Как использовать блестящие входы в строке для реактивной функции и в качестве условия для наблюдения события - PullRequest
2 голосов
/ 14 марта 2020

Я пытаюсь использовать автоматически генерируемые идентификаторы selectInput внутри реактивного элемента или наблюдать за событием. Когда я явно пишу идентификаторы ввода, такие как input$dfSelect1,input$dfSelect2,input$dfSelect3, это работает, как я хотел.

Поскольку я заранее не знаю, сколько будет идентификаторов (данные будут вводиться пользователем), мне нужно создать те же строки ввода идентификаторов, что и автоматически, но он не распознает их как триггер в наблюдать за событием или входными данными в реактивном элементе.

Вот минимальный воспроизводимый пример моей проблемы. если вы закомментируете строку 1 req(input$dfSelect1,input$dfSelect2,input$dfSelect3) и строку 2 dfx <- data.frame(carb = c(input$dfSelect1,input$dfSelect2,input$dfSelect3),stringsAsFactors = F) и удалите комментарий из следующих строк, я буду пытаться это сделать.

есть идеи, как передать эти значения?

library(dplyr)
library(DT)

exdata <- head(mtcars, 3) 
exdata$ROWs <- row.names(exdata)

ui <- fluidPage(
  headerPanel("Example"),
  mainPanel(
    uiOutput("selectionUI"),
    uiOutput("tableOutput")
  )
)

server <- function(input, output, server) {

  ### reqString result <- input$dfSelect1,input$dfSelect2,input$dfSelect3
  reqString <- noquote(paste0(unlist(lapply(1:length(sort(unique(row.names(exdata)))),function(i) {paste0("input$dfSelect",i,"")})),collapse = ","))

  values <- reactiveValues(
    upload_state = NULL
  )

  observe({
    ### 1-USE the line below with reqString instead -doesn't work ##
    req(input$dfSelect1,input$dfSelect2,input$dfSelect3)
    # req(reqString)
    values$upload_state <- 'uploaded'
  })

  output$selectionUI <- renderUI({
    df <- sort(unique(row.names(exdata)))
    wellPanel(
      lapply(1:length(df), function(i) {selectizeInput(paste0("dfSelect",i,""),df[i],choices=c("", unique(exdata$carb)))})
    )
  })

  completeTable <- reactive({
    browser()
    if (is.null(values$upload_state)) {
      return(exdata)
    }else if (values$upload_state == 'uploaded') {
      ### 2-USE the line below with  reqString instead -doesn't work##
      dfx <- data.frame(carb = c(input$dfSelect1,input$dfSelect2,input$dfSelect3),stringsAsFactors = F)
      # dfx <- data.frame(carb = c(reqString),stringsAsFactors = F)
      dfx <- data.frame(carb =as.numeric(unlist(dfx)))
      dataJoin <- exdata %>% left_join(dfx,by=("carb"))
    }
  })

  output$tableOutput <- renderUI({
    DT::dataTableOutput("dataTableServer")
  })

  output$dataTableServer <- DT::renderDataTable({
    DT::datatable(completeTable())
  })

}

shinyApp(ui = ui, server = server)

1 Ответ

1 голос
/ 14 марта 2020

Вы можете индексировать input, используя [[ вместо $:

sapply(1:length(sort(unique(row.names(exdata)))), 
       FUN=function(x) req(input[[paste0("dfSelect", x)]]))

и

l <- sapply(1:length(sort(unique(row.names(exdata)))), 
            FUN=function(x) input[[paste0("dfSelect", x)]])
dfx <- data.frame(carb = l,stringsAsFactors = F)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...