R中的多绘图饼图

Question

以前的文章中修改的代码会生成一个包含饼图的绘图窗口。我希望能够在窗口中放置多个饼图，但是在放置时遇到问题。连续调用饼图函数不会按照我预期的顺序填充图（两个饼图放置在图的对角，然后进一步调用不会再添加饼图，即使有空间）。有什么方法可以纠正这个问题吗？我最终需要6个饼图（3行2列）。

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) 

Answer 1

首先，一些技巧。 （1）如果您发布minimal example，那么人们可以更容易地提供帮助。你的代码有很多与问题无关的细节 - 尽量消除这些代码。 （2）由于rgb是一个函数名，所以尽量避免使用rgb作为变量名。 （3）你不需要遍历饼图切片 - 只需要R一次画出所有切片。 （4）你有太多的par(new=TRUE)陈述。

我认为下面的代码是你想要的东西的本质。

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