将 dplyr 中的 get(paste0()) 对象解析为 Shiny 应用程序

Question

我正在 Shiny 中构建一个新应用程序，它需要执行 flexible/reactive 聚合数据集以接收一些输入 ID。我真的很喜欢 dplyr，所以我用它来创建这个数据集。但是我在解析命令时遇到错误

... %>% summarise( get(paste0(substr(dis,1,4),".mean")) = mean(dis), count = n() )

这是数据集的例子：

n=100
taxi <- data.frame(conversion=c(rep(1,20),rep(0,80)),
             day = sample(1:7, n, TRUE),
             hour = sample(0:23,n, TRUE),
             source= sample(1:4, n, TRUE),
             service= sample(1:5, n, TRUE),
             relevancy= sample(1:4, n, TRUE),
             tollfree= sample(c(0,1), n, TRUE),
             distance= sample(0:15, n, TRUE),
             similarity= sample(seq(0,1,0.01), n, TRUE),
             simi.names= sample(c('[0,0.25)','[0.25,0.5)','[0.5,0.75)','[0.75,1]'), n, TRUE),
             dist.names= sample(c('[0,1)','[1,2)','[2,3)','[3,4)','[4,15]'), n, TRUE),
             week= sample(1:7, n, TRUE),
             rel= sample(c(1,4), n, TRUE))

这就是我最后一次尝试的样子： Ui.R

shinyUI(navbarPage("",
               tabPanel("Data",
                        sidebarLayout(
                          sidebarPanel(
                            selectInput("dataset", h5("Choose a dataset:"), choices = c("taxicabs", "liquor stores")),
                            radioButtons("discrete", h5("I want to discretize:"), choices = c("similarity", "distance","similarity & distance","none"),
                                               inline=F, selected = "none"),
                            radioButtons("agg", h5("I want to aggregate:"), choices = c("day in weekdays/weekends", "revelancy in binary revelancy",
                                                                                             "day in weekdays/weekends &  revelancy in binary revelancy","none"),
                                         inline=F, selected = "none"),
                            checkboxGroupInput("checkGroup", label = h5("Dataset Features:"), 
                                               choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"), inline = F,
                                               selected = c("day","hour","source","service","relevancy","tollfree","distance","similarity"))
                          ),
                          mainPanel(
                            numericInput("obs", label = h5("Number of observations to view"), 10, min = 5, max = 15, step = 1),
                            tableOutput("view") 
                          )
                        )
               ),
               tabPanel("Model",
                        h3("Best logistic model with logit link and variable selection via stepwise AIC "),
                        verbatimTextOutput("model"),
                        h3("MSE"),
                        tableOutput("measures")
               ),
               tabPanel("Graphs",
                        sidebarLayout(
                          sidebarPanel(    
                            selectInput('zcol', 'Variable to be fixed',  names(taxi[,-c(1,4,5,7,8,9,10,11)])),
                            selectInput("levels", "Levels",1:5)
                          ),
                          mainPanel(
                            plotOutput('plot3'),
                            plotOutput('plot1'),
                            plotOutput('plot2')
                          )
                        ))

 ))

Server.R

shinyServer(function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset,
       "taxicabs" = taxi,
       "liquor stores" = liq)
 })

observe({
if (input$discrete == 'none' & input$agg == 'none') {
  updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"),
                           inline=F, selected =c("day","hour","source","service","relevancy","tollfree","distance","similarity"))
} else if (input$discrete == 'none' & input$agg == 'day in weekdays/weekends'){
  updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","relevancy","tollfree","distance","similarity"),
                           inline=F, selected =c("week","hour","source","service","relevancy","tollfree","distance","similarity"))
} else if (input$discrete == 'none' & input$agg == 'revelancy in binary revelancy'){
  updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","rel","tollfree","distance","similarity"),
                           inline=F, selected =c("day","hour","source","service","rel","tollfree","distance","similarity"))
} else if (input$discrete == 'none' & input$agg == 'day in weekdays/weekends &  revelancy in binary revelancy'){
  updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","rel","tollfree","distance","similarity"),
                           inline=F, selected =c("week","hour","source","service","rel","tollfree","distance","similarity"))
}

  else if(input$discrete == 'similarity' & input$agg == 'none') {
  updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","relevancy","tollfree","distance","simi.names"),
                           inline=F, selected = c("day","hour","source","service","relevancy","tollfree","distance","simi.names"))
  } else if (input$discrete == 'similarity' & input$agg == 'day in weekdays/weekends'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","relevancy","tollfree","distance","simi.names"),
                             inline=F, selected =c("week","hour","source","service","relevancy","tollfree","distance","simi.names"))
  } else if (input$discrete == 'similarity' & input$agg == 'revelancy in binary revelancy'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","rel","tollfree","distance","simi.names"),
                             inline=F, selected =c("day","hour","source","service","rel","tollfree","distance","simi.names"))
  } else if (input$discrete == 'similarity' & input$agg == 'day in weekdays/weekends &  revelancy in binary revelancy'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","rel","tollfree","distance","simi.names"),
                             inline=F, selected =c("week","hour","source","service","rel","tollfree","distance","simi.names"))
  }

  else if(input$discrete == 'distance' & input$agg == 'none') {
  updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","relevancy","tollfree","dist.names","similarity"),
                           inline=F, selected =c("day","hour","source","service","relevancy","tollfree","dist.names","similarity"))
  } else if (input$discrete == 'distance' & input$agg == 'day in weekdays/weekends'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","relevancy","tollfree","dist.names","similarity"),
                             inline=F, selected =c("week","hour","source","service","relevancy","tollfree","dist.names","similarity"))
  } else if (input$discrete == 'distance' & input$agg == 'revelancy in binary revelancy'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","rel","tollfree","dist.names","similarity"),
                             inline=F, selected =c("day","hour","source","service","rel","tollfree","dist.names","similarity"))
  } else if (input$discrete == 'distance' & input$agg == 'day in weekdays/weekends &  revelancy in binary revelancy'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","rel","tollfree","dist.names","similarity"),
                             inline=F, selected =c("week","hour","source","service","rel","tollfree","dist.names","similarity"))
  }

  else if(input$discrete == 'similarity & distance' & input$agg == 'none') {
  updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","relevancy","tollfree","dist.names","simi.names"),
                           inline=F, selected =c("day","hour","source","service","relevancy","tollfree","dist.names","simi.names"))
  } else if (input$discrete == 'similarity & distance' & input$agg == 'day in weekdays/weekends'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","relevancy","tollfree","dist.names","simi.names"),
                             inline=F, selected =c("week","hour","source","service","relevancy","tollfree","dist.names","simi.names"))
  } else if (input$discrete == 'similarity & distance' & input$agg == 'revelancy in binary revelancy'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("day","hour","source","service","rel","tollfree","dist.names","simi.names"),
                             inline=F, selected =c("day","hour","source","service","rel","tollfree","dist.names","simi.names"))
  } else if (input$discrete == 'similarity & distance' & input$agg == 'day in weekdays/weekends &  revelancy in binary revelancy'){
    updateCheckboxGroupInput(session, "checkGroup", choices = c("week","hour","source","service","rel","tollfree","dist.names","simi.names"),
                             inline=F, selected =c("week","hour","source","service","rel","tollfree","dist.names","simi.names"))
  }
 })

 observe({ 
if(input$discrete == "similarity & distance") {

  #all discrete 
  datasetagg <- reactive({ 
    eval(substitute(right_join(
      datasetInput() %>% select(cg) %>% group_by(cg) %>% summarise(count=n()),
      datasetInput() %>% filter(conversion==1) %>% select(icg) %>% count(cg)
    ) %>% mutate(prop.conv = n/count), 
    list(cg=as.symbol(input$checkGroup))))
  })

} else if(input$discrete == "similarity" | "distance") {

  # one continuous
  datasetagg <- reactive({ 
    eval(substitute(right_join( # the error is in the next line!
      datasetInput() %>% select(cg) %>% group_by(cg[-which(cg == dis)]) %>% summarise(get(paste0(substr(dis,1,4),".mean"))=mean(dis),count=n()),
      datasetInput() %>% filter(conversion==1) %>% select(cg) %>% count(cg[-which(cg == dis)])
    ) %>% mutate(prop.conv = n/count), 
    list(cg=as.symbol(input$checkGroup),
         dis=as.symbol(input$discrete))))
  })

} else if(input$discrete == "none") {

  # two  
  datasetagg <- reactive({ 
    eval(substitute(right_join(
      datasetInput() %>% select(cg) %>% group_by(cg[-which(cg == c('distance','similarity'))]) %>% summarise(dist.mean=mean(distance),simi.mean=mean(similarity),count=n()),
      datasetInput() %>% filter(conversion==1) %>% select(cg) %>% count(cg[-which(cg == c('distance','similarity'))])
    ) %>% mutate(prop.conv = n/count), 
    list(cg=as.symbol(input$checkGroup))))
  })
}
})

# head of the table  
output$view <- renderTable({
head(datasetagg(), n = input$obs)
})


 })

有什么建议吗？感谢您的帮助！

Answer 1

但是，真正的问题是您试图使用 get(paste0(substr(dis,1,4),".mean")) 作为 summarise 中的参数名称。 R 中的命名参数不会被评估，它们只是一段文本。

您粘贴的代码需要大量重写。

顶部的第一个 observe 部分不必要地令人费解 - 它可以简化为 4 个 if 语句，如图所示。
您不能像以前那样动态定义 reactive。您需要声明一个 reactive ，其中包含所有条件逻辑。在 dplyr 代码之外对输入变量进行任何必要的处理也更加简洁。
当您为 select、group_by 等动态定义列时，您可以使用最初打算使用 eval(substitute()) 的方法，但是它使代码更难正确编写。在我看来，使用函数的标准评估版本要好得多，例如select_ 和 group_by_。对于input$checkgroup，您需要使用.dots参数（对于count_需要使用vars参数）。
在您的原始代码中，您将 input$checkgroup 变量强制转换为一个符号，该符号仅采用向量的第一个元素。
在summarise_中动态命名列的方法是使用setNames和.dots参数。

我仍然不确定某些输出是否正是您想要的，尤其是比例列，但这应该可以让您在此基础上有所建树。

ui.R

library(shiny)

shinyUI(navbarPage("",
                   tabPanel("Data",
                            sidebarLayout(
                              sidebarPanel(
                                selectInput("dataset", h5("Choose a dataset:"), choices = c("taxicabs", "liquor stores")),
                                radioButtons("discrete", h5("I want to discretize:"), choices = c("similarity", "distance","similarity & distance","none"),
                                             inline=F, selected = "none"),
                                radioButtons("agg", h5("I want to aggregate:"), choices = c("day in weekdays/weekends", "relevancy in binary relevancy",
                                                                                            "day in weekdays/weekends &  relevancy in binary relevancy","none"),
                                             inline=F, selected = "none"),
                                checkboxGroupInput("checkGroup", label = h5("Dataset Features:"), 
                                                   choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"), inline = F,
                                                   selected = c("day","hour","source","service","relevancy","tollfree","distance","similarity"))
                              ),
                              mainPanel(
                                numericInput("obs", label = h5("Number of observations to view"), 10, min = 5, max = 15, step = 1),
                                tableOutput("view") 
                              )
                            )
                   ),
                   tabPanel("Model",
                            h3("Best logistic model with logit link and variable selection via stepwise AIC "),
                            verbatimTextOutput("model"),
                            h3("MSE"),
                            tableOutput("measures")
                   ),
                   tabPanel("Graphs",
                            sidebarLayout(
                              sidebarPanel(    
                                selectInput("zcol", "Variable to be fixed",  c("hour", "source", "tollfree", "rel")),
                                selectInput("levels", "Levels",1:5)
                              ),
                              mainPanel(
                                plotOutput("plot3"),
                                plotOutput("plot1"),
                                plotOutput("plot2")
                              )
                            ))

))

server.R

library("shiny")
library("dplyr")

n <- 1000
taxi <- data.frame(day = sample(1:7, n, TRUE),
                   hour = sample(0:23,n, TRUE),
                   source= sample(1:4, n, TRUE),
                   service= sample(1:5, n, TRUE),
                   relevancy= sample(1:4, n, TRUE),
                   tollfree= sample(c(0,1), n, TRUE),
                   distance= sample(0:15, n, TRUE),
                   similarity= sample(seq(0,1,0.01), n, TRUE),
                   simi.names= sample(c('[0,0.25)','[0.25,0.5)','[0.5,0.75)','[0.75,1]'), n, TRUE),
                   dist.names= sample(c('[0,1)','[1,2)','[2,3)','[3,4)','[4,15]'), n, TRUE),
                   week= sample(1:7, n, TRUE),
                   rel= sample(c(1,4), n, TRUE),
                   conversion = sample(0:1, n, TRUE))

shinyServer(function(input, output, session) {
  datasetInput <- reactive({
    switch(input$dataset,
           "taxicabs" = taxi,
           "liquor stores" = liq)
  })

  observe({
    choices <- c("day", "hour", "source", "service", "relevancy", "tollfree", "distance", "similarity")
    if (grepl("day in weekdays/weekends", input$agg))  {
      choices[1] <- "week"
    }
    if (grepl("relevancy", input$agg))  {
      choices[5] <- "rel"
    }      
    if (grepl("similarity", input$discrete)) {
      choices[8] <- "simi.names"
    }
    if (grepl("distance", input$discrete)) {
      choices[7] <- "dist.names"
    }
    updateCheckboxGroupInput(session, "checkGroup", choices = choices,
                               inline = F, selected = choices)
  })

  datasetagg <- reactive({ 
    cg <- input$checkGroup
    dis <- input$discrete
    cg_not_d_or_s <- cg[!(cg %in% c("distance", "similarity"))]
    if(input$discrete == "similarity & distance") {
      #all discrete 
      right_join(
        datasetInput() %>%
          select_(.dots = cg) %>%
          group_by_(.dots = cg) %>%
          summarise(count=n()),
        datasetInput() %>%
          filter(conversion==1) %>%
          select_(.dots = cg) %>%
          count_(vars = cg)
      ) %>% mutate(prop.conv = n/count)
    } else if(input$discrete %in% c("similarity", "distance")) {
      cg_not_dis <- cg[cg != dis]
        # one continuous
      right_join(
        datasetInput() %>%
          group_by_(.dots = cg_not_dis) %>%
          summarise_(.dots = setNames(c(paste0("mean(", dis, ")"), "n()"),
                                      c(paste0(substr(dis, 1, 4), ".mean"), "count"))) %>%
          select_(.dots = c(cg_not_dis, paste0(substr(dis, 1, 4), ".mean"), "count")),
        datasetInput() %>%
          filter(conversion==1) %>%
          select_(.dots = cg_not_dis) %>%
          count_(vars = cg_not_dis)
      ) %>% mutate(prop.conv = n/count)
    } else if(input$discrete == "none") {
      # two  
      right_join(
        datasetInput() %>%
          select_(.dots = cg) %>%
          group_by_(.dots = cg_not_d_or_s) %>%
          summarise(dist.mean=mean(distance), simi.mean=mean(similarity), count=n()),
        datasetInput() %>%
          filter(conversion==1) %>%
          select_(.dots = cg) %>%
          count_(vars = cg_not_d_or_s)
      ) %>% mutate(prop.conv = n/count)
    }
  })

  # head of the table  
  output$view <- renderTable({
    head(datasetagg(), n = input$obs)
  })

})

将 dplyr 中的 get(paste0()) 对象解析为 Shiny 应用程序

Parsing get(paste0()) objects within dplyr into a Shiny app

r

shiny

dplyr