RBRN1231
RBRN1231

Reputation: 67

How to use shiny with check boxes from an excel file

I am trying to make a shiny app that all it does is display different line plots based on which check boxes are selected.

My data is housed in an excel file and it has 5 tabs, each of which I would like to have a plot and a corresponding check box. I have included a picture of the data enter image description here

I found the code below that creates checkboxes, but it also has a slider bar that I don't need (if I could use it, I would have it set the range of years to show in the plot)

Thanks for the help

library(ggplot2)
library(tidyverse)


df <- iris[, colnames(iris) != "Species"]

ui <- fluidPage(
  titlePanel("Density Plots of Quantitative Variables"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bw", "Slide to change bandwidth of Plot",
        min = 0.1,
        max = 20,
        value = 3,
        step = 0.1,
        animate = TRUE
      ),
      checkboxGroupInput("variableinp", "Choose variables",
        choices = colnames(df), selected = colnames(df)[1]
      ), verbatimTextOutput("value")
    ),
    mainPanel(plotOutput("densityplot"))
  )
)


server <- function(input, output) {

  # observeEvent(input$variableinp, {
  #      print((input$variableinp))
  #  })

  output$densityplot <- renderPlot({
    if (!is.null(input$variableinp)) {
      getoutandquant <- function(x) {
        q1 <- quantile(x)[[2]]
        q3 <- quantile(x)[[4]]
        IQR <- q3 - q1

        out1 <- q3 + (1.5) * IQR
        out2 <- q1 - (1.5) * IQR

        # Finding the list of points which are outliers for a particular variable.
        out <- x[x > out1]
        out2 <- x[x < out2]
        outliers <- tibble(x = c(out, out2), y = 0)

        return(outliers)
      }
      nplot <- length(input$variableinp)
      x <- input$variableinp

      for (i in 1:nplot) {
        outlier <- getoutandquant(df[, x[i]])
      }

      p1 <- ggplot(df, aes_string(input$variableinp[i])) +
        stat_density(geom = "line", adjust = input$bw) +
        ylab("Density\n")
      p1 + geom_point(data = outlier, aes(x, y), shape = 23)
    }
  })
}


shinyApp(ui = ui, server = server)

Upvotes: 1

Views: 167

Answers (1)

jpdugo17
jpdugo17

Reputation: 7106

We can keep everything in one single plot by pivoting the data and modifying getoutandquant function with an additional argument. The purpose of this is to be able to use color argument to differentiate each column.

df <- iris[, colnames(iris) != "Species"]

#pivot data to long format
df_long <- df %>%
  pivot_longer(everything())
#add an additional argument
getoutandquant <- function(x, group_name) {
  q1 <- quantile(x)[[2]]
  q3 <- quantile(x)[[4]]
  IQR <- q3 - q1

  out1 <- q3 + (1.5) * IQR
  out2 <- q1 - (1.5) * IQR

  # Finding the list of points which are outliers for a particular variable.
  out <- x[x > out1]
  out2 <- x[x < out2]
  outliers <- tibble(x = c(out, out2), y = 0, group_name)

  return(outliers)
}

Finally we change the server to plot one or more columns depending the number of checkboxes selected.

server <- function(input, output) {
  
  outliers <- reactive({
    #call getoutandquant function with each of the selected cols
    map_dfr(input$variableinp, ~ getoutandquant(df[, ..1], group_name = .x))
  })

  df_long_filt <- reactive({
    filter(df_long, name %in% input$variableinp)
  })

  output$densityplot <- renderPlot({
    req(input$variableinp)

    ggplot(df_long_filt()) +
      stat_density(aes(x = value, color = name),
        geom = "line",
        adjust = input$bw
      ) +
      labs(y = "Density\n", color = "Column") +
      #we change the dataset to plot the outliers
      geom_point(
        data = outliers(), aes(x = x, y = y, color = group_name),
        shape = 23,
        size = 5
      )
  })
}

The ui will remain the same.

enter image description here

Full app:

library(shiny)
library(tidyverse)


df <- iris[, colnames(iris) != "Species"]

#pivot data to long format
df_long <- df %>%
  pivot_longer(everything())

#add an additional argument
getoutandquant <- function(x, group_name) {
  q1 <- quantile(x)[[2]]
  q3 <- quantile(x)[[4]]
  IQR <- q3 - q1

  out1 <- q3 + (1.5) * IQR
  out2 <- q1 - (1.5) * IQR

  # Finding the list of points which are outliers for a particular variable.
  out <- x[x > out1]
  out2 <- x[x < out2]
  outliers <- tibble(x = c(out, out2), y = 0, group_name)

  return(outliers)
}

ui <- fluidPage(
  titlePanel("Density Plots of Quantitative Variables"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bw", "Slide to change bandwidth of Plot",
        min = 0.1,
        max = 20,
        value = 3,
        step = 0.1,
        animate = TRUE
      ),
      checkboxGroupInput("variableinp", "Choose variables",
        choices = colnames(df), selected = colnames(df)[1]
      ), verbatimTextOutput("value")
    ),
    mainPanel(plotOutput("densityplot"))
  )
)


server <- function(input, output) {
  
  outliers <- reactive({
    #call getoutandquant function with each of the selected cols
    map_dfr(input$variableinp, ~ getoutandquant(df[, ..1], group_name = .x))
  })

  df_long_filt <- reactive({
    filter(df_long, name %in% input$variableinp)
  })

  output$densityplot <- renderPlot({
    req(input$variableinp)

    ggplot(df_long_filt()) +
      stat_density(aes(x = value, color = name),
        geom = "line",
        adjust = input$bw
      ) +
      labs(y = "Density\n", color = "Column") +
      #we change the dataset to plot the outliers
      geom_point(
        data = outliers(), aes(x = x, y = y, color = group_name),
        shape = 23,
        size = 5
      )
  })
}


shinyApp(ui = ui, server = server)

Upvotes: 1

Related Questions