闪亮数据 table 由用户在单选按钮上输入填充
Shiny data table populated by user input on radio buttons
我是 Shiny 的新手，正在尝试创建一个主面板是选项卡面板的应用程序。第一个选项卡是条件面板（这些由 'criteria' 侧面板 selection 决定），第二个选项卡应该是 table 代表最高用户-selected每个问题的条件面板中的单选按钮选项（例如，如果 select 'Option 1' 用于 'Question 1'（条件面板 1），'Option 2' 用于'问题 2（条件面板，选项 2)，这应该显示问题 1 - 2。当用户在侧面板上移动不同的标准时，需要保留此信息。我遇到的问题是 1。我不确定如何保留基于单选按钮 selection，和 2。我不确定如何生成一个 table，它将更新以反映用户在处理标准时的输入。
任何输入将不胜感激。
ui <- fluidPage(theme = shinytheme("united"),
# Application title
titlePanel("TITLE"),
sidebarLayout(
sidebarPanel(
selectInput("select", label = helpText("Select a critera"),
choices = list("Criteria_1", "Criteria_2"),
selected = c("NULL"))),
mainPanel(tabsetPanel(
tabPanel("Criteria", conditionalPanel(h3("Question 1", align = "left"),
condition = "input.select == 'Criteria_1'",
prettyRadioButtons(
inputId = "Id037",
label = "Predictions:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3),
inline = TRUE,
status = "danger",
fill = TRUE),
),
conditionalPanel(h3("Question 2", align = "left"),
condition = "input.select == 'Criteria_1'",
prettyRadioButtons(
inputId = "Id037",
label = "Hypotheses:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3),
inline = TRUE,
status = "danger",
fill = TRUE)
),
#User side-pannel selection - criteria 2
conditionalPanel( h3("Question 1", align = "left"),
condition = "input.select == 'Criteria_2'",
prettyRadioButtons(
inputId = "Id037",
label = "Methods:",
choices = c(
"Option 1" = 1,
"Option 2" = 2),
inline = TRUE,
status = "danger",
fill = TRUE)
),
conditionalPanel(h3("Question 2", align = "left"),
condition = "input.stats == 'Criteria 2'",
prettyRadioButtons(
inputId = "Id037",
label = "Paradigm:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3),
inline = TRUE,
status = "danger",
fill = TRUE)
)),
tabPanel("Summary score", DT::renderDT({
datatable() %>% formatStyle(
'Sepal.Width',
backgroundColor = styleInterval(3.4, c('gray', 'yellow'))
)
})),
))
))
server <- function(input, output) {
}
shinyApp(ui, server)
正如@ben 指出的那样。每个 radioButtons() 必须有一个唯一的 inputId。此外，renderDT 应该进入服务器部分。在 ui 中我们需要 DToutput.
关于 criteria_2 的问题二，条件提到 input.stats 但没有名为 stats 的输入，所以我将其更改为 select。
library(shinythemes)
library(shiny)
library(shinyWidgets)
library(DT)
library(tidyverse)
ui <- fluidPage(theme = shinytheme("united"),
# Application title
titlePanel("TITLE"),
sidebarLayout(
sidebarPanel(
selectInput("select", label = helpText("Select a critera"),
choices = list("Criteria_1", "Criteria_2"),
selected = c("NULL"))),
mainPanel(tabsetPanel(
tabPanel("Criteria", conditionalPanel(h3("Question 1", align = "left"),
condition = "input.select == 'Criteria_1'",
prettyRadioButtons(
inputId = "Id037",
label = "Predictions:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3),
inline = TRUE,
status = "danger",
fill = TRUE),
),
conditionalPanel(h3("Question 2", align = "left"),
condition = "input.select == 'Criteria_1'",
prettyRadioButtons(
inputId = "Id038",
label = "Hypotheses:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3),
inline = TRUE,
status = "danger",
fill = TRUE)
),
#User side-pannel selection - criteria 2
conditionalPanel( h3("Question 1", align = "left"),
condition = "input.select == 'Criteria_2'",
prettyRadioButtons(
inputId = "Id039",
label = "Methods:",
choices = c(
"Option 1" = 1,
"Option 2" = 2),
inline = TRUE,
status = "danger",
fill = TRUE)
),
conditionalPanel(h3("Question 2", align = "left"),
condition = "input.select == 'Criteria_2'",
prettyRadioButtons(
inputId = "Id040",
label = "Paradigm:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3),
inline = TRUE,
status = "danger",
fill = TRUE)
)),
# Second Tab --------------------------------------------------------------
tabPanel("Summary score",
DTOutput('summary')),
))
)
)
# SERVER ------------------------------------------------------------------
server <- function(input, output) {
summ <- reactive({
radios_inputid <- str_c('Id0', seq(37, 40, 1))
radios_values <- map(radios_inputid, ~input[[.x]])
tibble(Criteria = c('Criteria_1','Criteria_1','Criteria_2', 'Criteria_2'),
Input_name = radios_inputid,
value = radios_values)
})
output$summary <- DT::renderDT({
datatable(summ())
})
}
shinyApp(ui, server)
编辑：
获取每个条件的最小值：
library(shinythemes)
library(shiny)
library(shinyWidgets)
library(DT)
library(tidyverse)
ui <- fluidPage(
theme = shinytheme("united"),
# Application title
titlePanel("TITLE"),
sidebarLayout(
sidebarPanel(
selectInput("select",
label = helpText("Select a critera"),
choices = list("Criteria_1", "Criteria_2"),
selected = c("NULL")
)
),
mainPanel(tabsetPanel(
tabPanel(
"Criteria", conditionalPanel(h3("Question 1", align = "left"),
condition = "input.select == 'Criteria_1'",
prettyRadioButtons(
inputId = "Id037_crit1",
label = "Predictions:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3
),
inline = TRUE,
status = "danger",
fill = TRUE
),
),
conditionalPanel(h3("Question 2", align = "left"),
condition = "input.select == 'Criteria_1'",
prettyRadioButtons(
inputId = "Id038_crit1",
label = "Hypotheses:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3
),
inline = TRUE,
status = "danger",
fill = TRUE
)
),
# User side-pannel selection - criteria 2
conditionalPanel(h3("Question 1", align = "left"),
condition = "input.select == 'Criteria_2'",
prettyRadioButtons(
inputId = "Id039_crit2",
label = "Methods:",
choices = c(
"Option 1" = 1,
"Option 2" = 2
),
inline = TRUE,
status = "danger",
fill = TRUE
)
),
conditionalPanel(h3("Question 2", align = "left"),
condition = "input.select == 'Criteria_2'",
prettyRadioButtons(
inputId = "Id040_crit2",
label = "Paradigm:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3
),
inline = TRUE,
status = "danger",
fill = TRUE
)
)
),
# Second Tab --------------------------------------------------------------
tabPanel(
"Summary score",
DTOutput("summary")
),
))
)
)
# SERVER ------------------------------------------------------------------
server <- function(input, output) {
calc_min_val <- function(contains) {
radios_inputid <- str_subset(names(input), contains)
map_dbl(radios_inputid, ~ as.numeric(input[[.x]])) %>%
min()
}
summ <- reactive({
min_values <- c("crit1$", "crit2$") %>%
map(calc_min_val)
tibble(
Lowest_Criteria = c("Criteria_1", "Criteria_2"),
value = map(min_values, ~.)
)
})
output$summary <- DT::renderDT({
datatable(summ())
})
}
shinyApp(ui, server)
我是 Shiny 的新手，正在尝试创建一个主面板是选项卡面板的应用程序。第一个选项卡是条件面板（这些由 'criteria' 侧面板 selection 决定），第二个选项卡应该是 table 代表最高用户-selected每个问题的条件面板中的单选按钮选项（例如，如果 select 'Option 1' 用于 'Question 1'（条件面板 1），'Option 2' 用于'问题 2（条件面板，选项 2)，这应该显示问题 1 - 2。当用户在侧面板上移动不同的标准时，需要保留此信息。我遇到的问题是 1。我不确定如何保留基于单选按钮 selection，和 2。我不确定如何生成一个 table，它将更新以反映用户在处理标准时的输入。 任何输入将不胜感激。
ui <- fluidPage(theme = shinytheme("united"),
# Application title
titlePanel("TITLE"),
sidebarLayout(
sidebarPanel(
selectInput("select", label = helpText("Select a critera"),
choices = list("Criteria_1", "Criteria_2"),
selected = c("NULL"))),
mainPanel(tabsetPanel(
tabPanel("Criteria", conditionalPanel(h3("Question 1", align = "left"),
condition = "input.select == 'Criteria_1'",
prettyRadioButtons(
inputId = "Id037",
label = "Predictions:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3),
inline = TRUE,
status = "danger",
fill = TRUE),
),
conditionalPanel(h3("Question 2", align = "left"),
condition = "input.select == 'Criteria_1'",
prettyRadioButtons(
inputId = "Id037",
label = "Hypotheses:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3),
inline = TRUE,
status = "danger",
fill = TRUE)
),
#User side-pannel selection - criteria 2
conditionalPanel( h3("Question 1", align = "left"),
condition = "input.select == 'Criteria_2'",
prettyRadioButtons(
inputId = "Id037",
label = "Methods:",
choices = c(
"Option 1" = 1,
"Option 2" = 2),
inline = TRUE,
status = "danger",
fill = TRUE)
),
conditionalPanel(h3("Question 2", align = "left"),
condition = "input.stats == 'Criteria 2'",
prettyRadioButtons(
inputId = "Id037",
label = "Paradigm:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3),
inline = TRUE,
status = "danger",
fill = TRUE)
)),
tabPanel("Summary score", DT::renderDT({
datatable() %>% formatStyle(
'Sepal.Width',
backgroundColor = styleInterval(3.4, c('gray', 'yellow'))
)
})),
))
))
server <- function(input, output) {
}
shinyApp(ui, server)
正如@ben 指出的那样。每个 radioButtons() 必须有一个唯一的 inputId。此外，renderDT 应该进入服务器部分。在 ui 中我们需要 DToutput.
关于 criteria_2 的问题二，条件提到 input.stats 但没有名为 stats 的输入，所以我将其更改为 select。
library(shinythemes)
library(shiny)
library(shinyWidgets)
library(DT)
library(tidyverse)
ui <- fluidPage(theme = shinytheme("united"),
# Application title
titlePanel("TITLE"),
sidebarLayout(
sidebarPanel(
selectInput("select", label = helpText("Select a critera"),
choices = list("Criteria_1", "Criteria_2"),
selected = c("NULL"))),
mainPanel(tabsetPanel(
tabPanel("Criteria", conditionalPanel(h3("Question 1", align = "left"),
condition = "input.select == 'Criteria_1'",
prettyRadioButtons(
inputId = "Id037",
label = "Predictions:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3),
inline = TRUE,
status = "danger",
fill = TRUE),
),
conditionalPanel(h3("Question 2", align = "left"),
condition = "input.select == 'Criteria_1'",
prettyRadioButtons(
inputId = "Id038",
label = "Hypotheses:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3),
inline = TRUE,
status = "danger",
fill = TRUE)
),
#User side-pannel selection - criteria 2
conditionalPanel( h3("Question 1", align = "left"),
condition = "input.select == 'Criteria_2'",
prettyRadioButtons(
inputId = "Id039",
label = "Methods:",
choices = c(
"Option 1" = 1,
"Option 2" = 2),
inline = TRUE,
status = "danger",
fill = TRUE)
),
conditionalPanel(h3("Question 2", align = "left"),
condition = "input.select == 'Criteria_2'",
prettyRadioButtons(
inputId = "Id040",
label = "Paradigm:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3),
inline = TRUE,
status = "danger",
fill = TRUE)
)),
# Second Tab --------------------------------------------------------------
tabPanel("Summary score",
DTOutput('summary')),
))
)
)
# SERVER ------------------------------------------------------------------
server <- function(input, output) {
summ <- reactive({
radios_inputid <- str_c('Id0', seq(37, 40, 1))
radios_values <- map(radios_inputid, ~input[[.x]])
tibble(Criteria = c('Criteria_1','Criteria_1','Criteria_2', 'Criteria_2'),
Input_name = radios_inputid,
value = radios_values)
})
output$summary <- DT::renderDT({
datatable(summ())
})
}
shinyApp(ui, server)
编辑：
获取每个条件的最小值：
library(shinythemes)
library(shiny)
library(shinyWidgets)
library(DT)
library(tidyverse)
ui <- fluidPage(
theme = shinytheme("united"),
# Application title
titlePanel("TITLE"),
sidebarLayout(
sidebarPanel(
selectInput("select",
label = helpText("Select a critera"),
choices = list("Criteria_1", "Criteria_2"),
selected = c("NULL")
)
),
mainPanel(tabsetPanel(
tabPanel(
"Criteria", conditionalPanel(h3("Question 1", align = "left"),
condition = "input.select == 'Criteria_1'",
prettyRadioButtons(
inputId = "Id037_crit1",
label = "Predictions:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3
),
inline = TRUE,
status = "danger",
fill = TRUE
),
),
conditionalPanel(h3("Question 2", align = "left"),
condition = "input.select == 'Criteria_1'",
prettyRadioButtons(
inputId = "Id038_crit1",
label = "Hypotheses:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3
),
inline = TRUE,
status = "danger",
fill = TRUE
)
),
# User side-pannel selection - criteria 2
conditionalPanel(h3("Question 1", align = "left"),
condition = "input.select == 'Criteria_2'",
prettyRadioButtons(
inputId = "Id039_crit2",
label = "Methods:",
choices = c(
"Option 1" = 1,
"Option 2" = 2
),
inline = TRUE,
status = "danger",
fill = TRUE
)
),
conditionalPanel(h3("Question 2", align = "left"),
condition = "input.select == 'Criteria_2'",
prettyRadioButtons(
inputId = "Id040_crit2",
label = "Paradigm:",
choices = c(
"Option 1" = 1,
"Option 2" = 2,
"Option 3" = 3
),
inline = TRUE,
status = "danger",
fill = TRUE
)
)
),
# Second Tab --------------------------------------------------------------
tabPanel(
"Summary score",
DTOutput("summary")
),
))
)
)
# SERVER ------------------------------------------------------------------
server <- function(input, output) {
calc_min_val <- function(contains) {
radios_inputid <- str_subset(names(input), contains)
map_dbl(radios_inputid, ~ as.numeric(input[[.x]])) %>%
min()
}
summ <- reactive({
min_values <- c("crit1$", "crit2$") %>%
map(calc_min_val)
tibble(
Lowest_Criteria = c("Criteria_1", "Criteria_2"),
value = map(min_values, ~.)
)
})
output$summary <- DT::renderDT({
datatable(summ())
})
}
shinyApp(ui, server)