I have a sample data set and I am trying to plot a basic donut plot in R via plotly. The code almost (currently the code below does not update the second color) works fine. Now, I want to show sum of the values of both the IDs under Type next to the respective percentages.
How can I do this?
Data
Value = c(50124, 9994, 9822, 13580, 5906, 7414, 16847, 59, 80550, 6824, 3111, 16756, 7702, 23034, 38058, 6729, 6951, 2, 408,
37360, 20517, 18714, 352, 3, 42922, 30850, 21, 4667, 12220, 8762, 445, 1875, 719, 188, 26, 124, 996, 10,
27, 304, 55, 34980, 67, 3, 25, 1012, 3588, 77, 847, 47, 1057, 924, 233, 40, 2, 2362, 3,
1866, 16, 0, 0, 0)
Type = c("A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B",
"B", "B", "B", "B", "B" "B", "B", "B", "B", "B", "B",
"B", "B", "B", "B", "B", "B", "B")
df = data.frame(Type, Value)
Code
library(tidyverse)
library(plotly)
color = c('rgb(0,255,255)', 'rgb(255,127,80)')
fig = df %>% plot_ly(labels = ~Type,
values = ~Value,
#colors = c("grey50", "blue"),
marker = list(colors = color))
fig = fig %>% add_pie(hole = 0.6,
text = ~paste(sum(Value)),
textinfo = "text + percent"))
fig = fig %>% layout(title = "Title", showlegend = T,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = T),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = T))
fig
Desired output
In your dataframe calculate a sum column and paste it in text = ~paste(sum)
df1 <- df %>%
group_by(Type) %>%
mutate(sum = sum(Value))
library(tidyverse)
library(plotly)
color = c('rgb(0,255,255)', 'rgb(255,127,80)')
fig = df1 %>% plot_ly(labels = ~Type,
values = ~Value,
#colors = c("grey50", "blue"),
marker = list(colors = color))
fig = fig %>% add_pie(hole = 0.6,
text = ~paste(sum),
textinfo = "text + percent")
fig = fig %>% layout(title = "Title", showlegend = T,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = T),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = T))
fig
Related
does anyone know how to deal with line charts in log scale where there are zero values in plotly? The lines sort of just disappear.
library(tidyverse)
library(lubridate)
library(plotly)
df2 <- tibble::tribble(
~SAMPLE_DATE, ~REPORT_RESULT_VALUE,
"2018-10-04", 0.05,
"2019-05-05", 0.01,
"2019-10-04", 0,
"2020-06-05", 0.01,
"2020-09-11", 0,
"2021-04-23", 0,
"2022-05-08", 0.06 ) %>%
mutate(SAMPLE_DATE = ymd(SAMPLE_DATE))
plot_ly(data = df2) %>%
add_trace(x = ~SAMPLE_DATE,
y = ~REPORT_RESULT_VALUE,
mode = "lines+markers") %>%
layout(xaxis = list(title = 'Sample date'),
yaxis = list(title = "Concentration (mg/L)",
type = "log"))
I found a similar post in the plotly forum a while ago, but no solution: https://community.plotly.com/t/line-chart-with-zero-in-logarithmic-scale/40084
-----------------------
An extra example based on Jon Spring's edited answer.
df3 <- tibble::tribble(
~SAMPLE_DATE, ~REPORT_RESULT_VALUE, ~CHEMICAL_NAME,
"2018-10-04", 0.05, "a",
"2019-05-05", 0.01, "a",
"2019-10-04", 0, "a",
"2020-06-05", 0.01, "a",
"2020-09-11", 0, "a",
"2021-04-23", 0, "a",
"2022-05-08", 0.06, "a",
"2018-10-04", 95, "b",
"2019-05-05", 90, "b",
"2019-10-04", 80, "b",
"2020-06-05", 91, "b",
"2020-09-11", 90, "b",
"2021-04-23", 90, "b",
"2022-05-08", 96, "b",
"2018-10-04", 9.5, "c",
"2019-05-05", 9.0, "c",
"2019-10-04", 8.0, "c",
"2020-06-05", 9.1, "c",
"2020-09-11", 9.0, "c",
"2021-04-23", 9.0, "c",
"2022-05-08", 9.6, "c") %>%
mutate(SAMPLE_DATE = ymd(SAMPLE_DATE))
ggplotly(
ggplot(df3, aes(SAMPLE_DATE, REPORT_RESULT_VALUE, colour = CHEMICAL_NAME)) +
geom_line() +
geom_point() +
scale_y_continuous(trans = scales::pseudo_log_trans(sigma = 0.1),
breaks = scales::breaks_pretty(n = 10)) +
labs(x = 'Sample date', y = "Concentration (mg/L)")
)
Here ideally I would like to have the labels spread out more.
Here's a way to do it in ggplot2 using the handy scales::pseudo_log_trans function and then using plotly::ggplotly to convert to plotly. pseudo_log_trans is handy when you want a (mostly) log scale but you want to accommodate zeroes or even negative values.
ggplotly(
ggplot(df2, aes(SAMPLE_DATE, REPORT_RESULT_VALUE)) +
geom_line() +
geom_point() +
scale_y_continuous(trans = scales::pseudo_log_trans(sigma = 0.005),
breaks = scales::breaks_pretty(n=10), # EDIT
labels = scales::number_format()) +
labs(x = 'Sample date', y = "Concentration (mg/L)")
)
Would removing zero work for you?
plot_ly(data = df2 %>% filter(REPORT_RESULT_VALUE > 0)) %>%
add_trace(x = ~SAMPLE_DATE,
y = ~REPORT_RESULT_VALUE,
mode = "lines+markers",
na.rm = TRUE) %>%
layout(xaxis = list(title = 'Sample date'),
yaxis = list(title = "Concentration (mg/L)",
type = "log"))
Created on 2022-12-22 with reprex v2.0.2
library(tidyverse)
library(waffle)
df_2 <- structure(list(group = c(2, 2, 2, 1, 1, 1),
parts = c("A", "B", "C", "A", "B", "C"),
values = c(1, 39, 60, 14, 15, 71)), row.names = c(NA,
-6L), class = c("tbl_df", "tbl", "data.frame"))
df_2 %>% ggplot(aes(label = parts)) +
geom_pictogram(
n_rows = 10, aes(color = parts, values = values),
family = "fontawesome-webfont",
flip = TRUE
) +
scale_label_pictogram(
name = "Case",
values = c("male"),
breaks = c("A", "B", "C"),
labels = c("A", "B", "C")
) +
scale_color_manual(
name = "Case",
values = c("A" = "red", "B" = "green", "C" = "grey85"),
breaks = c("A", "B", "C"),
labels = c("A", "B", "C")
) +
facet_grid(~group)
With the above code, I got the legend what I expected:
However, when I replaced df_2 with the following df_1 dataframe, I was unable to combine two legends.
df_1 <- structure(list(group = c(2, 2, 2, 1, 1, 1),
parts = c("A", "B", "C", "A", "B", "C"),
values = c(0, 0, 100, 0, 0, 100)),
row.names = c(NA,-6L), class = c("tbl_df", "tbl", "data.frame"))
I kind of know the cause of the problem (0 values) but I would like to keep the legend the same as the graph above. Any suggestions would be appreciated.
To make it clear, the package "waffle" referred to here is not the CRAN package "waffle", but the GitHub-only package:
remotes::install_github("hrbrmstr/waffle")
library(waffle)
You will also need a way of displaying the pictograms, such as:
library(emojifont)
load.fontawesome()
Now, as with any other discrete scale, if you want to add values that are not present in the (post-stat) data, you need to use the limits argument:
df_1 %>% ggplot(aes(label = parts)) +
geom_pictogram(
n_rows = 10, aes(color = parts, values = values),
family = "fontawesome-webfont",
flip = TRUE
) +
scale_label_pictogram(
name = "Case",
values = c("male"),
breaks = c("A", "B", "C"),
labels = c("A", "B", "C"),
limits = c("A", "B", "C")
) +
scale_color_manual(
name = "Case",
values = c("A" = "red", "B" = "green", "C" = "grey85"),
breaks = c("A", "B", "C"),
labels = c("A", "B", "C")
) +
facet_grid(~group)
It is a bit tricky, but what you could do is say let's add 1 to all values so it will plot it like before. But using ggplot_build to remove from each case one row to get it in the right amount like this:
library(tidyverse)
library(waffle)
library(ggplot2)
library(dplyr)
library(emojifont)
library(waffle)
library(extrafont)
p <- df_1 %>% ggplot(aes(label = parts)) +
geom_pictogram(
n_rows = 10, aes(color = parts, values = values+1),
family = "fontawesome-webfont",
flip = TRUE
) +
scale_label_pictogram(
name = "Case",
values = c("male"),
breaks = c("A", "B", "C"),
labels = c("A", "B", "C")
) +
scale_color_manual(
name = "Case",
values = c("A" = "red", "B" = "green", "C" = "grey85"),
breaks = c("A", "B", "C"),
labels = c("A", "B", "C")
) +
facet_grid(~group)
q <- ggplot_build(p)
q$data[[1]] <- q$data[[1]] %>%
group_by(PANEL) %>%
slice(4:n())
q <- ggplot_gtable(q)
plot(q)
Created on 2022-10-20 with reprex v2.0.2
I am trying to plot a basic donut plot in R using plotly. I then add custom colors to the plot. Now, the first color updates fine, but the second color i.e. 'rgb(255,127,80)' doesn't.
How can I fix this?
Data
Value = c(50124, 9994, 9822, 13580, 5906, 7414, 16847, 59, 80550, 6824, 3111, 16756, 7702, 23034, 38058, 6729, 6951, 2, 408,
37360, 20517, 18714, 352, 3, 42922, 30850, 21, 4667, 12220, 8762, 445, 1875, 719, 188, 26, 124, 996, 10,
27, 304, 55, 34980, 67, 3, 25, 1012, 3588, 77, 847, 47, 1057, 924, 233, 40, 2, 2362, 3,
1866, 16, 0, 0, 0)
Type = c("A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"B", "B", "B", "B", "B", "B", "B", "B", "B", "B", "B",
"B", "B", "B", "B", "B" "B", "B", "B", "B", "B", "B",
"B", "B", "B", "B", "B", "B", "B")
df = data.frame(Type, Value)
Code
library(tidyverse)
library(plotly)
color = c('rgb(0,255,255)', 'rgb(255,127,80)')
fig = df %>% plot_ly(labels = ~Type,
values = ~Value,
#colors = c("grey50", "blue"),
marker = list(colors = color)
)
fig = fig %>% add_pie(hole = 0.6)
fig = fig %>% layout(title = "Title", showlegend = T,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = T),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = T))
fig
Current output
You could it this way:
Note: 1. make a column in your dataframe for the colors
2. use type=pie with add_pie(hole=0.4)
df1 <- df %>%
group_by(Type) %>%
mutate(sum = sum(Value),
Typecolor = ifelse(Type=="A", 'rgb(0,255,255)', 'rgb(255,127,80)'))
df1 %>% plot_ly(labels = ~Type,
values = ~Value,
type = 'pie',
textposition = "inside",
textinfo = 'label+percent',
hole=0.6,
marker = list(colors = ~Typecolor)
) %>% add_pie(hole = 0.4)
)
0
Forgive my stupid to disturb you again.
#teunbrand answered my question yesterday and I used it in my real data but it doesn’t work .
Here is my question in stackoverfow:Can I adjust the fill(color) of different label regions when using ggh4x package
And # teunbrand created a function : assign_strip_colours <- function(gt, index, colours){…}
I don’t know where is wrong with my real data and code. There are 42 regions need to be filled with different colors.
gt <- assign_strip_colours(gt, 1:42,rainbow(42)) Warning message: In gt$grobs[is_strips] <- strips : 被替换的项目不是替换值长度的倍数(The item being replaced is not a multiple of the length of the replacement value. ) ?
If there is sth need to be adjust in assign_strip_colours <- function(gt, index, colours){…} ?
Forgive me I’m really new to ggplotGrob. I need your help.Thanks.
sample data and code:
structure(list(Name = 1:71, Disease = 72:142, Organ = c("A",
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A",
"A", "A", "A", "A", "A"), fill = c("a", "a", "a", "a", "a", "a",
"a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a",
"a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a",
"a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a",
"a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a",
"a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a", "a"
), mean =..., row.names = c(NA, 71L), class = "data.frame")
p1<-ggplot(data = data, aes(Name,mean, label = Name, fill=Organ)) +
geom_bar(position="dodge2", stat="identity",width = 0.85,color="black") +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd),position = position_dodge(0.95), width = .2) +
# scale_alpha_manual(values = datamean_sd$Alpha) +
# scale_color_manual(name = "Organ", values = c("A"="#f15a24", "B"="#00FF00","C"="#7570B3","D"="#FF00FF","E"="#FFFF33","F"="#00F5FF","G"="#666666","H"="#7FC97F","I"="#BEAED4","J"="#A6D854"))+
# guides(
# colour = guide_legend(title.position = "right")
# )+
facet_nested(.~Organ+Disease, scales = "free_x", space = "free_x",switch = "x")+
## facet_wrap(strip.position="bottom") +
labs(title = "123", x = NULL, y = "value") +
rotate_x_text(angle = 45)+
scale_fill_manual(name = "Organ",values = unique(datamean_sd$Organ_fill))
p1
####
gt <- ggplotGrob(p1)
###############
assign_strip_colours <- function(gt, index, colours) {
if (length(index) != length(colours))
stop()
# Decide which strips to recolour, here: the first 3
is_strips <- which(startsWith(gt$layout$name, "strip-b"))[index]
# Extract strips
strips <- gt$grobs[is_strips]
# Loop over strips
strips <- mapply(function(strip, colour) {
# Find actual strip
is_strip <- strip$layout$name == "strip"
grob <- strip$grobs[is_strip][[1]]
# Find rectangle
is_rect <- which(vapply(grob$children, inherits, logical(1), "rect"))
# Change colour
grob$children[[is_rect]]$gp$fill <- colour
# Put back into strip
strip$grobs[is_strip][[1]] <- grob
return(strip)
}, strip = strips, colour = colours)
# Put strips back into gtable
gt$grobs[is_strips] <- strips
return(gt)
}
gt <- assign_strip_colours(gt, 1:42,rainbow(42))
grid::grid.newpage(); grid::grid.draw(gt)
My bad, I think there should have been a SIMPLIFY = FALSE at the mapply() function which I forgot earlier.
gt <- ggplotGrob(p1)
assign_strip_colours <- function(gt, index, colours) {
if (length(index) != length(colours))
stop()
# Decide which strips to recolour, here: the first 3
is_strips <- which(startsWith(gt$layout$name, "strip-b"))[index]
# Extract strips
strips <- gt$grobs[is_strips]
# Loop over strips
strips <- mapply(function(strip, colour) {
# Find actual strip
is_strip <- strip$layout$name == "strip"
grob <- strip$grobs[is_strip][[1]]
# Find rectangle
is_rect <- which(vapply(grob$children, inherits, logical(1), "rect"))
# Change colour
grob$children[[is_rect]]$gp$fill <- colour
# Put back into strip
strip$grobs[is_strip][[1]] <- grob
return(strip)
}, strip = strips, colour = colours, SIMPLIFY = FALSE)
# Put strips back into gtable
gt$grobs[is_strips] <- strips
return(gt)
}
gt <- assign_strip_colours(gt, 1:42,rainbow(42))
grid::grid.newpage(); grid::grid.draw(gt)
Created on 2021-04-11 by the reprex package (v1.0.0)
Data / plot construction:
library(ggplot2)
library(ggh4x)
data <- [Censored upon request]
p1<-ggplot(data = data, aes(Name,mean, label = Name, fill=Organ)) +
geom_bar(position="dodge2", stat="identity",width = 0.85,color="black") +
geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd),position = position_dodge(0.95), width = .2) +
facet_nested(.~Organ+Disease, scales = "free_x", space = "free_x",switch = "x")+
theme_classic() +
theme(legend.position = "bottom",
legend.box = "horizontal",
plot.title = element_text(hjust = 0.5),
plot.margin = unit(c(5, 10, 20, 7), "mm"),
strip.background = element_rect(colour="black", fill="white"),
strip.text.x = element_text(size = 6, angle=0),
axis.text.x=element_text(size=8),
strip.placement = "outside"
) +
labs(title = "123", x = NULL, y = "value")
I am trying to learn how to use ggvis to make plots. I really would like on that looks like this:
I have learned how to make a nearly identical plot:
library(ggvis)
y <- c(
"a", "b", "c", "d", "e", "f", "g", "h",
"a", "b", "c", "d", "e", "f", "g", "h")
x <- c(28, 25, 38, 19, 13, 30, 60, 18, 11, 10, 17, 13, 9, 25, 56, 17)
Status <- c(rep(c('Group 1'),8), rep(c('Group 2'),8))
df <- data.frame(y,x,Status)
df %>% ggvis(x= ~x, y= ~y, fill= ~Status) %>% layer_points() %>%
add_axis('x', properties= axis_props( grid = list(stroke = 'blank') )) %>%
add_axis('y', properties= axis_props( grid = list(stroke = 'blank') ))
My question: How can I order the plot like they have done in the top plot? It looks like they have ordered it from biggest to smallest somehow. Thanks!
tbl_df(df) %>%
mutate(y=as.character(y), x=as.numeric(x)) %>%
arrange(desc(x)) %>%
ggvis(x= ~x, y= ~y, fill= ~Status) %>% layer_points() %>%
add_axis('x', properties= axis_props( grid = list(stroke = 'blank') )) %>%
add_axis('y', properties= axis_props( grid = list(stroke = 'blank') ))