Shiny renderUI with multiple inputs - r

My Shiny App has multiple inputs that depend on the number of variables used. A simplified version, though not working, is below. I was able to get the UI to update based upon the numericInput using a function called Make.UI which I used to make uiOutput, but getting the inputs back into the server is beyond my Shiny skill set! Any suggestions would be greatly appreciated.
gwynn
library(shiny)
D = matrix(runif(400), nrow = 20)
colnames(D) = labs = sapply(1:20, function(i) {paste0("col",i)})
# Define UI for application that summarises data
ui <- fluidPage(
# Application title
titlePanel("Summaries"),
# Select columns to get fed into summary
tabsetPanel(
tabPanel("Matching Variables Info",
sidebarPanel(
numericInput("NoVars","No. of variables to summarize",
value = 3, min = 2, max = dim(D)[2]),
uiOutput("VarsInput")
),
# Show summaries of columns choosen above
mainPanel(
verbatimTextOutput("dataInfo")
)
)
)
)
# Define the server code
server <- function(input, output){
Make.UI <- function(NoV){
C = sapply(1:NoV, function(i){paste0("cols",i)})
L = sapply(1:NoV, function(i){paste0("label",i)})
output = tagList()
for(i in seq_along(1:NoV)){
output[[i]] = tagList()
output[[i]][[1]] = selectInput(C[i], "Variable to summarize:", labs)
output[[i]][[2]] = textInput(L[i], label = "Label for variable:",
value = "Label for variable Here")
} ## for loop
output
} # closes Make.UI function
K <- reactive({
input$NoVars
})
output$VarsInput <- renderUI({
Make.UI(K())
})
output$dataInfo <- renderPrint({
C <- sapply(1:K(), function(i) {input[[paste0("cols",i)]]})
## the code in the line above doesn't work
summary(D[, C()])
})
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)

Like I wrote in the first comment, I am unsure about the Make.UI()function. If you really want to keep it as a seperate function you should make it reactive. Or just use it as I did in the code below.
Moreover, in output$dataInfo <- renderPrint({ C is not a reactive() function so you would need to remove brackets there.
library(shiny)
D = matrix(runif(400), nrow = 20)
colnames(D) = labs = sapply(1:20, function(i) {paste0("col",i)})
# Define UI for application that summarises data
ui <- fluidPage(
# Application title
titlePanel("Summaries"),
# Select columns to get fed into summary
tabsetPanel(
tabPanel("Matching Variables Info",
sidebarPanel(
numericInput("NoVars","No. of variables to summarize",
value = 3, min = 2, max = dim(D)[2]),
uiOutput("VarsInput")
),
# Show summaries of columns choosen above
mainPanel(
verbatimTextOutput("dataInfo")
)
)
)
)
# Define the server code
server <- function(input, output){
K <- reactive({
input$NoVars
})
output$VarsInput <- renderUI({
NoV = K()
C = sapply(1:NoV, function(i){paste0("cols",i)})
L = sapply(1:NoV, function(i){paste0("label",i)})
output = tagList()
for(i in seq_along(1:NoV)){
output[[i]] = tagList()
output[[i]][[1]] = selectInput(C[i], "Variable to summarize:", labs)
output[[i]][[2]] = textInput(L[i], label = "Label for variable:",
value = "Label for variable Here")
}
output
})
output$dataInfo <- renderPrint({
C <- sapply(1:K(), function(i) {input[[paste0("cols",i)]]})
## the code in the line above doesn't work
summary(D[, C])
})
}
# Return a Shiny app object
shinyApp(ui = ui, server = server)

Related

Trouble with Reactive Dataframes in Shiny

Here's the minimal reproducible example:
# This is a Shiny web application.
library(shiny)
# UI for application
ui <- fluidPage(
# Application title
titlePanel("A Problematic App - Part 2"),
# Sidebar with two slider inputs
sidebarLayout(
sidebarPanel(
sliderInput(
"NoOfSamples",
label = "Sample Size",
value = 100,
min = 10,
max = 150,
step = 10,
width = "40%"
),
sliderInput(
"KeepSamples",
label = "Samples to Keep",
value = 50,
min = 10,
max = 150,
step = 10,
width = "40%"
)
),
# Shows the resulting table
mainPanel(
tableOutput("table1"),
tableOutput("table2")
)
)
)
# Server logic
server <- function(input, output) {
# Using the iris dataset
datExpr <- as.data.frame(iris)
n = reactive({
input$NoOfSamples
})
datExpr0 <- reactive({
datExpr[1:n(), ]
})
output$table1 <- renderTable({
datExpr0()
})
# Displays the first table correctly if the rest is commented out
keepSamples = reactive({
input$KeepSamples
})
datExpr <- reactive({
datExpr0()[keepSamples(),]
})
output$table2 <- renderTable({
datExpr()
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have created live examples for demonstration.
With the second part of the program commented out.
The complete program. [Shinyapps.io] is supressing the error details, so attached is a screenshot of a local run.
The error is object of type 'closure' is not subsettable. While many questions (and answers) regarding this error exist, I am yet to find any explaining the behaviour demonstrated above.
Why does this happen?
The normal (script-equivalent) works as expected.
datExpr <- as.data.frame(iris)
n = 50
datExpr0 <- datExpr[1:n, ]
datExpr0
keepSamples = 10
datExpr <- datExpr0[keepSamples,]
datExpr
Is there a way to achieve what the normal script does in the shiny app?
The issue is that you have both a dataframe and a reactive in your app called datExpr. Simply rename one of both (I decided for the reactive).
EDIT There is of course nothing special about that in shiny.
A simple example to illustrate the issue:
datExpr <- iris
datExpr <- function() {}
datExpr[1:2]
#> Error in datExpr[1:2]: object of type 'closure' is not subsettable
And you see that we get the famous object of type 'closure' is not subsettable error too. The general issue or lesson is that in R you can't have two different objects with the same name at the same time.
# This is a Shiny web application.
library(shiny)
# UI for application
ui <- fluidPage(
# Application title
titlePanel("A Problematic App - Part 2"),
# Sidebar with two slider inputs
sidebarLayout(
sidebarPanel(
sliderInput(
"NoOfSamples",
label = "Sample Size",
value = 100,
min = 10,
max = 150,
step = 10,
width = "40%"
),
sliderInput(
"KeepSamples",
label = "Samples to Keep",
value = 50,
min = 10,
max = 150,
step = 10,
width = "40%"
)
),
# Shows the resulting table
mainPanel(
tableOutput("table1"),
tableOutput("table2")
)
)
)
# Server logic
server <- function(input, output) {
# Using the iris dataset
datExpr <- as.data.frame(iris)
n = reactive({
input$NoOfSamples
})
datExpr0 <- reactive({
datExpr[1:n(), ]
})
output$table1 <- renderTable({
datExpr0()
})
# Displays the first table correctly if the rest is commented out
keepSamples = reactive({
input$KeepSamples
})
datExpr1 <- reactive({
datExpr0()[keepSamples(),]
})
output$table2 <- renderTable({
datExpr1()
})
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:3648

R Shiny Reactive Plot from List of Lists

I'm building a basic R Shiny app, and have a list that contains individual lists, each storing a dataframe and a value. I've included sample data to demonstrate my list of lists. Within my app I am trying to have one select option (a dropdown menu that says "List 1", List 2", etc) and then have the main panel in the app display a boxplot of the dataframe (x and y) and a text output of the value stored in the list that was selected.
I'm having trouble with the ability to make the outputs (both plot and text) reactive to the input and display data from the selected list.
I've put my code of what I have so far below.
## Example Data
list_a <- list(df = data.frame(x = rnorm(n = 10, mean = 5, sd = 2),
y = rnorm(n = 10, mean = 7, sd = 3)),
value = "a")
list_b <- list(df = data.frame(x = rnorm(n = 10, mean = 20, sd = 5),
y = rnorm(n = 10, mean = 13, sd = 7)),
value = "b")
list_c <- list(df = data.frame(x = rnorm(n = 10, mean = 12, sd = 4),
y = rnorm(n = 10, mean = 10, sd = 4)),
value = "c")
mylist <- list(list_a, list_b, list_c)
## Packages
library(tidyverse)
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Shiny App"),
## Panel with selectInput dropdown and output options
pageWithSidebar(
headerPanel('Data'),
sidebarPanel(
selectInput('data', 'Dataset',
choices = c("1" = list_a, "2" = list_b, "3" = list_c)),
),
mainPanel(
plotOutput('plot1'),
textOutput('text1')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
## Boxplot with 'DF' from selected list
output$plot1 <- renderPlot({
reactivedata <- boxplot(input$data)
boxplot(reactivedata$df)
})
## Text output from 'value' stored in list
output$text1 <- renderText({
reactivetext <- print(input$data)
print(reactivetext$value)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Main issue with your code that you used your raw lists for the choices argument. Additionally I added a reactive to pick the right list according to the user's input:
set.seed(123)
library(tidyverse)
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Shiny App"),
## Panel with selectInput dropdown and output options
pageWithSidebar(
headerPanel("Data"),
sidebarPanel(
selectInput("data", "Dataset",
choices = c("list_a" = 1, "list_b" = 2, "list_c" = 3)
),
),
mainPanel(
plotOutput("plot1"),
textOutput("text1")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
reactivedata <- reactive({
mylist[[as.integer(input$data)]]
})
## Boxplot with 'DF' from selected list
output$plot1 <- renderPlot({
boxplot(reactivedata()$df)
})
## Text output from 'value' stored in list
output$text1 <- renderText({
print(reactivedata()$value)
})
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:4502
#> [1] "a"

Successive calculations in Shiny

I want to make a shiny app that can make successive calculations based on user input. Something like this:
a <- input$inputa
b <- a+2
c <- b-3
d <- c*4
e <- d/5
So the user would choose input a, and the shiny app would do the rest and show values a, b, c, d, e.
I managed to do it if the app always makes the entire calculations based on a. But if I try to create value b and call it, it breaks.
The following code works and shows the final result as it should, but I'm sure it can be improved upon, removing repetitions:
# UI
ui <- fluidPage(
# Application title
titlePanel("Doing algebra"),
# Sidebar with numeric input
sidebarLayout(
sidebarPanel(
numericInput("inputa",
"Input a:",
min = 0,
max = 100,
value = 20,
step=1)
),
# Show results of successive calculations
mainPanel(
verbatimTextOutput("output1"),
h4("+2"),
verbatimTextOutput("output2"),
h4("-3"),
verbatimTextOutput("output3"),
h4("*4"),
verbatimTextOutput("output4"),
h4("/5"),
verbatimTextOutput("output5")
)
)
)
# server
server <- function(input, output) {
output$output1 <- renderText({ input$inputa })
output$output2 <- renderText({ input$inputa+2 })
output$output3 <- renderText({ ( input$inputa+2)-3 })
output$output4 <- renderText({ (( input$inputa+2)-3)*4 })
output$output5 <- renderText({ ((( input$inputa+2)-3)*4)/5 })
}
shinyApp(ui, server)
The last bit, (((input$inputa+2)-3)*4)/5, looks terrible and is terrible. Can I make a shiny app that creates a value in one equation and uses that value in the next equation?
Thanks!
You can store the data in a reactive expression.
ui <- fluidPage(
# Application title
titlePanel("Doing algebra"),
# Sidebar with numeric input
sidebarLayout(
sidebarPanel(
numericInput("inputa",
"Input a:",
min = 0,
max = 100,
value = 20,
step=1)
),
# Show results of successive calculations
mainPanel(
verbatimTextOutput("output1"),
h4("+2"),
verbatimTextOutput("output2"),
h4("-3"),
verbatimTextOutput("output3"),
h4("*4"),
verbatimTextOutput("output4"),
h4("/5"),
verbatimTextOutput("output5")
)
)
)
# server
server <- function(input, output) {
rv <- reactive({
tibble::tibble(a = input$inputa, b = a + 2, c = b-3, d = c*4, e = d/5)
})
output$output1 <- renderText({rv()$a})
output$output2 <- renderText({rv()$b})
output$output3 <- renderText({rv()$c})
output$output4 <- renderText({rv()$d})
output$output5 <- renderText({rv()$e})
}
shinyApp(ui, server)

Using dynamic input from tagList to renderTable in Shiny

What I am trying to do is have the user specify the number of groups then, based on the number of groups specified, the UI generates a numericInput for each group. Then I want to use that value to do some other operations (in this example, I'm making a table of means). Using this example, I was able to make it return some text, but not use that label as input for anything else.
When I try to use that information (i.e., as reactive conductor), I get a "replacement has length zero" error. It seems shiny is not recognizing the updated UI. I know it probably has something to do with using reactive, but I can't figure out why it's not working. Here's my code:
library(shiny)
library(purrr)
# functions ---------------------------------------------------------------
## generic function that creates an input from an i
make_list = function(i, idname, labelname){
idname <- paste(idname, i, sep = "")
div(style="display: inline-block;vertical-align:top; width: 45%;",
numericInput(idname, labelname, 0))
}
## make function that can be used within a loop
list_loop = function(i) {
make_list(i, "mean", "Mean of Group ")
}
# UI ----------------------------------------------------------------------
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("A Test Page"),
sidebarLayout(
sidebarPanel(width = 8,
#### UI for groups
numericInput("groups", "How many groups?", 4),
hr(),
uiOutput("inputMean")),
# Main panel for displaying outputs ----
mainPanel(width = 4,
h3("Data Preview"),
#textOutput("inputValues"),
tableOutput("table"))
)
)
# Server ------------------------------------------------------------------
# Define server logic required to draw a histogram
server = function(input, output) {
## loop through # of groups for all i and make the UI
## this is passed back to the UI
observeEvent(input$groups,
{
output$inputMean = renderUI(
{
mean_list <- 1:input$groups %>% map(~list_loop(.x))
do.call(tagList, mean_list)
}
)
}
)
## return the inputnames
## This WORKS
output$inputValues <- renderText({
paste(lapply(1:input$groups, function(i) {
inputName <- paste("mean", i, sep = "")
input[[inputName]]
}))
})
make_table = reactive({
### prepopulate a table
d = data.frame(group = 1:input$groups)
d$means = NA
paste(lapply(1:input$groups, function(i) {
inputName <- paste("mean", i, sep = "")
# this fails because input is NULL at this point
d$means[i] = input[[inputName]]
}))
d
})
output$table <- renderTable({
make_table()
})
}
# Run the application
shinyApp(ui = ui, server = server)
If you replace your make_table with the following, it works.
I added a req that checks if all the input is present, so it won't throw errors anymore. Then, I filled d$means using the lapply you created.
make_table = reactive({
req(input$groups, input[[paste("mean", input$groups, sep = "")]])
### prepopulate a table
d = data.frame(group = 1:input$groups)
d$means = lapply(1:input$groups, function(i) {
inputName <- paste("mean", i, sep = "")
# this fails because input is NULL at this point
input[[inputName]]
})
d
})

How do I access a variable from another output

I'm trying to build my first Shiny app at the moment and and having some issues. Is it possible to get access to a variable from a different output object? I'm trying to print the table in the first tab and show the individual plots on separate tabs, even better if I can show all 3 on 1 tab.
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Table", tableOutput("dataTable")),
tabPanel("xy Chart", plotOutput("xyChart")),
tabPanel("yz Chart", plotOutput("yzChart"))
)
)
)
)
)
server <- function(input, output) {
output$dataTable <- renderTable({
x <- rnorm(100, mean = 1)
y <- rnorm(100, mean = 0)
z <- rnorm(100, mean = 0.5)
dataTable <- cbind(x,y,z)
})
output$xyChart <- renderPlot({
plot(x,y)
})
If you haven't already, would take a look at the shiny tutorials available.
Instead of including your data in a single output inside of server, you could declare these variables elsewhere. Since you are creating a shiny app, you might be interested in changing these variables, and having the other outputs automatically update.
If that is true, you might want to use reactiveValues or create a reactive function.
Here's an example below. By using reactiveValues, when you read a value from it (like x, y, or z) the calling expression takes a reactive dependency on that value (and will update with changes made to it). Whenever you modify those values, it will notify all reactive functions that depend on that value.
library(shiny)
ui <- fluidPage(
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plot", plotOutput("plot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table"))
)
)
)
server <- function(input, output) {
my_data <- reactiveValues(
x = rnorm(100, mean = 1),
y = rnorm(100, mean = 0),
z = rnorm(100, mean = 0.5)
)
output$table <- renderTable({
data.frame(my_data$x, my_data$y, my_data$z)
})
output$plot <- renderPlot({
plot(my_data$x, my_data$y)
})
output$summary <- renderText({
"Summary Goes Here"
})
}
shinyApp(ui = ui, server = server)
And if you want all 3 on one panel (as described in comments), use this for your ui:
ui <- fluidPage(
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("All 3",
plotOutput("plot"),
verbatimTextOutput("summary"),
tableOutput("table")
)
)
)
)
If you want to include your input$nRV (as mentioned in comments), use a reactive expression, and call it as my_data():
server <- function(input, output) {
my_data <- reactive({
a = rnorm(input$nRV, mean = 2)
b = rnorm(input$nRV, mean = 5)
x = rnorm(input$nRV, mean = 3)
y = rnorm(input$nRV, mean = 0)
z = rnorm(input$nRV, mean = 0.5)
data.frame(a, b, x, y, z)
})
output$table <- renderTable({ data.frame(my_data()$x, my_data()$y, my_data()$z)
})
output$plot <- renderPlot({ plot(my_data()$x, my_data()$y) })
}

Resources