1 ggplotオブジェクト作成

• オブジェクト作成ggplot
• ファイルに保存ggsave

# ライブラリロード
pacman::p_load(ggplot2, gridExtra, dplyr) 

# データと全体設定を持ったggplotオブジェクトを作る 
p <- ggplot(data = iris, mapping = aes(x = Sepal.Length, y = Sepal.Width) )

# レイヤーを重ねる
p_1 <- p + geom_point(stat = "identity", position = "identity")

# 書き方
p_1 <- ggplot(data = iris) + geom_point(data = iris, mapping = aes(x = Sepal.Length, y = Sepal.Width))
p_1 <- ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width)) + geom_point()
p_1 <- qplot(x=Sepal.Length, y=Sepal.Width, data = iris, geom = "point")

# ファイルに保存
# ggsave("sepal.png", p_1, "png", dpi = 100, width = 10, height = 7)

# 描画
print(p_1)

2 外観の変更

# 外観の変更　(テーマ, タイトル) ----
p <- ggplot(data = iris, mapping = aes(x = Sepal.Width, y = Sepal.Length) )

gg_theme <- list(p + theme_bw() + labs(title="theme_bw"),
                 p + theme_gray() + labs(title="theme_gray"),
                 p + theme_linedraw() + labs(title="theme_linedraw"),
                 p + theme_light() + labs(title="theme_light"),
                 p + theme_dark() + labs(title="theme_dark"),
                 p + theme_minimal() + labs(title="theme_minimal"),
                 p + theme_classic() + labs(title="theme_classic"),
                 p + theme_test() + labs(title="theme_test"),
                 p + theme_void() + labs(title="theme_void")
            ) 
 
# ggplotオブジェクトをまとめて描画する ----
do.call(gridExtra::grid.arrange, c(gg_theme, list(ncol=3, nrow=3)))

p <- ggplot(data = iris, mapping = aes(x = Sepal.Width, y = Sepal.Length) )

# base_size
p1 <- p + theme_gray(base_size = 20) +
  labs(subtitle="base_size=20")
  
# base_line_size
p2 <- p + theme_gray(base_size = 10, base_line_size=3) + 
  labs(title="base_line_size=3")
# 日本語フォント
p3 <- p + theme_gray(base_size = 10, base_family = "HiraKakuProN-W3") +
  labs(title= "base_family = 'HiraKakuProN-W3'", x="花弁幅", y="花弁長")

gridExtra::grid.arrange(p1, p2, p3, ncol=3)

p <- ggplot(data = iris, mapping = aes(x = Sepal.Width, y = Sepal.Length) )

pb_1 <- p + theme(panel.background = element_rect(fill = "lightblue")) + labs(title = "element_rect(fill)")
pb_2 <- p + theme(panel.background = element_blank()) + labs(subtitle = "element_blank()")

gridExtra::grid.arrange(pb_1, pb_2, ncol = 2)

gg <- ggplot(iris, aes(Sepal.Length, Petal.Length)) +
    theme_minimal() +
    geom_point() 
 

# グリッド　element_line An integer (0:8), a name (blank, solid, dashed, dotted, dotdash, longdash, twodash),
gr1 <- gg + theme(panel.grid.major.x=element_line(size=0.5, colour="blue", linetype="solid"),
                  panel.grid.minor.x=element_line(size=0.5, colour="blue", linetype="dotdash"), 
                  panel.grid.major.y=element_line(size=0.5, colour="blue", linetype="solid"), 
                  panel.grid.minor.y=element_line(size=0.5, colour="blue", linetype="dotdash")) +
  labs(title = "theme(panel.grid = element_line(size,colour,linetype)")

# グリッド消す
gr2 <- gg + theme(panel.grid.minor = element_blank()) +
  labs(title = "theme(panel.grid = element_blank()")

# まとめて描画
grid.arrange(gr1, gr2, ncol=2)

gg <- ggplot(iris, aes(Sepal.Length, Petal.Length)) +
    theme_bw() + geom_point() 

axt_1 <- gg + theme_bw(base_size = 20) + 
  labs(subtitle = "theme_bw(base_size = 20)")
axt_2 <- gg + theme(text = element_text(size = 20)) + 
  labs(subtitle = "theme(text=element_text(size = 20))")
axt_3 <- gg + theme(axis.text.y = element_text(angle=90, hjust=1, size=20)) +
  labs(subtitle = "theme(axis.text.y=element_text(angle,hjust,size)")
axt_4 <- gg + theme(axis.title = element_text(size = 30, face = "bold")) +
  labs(subtitle = "theme(axis.title = element_text(size=30, face='bold')")

gridExtra::grid.arrange(axt_1, axt_2, axt_3, axt_4, ncol=2)

ax <- tidyr::gather(iris, key="k", value="v", -5) %>%
  ggplot(aes(x = k, y = v)) + geom_boxplot() + theme_bw() 

ax_1 <- ax + 
  scale_x_discrete(limits=c("Petal.Length", "Petal.Width", "Sepal.Length", "Sepal.Width"), 
                   labels = c("PL","PW", "SL","SW")) +
  labs(subtitle = "scale_x_discrete(limits, labels)", x="", y="")
  
ax_2 <- ax + 
  scale_y_continuous(breaks = seq(0.5, 8, 0.5)) + 
  labs(subtitle = "scale_y_continuous(breaks)", x="", y="")

gridExtra::grid.arrange(ax_1, ax_2, ncol=2)

gg <- ggplot(iris, aes(Sepal.Length, Petal.Length)) +
    theme_bw() + geom_point() 

# labs(title, subtitle, caption, tag)
ttl_1 <- gg + labs(title="title", subtitle="subtitle", caption="caption", tag="tag")
ttl_2 <- gg + labs(title="title", subtitle="subtitle", caption="caption", tag="tag") +
  facet_wrap(~Species)

gridExtra::grid.arrange(ttl_1, ttl_2, nrow=2)

gg <- ggplot(iris, aes(Sepal.Length, Petal.Length)) +
    theme_bw() + geom_point() + facet_wrap(~Species)


# ストリップのテキスト変更
fctt_1 <- gg + theme(strip.background = element_rect(fill = "lightblue"),
                    strip.text = element_text(face = "bold.italic", size = 15))　

# ストリップの背景消す
fctt_2 <- gg + theme(strip.background = element_blank(), 
                    strip.text = element_text(size = 15))　


# 描画
gridExtra::grid.arrange(fctt_1, fctt_2, nrow=2)

3 散布図geom_point

• カテゴリに分けるaes(col=x), aes(colour=x),aes(color = x)どれでもいける
• 色を指定するscale_color_manual, scale_fill_manual(geom_histとかの場合)
• 形 aes(shape=Species), scale_shape_manual
• サイズ変更, 透過度geom_point(size=5, alpha=0.3)
• x,y軸変換coord_flip
• 軸範囲指定coord_cartesian(xlim, ylim)
• 回帰直線 geom_smooth, stat_smoothmethodオプション(lm, glm, gam, loess, rlm)

geom_point(mapping = NULL, data = NULL, stat = "identity",
  position = "identity", ..., na.rm = FALSE, show.legend = NA,
  inherit.aes = TRUE)
  

# 散布図 
scp <- ggplot(iris, aes(x=Petal.Width, y=Petal.Length)) +
  geom_point() + theme_bw() 

# カテゴリで分けてplot (色は自動) 
scp_1 <- ggplot(iris, aes(x=Petal.Width, y=Petal.Length, colour = Species)) +
  geom_point() + 
  theme_bw() + 
  labs(title="aes(colour)")

# 色を指定する 
scp_2 <- scp_1 +
  geom_point() +
  scale_color_manual(values = c("#1B9E77", "#D95F02", "#7570B3")) +
  labs(title="scale_color_manual()")

# 形,サイズ変更, 透過度の変更 
scp_3 <- ggplot(iris, aes(x=Petal.Width, y=Petal.Length, colour = Species, shape = Species)) +
  geom_point(size=5, alpha=0.3) + 
  theme_bw() + 
  labs(title="aes(shape = Species)") 

# 形を指定 scale_shape_manual
scp_4 <- ggplot(iris, aes(x=Petal.Width, y=Petal.Length, colour = Species, shape = Species)) +
  geom_point(size=5) + 
  scale_shape_manual(values = c(0:2)) +
  theme_bw() + 
  labs(title="scale_shape_manual()") 

# aesのオプションでサイズ変更(値を反映させる)  
scp_5 <- ggplot(iris, aes(x=Petal.Width, y=Petal.Length, colour = Species)) +
  geom_point(aes(size=Petal.Length), alpha = 0.5) + 
  theme_bw() +
  labs(title="aes(size=Petal.Length)")

# x,y軸変換 
scp_6 <- scp_1 + coord_flip() +
        labs(title="coord_flip()")

# ylim xlim 
scp_7 <- scp_1 + coord_cartesian(xlim = c(1, 2.5), ylim = c(3,7)) +
        labs(title="coord_cartesian(xlim, ylim)")

# 散布図 + 回帰直線 
scp_8 <- scp + 
        geom_point(aes(colour=Species)) + 
        geom_smooth(show.legend = T, method = "glm", 
                    linetype=3, size=0.5, colour="magenta") +
        labs(title="geom_smooth()") 　 

# まとめて描画 
library(gridExtra)
grid.arrange(scp, scp_1, scp_2, scp_3, scp_4, scp_5, scp_6, scp_7, scp_8, ncol=3)

4 項目名を文字列で与える場合aes_string()

ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width, colour=Species)) +
        geom_point()

ggplot(iris, aes_string(x=names(iris)[1], y=names(iris)[2], colour=names(iris)[5])) +
        geom_point()

ggplot(iris, aes_string(x="Sepal.Length", y="Sepal.Width", colour="Species")) +
        geom_point() 

5 グラフにテキスト追加 geom_text

• geom_text labelオプションはaesの中に記述する。またshow.legend=Fにする必要あり
• geom_text(aes(label=lab), vjust=-0.3, size=3.5)
• ggrepel::geom_text_repel

scp_1 <- ggplot(iris, aes(x=Petal.Width, y=Petal.Length, colour = Species)) +
  geom_point() +
  theme_bw()

# geom_textを使う場合
lab <- paste(rep(c("set","ver","vir"), table(iris$Species)), rownames(iris), sep=".")
scpt_1 <- scp_1 + 　
  geom_text(aes(label=lab), show.legend = FALSE) +　
  labs(title="geom_text(aes(label), show.legend=F )") +
  scale_shape_discrete(solid=F) +
  theme_bw()
　
# geom_text_repelを使う場合
library(ggrepel)
scpt_2 <- scp_1 +
  ggrepel::geom_text_repel(label=lab, size=2, 
                           segment.size = 0.1, show.legend = FALSE)+
  labs(title='geom_text_repel(label=v, size="0.1", show.legend = F)' ) +
  theme_bw()

gridExtra::grid.arrange(scpt_1, scpt_2, ncol=2)

6 凡例labs, theme, guides

• レジェンドタイトル変更labs(colour="SP")
• レジェンドの位置または削除theme(legend.position="top") none, left, right, bottom, c(1,3)
• レジェンドサイズ変更　theme(legend.title=element_text(10)), theme(legend.text=element_text(10))
• レジェンドの設定変更guides(colour=guide_legend(override.aes = list(alpha, size)))
• レジェンドを複数列guides(colour = guide_legend(nrow = 1))
• theme(legend.key.size = grid::unit(3.0, “lines”))

scp <- ggplot(iris, aes(x=Petal.Width, y=Petal.Length, colour = Species)) + geom_point() + theme_bw() 


# レジェンドの位置変更 
leg_1 <- scp +
  theme(legend.position = "top") +
  labs(subtitle = "theme(legend.position=\"top\")")

# レジェンドの位置(座標で指定) 
leg_2 <- scp +
  theme(legend.position = c(0.9,0.25),
        legend.background = element_blank()) +
  labs(subtitle = "theme(legend.position = c(0.9,0.25))")

# レジェンドタイトルテキストサイズ 
leg_3 <- scp +
  theme(legend.title = element_text(size=20)) +
  labs(subtitle="theme(legend.title = element_text(size=20)")

# レジェンドテキストサイズ, キーサイズ 
leg_4 <- scp +
  theme(legend.text = element_text(size=15), 
        legend.key.size = unit(1, "lines")) +
  labs(subtitle="theme(legend.text = element_text(size=15)")

# レジェンドタイトルラベル変更
leg_5 <- scp +
  labs(subtitle="labs(title,x,y,colour)", x = "PL", y = "PW", colour = "SP")

# ラベルを消す
leg_6 <- leg_5 +
  labs(subtitle="labs(x=NULL, y = NULL, colour = NULL)", x = NULL, y = NULL, colour = NULL)

# レジェンドのテキスト変更
leg_7 <- scp + 
  scale_color_discrete(labels = c("Set","Ver", "Vir")) +
  labs(subtitle="scale_color_discrete(labels = c('Set','Ver', 'Vir')")

# 凡例を複数列表示
leg_8 <- scp +
  guides(colour = guide_legend(nrow = 2)) +
  labs(subtitle="guides(colour = guide_legend(nrow = 1))")

# 凡例の設定変更  
leg_9 <- ggplot(iris, aes(x=Petal.Width, y=Petal.Length, colour=Species)) +
  geom_point(size=3, alpha=0.3) + 
  theme_bw() +
  guides(colour = guide_legend(override.aes = list(alpha=1, size = 5))) +
  labs(subtitle="guides(colour = guide_legend(override.aes = list(alpha=1, size = 5))))")


grid.arrange(leg_1,leg_2,leg_3,leg_4,leg_5, leg_6, leg_7, leg_8, leg_9, ncol=3)

7 信頼区間stat_ellipse

• stat_ellipse(type, linetype)
• type: “t”, “norm”, “euclid”

scp <- ggplot(iris, aes(x=Petal.Width, y=Petal.Length, colour = Species)) +
        geom_point() + theme_bw()

stelps_1 <- scp +
  stat_ellipse(type = "norm", linetype = 1) +　
  stat_ellipse(type = "t", linetype = 2) +　
  stat_ellipse(type = "euclid", linetype = 3) +　
  labs(title="stat_ellipse(type, linetype)") 

stelps_2 <- mutate(iris, elps = Species=="setosa") %>%
  ggplot(aes(Sepal.Length, Sepal.Width, colour=elps)) +
  geom_point() +
  theme_bw() +
  stat_ellipse(aes(col=elps))

iris_set <- filter(iris, Species=="setosa")

stelps_3 <- ggplot(iris, aes(Sepal.Length, Sepal.Width, colour=Species)) +
  geom_point() +
  theme_bw() + 
  stat_ellipse(data = iris_set, aes(Sepal.Length, Sepal.Width, col=Species), type = "norm", linetype = 1)

gridExtra::grid.arrange(stelps_1, stelps_2, stelps_3, ncol=3)

8 配置

p1 <- ggplot(iris, aes(x=Petal.Length, y=Petal.Width, colour = Species)) +
        geom_point() + theme_bw()
p2 <- ggplot(iris, aes(x=Sepal.Length, y=Sepal.Width, colour = Species)) +
        geom_point() + theme_bw()

#　legendのみのggplotオブジェクトを作る関数
g_legend <- function(ggobj){
  tmp <- ggplot_gtable(ggplot_build(ggobj))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)
}

# レジェンドなしggplotオブジェクト 
no_leg_1 <- p1 + theme(legend.position="none")
no_leg_2 <- p2 + theme(legend.position="none")

# レジェンドのみggplotオブジェクト 
leg <- g_legend(p1)

# サイズを調節して配置 
grid.arrange(arrangeGrob(no_leg_1, no_leg_2, leg, ncol=3, widths=c(3/7, 3/7, 1/7)))

fct1 <- ggplot(iris, aes(x=Petal.Length, y=Petal.Width, colour=Species)) +
          geom_point() +
          facet_grid(Species ~ .) +
          labs(title="facet_grid(Species ~ .)")
        
fct2 <- ggplot(iris, aes(x=Petal.Length, y=Petal.Width, colour=Species)) +
          geom_point() +
          facet_grid(. ~ Species) +
          labs(title="facet_grid(. ~ Species)")
        
fct3 <- ggplot(iris, aes(x=Petal.Length, y=Petal.Width, colour=Species)) +
          geom_point() +
          facet_wrap(~Species, ncol=3) +
          labs(title="facet_wrap(~Species, ncol=2)")  

fct4 <- ggplot(iris, aes(x=Petal.Length, y=Petal.Width, colour=Species)) +
          geom_point() +
          facet_wrap(~Species, scales="free") +
          labs(title="facet_wrap(~Species, scales='free')")  


gridExtra::grid.arrange(fct1, fct2, fct3, fct4, ncol=2)

9 ボックスプロットgeom_boxplot

• position_dodge
• scale_fill_manual

dat <- tidyr::gather(iris, key="k", value="v", -5) 

box1 <- ggplot(dat, aes(x = k, y = v)) + geom_boxplot() + labs(x=NULL,y=NULL)

box2 <- ggplot(dat, aes(x = k, y = v, colour = Species, fill = Species)) + 
  geom_boxplot(alpha = 0.5) +
  labs(title = "aes(colour = Species, fill = Species)")

box3 <- box2 +
  scale_color_manual(values = c(1, 2, 4)) +
  scale_fill_manual(values = c(1, 2, 4)) +
  labs(title ="scale_color_manual() + scale_fill_manual()")
  
box4 <- ggplot(dat, aes(x = k, y = v, colour = Species)) +   
  geom_boxplot(outlier.colour=NA) +
  geom_point(position=position_dodge(width=0.75), alpha=0.3) +
  labs(title ="position = position_dodge")

box5 <- ggplot(dat, aes(x=Species, y=v, colour=Species)) + 
  geom_boxplot(outlier.colour=NA) +
  geom_point(position=position_dodge(width=0.75), aes(group=Species), alpha=0.3) + 
  facet_wrap(~k, ncol=4)

box6 <- ggplot(dat, aes(x=Species, y=v, colour=Species)) + 
  geom_boxplot(aes(fill=Species), alpha=0.5, outlier.colour=NA) +
  geom_dotplot(aes(x=Species, y=v), colour = 1, fill = NA, 
               binwidth=0.1, dotsize=0.5, binaxis="y", stackdir="center") +
  facet_wrap(~k, ncol=4) +
  labs(title = "geom_dogplot()")

gridExtra::grid.arrange(box1, box2, box3, box4, box5, box6, ncol=1)

10 ヒストグラム geom_histogram

• binwidth, bins, position, closed
• x, alpha, colour, fill,linetype, size, weight
• binsはデフォルトで30. binwidthで指定する

geom_histogram(mapping = NULL, data = NULL, stat = "bin",
  position = "stack", ..., binwidth = NULL, bins = NULL, na.rm = FALSE,
  show.legend = NA, inherit.aes = TRUE)
  

h <- ggplot(iris, aes(x=Sepal.Length)) + theme_minimal()

# ヒストグラム 
h1 <- h +
  geom_histogram(fill = 1, bins=30, binwidth = 0.1, alpha = 0.5) +
  labs(title="h1")

# カテゴリごとに分ける, 透過色, breaks 
h2 <- h + 
  aes(fill=Species) + 
  geom_histogram(bins=30, binwidth = 0.1, alpha = 0.5) + 
  labs(title="h2")

# positionの変更("stack"がデフォルト) "identity", "fill", "dodge"  
h3 <- h +
  aes(fill=Species, colour=Species) + 
  geom_histogram(binwidth = 0.2, alpha = 0.5, position="identity") +
  labs(title="position = 'identity'")

h4 <- h + 
  aes(fill=Species, colour=Species) + 
  geom_histogram(binwidth = 0.2, alpha = 0.5, position="fill") +
  labs(title="position = 'fill'")

h5 <- h + 
  aes(fill=Species, colour=Species) + 
  geom_histogram(binwidth = 0.2, alpha = 0.5, position="dodge") +
  labs(title="position = 'dodge'")

# facetオプション 
# grid表示
h6 <- h + 
  geom_histogram(binwidth=0.2, alpha = 0.5, position="identity") + 
  facet_grid(Species ~ .) +
  labs(title="facet_grid(Species ~ .)")

# grid表示 
h7 <- h + 
  geom_histogram(binwidth=0.2, alpha =0.5, position="identity") +
  facet_grid(. ~ Species) +
  labs(title="facet_grid(. ~ Species)")

# facet_wrap
h8 <- h + 
  geom_histogram(binwidth=0.2, alpha =0.5, position="identity") + 
  facet_wrap(~Species, ncol=1) +
  labs(title="facet_wrap(~Species, ncol=1)")
         
# plot 
gridExtra::grid.arrange(h1, h2, h3, h4, h5, h6, h7, h8,  ncol=3)

11 ドットプロットgeom_dotplot

• binwidth
• binposition
• binaxis

geom_dotplot(mapping = NULL, data = NULL, position = "identity", ...,
  binwidth = NULL, binaxis = "x", method = "dotdensity",
  binpositions = "bygroup", stackdir = "up", stackratio = 1,
  dotsize = 1, stackgroups = FALSE, origin = NULL, right = TRUE,
  width = 0.9, drop = FALSE, na.rm = FALSE, show.legend = NA,
  inherit.aes = TRUE)
  

# 
dp_1 <- ggplot(iris, aes(x=Species, y=Petal.Length)) +
        geom_dotplot(binwidth = 0.1, binaxis ="y", stackdir = "center") + 
        labs(title="dp_1")

# 
dp_2 <- ggplot(iris, aes(x=Species, y=Petal.Length, fill=Species)) +
        geom_dotplot(binwidth = 0.1, binaxis="y", stackdir="center") +
        labs(title="dp_2")
# 
dp_3 <- ggplot(iris, aes(x=Species, y=Petal.Length, fill=Species, colour=Species)) +
        geom_dotplot(binwidth=0.1,dotsize=0.7, binaxis="y",stackdir="center") +
        labs(title="dp_3")

# geom_dotplot + geom_boxplot  
dp_4 <- dp_3 +
        geom_boxplot(alpha=0.3) + 
        labs(title="dp_4")

grid.arrange(dp_1, dp_2, dp_3, dp_4, ncol=2)

12 折れ線グラフgeom_line

• coord_cartesian(xlim, ylim) 軸範囲指定
• groupを複数因子で指定する場合group=interaction(gp1, gp2)

library(ggrepel)

# lineカラーを変える
lp_1 <- ggplot(Orange, aes(x = age, y = circumference, colour = Tree)) +
  geom_line(size = 1) + 
  theme_bw()
  

# テキストをラインの末端に追加
lp_2 <- lp_1 +
  coord_cartesian(xlim = c(min(Orange$age), max(Orange$age) + 200))+ 
  ggrepel::geom_text_repel(data = subset(Orange, age == max(age)),
                           aes(label = paste("Tree", Tree)), 
                           size = 6, nudge_x = 45, segment.color = NA) +
  theme_bw() +
  theme(legend.position = "none") +
  labs(x = "Age (days)", y = "Circumference (mm)")


# ラインのタイプ・サイズを変える
orange_cl <- Orange %>%
  mutate(gp1 = factor(ifelse(Tree==1 | Tree==3, 1, 
                            ifelse(Tree==2 | Tree==4, 2, 3))),
         gp2 = factor(ifelse(Tree==3 | Tree==4, 2, 1)) )

lp_3 <- ggplot(orange_cl,　aes(x = age, y = circumference, 
                              colour = gp1, group = interaction(Tree, gp1))) + 
  geom_line(aes(linetype = gp2, size = 0.5)) +
  theme_bw() +
  theme(legend.position="none") 
  


gridExtra::grid.arrange(lp_1, lp_2, lp_3, ncol=3)

13 棒グラフgeom_bar

b.p1 <- ggplot(iris, aes(x=Species)) +
        geom_bar()
plot(b.p1)

# データ集計 1
library(dplyr)
d <- iris %>% group_by(Species) %>% summarise_all(funs(sum))
knitr::kable(d, format = "pandoc", caption="種ごとに集計")

# 色分けしない
bar1 <- ggplot(d, aes(x=Species, y=Petal.Length)) +
        geom_bar(stat="identity")

# 色指定
bar2 <- ggplot(d, aes(x=Species, y=Petal.Length)) +
        geom_bar(stat="identity", fill = "red" )

# 棒の色分け
bar3 <- ggplot(d, aes(x=Species, y=Petal.Length, fill=Species)) +
        geom_bar(stat="identity")

# 軸ラベルのrotation
bar4 <- bar3 + theme(axis.text.x = element_text(angle = 45, hjust = 1))

# 水平な棒グラフ
bar5 <- bar3 + coord_flip()

# grid.arrange
gridExtra::grid.arrange(bar1, bar2, bar3, bar4, bar5, ncol=2)

# データ
md <- iris %>% group_by(Species) %>% summarise_all(funs(sum)) %>% 
  tidyr::gather(key = keys, value = values, -Species)
knitr::kable(md, format = "pandoc", caption="gatherを使ってunpivot")

# 縦　facet_grid(key ~ .)
bar6 <- ggplot(md, aes(x=Species, y=values, fill=Species)) +
  geom_bar(stat="identity")+
  facet_grid(keys ~ .) +
  labs(title="bar6  facet_grid(keys ~ .)")

# 横　facet_grid(. ~ keys)
bar7 <- ggplot(md, aes(x=Species, y=values, fill=Species)) +
  geom_bar(stat="identity")+
  facet_grid(. ~ keys) +
  labs(title="bar7  facet_grid(. ~ keys)")

# fill = Species
bar8 <- ggplot(md, aes(x=Species, y=values, fill=Species)) +
  geom_bar(stat="identity") +
  facet_wrap(~keys, ncol=2) +
  labs(title="bar8  facet_wrap(~keys, ncol=2)")

# fill = keys
bar9 <- ggplot(md, aes(x=Species, y=values, fill=keys)) +
  geom_bar(stat="identity") +
  facet_wrap(~keys, ncol=2) +
  labs(title="bar9  facet_wrap(~keys, ncol=2)")


# 積み上げ棒グラフ
## 測定項目でfillup
bar10 <- ggplot(md, aes(x=Species, y=values, fill=keys)) +
  geom_bar(stat="identity") +
  labs(title="bar10")

## 生物種でfillup
bar11 <- ggplot(md, aes(x=keys, y=values, fill=Species)) +
  geom_bar(stat="identity") +
  labs(title="bar11")

# grid.arrange
gridExtra::grid.arrange(bar6, bar7, bar8, bar9, bar10, bar11, ncol=2)

14 ヒートマップgeom_tile

• 数値マトリックスやdata.frameのプロット

15 ggplot2のデフォルトカラーコード

• hcl h:色相、c:彩度、l:輝度を指定するベクトルから色のベクトルを作成
• scale_colour_hueggplot2のデフォルトカラーコード

ggcolor_hue <- function(n, l=65) {
  hues <- seq(15, 375, length=n+1)
  hcl(h=hues, l=l, c=100)[1:n]
}

# plot
par(mfrow=c(2,2))
barplot(rep(1,3), col = ggcolor_hue(n=3), names.arg = ggcolor_hue(n = 3), 
        las=2, border = F, axes = F)
barplot(rep(1,4), col = ggcolor_hue(n = 4), names.arg = ggcolor_hue(n = 4), 
        las = 2, border = F, axes = F)
barplot(rep(1,5), col = ggcolor_hue(n = 5), names.arg = ggcolor_hue(n = 5), 
        las = 2, border = F, axes = F)
barplot(rep(1,6), col = ggcolor_hue(n = 6), names.arg = ggcolor_hue(n = 6), 
        las = 2, border = F, axes = F)

16 GGally

library("GGally")
GGally::ggpairs(iris, aes(colour = Species, alpha = 0.5))

GGally::ggpairs(iris, aes(colour = Species, alpha = 0.5),
    lower=list(continuous = wrap("smooth")),
    diag=list(continuous = wrap("barDiag")), 
    upper=list(wrap=list(corSize=3)), axisLabels='show')

17 環境

sessionInfo()

## R version 3.5.1 (2018-07-02)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS High Sierra 10.13.1
## 
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] ja_JP.UTF-8/ja_JP.UTF-8/ja_JP.UTF-8/C/ja_JP.UTF-8/ja_JP.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] GGally_1.4.0   bindrcpp_0.2.2 ggrepel_0.8.0  dplyr_0.7.8   
## [5] gridExtra_2.3  ggplot2_3.1.0 
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.0         RColorBrewer_1.1-2 highr_0.7         
##  [4] pillar_1.3.1       compiler_3.5.1     plyr_1.8.4        
##  [7] bindr_0.1.1        tools_3.5.1        digest_0.6.18     
## [10] viridisLite_0.3.0  evaluate_0.12      tibble_2.0.0      
## [13] gtable_0.2.0       pkgconfig_2.0.2    rlang_0.3.1       
## [16] yaml_2.2.0         withr_2.1.2        stringr_1.3.1     
## [19] knitr_1.20         rprojroot_1.3-2    grid_3.5.1        
## [22] tidyselect_0.2.5   reshape_0.8.8      glue_1.3.0        
## [25] R6_2.3.0           rmarkdown_1.10     pacman_0.5.0      
## [28] reshape2_1.4.3     purrr_0.2.5        tidyr_0.8.2       
## [31] magrittr_1.5       MASS_7.3-51.1      backports_1.1.2   
## [34] scales_1.0.0       htmltools_0.3.6    assertthat_0.2.0  
## [37] colorspace_1.3-2   labeling_0.3       stringi_1.2.4     
## [40] lazyeval_0.2.1     munsell_0.5.0      crayon_1.3.4