R言語でゴルフのスコアをデータ分析してみる(3)【データクレンジング編】

はじめに

前回の記事では、通算ラウンド数をベースに全体の成長曲線を描きました。しかし、そのグラフを詳しく見ていくと、停滞時期があるように見えるのが気になっていました。

今回は、データの「軸」や「前提条件」を疑い、その罠を解消していきます。「時間軸への捉え直し」や「パー数補正」を経て、本当の成長トレンドを可視化していきます。

時間軸におけるスコア推移の再描画

気になるのはグラフの横軸の取り方で、横軸を通算ラウンド数にしているので、日が空いていてもすぐでもメモリは1です。これを横軸を日付にして時間経過でスコアがどのように変化したかを同じローカル多項式回帰で描いてみます。

ソースコード:

HoleData.R

ggplot(
  data = JoRoundData %>% 
    as.data.frame() %>% 
    mutate(Date = as.Date(Date)), 
  
  mapping = aes(x = Date, y = Score)
) +
  geom_point(alpha = 0.4, color = "darkgreen") +
  
  geom_smooth(method = "loess", formula = y ~ x, se = TRUE, color = "blue", linewidth = 1.2) +
  
  scale_x_date(
    date_breaks = "1 year",        
    date_minor_breaks = "1 month",  
    date_labels = "%Y年"
  ) +
  
  labs(
    title = "日付とスコアの推移（成長曲線）",
    x = "日付",
    y = "スコア"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5),
    text = element_text(family = "Hiragino Sans"),
    panel.grid.major.x = element_line(color = "gray80", linewidth = 0.6), 
    panel.grid.minor.x = element_line(color = "gray90", linewidth = 0.4)
  )

出力結果:

前回の横軸が通算ラウンド数のグラフ：

前回のグラフでは最初に急激にスコアが良くなって、途中停滞していたように見えますが、日付を横軸にとると、時間経過でゆっくりとスコアが良くなっていることが分かります。前回グラフはラウンドが少ない時期は傾きが大きくなり、たくさんラウンドしている期間は傾きが緩やかになっていただけのようです。軸の取り方で見え方が変わって面白いです。

月別ラウンド回数の集計と可視化

日付を横軸にしたことで「期間の粗密」が影響していることが見えてきました。では、実際どの時期にどれくらい集中的にラウンドしていたのか、時系列での「ラウンドの密度」をはっきりさせるため、月別のラウンド回数を集計して棒グラフで可視化してみます。月ごとのデータへと丸めるために lubridate パッケージの floor_date を使用します。

ソースコード:

HoleData.R

library(lubridate)
library(dplyr)
library(ggplot2)

# 1. 月ごとのラウンド数を集計
MonthlyCount <- JoRoundData %>% 
  as.data.frame() %>% 
  mutate(
    Date = as.Date(Date),
    # 日付から「毎月1日」の形に変換して月単位で丸める
    YearMonth = floor_date(Date, "month") 
  ) %>% 
  group_by(YearMonth) %>% 
  summarise(RoundCount = n(), .groups = "drop")

# 2. 棒グラフを描画
ggplot(data = MonthlyCount, mapping = aes(x = YearMonth, y = RoundCount, fill = RoundCount)) +
  # width = 25 で棒の隙間を適度に調整
  geom_bar(stat = "identity", width = 25) + 
  
  # 頻度が高い月ほど濃い緑になるグラデーションを設定
  scale_fill_gradient(low = "#a1dbb1", high = "#1e5c31", name = "ラウンド数") +
  
  # 成長曲線と横軸を揃えるための設定
  scale_x_date(
    date_breaks = "1 year",         
    date_minor_breaks = "1 month",   
    date_labels = "%Y年"        
  ) +
  
  labs(
    title = "月別のラウンド回数推移",
    x = "日付",
    y = "ラウンド数（回）"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    text = element_text(family = "Hiragino Sans"),
    panel.grid.major.x = element_line(color = "gray80", linewidth = 0.6), 
    panel.grid.minor.x = element_line(color = "gray90", linewidth = 0.4)
  )

出力結果：

グラフを見ると、2024年の夏以降に一気にラウンド数が増えていることが分かります。
前回の通算ラウンド数ベースのグラフで「傾きが緩やか（停滞）」に見えていた期間は、まさにこのラウンドが集中していた時期にあたります。短期間にたくさんコースを回っていたため、横軸が引き伸ばされて停滞しているように見えていたようです。

コース基準（パー数）の違いに対する補正処理

スコアのグラフを見ていて少し気になる点があります。2026年6月に飛び抜けて良いスコアのデータがありますが、実はこのコースはパー64のかなり短い河川敷コースです。そのほかにもパー72ではないコースも複数あります。上手くなったかどうかを確認するのにはトータルスコアだけを見ていたのでは少し問題がありそうです。

そこでパー数補正をかけてもう一度グラフを描いてみます。

y = (Score - Par) + 72

で、オーバー数を計算して、72を足して補正をかけます。

ソースコード:

HoleData.R

ggplot(
  data = JoRoundData %>% 
    as.data.frame() %>% 
    mutate(Date = as.Date(Date)), 

   mapping = aes(x = Date, y = (Score - Par) + 72)  
#  mapping = aes(x = Date, y = Score)
) +
  
  geom_point(alpha = 0.4, color = "darkgreen") +
  
  geom_smooth(method = "loess", formula = y ~ x, se = TRUE, color = "blue", linewidth = 1.2) +
  
  scale_x_date(
    date_breaks = "1 year",         
    date_minor_breaks = "1 month",   
    date_labels = "%Y年"        
  ) +
  
  labs(
    title = "日付とスコアの推移（成長曲線）",
    x = "日付",
    y = "スコア（パー７２ 補正済み）"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5),
    text = element_text(family = "Hiragino Sans"),
    panel.grid.major.x = element_line(color = "gray80", linewidth = 0.6), 
    panel.grid.minor.x = element_line(color = "gray90", linewidth = 0.4)
  )

出力結果:

パー72補正をかけないグラフよりも一定のなだらかな曲線になっています。ここから順調に上手くなってると言えるのではないでしょうか。
最後に、補正前データと補正後データを重ねて表示しておきます。

ソースコード:

HoleData.R

# データを補正前・補正後でロング型（縦持ち）に変換
PlotData <- JoRoundData %>%
  as.data.frame() %>%
  mutate(Date = as.Date(Date)) %>%
  mutate(
    `補正なし(生スコア)` = Score,
    `パー72補正済み` = (Score - Par) + 72
  ) %>%
  pivot_longer(
    cols = c(`補正なし(生スコア)`, `パー72補正済み`),
    names_to = "DataType",
    values_to = "VisualizedScore"
  )

# 重ね合わせグラフの描画
ggplot(data = PlotData, mapping = aes(x = Date, y = VisualizedScore, color = DataType)) +
  geom_point(alpha = 0.2, show.legend = FALSE) +
  geom_smooth(method = "loess", formula = y ~ x, se = FALSE, linewidth = 1.2) +
  scale_color_manual(values = c("補正なし(生スコア)" = "gray60", "パー72補正済み" = "blue")) +
  scale_x_date(date_breaks = "1 year", date_labels = "%Y年") +
  labs(
    title = "パー72補正による成長曲線の変化",
    x = "日付",
    y = "スコア",
    color = "データの種類"
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    text = element_text(family = "Hiragino Sans"),
  )

出力結果：

まとめ

今回はデータの「時間軸での捉え直し」「ラウンド頻度の可視化」「パー数補正」を行い、実態に即した成長曲線を描き出しました。

• 軸による見え方の違い: 通算ラウンド数では停滞期に見えた部分も、月別頻度を可視化したことで「短期間にラウンドが集中していた」ことが分かりました。
• データクレンジングの重要性: パー64のような例外データをパー72へ補正したことで、ノイズが消え、本来の成長度合いが明確になりました。