brillant R à l'aide d'entrée-variables pour la création d'dplyr dynamique de datatables

Question

cible: Construire une application brillante qui permet à l'utilisateur d'effectuer 3 entrées via Groupcheckboxfields:

• Groupingvariables
• Metricvariables
• statistique qui sont utilisés dans dplyr

Regardez d'abord ce code - il est exécuté sans brillant et affiche les résultats à obtenir:

library("plyr") 
library("dplyr") 

## Without shiny - it works! 

groupss <- c("gear", "carb") 
statistics <- c("min", "max", "mean") 
metrics <- c("drat", "hp") 

grp_cols <- names(mtcars[colnames(mtcars) %in% groupss]) 
dots <- lapply(grp_cols, as.symbol) 

funct <- statistics 
funct <- lapply(funct, as.symbol) 

vars <- lapply(metrics, as.symbol) 


# A table is created successfully! 
mtcars %>% 
    group_by_ (.dots = dots) %>% 
    summarise_each_(funs_ (funct), vars) 
# idea taken from http://stackoverflow.com/questions/21208801/group-by-multiple-columns-in-dplyr-using-string-vector-input 

J'ai essayé de copier ce comportement à brillant, mais sans chance. En ce moment j'ai le problème, qu'aucune table de données n'est montrée - et également aucune erreur n'est donnée. L'application ne fondamentalement rien:

library(shiny) 
library(dplyr) 

# Define UI for application 
ui <- fluidPage(

    # Application title 
    titlePanel("dplyr and shiny"), 

    # Sidebar with 3 different filters 
    sidebarLayout(
    sidebarPanel(
     checkboxGroupInput(inputId = "var1_groups", 
         label = "Grouping vars", 
         choices = colnames(mtcars[7:10])), 
     checkboxGroupInput(inputId = "var2_metrics", 
         label = "Metric Vars", 
         choices = colnames(mtcars[1:6])), 
     checkboxGroupInput(inputId = "var3_statistics", 
         label = "Statistics", 
         choices = c("mean", "median", "sd", "min")) 
    ), 

    # Show a data table when claculations from server are done 
    mainPanel(dataTableOutput("x")) 

) 
) 


# Define server logic 
server <- function(input, output) { 

    # Save inputs in vectors 
    groupss <- reactive(input$var1_groups) 
    metrics <- reactive(input$var2_metrics) 
    statistics <- reactive(var3_statistics) 

    # Try to make them to symbols for implementation in dplyr-code 
    # symbols for Grouping variables 
    grp_cols <- reactive(names(mtcars[colnames(mtcars) %in% groupss])) 
    grp_cols <- reactive(lapply(grp_cols(), as.symbol)) 

    # Symbols for metrics 
    metrics <- reactive(names(mtcars[colnames(mtcars) %in% metrics])) 
    metrics <- reactive(lapply(funct, as.symbol)) 

    # Symbols for Statistics 
    statistics <- reactive(lapply(statistics, as.symbol)) 

# Use the created symbols in the dplyr-function 
    x <- reactive({mtcars %>% 
     group_by_ (.grp_cols = grp_cols) %>% 
     summarise_each_ (funs_ (statistics), metrics)}) 

    renderDataTable(x) 
} 

# Run the application 
shinyApp(ui = ui, server = server) 

Où est-ce que je me trompe - ce serait une autre stratégie pour achive la fonctionnalité souhaitée dans Shiy?

Answer 1

Peut-être essayer ceci:

library(shiny) 
library(dplyr) 

# Define UI for application 
ui <- fluidPage(

    # Application title 
    titlePanel("dplyr and shiny"), 

    # Sidebar with 3 different filters 
    sidebarLayout(
     sidebarPanel(
      checkboxGroupInput(inputId = "var1_groups", 
           label = "Grouping vars", 
           choices = colnames(mtcars[7:10]), 
           selected = colnames(mtcars[7:10])), 
      checkboxGroupInput(inputId = "var2_metrics", 
           label = "Metric Vars", 
           choices = colnames(mtcars[1:6]), 
           selected = colnames(mtcars[1:6])), 
      checkboxGroupInput(inputId = "var3_statistics", 
           label = "Statistics", 
           choices = c("mean", "median", "sd", "min"), 
           selected = c("mean", "sd", "min")) 
     ), 

     # Show a data table when claculations from server are done 
     mainPanel(dataTableOutput("x")) 
    ) 
) 

# Define server logic 
server <- function(input, output) { 

    # Use the created symbols in the dplyr-function 
    x <- reactive({ 

     req(input$var3_statistics) 

     grp_cols <- lapply(input$var1_groups, as.symbol) 
     metrics <- lapply(input$var2_metrics, as.symbol) 
     statistics <- lapply(input$var3_statistics, as.symbol) 

     a <- mtcars %>% 
      group_by_ (.dots = grp_cols) %>% 
      summarise_each_ (funs_ (statistics), metrics) 

     return(a) 
    }) 
    output$x <- renderDataTable({ 
     x() 
    }) 
} 

# Run the application 
shinyApp(ui = ui, server = server)