show warning to user in shiny in R - r

How to show warning to user in shiny in R. The user's input is correct, but the output is not suitable to show. The aim is to remind the user only a subset data are shown due to too many. warning() is shown in console only. Thank you.
Here is a fake code to explain the question due to the original is long. There is a warning in the renderTable. it aims to check data if the data is big, only first several items will be shown.
ui.R
shinyUI(fluidPage(
titlePanel("Validation App"),
sidebarLayout(
sidebarPanel(
selectInput("data", label = "Data set",
choices = c("", "mtcars", "faithful", "iris"))
),
# Show a plot of the generated distribution
mainPanel(
tableOutput("table"),
plotOutput("plot")
)
)
))
server.R
shinyServer(function(input, output) {
data <- reactive({
validate(
need(input$data != "", "Please select a data set")
)
get(input$data, 'package:datasets')
})
output$plot <- renderPlot({
hist(data()[, 1], col = 'forestgreen', border = 'white')
})
output$table <- renderTable({
warning("Warning message.")
head(data())
})
})

Update:
I put some more work into this and made the warning panel conditional.
However it only works if I include out the textOutput("warnstat") on every page. I assume because it is not setting the javascript variable output.warnstat unless I do this.
You could just build a warning panel into your UI, and set it accordingly. Here is a simple example, but it could be more elaborate than just a verabtim print statement.
ui.r
shinyUI(fluidPage(
titlePanel("Validation App"),
sidebarLayout(
sidebarPanel(
selectInput("data", label = "Data set",
choices = c("", "mtcars", "faithful", "iris"))
),
# Show a plot of the generated distribution
mainPanel(
conditionalPanel(condition = "output.warnstat == 'Error'",
verbatimTextOutput("warnmsg")),
tableOutput("table"),
plotOutput("plot")
)
)
))
server.r
shinyServer(function(input, output) {
errstat <- reactive({
ifelse (input$data=="mtcars",T,F)
})
data <- reactive({
validate(
need(input$data != "", "Please select a data set")
)
get(input$data, 'package:datasets')
})
output$plot <- renderPlot({
hist(data()[, 1], col = 'forestgreen', border = 'white')
})
output$table <- renderTable({
warning("Warning message.")
head(data())
})
output$warnmsg <- renderPrint({
if (errstat()){
print("Warning message - blah blah blah")
print(input$data)
head(data())
} else {
print("No error")
}
})
output$warnstat <- renderText({ifelse(errstat(),"Error","No error") })
outputOptions(output, "warnstat", suspendWhenHidden=FALSE)
})
With conditional warning panel:
Without conditional warning panel:

I use this wrapping function to capture errors, warnings and messages and display them as dismissible notifications to the user.
quietly <- function(.f) {
fun <- .f %>% purrr::quietly() %>% purrr::safely()
function(...) {
res <- fun(...)
if(!is.null(res$error)) { # safely output
showNotification(res$error$message, duration = 10, type="error")
return(res$result)
}
res <- res$result # quietly output
if(!is.null(res$warnings) && length(res$warnings) > 0) {
lapply(unique(res$warnings), showNotification, duration = 10, type="warning")
}
return(res$result)
}
}

Related

How to add a spinner before a selectizeInput has loaded all the choices? [Shiny]

I want to make an app with 2 actionButtons: 1) to submit the changes before loading a selectizeInput and 2) to draw the plot.
I know how to add a spinner after clicking a actionButton but the majority of the cases is added when you want to show the plot.
However, is it possible to add a spinner without showing any plot?
In this particular case, I want to show a spinner after clicking "Submit" until the selectizeInput from the 'Selection tab' is loaded. As you can see the example that I attach, it takes a bit to load all the choices (since the file has 25000 rows).
I already have one spinner after clicking the second actionButton (Show the plot) but I need one more.
I have created an example, but for some reason the plot is not shown in the shiny app and it appears in the window from R (I don't know why but I added the plot just to show you how I put the second spinner. I want a similar one but with the first actionButton.).
library(shiny)
library(shinycssloaders)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Submit",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Selection",
br(),
selectizeInput(inputId = "numbers", label = "Choose one number:", choices=character(0)),
actionButton("show_plot", "Show the plot")
))
),
mainPanel(
conditionalPanel(
condition = "input.show_plot > 0",
style = "display: none;",
withSpinner( plotOutput("hist"),
type = 5, color = "#0dc5c1", size = 1))
)
)
)
server <- function(input, output, session) {
data <- reactive({
data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
data[,1] <- as.character(data[,1])
if(input$log2 == TRUE){
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
return(data)
})
mylist <- reactive({
req(data())
data <- data()
data <- data[,1]
return(data)
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$submit, {
updateSelectizeInput(
session = session,
inputId = "numbers",
choices = mylist(), options=list(maxOptions = length(mylist()))
)
})
v <- reactiveValues()
observeEvent(input$show_plot, {
data <- data()
v$plot <- plot(x=data[,1], y=data[,2])
})
# If the user didn't choose to see the plot, it won't appear.
output$hist <- renderPlot({
req(data())
if (is.null(v$plot)) return()
if(input$show_plot > 0){
v$plot
}
})
}
Does anyone know how to help me, please?
Thanks very much
It's a little tricky.
First of all I'd update the selectizeInput on the server side as the warning suggests:
Warning: The select input "numbers" contains a large number of
options; consider using server-side selectize for massively improved
performance. See the Details section of the ?selectizeInput help
topic.
Furthermore I switched to ggplot2 regarding the plotOutput - Please see this related post.
To show the spinner while the selectizeInput is updating choices we'll need to know how long the update takes. This information can be gathered via shiny's JS events - please also see this article.
Finally, we can show the spinner for a non-existent output, so we are able to control for how long the spinner is shown (see uiOutput("dummyid")):
library(shiny)
library(shinycssloaders)
library(ggplot2)
ui <- fluidPage(
titlePanel("My app"),
tags$script(HTML(
"
$(document).on('shiny:inputchanged', function(event) {
if (event.target.id === 'numbers') {
Shiny.setInputValue('selectizeupdate', true, {priority: 'event'});
}
});
$(document).on('shiny:updateinput', function(event) {
if (event.target.id === 'numbers') {
Shiny.setInputValue('selectizeupdate', false, {priority: 'event'});
}
});
"
)),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Submit",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Selection",
br(),
selectizeInput(inputId = "numbers", label = "Choose one number:", choices=NULL),
actionButton("show_plot", "Show the plot")
))
),
mainPanel(
uiOutput("plotProxy")
)
)
)
server <- function(input, output, session) {
previousEvent <- reactiveVal(FALSE)
choicesReady <- reactiveVal(FALSE)
submittingData <- reactiveVal(FALSE)
observeEvent(input$selectizeupdate, {
if(previousEvent() && input$selectizeupdate){
choicesReady(TRUE)
submittingData(FALSE)
} else {
choicesReady(FALSE)
}
previousEvent(input$selectizeupdate)
})
data <- reactive({
data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
if(input$log2 == TRUE){
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
return(data)
})
mylist <- reactive({
req(data()[,1])
})
observeEvent(input$submit, {
submittingData(TRUE)
reactivePlotObject(NULL) # reset
updateSelectizeInput(
session = session,
inputId = "numbers",
choices = mylist(), options=list(maxOptions = length(mylist())),
server = TRUE
)
})
reactivePlotObject <- reactiveVal(NULL)
observeEvent(input$show_plot, {
reactivePlotObject(ggplot(data(), aes_string(x = names(data())[1], y = names(data())[2])) + geom_point())
})
output$hist <- renderPlot({
reactivePlotObject()
})
output$plotProxy <- renderUI({
if(submittingData() && !choicesReady()){
withSpinner(uiOutput("dummyid"), type = 5, color = "#0dc5c1", size = 1)
} else {
conditionalPanel(condition = "input.show_plot > 0", withSpinner(plotOutput("hist"), type = 5, color = "#0dc5c1", size = 1), style = "display: none;")
}
})
}
shinyApp(ui, server)
First 100 rows of your example data (dput(head(data, 100)) - your link might be offline some day):
structure(list(Index = 1:100, Height.Inches. = c(65.78331, 71.51521,
69.39874, 68.2166, 67.78781, 68.69784, 69.80204, 70.01472, 67.90265,
66.78236, 66.48769, 67.62333, 68.30248, 67.11656, 68.27967, 71.0916,
66.461, 68.64927, 71.23033, 67.13118, 67.83379, 68.87881, 63.48115,
68.42187, 67.62804, 67.20864, 70.84235, 67.49434, 66.53401, 65.44098,
69.5233, 65.8132, 67.8163, 70.59505, 71.80484, 69.20613, 66.80368,
67.65893, 67.80701, 64.04535, 68.57463, 65.18357, 69.65814, 67.96731,
65.98088, 68.67249, 66.88088, 67.69868, 69.82117, 69.08817, 69.91479,
67.33182, 70.26939, 69.10344, 65.38356, 70.18447, 70.40617, 66.54376,
66.36418, 67.537, 66.50418, 68.99958, 68.30355, 67.01255, 70.80592,
68.21951, 69.05914, 67.73103, 67.21568, 67.36763, 65.27033, 70.84278,
69.92442, 64.28508, 68.2452, 66.35708, 68.36275, 65.4769, 69.71947,
67.72554, 68.63941, 66.78405, 70.05147, 66.27848, 69.20198, 69.13481,
67.36436, 70.09297, 70.1766, 68.22556, 68.12932, 70.24256, 71.48752,
69.20477, 70.06306, 70.55703, 66.28644, 63.42577, 66.76711, 68.88741
), Weight.Pounds. = c(112.9925, 136.4873, 153.0269, 142.3354,
144.2971, 123.3024, 141.4947, 136.4623, 112.3723, 120.6672, 127.4516,
114.143, 125.6107, 122.4618, 116.0866, 139.9975, 129.5023, 142.9733,
137.9025, 124.0449, 141.2807, 143.5392, 97.90191, 129.5027, 141.8501,
129.7244, 142.4235, 131.5502, 108.3324, 113.8922, 103.3016, 120.7536,
125.7886, 136.2225, 140.1015, 128.7487, 141.7994, 121.2319, 131.3478,
106.7115, 124.3598, 124.8591, 139.6711, 137.3696, 106.4499, 128.7639,
145.6837, 116.819, 143.6215, 134.9325, 147.0219, 126.3285, 125.4839,
115.7084, 123.4892, 147.8926, 155.8987, 128.0742, 119.3701, 133.8148,
128.7325, 137.5453, 129.7604, 128.824, 135.3165, 109.6113, 142.4684,
132.749, 103.5275, 124.7299, 129.3137, 134.0175, 140.3969, 102.8351,
128.5214, 120.2991, 138.6036, 132.9574, 115.6233, 122.524, 134.6254,
121.8986, 155.3767, 128.9418, 129.1013, 139.4733, 140.8901, 131.5916,
121.1232, 131.5127, 136.5479, 141.4896, 140.6104, 112.1413, 133.457,
131.8001, 120.0285, 123.0972, 128.1432, 115.4759)), row.names = c(NA,
100L), class = "data.frame")

How to hide multiple shiny ui by condition, and how to use session$userData?

I am a beginer of shiny, and I am building a shiny app using win10 system, rstudio, and shiny version 1.7.1. I would like to make it more user oriented. It means that other parts of the application will be hid unless user uploads correct data. After many attempts, I decided to use session$userData and shinyjs::toggle to develop this app. But I am confused by session$userData. In the beginning, by reading the official documentation, I think it just like the global environment of r. But obviously not. So I just want to know how to use it correctly, or how to realize the features I want. There are three examples I had tried, they are for your reference.
Please note that the third example is almost what I want, but I don't think it's elegant since the continue button is somewhat redundant.
Examples 1:
I would like to check whether there is data input or whether the input data is a csv format, if true, show the data, and if not, the rest part of the app will be hid. In this case you can see, although you data have passed the check, the tablepanel b will still show nothing, unless before input data you have clicked tablepanel b, or unless after data checking you clicked button go again.
##### 1. packages #####
library(shiny)
library(shinyjs)
##### 2. ui #####
ui <- fluidPage(
useShinyjs(),
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(uiOutput("ui_p1_sidebar1"), uiOutput("ui_p1_sidebar2")),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(uiOutput("ui_p2_sidebar")),
mainPanel(uiOutput("ui_p2_main"))
))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_p1_sidebar1 <- renderUI({
fileInput(inputId = "p1s_inputdata",
label = "Input data",
multiple = FALSE,
accept = ".csv")
})
output$ui_p1_sidebar2 <- renderUI({
shiny::actionButton(inputId = "p1s_go",
label = "go",
icon = icon("play"))
})
observeEvent(input$p1s_go,{
isolate({
data <- input$p1s_inputdata
})
output$ui_p1_main <- renderUI({
tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T),
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T),
)
})
output$p1m_datacheck <- renderPrint({
# data check part, the result of checking is stored by session$userData$sig
if(is.null(data)){
cat("There is no data input! \n")
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
cat("Please input csv data! \n")
session$userData$sig <- F
} else{
cat("Data have passed the check!")
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
})
output$p1m_datashow <- renderPrint({
if(session$userData$sig){
print(session$userData$data)
} else{
cat("Please check the data!")
}
})
output$ui_p2_sidebar <- renderUI({
radioButtons("aaa", "aaa", choices = c("a", "b", "c"))
})
output$ui_p2_main <- renderUI({
verbatimTextOutput(outputId = "p2m_print", placeholder = T)
})
output$p2m_print <- renderPrint({print(letters[1:10])})
observe({
toggle(id = "ui_p2_sidebar", condition = session$userData$sig)
toggle(id = "ui_p2_main", condition = session$userData$sig)
})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
Example 2:
In this small case you can see, in a samle module, session$userData$... changed timely, but in another module, it will not change unless you click the button again. It that means session$userData$... could have different values at the same time?
##### 1. packages #####
library(shiny)
##### 2. ui #####
ui <- fluidPage(
sidebarLayout(
sidebarPanel(uiOutput("ui_sidebar")),
mainPanel(uiOutput("ui_main1"), uiOutput("ui_main2"))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_sidebar <- renderUI({
tagList(
radioButtons("s_letter", "letters", choices = c("a", "b", "c")),
shiny::actionButton(inputId = "go1",
label = "GO1",
icon = icon("play"))
)
})
observeEvent(input$go1, {
output$ui_main1 <- renderUI({
tagList(
h3("module 1: shared value changes timely."),
verbatimTextOutput(outputId = "m1", placeholder = T),
h3("module 2: shared value changes by button."),
verbatimTextOutput(outputId = "m2", placeholder = T)
)
})
output$m1 <- renderPrint({
out <- switch (input$s_letter,
"a" = "choose a",
"b" = "choose b",
"c" = "choose c")
session$userData$sharedout <- out
cat("out: \n")
print(out)
cat("sharedout: \n")
print(session$userData$sharedout)
})
output$m2 <- renderPrint({
cat("sharedout: \n")
print(session$userData$sharedout)
})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
Example 3: I also tried other solutions. There is a modification of example 1, I have added a continue button to realize my thought. It works well, but I hope the hidden action is based on conditions rather than events. So how to remove the button and let the rest part displayed automatically if data passed checking?
##### 1. packages #####
library(shiny)
##### 2. ui #####
ui <- fluidPage(
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(uiOutput("ui_p1_sidebar1"), uiOutput("ui_p1_sidebar2")),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(uiOutput("ui_p2_sidebar")),
mainPanel(uiOutput("ui_p2_main"))
))
)
)
##### 3. server #####
server <- function(input, output, session) {
output$ui_p1_sidebar1 <- renderUI({
fileInput(inputId = "p1s_inputdata",
label = "Input data",
multiple = FALSE,
accept = ".csv")
})
output$ui_p1_sidebar2 <- renderUI({
shiny::actionButton(inputId = "p1s_go",
label = "go",
icon = icon("play"))
})
observeEvent(input$p1s_go,{
isolate({
data <- input$p1s_inputdata
})
output$ui_p1_main <- renderUI({
tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T),
uiOutput("ispass"),
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T)
)
})
output$p1m_datacheck <- renderPrint({
if(is.null(data)){
cat("There is no data input! \n")
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
cat("Please input csv data! \n")
session$userData$sig <- F
} else{
cat("Data have passed the check!")
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
})
output$ispass <- renderUI({
if(isFALSE(session$userData$sig)){
return()
} else{
shiny::actionButton(inputId = "ispass",
label = "continue",
icon = icon("play"))
}
})
})
observeEvent(input$ispass,{
output$p1m_datashow <- renderPrint({
if(session$userData$sig){
print(session$userData$data)
} else{
cat("Please check the data!")
}
})
output$ui_p2_sidebar <- renderUI({
radioButtons("aaa", "aaa", choices = c("a", "b", "c"))
})
output$ui_p2_main <- renderUI({
verbatimTextOutput(outputId = "p2m_print", placeholder = T)
})
output$p2m_print <- renderPrint({print(letters[1:10])})
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
I hope the following refactoring will help and does what you want.
An essential tool for hiding,showing and updating UI elements can be the renderUI, but often this is overkill because of rerenderings.
But I would suggest using the shinyjs-package which gives you functions like shinyjs::show and shinyjs::hide for showing and hiding. For updating UI-elements, there are functions like shiny::updateActionButton,shiny::updateCheckboxInput, shiny::updateRadioButtons, ....
It is (always) useful to give your UI-elements IDs, like the tabsetPanel.
Moreover, a nice tool too is shiny::conditionalPanel, but you will dive into all this stuff when programming more apps. :)
##### 1. packages #####
library(shiny)
myapp <- function() {
##### 2. ui #####
ui <- fluidPage(
tabsetPanel(
tabPanel("a",
sidebarLayout(
sidebarPanel(
fileInput(inputId = "p1s_inputdata", label = "Input data", multiple = FALSE, accept = ".csv")
),
mainPanel(uiOutput("ui_p1_main"))
)),
tabPanel("b",
sidebarLayout(
sidebarPanel(radioButtons("aaa", "aaa", choices = c("some", "placeholder", "stuff"))),
mainPanel(verbatimTextOutput(outputId = "p2m_print", placeholder = T))
)),
id = "TABSETPANEL"
)
)
##### 3. server #####
server <- function(input, output, session) {
shiny::hideTab(inputId = "TABSETPANEL", target = "b", session = session)
observeEvent(input$p1s_inputdata, {
data <- input$p1s_inputdata
dataCheckText <- NULL
if(is.null(data)){
dataCheckText <- "There is no data input!"
session$userData$sig <- F
} else{
dataExt <- tools::file_ext(data$name)
if(dataExt != "csv"){
dataCheckText <- "Please input csv data!"
session$userData$sig <- F
} else{
dataCheckText <- "Data have passed the check!"
session$userData$data <- read.csv(data$datapath)
session$userData$sig <- T
}
}
output$p1m_datacheck <- renderPrint(dataCheckText)
if(session$userData$sig) shiny::showTab(inputId = "TABSETPANEL", target = "b", session = session)
else shiny::hideTab(inputId = "TABSETPANEL", target = "b", session = session)
main1Taglist <- tagList(
h3("Data check: "),
verbatimTextOutput(outputId = "p1m_datacheck", placeholder = T)
)
if(session$userData$sig) {
shiny::showTab(inputId = "TABSETPANEL", target = "b", session = session)
output$p1m_datashow <- renderPrint({
print(session$userData$data)
})
main1Taglist <- c(main1Taglist, tagList(
h3("Data show: "),
verbatimTextOutput(outputId = "p1m_datashow", placeholder = T)
))
#Update stuff in panel b according to the new data
updateRadioButtons(session = session, inputId = "aaa", choices = names(session$userData$data))
output$p2m_print <- renderPrint({print(letters[1:10])})
}
output$ui_p1_main <- renderUI(main1Taglist)
})
}
##### 4. app #####
shinyApp(ui = ui, server = server)
}
myapp()
You're somewhat on the right track. Try something like this:
observeEvent(input$go1, {
# Perform data validation here.
# This would look similar to what you have inside output$p1m_datacheck <- renderPrint({})
# If data file is no good, do nothing, exit this function: return()
# Else, data file is good, continue
# Do your output$* <- render*() functions here
})
You don't need to isolate() inside the handlerExpr of observeEvent(). It will already be executed in an isolate() scope.

R Shiny: PlotOutput not updating in Shiny app

I'm trying to make a simple Shiny app with the following features:
2 or 3 inputs:
input1: a selectInput
input2: a selectInput, conditional of input1
input3: a numeric value
The output is a ggplot where the labels inside of it change with the inputs.
I also want a default plot and a Reset button.
I made 3 files: ui.R, server.R and function.R. The last one is the one that makes the plot.
When input1 takes the values of "A" or "B", I get the desired output. The "Reset" button also seems to work fine. However, when I select "C" in input 1, it brings me back to the default plot: a plot whith the label "Nothing", instead of something like "C1 10".
I checked the code many times, but I can't get where is the problem.
Here is the code of my files:
# file ui.R
library(shiny)
shinyUI(fluidPage(
plotOutput("printsomething"),
selectInput(
inputId="input1",
label="input1",
choices=c("A","B","C"),
selected = NULL,
multiple = FALSE,
selectize = TRUE,
width = NULL,
size = NULL),
conditionalPanel(
condition = "input.input1 == 'A'",
selectInput("input2", "input2",
list("A1", "A2"))),
conditionalPanel(
condition = "input.input1 == 'C'",
selectInput("input2", "input2",
list("C1", "C2"))),
numericInput("num","Number",value=0,min=0),
actionButton("Run","Run"),
actionButton("Reset","Reset")
)
)
# file server.R
source("function.R")
library(shiny)
shinyServer(function(input, output) {
graph <- reactiveValues(data = NULL)
observeEvent(input$Run, {
graph$data <- printsomething(data,input$input1,input$input2,input$num)
})
observeEvent(input$Reset, {
graph$data <- printsomething("Nothing","NA","NA","NA")
})
output$printsomething <- renderPlot({
if (is.null(graph$data)) return(printsomething(data,"NA","NA","NA"))
graph$data
})
})
# file function.R
library(ggplot2)
data <- "Nothing"
printsomething <- function(data,input1=NA,input2=NA,num=0) {
if(is.na(input1)) {
data <- "Nothing"
} else if(input1=="A") {
if(input2=="A1") {
data <- paste("A1",num)
} else if(input2=="A2") {
data <- paste("A2",num)
}
} else if(input1=="B") {
data <- paste("B",num)
} else if(input1=="C") {
if(input2=="C1") {
data <- paste("C1",num)
} else if(input2=="C2") {
data <- paste("C2",num)
}
}
ggplot() +
geom_label(aes(x=1,y=1,label=data))
}
I'll really appreciate it if someone can help me. I'm new to Shiny.
Thanks.
As stated in the comment, unique inputId will make it work. There is a minor adjustment in the server side, and no change in the function printsomething. Try this
library(shiny)
ui <- shinyUI(fluidPage(
plotOutput("printsomething"),
selectInput(
inputId="input1",
label="input1",
choices=c("A","B","C"),
selected = NULL,
multiple = FALSE,
selectize = TRUE,
width = NULL,
size = NULL),
conditionalPanel(
condition = "input.input1 == 'A'",
selectInput("input2", "input2", list("A1", "A2"))),
conditionalPanel(
condition = "input.input1 == 'C'",
selectInput("input3", "input2", list("C1", "C2"))),
numericInput("num","Number",value=0,min=0),
actionButton("Run","Run"),
actionButton("Reset","Reset")
))
server <- shinyServer(function(input, output) {
graph <- reactiveValues(data = NULL)
observeEvent(input$Run, {
if (input$input1=="A"){ input2 = input$input2
}else if (input$input1=="C") input2 = input$input3
graph$data <- printsomething(data,input$input1,input2,input$num)
})
observeEvent(input$Reset, {
graph$data <- printsomething("Nothing","NA","NA","NA")
})
output$printsomething <- renderPlot({
if (is.null(graph$data)) return(printsomething(data,"NA","NA","NA"))
graph$data
})
})
shinyApp(ui, server)

Hide error message with custom message or reactive button in Shiny App

When I run the app, I get an error on the default screen. I'm not concerned about the error as the app works. When I select inputs the app works well.
What I would like to do is to hide the error on the default screen. This is the error message I'm getting:
Error: <text>:2:0: unexpected end of input
1: admit ~
^
I don't want to add a button to solve this issue as I would like to keep the app reactive. But if there is a way to add a button and still keep it reactive, I'd love that idea.
I'm also open to the idea of having a custom message on the default screen like "Select Dependent and Independent Variables" or something like that.
library(shiny)
mydata <- read.csv("https://stats.idre.ucla.edu/stat/data/binary.csv")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("input1", "Dependent Variable", choices = names(mydata)),
selectInput("input2", "Independent Variable(s)", choices = names(mydata), multiple = TRUE)
),
mainPanel(
verbatimTextOutput("output2"),
verbatimTextOutput("output1")
)
)
)
server <- function(input, output) {
left_vars <- reactive({input$input1})
right_vars <- reactive({
rights = input$input2
rights <- paste(rights, collapse=" + ")
})
log_formula <- reactive({as.formula(paste(left_vars(), " ~ ", right_vars()))})
output$output1 <- renderPrint({summary(glm(formula = log_formula(), data = mydata, family = "binomial"))})
output$output2 <- renderPrint({
paste(paste0(left_vars(), " ~", right_vars()))
})
}
shinyApp(ui = ui, server = server)
Adding a validation to the reactive term lets you write custom error messages with conditional statements.
library(shiny)
mydata <- read.csv("https://stats.idre.ucla.edu/stat/data/binary.csv")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("input1", "Dependent Variable", choices = names(mydata)),
selectInput("input2", "Independent Variable(s)", choices = names(mydata), multiple = TRUE)
),
mainPanel(
verbatimTextOutput("output2"),
verbatimTextOutput("output1")
)
)
)
server <- function(input, output) {
left_vars <- reactive({
validate(
need(input$input1, "Please enter a dependant variable"))
input$input1})
right_vars <- reactive({
validate(
need(input$input2, "Please enter an independant variable"))
rights = input$input2
rights <- paste(rights, collapse=" + ")
})
log_formula <- reactive({as.formula(paste(left_vars(), " ~ ", right_vars()))})
output$output1 <- renderPrint({summary(glm(formula = log_formula(), data = mydata, family = "binomial"))})
output$output2 <- renderPrint({
paste(paste0(left_vars(), " ~ ", right_vars()))
})
}
shinyApp(ui = ui, server = server)
Edit: In case you are wondering why it is displaying the same warning twice. It is because you have two render functions that can not be completed until an independent variable is selected.

attempt to apply non-function

I'm trying to build a simple application that draws a histogram of a selected variable based on a subset filtered by the other input. I get the error in the line hist(dataX()$datasetInput()) which should return dataX$mpg. How can I fix it?
Full code:
library(shiny)
u <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(
selectInput("variable", "Variable:",
list("Milles/gallon",
"Horse power")
),
textInput("nc","Number of cylinders",value = 6)
),
mainPanel(
plotOutput("Plot")
)
))
s <- shinyServer(function(input, output)
{
dataX <- reactive({mtcars[mtcars$cyl==input$nc,,drop = FALSE]})
datasetInput <- reactive({
switch(input$variable,
"Milles/gallon" = mpg,
"Horse power" = hp)
})
output$Plot <- renderPlot({
hist(dataX()$datasetInput())
})
})
shinyApp(u,s)
You complicated the simple app.
You do not need to list all the columns in selectInput. You can just render it from the server side.
Same applies to the cylinders
Shortcuts like u and sare acceptable, but just stick to the naming conventions. It makes your life easy.
Below is a complete working app
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(uiOutput("SelectColname"),
uiOutput("Cylinders")),
mainPanel(plotOutput("Plot"))
))
server <- shinyServer(function(input, output){
# Create a reactive dataset
dataX <- reactive({
mtcars
})
# Output number cylinders as select box
output$Cylinders <- renderUI({
selectInput("cylinders", "cylinders:", unique(dataX()$cyl))
})
# Output column names as selectbox
output$SelectColname <- renderUI({
selectInput("variable", "Variable:", colnames(dataX()[,c(1,4)]))
})
# Based on the selection by user, create an eventreactive plotdata object
plotdata <- eventReactive(input$cylinders, {
plotdata = dataX()[dataX()$cyl == input$cylinders, , drop = FALSE]
})
# Render the plot, the plot changes when new cylinder is selected
output$Plot <- renderPlot({
if (is.null(plotdata()))
return(NULL)
hist(
plotdata()[, input$variable],
xlab = input$variable,
main = paste(
"Histogram of" ,
input$variable
)
)
})
})
shinyApp(ui, server)

Resources