4

ggplot2 で geom_bar を「塗りつぶす」ために使用される要因のより広い分類に基づいて、凡例を色分けしようとしています。私のプロットは次のようここに画像の説明を入力になります: この R コードを使用して取得しました:

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

これが私のデータセットの出力サンプルです:

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

私は同じ凡例を持ちたいと思っていますが、漁業がどのカテゴリの「猫」変数 (つまり、遠洋魚、底魚) に基づいているかに基づいていくつかの色を付けたいと考えています。

4

1 に答える 1

3

これは、あなたの望むことですか?

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 の回答も参照してくださいここも試してみる価値はありそうです。gtableGrob の配置方法も確認できます。

于 2013-09-29T14:18:14.977 に答える