堆栈内存溢出
  繁体   English   中英

R闪亮-反应性selectInput数据帧列

[英]R Shiny - Reactive selectInput data frame column

 原文  2016-09-09 15:28:02  7   1    r/ shiny/ rstudio/ reactive-programming/ shinydashboard

问题描述

我有一个仪表板，可从Google Analytics（分析）或CSV上传中提取数据，然后计算转化率和平均订单价值（用于AB测试）。 我一直在尝试实现允许选择设备类别（例如，手机，平板电脑或台式机）和产品类别（例如卡，礼物或鲜花）的过滤器。 过滤器应动态地从数据帧中拉出，然后可以在下拉菜单中选择。 我已经看到过很多类似的论坛示例，但对于我来说，我一直无法使其正常运行。 我所看到的情况似乎正在使用观察（{}），但我的问题似乎来自以下事实：我需要首先将选择从响应函数中传递出去。

下面是一个可复制的简化示例，其中将生成数据帧，就像它们看上去一样。 我已在用户界面中注释掉＃choices = Results（）$ Devices，以便向您展示它破裂之前的样子。

非常感谢G 

require(shiny)
require(shinydashboard)
require(googleVis)
require(dplyr)


ui <- dashboardPage(  
  skin="blue",

  dashboardHeader(
    title="Dashboard",
    titleWidth = 250

  ),

  dashboardSidebar(


    sidebarMenu(
      menuItem("Calculator ", tabName = "calculator", icon = icon("calculator"))

    )
  ),
  #
  dashboardBody(
    tabItems(
      tabItem(tabName = "calculator",
              h1("Calculator"),


              fluidRow(
                column(width = 1,
                       selectInput("device","Device:",
                                   #choices= Results()$Devices,
                                   multiple=TRUE, selectize=TRUE)
                ),
                column(width = 1,
                       selectInput("product","Product:",
                                   #"choices= Results()$Products",
                                   multiple=TRUE, selectize=TRUE)
                )
              ),

              fluidRow(

                column(width = 6,
                       box(title="Overall Conversion rate %",status="primary",solidHeader = TRUE,
                           htmlOutput("CRABCalcl"),width = "100%",height=275)
                ),

                column(width = 6,
                       box(title="Overall AOV £",status="primary",solidHeader = TRUE,
                           htmlOutput("AOVABCalcl"),width = "100%",height=275)
                )
              ),
              fluidRow(

                column(width = 6,
                       box(title="Ecommerce Conversion rate %",status="primary",solidHeader = TRUE,
                           htmlOutput("CRABCalclEHC"),width = "100%",height=275)
                ),

                column(width = 6,
                       box(title="Ecoomerce AOV £",status="primary",solidHeader = TRUE,
                           htmlOutput("AOVABCalclEHC"),width = "100%",height=275)
                )
              )

          )

      )#End of tab Item
    ) #end of tabItems

  )#End of Dashboard body
)#End of dashboardPage


server <- function(input, output,session) {
  Results <- reactive({

    myDataRAW<-data.frame(
      c("mobile","mobile","desktop","desktop","tablet","tablet"),
      c("Control","Challenger","Control","Challenger","Control","Challenger"),
      c(34355,34917,28577,29534,15337,13854),
      c(15011,15427,32190,32548,40299,40858),
      c(14636,14990,19609,19702,7214,7785),
      c(123273.70,20936.92,45179.05,46359.91,65765.27,92771.36),
      c(10370,13403,19241,26965,4468,8796)
    )

    myDataRAWEHC<-data.frame(
      c("desktop","desktop","mobile","mobile","tablet","tablet","desktop","desktop","mobile","mobile","desktop","desktop","mobile","mobile","tablet","tablet","tablet","tablet","desktop","desktop"),
      c("Card","Card","Card","Card","Card","Card","Card","Card","Gift","Gift","Gift","Card","Card","Card","Card","Card","Card","Card","Flower","Flower"),
      c("Standard","Standard","Standard","Standard","Standard","Standard","Large","Large","Large","Large","Square","Square","Square","Square","Large","Large","Square","Square","Flowers","Flowers"),
      c("Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger"),
      c(8767,18072,5729,13017,2908,7086,1655,2971,1008,2177,984,2369,599,1422,449,1052,402,1001,233,355),
      c(9055,18624,5908,13302,3015,7288,1691,3000,1013,2192,1009,2455,623,1450,455,1068,413,1017,233,356),
      c(21699.60,44480.95,14464.85,32590.30,7232.47,17483.35,8309.85,14684.68,5024.92,10844.67,2405.07,5826.83,1529.16,3556.38,2220.21,5192.92,992.14,2447.78,5196.08,8021.95)
    )

    names(myDataRAW)<-c("Device.Category","Segment","Users","Sessions","Transactions","Revenue","Quantity")
    names(myDataRAWEHC)<-c("Device.Category","Product.Category..Enhanced.Ecommerce.","Product.Variant","Segment","Unique.Purchases","Quantity","Product.Revenue")

    Devices<-myDataRAW$Device.Category
    Products<-unique(myDataRAWEHC$Product.Category..Enhanced.Ecommerce.)
#     DeviceFilter<-input$device
#     ProductFilter<-input$product
    #the below is replacing the above input to act as filters
    DeviceFilter<-c("desktop","mobile")
    ProductFilter<-c("Flower","Gift")
    myData<-myDataRAW %>% filter(Device.Category %in% DeviceFilter)
    myDataEHC<-myDataRAWEHC %>% filter(Device.Category %in% DeviceFilter) %>% filter(`Product.Category..Enhanced.Ecommerce.` %in% ProductFilter)

    myData<-bind_rows(myData,myData %>% group_by(Device.Category="All",Segment) %>% summarise(Users=sum(Users),Sessions=sum(Sessions),Transactions=sum(Transactions),Revenue=sum(Revenue),Quantity=sum(Quantity)))
    myDataEHC<-rbind(myDataEHC %>% group_by(Device.Category,Segment) %>% summarise(Transactions=sum(Unique.Purchases),Quantity=sum(Quantity),Revenue=sum(Product.Revenue)), 
                     myDataEHC %>% group_by(Device.Category="All",Segment) %>% summarise(Transactions=sum(Unique.Purchases),Quantity=sum(Quantity),Revenue=sum(Product.Revenue)) )
    myDataEHC<-left_join(myDataEHC,myData %>% select(Segment,Device.Category,Users,Sessions))
    myData$Analysis<-"Overall"
    myDataEHC$Analysis<-"Ecommerce"
    myDataForAnalysis<-rbind(as.data.frame(myData),as.data.frame(myDataEHC))


    myDataForAnalysis$CVR<-myDataForAnalysis$Transactions/myDataForAnalysis$Sessions
    myDataForAnalysis$AOV<-myDataForAnalysis$Revenue/myDataForAnalysis$Transactions

    DisplayResultsEHC<-myDataForAnalysis %>% filter(Analysis %in% "Ecommerce")
    DisplayResults<-myDataForAnalysis %>% filter(Analysis %in% "Overall")



    list(DisplayResultsEHC=DisplayResultsEHC,DisplayResults=DisplayResults,Devices=Devices,Products=Products)
  })



  output$CRABCalcl <- renderGvis({
    DataABCalcl<-Results()$DisplayResults
    F<-cast(DataABCalcl, Device.Category~Segment, value = 'CVR')
    X<-gvisColumnChart(F,options=list(legend="{position:'top'}",width="100%"))

  })

  output$AOVABCalcl <- renderGvis({
    DataABCalcl<-Results()$DisplayResults
    F<-cast(DataABCalcl, Device.Category~Segment, value = 'AOV')
    X<-gvisColumnChart(F,options=list(legend="{position:'top'}",width="100%"))
  })

  output$CRABCalclEHC <- renderGvis({
    DataABCalcl<-Results()$DisplayResultsEHC
    F<-cast(DataABCalcl, Device.Category~Segment, value = 'CVR')
    X<-gvisColumnChart(F,options=list(legend="{position:'top'}",width="100%"))

  })

  output$AOVABCalclEHC <- renderGvis({
    DataABCalcl<-Results()$DisplayResultsEHC
    F<-cast(DataABCalcl, Device.Category~Segment, value = 'AOV')
    X<-gvisColumnChart(F,options=list(legend="{position:'top'}",width="100%"))
  })


}

shinyApp(ui, server)

1 个解决方案

解决方案1
 0 已采纳  2016-09-09 17:58:29

从我看来，一个好的开始是创建一个包含（并从server.R中删除）的global.R文件：

全球 

myDataRAW<-data.frame(
            c("mobile","mobile","desktop","desktop","tablet","tablet"),
            c("Control","Challenger","Control","Challenger","Control","Challenger"),
            c(34355,34917,28577,29534,15337,13854),
            c(15011,15427,32190,32548,40299,40858),
            c(14636,14990,19609,19702,7214,7785),
            c(123273.70,20936.92,45179.05,46359.91,65765.27,92771.36),
            c(10370,13403,19241,26965,4468,8796)
    )

    myDataRAWEHC<-data.frame(
            c("desktop","desktop","mobile","mobile","tablet","tablet","desktop","desktop","mobile","mobile","desktop","desktop","mobile","mobile","tablet","tablet","tablet","tablet","desktop","desktop"),
            c("Card","Card","Card","Card","Card","Card","Card","Card","Gift","Gift","Gift","Card","Card","Card","Card","Card","Card","Card","Flower","Flower"),
            c("Standard","Standard","Standard","Standard","Standard","Standard","Large","Large","Large","Large","Square","Square","Square","Square","Large","Large","Square","Square","Flowers","Flowers"),
            c("Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger","Control","Challenger"),
            c(8767,18072,5729,13017,2908,7086,1655,2971,1008,2177,984,2369,599,1422,449,1052,402,1001,233,355),
            c(9055,18624,5908,13302,3015,7288,1691,3000,1013,2192,1009,2455,623,1450,455,1068,413,1017,233,356),
            c(21699.60,44480.95,14464.85,32590.30,7232.47,17483.35,8309.85,14684.68,5024.92,10844.67,2405.07,5826.83,1529.16,3556.38,2220.21,5192.92,992.14,2447.78,5196.08,8021.95)
    )

    names(myDataRAW)<-c("Device.Category","Segment","Users","Sessions","Transactions","Revenue","Quantity")
    names(myDataRAWEHC)<-c("Device.Category","Product.Category..Enhanced.Ecommerce.","Product.Variant","Segment","Unique.Purchases","Quantity","Product.Revenue")

这使您可以从ui.R访问myDataRAW和myDataRAWEHC。 相应地修改ui.R： 

fluidRow(
                                    column(width = 3,
                                           selectInput("device","Device:",
                                                       choices= levels(myDataRAW$Device.Category),
                                                       multiple=TRUE, selectize=TRUE)
                                    ),
                                    column(width = 3,
                                           selectInput("product","Product:",
                                                       choices= unique(levels(myDataRAWEHC$Product.Category..Enhanced.Ecommerce.)),
                                                       multiple=TRUE, selectize=TRUE)
                                    )
                            ),

之后，您还需要进行一些工作来重新排列server.R部分。

暂无
暂无

声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

相关问题 在反应式selectinput中为Shiny返回数据帧值 R 中闪亮的反应式 selectInput R Shiny 反应式选择输入 R Shiny-使用Selectinput作为子集数据帧的列选择 用于 selectInput 的 R 闪亮加载 data.frame R Shiny中的多个电抗选择输入 R Shiny 如何选择输入表单数据框列（反应式） 如何从 R 中的reactive() 生成的数据框中调用列？ 反应数据框架中的反应列名称闪亮 R Shiny，变异替换，如何变异从数据框中的 selectInput 中选择的特定列？
相关标签
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM