Question

Hi Stack Overflow社区，

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

定性特征频率表和
基于此表，它是一个基于级别的彩色饼图。

已创建该应用程序，但我无法使颜色适用于饼图...这很奇怪，因为在闪亮的服务器外部，代码（用于表格和饼图）均有效。

N.B .：我知道您需要在dplyr环境中使用shiny时评估从字符串到符号的转换，但是我做到了，表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)

感谢您对我的帮助！祝你有美好的一天！

Answer 1

实际上，它并不那么复杂。我对您的脚本进行了三处更改：

如果您有一个名为aes_string的函数，则应真正使用字符串。您使用aes_string(x="", y = per, fill = input$qual_qual1)，其中per不是字符串，x必须为NA才能使用。
在光亮的应用程序中使用dplyr可能不会很快。取决于数据集的大小。您可以使用基本的R dplyr-和table-函数对rev进行所有操作。
如果您已经在使用shiny试用plotly。 plotly中的代码比ggplot2干净。对于该示例，我还使用RColorBrewer包根据数据中的频率对颜色进行了排序。

我的代码：

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

屏幕截图：

如何在闪亮的应用程序中根据名义特征的层次为饼图着色？

1 个答案: