I have a dataset with categorical data (let's use Arthritis from vcd package for exmaple purposes).

I want to obtain a barplot where for two variables and colouring by a third one.

In base R this would be:

library(vcd)
library(ggplot2)

data(Arthritis)
tab <- as.data.frame(prop.table(table(Arthritis$Treatment, Arthritis$Improved), margin = 1))

ggplot(tab,aes(x=Var1,y=Freq, fill=Var2, label = round(Freq,3))) 
  geom_bar(stat = 'identity') 
  geom_text(position = position_stack(vjust=0.5)) 
  scale_fill_manual(values=c('cyan3','tomato', 'blue'), guide = guide_legend(reverse=TRUE))

Which would give the result:

In my shinyApp the user should be able to choose the variables to plot.

For this I've created:

# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)
library(shinyjs)

# Data
library(readxl)
library(dplyr)
library(vcd)

# Plots
library(ggplot2)

not_sel <- "Not Selected"

ui <- navbarPage(
  title = "Plotter",
  windowTitle = "Plotter",
  tabPanel(
    "Plotter",
    fluidPage(
      fluidRow(
        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)),
          uiOutput("factor"),
          br(),
          actionButton("run_button", "Run Analysis", icon = icon("play"))
        ),
        
        # Main panel
        mainPanel(
          tabsetPanel(
            tabPanel(
              "Plot",
              br(),
              plotOutput("plot_1"),
              br(),
              verbatimTextOutput("data")
            ) 
          )
        )
      )
    )
  )
)

################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
server <- function(input, output){
  
  # Dynamic selection of the data 
  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)
  })
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  
  # data
  data_discrete_plot <- reactive({
    req(data_input(), input$num_var_1, input$num_var_2) 
    df <- data_input()
    df1 <- as.data.frame(prop.table(table(df[[input$num_var_1]], df[[input$num_var_2]]), margin = 1))
    df1
  })
  
  # Function for printing the plots
  draw_barplot <- function(data_input)
    ggplot(data = data_input, aes(x=data_input[1], y=data_input[3], fill=data_input [2], label = round(Freq, 3)))  
    geom_bar(stat = "identity")  
    scale_fill_manual(guide = guide_legend(reverse=TRUE))  
    ylim(0, 100)   
    theme_bw()
  
  ## BarPlot -------------------------------------------------------------------
  plot_1 <- eventReactive(input$run_button,{
    req(data_input())
    draw_barplot(data_discrete_plot())
  })
  
  output$plot_1 <- renderPlot(plot_1())
  
  output$data <- renderPrint(data_discrete_plot())
}

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

As you can see in the previous RepEx we are obtaining the contingency table, however, I'm finding some trouble when calling for the variables to plot, as it is a new dataframe with different names for the data.

If I run the code above, I get an error that says: default method not implemented for type 'list'

But if I try to do something like:

data_input[1] <- unlist(data_input[1])
data_input[2] <- unlist(data_input[2])
data_input[3] <- unlist(data_input[3])

The application crashes.

CodePudding user response：

As the columns of your new dataframe have names Var1, Var2 and Freqyou could do:

draw_barplot <- function(data_input) {
    ggplot(data = data_input, aes(x = Var1, y = Freq, fill = Var2, label = round(Freq, 3)))  
      geom_bar(stat = "identity")  
      scale_fill_discrete(guide = guide_legend(reverse = TRUE))  
      ylim(0, 1)  
      theme_bw()
  }

Additionally I replaced scale_fill_manual by scale_fill_discrete as for the first one you have to provide a vector of color values and set ylim(0, 1) as the proportions in the ´Freq` column are on a 0 to 1 scale.