Rで解析：ggplot２に情報を追加！！「ggpp」パッケージ

#パッケージのインストール
install.packages("ggpp")

#パッケージの読み込み
library("ggpp")

#tidyverseパッケージがなければインストール
if(!require("tidyverse", quietly = TRUE)){
  install.packages("tidyverse");require("tidyverse")
}

###データ例の作成#####
set.seed(1234)
n <- 50
TestData <- tibble(Group = factor(sample(paste0("Group", 1:4), n,
                                         replace = TRUE)),
                   X_Data = sample(c(1:50), n, replace = TRUE),
                   Y_Data = sample(c(51:100), n, replace = TRUE))
########


###基本の散布図を作成#####
PointPlot <- ggplot(TestData, aes(x = X_Data, y = Y_Data,
                                  col = Group)) +
  geom_point() +
  scale_color_manual(values = c("red", "#505457",
                                "#4b61ba", "#a87963")) +
  theme_bw()

#確認
PointPlot
########


#プロットにテキストを追加:geom_text_npcコマンド
##普通にgeom_text_npcコマンド
##プロット位置はdata.frame形式で指定します##
#X軸位置;"left","right","center"
#Y軸位置;"bottom","top","middle"
TexiPoint <- tibble(X_Position = c("left", "left", "right", "right", "center"),
                    Y_Position = c("bottom", "top", "bottom", "top", "middle"),
                    text = c("からだに", "いいもの", "KARADA", "GOOD", ".net"))
#プロットに設定
PointPlot + geom_text_npc(data = TexiPoint,
                          aes(npcx = X_Position,
                              npcy = Y_Position,
                              label = text),
                          col = c("red", "blue", "yellow", "green", "black"),
                          size = c(3, 5, 7, 9, 11))

##例えばgeom_text_npcコマンドでfacet_wrapを適応
#ポイントはfacet_wrapのグループ変数を変数名にする
FacetPoint <- tibble(Group = levels(TestData$Group),
                     X_Position = "left",
                     Y_Position = "top",
                     text = c("からだに", "いいもの", "KARADA", "GOOD"))
#プロットに設定
PointPlot + geom_text_npc(data = FacetPoint,
                          aes(npcx = X_Position,
                              npcy = Y_Position,
                              label = text),
                          col = c("red", "blue", "yellow", "green"),
                          size =c(3, 5, 7, 9)) +
  facet_wrap(~Group, scales = "free")
#############


#プロットにテーブルを追加する:geom_tableコマンド
#追加するデータを準備
InsertTable <- tibble(X = 0, Y = 120) %>%
  mutate(Table = TestData %>%
           group_by(Group) %>%
           summarise(X_Data = mean(X_Data), Y_Data = mean(Y_Data)) %>%
           list())
#確認
InsertTable
# A tibble: 1 x 3
#     X     Y Table           
#  <dbl> <dbl> <list>          
#1    0    120 <tibble [4 x 3]>  

#プロットに設定
#デザインを適応:table.themeオプション;
#ttheme_gtdefault,ttheme_gtminimal,ttheme_gtbw,ttheme_gtplain
#ttheme_gtdark,ttheme_gtlight,ttheme_gtsimple,ttheme_gtstripes
PointPlot +
  geom_table(data = InsertTable,
             aes(x = X, y = Y, label = Table),
             table.theme = ttheme_gtstripes,
             color = "red", size = 3,
             angle = 0, vjust = 1)
#############


#プロットに基準線を追加:geom_vhlinesコマンド
#x軸:xinterceptオプション
#y軸:yinterceptオプション
PointPlot +
  geom_vhlines(xintercept = 20, yintercept = 80,
               linetype = "dashed", color = "red")
#############


#プロットにプロットを追加:geom_plotコマンド
#プロットに装飾プロットを追加:annotateコマンド
#プロットに追加するプロットを準備
#散布図を作成
InsertPlot <- tibble(X = 0, Y = 150) %>%
  mutate(Plot = list(TestData %>%
           filter(dplyr::between(X_Data, 30, 50) &
                    dplyr::between(Y_Data, 65, 85)) %>%
           ggplot(aes(x = X_Data, y = Y_Data, col = Group)) +
           geom_point(show.legend = FALSE, size = 2) +
           scale_color_manual(values = c("red", "#505457",
                                         "#4b61ba", "#a87963")) +
           theme_bw()))
#BoxPlotを作成
InsertBoxPlot <- tibble(X = 50, Y = 150) %>%
  mutate(Plot = list(TestData %>%
                       filter(dplyr::between(X_Data, 30, 50) &
                                dplyr::between(Y_Data, 65, 85)) %>%
                       ggplot(aes(x = X_Data, y = Y_Data,
                                  group = Group, fill = Group)) +
                       geom_boxplot(show.legend = FALSE) +
                       scale_color_manual(values = c("red", "#505457",
                                                     "#4b61ba", "#a87963")) +
                       theme_bw()))

#プロットに設定
PointPlot +
  #散布図を追加
  geom_plot(data = InsertPlot, aes(x = X, y = Y, label = Plot)) +
  #BoxPlotを追加
  geom_plot(data = InsertBoxPlot, aes(x = X, y = Y, label = Plot)) +
  #annotateコマンドで枠を追加
  annotate(geom = "rect",
           xmin = 30, xmax = 50, ymin = 65, ymax = 85,
           linetype = "dotted", fill = NA, colour = "red",
           size = 1.5)
#############


#プロットにグループ毎のcentroidを追加:stat_centroidコマンド
PointPlot +
  stat_centroid(shape = "cross", size = 4)
#############

#基準で四分割し出現数を表示:stat_quadrant_countsコマンド
#平均で基準を作成
MeanData <- TestData %>%
  summarise(X_Data = mean(X_Data), Y_Data = mean(Y_Data))

#プロットに設定
#x軸:xinterceptオプション
#y軸:yinterceptオプション
PointPlot +
  stat_quadrant_counts(colour = "red",
                       xintercept = MeanData$X_Data,
                       yintercept = MeanData$Y_Data) +
  geom_vhlines(xintercept = MeanData$X_Data,
               yintercept = MeanData$Y_Data,
               linetype = "dashed", color = "red")
#############

#密度の低い場所から指定した基準でハイライト:stat_dens2d_filterコマンド
#詳細は「?stat_dens2d_filter」
PointPlot +
  stat_dens2d_filter(keep.fraction = 1/2, #keep.number = 50,
                     colour = "black", size = 4, shape = 1)
########