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

时间:2015-07-02 20:48:18

标签: r shiny dplyr

我在Shiny中构建一个新的应用程序,它需要执行灵活/反应性聚合数据集,这些数据集接收一些inputID。我真的很喜欢dplyr,所以我用它来创建这些数据集。但我在解析命令时遇到错误

  

...%>%汇总(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)
})


 })

有什么建议吗?谢谢你的帮助!

1 个答案:

答案 0 :(得分:4)

然而,真正的问题是您在尝试使用get(paste0(substr(dis,1,4),".mean"))作为参数的名称进行汇总。 R中的命名参数未经评估,它们只是一段文字。

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

  1. 顶部的第一个observe部分不必要地复杂化 - 它可以简化为4个if语句,如图所示。

  2. 您无法以您的方式动态定义reactive。您需要使用其中的所有条件逻辑声明一个reactive。在dplyr代码之外对输入变量进行必要的处理也非常简洁。

  3. 当您动态定义selectgroup_by等的列时,您可以使用最初使用eval(substitute())的方法,但它会使对于难以正确编写的代码。在我看来,使用功能的标准评估版本要好得多,例如: select_group_by_。对于input$checkgroup,您需要使用.dots参数(以及vars的{​​{1}}参数。

  4. 在原始代码中,您将count_变量强制转换为符号,该符号仅占用向量的第一个元素。

  5. input$checkgroup中动态命名列的方法是使用summarise_setNames参数。

  6. 我仍然不确定某些输出是否与你想要的完全一致,尤其是比例列,但是这应该可以为你提供一些有用的东西。

    <强> ui.R

    .dots

    <强> server.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")
                                  )
                                ))
    
    ))