r - scale_fill_manual 基于 ggplot2 中的另一个因素

Question

我正在尝试根据用于在 ggplot2 中“填充”我的 geom_bar 的因素的更广泛分类来对我的图例进行颜色编码。我的情节看起来像这样：我使用这个 R 代码得到的：

ggplot(df, aes(year, TOTALshark, fill=fishery)) + geom_bar(width=.5,stat="identity", position="dodge")+ facet_wrap(~div)

这是我的数据集的 dput 样本：

> dput(smpl)
df <- structure(list(X1 = structure(c(6L, 11L, 22L, 27L, 10L, 10L, 
6L, 11L, 6L, 10L, 8L, 6L, 6L, 4L, 22L, 18L, 10L, 10L, 11L, 6L
), .Label = c("AMERICAN PLAICE", "BIGEYE TUNA", "BIVALVE", "BLUEFIN TUNA", 
"CAPELIN", "COD(ATL)", "CRAB(SNOW,QUEEN)", "HADDOCK", "HAGFISH(ATL)", 
"HALIBUT(ATL)", "HALIBUT(GREENLAND)", "HERRING(ATL)", "JONAH CRAB (CANC.BOR.)", 
"LOBSTER", "LONGHORN SCULPIN", "LUMPFISH", "MACKEREL(ATL)", "MONKFISH", 
"PAND.BOR.", "PAND.MON.", "POLLOCK", "REDFISH", "SCALLOP", "SEA URCHINS", 
"SEACU", "SILVER HAKE", "SWORDFISH", "WHELK", "WHITE HAKE", "WINTER FLOUNDER", 
"WITCH FLOUNDER", "YELLOWFIN TUNA", "YELLOWTAIL FLOUNDER"), class = "factor"), 
    X2 = structure(c(2L, 2L, 8L, 5L, 5L, 5L, 5L, 8L, 5L, 5L, 
    5L, 2L, 5L, 5L, 8L, 2L, 5L, 5L, 2L, 2L), .Label = c("Dredge", 
    "Gillnet", "Hook", "Jigger", "Line", "Seine", "Trap", "Trawlb", 
    "Trawlm"), class = "factor"), fishery = structure(c(12L, 
    25L, 43L, 50L, 24L, 24L, 15L, 27L, 15L, 24L, 21L, 12L, 15L, 
    9L, 43L, 36L, 24L, 24L, 25L, 12L), .Label = c("AMERICAN PLAICE-Gillnet", 
    "AMERICAN PLAICE-Line", "AMERICAN PLAICE-Trawlb", "BIGEYE TUNA-Jigger", 
    "BIGEYE TUNA-Line", "BIVALVE-Dredge", "BLUEFIN TUNA-Hook", 
    "BLUEFIN TUNA-Jigger", "BLUEFIN TUNA-Line", "CAPELIN-Seine", 
    "CAPELIN-Trap", "COD(ATL)-Gillnet", "COD(ATL)-Hook", "COD(ATL)-Jigger", 
    "COD(ATL)-Line", "COD(ATL)-Trap", "COD(ATL)-Trawlb", "CRAB(SNOW,QUEEN)-Trap", 
    "CUSK-Line", "HADDOCK-Gillnet", "HADDOCK-Line", "HADDOCK-Trawlb", 
    "HAGFISH(ATL)-Trap", "HALIBUT(ATL)-Line", "HALIBUT(GREENLAND)-Gillnet", 
    "HALIBUT(GREENLAND)-Line", "HALIBUT(GREENLAND)-Trawlb", "HERRING(ATL)-Seine", 
    "HERRING(ATL)-Trawlm", "JONAH CRAB (CANC.BOR.)-Trap", "LOBSTER-Trap", 
    "LONGHORN SCULPIN-Trawlb", "LUMPFISH-Gillnet", "MACKEREL(ATL)-Seine", 
    "MACKEREL(ATL)-Trawlm", "MONKFISH-Gillnet", "MONKFISH-Trawlb", 
    "PAND.BOR.-Trawlb", "PAND.MON.-Trawlb", "POLLOCK-Gillnet", 
    "POLLOCK-Trawlb", "REDFISH-Gillnet", "REDFISH-Trawlb", "REDFISH-Trawlm", 
    "SCALLOP-Dredge", "SEA URCHINS-Dredge", "SEACU-Dredge", "SILVER HAKE-Trawlb", 
    "SWORDFISH-Jigger", "SWORDFISH-Line", "SWORDFISH-unk", "WHELK-Trap", 
    "WHITE HAKE-Gillnet", "WHITE HAKE-Line", "WINTER FLOUNDER-Gillnet", 
    "WINTER FLOUNDER-Trawlb", "WITCH FLOUNDER-Trawlb", "YELLOWFIN TUNA-Line", 
    "YELLOWTAIL FLOUNDER-Trawlb"), class = "factor"), year = c(2008L, 
    2008L, 2009L, 2009L, 2008L, 2009L, 2009L, 2008L, 2006L, 2007L, 
    2007L, 2007L, 2007L, 2007L, 2008L, 2008L, 2009L, 2009L, 2009L, 
    2009L), div = structure(c(6L, 19L, 2L, 4L, 5L, 10L, 3L, 19L, 
    9L, 10L, 3L, 9L, 6L, 4L, 3L, 9L, 6L, 11L, 7L, 9L), .Label = c("5Z", 
    "5Y", "4X", "4W", "4V", "4T", "4S", "4R", "3P", "3O", "3N", 
    "3M", "3L", "3K", "2J", "2H", "2G", "1F", "0B", "1B", "0A"
    ), class = "factor"), TOTALshark = c(3369.72, 12243.2, 6080.06, 
    316646.05, 18786.8, 6565.91, 1339771.2, 45841.03, 41329.64, 
    6411.86, 204980.36, 67608.78, 2617.05, 61547.64, 447349.44, 
    13226.4, 1362.55, 6012.23, 13152.51, 1067.92), cat = structure(c(1L, 
    1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 
    1L, 1L, 1L, 1L), .Label = c("groundfish", "largepelagic", 
    "bivalve", "smallpelagic", "crabs/lobsters", "shrimps", "others"
    ), class = "factor")), .Names = c("X1", "X2", "fishery", 
"year", "div", "TOTALshark", "cat"), class = "data.frame", row.names = c(70L, 
278L, 500L, 554L, 242L, 245L, 131L, 315L, 106L, 224L, 194L, 60L, 
115L, 37L, 489L, 385L, 249L, 244L, 284L, 75L))

我希望有相同的传说，但根据渔业属于哪个类别的“猫”变量（即远洋、底层鱼）有一些颜色。

Answer 1

这是你想要的吗？

library(ggplot2)
library(plyr)
library(gridExtra)

# create data that links colour per 'cat' with 'fishery'
# the 'cat' colours will be used as manually set fill colours. 

# get 'cat' colours

# alt. 1: grab 'cat' colours from plot object
# create a plot with fill = fishery *and* colour = cat
g1 <- ggplot(df, aes(x = year, y = TOTALshark, fill = fishery, colour = cat)) +
  geom_bar(width = 0.5, stat = "identity", position = "dodge") +
  facet_wrap(~ div)

g1

# grab 'cat' colours for each 'fishery' from plot object
# to be used in manual fill
cat_cols <- unique(ggplot_build(g1)[["data"]][[1]]$colour)

# unique 'cat'
cat <- unique(df$cat)

# create data frame with one colour per 'cat'
df2 <- data.frame(cat = cat, cat_cols)
df2


# alt 2: create your own 'cat' colours
# number of unique 'cat'
n <- length(cats)

# select one colour per 'cat', from e.g. brewer_pal or other palette tools 
cat_cols <- brewer_pal(type = "qual")(n)
# cat_cols <- rainbow(n)

# create data frame with one colour per 'cat'
df2 <- data.frame(cat, cat_cols)
df2

# select unique 'fishery' and 'cat' combinations
# in the order they show up in the legend, i.e. ordered ('arranged') by fishery
df3 <- unique(arrange(df[, c("fishery", "cat")], fishery))
df3

# add 'cat' colours to 'fishery'
# use 'join' to keep order
df3 <- join(df3, df2)
df3

# plot with fill by 'fishery' creates a fill scale by fishery,
# but colours are set manually using scale_fill_manual and the 'cat' colours from above
g2 <- ggplot(df, aes(x = year, y = TOTALshark, fill = fishery)) +
  geom_bar(width = 0.5, stat = "identity", position = "dodge") +
  facet_wrap(~ div, nrow = 5) +
  scale_fill_manual(values = as.character(df3$cat_cols))

g2

# create plot with both 'fishery' and 'cat' legend.

# extract 'fisheries' legend
tmp <- ggplot_gtable(ggplot_build(g2))
leg <- which(sapply(tmp$grobs, function(x) x$name) ==  "guide-box")
legend_fish <- tmp$grobs[[leg]]

# create a non-sense plot just to get a 'fill = cat' legend
g3 <- ggplot(df, aes(x = year, y = TOTALshark, fill = cat)) +
  geom_bar(stat = "identity") +
  scale_fill_manual(values = as.character(df3$cat_cols))

# extract 'cat' legend
tmp <- ggplot_gtable(ggplot_build(g3))
leg <- which(sapply(tmp$grobs, function(x) x$name) ==  "guide-box")
legend_cat <- tmp$grobs[[leg]]


# arrange plot and legends

library(gridExtra)

# quick and dirty with grid.arrange
# in the first column, put the plot (g2) without legend (removed using the 'theme' code)
# put the two legends in the second column
grid.arrange(g2 + theme(legend.position = "none"),
             arrangeGrob(legend_fish, legend_cat), ncol = 2) 


# arrange with viewports
# define plotting regions (viewports)
grid.newpage()
vp_plot <- viewport(x = 0.25, y = 0.5,
                    width = 0.5, height = 1)

vp_legend <- viewport(x = 0.75, y = 0.7,
                      width = 0.5, height = 0.5)

vp_sublegend <- viewport(x = 0.7, y = 0.25,
                         width = 0.5, height = 0.3)


print(g2 + theme(legend.position = "none"), vp = vp_plot)
upViewport(0)

pushViewport(vp_legend)
grid.draw(legend_fish)

upViewport(0)
pushViewport(vp_sublegend)
grid.draw(legend_cat)  

另请参阅@mnel在此处的答案以替换绘图对象中的值。在这里也可能值得尝试。您还可以检查gtable安排 grobs 的方法。