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

Question

Я создал данные, которые имеют 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") 
) 
) 

Это дает ошибку "Ошибка температура $ Value [я] < < - данные [Eval (синтаксический анализ (текст = паста (" вход $ Item.1.1" ,: замене имеет нулевую длину»

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

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 и вместо того, чтобы назначить темп [,.„Значение“] < - тест (), Я получаю 21 до секона d столбца моего datatable, и он не изменяется при изменении selectInputs.

В качестве теста, я попытался в том числе это в моем служить, в сочетании с соответствующим dataTableOutput() в моем Ui:

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

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

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

Answer 1

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

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

К тому времени, когда вы используете эти значения, то выберите входы еще даже не были вынесены на странице еще, так что не удивительно, что вы получите NULL ' s. Вы не можете назначить 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. Последняя форма более подходит в этом случае.