Генерация значений данных динамически на основе входных данных из другого столбца

Я создал таблицу данных, в одном из столбцов которой есть виджеты selectInput. Другой столбец таблицы данных должен принимать входные данные, указанные в первом столбце, и использовать их для поиска числа в моем источнике данных. Входные данные правильно связываются в Shiny с помощью функций preDrawCallback и drawCallback, но значения поиска не обновляются при изменении входных данных. Как ни странно, они обновляются, когда я ищу в отдельной таблице данных. Воспроизводимый пример здесь:

library(shiny)
library(DT)

data <- data.frame(c(1:7),c(21:27))

shinyApp(
  server = shinyServer(function(input, output) {
      output$table <- DT::renderDataTable({

        Rows <- c(1:7)
        temp <- data.frame(Rows)  
        temp[,"Item"] <- ""
        temp[,"Value"] <- ""
        temp$Rows <- NULL

        sapply(1:7, FUN = function(i) {
          temp$Item[i] <<- as.character(selectInput(paste("Item.1.1",i, sep = "."), "",
                                                       choices = setNames(c(1:7),c(1:7)),
                                                       selected = 1,
                                                       multiple = FALSE))
        })

         sapply(1:7, FUN = function(i) {
           temp$Value[i] <<- data[eval(parse(text = paste("input$Item.1.1",i, sep = "."))),2]
         })

        datatable(temp, escape = FALSE, rownames = FALSE,
                  options = list(sort = FALSE, paging = FALSE, searching = FALSE, dom = 't',
                                 columnDefs = list(list(className = 'dt-center', targets = 0:1)),
                                 preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                                 drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
                  ))
    }, server = FALSE)
  }),
  ui = fluidPage(
    dataTableOutput("table")
  )
)

Это дает ошибку «Ошибка в temp $ Value [i] ‹< - data [eval (parse (text = paste (« input $ Item.1.1 »,: replace has length zero»).

Я попытался добавить это на сервер:

test <- reactive({
              data.frame(c(ifelse(is.null(input$Item.1.1.1),"",data[eval(parse(text = paste("input$Item.1.1",1, sep = "."))),2]),
                ifelse(is.null(input$Item.1.1.2),"",data[input$Item.1.1.2,2]),
                ifelse(is.null(input$Item.1.1.3),"",data[input$Item.1.1.3,2]),
                ifelse(is.null(input$Item.1.1.4),"",data[input$Item.1.1.4,2]),
                ifelse(is.null(input$Item.1.1.5),"",data[input$Item.1.1.5,2]),
                ifelse(is.null(input$Item.1.1.6),"",data[input$Item.1.1.6,2]),
                ifelse(is.null(input$Item.1.1.7),"",data[input$Item.1.1.7,2])))
            })

Затем, когда я закомментирую соответствующий sapply в моем renderDataTable и вместо этого назначаю temp [, "Value"] ‹- test (), я получаю 21 во втором столбце моей таблицы данных, и он не меняется при изменении selectInputs.

В качестве теста я попытался включить это в свою подачу вместе с соответствующим dataTableOutput () в моем пользовательском интерфейсе:

             output$test1 <- DT::renderDataTable({
               test()
             })

test1 ведет себя так, как ожидалось, тогда и только тогда, когда второй sapply закомментирован внутри renderDataTable. Если это не закомментировано, в обеих таблицах есть столбец не отвечающих 21.

Это сводило меня с ума весь день, поэтому любые мысли сильно улучшат мою жизнь!


r shiny dt
person David Zornek    schedule 28.08.2015    source источник

Ответы (1)


arrow_upward
2
arrow_downward

Вы слишком рано используете выбранные входные значения:

 sapply(1:7, FUN = function(i) {
   temp$Value[i] <<- data[eval(parse(text = paste("input$Item.1.1",i, sep = "."))),2]
 })

К тому времени, когда вы используете эти значения, выбранные входы еще даже не были отображены на странице, поэтому неудивительно, что вы получаете NULL. Вы не можете присвоить NULL tmp$Value[i].

Затем по поводу сбоя с:

temp[,"Value"] <- test()

Я не понимаю, что это значит: test() возвращает фрейм данных, а temp[, "Value"] - вектор. Я думаю, вам следует использовать c() вместо data.frame() в реактиве.

Что-то не по теме, потому что я действительно ничего не могу поделать: почти всегда использовать eval(parse(text = ...)) - плохая идея. Вы можете просто использовать input[paste("Item.1.1", i, sep = ".")] вместо построения кода R и eval() его. И input$foo, и input['foo'] дают вам значение ввода с идентификатором foo. Последняя форма больше подходит в этом случае.

person Yihui Xie    schedule 02.09.2015
comment
Спасибо за советы. Я вообще не знал о синтаксисе input ['foo']! В итоге я использовал другое решение, в котором был selectizeInput над datatable, а затем использовал этот ввод для генерации моих строк datatable, но я уверен, что ваш совет пригодится для будущих проблем. - person David Zornek; 03.09.2015