mycode的

Question

我有15个选择（输入类型）字段。我需要将它传递给Server函数做预测并显示结果输出。 我不想自动更新，当用户为一个输入字段设置值时，我希望用户为所有（15个输入字段）设置值，然后按某种类型的按钮得到输出。

如何实现？这是我第一个闪亮的UI应用程序。

mycode的

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是解决这个问题的方法。

以下是您修改的示例，只有在三个条件之一为真时才会返回"result 1"

year1 input$a=="A"
the year2 input$f=="A"
the year3 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)

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

我希望这会对你有所帮助。我发现这是制作“做情节！”的最简单方法。按钮。

在提交或操作按钮上从Shiny UI应用程序获取输入到服务器

mycode的

2 个答案: