Блог

Я работаю над приложением R shiny и пытаюсь агрегировать данные по сумме групп на основе переменной, выбранной мной в пользовательском интерфейсе. Ниже приведены мои необработанные данные:

 Date        Month    Site   enrollment
3/30/2020   2020-03  14     1
4/6/2020    2020-04  14     21
4/13/2020   2020-04  14     8
4/20/2020   2020-04  14     8
4/27/2020   2020-04  14     13
5/4/2020    2020-05  14     18
5/11/2020   2020-05  14     19
5/18/2020   2020-05  14     13
  

Я хочу агрегировать данные по сумме групп.

 Month   Site    enrollment
2020-03     14   1
2020-04     14  50
2020-05     14  35

  

Я пытаюсь создать реактивные данные с помощью приведенного ниже кода:

 raw<-subset(aggregate(get(input$ycol) ~ get(input$xcol) get(input$fill),df, sum),get(input$ycol)!=0);
  

К сожалению, R shiny не распознает get(input$ycol) . Если я изменю его на имя переменной, которое я выбираю (например, сайт, регистрация), тогда он работает хорошо.

Ниже приведен мой блестящий код.

 library(dplyr)

# Define UI for overall application
ui <- fluidPage(
  
  # Application title
  titlePanel("Data Visualization  -- Clinical Study Enrollment"),
  
  tabsetPanel(
    # Data upload tab
    tabPanel("Upload File",
             titlePanel("Upload CSV File"),
             
             # sidebar layout with input and output definitions--
             sidebarLayout(
               
               # sidebar panel for inputs --- 
               sidebarPanel(
                 
                 # input-- select file
                 fileInput('file_input',
                           'Choose CSV(UTF-8) File',
                           multiple = FALSE,
                           accept = c('text/csv',
                                      'text/comma-separated-values,text/plain',
                                      '.csv')),
                 
                 # Horizontal line ----
                 tags$hr(),
                 
                 checkboxInput('header', 'Header', TRUE),
                 
                 radioButtons('sep',
                              'Separator',
                              c(Comma=',',
                                Semicolon=';',
                                Tab='t'),
                              ','),
                 
                 radioButtons('quote',
                              'Quote',
                              c(None='',
                                'Double Quote'='"',
                                'Single Quote'="'"),
                              '"'),
                 tags$hr(),
                 
                 # Input: Select number of rows to display ----
                 radioButtons("disp", "Display",
                              choices = c(Head = "head",
                                          All = "all"),
                              selected = "head")
               ),
               
               # main panel to display outputs
               mainPanel(
                 # output-- data file
                 DT::dataTableOutput('contents')
               )
             )
    ),
    
    # point estimate line plot
    tabPanel("Clinical study enrollment Plot",
             pageWithSidebar(
               headerPanel('Clinical study enrollment Plot'),
               
               sidebarPanel(
                 # drop down menu inputs
                 selectInput('xcol', 'Select X', ""),
                 
                 selectInput('ycol', 'Select Y', ""),
                 
                 selectInput('fill', 'Group', ""),
                 
              
               ),
               
               mainPanel(
                
                 DT::dataTableOutput('lineplot_table'))
             )
             
    )))


server <- function(input, output, session) {
  # Read upload file
  upload_data <- reactive({
 
    
    req(input$file_input);
    
    tryCatch({
      df <- read.csv(input$file_input$datapath,
                     header = input$header,
                     sep = input$sep,
                     quote = input$quote,
                     stringsAsFactors = FALSE,check.names=FALSE,fileEncoding = "UTF-8-BOM");
    }, error = function(e) {
      stop(safeError(e));
    })
    
    
    return(df);
  })
  
  
  # Display
  display_data <- reactive({
    df <- upload_data();
    
    if(input$disp == "head") {
      return(head(df));
    } else {
      return(df);
    }
  })
  
  observe({
    df <- upload_data();
    updateSelectInput(session, inputId = 'xcol',
                      label = 'Select X',
                      choices = names(df), selected = "Site");
    updateSelectInput(session, inputId = 'ycol',
                      label = 'Select Y',
                      choices = names(df), selected = "enrollment");
    updateSelectInput(session, inputId = 'fill',
                      label = 'Group',
                      choices = names(df), selected = "Date");
    
  })
  
  # Get bar plot data
  get_barplot_data <- reactive({
    
    df <- upload_data();
   
    raw<-subset(aggregate(get(input$ycol) ~ get(input$xcol) get(input$fill),df, sum),get(input$ycol)!=0);
    
    return(raw)
  })
  
  
 
  # Display data you uploaded
  output$contents <- DT::renderDataTable({
    display_data();
  })
  
  output$lineplot_table <- DT::renderDataTable({
    get_barplot_data();
    
  })
  
 
  
}

shinyApp(ui = ui, server = server)
  

Попробуйте использовать as.formula or reformulate в этом случае, чтобы построить свою формулу. Это позволит вам использовать символьные значения из shiny input при создании формулы для aggregate .

Например:

 raw <- subset(
  aggregate(
    reformulate(
      response = input$ycol,
      termlabels = c(input$xcol, input$fill)
    ),
    df,
    FUN = sum
  ),
  get(input$ycol) != 0
)