Rで何かをしたり、読書をするブログ

政府統計の総合窓口のデータや、OECDやUCIやのデータを使って、Rの練習をしています。ときどき、読書記録も載せています。

ラグビー リーグワン のデータの分析3 - GAM(Generalized Additive Model)での予測

www.crosshyou.info

の続きです。前回の線形モデルではあまり良い予測はできなかったので、今回はGAM(Generalized Additive Model)を試してみます。

まず、mgcvパッケージの読み込みをします。

学習します。

tryやpgは有意な変数ですね。

予測値と実際の値の散布図を描いてみます。

線形モデルと同じような散布図ですね。

交互作用を加えてみます。

交互作用の項、te()のところを見ると、あまり改善していないようです。

散布図を描いてみます。

気持ちよくなった程度でしょうか。。。

GAM(Generalized Additive Model)でも個人の成績からチームの順位を予測するのは難しそうです。

今回は以上です。

次回は、

www.crosshyou.info

です。

 

はじめから読むには、

www.crosshyou.info

です。

今回のコードは以下になります。

#
# GAM(Generalized Additive Model)
# パッケージの読み込み
library(mgcv)
#
# 学習
gam_mod <- gam(target ~ s(rank) + s(point) + s(game) + s(try) + s(goal) + s(pg),
               data = df)
summary(gam_mod)
#
# 予測値と実際の値の散布図
tibble(
  target = df$target,
  estimate = predict(gam_mod)
) |> 
  ggplot(aes(x = target, y = estimate)) +
  geom_point() +
  geom_abline(color = "red") +
  labs(title = "GAM") +
  theme_minimal()
#
# 交互作用を加えたモデル
gam_mod2 <- update(gam_mod, . ~ . + te(try, pg) + te(point, try) + 
                     te(point, pg), data = df)
summary(gam_mod2)
#
# 予測値と実際の値の散布図
tibble(
  target = df$target,
  estimate = predict(gam_mod2)
) |> 
  ggplot(aes(x = target, y = estimate)) +
  geom_point() +
  geom_abline(color = "red") +
  labs(title = "GAM(交互作用を加えたモデル)") +
  theme_minimal()
#

(冒頭の画像は Bing Image Creator で生成しました。プロンプトは Landscape of natural foreign vast grass field, there are a lot of red flowers and yellow flowers, close up of one large  Rhododendron degronianum flower( Azuma-Shakunage in Japanese), photo です)

 

 

ラグビー リーグワン のデータの分析2 - 線形モデルでの予測

www.crosshyou.info

の続きです。前回はCSVファイルのデータをRに読み込ませるところまでやりました。

今回は試しに線形モデルを作ってみます。

モデル全体のp-valueは0.1022となりました。個々の変数の係数を見ると、p-valueが0.05以下のものはありません。線形モデルではターゲットを上手く予測できない感じですね。

実際のtargetとモデルの予測値を散布図にしてみましょう。

う~ん、ダメだこりゃって感じですね。

二乗項や交互作用も加えてみます。

モデル全体のp-valueは0.2084と悪化してしまいました。

散布図を描いてみます。

代わり映えしないですね。。

線形モデルで個人成績からその個人が所属するチームの順位を予測するのは難しいようです。

今回は以上です。

次回は

www.crosshyou.info

です。

 

はじめから読むには、

www.crosshyou.info

です。

今回のコードは以下になります。

#
# linear model
lm_mod <- lm(target ~ ., data = df)
#
# lm_modのサマリー
summary(lm_mod)
#
# 実際のtargetと予測値の散布図
tibble(
  target = df$target,
  estimate = predict(lm_mod)
) |> 
  ggplot(aes(x = target, y = estimate)) +
  geom_point() +
  geom_abline(color = "red") +
  theme_minimal()
#
# 二乗項、交互作用も加える
lm_mod2 <- lm(target ~ rank + I(rank^2) + point + I(point^2) + game +
                I(game^2) + try + I(try^2) + goal + I(goal^2) + pg +
                I(pg^2) + point:try + try:goal + goal:pg, data = df)
#
# lm_mod2のサマリー
summary(lm_mod2)
#
# 散布図
tibble(
  target = df$target,
  estimate = predict(lm_mod2)
) |> 
  ggplot(aes(x = target, y = estimate)) +
  geom_point() +
  geom_abline(color = "red") +
  labs(title = "二乗項と交互作用を加えたモデル") +
  theme_minimal()
#

(冒頭の画像は、Bing Image Creator で生成しました。プロンプトは Natural wild field landscape, full of purple Nemophila flowers, close up of a Nemophila flower, blue sky, a small spring, photo です。)

 

読書記録 - 「世界秩序 グローバル化の夢と挫折」 田所 昌幸 著 (中公新書)

2025年9月25日が初版で、私が手にしたのは2026年1月25日再販のものでしたので、結構売れていると思います。

1999年にアメリカの有名ジャーナリスト、トーマス・フリードマンがグローバル化が進む世界で良い生活がしたいなら、アメリカ流の政治経済モデル、つまり「黄金の拘束衣」をまとう以外に道は無い、といってから四半世紀がたちました。

今はこのアメリカ流の政治経済モデルが黄金でもなんでもないということが明らかになっています。このような認識のもとでこの本は、過去からの世界のグローバル化、世界秩序の在り方をたどっていって、これからの世界秩序はどうなるかを考察しています。

ローマ帝国やジンギスカンのモンゴルの大帝国などの話から大英帝国、アメリカの帝国についての話があります。多くの帝国に共通していることは、帝国の外の民族を取り込むときに、どの程度まで帝国流のやり方を強制するか、もともとの民族のやり方を容認するるか、このバランスが上手だったときは帝国は繁栄して、下手だったとき帝国は衰退していくと読んでいて思いました。

日本はアメリカや中国のように大国ではありません。でも、G7の国の中ではアメリカについで2番目に人口があるので小国でもありません。アメリカの影響から完全に逃れることはできませんが、すべてアメリカの言いなりになる必要もありません。日本は日本で味方の国を増やし、敵対する国を減らしていく、というのが大切だと思いました。

 

ラグビー リーグワン のデータの分析 1 - R にデータを読み込ませる。

今回からしばらくは、ラグビー リーグワン のデータを分析してみたいと思います。

具体的には、

( https://sports.yahoo.co.jp/rugby/leagueone/div1/stats/ )
この個人の成績から、

https://sports.yahoo.co.jp/rugby/leagueone/div1/standings/ )
のチームの順位を予測したいと思います。

まず、個人成績のテーブルをCSVファイルにコピーペーストしました。

こんな感じです。2行目に変数名を挿入しました。

チーム順位を目視で確認して追加しました。targetという変数名です。

これをRに読み込んで分析します。

まず、tidyverse と tidymodels パッケージを読み込みます。

read_csv()関数でCSVファイルを読み込みます。

head() 関数でデータフレームを見てみます。

選手名は分析には使わないですし、チーム名はこれを入れると順位がすぐにわかっちゃいそうなので、name, team を削除したものを分析に使います。

これで分析の準備はできました。

とりあえず、相関係数マトリックスを作ってみます。

あ、dg(ドロップゴール)が標準偏差が0です。CSVファイルを見たら、50人全員、ドロップゴールは0でした。

dgを削除して、もう一度、相関係数マトリックスを作ります。

target(チームの順位)との相関に注目すると、rank(個人の順位)は正の相関です。point(得点)、game(試合数)、try(トライ数)は負の相関です。なんとなく納得できる相関の方向性ですね。goal(ゴール数)とpg(ペナルティーゴール)はほとんど無相関です。

今回は以上です。

次回は

www.crosshyou.info

です。

 

今回のコードは以下になります。

#
# 必要なパッケージの読み込み
library(tidyverse)
library(tidymodels)
#
# CSVファイルの読み込み
df_raw <- read_csv("league_one.csv",
                   skip = 1) |> 
  relocate(target)
#
# データフレームの確認
head(df_raw)
#
# nameとteamを削除
df <- df_raw |> 
  select(-name, -team)
head(df)
#
# 相関係数マトリックス
cor(df)
#
# dgを削除した相関係数マトリックス
df <- df |> select(-dg)
cor(df) |> round(3)
#

(冒頭の画像は、Bing Image Creator で生成しました。プロンプトは Landscape of old times natural forest, under the blue sky and a few white clouds, close up of beautiful purple wisteria flowers, Photograph. です。)

 

UCI Machine Learning Repository の Obesity データの分析10 - Random Forest モデルで予測。正解率は、94/0%

www.crosshyou.info

の続きです。今回はランダムフォレストモデルで予測してみます。

まず、モデルを作成します。

ワークフローを作成します。

 

チューニンググリッドを作成します。

 

トレーニング用のデータでチューニングします。

 

最適なパラメータを確認します。

 

最終ワークフローを作成します。

 

トレーニング用データで学習します。

 

テスト用のデータで予測します。

おお~~! さすがランダムフォレストですね。はじめの10行は全問正解です。

 

混合行列を作成します。

Obesity_Type_IIとIIIは全部正解です。

正解率を計算します。

正解率は 94.0% でした。このデータセットは。ツリーモデルと相性がいいようですね。

今回は以上です。

はじめから読むには、

www.crosshyou.info

です。

今回のコードは以下になります。

#
# モデルの作成
rf_mod <- rand_forest(
  mtry = tune(),
  trees = 500,
  min_n = tune()
) |> 
  set_engine("ranger", importance = "impurity") |> 
  set_mode("classification")
#
# ワークフローの作成
rf_wf <- workflow() |> 
  add_recipe(rec) |> 
  add_model(rf_mod)
#
# チューニンググリッドの作成
rf_grid <- grid_regular(
  mtry(range = c(1, 4)),
  min_n(range = c(2, 20)),
  levels = 5
)
#
# チューニングの実行
set.seed(123)
rf_tuned <- tune_grid(
  rf_wf,
  resamples = folds,
  grid = rf_grid,
  metrics = metric_set(accuracy)
)
#
# 最適なパラメータの確認
rf_params <- select_best(rf_tuned, metric = "accuracy")
rf_params
#
# 最適なパラメータで最終ワークフローを作成
rf_wf_final <- finalize_workflow(rf_wf, rf_params)
#
# トレーニング用データで学習
set.seed(123)
rf_fit <- fit(rf_wf_final, data = df_train)
#
# テスト用のデータで予測
rf_pred <- predict(rf_fit, new_data = df_test) |> 
  bind_cols(df_test |> select(obesity))
tree_pred
#
# 混合行列を作成
conf_mat(rf_pred, truth = obesity, estimate = .pred_class)
#
# 正解率
accuracy(rf_pred, truth = obesity, estimate = .pred_class)
#

(冒頭の画像は、Bing Image Creator で生成しました。プロンプトは Photograph of landscape, natural green grass field, under the clear blue sky, there are some purple AJISAI and red AJISAI flowers, close up of a yellow AJISAI flower. です。)

 

読書記録 - 「整形外科 生活の質を支える」 田中 栄 編 (岩波新書)

2026年4月17日に発行されたばかりです。

編者の田中栄先生は、東京大学大学院医学系研究科外科学専攻整形外科学の先生です。

田中先生の他、10人以上の整形外科の先生が整形外科のいろいろな分野について症状や治療法などをわかりやすく書かれています。

昨年の秋ごろ、膝を痛めて整形外科に診てもらったところ変形性膝関節症と診断されてしばらくリハビリテーションをしていた経験があるので、我が事のように興味を持って読むことができました。

歳をとると骨粗鬆症病や変形性膝関節症、その他の整形外科のお医者さんにお世話になることが多くなりますが、整形外科は英語では Orthopaedics と言って、Orthos(まっすぐな) という言葉と Padis(小児)という言葉が合わさってできたもので、小児期における身体変形の予防・矯正の技術から始まったということです。

予防に勝る治療はない、ということがいろいろな先生から言われていて、メタボや糖尿病などの生活習慣病には気を付けようと思いました。整形外科はどんどん進化していて、まさしく「生活の質を支える」のだとわかりました。医療は Save the Life ですが、その中でも整形外科は Save the Lifestyle と書かれていて、そのとおりだなと思いました。

 

UCI Machine Learning Repository の Obesity データの分析9 - 決定木モデルで予測。正解率は 94.2%

www.crosshyou.info

今回は決定木モデルで予測します。decision_tree() 関数で、エンジンは rpart を使います。モデルを作成します。

ワークフローを作ります。

チューニンググリッドを作成します。

チューニングを実行します。

最適なパラメータを取り出します。

最適なパラメータを使って最終ワークフローを作ります。

トレーニング用のデータで学習します。

テスト用のデータで予測します。

おお!1行目から10行目まで全部正解です。すごいですね。

混合行列を作成します。

Obesity Type III はパーフェクトに予測しています。

正解率はどのくらいでしょうか?

94.2% の正解率は、いままでで一番ですね。

今回は以上です。

次回は

www.crosshyou.info

です。

 

はじめから読むには、

www.crosshyou.info

です。

今回のコードは以下になります。

#
# モデルの作成
tree_mod <- decision_tree(
  cost_complexity = tune(),
  tree_depth = tune(),
  min_n = tune()
) |> 
  set_engine("rpart") |> 
  set_mode("classification")
#
# ワークフローの作成
tree_wf <- workflow() |> 
  add_recipe(rec) |> 
  add_model(tree_mod)
#
# チューニンググリッドの作成
tree_grid <- grid_regular(
  cost_complexity(range = c(-5, -1)),
  tree_depth(range = c(1, 10)),
  min_n(range = c(2, 20)),
  levels = 5
)
#
# チューニングの実行
set.seed(123)
tree_tuned <- tune_grid(
  tree_wf,
  resamples = folds,
  grid = tree_grid,
  metrics = metric_set(accuracy)
)
#
# 最適なパラメータ
tree_params <- select_best(tree_tuned, metric = "accuracy")
tree_params
#
# 最適なパラメータで最終ワークフロー
tree_wf_final <- finalize_workflow(tree_wf, tree_params)
#
# トレーニング用のデータで学習
tree_fit <- fit(tree_wf_final, data = df_train)
#
# テスト用のデータで予測
tree_pred <- predict(tree_fit, new_data = df_test) |> 
  bind_cols(df_test |> select(obesity))
tree_pred
#
# 混合行列を作成
conf_mat(tree_pred, truth = obesity, estimate = .pred_class)
#
# 正解率
accuracy(tree_pred, truth = obesity, estimate = .pred_class)
#

(冒頭の画像は Bing Image Creator で生成しました。プロンプトは Landscape of photograph, showing vast desert land, a few coconut trees, small oasis, bule sky and one white cloud, closing up of blue morning glory flowers. です。)