Shiny：對 DT 的反應值：數據表

Question

我正在創建一個 shiny 應用程序，我的用戶可以在其中手動重新編碼變量（種類）。 目前主要有兩個問題：

1. DT::datatable 不喜歡在用戶按下“執行重新編碼”后通過預期的 output 進行渲染。 反應值 v$data 存儲要在 tabPanel 之間傳遞的 output 表。 由於這被傳遞給 DT::datatable()，v$data 導致錯誤'data' must be 2-dimensional (eg data frame or matrix) 。

2. 我很確定當我將文本輸入解析到重新編碼時可能會出現問題：即 paste0(paste0('input$','recode_call_when',i))

服務器

shinyServer(function(input, output, session){

  v <- reactiveValues(data=NULL)
  d <- reactiveValues(print_execute_complete=FALSE)

    myData <-reactive({
        if(is.null(input$file1)) return(mtcars)
        as.data.frame(data.table::rbindlist(lapply(X=input$file1$datapath, FUN=read.csv,
                  quote=input$quote, sep=input$sep, header=input$header, dec=input$decimal),
                  use.names = TRUE,fill=TRUE
        ))
    })

    output$contents <-
            DT::renderDataTable({
              return(DT::datatable(myData(), filter='top'))
            })

    #Count the number of recoding terms to render
    counter <- reactiveValues(n = 1)

    #Recoding button functionality

    observeEvent(input$add_recode, {counter$n <-  counter$n + 1})
    observeEvent(input$rm_recode, {
      if(counter$n > 0) counter$n <-  counter$n - 1
      })



    recoding_i <- reactive({

      n <- counter$n

      if(n>0){
        isolate({
          lapply(seq_len(n),function(i){

            fluidRow(
              column(width=4,
              textInput(inputId = paste0('recode_call_variable',i),
                     label=paste0('Variable_',i))),


              column(width=4,
            textInput(inputId = paste0('recode_call_when',i),
                                 label=paste0('When_', i))),
            column(width=4,
            textInput(inputId= paste0('recode_call_then',i),
                                    label=paste0('Then_', i)))
            )
          }
          )

      })
    }
  })

    output$recoding <- renderUI({ recoding_i() })

    #Observes press of recode button.
     observeEvent(input$'execute_recode',{
       d$print_execute_complete <- TRUE
     })

     #Observes press of recode button.
     observeEvent(input$'reset_recode',{
       d$print_execute_complete <- FALSE
     })


     #Loop over recoding input boxes.
     v$data <- reactive({
       if(d$print_execute_complete == TRUE){
       if(is.null(v$data)){
         lapply(seq_len(n), function(i){
           myData() %>% mutate(paste0(paste0('input$','recode_call_variable',i), '=', 'case_when(',paste0('input$','recode_call_when',i), '~', paste0('input$','recode_call_then',i),")"))
           })
           } else {
             lapply(seq_len(n), function(i){
           v$data %>%  mutate(paste0(paste0('input$','recode_call_variable',i), '=', 'case_when(',paste0('input$','recode_call_when',i), '~', paste0('input$','recode_call_then',i),")"))
             })
           }
       }
     })






#Confirmation text
     output$execute_complete <- renderText({
       req(d$print_execute_complete)
       if(d$print_execute_complete == TRUE){
         "Recoding Complete."
       }

     })

     #Render recoded data table
     output$recoded_dt <- DT::renderDataTable({
       req(d$print_execute_complete == TRUE)
       if(!is.null(v$data)){
         return(DT::datatable(v$data, filter='top'))

       } else {
         return(DT::datatable(myData(),filter='top'))
       }
     })

})

用戶界面

shinyUI(fluidPage(


    titlePanel("Something's Wrong"),
            # Input: Select a file ----
    navlistPanel(
        tabPanel("Import",
                fileInput("file1", "Choose CSV File",
                          multiple = TRUE,
                          accept = c("text/csv",
                                     "text/comma-separated-values,text/plain",
                                     ".csv")),

            # Horizontal line ----
                tags$hr(),

            # Input: Checkbox if file has header ----
                checkboxInput("header", "Header", TRUE),

            # Input: Select separator ----
                radioButtons("sep", "Separator",
                            choices = c(Comma = ",",
                                        Semicolon = ";",
                                        Tab = "\t"),
                            selected = "\t"),

            # Input: Select quotes ----
                radioButtons("quote", "Quote",
                            choices = c(None = "",
                                        "Double Quote" = '"',
                                        "Single Quote" = "'"),
                            selected = '"'),

            # Input: Select decimal ----

            radioButtons("decimal","Decimal",
                         choices = c(Comma = ",",
                                     Dot = "."),
                         selected=","),

            # Horizontal line ----
                tags$hr(),

    # Main panel for displaying outputs ----


            # Output: Data file ----
                DT::dataTableOutput("contents")
        ),
    tabPanel("Recoding",

             h3("Instruction"),

             fluidRow(p("Write a functional call in one of the action boxes below. A call takes the form of one of the following :"
               ,style="font-family: 'times'; font-si16pt"),

             span(em("Old Variable == Value"),strong("  e.g. gear == 4")),
             br(),
             span(em("Old Variable > Value"),strong("e.g. gear > 4")),
             br(),
             span(em("Old Variable >= Value"), strong("e.g. gear >= 4")),
             br(),
             span(em("Old Variable != Value"),strong("e.g. gear != 4, 'is not equal to'")),
             br(),
             br(),
             p("A variable can be inside a span:"),
             br(),
             span(em("Old Variable > Value & Old Variable < Value2"), strong("e.g. gear > 2 & gear <=4")),
             br(),
             br(),
             p("A variable can be defined if it is one or the other:"),
             br(),
             span(em("Old Variable < Value | Old Variable == Value2"),strong("e.g. gear <= 2 | gear == 4")),
             br(),
             br()
             ),

             fluidRow(actionButton('add_recode', 'Add recode term'),
             actionButton('rm_recode', 'Remove recode term')),
             br(),
             br(),
             uiOutput('recoding'),
             br(),
             br(),
             fluidRow(actionButton('execute_recode', "Recode",icon = icon('angle-double-right')),
                      actionButton('reset_recode', "Reset", icon=icon('angle-double-right'))),
             textOutput('execute_complete'),
             br(),
             br(),
             br(),
             DT::dataTableOutput('recoded_dt')

    )
)
)
)

Answer 1

這是我解決它的方法：注意。 有幾個 v$data.，我想按順序使用。 取決於我的用戶已經做了什么。

    #Count the number of recoding terms to render
    counter <- reactiveValues(n = 0)

    #Recoding button functionality

    observeEvent(input$add_recode, {counter$n <-  counter$n + 1})
    observeEvent(input$rm_recode, {
      if(counter$n > 0) counter$n <-  counter$n - 1
      })



    recoding_i <- reactive({

      n <- counter$n

      if(n>0){
        isolate({
          lapply(seq_len(n),function(i){

            fluidRow(
              column(width=4,
                     textInput(inputId=paste0('recode_name',i),
                               label=paste0("Variable Name",i))),

              column(width=4,
              textInput(inputId = paste0('recode_call',i),
                     label=paste0('Code',i)))
            )
          }
          )

      })
    }
  })

    output$recoding <- renderUI({ recoding_i() })

    #Observes press of recode button.
     observeEvent(input$'execute_recode',{
       v[["print_execute_complete"]] <- TRUE
     })

     #Observes press of recode button.
     observeEvent(input$'reset_recode',{
       v[["print_execute_complete"]] <- FALSE
     })


     #Loop over recoding input boxes.
    observeEvent(v$print_execute_complete, {
      if(v[["print_execute_complete"]] == TRUE){
        n <- counter$n
        if(n==0){
          if(is.null(v$datafiltered)){
            v$datarecoded <- myData()
          } else {
            v$datarecoded <- v$datafiltered
          }

          } else {
            if(is.null(v$datafiltered)){
           v$datarecoded <- myData()
            } else {
              v$datarecoded <- v$datafiltered
           lapply(seq_len(n), function(i){
             recode_call_i <- rlang::parse_expr(rlang::eval_tidy(rlang::parse_expr(eval(paste0("input$recode_call",i)))))

             var_name_i <- rlang::sym(rlang::eval_tidy(rlang::parse_expr(paste0("input$recode_name",i))))

             v$datarecoded <- mutate(v$datarecoded,!!var_name_i := !!recode_call_i)
           }
           )
             }
      }
      }
    }
    )




#Confirmation text
     output$execute_complete <- renderText({
       req(v[["print_execute_complete"]])
       if(v[["print_execute_complete"]] == TRUE){
         "Recoding Complete."
       }

     })

     #Render recoded data table
     output$recoded_dt <- DT::renderDataTable({
       req(v[["print_execute_complete"]] == TRUE)
       if(!is.null(v[["datarecoded"]])){
         return(DT::datatable(v[["datarecoded"]], filter='top'))

       } else if(v[["print_filter_complete"]] == TRUE & !is.null(v[["datafiltered"]])) {
         return(DT::datatable(v[["datafiltered"]], filter='top'))

         } else {

         DT::datatable(myData(),filter='top')
       }
       })