【问题标题】:R Shiny dplyr reactive filtersR Shiny dplyr 反应式过滤器
【发布时间】:2018-10-11 14:24:30
【问题描述】:

我正在尝试设置一个仪表板,用户可以在其中按年份、状态和产品过滤数据。理想情况下,它应该在每个产品有 2 个关联变量(满意度得分和重要性得分)的情况下运行。从数据集中过滤时,应该为用户感兴趣的各个细分计算汇总平均值。然后是平均重要性和平均满意度分数被组合成一个 data.frame 并绘制在一个图上。

这就是我所在的地方……

我的用户界面

library(shiny)
library(dplyr)
library(shinydashboard)
library(tidyverse)

ui <- dashboardPage(
  dashboardHeader(title="Membership Satisfaction"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Demographics Dashboard", tabName = "demos", icon = 
               icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(

     tabItem(tabName = "demos",
             sidebarPanel(
                checkboxGroupInput("inpt","Select variables to plot", 
               choices = 
                                 c("Web" = 1,"Huddle" = 3, "Other" = 5, 
               "Test" = 7)),
            checkboxGroupInput("role", 
                               "Select Primary Role of Interest", 
                               choices = c("Student" = 1, "Not" = 2)),
            checkboxGroupInput("range", 
                               "Select year(S) of Interest", 
                               choices = c("2016"=2,"July 2017"=1))),
          fluidPage(

            plotOutput("plot")

          )))))

还有我的服务器:

  server <- function(input,output){

  library(tidyverse)


  x <- reactive({
    inpt <- as.double(input$inpt)
    role <- as.double(input$role)
    range <- as.double(input$range)

    GapAnalysis_LongFormB %>%
      filter(Product %in% inpt,
         status %in% role,
         year %in% range) %>%
       summarize(avg = mean(Score, na.rm = TRUE)) %>%
        pull(-1)
        })


  y <- reactive({
    inpt <- as.double(input$inpt)+1
    role <- as.double(input$role)
    range <- as.double(input$range)

 GapAnalysis_LongFormB %>%
    filter(Product %in% inpt,
         status %in% role,
         year %in% range) %>% 
   summarize(avg = mean(Score, na.rm = TRUE))%>%
   pull(-1)
  })

 xyCoords<- reactive({
   x <- x()
   y <- y()

   data.frame(col1=x, col2=y)
   })



  output$plot <- renderPlot({

    xyCoords <- xyCoords()    

    xyCoords %>% 
     ggplot(aes(x = col1, y = col2)) +
     geom_point(colour ="green", shape = 17, size = 5 )+
     labs(x = "Mean Satisfaction", y = "Mean Importance") +
     xlim(0,5) + ylim(0,5) +
     geom_vline(xintercept=2.5) + 
     geom_hline(yintercept =  2.5)
    })

}



shinyApp (ui = ui, server = server)

这里是变量结构:

> dput(head(GapAnalysis_LongFormB))
structure(list(status = c(1, 5, 5, 1, 1, 5), year = c(1, 1, 1, 
1, 1, 1), Product = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = c("1", 
"2", "3", "4"), class = "factor"), Score = c(2, 5, 3, 5, 4, 4
)), .Names = c("status", "year", "Product", "Score"), row.names = c(NA, 
6L), class = "data.frame")

它有效——只是没有完全按照我的需要去做。目前,它需要在绘制之前输入所有 3 个复选框输入变量(inpt、role、range)。我需要它来要求一个产品,但要为每个额外的输入绘图。意思是,如果他们选择 Web,它将绘制 web 的平均值。如果他们选择 Web 和 2017 年,它将绘制 2017 年 Web 的平均值。

非常感谢任何帮助!!!!

【问题讨论】:

  • 我没有运行代码,但是看看as.integer(input$inpt+1)。不应该是as.integer(input$inpt) + 1
  • 我认为它们都产生相同的结果(至少在我运行代码时没有任何变化)

标签: r filter shiny dplyr reactive


【解决方案1】:

变化

我认为这里有几件事造成了一些麻烦:

首先,您使用的是input$range,尽管您从未定义过input$range。你定义了一个input$yrs,所以我把它改成了input$range

接下来,您将使用 ==filter,而您应该使用 %in%。这允许多个选择,而不仅仅是一个选择。如果您只想要一个选择,请使用 radioButtons() 而不是 checkboxGroupInput()

在您的summarize 中,您使用了额外且不必要的子集。我们已经在数据集上使用了完全相同的filter,因此无需在summarize 中应用子集。

最后,我认为您的xyCoords 可能会遇到一些严重问题。因为您在两个数据集上使用了不同的过滤器,所以您最终可能会得到 xy 的不同向量长度。这会导致问题。我的建议是您以某种方式将两个数据集与full_join 结合起来,以确保xy 的长度始终相同。这不是关于shiny 的问题,更多的是关于dplyr 的问题。

我还更改了您的一些 reactive 对象。

用户界面:

library(shiny)
library(shinydashboard)
library(tidyverse)

ui <- dashboardPage(
  dashboardHeader(title="Membership Satisfaction"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Demographics Dashboard", tabName = "demos", icon = 
                 icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(

      tabItem(tabName = "demos",
              sidebarPanel(
                checkboxGroupInput("inpt","Select variables to plot", choices = 
                                     c("Web" = 1,"Huddle" = 3, "Other" = 5, "Test" = 7)),
                checkboxGroupInput("role", 
                                   "Select Primary Role of Interest", 
                                   choices = c("Student" = 1, "Not" = 2)),
                checkboxGroupInput("range", 
                                   "Select year(S) of Interest", 
                                   choices = c("2016"=2,"July 2017"=1))),
              fluidPage(

                plotOutput("plot")

              )))))

服务器:

server <- function(input,output){

  library(tidyverse)

  GapAnalysis_LongFormImpt <- structure(list(status = c(1, 5, 5, 1, 1, 5), year = c(1, 1, 1, 
                                                                                    1, 1, 1), Product = structure(c(2L, 2L, 2L, 2L, 2L, 2L), .Label = c("1", 
                                                                                                                                                        "2", "3", "4"), class = "factor"), Score = c(1, 1, 3, 2, 2, 1
                                                                                                                                                        )), .Names = c("status", "year", "Product", "Score"), row.names = c(NA, 
                                                                                                                                                                                                                            6L), class = "data.frame")


  GapAnalysis_LongFormSat <- structure(list(status = c(5, 5, 1, 1, 5, 1), year = c(1, 1, 1, 
                                                                                   1, 1, 1), Product = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = c("1", 
                                                                                                                                                       "2", "3", "4"), class = "factor"), Score = c(2, 3, 2, 1, 1, 1
                                                                                                                                                       )), .Names = c("status", "year", "Product", "Score"), row.names = c(NA, 
                                                                                                                                                                                                                           6L), class = "data.frame")

  x <- reactive({
    inpt <- as.double(input$inpt)
    role <- as.double(input$role)
    range <- as.double(input$range)

    GapAnalysis_LongFormSat %>%
      filter(Product %in% inpt,
             status %in% role,
             year %in% range) %>%
      summarize(Avg = mean(Score, na.rm = TRUE)) %>%
      pull(-1)
  })


  y <- reactive({
    inpt <- as.double(input$inpt)
    role <- as.double(input$role)
    range <- as.double(input$range)

    GapAnalysis_LongFormImpt %>%
      filter(Product %in% inpt,
             status %in% role,
             year %in% range) %>% 
      summarize(Avg = mean(Score, na.rm = TRUE))%>%
      pull(-1)
  })

  xyCoords<- reactive({
    x <- x()
    y <- y()

    data.frame(col1=x, col2=y)})

  output$plot <- renderPlot({
    xyCoords <- xyCoords()

    xyCoords %>% 
      ggplot(aes(x = col1, y = col2)) +
      geom_point(colour ="green", shape = 17, size = 5 )+
      labs(x = "Mean Satisfaction", y = "Mean Importance") +
      xlim(0,5) + ylim(0,5) +
      geom_vline(xintercept=2.5) + 
      geom_hline(yintercept =  2.5)})

}



shinyApp (ui = ui, server = server)

【讨论】:

  • 您的代码中有一些拼写错误,应该是summarize(Avg =。一个=不是两个。
  • 谢谢!!这仅允许在填充所有字段后进行绘图,有没有办法为每个细分/变量绘制?
  • 对原始代码进行了更正...至于绘制每个变量/细分,使用您拥有的代码,我建议使用 @ 中的 selected 参数为要选择的所有内容添加默认值987654348@
  • @DaveGruenewald 我现在遇到了颜色/形状编码的问题……也许你能帮忙??问题链接 -> stackoverflow.com/questions/50139261/…
猜你喜欢
  • 2019-05-04
  • 1970-01-01
  • 2018-01-30
  • 2016-06-28
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2014-05-11
  • 2022-12-10
相关资源
最近更新 更多