如何在ggplot2中创建Marimekko / Mosaic图

Question

当x和y都是分类变量时，Marimekko / Mosaic图是一个很好的默认图。使用ggplot创建这些内容的最佳方法是什么？

我能找到的唯一参考是这个4yo blog post，但这似乎有点过时了。现在是否有更好或更简单的实施方法可供选择？ GGally包有一个函数ggally_ratio，但这会产生一些完全不同的东西：

Answer 1

我是前一段时间做过的，只使用geom_bar，我把它变成了一个通用函数，所以它应该适用于任何两个factors。

ggMMplot <- function(var1, var2){
  require(ggplot2)
  levVar1 <- length(levels(var1))
  levVar2 <- length(levels(var2))

  jointTable <- prop.table(table(var1, var2))
  plotData <- as.data.frame(jointTable)
  plotData$marginVar1 <- prop.table(table(var1))
  plotData$var2Height <- plotData$Freq / plotData$marginVar1
  plotData$var1Center <- c(0, cumsum(plotData$marginVar1)[1:levVar1 -1]) +
    plotData$marginVar1 / 2

  ggplot(plotData, aes(var1Center, var2Height)) +
    geom_bar(stat = "identity", aes(width = marginVar1, fill = var2), col = "Black") +
    geom_text(aes(label = as.character(var1), x = var1Center, y = 1.05)) 
  }

ggMMplot(diamonds$cut, diamonds$clarity)

Answer 2

一段时间后，我对一个项目有同样的问题。我的解决方案是将geom_bar与scales="free_x", space="free_x"中的facet_grid选项一起使用，以适应不同的条形宽度：

# using diamonds dataset for illustration
df <- diamonds %>%
  group_by(cut, clarity) %>%
  summarise(count = n()) %>%
  mutate(cut.count = sum(count),
         prop = count/sum(count)) %>%
  ungroup()

ggplot(df,
       aes(x = cut, y = prop, width = cut.count, fill = clarity)) +
  geom_bar(stat = "identity", position = "fill", colour = "black") +
  # geom_text(aes(label = scales::percent(prop)), position = position_stack(vjust = 0.5)) + # if labels are desired
  facet_grid(~cut, scales = "free_x", space = "free_x") +
  scale_fill_brewer(palette = "RdYlGn") +
  # theme(panel.spacing.x = unit(0, "npc")) + # if no spacing preferred between bars
  theme_void() 

Answer 3

第一次尝试。我不知道如何将因子标签放在轴上。

makeplot_mosaic <- function(data, x, y, ...){
  xvar <- deparse(substitute(x))
  yvar <- deparse(substitute(y))
  mydata <- data[c(xvar, yvar)];
  mytable <- table(mydata);
  widths <- c(0, cumsum(apply(mytable, 1, sum)));
  heights <- apply(mytable, 1, function(x){c(0, cumsum(x/sum(x)))});

  alldata <- data.frame();
  allnames <- data.frame();
  for(i in 1:nrow(mytable)){
    for(j in 1:ncol(mytable)){
      alldata <- rbind(alldata, c(widths[i], widths[i+1], heights[j, i], heights[j+1, i]));
    }
  }
  colnames(alldata) <- c("xmin", "xmax", "ymin", "ymax")

  alldata[[xvar]] <- rep(dimnames(mytable)[[1]],rep(ncol(mytable), nrow(mytable)));
  alldata[[yvar]] <- rep(dimnames(mytable)[[2]],nrow(mytable));

  ggplot(alldata, aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax)) + 
    geom_rect(color="black", aes_string(fill=yvar)) +
    xlab(paste(xvar, "(count)")) + ylab(paste(yvar, "(proportion)"));
}

示例：

makeplot_mosaic(mtcars, vs, gear)

Answer 4

你可以使用名为＆＃34; ggmosaic＆＃34;的ggplot2扩展包。 （https://github.com/haleyjeppson/ggmosaic）。

这里给出了带有示例代码和可视化结果的详尽教程https://cran.r-project.org/web/packages/ggmosaic/vignettes/ggmosaic.html。

Answer 5

Plotluck是一个基于 ggplot2 的库，旨在根据1-3个变量的特征自动选择绘图类型。它包含马赛克图的功能。例： plotluck(mtcars,vs,gear)

Answer 6

根据user2030503的建议，以下是使用ggmosaic的版本。 （请注意，ggplot 3.0 broke some piece of ggmosaic是最新版本。）

library(tidyverse)
library(ggmosaic)

# Data copied from linked blog post
df <- data.frame(
  segment = LETTERS[1:4],
  segpct = c(40, 30, 20, 10),
  Alpha = c(60, 40, 30, 25), 
  Beta = c(25, 30, 30, 25),
  Gamma = c(10, 20, 20, 25), 
  Delta = c(5, 10, 20, 25)
  )

# Convert to "long" for plotting
df_long <- gather(df, key = "greek_letter", value = "pct", 
                  -c("segment", "segpct")) %>% 
  mutate(
    greek_letter = factor(
      greek_letter, 
      levels = c("Alpha", "Beta", "Gamma", "Delta")
      ),
    weight = (segpct * pct) / 10000
    )

# Plot
ggplot(df_long) +
  geom_mosaic(aes(x = product(greek_letter, segment), fill = greek_letter,
                  weight = weight))

Answer 7

感谢所有创建此条目的人，这些条目确实对我有所帮助，因为ggmosaic不能满足我的要求（并且无法正确标记轴）。 Z.Lin的好函数在https://github.com/tidyverse/ggplot2/issues/3142中引发了警告类型的解释，该警告似乎表示警告在内容上在技术上是不真实的，实际上是在警告我们，ggplotocracy祝福他们并感谢他们，感觉到geom_bar不应真正具有可变的宽度。我想我明白了这一点，所以我选择了杰克·费舍尔（Jake Fisher）的功能，并根据自己的需要进行了调整。如果它对其他人有用，那就在这里：

makeplot_mosaic2 <- function(data, x, y, statDigits = 1, residDigits = 1, pDigits = 3, ...){
  ### from https://stackoverflow.com/questions/19233365/how-to-create-a-marimekko-mosaic-plot-in-ggplot2,
  ### this from Jake Fisher (I think)
  xvar <- deparse(substitute(x))
  yvar <- deparse(substitute(y))
  mydata <- data[c(xvar, yvar)]
  mytable <- table(mydata)
  
  widths <- c(0, cumsum(apply(mytable, 1, sum)))
  heights <- apply(mytable, 1, function(x){c(0, cumsum(x/sum(x)))})
  
  alldata <- data.frame()
  allnames <- data.frame()
  for(i in 1:nrow(mytable)){
    for(j in 1:ncol(mytable)){
      alldata <- rbind(alldata, c(widths[i], widths[i+1], heights[j, i], heights[j+1, i]))
    }
  }
  colnames(alldata) <- c("xmin", "xmax", "ymin", "ymax")
  
  alldata[[xvar]] <- rep(dimnames(mytable)[[1]],rep(ncol(mytable), nrow(mytable)))
  alldata[[yvar]] <- rep(dimnames(mytable)[[2]],nrow(mytable))
  
  chisq <- chisq.test(mytable)
  df <- chisq$parameter
  pval <- chisq$p.value
  chisqval <- chisq$statistic
  # stdResids <- chisq$stdres
  alldata$xcent <- (alldata$xmin + alldata$xmax)/2
  alldata$ycent <- (alldata$ymin + alldata$ymax)/2
  alldata$stdres <- round(as.vector(t(chisq$stdres)), residDigits)
  # print(chisq$stdres)
  # print(alldata)
  
  titleTxt1 <- paste0("Mosaic plot of ",
                      yvar,
                      " against ",
                      xvar,
                      ", ")
  titleTxt2 <- paste0("chisq(",
                     df,
                     ") = ",
                     round(chisqval, statDigits),
                     ", p = ",
                     format.pval(pval, digits = pDigits))
  titleTxt <- paste0(titleTxt1, titleTxt2)
  subTitleTxt <- "Cell labels are standardised residuals"
  
  ggplot(data  = alldata, 
         aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax)) + 
    geom_rect(color="black", aes_string(fill=yvar)) +
    geom_text(aes(x = xcent, y = ycent, label = stdres)) +
    xlab(paste0("Count of '", 
                xvar,
                "', total = ",
                max(alldata$xmax))) + # tweaked by CE
    ylab(paste0("Proportion of '", 
                yvar,
                "' per level of '",
                xvar,
                "'")) +
    ggtitle(titleTxt,
            subtitle = subTitleTxt) +
    theme_bw() +
    theme(plot.title = element_text(hjust = .5),
          plot.subtitle = element_text(hjust = .5))
}

makeplot_mosaic2(mtcars, vs, gear)
makeplot_mosaic2(diamonds, cut, clarity)