So I have the following shiny app, I am trying to write different functions so I don't have to write repeated lines but I'm getting stuck with updating the scores table in the scores tab. I'm getting the following error when I run the code: Warning: Error in [[: Can't read output 'score_q2ii'.
library(shiny);library(stringr);library(dplyr)
questions_df <- data.frame(
tab = c(rep("Tab1", 2), rep("Tab2", 2)),
id = c("q1i", "q1ii", "q2i", "q2ii"),
question = c("Question 1", "Question 1", "Question 2", "Question 2"),
part = c("i", "ii", "i", "ii"),
choices = c("1,2,3", "1,2", "1,2", "1,2"),
stringsAsFactors = FALSE
)
# Split the questions data frame based on the tab
questions_split <- split(questions_df, questions_df$tab)
# UI
ui <- fluidPage(
titlePanel("Customized Survey using Data Frame"),
tabsetPanel(
tabPanel("Tab1",
uiOutput("questions_ui_Tab1"),
textAreaInput("feedback_Tab1", "Additional feedback:", "", width = "100%", height = "100px"),
actionButton("submit_Tab1", "Submit Tab1 Answers")
),
tabPanel("Tab2",
uiOutput("questions_ui_Tab2"),
textAreaInput("feedback_Tab2", "Additional feedback:", "", width = "100%", height = "100px"),
actionButton("submit_Tab2", "Submit Tab2 Answers")
),
tabPanel("Score Table", tableOutput("score_table"))
)
)
# Server
server <- function(input, output, session) {
# Reactive value to store scores and feedbacks
scores <- reactiveVal(data.frame(id = questions_df$id, score = numeric(nrow(questions_df)), feedback = "", stringsAsFactors = FALSE))
render_question_ui <- function(tab) {
output[[paste0("questions_ui_", tab)]] <- renderUI({
question_list <- lapply(split(questions_split[[tab]], questions_split[[tab]]$question), generate_ui)
do.call(tagList, question_list)
})
}
render_question_ui("Tab1")
render_question_ui("Tab2")
generate_ui <- function(question_subset) {
tags$div(
h3(unique(question_subset$question)),
tags$ul(
lapply(1:nrow(question_subset), function(i) {
tags$li(
paste0("Part ", question_subset$part[i], ") "),
radioButtons(question_subset$id[i], NULL,
choices = strsplit(question_subset$choices[i], ",")[[1]],
selected = NULL),
if(question_subset$part[i]!='i') {
tags$div("Requires evidence?",
selectInput(paste0("e", question_subset$id[i]), NULL,
choices = c("No" = 1, "Yes" = 2, "Partially Accepted" = 1.5),
selected = NULL),
tags$br()
)
},
"Score for this part: ", textOutput(paste0("score_", question_subset$id[i]))
)
})
)
)
}
lapply(1:nrow(questions_df), function(i) {
observe({
evidence_input<-input[[paste0("e", questions_df$id[i])]]
level_input <- as.numeric(input[[questions_df$id[i]]])
output[[paste0("score_", questions_df$id[i])]] <- renderText({
if (questions_df$part[i] == "i") {
level_input * 0.5
} else {
level_input *10* as.numeric(evidence_input)
}
})
current_scores <- scores()
current_scores[current_scores$id == questions_df$id[i], "score"] <- as.numeric(output[[paste0("score_", questions_df$id[i])]]())
scores(current_scores)
})
})
# Render the table
output$score_table <- renderTable({
scores()
}, rownames = TRUE)
}
# Run the app
shinyApp(ui = ui, server = server)
Your issue seems to be this line: current_scores[current_scores$id == questions_df$id[i], "score"] <- as.numeric(output[[paste0("score_", questions_df$id[i])]]())
A work around is shown below.
questions_df <- data.frame(
tab = c(rep("Tab1", 2), rep("Tab2", 2)),
id = c("q1i", "q1ii", "q2i", "q2ii"),
question = c("Question 1", "Question 1", "Question 2", "Question 2"),
part = c("i", "ii", "i", "ii"),
choices = c("1,2,3", "1,2", "1,2", "1,2"),
stringsAsFactors = FALSE
)
# Split the questions data frame based on the tab
questions_split <- split(questions_df, questions_df$tab)
# UI
ui <- fluidPage(
titlePanel("Customized Survey using Data Frame"),
tabsetPanel(
tabPanel("Tab1",
uiOutput("questions_ui_Tab1"),
textAreaInput("feedback_Tab1", "Additional feedback:", "", width = "100%", height = "100px"),
actionButton("submit_Tab1", "Submit Tab1 Answers")
),
tabPanel("Tab2",
uiOutput("questions_ui_Tab2"),
textAreaInput("feedback_Tab2", "Additional feedback:", "", width = "100%", height = "100px"),
actionButton("submit_Tab2", "Submit Tab2 Answers")
),
tabPanel("Score Table", tableOutput("score_table"))
)
)
# Server
server <- function(input, output, session) {
# Reactive value to store scores and feedbacks
scores <- reactiveValues(df = data.frame(id = questions_df$id, score = numeric(nrow(questions_df)), feedback = "", stringsAsFactors = FALSE))
lapply(1:nrow(questions_df), function(i) {
observe({
evidence_input<-input[[paste0("e", questions_df$id[i])]]
level_input <- as.numeric(input[[questions_df$id[i]]])
if (questions_df$part[i] == "i") {
mylevel <- level_input * 0.5
} else {
mylevel <- level_input *10* as.numeric(evidence_input)
}
if (!is.null(input[[questions_df$id[i]]])){
output[[paste0("score_", questions_df$id[i])]] <- renderText({
mylevel
})
current_scores <- scores$df
# current_scores[current_scores$id == questions_df$id[i], "score"] <- as.numeric(output[[paste0("score_", questions_df$id[i])]]())
current_scores[current_scores$id == questions_df$id[i], "score"] <- mylevel
scores$df <- current_scores
}
})
})
render_question_ui <- function(tab) {
output[[paste0("questions_ui_", tab)]] <- renderUI({
question_list <- lapply(split(questions_split[[tab]], questions_split[[tab]]$question), generate_ui)
do.call(tagList, question_list)
})
}
render_question_ui("Tab1")
render_question_ui("Tab2")
generate_ui <- function(question_subset) {
tags$div(
h3(unique(question_subset$question)),
tags$ul(
lapply(1:nrow(question_subset), function(i) {
tags$li(
paste0("Part ", question_subset$part[i], ") "),
radioButtons(question_subset$id[i], NULL,
choices = strsplit(question_subset$choices[i], ",")[[1]],
selected = NULL),
if(question_subset$part[i]!='i') {
tags$div("Requires evidence?",
selectInput(paste0("e", question_subset$id[i]), NULL,
choices = c("No" = 1, "Yes" = 2, "Partially Accepted" = 1.5),
selected = NULL),
tags$br()
)
},
"Score for this part: ", textOutput(paste0("score_", question_subset$id[i]))
)
})
)
)
}
# Render the table
output$score_table <- renderTable({
scores$df
}, rownames = TRUE)
}
# Run the app
shinyApp(ui = ui, server = server)