时间戳

首页 > 解决方案 > 在闪亮的应用程序中使用 actionButton 更新数据框的值

r - 在闪亮的应用程序中使用 actionButton 更新数据框的值

问题描述

我在下面有一个闪亮的应用程序，用户在其中上传一个文件（这里我只是把它dt放在一个反应​​函数中），然后他可以从那里选择他想通过pickerInput(). 如果他选择 ，value1他应该能够通过将所有值与 相乘来更新其所有值numericInput() value1并创建一个新的sliderInput()。当我尝试加载应用程序时，我得到：subscript out of bounds。

library(shiny)
library(shinyWidgets)
# ui object

ui <- fluidPage(
    titlePanel(p("Spatial app", style = "color:#3474A7")),
    sidebarLayout(
        sidebarPanel(
            pickerInput(
                inputId = "p1",
                label = "Select Column headers",
                choices = colnames( dt),
                multiple = TRUE,
                options = list(`actions-box` = TRUE)
            ),
            numericInput("num", label = ("value1"), value = 1),
            #Add the output for new pickers
            uiOutput("pickers"),
            actionButton("button", "Update")
        ),
        
        mainPanel(
            
        )
    )
)

# server()
server <- function(input, output) {
    dt<-reactive({input$button
        name<-c("John","Jack","Bill")
        value1<-c(2,4,6)
        dt<-data.frame(name,value1)
        dt$value1<-dt$value1*isolate(input$num)
    })
    observeEvent(input$p1, {
        #Create the new pickers 
        output$pickers<-renderUI({
            div(lapply(input$p1, function(x){
                if (is.numeric(dt()[[x]])) {
                    sliderInput(inputId=x, label=x, min=min(dt()[x]), max=max(dt()[[x]]), value=c(min(dt()[[x]]),max(dt()[[x]])))
                }
                else if (is.factor(dt()[[x]])) {
                    selectInput(
                        inputId = x#The colname of selected column
                        ,
                        label = x #The colname of selected column
                        ,
                        choices = dt()[,x]#all rows of selected column
                        ,
                        multiple = TRUE
                        
                    )
                }
                
            }))
        })
    })
    
    
}

# shinyApp()
shinyApp(ui = ui, server = server)

标签： rshiny

解决方案

要使用用户输入数据，最好将其pickerInput移至服务器端。然后用于observeEvent更新反应数据并将其分配给 reactiveValues 数据帧。尝试这个

ui <- fluidPage(
  titlePanel(p("Spatial app", style = "color:#3474A7")),
  sidebarLayout(
    sidebarPanel(
      uiOutput("inputp1"),
      numericInput("num", label = ("value"), value = 1),
      #Add the output for new pickers
      uiOutput("pickers"),
      actionButton("button", "Update")
    ),
    
    mainPanel(
      
    )
  )
)

# server()
server <- function(input, output) {
  name<-c("John","Jack","Bill")
  value1<-c(2,4,6)
  dt<-data.frame(name,value1)
  
  DF1 <- reactiveValues(data=dt)
  
  output$inputp1 <- renderUI({
    pickerInput(
      inputId = "p1",
      label = "Select Column headers",
      choices = colnames( dt),
      multiple = TRUE,
      options = list(`actions-box` = TRUE)
    )
  })
  
  observeEvent(input$p1, {
    #Create the new pickers 
    output$pickers<-renderUI({
      dt1 <- DF1$data
      div(lapply(input$p1, function(x){
        if (is.numeric(dt1[[x]])) {
          sliderInput(inputId=x, label=x, min=min(dt1[[x]]), max=max(dt1[[x]]), value=c(min(dt1[[x]]),max(dt1[[x]])))
        }else { # if (is.factor(dt1[[x]])) {
          selectInput(
            inputId = x,       # The col name of selected column
            label = x,         # The col label of selected column
            choices = dt1[,x], # all rows of selected column
            multiple = TRUE
          )
        }
        
      }))
    })
  })
  
  observeEvent(input$button, {
    dt<-reactive({
      req(input$num)
      dt <- DF1$data ## here you can provide the user input data read inside this observeEvent or recently modified data DF1$data
      dt$value1<-dt$value1*isolate(input$num)
      return(dt)
    })
    
    DF1$data <- dt()
  })
  
  
}

# shinyApp()
shinyApp(ui = ui, server = server)

推荐阅读