闪亮：在 empty/non-selected radioButtions() 的情况下，actionButton() return 会出错吗？
shiny: can an actionButton() return an error in case of empty/non-selected radioButtions()?
我还没有找到我的问题的解决方案，这个 接近但不完全。
我制作了一个简单的app，其中包含几个radioButtons()。根据 app 的基本概念，它们中的一些是空的，如 radioButtons( ... , selected=character(0)) 中，而另一些具有预选值。
重要的是，在 actionButton() 开始进一步分析之前，所有 radioButtons() 都必须有一个选定的值。
问题： 如何设计一个 actionButton() 使 (1) returns 在未选择 radioButtons() 和(2) returns 什么 radioButtons() 包含未选择的值，具体是什么？
预期输出
写成
library(shiny)
library(shinyjs)
library(shinycustomloader)
library(shinyWidgets)
ui <- fluidPage(
useShinyjs(),
tabsetPanel(
# GTR
tabPanel(title = HTML(paste(h4("Gross Total Resection"),
h6("Simpson Grade I-III", align = "left"))),
br(), br(),
fluidRow(
column(
4,
wellPanel(
style = "height:275px",
h4("Patient-related factors", align="center"), br(),
sliderInput("GTR_age", "Age",
min = 18, max = 100, value = 60), br(),
radioButtons("GTR_sex", "Sex", choiceValues=list("Male","Female"),
choiceNames=list("Male","Female"), selected=character(0), inline = T)
), br(), br(),
fluidRow(align="center", br(), actionBttn("GTRdo", "Submit", style = "material-flat"))
),
column(
4,
wellPanel(
style = "height:375px",
h4("Tumor-related factors", align="center"), br(),
radioButtons("GTR_WHO", "WHO Grade", choiceValues=list("WHO-I","WHO-II", "WHO-III"),
choiceNames=list("WHO-I","WHO-II","WHO-III"), selected=character(0), inline=T), br(),
sliderInput("GTR_Ki67", "Ki-67 proliferative index",
min = 0, max = 60, value = 5), br(),
selectInput("GTR_location", "Location",
c("Convexity" = "0",
"Parasagittal" = "1",
"Anterior skull-base" = "2",
"Mid skull-base" = "3",
"Posterior skull-base" = "4"))
)),
column(
4,
wellPanel(
style = "height:525px",
h4("Treatment-related factors", align="center"), br(),
radioButtons("GTR_Simpson", "Simpson Grade", choiceValues=list("Grade I","Grade II", "Grade III"),
choiceNames=list("Grade I","Grade II","Grade III"), selected=character(0), inline=T), br(),
radioButtons("GTR_EXBR", "External Beam Radiation", choiceValues=list("No","Yes"),
choiceNames=list("No","Yes"), selected ="No", inline=T),
sliderInput("GTR_EXBRGy", "Cumulative Gy",
min = 40, max = 60, value = 54.2, step = 0.2), br(),
radioButtons("GTR_SRS", "Stereotactic radiosurgery", choiceValues=list("No","Yes"),
choiceNames=list("No","Yes"), selected ="No", inline=T),
sliderInput("GTR_SRSGy", "Cumulative Gy",
min = 12, max = 22, value = 15, step = 1), br(),
)
)
)
)
)
)
server <- function(input, output, session) {
GTR_rvs <- reactiveValues(prev_value = 54.2)
observeEvent(input$GTR_EXBR, {
if(input$GTR_EXBR == "No"){
updateSliderInput(session, "GTR_EXBRGy",min = 0, max = 0, value=0)
GTR_rvs$prev_value <- input$GTR_EXBRGy
disable("GTR_EXBRGy")
}else{
updateSliderInput(session, "GTR_EXBRGy", min = 40, max = 60, value = GTR_rvs$prev_value)
enable("GTR_EXBRGy")
}
})
observeEvent(input$GTR_EXBRGy, {
print(input$GTR_EXBRGy)
})
GTR_rvs_srs <- reactiveValues(prev_value = 15)
observeEvent(input$GTR_SRS, {
if(input$GTR_SRS == "No"){
updateSliderInput(session, "GTR_SRSGy",min = 0, max = 0, value=0)
GTR_rvs_srs$prev_value <- input$GTR_SRSGy
disable("GTR_SRSGy")
}else{
updateSliderInput(session, "GTR_SRSGy", min = 12, max = 22, value = GTR_rvs_srs$prev_value)
enable("GTR_SRSGy")
}
})
observeEvent(input$GTR_SRSGy, {
print(input$GTR_SRSGy)
})
}
shinyApp(ui, server)
这应该能满足您的需求。它使用以下技术：
renderUI() 显示错误信息，格式为req() 检查是否应显示红色错误消息toggleState() 使 "Submit" 按钮仅在所有指定单选按钮的长度都不为 0 时才可单击（由 character(0)
library(shiny)
library(shinyjs)
library(shinycustomloader)
library(shinyWidgets)
ui <- fluidPage(
useShinyjs(),
tabsetPanel(
# GTR
tabPanel(title = HTML(paste(h4("Gross Total Resection"),
h6("Simpson Grade I-III", align = "left"))),
br(), br(),
fluidRow(
column(
4,
wellPanel(
style = "height:275px",
h4("Patient-related factors", align="center"), br(),
sliderInput("GTR_age", "Age",
min = 18, max = 100, value = 60), br(),
radioButtons("GTR_sex", "Sex", choiceValues=list("Male","Female"),
choiceNames=list("Male","Female"), selected=character(0), inline = T)
), br(), br(),
fluidRow(align="center", br(), actionBttn("GTRdo", "Submit", style = "material-flat"),br(),
uiOutput("req_text", style = "width: 200px; color: red"))
),
column(
4,
wellPanel(
style = "height:375px",
h4("Tumor-related factors", align="center"), br(),
radioButtons("GTR_WHO", "WHO Grade", choiceValues=list("WHO-I","WHO-II", "WHO-III"),
choiceNames=list("WHO-I","WHO-II","WHO-III"), selected=character(0), inline=T), br(),
sliderInput("GTR_Ki67", "Ki-67 proliferative index",
min = 0, max = 60, value = 5), br(),
selectInput("GTR_location", "Location",
c("Convexity" = "0",
"Parasagittal" = "1",
"Anterior skull-base" = "2",
"Mid skull-base" = "3",
"Posterior skull-base" = "4"))
)),
column(
4,
wellPanel(
style = "height:525px",
h4("Treatment-related factors", align="center"), br(),
radioButtons("GTR_Simpson", "Simpson Grade", choiceValues=list("Grade I","Grade II", "Grade III"),
choiceNames=list("Grade I","Grade II","Grade III"), selected=character(0), inline=T), br(),
radioButtons("GTR_EXBR", "External Beam Radiation", choiceValues=list("No","Yes"),
choiceNames=list("No","Yes"), selected ="No", inline=T),
sliderInput("GTR_EXBRGy", "Cumulative Gy",
min = 40, max = 60, value = 54.2, step = 0.2), br(),
radioButtons("GTR_SRS", "Stereotactic radiosurgery", choiceValues=list("No","Yes"),
choiceNames=list("No","Yes"), selected ="No", inline=T),
sliderInput("GTR_SRSGy", "Cumulative Gy",
min = 12, max = 22, value = 15, step = 1), br(),
)
)
)
)
)
)
server <- function(input, output, session) {
GTR_rvs <- reactiveValues(prev_value = 54.2)
observeEvent(input$GTR_EXBR, {
if(input$GTR_EXBR == "No"){
updateSliderInput(session, "GTR_EXBRGy",min = 0, max = 0, value=0)
GTR_rvs$prev_value <- input$GTR_EXBRGy
disable("GTR_EXBRGy")
}else{
updateSliderInput(session, "GTR_EXBRGy", min = 40, max = 60, value = GTR_rvs$prev_value)
enable("GTR_EXBRGy")
}
})
observeEvent(input$GTR_EXBRGy, {
print(input$GTR_EXBRGy)
})
GTR_rvs_srs <- reactiveValues(prev_value = 15)
observeEvent(input$GTR_SRS, {
if(input$GTR_SRS == "No"){
updateSliderInput(session, "GTR_SRSGy",min = 0, max = 0, value=0)
GTR_rvs_srs$prev_value <- input$GTR_SRSGy
disable("GTR_SRSGy")
}else{
updateSliderInput(session, "GTR_SRSGy", min = 12, max = 22, value = GTR_rvs_srs$prev_value)
enable("GTR_SRSGy")
}
})
observeEvent(input$GTR_SRSGy, {
print(input$GTR_SRSGy)
})
observe({
toggleState(id = "GTRdo", condition = length(input$GTR_sex) > 0 &
length(input$GTR_WHO) > 0 &
length(input$GTR_Simpson) > 0)
})
output$req_text <- renderUI({
req(length(input$GTR_sex) == 0 |
length(input$GTR_WHO) == 0 |
length(input$GTR_Simpson) == 0)
out <- tagList(p("Please choose:"),
tags$ul(style = "text-align: left"))
if(length(input$GTR_sex) == 0) {
out[[2]] <- tagAppendChild(out[[2]],tags$li("Sex"))
}
if(length(input$GTR_WHO) == 0) {
out[[2]] <- tagAppendChild(out[[2]],tags$li("WHO Grade"))
}
if(length(input$GTR_Simpson) == 0) {
out[[2]] <- tagAppendChild(out[[2]],tags$li("Simpson Grade"))
}
out
})
}
shinyApp(ui, server)
我还没有找到我的问题的解决方案，这个
我制作了一个简单的app，其中包含几个radioButtons()。根据 app 的基本概念，它们中的一些是空的，如 radioButtons( ... , selected=character(0)) 中，而另一些具有预选值。
重要的是，在 actionButton() 开始进一步分析之前，所有 radioButtons() 都必须有一个选定的值。
问题： 如何设计一个 actionButton() 使 (1) returns 在未选择 radioButtons() 和(2) returns 什么 radioButtons() 包含未选择的值，具体是什么？
预期输出
写成
library(shiny)
library(shinyjs)
library(shinycustomloader)
library(shinyWidgets)
ui <- fluidPage(
useShinyjs(),
tabsetPanel(
# GTR
tabPanel(title = HTML(paste(h4("Gross Total Resection"),
h6("Simpson Grade I-III", align = "left"))),
br(), br(),
fluidRow(
column(
4,
wellPanel(
style = "height:275px",
h4("Patient-related factors", align="center"), br(),
sliderInput("GTR_age", "Age",
min = 18, max = 100, value = 60), br(),
radioButtons("GTR_sex", "Sex", choiceValues=list("Male","Female"),
choiceNames=list("Male","Female"), selected=character(0), inline = T)
), br(), br(),
fluidRow(align="center", br(), actionBttn("GTRdo", "Submit", style = "material-flat"))
),
column(
4,
wellPanel(
style = "height:375px",
h4("Tumor-related factors", align="center"), br(),
radioButtons("GTR_WHO", "WHO Grade", choiceValues=list("WHO-I","WHO-II", "WHO-III"),
choiceNames=list("WHO-I","WHO-II","WHO-III"), selected=character(0), inline=T), br(),
sliderInput("GTR_Ki67", "Ki-67 proliferative index",
min = 0, max = 60, value = 5), br(),
selectInput("GTR_location", "Location",
c("Convexity" = "0",
"Parasagittal" = "1",
"Anterior skull-base" = "2",
"Mid skull-base" = "3",
"Posterior skull-base" = "4"))
)),
column(
4,
wellPanel(
style = "height:525px",
h4("Treatment-related factors", align="center"), br(),
radioButtons("GTR_Simpson", "Simpson Grade", choiceValues=list("Grade I","Grade II", "Grade III"),
choiceNames=list("Grade I","Grade II","Grade III"), selected=character(0), inline=T), br(),
radioButtons("GTR_EXBR", "External Beam Radiation", choiceValues=list("No","Yes"),
choiceNames=list("No","Yes"), selected ="No", inline=T),
sliderInput("GTR_EXBRGy", "Cumulative Gy",
min = 40, max = 60, value = 54.2, step = 0.2), br(),
radioButtons("GTR_SRS", "Stereotactic radiosurgery", choiceValues=list("No","Yes"),
choiceNames=list("No","Yes"), selected ="No", inline=T),
sliderInput("GTR_SRSGy", "Cumulative Gy",
min = 12, max = 22, value = 15, step = 1), br(),
)
)
)
)
)
)
server <- function(input, output, session) {
GTR_rvs <- reactiveValues(prev_value = 54.2)
observeEvent(input$GTR_EXBR, {
if(input$GTR_EXBR == "No"){
updateSliderInput(session, "GTR_EXBRGy",min = 0, max = 0, value=0)
GTR_rvs$prev_value <- input$GTR_EXBRGy
disable("GTR_EXBRGy")
}else{
updateSliderInput(session, "GTR_EXBRGy", min = 40, max = 60, value = GTR_rvs$prev_value)
enable("GTR_EXBRGy")
}
})
observeEvent(input$GTR_EXBRGy, {
print(input$GTR_EXBRGy)
})
GTR_rvs_srs <- reactiveValues(prev_value = 15)
observeEvent(input$GTR_SRS, {
if(input$GTR_SRS == "No"){
updateSliderInput(session, "GTR_SRSGy",min = 0, max = 0, value=0)
GTR_rvs_srs$prev_value <- input$GTR_SRSGy
disable("GTR_SRSGy")
}else{
updateSliderInput(session, "GTR_SRSGy", min = 12, max = 22, value = GTR_rvs_srs$prev_value)
enable("GTR_SRSGy")
}
})
observeEvent(input$GTR_SRSGy, {
print(input$GTR_SRSGy)
})
}
shinyApp(ui, server)
这应该能满足您的需求。它使用以下技术：
renderUI()显示错误信息，格式为req()检查是否应显示红色错误消息toggleState()使 "Submit" 按钮仅在所有指定单选按钮的长度都不为 0 时才可单击（由character(0) 指定）
library(shiny)
library(shinyjs)
library(shinycustomloader)
library(shinyWidgets)
ui <- fluidPage(
useShinyjs(),
tabsetPanel(
# GTR
tabPanel(title = HTML(paste(h4("Gross Total Resection"),
h6("Simpson Grade I-III", align = "left"))),
br(), br(),
fluidRow(
column(
4,
wellPanel(
style = "height:275px",
h4("Patient-related factors", align="center"), br(),
sliderInput("GTR_age", "Age",
min = 18, max = 100, value = 60), br(),
radioButtons("GTR_sex", "Sex", choiceValues=list("Male","Female"),
choiceNames=list("Male","Female"), selected=character(0), inline = T)
), br(), br(),
fluidRow(align="center", br(), actionBttn("GTRdo", "Submit", style = "material-flat"),br(),
uiOutput("req_text", style = "width: 200px; color: red"))
),
column(
4,
wellPanel(
style = "height:375px",
h4("Tumor-related factors", align="center"), br(),
radioButtons("GTR_WHO", "WHO Grade", choiceValues=list("WHO-I","WHO-II", "WHO-III"),
choiceNames=list("WHO-I","WHO-II","WHO-III"), selected=character(0), inline=T), br(),
sliderInput("GTR_Ki67", "Ki-67 proliferative index",
min = 0, max = 60, value = 5), br(),
selectInput("GTR_location", "Location",
c("Convexity" = "0",
"Parasagittal" = "1",
"Anterior skull-base" = "2",
"Mid skull-base" = "3",
"Posterior skull-base" = "4"))
)),
column(
4,
wellPanel(
style = "height:525px",
h4("Treatment-related factors", align="center"), br(),
radioButtons("GTR_Simpson", "Simpson Grade", choiceValues=list("Grade I","Grade II", "Grade III"),
choiceNames=list("Grade I","Grade II","Grade III"), selected=character(0), inline=T), br(),
radioButtons("GTR_EXBR", "External Beam Radiation", choiceValues=list("No","Yes"),
choiceNames=list("No","Yes"), selected ="No", inline=T),
sliderInput("GTR_EXBRGy", "Cumulative Gy",
min = 40, max = 60, value = 54.2, step = 0.2), br(),
radioButtons("GTR_SRS", "Stereotactic radiosurgery", choiceValues=list("No","Yes"),
choiceNames=list("No","Yes"), selected ="No", inline=T),
sliderInput("GTR_SRSGy", "Cumulative Gy",
min = 12, max = 22, value = 15, step = 1), br(),
)
)
)
)
)
)
server <- function(input, output, session) {
GTR_rvs <- reactiveValues(prev_value = 54.2)
observeEvent(input$GTR_EXBR, {
if(input$GTR_EXBR == "No"){
updateSliderInput(session, "GTR_EXBRGy",min = 0, max = 0, value=0)
GTR_rvs$prev_value <- input$GTR_EXBRGy
disable("GTR_EXBRGy")
}else{
updateSliderInput(session, "GTR_EXBRGy", min = 40, max = 60, value = GTR_rvs$prev_value)
enable("GTR_EXBRGy")
}
})
observeEvent(input$GTR_EXBRGy, {
print(input$GTR_EXBRGy)
})
GTR_rvs_srs <- reactiveValues(prev_value = 15)
observeEvent(input$GTR_SRS, {
if(input$GTR_SRS == "No"){
updateSliderInput(session, "GTR_SRSGy",min = 0, max = 0, value=0)
GTR_rvs_srs$prev_value <- input$GTR_SRSGy
disable("GTR_SRSGy")
}else{
updateSliderInput(session, "GTR_SRSGy", min = 12, max = 22, value = GTR_rvs_srs$prev_value)
enable("GTR_SRSGy")
}
})
observeEvent(input$GTR_SRSGy, {
print(input$GTR_SRSGy)
})
observe({
toggleState(id = "GTRdo", condition = length(input$GTR_sex) > 0 &
length(input$GTR_WHO) > 0 &
length(input$GTR_Simpson) > 0)
})
output$req_text <- renderUI({
req(length(input$GTR_sex) == 0 |
length(input$GTR_WHO) == 0 |
length(input$GTR_Simpson) == 0)
out <- tagList(p("Please choose:"),
tags$ul(style = "text-align: left"))
if(length(input$GTR_sex) == 0) {
out[[2]] <- tagAppendChild(out[[2]],tags$li("Sex"))
}
if(length(input$GTR_WHO) == 0) {
out[[2]] <- tagAppendChild(out[[2]],tags$li("WHO Grade"))
}
if(length(input$GTR_Simpson) == 0) {
out[[2]] <- tagAppendChild(out[[2]],tags$li("Simpson Grade"))
}
out
})
}
shinyApp(ui, server)