R Shiny dplyr reactive filters

Ellie

I'm trying to set up a dashboard where the user can filter data by year, status, and product. Ideally it should run where each product has 2 variables associated, a satisfaction score and an importance score.When filtering from the data set, a summary mean should be calculated for the various segments the user is interested in. Then the mean importance and mean satisfaction scores are combined into a data.frame and plotted on a single plot.

Here is where I'm at...

My UI

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")

          )))))

And my Server:

  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)

Here are the variable structures:

> 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")

It works - only not doing exactly what I need it to. Currently, it requires an input in all 3 checkbox input variables (inpt, role, range) before it plots. I need it to require a product, but plot for each additional input. Meaning, if they select Web, it will plot the mean of web. If they select Web and year 2017, it will plot the mean of Web in 2017.

Any help is VERY appreciated!!!!

Dave Gruenewald

Changes

There were a few things here that I think are causing some trouble:

First, you are using input$range although you have never defined input$range. You have defined a input$yrs, so I changed it to input$range.

Next, you are using == with filter, when you should be using %in% instead. This allows for multiple selections, not just a single selection. If you only want a single selection, use radioButtons() instead of checkboxGroupInput().

In your summarize, you are using an additional and unnecessary subsetting. We've already used the exact same filter on the dataset, so no need to apply the subsetting within summarize.

Finally, I think you might run into some serious issues with your xyCoords. Because you are using different filters on your two datasets, you likely will end up with varying vector lengths for x and y. This will cause problems. My suggestion is that you somehow combine the two datasets with a full_join to make sure x and y will always be the same length. That's less of a question about shiny and more about dplyr as well.

I also changed some of your reactive objects.

UI:

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:

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)

Collected from the Internet

Please contact [email protected] to delete if infringement.

edited at
0

Comments

0 comments
Login to comment

Related