Thank you in advance for your help. I've tried to boil my issue down into as simple of an app as I could construct. I have a function sliderResetInput that calls an observeEvent and returns some UI elements. I can use sliderResetInput outside of a module (will demonstrate below), but I cannot use it inside a module. I thought this was an issue with a wrapping a namespace around my inputs, but I think the ID's all check out here. What's going on? As a note, while this construction seems needlessly complicated for this app, I need the structure for a much larger app.
This works:
library(shiny) # Version 1.0.5
sliderResetInput = function(id, input, output, session) {
observeEvent(input[[paste0(id, "_reset_slider")]],
updateSliderInput(session = session, inputId = paste0(id, "_slider"), value = c(0, 10)))
out = list(
sliderInput(inputId = paste0(id, "_slider"), label = "Slider", min = 0, max = 10, value = c(0, 10)),
actionButton(inputId = paste0(id, "_reset_slider"), label = "Reset slider")
)
return(out)
}
server <- function(input, output, session) {
getSliders = reactive(sliderResetInput(id = "test1", input, output, session))
output$sliders = renderUI(getSliders())
observeEvent(input$browser, browser())
}
ui <- fluidPage(
uiOutput(outputId = "sliders"),
actionButton(inputId = "browser", "Click me to go into browser()")
)
shinyApp(ui = ui, server = server, options = list(launch.browser = T))
With the same sliderResetInput() function, this does NOT work:
library(shiny) # Version 1.0.5
sliderResetInput = function(id, input, output, session) {
observeEvent(input[[paste0(id, "_reset_slider")]],
updateSliderInput(session = session, inputId = paste0(id, "_slider"), value = c(0, 10)))
out = list(
sliderInput(inputId = paste0(id, "_slider"), label = "Slider", min = 0, max = 10, value = c(0, 10)),
actionButton(inputId = paste0(id, "_reset_slider"), label = "Reset slider")
)
return(out)
}
myModuleUI = function(id) {
ns = NS(id)
tagList(
uiOutput(outputId = ns("sliders"))
)
}
myModule = function(input, output, session) {
ns = session$ns
getSliders = reactive(sliderResetInput(id = ns("test1"), input, output, session))
output$sliders = renderUI(getSliders())
}
server <- function(input, output, session) {
callModule(myModule, id = "A")
observeEvent(input$browser, browser())
}
ui <- fluidPage(
myModuleUI(id = "A"),
actionButton(inputId = "browser", "Click me to go into browser()")
)
shinyApp(ui = ui, server = server, options = list(launch.browser = T))
Does anyone know what's going on here?
Thank you for your time!
You have to prefix the ids of the widgets only. That is:
sliderResetInput = function(id, NSid, input, output, session) {
observeEvent(input[[paste0(id, "_reset_slider")]], {
updateSliderInput(session = session, inputId = paste0(id, "_slider"), value = c(0, 10))
})
out = list(
sliderInput(inputId = paste0(NSid, "_slider"), label = "Slider", min = 0, max = 10, value = c(0, 10)),
actionButton(inputId = paste0(NSid, "_reset_slider"), label = "Reset slider")
)
return(out)
}
and
getSliders = reactive(sliderResetInput(id = "test1", NSid = ns("test1"), input, output, session))
Related
Objective: I have created a simple reproducible app in which I am attempting to add UI components through an action button so that I can filter the same dataset by the UI filters generated from the action button. I am attempting to use the shiny module code to save the dataset after the filter is applied to it and reuse the filtered dataset the next time the actionbutton is clicked. In other words, I want to reuse this filtered dataset (not the original unfiltered dataset) everytime a new set of UI components are generated by clicking the actionbutton.
Problem: The desired outcome works for the first instance when the user clicks the actiobutton, but any sequential click of the actionbutton results in Error: promise already under evaluation: recursive default argument reference or earlier problems? Is what I am attempting to do not possible in shiny / shiny modules, or am I performing something incorrectly? Any help would be greatly appreciated.
library(shiny)
library(dplyr)
add.filter.UI = function(id) {
ns = NS(id)
fluidRow(
column(4, uiOutput(ns("UI_1"))),
column(6, uiOutput(ns("UI_2"))),
column(width = 2,
actionButton(inputId = ns("rm.filter"), label = "Filter", icon = icon("minus"), style = "position: relative; bottom: 0; right:0; top:24px;")),
br(),
column(width = 12, tableOutput(ns("test"))))
}
add.filter.server = function(id, data) {
moduleServer(id, function(input, output, session) {
ns = session$ns
output$UI_1 <- renderUI({
selectInput(inputId = ns("sel.col"),
label = "Select a column",
choices = names(data %>% select_if(is.numeric)),
multiple = F)
})
col.rng = reactive({ data %>% select(one_of(input$sel.col)) })
output$UI_2 = renderUI({
sliderInput(inputId = ns("sel.rng"),
label = "Filter the range",
min = min(col.rng(), na.rm = T),
max = max(col.rng(), na.rm = T),
value = c(min(col.rng(), na.rm = T), max(col.rng(), na.rm = T)),
step = (max(col.rng(), na.rm = T) - min(col.rng(), na.rm = T)) / 100 # of breaks
)
})
data.filtered = reactive({
data %>%
rename(Var = one_of(input$sel.col)) %>%
arrange(Var) %>%
filter(Var >= min(input$sel.rng), Var <= max(input$sel.rng)) %>%
rename(!!input$sel.col := Var)
})
output$test = renderTable({
data.filtered() %>%
head()
})
return( data.filtered )
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
column(width = 2, offset = 10, actionButton(inputId = "add.filter", label = "Filter", icon = icon("plus"), style = "position:relative; left:10px;")),
tags$div(id = 'placeholder')
),
mainPanel(
tableOutput(outputId = "tbl")
)
)
)
server <- function(input, output, session) {
counter = reactiveVal(value = 0)
observeEvent(input$add.filter, {
id <- paste0("#filter_", input$add.filter) # - 1, "-break"
insertUI(selector = "#placeholder",
where = "afterEnd",
ui = tags$div(
add.filter.UI(paste0("filter_", input$add.filter)),
id = id)
)
counter(input$add.filter)
if (counter() == 1) {
df.filtered = add.filter.server(id = paste0("filter_", input$add.filter), data = mtcars)
} else {
df.filtered = add.filter.server(id = paste0("filter_", input$add.filter), data = df.filtered())
}
output$tbl = renderTable({
df.filtered()
})
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
I was able to resolve my issue by taking an alternative approach, as described in my comment above. The below code provides a summary table of the inputs selected by the user. All that would need to be done is to apply these filters onto the table to subset it accordingly.
library(shiny)
library(dplyr)
add.filter.UI = function(id) {
ns = NS(id)
fluidRow(
column(4, uiOutput(ns("UI_1"))),
column(6, uiOutput(ns("UI_2"))),
column(width = 2,
actionButton(inputId = ns("rm.filter"), label = "Filter", icon = icon("minus"), style = "position: relative; bottom: 0; right:0; top:24px;"))
)
}
add.filter.server = function(id, data) {
moduleServer(id, function(input, output, session) {
ns = session$ns
output$UI_1 <- renderUI({
selectInput(inputId = ns("sel.col"),
label = "Select a column",
choices = names(data %>% select_if(is.numeric)),
multiple = F)
})
col.rng = reactive({ data %>% select(one_of(input$sel.col)) })
output$UI_2 = renderUI({
sliderInput(inputId = ns("sel.rng"),
label = "Filter the range",
min = min(col.rng(), na.rm = T),
max = max(col.rng(), na.rm = T),
value = c(min(col.rng(), na.rm = T), max(col.rng(), na.rm = T)),
step = (max(col.rng(), na.rm = T) - min(col.rng(), na.rm = T)) / 100 # of breaks
)
})
data.filtered = reactive({
data.frame(Col.Nm = input$sel.col,
Min = min(input$sel.rng, na.rm = T),
Max = max(input$sel.rng, na.rm = T))
})
return( data.filtered )
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
column(width = 2, offset = 10, actionButton(inputId = "add.filter", label = "Filter", icon = icon("plus"), style = "position:relative; left:10px;")),
tags$div(id = 'placeholder')
),
mainPanel(
tableOutput(outputId = "tbl")
)
)
)
server <- function(input, output, session) {
df.filtered = reactiveValues()
observeEvent(input$add.filter, {
id <- paste0("#filter_", input$add.filter) # - 1, "-break"
insertUI(selector = "#placeholder",
where = "afterEnd",
ui = tags$div(
add.filter.UI(paste0("filter_", input$add.filter)),
id = id)
)
df.filtered[[paste0("Filtered_", input$add.filter[1])]] = add.filter.server(id = paste0("filter_", input$add.filter), data = mtcars)
output$tbl = renderTable({
for (i in 1:input$add.filter[1]) {
if (i == 1) {
df = df.filtered[[paste0("Filtered_", i)]]()
} else {
df = rbind(df,
df.filtered[[paste0("Filtered_", i)]]())
}
}
df
})
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
UPDATED with Limey's suggestion
I have created a simple reproducible app in which I am attempting to add UI components through an action button so that I can filter the same dataset by the UI filters generated from the action button. The issue I am not understanding, is how to get the modularized code to save the dataset after the filter is applied to it and reuse the filtered dataset the next time the actionbutton is clicked. In other words, I want to reuse this filtered dataset (not the original unfiltered dataset) everytime a new set of UI components are generated by clicking the actionbutton. The below code launches properly, but does not perform the desired function. The error that I am getting which I cannot resolve is when I uncomment out the commented out 2 lines of code.
library(shiny)
library(dplyr)
add.filter.UI = function(id) {
ns = NS(id)
fluidRow(
column(4, uiOutput(ns("UI_1"))),
column(6, uiOutput(ns("UI_2"))),
column(width = 2,
actionButton(inputId = ns("rm.filter"), label = "Filter", icon = icon("minus"), style = "position: relative; bottom: 0; right:0; top:24px;")),
br(),
column(width = 12, tableOutput(ns("test"))))
}
add.filter.server = function(id, data) {
moduleServer(id, function(input, output, session) {
ns = session$ns
output$UI_1 <- renderUI({
selectInput(inputId = ns("sel.col"),
label = "Select a column",
choices = names(data %>% select_if(is.numeric)),
multiple = F)
})
col.rng = reactive({ data %>% select(one_of(input$sel.col)) })
output$UI_2 = renderUI({
sliderInput(inputId = ns("sel.rng"),
label = "Filter the range",
min = min(col.rng(), na.rm = T),
max = max(col.rng(), na.rm = T),
value = c(min(col.rng(), na.rm = T), max(col.rng(), na.rm = T)),
step = (max(col.rng(), na.rm = T) - min(col.rng(), na.rm = T)) / 100 # of breaks
)
})
data.filtered = reactive({
data %>%
rename(Var = one_of(input$sel.col)) %>%
arrange(Var) %>%
filter(Var >= min(input$sel.rng), Var <= max(input$sel.rng)) %>%
rename(!!input$sel.col := Var)
})
output$test = renderTable({
data.filtered() %>%
head()
})
return( data.filtered )
})
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
column(width = 2, offset = 10, actionButton(inputId = "add.filter", label = "Filter", icon = icon("plus"), style = "position:relative; left:10px;")),
tags$div(id = 'placeholder')
),
mainPanel(
tableOutput(outputId = "tbl")
)
)
)
server <- function(input, output, session) {
df.filtered = reactiveVal(value = mtcars )
observeEvent(input$add.filter, {
id <- paste0("#filter_", input$add.filter) # - 1, "-break"
insertUI(selector = "#placeholder",
where = "afterEnd",
ui = tags$div(
add.filter.UI(paste0("filter_", input$add.filter)),
id = id)
)
new.df = add.filter.server(id = paste0("filter_", input$add.filter), data = df.filtered())
# df.filtered(new.df()) # this causes an error
output$tbl = renderTable({
new.df()
# df.filtered() # replacing the new.df() line with this line causes an error
})
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
I'm building a shiny app that has a reactive slider that I want the bar color to be red. I'm trying to use the setSliderColor() function from the shinyWidgets package, but it's not working. My assumption is that it isn't picking up on the sliderId because it isn't:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
setSliderColor(c("green"), sliderId = c(1)),
sidebarLayout(
sidebarPanel(
textInput(inputId = "greeting",
label = "Say hi!"),
actionButton(inputId = "submit",
label = "Submit"),
uiOutput("num_slider"),
),
mainPanel()
))
server <- function(input, output) {
output$num_slider <- renderUI({
shiny::req(input$greeting)
shiny::req(input$submit)
if(input$greeting == "hi!") {
sliderInput(inputId = "num_filter2",
label = "Filter by Number",
min = 1,
max = 10,
value = c(1, 10))
} else {
sliderInput(inputId = "num_filter2",
label = "Filter by Number",
min = 1,
max = 5,
value = c(1, 5))
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
But, here's the weird thing. If I put in a regular slider in the UI, it suddenly detects both--but then changes the color back to blue if I click submit twice:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
setSliderColor(c("green", "red"), sliderId = c(1, 2)),
sidebarLayout(
sidebarPanel(
textInput(inputId = "greeting",
label = "Say hi!"),
actionButton(inputId = "submit",
label = "Submit"),
uiOutput("num_slider"),
sliderInput(inputId = "num_filter1",
label = "Now it works!",
min = 1,
max = 10,
value = c(1, 10))
),
mainPanel()
))
server <- function(input, output) {
output$num_slider <- renderUI({
shiny::req(input$greeting)
shiny::req(input$submit)
if(input$greeting == "hi!") {
sliderInput(inputId = "num_filter2",
label = "Filter by Number",
min = 1,
max = 10,
value = c(1, 10))
} else {
sliderInput(inputId = "num_filter2",
label = "Filter by Number",
min = 1,
max = 5,
value = c(1, 5))
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Any fix on how address this? I'm also open to other solutions if it avoids long bouts of HTML, like this answer.
The function is just not designed to work with renderUI(). The arguments need to be updated in each call.
a quick fix would be preallocate very large vectors that the user will never reach (like 1 million) or use reactiveValues() like this:
note: The sliders will turn green when "hi!" is passed as an input.
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput(inputId = "greeting",
label = "Say hi!"),
actionButton(inputId = "submit",
label = "Submit"),
uiOutput("num_slider"),
sliderInput(inputId = "num_filter1",
label = "Now it works!",
min = 1,
max = 10,
value = c(1, 10))
),
mainPanel()
))
server <- function(input, output) {
i <- reactiveValues()
i$color <- 1
i$color_name <- 'green'
observeEvent(input$submit, {
i$color <- c(i$color, i$color[[length(i$color)]] + 1)
i$color_name <- c(i$color_name, 'green')
#left for demonstration purposes
print(i$color)
print(i$color_name)
shiny::req(input$greeting)
shiny::req(input$submit)
output$num_slider <- renderUI({
if(input$greeting == "hi!") {
fluidPage(setSliderColor(i$color_name, sliderId = i$color),
sliderInput(inputId = "num_filter2",
label = "Filter by Number",
min = 1,
max = 10,
value = c(1, 10)))}
}) })
}
# Run the application
shinyApp(ui = ui, server = server)
I created a (for demonstration purposes reproducible) shiny app where the ui creates some Data (DataPack) (a list with two elements) by clicking the "Load"-button. Every element of this list is plotted via the module using lapply in the server function.
The app works, however, the plots come out in reverse order (DataPack$two with rnorm(n)^2 before DataPack$one with rnorm(n)) but are expected to be shown as called (lapply(names(DataPack()), function(DataSetName) {...})). How do I fix this/repeat calling modules in an exactly given order and what is the explanation for that behavior?
library(shiny)
library(TTR)
Module_ui <- function(id) {
ns <- shiny::NS(id)
shiny::uiOutput(ns("Plot"))
}
Module_Server <- function(
input, output, session,
DataPack, DataSetName, InputButton_GetData, xlim) {
AnalysedPack <- eventReactive(c(
InputButton_GetData(),
input$InputButton_ProcessData), {
message(paste("Analysed Pack", DataSetName))
AnalysedPack <-
runMean(DataPack()[[DataSetName]],
min(input$NumericInput_BW,
length(DataPack()[[DataSetName]])))
return(AnalysedPack)
})
output[['Plot']] <- renderUI({
ns <- session$ns
tags$div(
id = environment(ns)[['namespace']],
tagList(
fluidRow(
column(2, column(12, fluidRow(
numericInput(
inputId = ns("NumericInput_BW"),
label = NULL,
min = 1,
max = 100,
value = 10,
step = 1))),
fluidRow(
column(12, actionButton(
ns("InputButton_ProcessData"),
"Process", width = "100%")))),
column(10,
renderPlot({
message(paste("Base_Plot", DataSetName))
plot(DataPack()[[DataSetName]],
xlim = c(xlim()[1],
xlim()[2]))
lines(AnalysedPack(),
col = "tomato", lwd = 2)
}) ) )
)
)
})
}
ui <- fluidPage(
fluidRow(
column(
6,
column(
12,
fluidRow(h4("Data Generation")),
fluidRow(actionButton(
"InputButton_GetData", "Load", width = "100%")))),
column(
6,
column(
12,
fluidRow(h4("Update Plot")),
sliderInput(
"SliderInput_xAxis",
label = NULL,
min = 0,
max = 150,
value = c(0, 150),
animate = TRUE)
)
),
column(12, actionButton('addButton', '', icon = icon('plus')))
)
)
server <- function(input, output, session) {
DataPack <- eventReactive(
input$InputButton_GetData, {
message("DataPack")
n <- round(runif(1, min = 100, max = 500))
message(n)
DataPack <- NULL
DataPack$one <- rnorm(n)
DataPack$two <- rnorm(n)^2
updateSliderInput(
session = session,
inputId = "SliderInput_xAxis",
value = c(1, n),
min = 1,
max = n)
return(DataPack)
})
SliderInput_xAxis_rx <-
reactive(input$SliderInput_xAxis)
InputButton_GetData_rx <-
reactive(input$InputButton_GetData)
observeEvent(input$InputButton_GetData, {
lapply(names(DataPack()), function(DataSetName) {
id <- sprintf('Plot%s', DataSetName)
insertUI(
selector = "#addButton",
where = "afterEnd",
ui = Module_ui(id)
)
callModule(
Module_Server, id,
DataPack = DataPack,
DataSetName = DataSetName,
InputButton_GetData = InputButton_GetData_rx,
xlim = SliderInput_xAxis_rx)
})
})
}
shinyApp(ui, server)
This code:
insertUI(
selector = "#addButton",
where = "afterEnd",
ui = Module_ui(id)
)
inserts the UI after the element #addButton. So the first call generates, schematically:
#addButton
ui1
And the second call, as the first one, inserts after #addButton, not after ui1:
#addButton
ui2
ui1
So, reverse the names.
I have a weird issue with conditionalPanel in shiny dashboard.
I modularized my chart UI components as I need to call it multiple times.
The conditional Panel seems to work fine if I call it only once. However, if I attempted to call more than once, it stopped working.
Below is the reproducible code:
library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)
library(highcharter)
library(lubridate)
chartUI <- function(id) {
ns <- NS(id)
tagList(
verbatimTextOutput(ns("group")),
selectInput(ns("freq"),"Select frequency:",
choices = list("Yearly" = "Y","Half yearly" = "H","Quarterly" = "Q",
"Monthly"="M"), selected = "Yearly", multiple = FALSE),
dateInput(ns("dates"), "Select start date:",format = "yyyy-mm-dd", startview = "month", value = dmy("1/1/2014")),
selectInput(ns("link"),"Select link ratio:",choices = list("All" = "all", "Standard" = "std"),selected = "all"),
conditionalPanel("input.link == 'std'", ns=ns, sliderInput(ns("std.month"),"No of months:",min=1,max=119,value=60))
)
}
ui <- shinyUI(
ui = dashboardPagePlus(skin = "red",
header = dashboardHeaderPlus(
title = "TITLE",
titleWidth = 700
),
dashboardSidebar(),
body = dashboardBody(
# boxPlus(
# width = NULL,title = "CHART",closable = TRUE,enable_sidebar = TRUE,
# sidebar_width = 15,sidebar_start_open = FALSE,sidebar_content = chartUI("chartui1"),
# highchartOutput("")
# ),
boxPlus(
width = NULL,title = "CHART",closable = TRUE,enable_sidebar = TRUE,
sidebar_width = 15,sidebar_start_open = FALSE,sidebar_content = chartUI("chartui2"),
highchartOutput("")
)
),
title = "DashboardPage"
)
)
server <- shinyServer(function(input, output) {
})
shinyApp(ui, server)
If I only call chartui2, conditional panel works fine. But if I call both chartui1 and chartui2, both of them no longer work.
A minimal example with uiOutput / renderUI would be:
library(shiny)
dyn_ui <- function(id) {
ns <- NS(id)
tagList(selectInput(ns("show"), "show or not", choices = c("hide", "show")),
uiOutput(ns("dyn")))
}
dyn_server <- function(input, output, session) {
output$dyn <- renderUI({
ns <- session$ns
if (input$show == "show") {
sliderInput(
inputId = ns("std_month"),
"No of months:",
min = 1,
max = 119,
value = 60
)
}
})
}
ui <- basicPage(dyn_ui("test"))
server <- function(input, output, session) {
callModule(module = dyn_server, id = "test")
}
runApp(list(ui = ui, server = server))
Edit:
In fact, a minimal example works well with conditionalPanel too (see below). So something else about your app is causing a conflict. Not sure what it is, but I would start adding components one by one and see when these minimal examples start misbehaving.
library(shiny)
dyn_ui <- function(id) {
ns <- NS(id)
tagList(
selectInput(ns("show"), "show or not", choices = c("hide", "show")),
conditionalPanel(
ns = ns,
condition = "input.show == 'show'",
sliderInput(
inputId = ns("std_month"),
"No of months:",
min = 1,
max = 119,
value = 60
)
)
}
ui <- basicPage(
dyn_ui("test"),
dyn_ui("test2")
)
server <- function(input, output, session) {
}
runApp(list(ui = ui, server = server))