Search code examples
rcolorsshinypie-chart

How to color a pie chart, based on levels of a nominal feature, in a shiny app?

Hi Stack Overflow community,

I am working on setting up a user interface with shiny. So far, I would like to output

  1. a frequency table of qualitative features and
  2. based on this table, a level-based colored pie chart.

The app is created but I cannot make the colors work for the pie chart... which is weird, because outside the shiny server, the code (both for the table and the pie chart) works.

N.B.: I know you need to evaluate the conversion from strings to symbols while using dplyr in shiny environment, but I did it and the table frequencytable1 looks perfectly fine.

The code:

#Loading libraries#
###################

library(ggplot2) #visualization library (all kinds of plots)
library(shiny) #web application library (setting up a user interface with backing code on a server's side)
library(DT) #table formating library
library(dplyr) #data pre-processing library (SQL, summary stat, feature creation, filtering, ordering, merging,...)
library(random)

#Creating the dataframe#
########################
set.seed(1)
dataf <- data.frame(list(first = c(1:100), 
                         third = c(sample(0:99, 100, replace = TRUE)), 
                         fourth = c(sample(LETTERS[1:4], 100, replace = TRUE)),
                         fifth = rnorm(100, mean = 70, sd = 10), 
                         sixth = rnorm(100, mean = 20, sd = 2), 
                         seventh = c(sample(c("A-B", "C-D", "E-F"), 100, replace = TRUE)),
                         eight = c(sample(LETTERS[1:2], 100, replace = TRUE)),
                         tenth = c(sample(letters[1:3], 100, replace = TRUE)),
                         eleventh = rnorm(100, mean = 40, sd = 10),
                         twelfth = c(sample(letters[25:26], 100, replace = TRUE)),
                         y = rnorm(100, mean = 10, sd = 1)), stringsAsFactors = FALSE)

#Shiny App#
###########
ui <- fluidPage(
  sidebarLayout(
  sidebarPanel(selectInput(inputId = "qual_qual1", label = "Choose a qualitative feature:", choices = names(which(unlist(lapply(dataf, is.character)))), selectize = TRUE)),
  mainPanel(DT::dataTableOutput(outputId = "frequencytable1"), plotOutput(outputId = "piechart1"))
  ))


server <- function(input, output){

  frequency1 <- reactive({ 

    dataf %>% 
      group_by(!! rlang::sym(input$qual_qual1)) %>% 
      count() %>% 
      ungroup() %>% 
      mutate(per = `n`/sum(`n`)) %>% 
      arrange(desc(!! rlang::sym(input$qual_qual1))) %>% 
      mutate(position = cumsum(n) - n / 2)

  })

  output$frequencytable1 <- DT::renderDataTable({ 

    DT::datatable(frequency1())

  })

  output$piechart1 <- renderPlot({ 

    ggplot(frequency1()) + geom_bar(aes_string(x="", y = per, fill = input$qual_qual1), stat = "identity", width = 1) +
      coord_polar("y", start = 0) + geom_text(aes(x = 1, y = cumsum(per) - per/2, label = paste(per*100, '%'))) +
      labs(title=paste('Pie chart of', input$qual_qual1), fill=input$qual_qual1) +
      scale_fill_brewer(palette = "Oranges", direction = -1) +
      theme(plot.title = element_text(size=12, face="bold")) +
      theme_void()

  })
}

shinyApp(ui = ui, server = server)

Thank you for helping me! Have a nice day!

Solution

  • Actually it is not that complicated. I made three changes to your script:

    1. If you have a function which is called aes_string you should really use strings. You use aes_string(x="", y = per, fill = input$qual_qual1), where per is not a string and x needs to be NA to work.
    2. Using dplyr might not be very fast inside a shiny app. Depending on how big your dataset is. You can do all the operations you do with dplyr with the basic R table- and rev-function.
    3. If you are already using shiny tryout plotly. The code in plotly is cleaner than ggplot2. For that example I also ordered the colors according to the frequency in the data using the RColorBrewer-package.

    my code:

    #Loading libraries#
###################

library(ggplot2) #visualization library (all kinds of plots)
library(shiny) #web application library (setting up a user interface with backing code on a server's side)
library(DT) #table formating library
library(random)
library(plotly)

#Creating the dataframe#
########################
set.seed(1)
dataf <- data.frame(list(first = c(1:100), 
                         third = c(sample(0:99, 100, replace = TRUE)), 
                         fourth = c(sample(LETTERS[1:4], 100, replace = TRUE)),
                         fifth = rnorm(100, mean = 70, sd = 10), 
                         sixth = rnorm(100, mean = 20, sd = 2), 
                         seventh = c(sample(c("A-B", "C-D", "E-F"), 100, replace = TRUE)),
                         eight = c(sample(LETTERS[1:2], 100, replace = TRUE)),
                         tenth = c(sample(letters[1:3], 100, replace = TRUE)),
                         eleventh = rnorm(100, mean = 40, sd = 10),
                         twelfth = c(sample(letters[25:26], 100, replace = TRUE)),
                         y = rnorm(100, mean = 10, sd = 1)), stringsAsFactors = FALSE)

#Shiny App#
###########
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(selectInput(inputId = "qual_qual1", label = "Choose a qualitative feature:", choices = names(which(unlist(lapply(dataf, is.character)))), selectize = TRUE)),
    mainPanel(DT::dataTableOutput(outputId = "frequencytable1"), plotOutput(outputId = "piechart1"),plotlyOutput(outputId = 'plotly1'))
  ))


server <- function(input, output){

  frequency1 <- reactive({ 

    n=as.numeric(rev(table(dataf[,input$qual_qual1])))
    df<-data.frame(sort(unique(as.character(dataf[,input$qual_qual1])),decreasing=TRUE),
                   n,per=n/sum(n),postion=cumsum(n)-n/2)
    colnames(df)[1]=input$qual_qual1
    return(df)

  })



  output$frequencytable1 <- DT::renderDataTable({ 

    DT::datatable(frequency1())

  })

  output$piechart1 <- renderPlot({ 

    ggplot(frequency1()) + geom_bar(aes_string(x=NA, y = 'per', fill = input$qual_qual1), stat = "identity", width = 1) +
      coord_polar("y", start = 0) + geom_text(aes(x = 1, y = cumsum(per) - per/2, label = paste(per*100, '%'))) +
      labs(title=paste('Pie chart of', input$qual_qual1), fill=input$qual_qual1) +
      scale_fill_brewer(palette = "Oranges", direction = -1) +
      theme(plot.title = element_text(size=12, face="bold")) +
      theme_void()

  })

  output$plotly1<-renderPlotly({
    df=frequency1()
    colors=RColorBrewer::brewer.pal(nrow(df),'Oranges')
    df_ordered<-df[order(df$per,decreasing = TRUE),]
    plot_ly(df_ordered, labels = df_ordered[,input$qual_qual1], values = ~per, type = 'pie', marker = list(colors = colors)) %>%
      layout(title=paste('Pie chart of', input$qual_qual1),showlegend=TRUE)
  }

  )

}

shinyApp(ui = ui, server = server)

    Screenshot:

    enter image description here