반짝이 R dataTables

Question

대상 동적 dplyr 생성을위한 입력 변수 사용 : Groupcheckboxfields 통해 3 개 입력 할 수 있도록 해주는 반짝이-앱 구축 을 :

• Groupingvariables
• Metricvariables
• 통계 어떤 dplyr에서 사용됩니다

이 코드를 먼저 살펴보십시오. 반짝임없이 실행되고 결과가 표시됩니다.

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 

이 동작을 빛나는 것으로 복사하려고했지만 운이 없었습니다. 지금 당장 문제가 생기고 데이터 테이블이 표시되지 않으며 오류도 표시되지 않습니다. 응용 프로그램은 기본적으로 아무 것도하지 않습니다.

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) 

어디에서 잘못 되었습니까? shiy에서 원하는 기능을 달성하기위한 또 다른 전략은 무엇입니까?

Answer 1

어쩌면이 시도 :

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)