如何在闪亮的应用程序中根据标称特征的级别为饼图着色?

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

嗨 Stack Overflow 社区,

我正在使用 shiny 设置用户界面。到目前为止,我想输出

  1. 定性特征的频率 table 和
  2. 基于此table,一个基于级别的彩色饼图。

应用程序已创建,但我无法使颜色适用于饼图...这很奇怪,因为在闪亮的服务器之外,代码(适用于 table 和饼图)有效.

N.B.: 我知道你需要评估在 shiny 环境中使用 dplyr 时从字符串到符号的转换,但我做到了 table frequencytable1 看起来非常好。

代码:

#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)

谢谢你帮助我!祝你有美好的一天!

其实也没那么复杂。我对您的脚本进行了三处更改:

  1. 如果您有一个名为 aes_string 的函数,您应该真正使用字符串。您使用 aes_string(x="", y = per, fill = input$qual_qual1),其中 per 不是字符串并且 x 需要 NA 才能工作。
  2. 在闪亮的应用程序中使用 dplyr 可能不是很快。取决于你的数据集有多大。您可以使用基本的 R table- 和 rev- 函数执行对 dplyr 执行的所有操作。
  3. 如果您已经在使用 shiny 试用版 plotlyplotly 中的代码比 ggplot2 中的代码更清晰。对于该示例,我还使用 RColorBrewer-package.
  4. 根据数据中的频率对颜色进行了排序

我的代码:

#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)

截图: