Order of repeated Shiny Modules using lapply and insertUI - r

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.

Related

Module inside module shiny

I'm trying to call a module from inside a module and having some problems.
This first code is working, it displays an app with a button that creates a popup. Inside the popup is a plot and a slider input. The popup-plot is defined in it's own module.
library(shiny)
library(shinyWidgets)
uiForModal <<- function(id) {
ns <- NS(id)
tagList(
fluidRow(
plotOutput(outputId = ns("plot")),
sliderInput(
inputId =ns( "clusters"),
label = "Number of clusters",
min = 2, max = 6, value = 3, width = "100%"
)
)
)
}
serverForModal <<- function(input, output, session) {
output$plot <- renderPlot({
print(head(iris))
plot(Sepal.Width ~ Sepal.Length,
data = iris, col = Species,
pch = 20, cex = 2)
points(kmeans(iris[, 1:2], input$clusters)$centers,
pch = 4, cex = 4, lwd = 4)
})
}
ui <- fluidPage(
actionButton("showPlot", "showPlot")
)
server <- function(input, output){
observeEvent(input$showPlot, {
show_alert(
title = "Some Title",
text = tags$div(
uiForModal("test1")
),
html = TRUE,
width = "80%"
)
})
callModule(serverForModal, "test1")
}
runApp(shinyApp(ui, server))
The problem occurs when I try to put the button inside its own module. The code below is my failed attempt at this. I think the problem is something to do with the namespace. In the code below, the button calls the UI with the popup and slider, but the plot doesn't show. So I think the problem is in the server namespace for the plot. Can someone please help me out?
library(shiny)
library(shinyWidgets)
uiForModal <<- function(id) {
print(id)
ns <- NS(id)
print(ns("plot"))
tagList(
fluidRow(
plotOutput(outputId = ns("plot")),
sliderInput(
inputId =ns( "clusters"),
label = "Number of clusters",
min = 2, max = 6, value = 3, width = "100%"
)
)
)
}
serverForModal <<- function(input, output, session) {
output$plot <- renderPlot({
print(head(iris))
plot(Sepal.Width ~ Sepal.Length,
data = iris, col = Species,
pch = 20, cex = 2)
points(kmeans(iris[, 1:2], input$clusters)$centers,
pch = 4, cex = 4, lwd = 4)
})
}
uiForButton <<- function(id) {
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("showPlot"), "showPlot")
)
)
}
serverForButton <<- function(input, output, session, ns) {
observeEvent(input$showPlot, {
show_alert(
title = "Some Title",
text = tags$div(
uiForModal(ns("test2"))
),
html = TRUE,
width = "80%"
)
})
callModule(serverForModal, ns("test2"))
}
ui <- fluidPage(
uiForButton("test1")
)
server <- function(input, output){
callModule(serverForButton, "test1", NS("test1"))
}
runApp(shinyApp(ui, server))
Change
callModule(serverForModal, ns("test2"))
to
callModule(serverForModal, "test2")

Shiny Modules: Handling a list of buttons

I am trying to build an app that relies on a list of buttons created via lapply. I can successfully reference the buttons using observeEvent when I am not working with modularized code. However, when I try to use modules, the observeEvent doesn't work. I suspect it has something to do with how Shiny handles the namespace id's, but despite a couple of days of experimentation, I have not been able to solve the issue.
Below I will post first the non-modularized dummy app that does work (stolen from this other stack overflow question: R Shiny: How to write loop for observeEvent). Then I will share my existing modularized code that does not work.
Working non-modularized code:
library("shiny")
ui <- fluidPage(
fluidRow(
column(
width = 6,
lapply(
X = 1:6,
FUN = function(i) {
sliderInput(inputId = paste0("d", i), label = i, min = 0, max = 10, value = i)
}
)
),
column(
width = 6,
verbatimTextOutput(outputId = "test")
)
)
)
server <- function(input, output){
vals <- reactiveValues()
lapply(
X = 1:6,
FUN = function(i){
observeEvent(input[[paste0("d", i)]], {
vals[[paste0("slider", i)]] <- input[[paste0("d", i)]]
})
}
)
output$test <- renderPrint({
reactiveValuesToList(vals)
})
}
shinyApp(ui = ui, server = server)
Modularized Code that fails:
library(shiny)
slidersUI <- function(id){
ns <- NS(id)
tagList(
fluidRow(
column(
width = 6,
lapply(
X = 1:6,
FUN = function(i) {
sliderInput(inputId = paste0("d", i), label = i, min = 0, max = 10, value = i)
} ),
column(
width = 6,
verbatimTextOutput(outputId = "test")
)
)))
}
slidersServer <- function(input, output, session){
vals <- reactiveValues()
lapply(
X = 1:6,
FUN = function(i){
output$test2 <- renderText(paste0("this is i:", i))
observeEvent(input[[paste0("d", i)]], {
vals[[paste0("slider", i)]] <- input[[paste0("d", i)]]
})
}
)
output$test <- renderPrint({
reactiveValuesToList(vals)
})
}
library("shiny")
ui <- fluidPage(
slidersUI("TheID")
)
server <- function(input, output){
callModule(slidersServer, "TheID")
}
shinyApp(ui = ui, server = server)
Thank you!
You need to wrap your IDs in ns to get the correct namespace. Here is the corrected module ui:
slidersUI <- function(id){
ns <- NS(id)
tagList(
fluidRow(
column(
width = 6,
lapply(
X = 1:6,
FUN = function(i) {
sliderInput(inputId = ns(paste0("d", i)), label = i, min = 0, max = 10, value = i)
} ),
column(
width = 6,
verbatimTextOutput(outputId = ns("test"))
)
)))
}

Shiny Dynamic UI Resetting to Original Values

I have created a dynamic UI with the number of rows of a 'table' defined by a slider. I would like to use the numericInputs from the UI to perform further calculations. In the example below I have tried to calculate a rate from the two numeric inputs, which seems to work when new values are entered but immediately defaults back to the original starting values.
I tried using a button and changing the observe to an observeEvent to calculate the rates which worked to generate the result, but did not stop the numericInputs defaulting back to the starting values.
I have also tried to create the textboxes as a reactive and then call it to renderUI which gives the same 'broken' functionality.
output$groupings <- renderUI({ textboxes() })
textboxes <- reactive ({
I think I need to create vector or datatable to store the inputs so that I can call them later, however I've been unsuccessful so far. My working example is below:
library(shiny)
mod1UI <- function(id) {
ns <- NS(id)
tagList(
sliderInput(inputId = ns("groups"), label = "Number of Rows", min = 1, max = 6, value = 4, step = 1, width = NULL),
hr(),
fluidRow(
column(2,
strong("Speed")),
column(2,
strong("Amount")),
column(2,
strong("Run Rates"))
),
hr(),
uiOutput(ns("textboxes")),
)
}
mod1 <- function(input, output, session, data) {
ns <- session$ns
m <- reactiveValues(x=NULL)
output$textboxes <- renderUI ({
req(input$groups)
lapply(1:input$groups, function(i) {
fluidRow(
column(2,
numericInput(inputId = paste0(session$ns("speed"),i), value = 700, label = NULL, width = 80)
),
column(2,
numericInput(inputId = paste0(session$ns("amount"),i), value = 14, label = NULL, width = 80)
),
column(2,
(m$x[[i]])
)
)
})
})
observe({
lapply(1:input$groups, function(i){
m$x[[i]] <- input[[paste0("speed", i)]] * input[[paste0("amount", i)]] * 60
})
})
}
ui <- fluidPage(
fluidRow(
column(12,
mod1UI("input1"))
)
)
server <- function(input, output, session) {
y <- callModule(mod1, "input1")
}
shinyApp(ui, server)
Your problem is that you render all elements to one output, output$textboxes. Changing the input value of one of your numeric inputs leads to the calculation of a new rate, so the reactive Value m gets updated and the output$textboxes is rerendered.
Below I present you a solution where the different columns are rendered separately; you would have to play with HTML/CSS to display the values nicely. However, if you change the numbers of rows with the slider, all inputs are reset. Therefore I also added a solution where every row is a module that can be added.
library(shiny)
mod1UI <- function(id) {
ns <- NS(id)
tagList(
sliderInput(inputId = ns("groups"), label = "Number of Rows", min = 1, max = 6, value = 4, step = 1, width = NULL),
hr(),
fluidRow(
column(2,
strong("Speed")),
column(2,
strong("Amount")),
column(2,
strong("Run Rates"))
),
hr(),
fluidRow(
column(2,
uiOutput(ns("UI_speed"))),
column(2,
uiOutput(ns("UI_amount"))),
column(2,
uiOutput(ns("rates")))
)
)
}
mod1 <- function(input, output, session, data) {
ns <- session$ns
m <- reactiveValues(x=NULL)
output$UI_speed <- renderUI({
req(input$groups)
lapply(1:input$groups, function(i) {
numericInput(inputId = paste0(session$ns("speed"),i), value = 700, label = NULL, width = 80)
})
})
output$UI_amount <- renderUI({
req(input$groups)
lapply(1:input$groups, function(i) {
numericInput(inputId = paste0(session$ns("amount"),i), value = 14, label = NULL, width = 80)
})
})
output$rates <- renderUI({
req(input$groups)
text <- lapply(1:input$groups, function(i) {
m$x[[i]]
})
HTML(paste0(text, collapse = "<br>"))
})
observe({
lapply(1:input$groups, function(i){
m$x[[i]] <- input[[paste0("speed", i)]] * input[[paste0("amount", i)]] * 60
})
})
}
ui <- fluidPage(
fluidRow(
column(12,
mod1UI("input1"))
)
)
server <- function(input, output, session) {
y <- callModule(mod1, "input1")
}
shinyApp(ui, server)
Every row is a module
You get more flexibility if you have the slider in the main app and then add/remove a module. The module UI now consists of a set of inputs for Speed and Amount and an Output for the Rate. You can use insertUI and removeUI to dynamically control the amount of modules and with this the amount of displayed UI elements.
library(shiny)
mod1UI <- function(id) {
ns <- NS(id)
fluidRow(
id = id,
column(2,
uiOutput(ns("UI_speed"))),
column(2,
uiOutput(ns("UI_amount"))),
column(2,
textOutput(ns("rates")))
)
}
mod1 <- function(input, output, session, data) {
ns <- session$ns
output$UI_speed <- renderUI({
numericInput(inputId = ns("speed"), value = 700, label = NULL, width = 80)
})
output$UI_amount <- renderUI({
numericInput(inputId = ns("amount"), value = 14, label = NULL, width = 80)
})
output$rates <- renderText({
get_rate()
})
get_rate <- reactive({
input$speed * input$amount * 60
})
}
ui <- fluidPage(
fluidRow(
column(12,
sliderInput(inputId = "groups", label = "Number of Rows", min = 1, max = 6, value = 4, step = 1, width = NULL),
hr(),
fluidRow(
column(2,
strong("Speed")),
column(2,
strong("Amount")),
column(2,
strong("Run Rates"))
),
hr(),
tags$div(id = "insert_ui_here")
)
)
)
number_modules <- 4
current_id <- 1
server <- function(input, output, session) {
# generate the modules shown on startup
for (i in seq_len(number_modules)) {
# add the UI
insertUI(selector = '#insert_ui_here',
ui = mod1UI(paste0("module_", current_id)))
# add the logic
callModule(mod1, paste0("module_", current_id))
# update the id
current_id <<- current_id + 1
}
observeEvent(input$groups, {
# add modules
if (input$groups > number_modules) {
for (i in seq_len(input$groups - number_modules)) {
# add the UI
insertUI(selector = '#insert_ui_here',
ui = mod1UI(paste0("module_", current_id)))
# add the logic
callModule(mod1, paste0("module_", current_id))
# update the id
current_id <<- current_id + 1
}
} else {
# remove modules
for (i in seq_len(number_modules - input$groups)) {
# remove the UI
removeUI(selector = paste0("#module_", current_id - 1))
current_id <<- current_id - 1
}
}
# update the number of modules
number_modules <<- input$groups
}, ignoreInit = TRUE)
}
shinyApp(ui, server)

Repeating Shiny Modules using insertUI

I use a shiny module to plot each element (some data) of a list respectively.
The ui creates some Data (DataPack) (a list with so far two elements) by clicking the "Load"-button. The data is then plotted via the module whereas the x-axis range of each module's plot is controlled by the sliderInput of the ui. In addition, each module plots some "analysis" (a running mean) by clicking the module's "Process" button.
Is there a way, for the ui as well as for the server function, to use insertUI in a way that repeats the module depending on the length of the list DataPack but preserving the connectivity between the ui's slider input with each module (thereby avoiding to copy and paste Module_ui in the ui as well as callModule in the server function several times)?
Thanks!
library(shiny)
library(TTR)
Module_ui <- function(id) {
ns <- NS(id)
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, plotOutput(ns("Plot"))))
)
}
Module_Server <- function(input, output, session,
DataPack, AnalysedPack,
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 <- 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))
)
),
Module_ui("Plot_1"),
Module_ui("Plot_2")
)
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)
callModule(Module_Server, "Plot_1",
DataPack = DataPack,
DataSetName = "one",
InputButton_GetData = InputButton_GetData_rx,
xlim = SliderInput_xAxis_rx)
callModule(Module_Server, "Plot_2",
DataPack = DataPack,
DataSetName = "two",
InputButton_GetData = InputButton_GetData_rx,
xlim = SliderInput_xAxis_rx)
}
shinyApp(ui, server)
Inspired by Thomas Roh's article (Link 1, Link 2) as well as this post it works like this:
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)

Keep plots and input values when switching between tabs

I have a shinydashboard app with two different tab panels. Each tab has different input values and both of them generate a graph when an action button is clicked.
Whenever I switch between these tabs, their respective graphs disappear and input values are reset to default.
I want to keep the tabs in their user modified states (i.e keep both graphs and inputs) even when the user decides to switch between the panels.
Code
library(shiny)
library(shinydashboard)
ui <- fluidPage(
dashboardPage(
dashboardHeader(title = "DASHBOARD"),
dashboardSidebar(
uiOutput("mysidebar"),
),
dashboardBody(
tabsetPanel(type = "tabs", id = "tab",
tabPanel("Tab1", fluid = TRUE, value = 1,plotOutput("A")),
tabPanel("Tab2", fluid = TRUE, value = 2, plotOutput("B"))
)
)
)
)
server <- function(input, output, session){
output$mysidebar <- renderUI({
if(input$tab == 1){
tagList(
sliderInput(inputId = "Sample",
label = "Enter Number of Samples:",
min = 1000, max = 100000,
value = 10000),
fluidRow(
column(6,
actionButton(inputId = "b1", label = "Generate"))
)}
if(input$tab == 2){
tagList(
sliderInput(inputId = "Weight",
label = "Enter Weight:",
value = 100),
fluidRow(
column(6,
actionButton(inputId = "b2", label = "Generate"))
)}
p1<- eventReactive(input$b1, {
#creating a dataframe using input "Sample" in tab1 - Rough example
df <- input$Sample
})
output$SA <- renderPlot({
plot(df)
})
p2 <- eventReactive(input$b2, {
#creating a dataframe using input "Weight" in tab2-- Rough example
df2 <- input$Weight
})
output$A <- renderPlot({
plot(p1())
})
output$B <- renderPlot({
plot(p2())
})
}
I'd much rather you use show and hide functionality within shinyjs package like example below, this way the values will be preserved when you switch between the Tabs
library(shiny)
library(shinyjs)
library(shinydashboard)
ui <- fluidPage(
dashboardPage(
dashboardHeader(title = "DASHBOARD"),
dashboardSidebar(
useShinyjs(),
sliderInput("Sample","Enter Number of Samples:",min = 1000, max = 100000,value = 10000),
sliderInput("Weight","Enter Weight:",min = 1, max = 1000,value = 100),
fluidRow(column(6,actionButton("b1","Generate"),actionButton("b2","Generate")))
),
dashboardBody(
tabsetPanel(type = "tabs", id = "tab",
tabPanel("Tab1", fluid = TRUE, value = 1,plotOutput("A")),
tabPanel("Tab2", fluid = TRUE, value = 2, plotOutput("B"))
)
)
)
)
server <- function(input, output, session){
observe({
if(input$tab == 1){
show("Sample")
show("b1")
hide("Weight")
hide("b2")
}
if(input$tab == 2){
hide("Sample")
hide("b1")
show("Weight")
show("b2")
}
})
p1<- eventReactive(input$b1,{
df <- rnorm(input$Sample)
})
output$SA <- renderPlot({
plot(df)
})
p2 <- eventReactive(input$b2,{
df2 <- rnorm(input$Weight)
})
output$A <- renderPlot({plot(p1())})
output$B <- renderPlot({plot(p2())})
}
shinyApp(ui, server)
The following code keeps the plots and inputs, by using reactiveValues.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(dashboardHeader(title = "DASHBOARD"),
dashboardSidebar(
uiOutput("mysidebar")
),
dashboardBody(
tabsetPanel(type = "tabs", id = "tab",
tabPanel("Tab1", value = 1,plotOutput("SA")),
tabPanel("Tab2", value = 2, plotOutput("SA1"))
)
)
)
server <- function(input, output, session){
slider_react <- reactiveValues(b1=10000, b2 = 100)
observe({
if (input$tab == 1){
output$mysidebar <- renderUI({
tagList(
sliderInput(inputId = "Sample",
label = "Enter Number of Samples:",
min = 1000, max = 100000,
# value = 10000),
value = slider_react$b1),
actionButton(inputId = "b1", label = "Generate"))
})
}
if(input$tab == 2){
output$mysidebar <- renderUI({
tagList(
sliderInput(inputId = "Weight",
label = "Enter Weight:",
min=0, max=1000,
# value = 100),
value = slider_react$b2),
actionButton(inputId = "b2", label = "Generate"))
})
}
})
df_react <- reactiveValues(a1=NULL, a2=NULL)
p1<- observeEvent(input$b1, {
#creating a dataframe using input "Sample" in tab1 - Rough example
df <- runif(input$Sample, 0, 100)
slider_react$b1 = input$Sample
df_react$a1 = df
})
p2 <- observeEvent(input$b2, {
#creating a dataframe using input "Weight" in tab2-- Rough example
df2 <- runif(input$Weight, 0, 100)
slider_react$b2 = input$Weight
df_react$a2 = df2
})
output$SA <- renderPlot({
req(df_react$a1)
plot(df_react$a1)
})
output$SA1 <- renderPlot({
req(df_react$a2)
plot(df_react$a2)
})
}
shinyApp(ui, server)

Resources