scale_fill_manual based on another factor in ggplot2

问题

I am trying to color-code my legend based on a broader categorization of the factor used to "fill" my geom_bar in ggplot2. My plot looks like this:

which I got using this R code:

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

Here is a dput sample of my dataset:

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

I wish to have the same legend, but with a few colors based on which category "cat" variable (i.e.,, pelagic, groundfish) the fishery falls in.

回答1:

Is this what you want?

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)

See also @mnel's answer here for replacing values in the plot object. It might be worth trying here as well. You may also check gtable methods for arranging grobs.

来源：https://stackoverflow.com/questions/19068040/scale-fill-manual-based-on-another-factor-in-ggplot2

标签

ggplot2

legend