在提交或操作按钮上从 Shiny UI 应用程序获取输入到服务器
Posted
技术标签:
【中文标题】在提交或操作按钮上从 Shiny UI 应用程序获取输入到服务器【英文标题】：Get inputs from Shiny UI app to the server on Submit or Action button 【发布时间】：2017-08-31 11:58:06 【问题描述】：我有 15 个选择（输入类型）字段。我需要将它传递给服务器函数进行预测并显示结果输出。 我不想自动更新，当用户为一个输入字段设置值时，我希望用户为所有（15 个输入字段）设置值，然后按下某种类型的按钮获取输出。
如何做到这一点？这是我的第一个闪亮的 UI 应用程序。
我的代码
library(shiny)
dataset <- diamonds
marks <- 0:100
grades <- c("A","B","C","D","E","F")
ui <- fluidPage(
tags$head(tags$style(html("
h2
text-align: center;
h3
text-align: center;
h6
text-align: center;
color:red;
#goButton
width: 100%;
")
)
),
verticalLayout
(
wellPanel
(
titlePanel("Get Recommendation for Year 4 or 5 Courses"),
h6("* Set the value of input field as 'NA', if you received a remark of Absent (ABS), Medical Circumstances (MC), Exemption (EX), Synoptic Course in absence (NC), Discretionary credits (DC), or any other reason")
)
),
fluidRow
(
column(2,
wellPanel(
radioButtons("type", label = h3("Select Type"),
choices = list("Grades" = 'grades', "Marks" = 'marks'),
selected = 'grades')
)
),
conditionalPanel
(
condition = "input.type == 'grades'",
column
(2,
wellPanel
(
h3("Year 1"),
selectInput('a', 'A',c('NA', grades)),
selectInput('b', 'B',c('NA', grades)),
selectInput('c', 'C',c('NA', grades)),
selectInput('d', 'D',c('NA', grades)),
selectInput('e', 'E',c('NA', grades))
)
),
column
(2,
wellPanel
(
h3("Year 2"),
selectInput('f', 'F',c('NA', grades)),
selectInput('g', 'G',c('NA', grades)),
selectInput('h', 'H',c('NA', grades)),
selectInput('i', 'I',c('NA', grades)),
selectInput('j', 'J',c('NA', grades))
)
),
column
(2,
wellPanel
(
h3("Year 3"),
selectInput('k', 'K',c('NA', grades)),
selectInput('l', 'L',c('NA', grades)),
selectInput('m', 'M',c('NA', grades)),
selectInput('n', 'N',c('NA', grades)),
selectInput('o', 'O',c('NA', grades))
)
)
),
conditionalPanel
(
condition = "input.type == 'marks'",
column
(2,
wellPanel
(
h3("Year 1"),
selectInput('a', 'A',c('NA', marks)),
selectInput('b', 'B',c('NA', marks)),
selectInput('c', 'C',c('NA', marks)),
selectInput('d', 'D',c('NA', marks)),
selectInput('e', 'E',c('NA', marks))
)
),
column
(2,
wellPanel
(
h3("Year 2"),
selectInput('f', 'F',c('NA', marks)),
selectInput('g', 'G',c('NA', marks)),
selectInput('h', 'H',c('NA', marks)),
selectInput('i', 'I',c('NA', marks)),
selectInput('j', 'J',c('NA', marks))
)
),
column
(2,
wellPanel
(
h3("Year 3"),
selectInput('k', 'K',c('NA', marks)),
selectInput('l', 'L',c('NA', marks)),
selectInput('m', 'M',c('NA', marks)),
selectInput('n', 'N',c('NA', marks)),
selectInput('o', 'O',c('NA', marks))
)
)
),
column
(4,
actionButton("goButton", "Submit"),
wellPanel
(
h3("Results"),
verbatimTextOutput("value")
)
)
)
)
server <- function(input, output)
#Do Prediction
#Get Results
new_vector = c()
if (input.type == 'marks')
new_vector <- append(new_vector, input$f27sa, 1)
new_vector <- append(new_vector, input$f27sb, 2)
new_vector <- append(new_vector, input$f27cs, 3)
new_vector <- append(new_vector, input$f27is, 4)
new_vector <- append(new_vector, input$f27px, 5)
new_vector <- append(new_vector, input$f28in, 6)
new_vector <- append(new_vector, input$f28da, 7)
new_vector <- append(new_vector, input$f28pl, 8)
new_vector <- append(new_vector, input$f28sd, 9)
new_vector <- append(new_vector, input$f28dm, 10)
new_vector <- append(new_vector, input$f28ai, 11)
new_vector <- append(new_vector, input$f28fa, 12)
new_vector <- append(new_vector, input$f28fb, 13)
new_vector <- append(new_vector, input$f28oc, 14)
new_vector <- append(new_vector, input$f28pd, 15)
else
new_vector <- append(new_vector, input$f27sa2, 1)
new_vector <- append(new_vector, input$f27sb2, 2)
new_vector <- append(new_vector, input$f27cs2, 3)
new_vector <- append(new_vector, input$f27is2, 4)
new_vector <- append(new_vector, input$f27px2, 5)
new_vector <- append(new_vector, input$f28in2, 6)
new_vector <- append(new_vector, input$f28da2, 7)
new_vector <- append(new_vector, input$f28pl2, 8)
new_vector <- append(new_vector, input$f28sd2, 9)
new_vector <- append(new_vector, input$f28dm2, 10)
new_vector <- append(new_vector, input$f28ai2, 11)
new_vector <- append(new_vector, input$f28fa2, 12)
new_vector <- append(new_vector, input$f28fb2, 13)
new_vector <- append(new_vector, input$f28oc2, 14)
new_vector <- append(new_vector, input$f28pd2, 15)
results <- eventReactive(input$goButton,
return (new_vector)
)
output$value <- renderPrint( results() )
shinyApp(ui = ui, server = server)
【问题讨论】：
【参考方案1】：eventReactive 是解决此问题的方法。
这里是您的示例，修改后仅在三个条件之一为真时返回 "result 1"
input$a=="A"
年份2 input$f=="A"
年份3 input$k=="A"
否则返回"result 3"。但是请注意，在您点击提交按钮之前，它不会返回任何内容。
不知何故，eventReactive 在闪亮的世界中并不为人所知——但这种场景正是它的本意。直到我定期编写 Shiny 程序一年多，我才偶然发现它。
library(shiny)
dataset <- diamonds
marks <- 0:100
grades <- c("A","B","C","D","E","F")
ui <- fluidPage(
tags$head(tags$style(HTML("
h2
text-align: center;
h3
text-align: center;
h6
text-align: center;
color:red;
#goButton
width: 100%;
")
)
),
verticalLayout
(
wellPanel
(
titlePanel("Get Recommendation for Year 4 or 5 Courses"),
h6("* Set the value of input field as 'NA', if you received a remark of Absent (ABS), Medical Circumstances (MC), Exemption (EX), Synoptic Course in absence (NC), Discretionary credits (DC), or any other reason")
)
),
fluidRow
(
column(2,
wellPanel(
radioButtons("type", label = h3("Select Type"),
choices = list("Grades" = 'grades', "Marks" = 'marks'),
selected = 'grades')
)
),
conditionalPanel
(
condition = "input.type == 'grades'",
column
(2,
wellPanel
(
h3("Year 1"),
selectInput('a', 'A',c('NA', grades)),
selectInput('b', 'B',c('NA', grades)),
selectInput('c', 'C',c('NA', grades)),
selectInput('d', 'D',c('NA', grades)),
selectInput('e', 'E',c('NA', grades))
)
),
column
(2,
wellPanel
(
h3("Year 2"),
selectInput('f', 'F',c('NA', grades)),
selectInput('g', 'G',c('NA', grades)),
selectInput('h', 'H',c('NA', grades)),
selectInput('i', 'I',c('NA', grades)),
selectInput('j', 'J',c('NA', grades))
)
),
column
(2,
wellPanel
(
h3("Year 3"),
selectInput('k', 'K',c('NA', grades)),
selectInput('l', 'L',c('NA', grades)),
selectInput('m', 'M',c('NA', grades)),
selectInput('n', 'N',c('NA', grades)),
selectInput('o', 'O',c('NA', grades))
)
)
),
conditionalPanel
(
condition = "input.type == 'marks'",
column
(2,
wellPanel
(
h3("Year 1"),
selectInput('a', 'A',c('NA', marks)),
selectInput('b', 'B',c('NA', marks)),
selectInput('c', 'C',c('NA', marks)),
selectInput('d', 'D',c('NA', marks)),
selectInput('e', 'E',c('NA', marks))
)
),
column
(2,
wellPanel
(
h3("Year 2"),
selectInput('f', 'F',c('NA', marks)),
selectInput('g', 'G',c('NA', marks)),
selectInput('h', 'H',c('NA', marks)),
selectInput('i', 'I',c('NA', marks)),
selectInput('j', 'J',c('NA', marks))
)
),
column
(2,
wellPanel
(
h3("Year 3"),
selectInput('k', 'K',c('NA', marks)),
selectInput('l', 'L',c('NA', marks)),
selectInput('m', 'M',c('NA', marks)),
selectInput('n', 'N',c('NA', marks)),
selectInput('o', 'O',c('NA', marks))
)
)
),
column
(4,
actionButton("goButton", "Submit"),
wellPanel
(
h3("Results"),
verbatimTextOutput("value")
)
)
)
)
server <- function(input, output)
#Do Prediction
results <- eventReactive(input$goButton,
if (input$k=="A" | input$f=="A" | input$a=="A" )
return("result 1")
else
return("result 3")
)
#Get Results
#results <- c("result 1","result 2","result 3");
output$value <- renderPrint( results() )
shinyApp(ui = ui, server = server)
【讨论】：
感谢您的帮助，一个简单的问题，在我提取输入值并将其存储在向量中之前，我需要确定用户选择的类型是“成绩”还是“标记”，因为那时我知道是使用 input$f27sa 还是 input$f27sa2。我该如何检查？我这样做了：if (input.type == 'marks')...else ... 但给出错误：找不到对象'input.type'。简而言之，如何检查选择了哪个单选按钮。 让我看看。 我认为你需要使用“input$type”。这 ”。”字符在 R 中没有特别的意义——例如与 javascript 不同。这只是另一个角色。 $ 是 R 中列表的选择器，所以我认为这就是您要使用的意思。 你必须使用验证需要尝试一下 是的，input.type 表单用于将条件传递给 javascript 的 UI 部分。就这样 ”。”选择器而不是“$”选择器。有趣的。直到现在才知道conditionalPanel 是如何工作的。【参考方案2】：
如果我理解你的问题，我认为你应该使用isolate 函数来实现这一点。这个想法很容易理解。您创建一个 actionButton 并在单击它时计算绘图（或其他类型的输出）。关键是要隔离输入，以使它们没有反应，并且在您单击按钮之前不会改变。
这里有完整的解释：https://shiny.rstudio.com/articles/isolation.html
我会用 plotOutput 举例：
这个想法是在您的应用程序的UI 部分中创建一个操作按钮，就像actionButton("goButtoncomparacio", "Make the plot!",width = "200px",icon=icon("play-circle")) 一样
然后，在您应用的 server 部分：
output$plotComparacio<-renderPlot(
input$goButtoncomparacio
#You isolate each one of your input.
#This will make that they dont change untill you click the button.
embassament<-isolate(input$embcomparacio)
anysfons<-isolate(input$riboncomparacio)
anys1<-isolate(input$datescomparacio1)
anys2<-isolate(input$datescomparacio2)
anys3<-isolate(input$datescomparacio3)
mitjana<-isolate(input$mitjanaComparacio)
fons<-isolate(input$fonscomparacio)
efemeri<-isolate(input$efemeridescomparacio)
previ<-isolate(input$previsionscomparacio)
myplot<-ggplot()+whatever you want to plot
)
我希望这对你有帮助。我发现它是制作“做情节！”的最简单方法。按钮。
【讨论】：
以上是关于在提交或操作按钮上从 Shiny UI 应用程序获取输入到服务器的主要内容，如果未能解决你的问题，请参考以下文章
在 Shiny 中，避免 selectInput 下拉菜单与其下方的操作按钮重叠