Блог

Я пишу блестящее приложение, которое поможет моим коллегам немного лучше просматривать файлы csv.

Первая вкладка позволяет импортировать, а вторая — группировать данные.

Для простоты кодирования, если csv не загружен, используется mtcars набор данных.

Он принимает набор данных, а затем записывает сводки на основе выбранных столбцов и группировок.

Мне удалось разработать реактивный ввод, который принимает столбцы, которые вы хотели бы выбрать. Затем ввод группировки обновляется только теми столбцами, которые «выбраны» в качестве вариантов. Однако, похоже, это не передается функции, которая создает итоговый вывод. Это создает предупреждение:

Предупреждение: ошибка в: необходимо подмножество столбцов с допустимым вектором нижнего индекса. Индекс x имеет неправильный тип list . ℹ Он должен быть числовым или символьным. 119:

Хэшированный код приводит к сбою приложения shiny.

 library(shiny)
library(DT)
library(dplyr)

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

    myData <-reactive({
        if(is.null(input$file1)) return(mtcars)
        as.data.frame(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'))
            })

    observe({
        data <- myData()
        updateSelectInput(session, 'selected',choices=names(data))
    })


#    observeEvent(input$selected, {
#        data <- myData() %>% select(all_of(input$selected))
#        updateSelectInput(session, 'groupby', choices= names(data))
#    })



    output$group_summary <- renderPrint({
        myData() %>%
            select(all_of(input$selected)) %>%
            group_by(across(all_of(input$groupby))) %>%
            summary()

    })



}
)


ui <- shinyUI(fluidPage(


    titlePanel("Nya Statistikhanteraren"),
            # 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("Grouping",

             varSelectInput("selected", "Selected:", data, multiple = TRUE),
             varSelectInput("groupby", "Grouping:", data, multiple=TRUE),

             box(
                 title="Summary",
                 status="warning",
                 solidHeader=TRUE,
                 verbatimTextOutput("group_summary")
             )
             )
    )
  )
)

shinyApp(ui,server)
 

Я думаю, что это больше соответствует тому, чего вы хотите. Основная проблема с селекторами заключается в том, что они возвращали списки и all_of() хотели получить вектор, поэтому перенос input$selected as.character() решил эту проблему. Другая проблема, с которой вы могли бы столкнуться, заключается в том, что генерируемая сводка не была затронута group_by() оператором. Я изменил эту часть функции, чтобы вы получили сводку для каждой группы в вашем group_by аргументе. По-прежнему есть labels missing предупреждение, но я подозреваю, что вы можете устранить его.

 library(shiny)
library(DT)
library(dplyr)

server <- shinyServer(function(input, output, session){
  #     Add to your server
  observeEvent(input$browser,{
      browser()
  })
  
  myData <-reactive({
    if(is.null(input$file1)) return(mtcars)
    as.data.frame(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'))
    })
  
  observe({
    data <- myData()
    updateSelectInput(session, 'selected',choices=names(data))
  })
  
  
     observeEvent(input$selected, {
         data <- myData() %>% dplyr::select(all_of(as.character(input$selected)))
         updateSelectInput(session, 'groupby', choices= names(data))
     })
  
  
  
  output$group_summary <- renderPrint({
    if(length(input$groupby) >0){
    tmp <- myData() %>%
      dplyr::select(all_of(as.character(input$selected))) %>%
      group_by(across(all_of(as.character(input$groupby))))
    tk <- tmp %>% group_keys
    tk <- tk %>% as.matrix() %>% apply(1, paste, collapse="-")
    tmp <- tmp %>% group_split() %>% setNames(tk)
    lapply(tmp, summary)
    }
  }, width=600)
  
  
  
}
)


ui <- shinyUI(fluidPage(
  
  
  titlePanel("Nya Statistikhanteraren"),
  # 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("Grouping",
             actionButton("browser", label = ), 
             varSelectInput("selected", "Selected:", data, multiple = TRUE),
             varSelectInput("groupby", "Grouping:", data, multiple=TRUE),
             
             box(
               title="Summary",
               status="warning",
               solidHeader=TRUE,
               verbatimTextOutput("group_summary")
             )
    )
  )
)
)

shinyApp(ui,server)

 

Вот как я в конечном итоге решил эту проблему с помощью rlang. Примечание: приведенный ниже код содержит цепочку данных v $ …. которые я хотел бы использовать по порядку.

   #Grouping functionality.
    observe({
        if(is.null(v$datarecoded)){
          if(is.null(v$datafiltered)){
            data <- myData()
          } else {
            data <- v$datafiltered
          }
          } else{
          data <- v$datarecoded
          }

      updateSelectInput(session, 'selected',choices=names(data),selected = names(data)[1])
    })


    observeEvent(input$selected, {
        updateSelectInput(session, 'groupby', choices= input$selected)
    })

    output$summary <- renderPrint({
      if(is.null(v$datarecoded)){
        if(is.null(v$datafiltered)){
          data <- mydata()
        } else {
          data <- v$datafiltered
        }
      } else{
        data <- v$datarecoded
      }
        data %>%
            select(!!!rlang::syms(input$selected)) %>%
            group_by(!!!rlang::syms(input$groupby)) %>%
            summary()

    })

    grouped_summary_temp <- reactive({
      if(is.null(v$datarecoded)){
        if(is.null(v$datafiltered)){
          data <- mydata()
        } else {
          data <- v$datafiltered
        }
      } else{
        data <- v$datarecoded
      }

         data2 <- data %>%
          select(!!!rlang::syms(input$selected)) %>%
          group_by(!!!rlang::syms(input$groupby)) %>%
          summarise(across(.fns=list(Min=min,Max=max,Mean=mean,Median=median,SD=sd)))
         return(data2)

         })

    output$grouped_summary <- DT::renderDataTable({
      DT::datatable(grouped_summary_temp(), filter='top')
    })