Trouble with Reactive Dataframes in Shiny - r

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

Related

R Shiny app seems to hang when generating data

Colleagues,
I'm creating a Shiny app that can generate a data set with user-defined properties. The intended data-generation function can take some time, so I've substituted a very simple one.
My problem is that the app seems to just hang, or nothing happens at all, when I hit the GO button.
DEBUG in Rstudio shows nothing, and reactlog also gives no information.
Similar questions on this stackoverflow forum are more than 8 years old, and suggestions don't seem to work either.
I'm sure the solution is head-slapping simple but, right now, I'm lost.
Any suggestions from those more knowledgeable than this Shiny newbie?
## generate data set with user-defined parameters
## load libraries
library(shiny)
library(ggplot2)
library(DT)
##
options(shiny.reactlog = TRUE)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Synthesise data"),
# Sidebar
sidebarLayout(
sidebarPanel(
## Sample size
numericInput("sample_n", "Sample size", 30,
min = 10, max = 300, step = 1
),
h4("Desired scale moments"),
numericInput("target_mean", "Target mean", 4),
numericInput("target_sd", "Target st dev", 1),
hr(style = "border-top: 1px solid #000000;"),
actionButton("goButton", "Go!"),
actionButton("goChart", "show chart"),
),
mainPanel(
h4("generated data"),
# table of generated data
DT::dataTableOutput("mytable"),
# Show a plot of the generated distribution
plotOutput("resultPlot")
)
)
)
# Define server logic
server <- function(input, output) {
mytable <- reactive(input$goButton, {
## substituting data-gen function that can take some time
mydata <- rnorm(sample_n, target_mean, target_sd) |>
data.frame()
colnames(mydata) <- "scale"
# saveRDS(mydata, file = "generatedData.RDS")
output$mytable <- DT::renderDataTable(DT::datatable({
mydata
}))
})
myplot <- eventReactive(input$goChart, {
output$resultPlot <- renderPlot({
ggplot(mydata, aes(x = scale)) +
geom_density()
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
Few code errors here :
forgot input$ when using sample_n, target_mean and target_sd in server
put some output definition inside eventReactive or reactive is a terrible habit
reactive is not used like you did. EventReactive is what you needed here.
Here is a corrected version of you code
library(shiny)
library(ggplot2)
library(DT)
ui <- fluidPage(
titlePanel("Synthesise data"),
sidebarLayout(
sidebarPanel(
numericInput("sample_n", "Sample size", 30,
min = 10, max = 300, step = 1
),
h4("Desired scale moments"),
numericInput("target_mean", "Target mean", 4),
numericInput("target_sd", "Target st dev", 1),
hr(style = "border-top: 1px solid #000000;"),
actionButton("goButton", "Go!"),
actionButton("goChart", "show chart"),
),
mainPanel(
h4("generated data"),
DT::dataTableOutput("mytable"),
plotOutput("resultPlot")
)
)
)
server <- function(input, output) {
mydata <- eventReactive(input$goButton, {
mydata <- data.frame(scale = rnorm(input$sample_n, input$target_mean, input$target_sd))
return(mydata)
})
output$mytable <- DT::renderDataTable(DT::datatable(
mydata()
))
output$resultPlot <- renderPlot({
input$goChart
isolate(ggplot(mydata(), aes(x = scale)) +
geom_density())
})
}
shinyApp(ui = ui, server = server)

Why Is my R Shiny app not displaying properly?

I am clearly missing something here, but I am pretty new to Shiny apps (I have only every made a couple of them before), and I'm still learning the ropes of them.
This app (which will run on its own) works for the input side (a slider and a text input), but the output (which is supposed to be a table) will not display.
Here is the code:
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("CHD Risk Calculator"),
sidebarLayout(
sidebarPanel(
sliderInput("BMI",
"Your BMI (kg/m^2 OR (703*lbs)/in^2):",
min = 10,
max = 70,
value = 24),
textInput("Age",
"Your Age:")
),
mainPanel(
tableOutput("")
)
)
)
server <- function(input, output) {
inputdata <- reactive({
data <- data.frame(
MyBMI = as.integer(input$BMI),
MyAge = as.integer(input$age))
data
})
output$result <- renderTable({
data = inputdata()
chdrisk = -6.293 + (0.0292*data$BMI) + (0.07409*data$age)
resultTable = data.frame(
Result = "Your risk of Coronary Heart Disease (CHD) is",
Risk = chdrisk)
resultTable
})
}
# Run the application
shinyApp(ui = ui, server = server)
What am I missing here?
Thank you!
You have a few things going on here
Your tableOutput() has been given outputID=""; change this to "result"
Your inputs for the slider and the text are called BMI and Age, but in the reactive, you refer to them as BMI and age
The data frame in the reactive has two columns, MyBMI and MyAge, but later, you refer to them like this: data$BMI and data$age
Here is a corrected version
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("CHD Risk Calculator"),
sidebarLayout(
sidebarPanel(
sliderInput("BMI",
"Your BMI (kg/m^2 OR (703*lbs)/in^2):",
min = 10,
max = 70,
value = 24),
textInput("Age",
"Your Age:")
),
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
inputdata <- reactive({
data <- data.frame(
MyBMI = as.integer(input$BMI),
MyAge = as.integer(input$Age))
data
})
output$result <- renderTable({
data = inputdata()
chdrisk = -6.293 + (0.0292*data$MyBMI) + (0.07409*data$MyAge)
resultTable = data.frame(
Result = "Your risk of Coronary Heart Disease (CHD) is",
Risk = chdrisk)
resultTable
})
}
# Run the application
shinyApp(ui = ui, server = server)

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)

Generate data.frame in Shiny with a n number of vectors using an input

I´m having some trouble to understand why "testTable2" is not working (see code below), while there is no problem if I add the values manually to the data frame. Please have a look and let me know where am I messing up or point me in the right direction. Many thanks!
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("test"),
# Sidebar
sidebarLayout(
sidebarPanel(
sliderInput("n",
"Number",
min = 1,
max = 10,
value = 5)
),
# Show table
mainPanel(
tableOutput("testTable1"),
tableOutput("testTable2")
)
)
)
# Define server logic
server <- function(input, output) {
#generate some vectors using input$n
vec1<-reactive({
rnorm(input$n,mean=0,sd=1)
})
vec2<-reactive({
rnorm(input$n,mean=1,sd=1)
})
vec3<-reactive({
rnorm(input$n,mean=10,sd=0.5)
})
vec4<-reactive({
rnorm(input$n,mean=3,sd=5)
})
vec5<-reactive({
rnorm(input$n,mean=-1,sd=2)
})
#create a table manually
output$testTable1<-renderTable({
data.frame(vec1(),vec2(),vec3(),vec4(),vec5())
})
#add vectors to a table using an input
output$testTable2<-renderTable({
data.frame(sapply(paste0("vec",1:input$n),get()))
})
}
# Run the application
shinyApp(ui = ui, server = server)
To dynamically access reactive functions you can use -
output$testTable2<-renderTable({
data.frame(sapply(paste0("vec",1:input$n),function(x) get(x)()))
})
Complete app code -
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("test"),
# Sidebar
sidebarLayout(
sidebarPanel(
sliderInput("n",
"Number",
min = 1,
max = 10,
value = 5)
),
# Show table
mainPanel(
tableOutput("testTable1"),
tableOutput("testTable2")
)
)
)
# Define server logic
server <- function(input, output) {
#generate some vectors using input$n
vec1<-reactive({
rnorm(input$n,mean=0,sd=1)
})
vec2<-reactive({
rnorm(input$n,mean=1,sd=1)
})
vec3<-reactive({
rnorm(input$n,mean=10,sd=0.5)
})
vec4<-reactive({
rnorm(input$n,mean=3,sd=5)
})
vec5<-reactive({
rnorm(input$n,mean=-1,sd=2)
})
#create a table manually
output$testTable1<-renderTable({
data.frame(vec1(),vec2(),vec3(),vec4(),vec5())
})
#add vectors to a table using an input
output$testTable2<-renderTable({
data.frame(sapply(paste0("vec",1:input$n),function(x) get(x)()))
})
}
# Run the application
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