通过“提交”或“操作”按钮从 Shiny UI 应用向服务器获取输入

Question

我有 15 个 select（输入类型）字段。我需要将它传递给服务器函数进行预测并显示结果输出。 我不想在用户为一个输入字段设置值时自动更新，而是我希望用户为所有（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)

Answer 1

eventReactive 是解决这个问题的方法。

您的示例已修改，因此只有 returns "result 1" 如果三个条件之一为真

第1年input$a=="A"
第二年input$f=="A"
3年input$k=="A"

否则它 returns "result 3"。但是请注意，在您点击提交按钮之前，它不会 return 任何东西。

不知何故 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)

Answer 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
})

希望对您有所帮助。我发现这是制作 "Do the plot!" 按钮的最简单方法。

通过“提交”或“操作”按钮从 Shiny UI 应用向服务器获取输入

Get inputs from Shiny UI app to the server on Submit or Action button

r

reactive-programming

shiny

shiny-server

shinydashboard

我的代码