R Shiny 中的动态输入

Question

我正在尝试进行响应式输入以获取输出，然后将该输出用作输入来计算函数。这只是我想做的一个例子。我无法删除产品功能。

你能建议如何显示输出吗？ 因此产品必须是 hours 和 maxdays 的结果，这取决于天数的选择。

library(shiny)

ui = fluidPage(
  selectInput('p_id','ID:', c(111,222,333)),
  uiOutput('uiID'),
  uiOutput('uiID1'),
  # uiOutput('val'),
  textOutput("values4.5"),
  submitButton("apply_changes")

)

server = function(input, output, session) {

  maxdays <- reactive({
    if(input$p_id %in% c(111)){
      x = c(1,2)
    }else{
      if(input$p_id %in% c(222)){
        x = 2
      }else
        x = 3 
    }
    return(x)
  })

  hours <- reactive({
    if(input$p_id %in% c(111)){
      x = c(20,10)
    }else{
      if(input$p_id %in% c(222)){
        x = 20
      }else
        x = 30 
    }
    return(x)
  })

  output$uiID <- renderUI({
    selectInput('days','Days:', choices=maxdays())
  })

  output$uiID1 <- renderUI({
    selectInput('days','Days:', choices=hours())
  })

 product<-function(p_id,maxdays,hours){
   prod=p_id*maxdays*hours
   return(prod)
 }


complete_ans <-reactive({
   answer <- product(input$p_id,input$maxdays,input$hours)
   values4.5 = answer
output=list(values4.5=values4.5)

})

 output$values4.5 <- renderText({complete_ans()[['values4.5']]})
}

runApp(shinyApp(ui = ui, server = server))

Answer 1

您需要在参数中为“产品”函数传递数字参数。这可以通过使用 as.numeric() 进行强制来完成。此外，您应该与使用 ' 保持一致

library(shiny)

ui = fluidPage(
  selectInput('p_id','ID:', c(111,222,333)),
  uiOutput('uiID'),
  uiOutput('uiID1'),
  # uiOutput('val'),
  textOutput("values4.5"),
  submitButton("apply_changes")

)

server = function(input, output, session) {

  maxdays <- reactive({
    if(input$p_id %in% c(111)){
      x = c(1,2)
    }else{
      if(input$p_id %in% c(222)){
        x = 2
      }else
        x = 3 
    }
    return(x)
  })

  hours <- reactive({
    if(input$p_id %in% c(111)){
      x = c(20,10)
    }else{
      if(input$p_id %in% c(222)){
        x = 20
      }else
        x = 30 
    }
    return(x)
  })

  output$uiID <- renderUI({
    selectInput('days1','Days:', choices=maxdays())
  })

  output$uiID1 <- renderUI({
    selectInput('days2','Days:', choices=hours())
  })

  product <- function(p_id,maxdays,hours){
    prod <- p_id * maxdays * hours
    return(prod)
  }


  complete_ans <- reactive({
    answer <- product(as.numeric(input$p_id), as.numeric(maxdays()), as.numeric(hours()))
    values4.5 <- answer
    output1 <- list(values4.5=values4.5)
    return(output1)
  })

  output$values4.5 <- renderText({
    complete_ans()[['values4.5']]
    })
}

runApp(shinyApp(ui = ui, server = server))

Answer 2

我觉得这样更干净一些：

library(shiny)

product <- function(p_id,maxdays,hours){
        prod <- as.numeric(p_id)*as.numeric(maxdays)*as.numeric(hours)
        return(prod)
}

ui = fluidPage(
        selectInput('p_id','ID:', c(111,222,333)),
        selectInput('maxdays','Days:', choices=NULL),
        selectInput('hours','Hours:', choices=NULL),

        uiOutput('uiID'),
        uiOutput('uiID1'),
        actionButton("apply_changes","apply_changes"),
        textOutput("values4_5")

)

server = function(input, output, session) {

        observeEvent(input$p_id,{
                if(input$p_id == 111){
                        v1 <- v2 <- c(1,2);

                }
                else if(input$p_id == 222){
                        v1 <- 2;v2 <- 20
                }
                else{
                        v1 <- 3;v2 <- 30
                }
                updateSelectInput(session,"maxdays",choices = v1)
                updateSelectInput(session,"hours",choices = v2)
        })

        complete_ans <-eventReactive(input$apply_changes,{
                answer <- product(input$p_id,input$maxdays,input$hours)
                list(values4.5=answer)
        })
        output$values4_5 <- renderText({complete_ans()[['values4.5']]})
}

runApp(shinyApp(ui = ui, server = server))