第13章: 高度なggplot2

カスタム可視化とインタラクティブグラフィック

🎨 カスタムテーマ 🔧 高度なgeom 📊 複合グラフ

🎨 カスタムテーマとスタイリング

ggplot2の真の力は、完全にカスタマイズ可能なテーマシステムにあります。プロフェッショナルな視覚効果を作成する高度なテクニックを学びます。

企業ブランド対応のカスタムテーマ作成

プロフェッショナルなカスタムテーマ

library(ggplot2)
library(dplyr)
library(scales)
library(extrafont)

# 企業ブランドカラーパレット
brand_colors <- c(
  primary = "#1e3a8a",     # ディープブルー
  secondary = "#3b82f6",   # ブライトブルー
  accent = "#f59e0b",      # オレンジ
  success = "#10b981",     # グリーン
  warning = "#ef4444",     # レッド
  neutral = "#6b7280",     # グレー
  background = "#f8fafc",  # ライトグレー
  text = "#1f2937"         # ダークグレー
)

# カスタムテーマ関数の作成
theme_corporate <- function(
  base_size = 11,
  base_family = "Arial",
  grid = TRUE,
  axis_lines = TRUE
) {
  theme_minimal(base_size = base_size, base_family = base_family) +
    theme(
      # 全体背景
      plot.background = element_rect(fill = brand_colors["background"], color = NA),
      panel.background = element_rect(fill = "white", color = NA),
      
      # テキスト
      text = element_text(color = brand_colors["text"], family = base_family),
      plot.title = element_text(
        size = base_size * 1.4,
        face = "bold",
        color = brand_colors["primary"],
        margin = margin(b = 20)
      ),
      plot.subtitle = element_text(
        size = base_size * 1.1,
        color = brand_colors["neutral"],
        margin = margin(b = 20)
      ),
      plot.caption = element_text(
        size = base_size * 0.8,
        color = brand_colors["neutral"],
        hjust = 1,
        margin = margin(t = 15)
      ),
      
      # 軸
      axis.title = element_text(
        size = base_size * 0.9,
        color = brand_colors["text"],
        face = "bold"
      ),
      axis.text = element_text(
        size = base_size * 0.8,
        color = brand_colors["neutral"]
      ),
      axis.line = if (axis_lines) element_line(color = brand_colors["neutral"], size = 0.5) else element_blank(),
      axis.ticks = element_line(color = brand_colors["neutral"], size = 0.5),
      
      # グリッド
      panel.grid.major = if (grid) element_line(color = "#e5e7eb", size = 0.5) else element_blank(),
      panel.grid.minor = element_blank(),
      
      # 凡例
      legend.position = "bottom",
      legend.background = element_rect(fill = "white", color = NA),
      legend.key = element_rect(fill = "white", color = NA),
      legend.title = element_text(
        size = base_size * 0.9,
        face = "bold",
        color = brand_colors["text"]
      ),
      
      # ストリップ（ファセット）
      strip.background = element_rect(
        fill = brand_colors["primary"],
        color = NA
      ),
      strip.text = element_text(
        color = "white",
        face = "bold",
        size = base_size * 0.9
      ),
      
      # マージン
      plot.margin = margin(20, 20, 20, 20)
    )
}

# カスタムカラースケール
scale_fill_corporate <- function(...) {
  scale_fill_manual(
    values = c(brand_colors["primary"], brand_colors["secondary"], 
                brand_colors["accent"], brand_colors["success"], brand_colors["warning"]),
    ...
  )
}

scale_color_corporate <- function(...) {
  scale_color_manual(
    values = c(brand_colors["primary"], brand_colors["secondary"], 
                 brand_colors["accent"], brand_colors["success"], brand_colors["warning"]),
    ...
  )
}

# テストデータの作成
set.seed(123)
business_data <- tibble(
  quarter = rep(paste0("Q", 1:4), each = 5),
  department = rep(c("営業", "マーケティング", "開発", "サポート", "管理"), 4),
  revenue = round(rnorm(20, 5000, 1500)),
  target = round(rnorm(20, 4800, 800)),
  satisfaction = round(runif(20, 3.5, 5.0), 1)
) %>%
  mutate(
    performance = revenue / target,
    status = case_when(
      performance >= 1.1 ~ "優秀",
      performance >= 0.95 ~ "良好",
      TRUE ~ "改善要"
    )
  )

# カスタムテーマの適用例
corporate_chart <- business_data %>%
  ggplot(aes(x = quarter, y = revenue, fill = department)) +
  geom_col(position = "dodge", width = 0.8, alpha = 0.9) +
  scale_fill_corporate() +
  scale_y_continuous(
    labels = label_currency(prefix = "¥", suffix = "K", scale = 0.001),
    expand = expansion(mult = c(0, 0.1))
  ) +
  labs(
    title = "四半期別部門売上実績",
    subtitle = "2023年度における各部門のパフォーマンス推移",
    x = "四半期",
    y = "売上（千円）",
    fill = "部門",
    caption = "データソース: 社内売上管理システム | 作成日: 2023-12-20"
  ) +
  theme_corporate()

print(corporate_chart)

print("カスタムテーマが適用されました")

企業ブランドテーマ適用結果

[1] "カスタムテーマが適用されました" # カスタムテーマの特徴: - 企業ブランドカラーの統一 - プロフェッショナルなタイポグラフィ - 清潔で読みやすいレイアウト - レスポンシブなマージン設定 - 統一されたスタイルガイド

企業ブランドテーマ適用例

アニメーション効果とトランジション

gganimate によるアニメーション可視化

library(gganimate)
library(transformr)

# 時系列アニメーションデータの作成
set.seed(456)
animation_data <- tibble(
  year = rep(2020:2023, each = 12),
  month = rep(1:12, 4),
  date = as.Date(paste(year, month, "01", sep = "-"))
) %>%
  mutate(
    product_a = cumsum(rnorm(n(), 50, 20)) + 1000,
    product_b = cumsum(rnorm(n(), 30, 25)) + 800,
    product_c = cumsum(rnorm(n(), 40, 15)) + 600
  ) %>%
  pivot_longer(
    cols = starts_with("product"),
    names_to = "product",
    values_to = "sales"
  ) %>%
  mutate(
    product = case_when(
      product == "product_a" ~ "プロダクトA",
      product == "product_b" ~ "プロダクトB",
      product == "product_c" ~ "プロダクトC"
    )
  )

# アニメーション付きラインチャート
animated_line_chart <- animation_data %>%
  ggplot(aes(x = date, y = sales, color = product)) +
  geom_line(size = 1.2, alpha = 0.8) +
  geom_point(size = 3, alpha = 0.9) +
  scale_color_corporate() +
  scale_x_date(date_labels = "%Y-%m", date_breaks = "6 months") +
  scale_y_continuous(
    labels = label_currency(prefix = "¥", suffix = "K", scale = 0.001)
  ) +
  labs(
    title = "製品別売上推移: {closest_state}年{sprintf('%02d', month(closest_state))}月",
    subtitle = "累積売上高の月次トレンド分析",
    x = "期間",
    y = "売上高（千円）",
    color = "製品",
    caption = "データ期間: 2020年1月〜2023年12月"
  ) +
  theme_corporate() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  transition_reveal(date) +
  ease_aes("linear")

# レース型チャートの作成
race_data <- animation_data %>%
  group_by(date) %>%
  arrange(desc(sales)) %>%
  mutate(rank = row_number()) %>%
  ungroup() %>%
  filter(rank <= 3)

racing_bar_chart <- race_data %>%
  ggplot(aes(x = -rank, y = sales, fill = product)) +
  geom_col(width = 0.8) +
  geom_text(
    aes(y = sales + 50, label = product),
    hjust = 0,
    size = 4,
    fontface = "bold"
  ) +
  geom_text(
    aes(y = 0, label = paste0("¥", round(sales/1000, 1), "K")),
    hjust = -0.1,
    size = 3.5,
    color = "white",
    fontface = "bold"
  ) +
  scale_fill_corporate() +
  coord_flip() +
  scale_x_continuous(breaks = c(-3, -2, -1), labels = c("3位", "2位", "1位")) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.15))) +
  labs(
    title = "製品売上ランキング: {closest_state}年{sprintf('%02d', month(closest_state))}月",
    subtitle = "月次売上高による順位変動",
    x = "順位",
    y = "売上高（千円）",
    caption = "上位3製品の推移"
  ) +
  theme_corporate() +
  theme(
    legend.position = "none",
    axis.text.y = element_blank(),
    axis.ticks.y = element_blank()
  ) +
  transition_time(date) +
  ease_aes("cubic-in-out")

print("アニメーションチャートが作成されました")

# アニメーション設定のカスタマイズ
animation_options <- list(
  width = 800,
  height = 600,
  res = 120,
  fps = 10,
  duration = 8
)

print("アニメーション設定:")
print(animation_options)

アニメーション可視化結果

[1] "アニメーションチャートが作成されました" [1] "アニメーション設定:" $width [1] 800 $height [1] 600 $res [1] 120 $fps [1] 10 $duration [1] 8 # アニメーション機能: - transition_reveal(): データの段階的表示 - transition_time(): 時間軸に沿った変化 - ease_aes(): スムーズなトランジション効果 - 動的タイトルとラベル更新

🔧 高度なgeom と統計変換

カスタムgeom の活用

高度なgeomとstat関数

library(ggridges)
library(ggbeeswarm)
library(ggforce)
library(patchwork)

# 複雑なデータセットの作成
set.seed(789)
advanced_data <- tibble(
  customer_segment = rep(c("プレミアム", "スタンダード", "ベーシック"), each = 200),
  purchase_amount = c(
    rlnorm(200, log(5000), 0.8),  # プレミアム
    rlnorm(200, log(2000), 0.6),  # スタンダード
    rlnorm(200, log(800), 0.5)    # ベーシック
  ),
  satisfaction = c(
    rnorm(200, 4.5, 0.5),  # プレミアム
    rnorm(200, 4.0, 0.7),  # スタンダード
    rnorm(200, 3.5, 0.8)   # ベーシック
  ),
  retention_months = c(
    round(rexp(200, 1/24)),  # プレミアム（長期）
    round(rexp(200, 1/15)),  # スタンダード（中期）
    round(rexp(200, 1/8))   # ベーシック（短期）
  )
) %>%
  mutate(
    satisfaction = pmax(1, pmin(5, satisfaction)),
    retention_months = pmax(1, pmin(60, retention_months)),
    customer_value = purchase_amount * retention_months / 12
  )

# 1. Ridge Plot（分布の重なり表示）
ridge_plot <- advanced_data %>%
  ggplot(aes(x = purchase_amount, y = customer_segment, fill = customer_segment)) +
  geom_density_ridges(
    alpha = 0.7,
    bandwidth = 500,
    scale = 1.2,
    rel_min_height = 0.01
  ) +
  scale_fill_corporate() +
  scale_x_continuous(
    labels = label_currency(prefix = "¥", suffix = "K", scale = 0.001),
    limits = c(0, 15000)
  ) +
  labs(
    title = "セグメント別購入金額分布",
    subtitle = "顧客セグメントごとの購入パターン分析",
    x = "購入金額（千円）",
    y = "顧客セグメント"
  ) +
  theme_corporate() +
  theme(legend.position = "none")

# 2. Beeswarm Plot（データポイントの重複回避）
beeswarm_plot <- advanced_data %>%
  sample_n(150) %>%  # 表示のため一部を抽出
  ggplot(aes(x = customer_segment, y = satisfaction, color = customer_segment)) +
  geom_quasirandom(
    size = 2,
    alpha = 0.7,
    width = 0.3
  ) +
  geom_boxplot(
    alpha = 0.3,
    width = 0.5,
    outlier.shape = NA
  ) +
  scale_color_corporate() +
  scale_y_continuous(limits = c(1, 5), breaks = 1:5) +
  labs(
    title = "セグメント別顧客満足度",
    subtitle = "個別データポイントとボックスプロットの組み合わせ",
    x = "顧客セグメント",
    y = "満足度スコア"
  ) +
  theme_corporate() +
  theme(legend.position = "none")

# 3. Voronoi Plot（エリア分割可視化）
voronoi_data <- advanced_data %>%
  sample_n(50) %>%
  select(purchase_amount, satisfaction, customer_segment, customer_value)

voronoi_plot <- voronoi_data %>%
  ggplot(aes(x = purchase_amount, y = satisfaction)) +
  geom_voronoi_tile(aes(fill = customer_value), alpha = 0.7) +
  geom_voronoi_segment(color = "white", size = 0.5) +
  geom_point(aes(color = customer_segment), size = 3) +
  scale_fill_gradient2(
    low = "#3b82f6",
    mid = "#f59e0b",
    high = "#ef4444",
    midpoint = median(voronoi_data$customer_value),
    labels = label_currency(prefix = "¥", suffix = "K", scale = 0.001)
  ) +
  scale_color_corporate() +
  scale_x_continuous(
    labels = label_currency(prefix = "¥", suffix = "K", scale = 0.001)
  ) +
  labs(
    title = "顧客価値マップ（ボロノイ図）",
    subtitle = "購入金額と満足度による顧客価値の空間分布",
    x = "購入金額（千円）",
    y = "満足度スコア",
    fill = "顧客価値",
    color = "セグメント"
  ) +
  theme_corporate()

# 4. 統計変換の活用
stat_plot <- advanced_data %>%
  ggplot(aes(x = purchase_amount, y = retention_months)) +
  geom_point(alpha = 0.3, size = 1) +
  stat_smooth(
    method = "loess",
    se = TRUE,
    color = brand_colors["primary"],
    fill = brand_colors["secondary"],
    alpha = 0.3
  ) +
  stat_ellipse(
    level = 0.95,
    color = brand_colors["warning"],
    linetype = "dashed",
    size = 1
  ) +
  stat_density_2d(
    color = brand_colors["accent"],
    alpha = 0.6
  ) +
  scale_x_continuous(
    labels = label_currency(prefix = "¥", suffix = "K", scale = 0.001)
  ) +
  labs(
    title = "購入金額と継続期間の関係分析",
    subtitle = "回帰線、信頼楕円、密度分布の重ね合わせ",
    x = "購入金額（千円）",
    y = "継続期間（月）"
  ) +
  theme_corporate()

# 複数プロットの組み合わせ
combined_plot <- (ridge_plot + beeswarm_plot) / (voronoi_plot + stat_plot) +
  plot_annotation(
    title = "高度な可視化技術の活用例",
    subtitle = "複数の geom と統計変換による多角的データ分析",
    theme = theme(
      plot.title = element_text(
        size = 16,
        face = "bold",
        color = brand_colors["primary"]
      ),
      plot.subtitle = element_text(
        size = 12,
        color = brand_colors["neutral"]
      )
    )
  )

print("高度なgeomと統計変換が適用されました")

高度なgeom活用結果

[1] "高度なgeomと統計変換が適用されました" # 使用された高度なgeom: - geom_density_ridges: 分布の重なり表示 - geom_quasirandom: ビースワームプロット - geom_voronoi_tile/segment: ボロノイ図 - stat_smooth: 平滑化回帰線 - stat_ellipse: 信頼楕円 - stat_density_2d: 2次元密度分布 # 組み合わせ効果: - 多次元データの包括的理解 - 統計的関係性の視覚化 - データ分布パターンの発見

🌊 Ridge Plots

複数カテゴリの分布を重ねて表示。密度の違いや分布の形状変化を直感的に比較できます。

🐝 Beeswarm Plots

データポイントの重複を避けながら個別値を表示。外れ値や分布の詳細を確認できます。

🔷 Voronoi Diagrams

データポイント周辺の影響領域を可視化。空間的な関係性やクラスター構造を把握できます。

📈 Statistical Layers

回帰線、信頼区間、密度等高線などの統計的要素を重ね合わせて複合的な分析を実現。

📊 複合グラフとダッシュボード

統合ダッシュボードの構築

包括的ビジネスダッシュボード

library(gridExtra)
library(grid)
library(ggtext)

# ダッシュボード用データの作成
set.seed(2023)
dashboard_data <- list(
  # KPI指標
  kpi = tibble(
    metric = c("総売上", "新規顧客", "リピート率", "顧客満足度"),
    current = c(12500000, 1250, 68.5, 4.2),
    target = c(12000000, 1200, 70.0, 4.5),
    unit = c("¥", "人", "%", "点")
  ),
  
  # 時系列データ
  timeseries = tibble(
    date = seq(as.Date("2023-01-01"), as.Date("2023-12-31"), by = "week"),
    sales = cumsum(rnorm(53, 240000, 50000)),
    orders = round(rnorm(53, 120, 30)),
    customers = round(rnorm(53, 80, 20))
  ),
  
  # 地域別データ
  regional = tibble(
    region = c("北海道", "東北", "関東", "中部", "関西", "中国", "四国", "九州"),
    sales = c(1200, 980, 4500, 2100, 3200, 850, 420, 1100),
    growth = c(5.2, -2.1, 8.7, 3.4, 6.8, -0.5, 12.3, 4.1)
  ),
  
  # 製品カテゴリ
  category = tibble(
    category = c("エレクトロニクス", "ファッション", "ホーム&ガーデン", "スポーツ", "書籍"),
    sales = c(4200, 3100, 2800, 1900, 1500),
    profit_margin = c(18.5, 45.2, 32.1, 25.8, 12.3)
  )
)

# KPI指標カード
create_kpi_card <- function(metric, current, target, unit) {
  achievement <- current / target
  color <- if (achievement >= 1) brand_colors["success"] else brand_colors["warning"]
  
  ggplot() +
    geom_rect(aes(xmin = 0, xmax = 1, ymin = 0, ymax = 1), 
              fill = "white", color = color, size = 2) +
    annotate("text", x = 0.5, y = 0.8, 
             label = metric, size = 5, fontface = "bold",
             color = brand_colors["text"]) +
    annotate("text", x = 0.5, y = 0.5,
             label = paste0(format(current, big.mark = ","), unit),
             size = 8, fontface = "bold", color = color) +
    annotate("text", x = 0.5, y = 0.2,
             label = paste0("目標: ", format(target, big.mark = ","), unit,
                           " (", round((achievement - 1) * 100, 1), "%)\"),
             size = 3, color = brand_colors["neutral"]) +
    xlim(0, 1) + ylim(0, 1) +
    theme_void() +
    theme(
      plot.background = element_rect(fill = brand_colors["background"], color = NA),
      plot.margin = margin(10, 10, 10, 10)
    )
}

# KPI カードの生成
kpi_cards <- map2(
  dashboard_data$kpi$metric,
  pmap(list(dashboard_data$kpi$current, dashboard_data$kpi$target, dashboard_data$kpi$unit), c),
  ~ create_kpi_card(.x, .y[[1]], .y[[2]], .y[[3]])
)

# メイン時系列チャート
main_timeseries <- dashboard_data$timeseries %>%
  ggplot(aes(x = date, y = sales)) +
  geom_area(fill = brand_colors["secondary"], alpha = 0.3) +
  geom_line(color = brand_colors["primary"], size = 1.2) +
  geom_point(color = brand_colors["primary"], size = 0.8) +
  scale_x_date(date_labels = "%m月", date_breaks = "2 months") +
  scale_y_continuous(
    labels = label_currency(prefix = "¥", suffix = "M", scale = 1e-6)
  ) +
  labs(
    title = "累積売上推移",
    x = NULL,
    y = "売上高"
  ) +
  theme_corporate(base_size = 10)

# 地域別売上
regional_chart <- dashboard_data$regional %>%
  arrange(desc(sales)) %>%
  mutate(region = factor(region, levels = region)) %>%
  ggplot(aes(x = region, y = sales, fill = growth > 0)) +
  geom_col(width = 0.7) +
  geom_text(aes(label = paste0(growth, "%")), 
            vjust = -0.5, size = 3, fontface = "bold") +
  scale_fill_manual(values = c("FALSE" = brand_colors["warning"], 
                                   "TRUE" = brand_colors["success"])) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.1))) +
  labs(
    title = "地域別売上と成長率",
    x = NULL,
    y = "売上（百万円）"
  ) +
  theme_corporate(base_size = 10) +
  theme(
    legend.position = "none",
    axis.text.x = element_text(angle = 45, hjust = 1)
  )

# カテゴリ別利益率
category_chart <- dashboard_data$category %>%
  ggplot(aes(x = sales, y = profit_margin, size = sales, fill = category)) +
  geom_point(alpha = 0.8, shape = 21, color = "white", stroke = 1) +
  geom_text(aes(label = category), size = 3, 
            color = brand_colors["text"], fontface = "bold",
            nudge_y = 2) +
  scale_fill_corporate() +
  scale_size_continuous(range = c(5, 15), guide = "none") +
  labs(
    title = "カテゴリ別売上vs利益率",
    x = "売上（百万円）",
    y = "利益率（%）"
  ) +
  theme_corporate(base_size = 10) +
  theme(legend.position = "none")

print("ダッシュボードコンポーネントが作成されました")

ダッシュボード構築結果

[1] "ダッシュボードコンポーネントが作成されました" # ダッシュボードの構成要素: - KPI指標カード: リアルタイム業績指標 - 時系列チャート: 売上推移の可視化 - 地域別分析: 成長率付き売上比較 - カテゴリ分析: 売上と利益率の相関 # 企業レベルの特徴: - 統一されたブランドカラー - レスポンシブレイアウト - インタラクティブ要素 - データドリブンな意思決定支援

統合ダッシュボードレイアウト例

高度なggplot2機能	用途	実装パッケージ	適用場面
カスタムテーマ	ブランド統一	ggplot2	企業レポート、プレゼンテーション
アニメーション	時系列変化表現	gganimate	プレゼンテーション、ウェブ
高度なgeom	複雑な分布表現	ggridges, ggforce	統計分析、研究発表
複合グラフ	多角的分析	patchwork	ダッシュボード、レポート
インタラクティブ	動的探索	plotly, shiny	ウェブアプリ、分析ツール

第13章の重要ポイント

企業ブランド統合：カスタムテーマによる視覚的一貫性の確保
アニメーション効果：時系列変化とデータストーリーの動的表現
高度なgeom活用：複雑なデータ分布の多角的可視化
統計レイヤー：回帰線、密度分布、信頼区間の重ね合わせ
複合ダッシュボード：複数チャートの統合による包括的分析
パフォーマンス最適化：大容量データの効率的レンダリング

実践的アドバイス

高度なggplot2技術は、データの洞察を深めるだけでなく、ステークホルダーへの効果的なコミュニケーションツールとなります。企業環境では、ブランド一貫性とユーザビリティのバランスが重要です。また、インタラクティブ要素やアニメーションは、適切に使用することで、複雑なデータストーリーを直感的に伝えることができます。