ggplot2 Torten-und donut-Diagramm auf dem gleichen Grundstück

Edit 2

Meine ursprüngliche Antwort ist wirklich dumm. Hier ist eine viel kürzere version, die meiste Arbeit macht mit einer viel einfacheren Benutzeroberfläche.

#' 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-Beitrag

Euch nicht haben givemedonutsorgivemedeath Funktion? Basis Grafiken sind immer der Weg zu gehen für sehr detaillierte Dinge wie diese. Konnte nicht denken, der eine elegante Weise, um den Verlauf der center kreisbezeichnungen, obwohl.

givemedonutsorgivemedeath('~/desktop/donuts.pdf') 

Gibt mir

Beachten Sie, dass in ?pie sehen Sie

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')

Bearbeiten 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)

InformationsquelleAutor rawr

@rawr ' s Lösung ist wirklich nett, allerdings werden die Beschriftungen überlappt werden, wenn es zu viele sind. Inspiriert von @user3969377 und @FlorianGD, ich habe eine neue Lösung mit ggplot2 und ggrepel.

1. vorbereiten von Daten

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. schreiben piedonut-Funktion

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. Holen Sie sich die 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()

InformationsquelleAutor CcMango

Ich verwendet Sie schweben.pie statt ggplot2 zu erstellen, die zwei überlappende Kreisdiagramme:

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"
)

InformationsquelleAutor LeilaHC