Subset data based on input and create a plots with this data on Rshiny

Roman history fan here, so I have a dataframe with the name of two legions (fifth and tirteenth), their casualties (numerical value), and the moral of the troops (high, medium, low).

I want to know (boxplot) the relationship between moral (x axis) and casualties (y axis), and also subset by legion:

Legion <- c("Fifth", "Fifth", "Fifth","Fifth","Fifth","Tirteenth","Tirteenth", "Tirteenth", "Tirteenth","Tirteenth")
Casualties <- c(13, 34,23,123,0,234,3,67,87,4)
Moral <- c("High", "Medium", "Low","High", "Medium", "Low","High", "Medium", "Low", "High")
romans <- data.frame(Legion, Casualties, Moral)

Please notice that this is a toy example. In the real data (no romans) we have several variables for each of the axis, so we ask the user to load the data, and then select which variables he wants to use for each axis.

This is what I have:

library(shiny)
library(shinythemes)
library(dplyr)
library(readxl)
library(ggplot2)

not_sel <- "Not Selected"

main_page <- tabPanel(
  title = "Romans",
  titlePanel("Romans"),
  sidebarLayout(
    sidebarPanel(
      title = "Inputs",
      fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
      selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
      selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
      selectInput("factor", "Select factor", choices = c(not_sel)),
      br(),
      actionButton("run_button", "Run Analysis", icon = icon("play"))
    ),
    mainPanel(
      tabsetPanel(
        tabPanel(
          title = "Plot",
          plotOutput("plot_1")
        )
      )
    )
  )
)

draw_plot_1 <- function(data_input, num_var_1, num_var_2, factor){

  
  if(num_var_1 != not_sel & num_var_2 != not_sel & factor == not_sel){
    ggplot(data = data_input, aes_string(x = num_var_1, y = num_var_2, fill= num_var_2)) +
      geom_boxplot() + 
      theme_bw()
  }
  
  else if(num_var_1 != not_sel & num_var_2 != not_sel & factor != not_sel){
    ggplot(data = data_input, aes_string(x = num_var_1, y = num_var_2, fill = factor)) +
      geom_boxplot() + 
      theme_bw()
  }
}


ui <- navbarPage(
  title = "Plotter",
  theme = shinytheme("yeti"),
  main_page
)

server <- function(input, output){
  options(shiny.maxRequestSize=10*1024^2)
  
  data_input <- reactive({
    req(input$xlsx_input)
    inFile <- input$xlsx_input
    read_excel(inFile$datapath, 1)
  })
  
  
  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 = "factor", choices = choices)
  })
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  factor <- eventReactive(input$run_button, input$factor)
  
    plot_1 <- eventReactive(input$run_button,{
    draw_plot_1(data_input(), num_var_1(), num_var_2(), factor())
  })
  
  
  output$plot_1 <- renderPlot(plot_1())
   
}

shinyApp(ui = ui, server = server)

I've been trying different methods to:

  • First, let the user select which legion wants to plot.
  • Implement this selection in plot.

So far, the plot looks like this:

Boxplot Any help given would be really appreciate it.

1 answer

  • answered 2021-11-28 23:56 YBS

    Perhaps you are looking for this

    Legion <- c("Fifth", "Fifth", "Fifth","Fifth","Fifth","Tirteenth","Tirteenth", "Tirteenth", "Tirteenth","Tirteenth")
    Casualties <- c(13, 34,23,123,0,234,3,67,87,4)
    Moral <- c("High", "Medium", "Low","High", "Medium", "Low","High", "Medium", "Low", "High")
    romans <- data.frame(Legion, Casualties, Moral)
    
    library(shiny)
    library(shinythemes)
    library(shinyWidgets)
    library(dplyr)
    library(readxl)
    library(ggplot2)
    
    not_sel <- "Not Selected"
    
    main_page <- tabPanel(
      title = "Romans",
      titlePanel("Romans"),
      sidebarLayout(
        sidebarPanel(
          title = "Inputs",
          fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
          selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
          selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
          selectInput("factor", "Select factor", choices = c(not_sel)), uiOutput("leg"),
          br(),
          actionButton("run_button", "Run Analysis", icon = icon("play"))
        ),
        mainPanel(
          tabsetPanel(
            tabPanel(
              title = "Plot",
              plotOutput("plot_1")
            )
          )
        )
      )
    )
    
    draw_plot_1 <- function(data_input, num_var_1, num_var_2, factor){
      print(num_var_1)
    
      if(num_var_1 != not_sel & num_var_2 != not_sel & factor == not_sel){
        ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]], fill= .data[[num_var_2]])) +
          geom_boxplot() +
          theme_bw()
      }
    
      else if(num_var_1 != not_sel & num_var_2 != not_sel & factor != not_sel){
        ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]], fill = .data[[factor]])) +
          geom_boxplot() +
          theme_bw()
      }
    }
    
    
    ui <- navbarPage(
      title = "Plotter",
      theme = shinytheme("yeti"),
      main_page
    )
    
    options(shiny.maxRequestSize=10*1024^2)
    
    server <- function(input, output){
    
    
      data_input <- reactive({
        # req(input$xlsx_input)
        # inFile <- input$xlsx_input
        # read_excel(inFile$datapath, 1)
        romans
      })
    
    
      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 = "factor", choices = choices)
      })
    
      output$leg <- renderUI({
        req(input$factor,data_input())
        if (input$factor != not_sel) {
          b <- unique(data_input()[[input$factor]])
          pickerInput(inputId = 'selected_factors',
                      label = 'Select factors',
                      choices = c(b[1:length(b)]), selected=b[1],
                      multiple = TRUE,  ###  if you wish to select multiple factor values; then deselect NONE
                      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)
      factor <- eventReactive(input$run_button, input$factor)
    
      plot_1 <- eventReactive(input$run_button,{
        #print(input$selected_factors)
        req(input$factor,data_input())
        if (!is.null(input$selected_factors)) df <- data_input()[data_input()[[input$factor]] %in% input$selected_factors,]
        else df <- data_input()
        draw_plot_1(df, num_var_1(), num_var_2(), factor())
      })
    
      output$plot_1 <- renderPlot(plot_1())
    
    }
    
    shinyApp(ui = ui, server = server)
    

    output

How many English words
do you know?
Test your English vocabulary size, and measure
how many words do you know
Online Test
Powered by Examplum