Search code examples
rshinyflexdashboard

Shiny input - Show all data if all is selected and plot summarize data


I am trying to filter a data frame from input. I want all data to show if the option All is selected. Here is what I have so far:

This will reproduce some data:

library(tidyverse)

lihn_service_line <- rep(c("Medical", "CVA"), 10)
dsch_date <- seq.Date(as.Date("2017/01/01"), to = as.Date("2018/08/01"), by = "month")
alos <- rnorm(20, mean = 6, sd = 0.5)
elos <- rnorm(20, mean = 5, sd = 1)
df_los <- data.frame(dsch_date, lihn_service_line, alos, elos)

df_los <- df_los %>%
  tibbletime::as_tbl_time(index = dsch_date) %>%
  tibbletime::collapse_by("monthly") %>%
  dplyr::group_by(dsch_date, add = T) %>%
  summarize(
    alos = round(mean(alos), 2)
    , elose = round(mean(elos), 2)
  )

The below is what I have so far:

Inputs {.sidebar}
-----------------------------------------------------------------------
Pick a Service Line.

```{r}

selectInput(
  "svcline"
  , label = h3("Service Line")
  , choices = c(
    "All"
    , "Medical"
    , "GI Hemorrhage"
    , "COPD"
    , "CVA"
    , "CHF"
  )
  , selected = "Medical"
)

```


Column {data-width=350}
-----------------------------------------------------------------------

### ALOS vs. ELOS

```{r}

svc_line <- reactive({as.character(input$svcline)})

alos <- reactive(
  {
    df_los %>%
      filter(svc_line == "All" | lihn_service_line == svc_line) %>%
      collapse_by("monthly") %>%
      group_by(dsch_date, add = T) %>%
      summarize(
        alos = round(mean(los), 2)
        , elos = round(mean(performance), 2)
      )
  }
)

renderPlot(
  {
    # alos <- df_los %>%
    #   collapse_by("monthly") %>%
    #   group_by(dsch_date, add = T) %>%
    #   summarize(
    #     alos = round(mean(los), 2)
    #     , elos = round(mean(performance), 2)
    #     ) %>%
    #   select(dsch_date, alos, elos)

    alos() %>%
      ggplot(
        mapping = aes(
          x = dsch_date
          , y = alos
          )
        ) +
      geom_line(
        color = "black"
        ) +
      geom_point() +
      geom_line(
        aes(
          x = dsch_date
          , y = elos
          )
        , color = "red"
        ) +
      geom_point(
        x = alos$dsch_date
        , y = alos$elos
        , color = "red"
        ) +
      labs(
        x = ""
        , y = "ALOS"
        , caption = "Black Line is Actual and Red Line is Benchmark"
        )  +
      theme_minimal() +
      theme(
        axis.text.x = element_text(angle = 90, hjust = 0)
        ) +
      scale_x_date(
        breaks = alos$dsch_date
        , labels = date_format("%b %Y")
      )
    }
)

```

So I am attempting to take input and filter a data.frame and have the corresponding graph(s) update. The error I get is the following:

I get the following warning/error:

Warning: Error in ==: comparison (1) is possible only for atomic and list types
  203: filter_impl
  202: filter.tbl_df
  196: function_list[[i]]
  195: freduce
  194: _fseq
  193: eval
  192: eval
  190: %>%
  189: <reactive> [<text>#29]
  187: .func
  184: contextFunc
  183: env$runWith
  176: ctx$run
  175: self$.updateValue
  173: alos
  169: renderPlot [<text>#51]
  167: func
  127: drawPlot
  113: <reactive:plotObj>
   97: drawReactive
   84: origRenderFunc
   83: output$out7e92cd2b0c4de4e1
    3: <Anonymous>
    1: rmarkdown::run

Solution

  • This is an example using the iris dataset. Below I add an example with the data you provided. There were several mistakes in the call to ggplot as well as in creating the df_los data. Let me know whether this approach works on your real data.

    ---
    title: "Untitled"
    runtime: shiny
    output: html_document
    ---
    
    
    Inputs {.sidebar}
    -----------------------------------------------------------------------
      Pick a Species
    
    ```{r echo = FALSE} 
    
    selectInput(
      "species",
        label = h3("Species"),
        choices = c("All",unique(as.character(iris$Species))),
       selected = "All"
    )
    
    ```
    
    
    Column {data-width=350}
    -----------------------------------------------------------------------
    
      ### Data & Graph 
    
    ```{r echo = FALSE, message = FALSE, warning = FALSE} 
    library(dplyr)
    library(tidyr)
    library(ggplot2)
    
    iris_reac <- reactive({
    
        iris %>% 
        # this is the filter method r2evans suggested below I commented my own longer filter version out
        filter(input$species == "All" | Species == input$species) 
        # filter(if (input$species != "All") Species == input$species else 1>0) %>% 
        summarise(sepal_length = mean(Sepal.Length, na.rm = T),
                  sepal_width = mean(Sepal.Width, na.rm = T),
                  petal_length = mean(Petal.Length, na.rm = T),
                  petal_width = mean(Petal.Width, na.rm = T)) %>% 
        gather(key = metric) 
    
    })
    
    renderPlot({
    
        print(iris_reac())
    
        ggplot(iris_reac(), aes(x = metric, y = value)) +
           geom_col(width = 0.5)
    
    })
    
    ```
    



    Update

    The approch below uses your example data.

    ---
    title: "Untitled"
    runtime: shiny
    output: html_document
    ---
    
    
    Inputs {.sidebar}
    -----------------------------------------------------------------------
      Pick a Species
    
    ```{r echo = FALSE} 
    
    selectInput(
      "svc_line",
      label = h3("Service Line"),
       choices = c(
        "All",
        "Medical",
        "GI Hemorrhage",
        "COPD",
        "CVA",
        "CHF"
      ),
      selected = "Medical"
    )
    
    ```
    
    
    Column {data-width=350}
    -----------------------------------------------------------------------
    
      ### Data & Graph 
    
    ```{r echo = FALSE, message = FALSE, warning = FALSE} 
    library(tidyverse)
    library(tibbletime)
    
    lihn_service_line <- rep(c("Medical", "CVA"), 10)
    dsch_date <- seq.Date(as.Date("2017/01/01"), to = as.Date("2018/08/01"), by = "month")
    alos <- rnorm(20, mean = 6, sd = 0.5)
    elos <- rnorm(20, mean = 5, sd = 1)
    df_los <- data.frame(dsch_date, lihn_service_line, alos, elos)
    
    df_los <- df_los %>%
      tibbletime::as_tbl_time(index = dsch_date) 
    
    alos_data <- reactive(
      {
        df_los %>%
          filter(input$svc_line == "All" | lihn_service_line == input$svc_line) %>%
          collapse_by("monthly") %>%
          group_by(dsch_date, add = T) %>%
          summarize(
            alos = round(mean(alos), 2)
            , elos = round(mean(elos), 2)
          )
      }
    )
    
    
    renderPlot({
    
        print(alos_data())
    
        alos_data() %>%
          ggplot(
            mapping = aes(
              x = dsch_date
              , y = alos
              )
            ) +
          geom_line(
            color = "black"
            )  +
          geom_point() +
          geom_line(
            aes(
              x = dsch_date
              , y = elos
              )
            , color = "red"
            ) +
          geom_point(aes(
            x = dsch_date
            , y = elos)
            , color = "red"
            )  +
          labs(
            x = ""
            , y = "ALOS"
            , caption = "Black Line is Actual and Red Line is Benchmark"
            )  +
          theme_minimal() +
          theme(
            axis.text.x = element_text(angle = 90, hjust = 0)
            ) +
          scale_x_date(
            date_breaks = "1 month"
            , date_labels = "%b %Y"
          )
    
    
    
    })
    
    ```