1. さけのわデータ
利用規約を遵守しつつデータの取得を行う。
1.1 利用規約
サイト上 の利用規約によると 『さけのわデータにて提供されるデータを利用するのに必要なのは 帰属表示 (後述) だけです』 かつ
- 無料です
- 商用、非商用を問わず利用できます
- データを加工して利用できます
との事なので規約に従って帰属表示をちゃんと表示してみる。
〜この記事では さけのわデータ を利用しています〜
ありがとうございます。
1.2 データ取得
httr パッケージで Web API からデータを取得し jsonlite パッケージで json から data.frame への変換を行う。
※データフォーマットに関しては さけのわデータプロジェクト を参照
library(tidyverse)
library(httr)
library(jsonlite)
# 銘柄マスタ
df.brands <-
# API を叩いて json データを取得
httr::GET("https://muro.sakenowa.com/sakenowa-data/api/brands") %>%
httr::content(as = "text", encoding = "utf-8") %>%
# json を data.frame に変換
jsonlite::fromJSON() %>%
.$brands %>%
# data.frame を tibble に変換
tibble::as_tibble()
# 醸造所マスタ
df.breweries <-
# API を叩いて json データを取得
httr::GET("https://muro.sakenowa.com/sakenowa-data/api/breweries") %>%
httr::content(as = "text", encoding = "utf-8") %>%
# json を data.frame に変換
jsonlite::fromJSON() %>%
.$breweries %>%
# data.frame を tibble に変換
tibble::as_tibble()
# 地域マスタ
df.areas <-
# API を叩いて json データを取得
httr::GET("https://muro.sakenowa.com/sakenowa-data/api/areas") %>%
httr::content(as = "text", encoding = "utf-8") %>%
# json を data.frame に変換
jsonlite::fromJSON() %>%
.$areas %>%
# data.frame を tibble に変換
tibble::as_tibble()
# 銘柄ごとのフレーバーデータ
df.flavor_charts <-
# API を叩いて json データを取得
httr::GET("https://muro.sakenowa.com/sakenowa-data/api/flavor-charts") %>%
httr::content(as = "text", encoding = "utf-8") %>%
# json を data.frame に変換
jsonlite::fromJSON() %>%
.$flavorCharts %>%
# data.frame を tibble に変換
tibble::as_tibble()
# ランキングデータ
df.rankings <-
# API を叩いて json データを取得
httr::GET("https://muro.sakenowa.com/sakenowa-data/api/rankings") %>%
httr::content(as = "text", encoding = "utf-8") %>%
# json を data.frame に変換
jsonlite::fromJSON() %>%
# 総合ランキングを対象(地域ランキングは今回は対象外)
.$overall %>%
# data.frame を tibble に変換
tibble::as_tibble()
2. クラスタリング
銘柄ごとのフレーバー値(f1〜f6)で k-means によるクラスタリングを行う。
2.1 クラスタ数の推定
cluster パッケージを用いて良さげなクラスタ数を推定する。
※参考: R K-means法のクラスタ数を機械的に決定する方法
set.seed(1025) clsgap.flavor_charts <- df.flavor_charts %>% # フレーバーデータ以外を除去 dplyr::select(-brandId) %>% # 標準化の実施 scale() %>% # 推定に用いる統計量を算出 # K.max: 推定するクラスタ数の上限 # B: モンテカルロ法のブートストラップ回数(らしい) # ※k-means の収束を安定させるために kmeans 関数の引数 iter.max を大きめに指定している事に注意 cluster::clusGap(kmeans, K.max = 10, B = 100, iter.max = 100) # 結果の確認 # 今回はクラスタ数 5 が推定されている clsgap.flavor_charts # Clustering Gap statistic ["clusGap"] from call: # cluster::clusGap(x = ., FUNcluster = kmeans, K.max = 10, B = 100, iter.max = 100) # B=100 simulated reference sets, k = 1..10; spaceH0="scaledPCA" # --> Number of clusters (method 'firstSEmax', SE.factor=1): 5 # 推定されたクラスタ数
2.2 クラスタリングの実施
上記で推定されたクラスタ数 5 を用いて k-means によるクラスタリングを実施。
km.flavor_charts <- df.flavor_charts %>% # フレーバーデータ以外を除去 dplyr::select(-brandId) %>% # 標準化の実施 scale() %>% # matrix から tibble へ変換 tibble::as_tibble() %>% # k-means の実施 # nstart: ランダムにクラスタリングを実施する回数(デフォルトの 1 だと結果が安定しない事が多いので 5〜10 程度を指定する方が良い(と思う)) kmeans(centers = 5, iter.max = 100, nstart = 5)km.flavor_charts$centers で取得できる 5 つのクラスタ中心の特徴を確認する。
km.flavor_charts$centers %>%
# matrix を tibble に変換
# rownames を指定する事で matrix の表側に指定された内容を列として追加可能
tibble::as_tibble(rownames = "cluster") %>%
dplyr::mutate(cluster = factor(cluster)) %>%
# => long-form
tidyr::pivot_longer(cols = -cluster, names_to = "feature", values_to = "score") %>%
# 可視化
ggplot(aes(feature, cluster)) +
geom_tile(aes(fill = score), colour = "black", show.legend = F) +
geom_text(aes(label = round(score, 2)), size = 5, alpha = 1/2) +
scale_fill_gradient(low = "white", high = "tomato") +
# 余白を除去
coord_cartesian(expand = F)
横軸に各フレーバー、縦軸に各クラスタを配置。セル内の数値は標準化処理済みのフレーバー平均値。
各クラスタごとにうまく特徴を抽出できているような感じはある。
※各フレーバー f1〜f6 の中身に関しては さけのわデータプロジェクト を参照
- クラスタ 1
- f4(穏やか)が高め
- クラスタ 2
- f3(重厚)が高め
- f6(軽快)が低め
- クラスタ 3
- f2(芳醇)が若干高めだが概ね平均的
- クラスタ 4
- f1(華やか)が高め
- f6(軽快)が高め
- クラスタ 5
- f5(ドライ)が高め
さらにクラスタごとに各フレーバーの分布を確認する事を考える。
df.flavor_charts %>%
# クラスタ番号を追加
dplyr::mutate(cluster = forcats::as_factor(km.flavor_charts$cluster)) %>%
# => long-form
tidyr::pivot_longer(cols = dplyr::starts_with("f"), names_to = "feature", values_to = "score") %>%
# 可視化
ggplot(aes(feature, score)) +
geom_boxplot() +
facet_grid(cluster ~ .)
横軸に各フレーバー、縦軸にオリジナルのフレーバー値(0〜1)を表示。
概ね前述したクラスタ中心に沿って各クラスタごとに特徴的な分布をしている事が見て取れる。
クラスタ 3 は際立った特徴が無く平均的な銘柄を中心とするクラスタである事がよく分かる。
3. 銘柄全体の可視化
6 項目(次元)のフレーバーデータを平面上で表現するために第 1＆2 主成分スコアを用いて各銘柄を配置する事を考える。
3.1 主成分分析
銘柄ごとのフレーバー値を用いて主成分分析を実施する。
第 1＆2 主成分で約 70% の寄与率であり、それなりに特徴を捉えた表現が出来る可能性あり。
pca.flavor_charts <- df.flavor_charts %>% # フレーバーデータ以外を除去 dplyr::select(-brandId) %>% # 主成分分析を実施 # scale = T で標準化の実施を指定 prcomp(scale = T) # 結果を確認 summary(pca.flavor_charts) # Importance of components: # PC1 PC2 PC3 PC4 PC5 PC6 # Standard deviation 1.6518 1.2178 0.9635 0.71732 0.48521 0.33189 # Proportion of Variance 0.4548 0.2472 0.1547 0.08576 0.03924 0.01836 # Cumulative Proportion 0.4548 0.7019 0.8567 0.94240 0.98164 1.00000pca.flavor_charts$rotation で取得できる各種成分ごとの固有ベクトルを用いて第 1＆2 主成分の特徴を確認する。
pca.flavor_charts$rotation %>%
# matrix を tibble に変換
# rownames を指定する事で matrix の表側に指定された内容を列として追加可能
tibble::as_tibble(rownames = "flavor") %>%
# => long-form
tidyr::pivot_longer(cols = -flavor, names_to = "PC", values_to = "score") %>%
# 可視化
ggplot(aes(flavor, score)) +
# 第 3〜6 主成分をグレーで表示
geom_line(aes(group = PC), colour = "gray", data = function(df) { dplyr::filter(df, PC %in% stringr::str_c("PC", 3:6, sep = "")) }, alpha = 1/2) +
geom_point(colour = "gray", data = function(df) { dplyr::filter(df, PC %in% stringr::str_c("PC", 3:6, sep = "")) }, alpha = 1/2) +
# 第 1＆2 主成分のみを強調表示
geom_line(aes(group = PC, colour = PC), data = function(df) { dplyr::filter(df, PC %in% stringr::str_c("PC", 1:2, sep = "")) }, size = 1, alpha = 2/3) +
geom_point(aes(colour = PC), data = function(df) { dplyr::filter(df, PC %in% stringr::str_c("PC", 1:2, sep = "")) }, size = 3)
ざっくり第 1 主成分が軽さ、第 2 主成分が辛口の度合いという感じ？(適当)
※各フレーバー f1〜f6 の中身に関しては さけのわデータプロジェクト を参照
3.2 銘柄の配置
算出した第 1＆2 主成分を用いて銘柄を配置していく。
df.flavor_charts %>%
# 各主成分スコアを追加
dplyr::bind_cols(tibble::as_tibble(pca.flavor_charts$x)) %>%
# クラスタ番号を追加
dplyr::mutate(cluster = forcats::as_factor(km.flavor_charts$cluster)) %>%
# 銘柄の名称を追加
dplyr::left_join(df.brands, by = c("brandId" = "id")) %>%
# ランキング(トップ 50)を追加
dplyr::left_join(df.rankings, by = "brandId") %>%
dplyr::select(
brand_name = name,
PC1,
PC2,
cluster,
rank
) %>%
# 可視化
ggplot(aes(PC1, PC2)) +
# 銘柄の名称を追加
geom_text(aes(label = brand_name, colour = cluster), family = "Osaka", size = 3, alpha = 2/3) +
# クラスタごとの中心(平均値)を追加
geom_point(
aes(x = PC1, y = PC2, fill = cluster),
data = function(df) {
dplyr::group_by(df, cluster) %>%
dplyr::summarise(dplyr::across(dplyr::starts_with("PC"), mean))
},
size = 5,
shape = 24 # 表示を▲に指定
) +
# ランキング(トップ 50)を追加
geom_text(aes(label = rank), data = function(df) { dplyr::filter(df, dplyr::between(rank, 1, 50)) }, size = 5, alpha = 2/3)
横軸を第 1 主成分、縦軸を第 2 主成分として各銘柄の位置を表現した。
5 つの三角(▲)は各クラスタの重心(平均値)の位置を表しており、黒文字の数字はランキング対象銘柄の位置を表す。
概ね各クラスタごとに配置が分離されており、第 1＆2 主成分でそれなりに特徴を捉える事が出来ているものと思われる。
ランキングのトップ 50 に入るような人気銘柄の多くがクラスタ 3 と 4 の領域に存在しており、 辛口を避け(＝下半分)軽い飲み心地(＝やや右寄り)の尖りすぎない(＝原点に近い)銘柄が好まれる傾向にあるのではないかと考えられる。
ランキングをトップ 10 に絞ってみると上記の傾向がより顕著となり、仮説としてはそれなりに悪くないのかも。
4. 決定木
ランクを数量と見做して回帰を行う事の是非は一旦見ないふりをして各ランクを分類するための決定木を構築する。
今回は ggparty パッケージを使用して ggplot 上でグラフを作成する(決定木をキレイに可視化できるようになって嬉しい)。
※ggparty の詳細に関しては ggparty: Graphic Partying を参照
各エッジ上に分割の条件となる数値が表示されるが、現状では簡単に丸め処理を行う方法が無い(恐らく)ので ggparty 作者が作成した非公式の add_splitvar_breaks_index_new 関数をダウンロードして用いている。
※詳細は Number of decimal places on edges of a decision-tree plot with ggparty 参照
library(ggparty)
# github 上の add_splitvar_breaks_index_new 関数をロードする
# エッジ上のラベルに表示する数値を丸めるために用いる
fnc <- readr::read_file("https://raw.githubusercontent.com/martin-borkovec/ggparty/martin/R/add_splitvar_breaks_index_new.R") %>%
parse(text = .)
eval(fnc)
df.flavor_charts %>%
# 各主成分スコアを追加
dplyr::bind_cols(tibble::as_tibble(pca.flavor_charts$x)) %>%
# クラスタ番号を追加
dplyr::mutate(cluster = forcats::as_factor(km.flavor_charts$cluster)) %>%
# ランキングの追加
dplyr::inner_join(df.rankings, by = "brandId") %>%
dplyr::select(-c(
brandId,
score
)) %>%
# 決定木を構築
rpart::rpart(rank ~ ., data = ., minbucket = 5)%>%
partykit::as.party() %>%
{
pt <- (.)
# ノード分割に用いる数値の表示を丸める
rounded_labels <- add_splitvar_breaks_index_new(
party_object = pt,
plot_data = ggparty:::get_plot_data(pt),
round_digits = 3
)
# 可視化
ggparty(pt) +
geom_edge() +
geom_edge_label(aes(label = unlist(rounded_labels)), size = 3) +
# ノード分割に用いる項目を追加
geom_node_label(
aes(colour = splitvar),
line_list = list(
aes(label = splitvar),
aes(label = stringr::str_c("N = ", nodesize, sep = ""))
),
line_gpar = list(
list(size = 12, fontface = "bold"),
list(size = 9, colour = "black")
),
show.legend = F,
ids = "inner"
) +
# 終端ノードに箱ひげ図を指定
geom_node_plot(
gglist = list(
geom_boxplot(aes(x = "", y = rank)),
labs(
x = NULL
)
),
nudge_x = -0.01,
shared_axis_labels = T
) +
# 終端ノードの件数を追加
geom_node_label(
line_list = list(
aes(label = stringr::str_c("N = ", nodesize, sep = ""))
),
line_gpar = list(
list(size = 9, colour = "black")
),
nudge_y = -0.4,
ids = "terminal"
)
}
- f3(重厚)が 0.256(下位25%)〜0.276(下位35%)に位置する銘柄群が最も人気の高いクラス(一番左)として識別されており、これは第 1 主成分 PC1 の f3 が負の方向に大きく特徴づけられている事とも整合性がとれている
- f3(重厚)が 0.276(下位35%)以上であり、PC1 のスコアがそれなりに低い(-0.738以下)銘柄群が最も人気の低いクラス(一番右)として識別されている事もこれまで見てきた特徴と整合性がとれている
5. まとめ
- さけのわデータは利用規約が緩く使い勝手が良い
- json ベースの Web API は R でも簡単に扱える
- 人気銘柄の傾向をそれなりに捉えられて楽しい
- 今回は使用していないフレーバータグも試してみたい
参考
0 件のコメント:
コメントを投稿