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