R Shiny Reactive Plot from List of Lists - r

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"

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

Display table and recompute one column based on sliders

I want to create a small shiny app to explore a scoring function that I am writing for a set of data observations. This is my first shiny app so bear with me.
What I want to show is the data table where one column is computed by a function (let's say f(x) = x^2 + y) where x is another (numeric) column in the table and y should be adjustable with a slider in the sidebar.
I want to make the table reactive, so that as soon as the slider is adjusted, the content that is displayed will be updated. Does anyone have a link to a tutorial (I could not find a similar problem) or a suggestion how to handle this. If so, please let me know!
This is the code I have so far:
library(shiny)
#### INIT ####
x <- 1
y <- 0.5
z <- 2
df <- data.frame(
a=1:10,
b=10:1
)
df['score'] <- df[,x]^y + z
#### UI ####
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
sliderInput("x", "x:",
min = 0, max = ncol(df),
value = 1),
sliderInput("y", "y:",
min = 1, max = 10,
value = 1),
sliderInput("z", "z:",
min = 1, max = 100,
value = 20)
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("df", dataTableOutput("df"))
)
)
)
)
#### SERVER ####
server <- function(input, output) {
sliderValues <- reactive({
df['score'] <- df[,input$x]^input$y + input$z
})
sliderValues()
output$df<- renderDataTable(df)
}
#### RUN ####
shinyApp(ui = ui, server = server)
Just make the data.frame you actually plot reactive. For example
server <- function(input, output) {
calcualtedValues <- reactive({
df['score'] <- df[,input$x]^input$y + input$z
df
})
output$df<- renderDataTable(calcualtedValues())
}
Here the calcualtedValues reactive element returns a new data.frame when the input is updated, and then you actually render that updated data.frame rather than the original data.frame each time.

How to use workspace objects in an R Shiny application

I would like a user to be able to type in the name of a dataframe object and have that object rendered as a formatted data table in a Shiny application.
Here is a toy example. There are two dataframe objects available in the workspace: df1 and df2. When the user types in df1, I would like that dataframe to be rendered. Likewise for df2 or for any other dataframe they have in their workspace.
I suspect I have to do something with environments or scoping or evaluation but I am not sure what.
I have commented in the code where I can hardcode in the built-in mtcars dataset and have that rendered correctly. Now I just want to be able to do the same for any ad-hoc dataframe in a user's workspace.
library(shiny)
set.seed(1234)
x <- sample.int(n = 20)
y <- sample(x = LETTERS, size = 20)
a <- rnorm(n = 20)
b <- sample(x = letters, size = 20)
df1 <- data.frame(x = x, y = y)
df2 <- data.frame(a = a, b = b)
# Define UI ----
ui <- fluidPage(
titlePanel("Using text inputs to select dataframes"),
sidebarLayout(position = "left",
sidebarPanel(width = 5,
textInput("dfInput", h5("Enter name of dataframe"),
value = "")),
mainPanel(width = 6,
h4("Here's your data"),
textOutput("selected_df"),
dataTableOutput("view")
)
)
)
# Define server logic ----
server <- function(input, output, session) {
output$selected_df <- renderText({
paste("You have selected ", input$dfInput)
})
output$view <-
renderDataTable({
input$dfInput # this should render the selected dataframe. If you replace this with mtcars then that dataset is correctly rendered.
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
We are going to get all the dataframes within the global enviriment first and then use get in order to access the object. I changed the textInput to selectInput so you dont need to type anything, potentially making a mistake. Moreover I added the data from datasets package however you should build more test cases to check if the data exists
library(shiny)
set.seed(1234)
x <- sample.int(n = 20)
y <- sample(x = LETTERS, size = 20)
a <- rnorm(n = 20)
b <- sample(x = letters, size = 20)
df1 <- data.frame(x = x, y = y)
df2 <- data.frame(a = a, b = b)
mydataframes <- names(which(unlist(eapply(.GlobalEnv,is.data.frame))))
OpenData <- data()$results[,3]
#Define UI ----
ui <- fluidPage(
titlePanel("Using text inputs to select dataframes"),
sidebarLayout(position = "left",
sidebarPanel(width = 5,
selectInput("dfInput","Select Dataframe",
#choices = mydataframes,
list("Your Datasets" = c(mydataframes),
"R Datasets" = c(OpenData),
selected=NULL))),
mainPanel(width = 6,
h4("Here's your data"),
textOutput("selected_df"),
dataTableOutput("view")
)
)
)
# Define server logic ----
server <- function(input, output, session) {
output$selected_df <- renderText({
paste("You have selected ", input$dfInput)
})
output$view <-
renderDataTable({
as.data.frame(get(input$dfInput)) # this should render the selected dataframe. If you replace this with mtcars then that dataset is correctly rendered.
})
}
# Run the app ----
shinyApp(ui = ui, server = server)

Applying selecting dataset and filtering in R shiny

I've this problem. I'm starting to learn shiny and I can't figure out how to use a filter on a dataset derived from another shiny selector.
In this particular case I would like to have one filter that works for any dataset that is selected at the first step.
I want to filter the dataset according to the column C, in particular I want to visualize only the rows with C > 1.
I'll report the code:
library(shiny)
set.seed(1)
rock <- data.frame(unif = runif(100, -1, 1),
norm = rnorm(100, 0, 2),
pois = rpois(100, 1))
paper <- data.frame(unif = runif(100, -2, 2),
norm = rnorm(100, 0, 4),
pois = rpois(100, 2))
scissor <- data.frame(unif = runif(100, -3, 3),
norm = rnorm(100, 0, 6),
pois = rpois(100, 3))
# Define UI for dataset viewer application
ui <- shinyUI(pageWithSidebar(
# Application title
headerPanel("Shiny Text"),
# Sidebar with controls to select a dataset and specify the number
# of observations to view
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "paper", "scissor")),
sliderInput("range", "Range:",
min = 0, max = 10,
value = c(0.5,5)),
numericInput("obs", "Number of observations to view:", 20)
),
# Show an HTML table with the requested
# number of observations
mainPanel(
tableOutput("view")
)
))
# Define server logic required to summarize and view the selected dataset
server <- shinyServer(function(input, output) {
# Return the requested dataset
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"paper" = paper,
"scissor" = scissor)
})
#Creating a data frame based on inputs
####?????####
# Show the first "n" observations
output$view <- renderTable({
head(datasetInput(), n = input$obs)
})
})
shinyApp(ui = ui, server = server)
My problem is what to put instead of ####?????#### in the server part.
I hope you can help me.
Something like this?
library(shiny)
set.seed(1)
rock <- data.frame(unif = runif(100, -1, 1),
norm = rnorm(100, 0, 2),
pois = rpois(100, 1))
paper <- data.frame(unif = runif(100, -2, 2),
norm = rnorm(100, 0, 4),
pois = rpois(100, 2))
scissor <- data.frame(unif = runif(100, -3, 3),
norm = rnorm(100, 0, 6),
pois = rpois(100, 3))
# Define UI for dataset viewer application
ui <- shinyUI(pageWithSidebar(
# Application title
headerPanel("Shiny Text"),
# Sidebar with controls to select a dataset and specify the number
# of observations to view
sidebarPanel(
selectInput("dataset", "Choose a dataset:",
choices = c("rock", "paper", "scissor")),
sliderInput("range", "Range:",
min = 0, max = 10,
value = c(0.5,5)),
numericInput("obs", "Number of observations to view:", 20)
),
# Show an HTML table with the requested
# number of observations
mainPanel(
tableOutput("view")
)
))
# Define server logic required to summarize and view the selected dataset
server <- shinyServer(function(input, output) {
# Return the requested dataset
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"paper" = paper,
"scissor" = scissor)
})
#Creating a data frame based on inputs
seconddata <- reactive({
d <- datasetInput()
d[d[,3] >= input$range[1] & d[,3] <= input$range[2],]
})
####?????####
# Show the first "n" observations
output$view <- renderTable({
head(seconddata(), n = input$obs)
})
})
shinyApp(ui = ui, server = server)

Shiny renderUI with multiple inputs

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)

Resources