R Shiny Ggplot Bar and Line Charts with Dynamic Variable Selection and Y Axis to Be Percentages

R Shiny ggplot bar and line charts with dynamic variable selection and y axis to be percentages

To properly group variables for plotting, geom_bar requires that the x values be numeric and the fill values be factors or that the argument group be used to explicitly specify grouping variables. However, plotly throws an error when group is used. The approach below converts x variables to integer and fill variables to factor so that they are properly grouped. This retains the use of geom_bar to calculate the percentages.

First, however, I wonder if mydata is specified correctly. Given that the data is a mix of character and integer, cbind(Location, Brand, Year, Q1, Q2) gives a character matrix which is then converted to a data.table where all variables are character mode. In the code below, I've defined mydata directly as a data.table but have converted Q1 to character mode so that mydata contains a mix of character and numeric.

The approach used below is to create a new data frame, plotdata, containing the x and fill data. The x data is converted to numeric, if necessary, by first making it a factor variable and then using unclass to get the factor integer codes. The fill data converted to a factor. plotdata is then used generate the ggplot plot which is then displayed using plotly. The code includes a couple of other modifications to improve the appearance of the chart.

EDIT

The code below has been updated to show the name of the row variable beneath it's bar. Also the percentage and count for each bar are only shown when the mouse pointer hovers above the bar.

 library("shiny")
  library("ggplot2")
  library("scales")
  library(plotly)
  library(data.table)

  Location <- sample(1:5,100,replace = T)
  Brand <- sample(1:3,100,replace = T)
  Year <- rep(c("Year 2014","Year 2015"),50)
  Q1 <- sample(1:5,100,replace = T)
  Q2 <- sample(1:5,100,replace = T)
  Q3 <- sample(seq(1,3,.5), 100, replace=T)
  mydata <- data.table(Location,Brand,Year,Q1,Q2, Q3)
#
# convert Q1 to character for demonstation purposes  
#
    mydata$Q1 <- as.character(mydata$Q1)

  ui <- shinyUI(fluidPage(
    sidebarPanel(
      fluidRow(
        column(10,
               div(style = "font-size: 13px;", selectInput("rowvar", label = "Select Row Variable", 
                                                           choices=colnames(mydata)))),
        tags$br(),
        tags$br(),
        column(10,
               div(style = "font-size: 13px;", selectInput("columnvar", label="Select Column Variable", 
                                                           choices=colnames(mydata))))
        )
    ),
    tabPanel("First Page"),
    mainPanel(tabsetPanel(id='charts',
                          tabPanel("charts",tags$b(tags$br("Graphical Output" )),tags$br(),plotlyOutput("plot1"))
    )
    )
  ))
  server <- shinyServer(function(input, output,session){
    updateTabsetPanel(session = session
                      ,inputId = 'myTabs')
    observe({
      updateSelectInput(session, "rowvar", choices = colnames(mydata), selected=colnames(mydata)[1])
    })
    observe({
      updateSelectInput(session, "columnvar", choices = colnames(mydata), selected=colnames(mydata)[2])
    })
    output$plot1 <- renderPlotly({
#
#   create data frame for plotting containing x variables as integer and fill variables as factors
#   
      if(is.numeric(get(input$rowvar)))  {
        rowvar_brks <- sort(unique(get(input$rowvar)))
        rowvar_lbls <- as.character(rowvar_brks)
        plotdata <- data.frame(get(input$rowvar), factor(get(input$columnvar)) )
      }
      else {
        rowvar_factors <- factor(get(input$rowvar))
        rowvar_brks <- 1:nlevels(rowvar_factors)
        rowvar_lbls <- levels(rowvar_factors)
        plotdata <- data.frame(unclass(rowvar_factors), factor(get(input$columnvar)) )
      }
      colnames(plotdata) <- c(input$rowvar, input$columnvar)
      validate(need(input$rowvar,''),
               need(input$columnvar,''))
      col_width <- .85*mean(diff(rowvar_brks))
      sp <- ggplot(plotdata, aes_(x = as.name(input$rowvar), fill = as.name(input$columnvar))) +
        geom_bar( aes(y= ..prop..), stat="count", position=position_dodge(width=col_width)) +
        geom_text(aes( label = paste(scales::percent(..prop..),"<br>", "count:",..count..,"<br>"),  y= ..prop.. + .01),
                  stat= "count", position=position_dodge(width=col_width), size=3, alpha=0) +
        labs(x= input$rowvar, y = "Percent", fill=input$columnvar) +
        scale_y_continuous(labels=percent) +
        scale_x_continuous(breaks=rowvar_brks, labels=rowvar_lbls)
        ggplotly(sp, tooltip="none")
      })
  })

  shinyApp(ui = ui, server = server)

Create dynamic barplot based on users input in Rshiny

Your data wrangling in NSE (Non-Standard Evaluation) requires some work. Try this

# Function for printing the plots with two different options
draw_barplot <- function(data_input, num_var_1, num_var_2, biomarker){
  print(num_var_1)
  
  if(num_var_1 != not_sel & num_var_2 != not_sel & biomarker == not_sel){
    ggplot(data = data_input, aes(x = .data[[num_var_1]], y=n)) +
      geom_bar(stat = "identity") +
      labs(y = "Percentage") + 
      ylim(0, 100)
    
  }
  
  else if(num_var_1 != not_sel & num_var_2 != not_sel & biomarker != not_sel){
    ggplot(data = data_input, aes(x = .data[[num_var_1]], y=n)) +
      geom_bar(stat = "identity") +
      labs(y = "Percentage") + 
      ylim(0, 100)
    
  }
}

################# --------------------------------------------------------------
# User interface
################# --------------------------------------------------------------

ui <- navbarPage(
  main_page
)

################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
server <- function(input, output){
  
  # Dynamic selection of the data. We allow the user to input the data that they want 
  data_input <- reactive({
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    Arthritis
  })
  
  # We update the choices available for each of the variables
  observeEvent(data_input(),{
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
    updateSelectInput(inputId = "biomarker", choices = choices)
  })
  
  
  # We select the binning level that we want for the plot of the Y axis
  output$binning <- renderUI({
    req(input$num_var_2, data_input())
    a <- unique(data_input()[[input$num_var_2]])
    print(a)
    pickerInput(inputId = 'selected_bins',
                label = 'Select binning for plot',
                choices = c(a), selected=a[3], multiple = TRUE,
                options = list(`actions-box` = TRUE)) #options = list(`style` = "btn-warning"))
  })
  
  
  # We select the factor level that we want for our biomarker
  output$factor <- renderUI({
    req(input$biomarker, data_input())
    if (input$biomarker != not_sel) {
      b <- unique(data_input()[[input$biomarker]])
      pickerInput(inputId = 'selected_factors',
                  label = 'Select factors',
                  choices = c(b[1:length(b)]), selected=b[1], multiple = TRUE,
                  # choices = c("NONE",b[1:length(b)]), selected="NONE", If we want "NONE" to appear as the first option
                  # multiple = TRUE,  ##  if you wish to select multiple factor values; then deselect NONE
                  options = list(`actions-box` = TRUE)) #options = list(`style` = "btn-warning"))
    }
  })
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  biomarker <- eventReactive(input$run_button, input$biomarker)
  
  ## Obtain plots dynamically --------------------------------------------------
  ##### Barlot -----------------------------------------------------------------
  
  # The barplot has two steps:
  # 1. Create de new df 
  # 2. Apply the function

  data_plot <- reactive({
    req(data_input(), input$num_var_1, input$num_var_2, input$biomarker, input$selected_bins) 
    # We filter by biomarker in case user selected, otherwise data_input() remains the same
    if (input$biomarker != "Not Selected") df <- data_input()[data_input()[[input$biomarker]] %in% input$selected_factors,]
    else df <- data_input()
    df1 <- df %>%
      dplyr::filter(.data[[input$num_var_2]] %in% input$selected_bins ) %>% 
      count(.data[[input$num_var_1]]) %>%
      dplyr::mutate(n = n / sum(n) * 100) 
    df1
  })
  
  observe({print(data_plot())})
  
  plot_1 <- eventReactive(input$run_button,{
    req(input$selected_bins, data_plot(), input$num_var_2, input$num_var_1)
    draw_barplot(data_plot(), num_var_1(), num_var_2(), biomarker = "selected")
  })
  
  output$plot_1 <- renderPlot(plot_1())
  
}

# Connection for the shinyApp
shinyApp(ui = ui, server = server)

Related Topics