How to Get a Warning on "Shiny App Will Not Work If the Same Output Is Used Twice"

How to get a warning on shiny app will not work if the same output is used twice

I think that it may be quite some task to print it out to the R console. But if you open your app and go to the JS console you should see an error message:

Duplicate


Feedback as requested (here in the answer to allow for formatting purposes):

Your code covers basic cases, but there are some edge cases which you may be overlooking (this list does not claim to be exhaustive):

  1. If the name of the output element is in the next line, your code will not detect it.
  2. If the name of the element is not a string but in a variable it won't work either.

(and this are just 2 cases I can quickly think of - and they are not completely unrealistic to be honest)

Overall, I think it will be quite some work to cover all cases, while a quick look into the JS console reveals all you need, just in a different environment. IMHO completeness beats convenience.

outname <- "distPlot"
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100)
),
mainPanel(plotOutput("distPlot"),
plotOutput(
"distPlot" # not covered b/c in other line
),
plotOutput(outname) # not covered b/c in variable
)
)
)

Using the same output element twice in Shiny

Your ui code is fine, but:

Shiny doesn't support multiple outputs with the same name. This code
would generate HTML where two elements have the same ID, which is
invalid HTML.

So, I think your only solution would be to create a third table. The best option is to use a reactive in the middle, so you avoid having the same code used twice.

function(input, output) {

# display 10 rows initially
output$ex1 <- DT::renderDataTable(
DT::datatable(iris, options = list(pageLength = 25))
)

# -1 means no pagination; the 2nd element contains menu labels

iris_table <- reactive({
DT::datatable(
iris, options = list(
lengthMenu = list(c(5, 15, -1), c('5', '15', 'All')),
pageLength = 15
)
)
})

output$ex2 <- DT::renderDataTable(
iris_table()
)
output$ex3 <- DT::renderDataTable(
iris_table()
)

}

Hope this helps!

How to add warnings to UI outputs generated dynamically in Shiny

I think you have a couple of problems here.

First, you have forgotten to add useShinyFeedback() to your UI definition.

ui = shinyUI(
fluidPage(
useShinyFeedback(),
titlePanel("Compare"),
...

Second, you've put the observeEvents that monitor your first item values inside your renderUI. That's not going to work: R's standard scoping means that these observeEvents won't be available to monitor changes in the corresponding input widgets. The solution is to create a separate observeEvent to create your observers on the inputs:

  observeEvent(input$numitems, {
lapply(1:(input$numitems), function(i) {
observeEvent(input[[paste0('firstitem',i)]], {
shinyFeedback::feedbackWarning(
inputId = paste0('firstitem',i),
show = input[[paste0('firstitem',i)]] > 100,
text = "Number less than 100 required.",
color="red"
)
})
})
})

Making these changes gives me, for example,

Sample Image

With regard to your final question about the Submit actionButton, and as a general observation, I think your life will be much easier if you use Shiny modules to solve this problem. This will allow you to delegate the error checking to the indivudual modules and remove the need to continually loop through the indices of the dynamic inputs. This will lead to shorter, simpler, and more understandable code.

One thing to bear in mind if you do this: make sure you put a call to useShinyFeedback in the definition of the module UI.

R Shiny Object not found - Evaluating a strings as code

Functions in R (and therefore shiny) are lexically scoped. This mean that functions can only see the variables defined in the environment where they themselves are defined. You are defining eval_parse in the global environment but random_df is defined in the shiny server function. This the former cannot see the latter because random_df is not in the gloabl enviroment like it was in your non-shiny example.

If you want to make all the server variables available to your expression, you can specify an environment to eval(). First change the helper so you can pass an environment

eval_parse <- function(x, env=parent.frame()){
eval(parse(text = x), envir=env)
}

and then change your server code to pass along the function environment

tf_vector <- sapply(code_df$code_string, eval_parse, env=environment())

R Shiny reactivity error, how can I fix it?

This warning appears when there's a single item on one of the two axes - see this shiny issue.

But your code does not produce the plot you expect: input$dataset is the name of a column of the data, hence it is a string, and then when you do aes(x = Global_Sales, y = input$dataset), the y argument of aes is not set to a variable of the data, it is set to a string. So you have a single item on the y-axis, hence the warning.

To set the arguments of aes to some variables of the data when you have the names of these variables, you can use aes_string:

aes_string(x = "Global_Sales", y = input$dataset)

Shiny if else statement

You can try the following code -

  • plotOutput("plot") was mentioned twice, removed it to include it only once.
  • We don't need to check for conditions while creating the dataset in reactive, handle it in the plot code itself.
  • Use .data to refer column names in ggplot code.
library(shiny)
library(ggplot2)

df <- mtcars
ui <- fluidPage(
h1("My first app",
style = 'color: green;
font-style: italic'),
hr(),
fluidRow(
sidebarPanel(
radioButtons(inputId = "number",
label = "Select number of variable",
choices = c("1 variable" = 1,
"2 variable" = 2)),
selectInput(inputId = "x",
label = "Variable 1",
choices = names(df)),
conditionalPanel(
condition = "input.number == 2",
selectInput(inputId = "y",
label = "Variable 2",
choices = names(df))
)
),
column(8, plotOutput("plot"))
)
)

server <- function(input, output, session){

data <- reactive({
df
})

observeEvent(input$x,
{updateSelectInput(session,
inputId = "y",
label = "Variable 2",
choices = names(df)[names(df) != input$x])
})

output$plot <- renderPlot({

if(input$number == 1){
plot <- ggplot(data = data(), aes(x = .data[[input$x]])) + geom_density()
} else {
plot <- ggplot(data = data(),
aes(x = .data[[input$x]], y = .data[[input$y]])) +
geom_point()
}
plot
})
}

shinyApp(ui = ui, server = server)

R Shiny: Output warning messages to UI

You can use tryCatch to store a warning object.
You can then put the message anywhere on your UI.

library(shiny)

ui <- fluidPage(
actionButton("btn", "click me")
)

server <- function(input, output)
{
observeEvent(input$btn, {
#x <- (1:3 * 1:2) # this generates a warning
#warning("manually generated warning message")
#mess <- names(last.warning)
a <- tryCatch(warning(Sys.time()), warning=function(w) { w })
mess <- a$message
showNotification(mess)
})
}

runApp(list(ui=ui, server=server))

Getting both message and value

If the operation is not heavy, an easy way is to run it twice: once with tryCatch and the other without.

library(shiny)

ui <- fluidPage(
actionButton("btn", "click me")
)

server <- function(input, output)
{
observeEvent(input$btn, {

x <- tryCatch(1:3 * 1:2, warning=function(w) { w })
if (inherits(x, "simpleWarning")) {
mess <- x$message
showNotification(mess)
x <- 1:3 * 1:2
}
print(x)
})
}

runApp(list(ui=ui, server=server))

If running the same operation twice is not desirable, then use the following trick (See this SO thread)

library(shiny)

ui <- fluidPage(
actionButton("btn", "click me")
)

server <- function(input, output)
{
withWarnings <- function(expr) {
myWarnings <- NULL
wHandler <- function(w) {
myWarnings <<- c(myWarnings, list(w))
invokeRestart("muffleWarning")
}
val <- withCallingHandlers(expr, warning = wHandler)
list(value = val, warnings = myWarnings)
}

observeEvent(input$btn, {
x <- withWarnings(1:3 * 1:2)
if (!is.null(x$warnings)) {
for (w in x$warnings) showNotification(w$message)

}
})
}

runApp(list(ui=ui, server=server))

R Shiny, shinyapps.io printing error messages for R codes

use shinyCatch from spsComps

Example for your case:

library(shiny)
library(spsComps)
ui <- fluidPage(
actionButton("a", "blocking"),
actionButton("b", "no blocking"),
)

server <- function(input, output, session) {
observeEvent(input$a, {
spsComps::shinyCatch({
seq(1,10,-2)
},
# blocking recommended
blocking_level = "error",
prefix = "My-project" #change console prefix if you don't want "SPS"
)
# some other following actions will NOT be run
print("other actions")
})

# if you dont want to block
observeEvent(input$b, {
spsComps::shinyCatch({
seq(1,10,-2)
}, prefix = "My-project")
# some other following actions will run
print("other actions")
})
}

shinyApp(ui, server)

or try more demos here

How do I use the output generated from another output with a Shiny app?

You can move the query into reactive function (function inside "server" part of the app):

sqlData <- reactive({
q1 <- "
SELECT *
FROM table
WHERE date > '"
q2 <- input$date[1]
q3 < "'"
p1_df <- sqlQuery(DS, q)
return(p1_df)
})

and then just call it inside renderPlotly:

output$p1 <- renderPlotly({
p1_df <- sqlData()
plot_ly(data = p1_df, x = ~x, y = ~y)
})

output$p2 <- renderPlotly({
p2_df <- sqlData()
plot_ly(data = p2_df, x = ~x, y = ~y)
})


Related Topics



Leave a reply



Submit