I am trying to replicate this with R ggplot. I have exactly the same data:
browsers<-structure(list(browser = structure(c(3L, 3L, 3L, 3L, 2L, 2L,
2L, 1L, 5L, 5L, 4L), .Label = c("Chrome", "Firefox", "MSIE",
"Opera", "Safari"), class = "factor"), version = structure(c(5L,
6L, 7L, 8L, 2L, 3L, 4L, 1L, 10L, 11L, 9L), .Label = c("Chrome 10.0",
"Firefox 3.5", "Firefox 3.6", "Firefox 4.0", "MSIE 6.0", "MSIE 7.0",
"MSIE 8.0", "MSIE 9.0", "Opera 11.x", "Safari 4.0", "Safari 5.0"
), class = "factor"), share = c(10.85, 7.35, 33.06, 2.81, 1.58,
13.12, 5.43, 9.91, 1.42, 4.55, 1.65), ymax = c(10.85, 18.2, 51.26,
54.07, 55.65, 68.77, 74.2, 84.11, 85.53, 90.08, 91.73), ymin = c(0,
10.85, 18.2, 51.26, 54.07, 55.65, 68.77, 74.2, 84.11, 85.53,
90.08)), .Names = c("browser", "version", "share", "ymax", "ymin"
), row.names = c(NA, -11L), class = "data.frame")
and it looks like this:
> browsers
browser version share ymax ymin
1 MSIE MSIE 6.0 10.85 10.85 0.00
2 MSIE MSIE 7.0 7.35 18.20 10.85
3 MSIE MSIE 8.0 33.06 51.26 18.20
4 MSIE MSIE 9.0 2.81 54.07 51.26
5 Firefox Firefox 3.5 1.58 55.65 54.07
6 Firefox Firefox 3.6 13.12 68.77 55.65
7 Firefox Firefox 4.0 5.43 74.20 68.77
8 Chrome Chrome 10.0 9.91 84.11 74.20
9 Safari Safari 4.0 1.42 85.53 84.11
10 Safari Safari 5.0 4.55 90.08 85.53
11 Opera Opera 11.x 1.65 91.73 90.08
So far, I have plotted the individual components (i.e. the donut chart of the versions, and the pie chart of the browsers) like so:
ggplot(browsers) + geom_rect(aes(fill=version, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) +
coord_polar(theta="y") + xlim(c(0, 4))
ggplot(browsers) + geom_bar(aes(x = factor(1), fill = browser),width = 1) +
coord_polar(theta="y")
The problem is, how do I combine the two to look like the topmost image? I have tried many ways, such as:
ggplot(browsers) + geom_rect(aes(fill=version, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) + geom_bar(aes(x = factor(1), fill = browser),width = 1) + coord_polar(theta="y") + xlim(c(0, 4))
But all my results are either twisted or end with an error message.
Edit 2
My original answer is really dumb. Here is a much shorter version which does most of the work with a much simpler interface.
#' x numeric vector for each slice
#' group vector identifying the group for each slice
#' labels vector of labels for individual slices
#' col colors for each group
#' radius radius for inner and outer pie (usually in [0,1])
donuts <- function(x, group = 1, labels = NA, col = NULL, radius = c(.7, 1)) {
group <- rep_len(group, length(x))
ug <- unique(group)
tbl <- table(group)[order(ug)]
col <- if (is.null(col))
seq_along(ug) else rep_len(col, length(ug))
col.main <- Map(rep, col[seq_along(tbl)], tbl)
col.sub <- lapply(col.main, function(x) {
al <- head(seq(0, 1, length.out = length(x) + 2L)[-1L], -1L)
Vectorize(adjustcolor)(x, alpha.f = al)
})
plot.new()
par(new = TRUE)
pie(x, border = NA, radius = radius[2L],
col = unlist(col.sub), labels = labels)
par(new = TRUE)
pie(x, border = NA, radius = radius[1L],
col = unlist(col.main), labels = NA)
}
par(mfrow = c(1,2), mar = c(0,4,0,4))
with(browsers,
donuts(share, browser, sprintf('%s: %s%%', version, share),
col = c('cyan2','red','orange','green','dodgerblue2'))
)
with(mtcars,
donuts(mpg, interaction(gear, cyl), rownames(mtcars))
)
Original post
You guys don't have givemedonutsorgivemedeath function? Base graphics are always the way to go for very detailed things like this. Couldn't think of an elegant way to plot the center pie labels, though.
givemedonutsorgivemedeath('~/desktop/donuts.pdf')
Gives me
Note that in ?pie you see
Pie charts are a very bad way of displaying information.
code:
browsers <- structure(list(browser = structure(c(3L, 3L, 3L, 3L, 2L, 2L,
2L, 1L, 5L, 5L, 4L), .Label = c("Chrome", "Firefox", "MSIE",
"Opera", "Safari"), class = "factor"), version = structure(c(5L,
6L, 7L, 8L, 2L, 3L, 4L, 1L, 10L, 11L, 9L), .Label = c("Chrome 10.0",
"Firefox 3.5", "Firefox 3.6", "Firefox 4.0", "MSIE 6.0", "MSIE 7.0",
"MSIE 8.0", "MSIE 9.0", "Opera 11.x", "Safari 4.0", "Safari 5.0"),
class = "factor"), share = c(10.85, 7.35, 33.06, 2.81, 1.58,
13.12, 5.43, 9.91, 1.42, 4.55, 1.65), ymax = c(10.85, 18.2, 51.26,
54.07, 55.65, 68.77, 74.2, 84.11, 85.53, 90.08, 91.73), ymin = c(0,
10.85, 18.2, 51.26, 54.07, 55.65, 68.77, 74.2, 84.11, 85.53,
90.08)), .Names = c("browser", "version", "share", "ymax", "ymin"),
row.names = c(NA, -11L), class = "data.frame")
browsers$total <- with(browsers, ave(share, browser, FUN = sum))
givemedonutsorgivemedeath <- function(file, width = 15, height = 11) {
## house keeping
if (missing(file)) file <- getwd()
plot.new(); op <- par(no.readonly = TRUE); on.exit(par(op))
pdf(file, width = width, height = height, bg = 'snow')
## useful values and colors to work with
## each group will have a specific color
## each subgroup will have a specific shade of that color
nr <- nrow(browsers)
width <- max(sqrt(browsers$share)) / 0.8
tbl <- with(browsers, table(browser)[order(unique(browser))])
cols <- c('cyan2','red','orange','green','dodgerblue2')
cols <- unlist(Map(rep, cols, tbl))
## loop creates pie slices
plot.new()
par(omi = c(0.5,0.5,0.75,0.5), mai = c(0.1,0.1,0.1,0.1), las = 1)
for (i in 1:nr) {
par(new = TRUE)
## create color/shades
rgb <- col2rgb(cols[i])
f0 <- rep(NA, nr)
f0[i] <- rgb(rgb[1], rgb[2], rgb[3], 190 / sequence(tbl)[i], maxColorValue = 255)
## stick labels on the outermost section
lab <- with(browsers, sprintf('%s: %s', version, share))
if (with(browsers, share[i] == max(share))) {
lab0 <- lab
} else lab0 <- NA
## plot the outside pie and shades of subgroups
pie(browsers$share, border = NA, radius = 5 / width, col = f0,
labels = lab0, cex = 1.8)
## repeat above for the main groups
par(new = TRUE)
rgb <- col2rgb(cols[i])
f0[i] <- rgb(rgb[1], rgb[2], rgb[3], maxColorValue = 255)
pie(browsers$share, border = NA, radius = 4 / width, col = f0, labels = NA)
}
## extra labels on graph
## center labels, guess and check?
text(x = c(-.05, -.05, 0.15, .25, .3), y = c(.08, -.12, -.15, -.08, -.02),
labels = unique(browsers$browser), col = 'white', cex = 1.2)
mtext('Browser market share, April 2011', side = 3, line = -1, adj = 0,
cex = 3.5, outer = TRUE)
mtext('stackoverflow.com:::maryam', side = 3, line = -3.6, adj = 0,
cex = 1.75, outer = TRUE, font = 3)
mtext('/questions/26748069/ggplot2-pie-and-donut-chart-on-same-plot',
side = 1, line = 0, adj = 1.0, cex = 1.2, outer = TRUE, font = 3)
dev.off()
}
givemedonutsorgivemedeath('~/desktop/donuts.pdf')
Edit 1
width <- 5
tbl <- table(browsers$browser)[order(unique(browsers$browser))]
col.main <- Map(rep, seq_along(tbl), tbl)
col.sub <- lapply(col.main, function(x)
Vectorize(adjustcolor)(x, alpha.f = seq_along(x) / length(x)))
plot.new()
par(new = TRUE)
pie(browsers$share, border = NA, radius = 5 / width,
col = unlist(col.sub), labels = browsers$version)
par(new = TRUE)
pie(browsers$share, border = NA, radius = 4 / width,
col = unlist(col.main), labels = NA)
I find it easier to work in rectangular coordinates first, and when that is correct, then switch to polar coordinates. The x coordinate becomes radius in polar. So, in rectangular coordinates, the inside plot goes from zero to a number, like 3, and the outer band goes from 3 to 4.
For example
ggplot(browsers) +
geom_rect(aes(fill=version, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) +
geom_rect(aes(fill=browser, ymax=ymax, ymin=ymin, xmax=3, xmin=0)) +
xlim(c(0, 4)) +
theme(aspect.ratio=1)
Then, when you switch to polar, you get something like what you are looking for.
ggplot(browsers) +
geom_rect(aes(fill=version, ymax=ymax, ymin=ymin, xmax=4, xmin=3)) +
geom_rect(aes(fill=browser, ymax=ymax, ymin=ymin, xmax=3, xmin=0)) +
xlim(c(0, 4)) +
theme(aspect.ratio=1) +
coord_polar(theta="y")
This is a start, but may need to fine tune the dependency on y (or angle) and also work out the labeling / legend / coloring... By using rect for both the inner and outer rings, that should simplify adjusting the coloring. Also, it can be useful to use the reshape2::melt function to reorganize the data so then legend comes out correct by using group (or color).
I created a general purpose donuts plot function to do this, which could
Draw ring plot, i.e. draw pie chart for panel and colorize each circular sector by given percentage pctr and colors cols. The ring width could be tuned by outradius>radius>innerradius.
Overlay several ring plot together.
The main function actually draw a bar chart and bend it into a ring, hence it is something between a pie chart and a bar chart.
Example Pie Chart, two rings:
Browser Pie Chart
donuts_plot <- function(
panel = runif(3), # counts
pctr = c(.5,.2,.9), # percentage in count
legend.label='',
cols = c('chartreuse', 'chocolate','deepskyblue'), # colors
outradius = 1, # outter radius
radius = .7, # 1-width of the donus
add = F,
innerradius = .5, # innerradius, if innerradius==innerradius then no suggest line
legend = F,
pilabels=F,
legend_offset=.25, # non-negative number, legend right position control
borderlit=c(T,F,T,T)
){
par(new=add)
if(sum(legend.label=='')>=1) legend.label=paste("Series",1:length(pctr))
if(pilabels){
pie(panel, col=cols,border = borderlit[1],labels = legend.label,radius = outradius)
}
panel = panel/sum(panel)
pctr2= panel*(1 - pctr)
pctr3 = c(pctr,pctr)
pctr_indx=2*(1:length(pctr))
pctr3[pctr_indx]=pctr2
pctr3[-pctr_indx]=panel*pctr
cols_fill = c(cols,cols)
cols_fill[pctr_indx]='white'
cols_fill[-pctr_indx]=cols
par(new=TRUE)
pie(pctr3, col=cols_fill,border = borderlit[2],labels = '',radius = outradius)
par(new=TRUE)
pie(panel, col='white',border = borderlit[3],labels = '',radius = radius)
par(new=TRUE)
pie(1, col='white',border = borderlit[4],labels = '',radius = innerradius)
if(legend){
# par(mar=c(5.2, 4.1, 4.1, 8.2), xpd=TRUE)
legend("topright",inset=c(-legend_offset,0),legend=legend.label, pch=rep(15,'.',length(pctr)),
col=cols,bty='n')
}
par(new=FALSE)
}
## col- > subcor(change hue/alpha)
subcolors <- function(.dta,main,mainCol){
tmp_dta = cbind(.dta,1,'col')
tmp1 = unique(.dta[[main]])
for (i in 1:length(tmp1)){
tmp_dta$"col"[.dta[[main]] == tmp1[i]] = mainCol[i]
}
u <- unlist(by(tmp_dta$"1",tmp_dta[[main]],cumsum))
n <- dim(.dta)[1]
subcol=rep(rgb(0,0,0),n);
for(i in 1:n){
t1 = col2rgb(tmp_dta$col[i])/256
subcol[i]=rgb(t1[1],t1[2],t1[3],1/(1+u[i]))
}
return(subcol);
}
### Then get the plot is fairly easy:
# INPUT data
browsers <- structure(list(browser = structure(c(3L, 3L, 3L, 3L, 2L, 2L,
2L, 1L, 5L, 5L, 4L),
.Label = c("Chrome", "Firefox", "MSIE","Opera", "Safari"),class = "factor"),
version = structure(c(5L,6L, 7L, 8L, 2L, 3L, 4L, 1L, 10L, 11L, 9L),
.Label = c("Chrome 10.0", "Firefox 3.5", "Firefox 3.6", "Firefox 4.0", "MSIE 6.0",
"MSIE 7.0","MSIE 8.0", "MSIE 9.0", "Opera 11.x", "Safari 4.0", "Safari 5.0"),
class = "factor"),
share = c(10.85, 7.35, 33.06, 2.81, 1.58,13.12, 5.43, 9.91, 1.42, 4.55, 1.65),
ymax = c(10.85, 18.2, 51.26,54.07, 55.65, 68.77, 74.2, 84.11, 85.53, 90.08, 91.73),
ymin = c(0,10.85, 18.2, 51.26, 54.07, 55.65, 68.77, 74.2, 84.11, 85.53,90.08)),
.Names = c("browser", "version", "share", "ymax", "ymin"),
row.names = c(NA, -11L), class = "data.frame")
## data clean
browsers=browsers[order(browsers$browser,browsers$share),]
arr=aggregate(share~browser,browsers,sum)
### choose your cols
mainCol = c('chartreuse3', 'chocolate3','deepskyblue3','gold3','deeppink3')
donuts_plot(browsers$share,rep(1,11),browsers$version,
cols=subcolors(browsers,"browser",mainCol),
legend=F,pilabels = T,borderlit = rep(F,4) )
donuts_plot(arr$share,rep(1,5),arr$browser,
cols=mainCol,pilabels=F,legend=T,legend_offset=-.02,
outradius = .71,radius = .0,innerradius=.0,add=T,
borderlit = rep(F,4) )
###end of line
you can get something similar using the package ggsunburst
# using your data without "ymax" and "ymin"
browsers <- structure(list(browser = structure(c(3L, 3L, 3L, 3L, 2L, 2L,
2L, 1L, 5L, 5L, 4L), .Label = c("Chrome", "Firefox", "MSIE",
"Opera", "Safari"), class = "factor"), version = structure(c(5L,
6L, 7L, 8L, 2L, 3L, 4L, 1L, 10L, 11L, 9L), .Label = c("Chrome 10.0",
"Firefox 3.5", "Firefox 3.6", "Firefox 4.0", "MSIE 6.0", "MSIE 7.0",
"MSIE 8.0", "MSIE 9.0", "Opera 11.x", "Safari 4.0", "Safari 5.0"
), class = "factor"), share = c(10.85, 7.35, 33.06, 2.81, 1.58,
13.12, 5.43, 9.91, 1.42, 4.55, 1.65)), .Names = c("parent", "node", "size")
, row.names = c(NA, -11L), class = "data.frame")
# add column browser to be used for colouring
browsers$browser <- browsers$parent
# write data.frame into csv file
write.table(browsers, file = 'browsers.csv', row.names = F, sep = ",")
# install ggsunburst
if (!require("ggplot2")) install.packages("ggplot2")
if (!require("rPython")) install.packages("rPython")
install.packages("http://genome.crg.es/~didac/ggsunburst/ggsunburst_0.0.9.tar.gz", repos=NULL, type="source")
library(ggsunburst)
# generate data structure
sb <- sunburst_data('browsers.csv', type = 'node_parent', sep = ",", node_attributes = c("browser","size"))
# add name as browser attribute for colouring to internal nodes
sb$rects[!sb$rects$leaf,]$browser <- sb$rects[!sb$rects$leaf,]$name
# plot adding geom_text layer for showing the "size" value
p <- sunburst(sb, rects.fill.aes = "browser", node_labels = T, node_labels.min = 15)
p + geom_text(data = sb$leaf_labels,
aes(x=x, y=0.1, label=paste(size,"%"), angle=angle, hjust=hjust), size = 2)
You can create a pie-donut chart like the one below with only one code line using the PieDonut() function from the webr package.
# loadin the libraries
library(ggplot2)
library(webr)
# replicating the table
browsers<-structure(
list(browser = structure(c(3L, 3L, 3L, 3L, 2L, 2L, 2L, 1L, 5L, 5L, 4L),
.Label = c("Chrome", "Firefox", "MSIE", "Opera", "Safari"), class = "factor"),
version = structure(c(5L, 6L, 7L, 8L, 2L, 3L, 4L, 1L, 10L, 11L, 9L),
.Label = c("Chrome 10.0", "Firefox 3.5", "Firefox 3.6", "Firefox 4.0", "MSIE 6.0", "MSIE 7.0", "MSIE 8.0", "MSIE 9.0", "Opera 11.x", "Safari 4.0", "Safari 5.0"), class = "factor"),
share = c(10.85, 7.35, 33.06, 2.81, 1.58, 13.12, 5.43, 9.91, 1.42, 4.55, 1.65),
ymax = c(10.85, 18.2, 51.26, 54.07, 55.65, 68.77, 74.2, 84.11, 85.53, 90.08, 91.73),
ymin = c(0, 10.85, 18.2, 51.26, 54.07, 55.65, 68.77, 74.2, 84.11, 85.53, 90.08)),
.Names = c("browser", "version", "share", "ymax", "ymin"), row.names = c(NA, -11L), class = "data.frame")
# building the pie-donut chart
PieDonut(browsers, aes(browser, version, count=share),
title = "Browser market share, April, 2011",
ratioByGroup = FALSE)
#rawr's solution is really nice, however, the labels will be overlapped if there are too many. Inspired by #user3969377 and #FlorianGD, I got a new solution using ggplot2 and ggrepel.
1. prepare data
browsers$ymax <- cumsum(browsers$share) # fed to geom_rect() in piedonut()
browsers$ymin <- browsers$ymax - browsers$share # fed to geom_rect() in piedonut()
browsers$share_browser <- sum(browsers$share[browsers$browser == unique(browsers$browser)[1]]) # "_browser" means at browser level
browsers$ymax_browser <- browsers$share_browser[browsers$browser == unique(browsers$browser)[1]][1]
for (z in 2:length(unique(browsers$browser))) {
browsers$share_browser[browsers$browser == unique(browsers$browser)[z]] <- sum(browsers$share[browsers$browser == unique(browsers$browser)[z]])
browsers$ymax_browser[browsers$browser == unique(browsers$browser)[z]] <- browsers$ymax_browser[browsers$browser == unique(browsers$browser)[z-1]][1] + browsers$share_browser[browsers$browser == unique(browsers$browser)[z]][1]
}
browsers$ymin_browser <- browsers$ymax_browser - browsers$share_browser
2. write piedonut function
piedonut <- function(data, cols = c('cyan2','red','orange','green','dodgerblue2'), force = 80, nudge_x = 3, nudge_y = 10) { # force, nudge_x, nudge_y are parameters to fine tune positions of the labels by geom_label_repel.
nr <- nrow(data)
# width <- max(sqrt(data$share)) / 0.1
tbl <- with(data, table(browser)[order(unique(browser))])
cols <- unlist(Map(rep, cols, tbl))
col_subnum <- unlist(Map(rep, 255/tbl,tbl))
col <- rep(NA, nr)
col_browser <- rep(NA, nr)
for (i in 1:nr) {
## create color/shades
rgb <- col2rgb(cols[i])
col[i] <- rgb(rgb[1], rgb[2], rgb[3], col_subnum[i]*sequence(tbl)[i], maxColorValue = 255)
rgb <- col2rgb(cols[i])
col_browser[i] <- rgb(rgb[1], rgb[2], rgb[3], maxColorValue = 255)
}
#col
# set labels positions
x.breaks <- seq(1, 1.8, length.out = nr)
y.breaks <- cumsum(data$share)-data$share/2
ggplot(data) +
geom_rect(aes(ymax = ymax, ymin = ymin, xmax=4, xmin=1), fill=col) +
geom_rect(aes(ymax=ymax_browser, ymin=ymin_browser, xmax=1, xmin=0), fill=col_browser) +
coord_polar(theta = 'y') +
theme(axis.ticks = element_blank(),
axis.title = element_blank(),
axis.text = element_blank(),
panel.grid = element_blank(),
panel.background = element_blank()) +
geom_label_repel(aes(x = x.breaks, y = y.breaks, label = sprintf("%s: %s%%",data$version, data$share)),
force = force,
nudge_x = nudge_x,
nudge_y = nudge_y)
}
3. get the piedonut
cols <- c('cyan2','red','orange','green','dodgerblue2')
pdf('~/Downloads/donuts.pdf', width = 10, height = 10, bg = "snow")
par(omi = c(0.5,0.5,0.75,0.5), mai = c(0.1,0.1,0.1,0.1), las = 1)
print(piedonut(data = browsers, cols = cols, force = 80, nudge_x = 3, nudge_y = 10))
dev.off()
I used floating.pie instead of ggplot2 to create two overlapping pie charts:
library(plotrix)
# browser data without "ymax" and "ymin"
browsers <-
structure(
list(
browser = structure(
c(3L, 3L, 3L, 3L, 2L, 2L,
2L, 1L, 5L, 5L, 4L),
.Label = c("Chrome", "Firefox", "MSIE",
"Opera", "Safari"),
class = "factor"
),
version = structure(
c(5L,
6L, 7L, 8L, 2L, 3L, 4L, 1L, 10L, 11L, 9L),
.Label = c(
"Chrome 10.0",
"Firefox 3.5",
"Firefox 3.6",
"Firefox 4.0",
"MSIE 6.0",
"MSIE 7.0",
"MSIE 8.0",
"MSIE 9.0",
"Opera 11.x",
"Safari 4.0",
"Safari 5.0"
),
class = "factor"
),
share = c(10.85, 7.35, 33.06, 2.81, 1.58,
13.12, 5.43, 9.91, 1.42, 4.55, 1.65)
),
.Names = c("parent", "node", "size")
,
row.names = c(NA,-11L),
class = "data.frame"
)
# aggregate data for the browser pie chart
browser_data <-
aggregate(browsers$share,
by = list(browser = browsers$browser),
FUN = sum)
# order version data by browser so it will line up with browser pie chart
version_data <- browsers[order(browsers$browser), ]
browser_colors <- c('#85EA72', '#3B3B3F', '#71ACE9', '#747AE6', '#F69852')
# adjust these as desired (currently colors all versions the same as browser)
version_colors <-
c(
'#85EA72',
'#3B3B3F',
'#3B3B3F',
'#3B3B3F',
'#71ACE9',
'#71ACE9',
'#71ACE9',
'#71ACE9',
'#747AE6',
'#F69852',
'#F69852'
)
# format labels to display version and % market share
version_labels <- paste(version_data$version, ": ", version_data$share, "%", sep = "")
# coordinates for the center of the chart
center_x <- 0.5
center_y <- 0.5
plot.new()
# draw version pie chart first
version_chart <-
floating.pie(
xpos = center_x,
ypos = center_y,
x = version_data$share,
radius = 0.35,
border = "white",
col = version_colors
)
# add labels for version pie chart
pie.labels(
x = center_x,
y = center_y,
angles = version_chart,
labels = version_labels,
radius = 0.38,
bg = NULL,
cex = 0.8,
font = 2,
col = "gray40"
)
# overlay browser pie chart
browser_chart <-
floating.pie(
xpos = center_x,
ypos = center_y,
x = browser_data$x,
radius = 0.25,
border = "white",
col = browser_colors
)
# add labels for browser pie chart
pie.labels(
x = center_x,
y = center_y,
angles = browser_chart,
labels = browser_data$browser,
radius = 0.125,
bg = NULL,
cex = 0.8,
font = 2,
col = "white"
)
I have created ggpie to better create pie, donut and rose pie plot, you can solve this problem with ggnestedpie!
This is Vignette.
Related
My error bars in my barplot are messed up despite the position dodge, I used the same for a less complicated plot and it worked. I welcome suggestions around it
tgc <- structure(list(Group = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 2L,
2L, 2L, 2L, 2L, 2L), .Label = c("Visible", "Remembered"), class = "factor"),
Condition = structure(c(1L, 1L, 2L, 2L, 3L, 3L, 1L, 1L, 2L,
2L, 3L, 3L), .Label = c("CEN", "IPS", "CTR"), class = "factor"),
test = structure(c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L,
1L, 2L), .Label = c("Pretest", "Posttest"), class = "factor"),
N = c(12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12), EE = c(7.33336873483333,
6.80361546108333, 7.09299323975, 7.85694358425, 7.03401583625,
6.98843623408333, 6.64690423166667, 6.76286593966667, 6.53229116175,
6.597801229, 5.87755052541667, 6.29406939166667), sd = c(1.10209636894719,
0.640166385925573, 0.829194321849813, 0.815786383997366,
1.13990647741682, 0.831699837406531, 0.894188346279884, 0.836594325568601,
0.762116322320573, 0.810426854086389, 0.986911196860133,
0.835898962602035), se = c(0.318147817642284, 0.18480011762014,
0.239367782465249, 0.235497244201055, 0.329062655793799,
0.240091062505814, 0.258129941215459, 0.241503979534773,
0.220004031922795, 0.233950081182639, 0.284896722586727,
0.241303245536807), ci = c(0.700238625346207, 0.406742316465117,
0.526844937010058, 0.518325939729, 0.724262022142493, 0.528436865645932,
0.568140169990552, 0.531546675059109, 0.484225609422399,
0.514920656885223, 0.62705345857213, 0.531104862508461)), row.names = c(NA,
-12L), class = "data.frame")
tgc <- summarySE(data10, measurevar="EE", groupvars=c("Group", "Condition", "test"))
ggplot(tgc, aes(x = Condition, y = EE), fill = test) +
geom_errorbar(aes(ymin=EE-se, ymax=EE+se), position = position_dodge(0.5), width=.1) +
geom_bar(aes(fill = test), stat = "identity", width = 0.5, color = "black", position='dodge') + ylim(0,9) + theme_bw() +
geom_signif(data = data.frame(Condition = c("CEN","IPS", "CTL")),
aes(y_position=c(8.5, 8.5, 8.5, 8.5, 8.5, 8.5), xmin=c(0.8, 1.8, 2.8, 0.8, 1.8, 2.8), xmax=c(1.2, 2.2, 3.2, 1.2, 2.2,3.2),
annotations=c("**", "*", "NS", "*", "**", "NS")), tip_length=0, manual = T) +
scale_fill_manual(values = c("grey80", "grey20")) +
facet_grid(~ Group, scales = "free")
You need to let ggplot know which variable to use as the grouping variable on which to apply the dodge (in your case this would be test). Also, you should draw the error bars after the actual bars so that the lower portion remains visible:
ggplot(tgc, aes(x = Condition, y = EE, fill = test)) +
geom_bar(stat = "identity", width = 0.5, color = "black", position='dodge') +
geom_errorbar(aes(ymin = EE - se, ymax = EE + se, group = test),
position = position_dodge(width = 0.5), width = 0.25) +
geom_signif(data = data.frame(Condition = c("CEN","IPS", "CTL"),
ypos = c(8.5, 8.5, 8.5, 8.5, 8.5, 8.5),
xmin = c(0.8, 1.8, 2.8, 0.8, 1.8, 2.8),
xmax = c(1.2, 2.2, 3.2, 1.2, 2.2,3.2),
annot = c("**", "*", "NS", "*", "**", "NS")),
mapping = aes(y_position = ypos,
xmin = xmin,
xmax = xmax,
annotations = annot),
tip_length = 0, manual = TRUE, inherit.aes = FALSE)
scale_fill_manual(values = c("grey80", "grey20")) +
facet_grid(~ Group, scales = "free") +
ylim(0, 9) +
theme_bw()
after following Stefan's very helpful answer to this post, where he uses ggnewscale::new_scale(), I now am stuck with the following question:
"How to arrange the custom legends from ggnewscale into multiple vertical columns?"
like it is usually done with a command such as guides(scale_shape_manual=guide_legend(ncol=2)) in ggplot2.
Minimal reproducible example:
# fictional data in the scheme of https://stackoverflow.com/q/66804487/16642045
mutated <- list()
for(i in 1:10) {
mutated[[i]] <- data.frame(Biological.Replicate = rep(1,4),
Reagent.Conc = c(10000, 2500, 625, 156.3),
Reagent = rep(1,8),
Cell.type = rep(LETTERS[i],4),
Mean.Viable.Cells.1 = rep(runif(n = 10, min = 0, max = 1),4))
}
mutated <- do.call(rbind.data.frame, mutated)
The modified code after the answer of user "stefan" looks like this:
# from https://stackoverflow.com/a/66808609/16642045
library(ggplot2)
library(ggnewscale)
library(dplyr)
library(magrittr)
mutated <- mutated %>%
mutate(Cell.type = as.factor(Cell.type),
Reagent = factor(Reagent,
levels = c("0", "1", "2")))
mean_mutated <- mutated %>%
group_by(Reagent, Reagent.Conc, Cell.type) %>%
split(.$Cell.type)
layer_geom_scale <- function(Cell.type) {
list(geom_point(mean_mutated[[Cell.type]], mapping = aes(shape = Reagent)),
geom_line(mean_mutated[[Cell.type]], mapping = aes(group = Reagent, linetype = Reagent)),
scale_linetype_manual(name = Cell.type, values = c("solid", "dashed", "dotted"), drop=FALSE),
scale_shape_manual(name = Cell.type, values = c(15, 16, 4), labels = c("0", "1", "2"), drop=FALSE)
)
}
my_plot <-
ggplot(mapping = aes(
x = as.factor(Reagent.Conc),
y = Mean.Viable.Cells.1)) +
layer_geom_scale(unique(mutated$Cell.type)[1])
for(current_Cell.type_index in 2:length(unique(mutated$Cell.type))) {
my_plot <-
my_plot +
ggnewscale::new_scale("shape") +
ggnewscale::new_scale("linetype") +
layer_geom_scale(unique(mutated$Cell.type)[current_Cell.type_index])
}
my_plot
This results in:
Now, I want the legends to be displayed side-by-side, in two columns, and I tried this (without success):
my_plot +
guides(scale_shape_manual=guide_legend(ncol=2))
EDIT: A picture of the way I want the legends to be arranged
Is there anyone who could help me?
Thanks!
Note: This answer addresses the question before clarification was made at question edit # 4 and beyond.
Horizontal legend
Adding theme(legend.box = "horizontal") will make the legend elements appear side by side.
Multiple columns and ggnewscale
Using guides globally will result in the modification of scales after ggnewscale updates them. In this context, only the variable RKO will be updated:
layer_geom_scale <- function(cell_type, color) {
list(geom_point(mean_mutated[[cell_type]], mapping = aes(shape = Reagent), color = color),
geom_line(mean_mutated[[cell_type]], mapping = aes(group = Reagent, linetype = Reagent), color = color),
scale_linetype_manual(name = cell_type, values = c("solid", "dashed", "dotted"), drop=FALSE),
scale_shape_manual(name = cell_type, values = c(15, 16, 4), labels = c("0", "1", "2"), drop=FALSE)
)
}
my_plot <-
ggplot(mapping = aes(
x = as.factor(Reagent.Conc),
y = Mean.Viable.Cells.1)) +
layer_geom_scale("HCT", "#999999") +
ggnewscale::new_scale("linetype") +
ggnewscale::new_scale("shape") +
layer_geom_scale("RKO", "#E69F00") +
theme(legend.box = "horizontal") +
guides(shape = guide_legend(ncol = 2),
linetype = guide_legend(ncol = 2))
my_plot
To modify the same scales for all variables, the guide should be added inside the scale definitions:
layer_geom_scale <- function(cell_type, color) {
list(geom_point(mean_mutated[[cell_type]], mapping = aes(shape = Reagent), color = color),
geom_line(mean_mutated[[cell_type]], mapping = aes(group = Reagent, linetype = Reagent), color = color),
scale_linetype_manual(name = cell_type, values = c("solid", "dashed", "dotted"), drop=FALSE,
guide = guide_legend(ncol = 2)),
scale_shape_manual(name = cell_type, values = c(15, 16, 4), labels = c("0", "1", "2"), drop=FALSE,
guide = guide_legend(ncol = 2))
)
}
my_plot <-
ggplot(mapping = aes(
x = as.factor(Reagent.Conc),
y = Mean.Viable.Cells.1)) +
layer_geom_scale("HCT", "#999999") +
ggnewscale::new_scale("linetype") +
ggnewscale::new_scale("shape") +
layer_geom_scale("RKO", "#E69F00") +
theme(legend.box = "horizontal")
my_plot
Raw data
# from https://stackoverflow.com/q/66804487/16642045
mutated <- structure(list(
Biological.Replicate = c(1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L),
Reagent.Conc = c(10000, 2500, 625, 156.3,
39.1, 9.8, 2.4, 0.6,
10000, 2500, 625, 156.3,
39.1, 9.8, 2.4, 0.6,
10000, 2500, 625, 156.3,
39.1, 9.8, 2.4, 0.6),
Reagent = c(1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L,
2L, 2L, 2L, 2L,
2L, 2L, 2L, 2L,
0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L),
Cell.type = c("HCT", "HCT", "HCT", "HCT",
"HCT", "HCT", "HCT", "HCT",
"HCT", "HCT", "HCT", "HCT",
"HCT", "HCT", "HCT", "HCT",
"RKO", "RKO", "RKO", "RKO",
"RKO", "RKO", "RKO", "RKO"),
Mean.Viable.Cells.1 = c(1.014923966, 1.022279854, 1.00926559, 0.936979842,
0.935565248, 0.966403395, 1.00007073, 0.978144524,
1.019673384, 0.991595836, 0.977270557, 1.007353643,
1.111928183, 0.963518289, 0.993028364, 1.027409034,
1.055452733, 0.953801253, 0.956577449, 0.792568337,
0.797052961, 0.755623576, 0.838482346, 0.836773918)),
row.names = 9:32,
class = "data.frame")
# from https://stackoverflow.com/a/66808609/16642045
library(ggplot2)
library(ggnewscale)
library(dplyr)
library(magrittr)
mutated <- mutated %>%
mutate(Cell.type = factor(Cell.type,
levels = c("HCT", "RKO")),
Reagent = factor(Reagent,
levels = c("0", "1", "2")))
mean_mutated <- mutated %>%
group_by(Reagent, Reagent.Conc, Cell.type) %>%
split(.$Cell.type)
I'm making a diverging bar plot for some Likert data (along these lines). The client has requested a "mean response" for each group, treating Likert responses as consecutive integers ("Strongly disagree" = 1, "Disagree" = 2, etc.); these means are displayed on top of the bars, in the "neutral" area.
For transparency, I want to add the numeric value of each Likert response to the legend. I could add the number to the label (e.g., "Strongly agree (5)"), but I would prefer to put it on top of the color box (e.g., on top of the blue square for "Strongly agree").
Here's the code that produces the diverging bar plot:
library(dplyr)
library(ggplot2)
library(RColorBrewer)
# The data.
df = structure(list(group = structure(c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L),
.Label = c("Group A", "Group B", "Group C"),
class = "factor"),
response = c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L, 5L, 5L, 5L),
n = c(4, 8, 25, 8, 25, 29, 29, 35, 28, 25, 22, 12, 34, 10, 6),
mean.response = c(3.8, 3, 2.5, 3.8, 3, 2.5, 3.8, 3, 2.5, 3.8, 3, 2.5, 3.8, 3, 2.5),
response.fill = c("#CA0020", "#CA0020", "#CA0020",
"#F4A582", "#F4A582", "#F4A582",
"#F7F7F7", "#F7F7F7", "#F7F7F7",
"#92C5DE", "#92C5DE", "#92C5DE",
"#0571B0", "#0571B0", "#0571B0"),
n.to.plot = c(4, 8, 25, 8, 25, 29, 14.5, 17.5, 14, 25, 22, 12, 34, 10, 6)),
class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
row.names = c(NA, -15L),
groups = structure(list(group = structure(1:3, .Label = c("Group A", "Group B", "Group C"),
class = "factor"),
.rows = list(c(1L, 4L, 7L, 10L, 13L),
c(2L, 5L, 8L, 11L, 14L),
c(3L, 6L, 9L, 12L, 15L))),
row.names = c(NA, -3L),
class = c("tbl_df", "tbl", "data.frame"),
.drop = TRUE))
# Groups, responses, and colors.
n.groups = 3
groups = paste("Group", LETTERS[1:n.groups])
likert.responses = c("Strongly disagree", "Disagree", "Neutral", "Agree", "Strongly agree")
pal = brewer.pal(length(likert.responses), "RdBu")
# Make the plot.
ggplot(data = df, aes(x = group, y = n.to.plot, fill = response.fill)) +
# Start with the "agree" responses.
geom_bar(data = df %>% filter(response >= 3),
stat = "identity") +
# Add the "disagree" responses going the opposite way.
geom_bar(data = df %>%
filter(response <= 3) %>%
mutate(n.to.plot = n.to.plot * -1),
stat = "identity") +
# Add text labels with the mean response for each group.
geom_text(data = df %>%
dplyr::select(group, mean.response) %>%
distinct(),
aes(x = group, y = 0,
label = format(mean.response, nsmall = 1),
fill = NA)) +
# Specify fill colors.
scale_fill_identity("Response", breaks = pal, labels = likert.responses,
guide = "legend") +
# Adjust axis labels.
scale_x_discrete("") +
scale_y_continuous("Number of responses") +
# Swap x and y axes.
coord_flip() +
# Add the prompt text as the title.
ggtitle("I like program XYZ.")
And here's my desired output:
Taking inspiration from this answer, I tried adding a label aesthetic to the fill legend, but that did nothing:
+ guides(fill = guide_legend(override.aes = list(label = "foo")))
I know I can customize the shape of the legend symbols, but the problem is that I want two things: a square with the color, and a black digit superimposed on the square.
Update: custom annotation
#M-- suggests using annotation_custom, as described here. To do that, I'll need to figure out where the color boxes in the legend are. That's where I'm stuck; I can find the grobs for these boxes, but I can't figure out how to put text on top of them.
Grob for one of the color boxes (after saving the plot above as g; with guidance from this answer):
gt = ggplot_gtable(ggplot_build(g))
gb = which(gt$layout$name == "guide-box")
box.grob = gt$grobs[[gb]]$grobs[[1]]$grobs[[3]]
box.grob$x and box.grob$y are both 0.5npc; I tried adding a label with geom_text_npc, but the label is right in the middle of the plot. Clearly, I haven't correctly identified the location of the color box (or I'm not translating it to plotting coordinates correctly).
library(ggpmisc)
g + geom_text_npc(aes(npcx = 0.5, npcy = 0.5, label = "foo"))
Thinking a little out of the box here, you can avoid the custom_annotation and using your idea of adding the number to the label like this:
likert.responses = c("1 Strongly disagree", "2 Disagree", "3 Neutral", "4 Agree", "5 Strongly agree")
and playing with the left margin of the legend label element_text a little:
guides(
fill = guide_legend(label.theme = element_text(margin = margin(l = -18, unit = 'pt')))
)
This achieves what you want and have the advantage of scaling well when the plot changes sizes as we are using pt units.
Complete reproducible solution:
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(ggplot2)
library(RColorBrewer)
# The data.
df = structure(list(group = structure(c(1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L),
.Label = c("Group A", "Group B", "Group C"),
class = "factor"),
response = c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 4L, 4L, 4L, 5L, 5L, 5L),
n = c(4, 8, 25, 8, 25, 29, 29, 35, 28, 25, 22, 12, 34, 10, 6),
mean.response = c(3.8, 3, 2.5, 3.8, 3, 2.5, 3.8, 3, 2.5, 3.8, 3, 2.5, 3.8, 3, 2.5),
response.fill = c("#CA0020", "#CA0020", "#CA0020",
"#F4A582", "#F4A582", "#F4A582",
"#F7F7F7", "#F7F7F7", "#F7F7F7",
"#92C5DE", "#92C5DE", "#92C5DE",
"#0571B0", "#0571B0", "#0571B0"),
n.to.plot = c(4, 8, 25, 8, 25, 29, 14.5, 17.5, 14, 25, 22, 12, 34, 10, 6)),
class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
row.names = c(NA, -15L),
groups = structure(list(group = structure(1:3, .Label = c("Group A", "Group B", "Group C"),
class = "factor"),
.rows = list(c(1L, 4L, 7L, 10L, 13L),
c(2L, 5L, 8L, 11L, 14L),
c(3L, 6L, 9L, 12L, 15L))),
row.names = c(NA, -3L),
class = c("tbl_df", "tbl", "data.frame"),
.drop = TRUE))
# Groups, responses, and colors.
n.groups = 3
groups = paste("Group", LETTERS[1:n.groups])
likert.responses = c("1 Strongly disagree", "2 Disagree", "3 Neutral", "4 Agree", "5 Strongly agree")
pal = brewer.pal(length(likert.responses), "RdBu")
# Make the plot.
ggplot(data = df, aes(x = group, y = n.to.plot, fill = response.fill)) +
# Start with the "agree" responses.
geom_bar(data = df %>% filter(response >= 3),
stat = "identity") +
# Add the "disagree" responses going the opposite way.
geom_bar(data = df %>%
filter(response <= 3) %>%
mutate(n.to.plot = n.to.plot * -1),
stat = "identity") +
# Add text labels with the mean response for each group.
geom_text(data = df %>%
dplyr::select(group, mean.response) %>%
distinct(),
aes(x = group, y = 0,
label = format(mean.response, nsmall = 1),
fill = NA)) +
# Specify fill colors.
scale_fill_identity("Response", breaks = pal, labels = likert.responses,
guide = "legend") +
# Adjust axis labels.
scale_x_discrete("") +
scale_y_continuous("Number of responses") +
# Swap x and y axes.
coord_flip() +
# Add the prompt text as the title.
ggtitle("I like program XYZ.") -> test
#> Warning: Ignoring unknown aesthetics: fill
test + guides(
fill = guide_legend(label.theme = element_text(margin = margin(l = -18, unit = 'pt')))
)
Created on 2019-12-07 by the reprex package (v0.3.0)
I am plotting a three series graph for the data
> dput(test)
structure(list(Industry = structure(c(2L, 3L, 1L, 4L, 2L, 3L,
1L, 4L, 2L, 3L, 1L, 4L), .Label = c("Overall", "High Tech", "Other Non-Manufacturing",
"Services (Non-Financial)"), class = "factor"), variable = structure(c(1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L), .Label = c("2018 % (Actual)",
"2019 % (Actual/Budgeted)", "2020 % (Forecast)"), class = "factor"),
value = c(3.8, 3.7, 3.9, 3.4, 3.8, 3.7, 3.8, 3.9, 3.5, 3.3,
3.7, 3.8)), row.names = c(3L, 7L, 8L, 10L, 14L, 18L, 19L,
21L, 25L, 29L, 30L, 32L), class = "data.frame")
The three series are: 2018 % (Actual), 2019 % (Actual/Budgeted), 2020 % (Forecast)
The problem is I want the legend in the same sequence but the graph is showing the legend sequence as: 2020 % (Forecast),2018 % (Actual), 2019 % (Actual/Budgeted)
ggplot(subset(test,variable!="2020 % (Forecast)")) +
aes(x=Industry,y=value,fill=factor(variable, levels = c("2018 % (Actual)","2019 % (Actual/Budgeted)"))) +
geom_bar(,width = 0.9,stat="identity",position = position_dodge2(width=NULL,preserve = "single"))+
scale_fill_manual(values = c("#006D9E","#00A8C8","#FDFEFE"))+
geom_text(aes(label=paste0(value, "%")), colour="black", size=3,
position=position_dodge(width = 0.9), vjust=0.2,angle=90, hjust=2) +
geom_point(data=subset(test,variable=="2020 % (Forecast)"),aes(x=Industry,y=value,colour=variable),
position = position_dodge(0.5),show.legend = F)+
geom_line(data=subset(test,variable=="2020 % (Forecast)"),aes(x=Industry,y=value,colour=variable,group=1),position = position_dodge(1)) +
geom_text(data=subset(test,variable=="2020 % (Forecast)"), aes(x=Industry,y=value,label=paste0(value, "%")),size=3,
position=position_dodge(width =1), vjust= -0.25)+
labs(x=NULL, y=NULL)+
theme(axis.text.x = element_text(face="bold",color = "#626366",size = 10,angle=90, vjust=0.6))+
scale_y_continuous(expand = c(0,0),labels = number_format(suffix = "%"),
limits=c(0,max(test$value, na.rm = TRUE)+
max(test$value, na.rm = TRUE)/5))+
scale_x_discrete(limits=levels(test$Industry),labels = function(x) str_wrap(x, width = 5))
Is there any way in ggplot to change the sequence of legends?
You can use guides(). First we start with your plot:
library(tidyverse)
p = ggplot(subset(test,variable!="2020 % (Forecast)")) +
aes(x=Industry,y=value,fill=factor(variable, levels = c("2018 % (Actual)","2019 % (Actual/Budgeted)"))) +
geom_bar(,width = 0.9,stat="identity",position = position_dodge2(width=NULL,preserve = "single"))+
scale_fill_manual(values = c("#006D9E","#00A8C8","#FDFEFE"))+
geom_text(aes(label=paste0(value, "%")), colour="black", size=3,
position=position_dodge(width = 0.9), vjust=0.2,angle=90, hjust=2) +
geom_point(data=subset(test,variable=="2020 % (Forecast)"),aes(x=Industry,y=value,colour=variable),
position = position_dodge(0.5),show.legend = F)+
geom_line(data=subset(test,variable=="2020 % (Forecast)"),aes(x=Industry,y=value,colour=variable,group=1),position = position_dodge(1)) +
geom_text(data=subset(test,variable=="2020 % (Forecast)"), aes(x=Industry,y=value,label=paste0(value, "%")),size=3,
position=position_dodge(width =1), vjust= -0.25)+
labs(x=NULL, y=NULL)+
theme(axis.text.x = element_text(face="bold",color = "#626366",size = 10,angle=90, vjust=0.6))+
scale_y_continuous(expand = c(0,0),labels = number_format(suffix = "%"),
limits=c(0,max(test$value, na.rm = TRUE)+
max(test$value, na.rm = TRUE)/5))+
scale_x_discrete(limits=levels(test$Industry),labels = function(x) str_wrap(x, width = 5))
Now we specify guides, your line is a color legend and your bars have a fill, and you just specify the title and order insider guide_legend():
p + guides(color=guide_legend(title="Forecast",order = 2),fill=guide_legend(title="Actual",order = 1))
Gives you:
The following code modified from an earlier post produces a plot window containing a pie-chart. I would like to be able to place multiple pie charts in the window, but am having trouble with placement. Successive calls to the pie chart function do not populate the plot in the order I expect (two pie charts are placed in opposite corners of the plot, and then further calls do not add any more pie charts, even though there is space). Is there any way to correct this? I eventually need 6 pie charts (3 rows and 2 columns).
rm(list = ls(all = TRUE))
# DATA
mydf <- structure(list(inner_category = structure(c(3L, 3L, 3L, 3L, 2L, 2L,
2L, 1L, 5L, 5L, 4L), .Label = c("group1", "group2", "group3",
"group4", "group5"), class = "factor"), outer_category = structure(c(5L,
6L, 7L, 8L, 2L, 3L, 4L, 1L, 10L, 11L, 9L), .Label = c("group1_A",
"group1_B", "group1_C", "group1_D", "group2_A", "group2_B",
"group2_C", "group2_D", "group3_A", "group4_A", "group4_B"),
class = "factor"), share = c(10.85, 7.35, 33.06, 2.81, 1.58,
13.12, 5.43, 9.91, 1.42, 4.55, 1.65)), .Names = c("inner_category", "outer_category", "share"),
row.names = c(NA, -11L), class = "data.frame")
mydf$total <- with(mydf1, ave(share, inner_category, FUN = sum))
# PLOTTING WINDOW
quartz("Quartz", width=9, height=8, pointsize=18)
par(mfrow=c(3,2), mar=c(4,4,2,0.5), mgp = c(1.5, 0.3, 0), tck = -0.01)
#FUNCTION
donutplotfunction <- function(myfile, width = 15, height = 11) {
## HOUSEKEEPING
if (missing(myfile)) file <- getwd()
op <- par(no.readonly = TRUE); on.exit(par(op))
nr <- nrow(myfile)
width <- max(sqrt(myfile$share)) / 0.8
tbl <- with(myfile, table(inner_category)[order(unique(inner_category))])
cols <- c('cyan2','red','orange','green','dodgerblue2')
cols <- unlist(Map(rep, cols, tbl))
## LOOP TO CREATE PIE SLICES
par(omi = c(0.5,0.5,0.75,0.5), mai = c(0.1,0.1,0.1,0.1), las = 1)
for (i in 1:nr) {
par(new = TRUE)
## CREATE COLORS AND SHADES
rgb <- col2rgb(cols[i])
f0 <- rep(NA, nr)
f0[i] <- rgb(rgb[1], rgb[2], rgb[3], 190 / sequence(tbl)[i], maxColorValue = 255)
## CREATE LABELS FOR THE OUTERMOST SECTION
lab <- with(myfile, sprintf('%s: %s', outer_category, share))
if (with(myfile, share[i] == max(share))) {
lab0 <- lab
} else lab0 <- NA
## PLOT THE OUTSIDE PIE AND SHADES OF SUBGROUPS
par(lwd = 0.1)
pie(myfile$share, border = "white", radius = 5 / width, col = f0, labels = lab0, cex = 0.7, ticks = 0)
## REPEAT ABOVE FOR THE MAIN GROUPS
par(new = TRUE)
rgb <- col2rgb(cols[i])
f0[i] <- rgb(rgb[1], rgb[2], rgb[3], maxColorValue = 255)
par(lwd = 0.1)
pie(myfile$share, border = "white", radius = 4 / width, col = f0, labels = NA)
}
## GRAPH TITLE
text(x = c(-.05, -.05, 0.15, .25, .3), y = c(.08, -.12, -.15, -.08, -.02), labels = unique(myfile$inner_category), col = 'black', cex = 0.8)
mtext('Figure Main Title', side = 3, line = -1, adj = 0, cex = 1, outer = TRUE)
}
donutplotfunction(mydf)
First, a couple of tips. (1) It is easier for people to help if you post a minimal example. Your code has a lot of details that aren't relevant to the problem--try to eliminate such code. (2) Since rgb is a function name, try to avoid using rgb for a variable name. (3) You don't need to loop over pie slices--just have R draw all slices at once. (4) You had too many par(new=TRUE) statements.
I think the following code is the essence of what you want.
mydf <- structure(list(inner_category = structure(c(3L, 3L, 3L, 3L, 2L, 2L,
2L, 1L, 5L, 5L, 4L), .Label = c("group1", "group2", "group3",
"group4", "group5"), class = "factor"), outer_category = structure(c(5L,
6L, 7L, 8L, 2L, 3L, 4L, 1L, 10L, 11L, 9L), .Label = c("group1_A",
"group1_B", "group1_C", "group1_D", "group2_A", "group2_B",
"group2_C", "group2_D", "group3_A", "group4_A", "group4_B"),
class = "factor"), share = c(10.85, 7.35, 33.06, 2.81, 1.58,
13.12, 5.43, 9.91, 1.42, 4.55, 1.65)), .Names = c("inner_category", "outer_category", "share"),
row.names = c(NA, -11L), class = "data.frame")
donutplotfunction <- function(myfile, width = 7) {
tbl <- with(myfile, table(inner_category)[order(unique(inner_category))])
cols <- c('cyan2','red','orange','green','dodgerblue2')
cols <- unlist(Map(rep, cols, tbl))
rg <- col2rgb(cols)
col.lt <- rgb(rg[1,], rg[2,], rg[3,], alpha = 190 / sequence(tbl), maxColorValue = 255)
col.dk <- rgb(rg[1,], rg[2,], rg[3,], maxColorValue = 255)
# Outside pie
pie(myfile$share, border = "white", radius = 5 / width, col = col.lt, cex = 0.7)
# Inside pie. Use 'new' to get overplotting
par(new = TRUE)
pie(myfile$share, border = "white", radius = 4 / width, col = col.dk, labels = NA)
}
#windows()
par(mfrow=c(3,2), mar=c(4,4,2,0.5), mgp = c(1.5, 0.3, 0), tck = -0.01)
donutplotfunction(mydf)
donutplotfunction(mydf)
donutplotfunction(mydf) # etc