如何在闪亮的应用程序中根据标称特征的级别为饼图着色?
How to color a pie chart, based on levels of a nominal feature, in a shiny app?
嗨 Stack Overflow 社区,
我正在使用 shiny
设置用户界面。到目前为止,我想输出
- 定性特征的频率 table 和
- 基于此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)
谢谢你帮助我!祝你有美好的一天!
其实也没那么复杂。我对您的脚本进行了三处更改:
- 如果您有一个名为
aes_string
的函数,您应该真正使用字符串。您使用 aes_string(x="", y = per, fill = input$qual_qual1)
,其中 per
不是字符串并且 x
需要 NA
才能工作。
- 在闪亮的应用程序中使用 dplyr 可能不是很快。取决于你的数据集有多大。您可以使用基本的 R
table
- 和 rev
- 函数执行对 dplyr
执行的所有操作。
- 如果您已经在使用
shiny
试用版 plotly
。 plotly
中的代码比 ggplot2
中的代码更清晰。对于该示例,我还使用 RColorBrewer
-package. 根据数据中的频率对颜色进行了排序
我的代码:
#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)
截图:
嗨 Stack Overflow 社区,
我正在使用 shiny
设置用户界面。到目前为止,我想输出
- 定性特征的频率 table 和
- 基于此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)
谢谢你帮助我!祝你有美好的一天!
其实也没那么复杂。我对您的脚本进行了三处更改:
- 如果您有一个名为
aes_string
的函数,您应该真正使用字符串。您使用aes_string(x="", y = per, fill = input$qual_qual1)
,其中per
不是字符串并且x
需要NA
才能工作。 - 在闪亮的应用程序中使用 dplyr 可能不是很快。取决于你的数据集有多大。您可以使用基本的 R
table
- 和rev
- 函数执行对dplyr
执行的所有操作。 - 如果您已经在使用
shiny
试用版plotly
。plotly
中的代码比ggplot2
中的代码更清晰。对于该示例,我还使用RColorBrewer
-package. 根据数据中的频率对颜色进行了排序
我的代码:
#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)
截图: