国連投票パターンの次元縮小🌍

これは、screencastsパッケージを使用して、どのように複雑なモデルを調整するための最初のモデリングのステップを開始からの使用を示すtidymodelsの私のシリーズの最新です.私が最近私のブログにした1つの変化はDisqusコメントを削除することです.ありがとうございます🙏 前に私のブログにコメントし、私は人々の興味と自分の考えを共有する意欲を感謝どのくらいを表現するみんなに.Disqusは2、3の理由のためにイライラしていました、それで、私は私のアーカイブをダウンロードしました(したがって、私は必要に応じて将来のどんな古いコメントも見ることができます)、そして、utteranc.esによってこのポストからの援助でMaëlle Salmonに変わりました.私は、これがより良い前進すると思っています!
今日のScreenCastは、Unicode投票で今週の #TidyTuesday data setを使用して、教師なし機械学習のためにtidymodelを使う方法を調査します.🗳
ここでは、ビデオの代わりに、またはビデオに加えて読書を好む人々のために、私はビデオで使用されるコードです.

データを探る

この分析は私がlast May for the #TidyTuesday data set on cocktail recipesをしたことと非常に似ているので、2つの異なったデータセットについて、同じことと何が異なるかを見るために両方を見てみましょう.我々のモデリング目標は、どの国が似ているかを理解するためにUnited Nations voting dataで次元縮小のための教師なしアルゴリズムを使用することです.

library(tidyverse)

unvotes <- read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-03-23/unvotes.csv")
issues <- read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2021/2021-03-23/issues.csv")

モデリングに使用するpivot_wider()を通してこのデータセットのワイドバージョンを作成しましょう.

unvotes_df <- unvotes %>%
  select(country, rcid, vote) %>%
  mutate(
    vote = factor(vote, levels = c("no", "abstain", "yes")),
    vote = as.numeric(vote),
    rcid = paste0("rcid_", rcid)
  ) %>%
  pivot_wider(names_from = "rcid", values_from = "vote", values_fill = 2)

主成分分析

この解析は、recipesパッケージだけでなく、データ処理前処理用のTidyModelパッケージと、教師なしメソッドのための関数を含むフィーチャーエンジニアリングを使用します.利用可能なオプションはたくさんありますが、基本的な主成分分析を実装しましょう.

library(recipes)

pca_rec <- recipe(~., data = unvotes_df) %>%
  update_role(country, new_role = "id") %>%
  step_normalize(all_predictors()) %>%
  step_pca(all_predictors(), num_comp = 5)

pca_prep <- prep(pca_rec)

pca_prep


## Data Recipe
## 
## Inputs:
## 
## role #variables
## id 1
## predictor 6202
## 
## Training data contained 200 data points and no missing data.
## 
## Operations:
## 
## Centering and scaling for rcid_3, rcid_4, rcid_5, rcid_6, rcid_7, ... [trained]
## PCA extraction with rcid_3, rcid_4, rcid_5, rcid_6, rcid_7, ... [trained]

我々は、国が主要なコンポーネントスペースにプリフェッチされたレシピを焼いているところを見ることができます.

bake(pca_prep, new_data = NULL) %>%
  ggplot(aes(PC1, PC2, label = country)) +
  geom_point(color = "midnightblue", alpha = 0.7, size = 2) +
  geom_text(check_overlap = TRUE, hjust = "inward", family = "IBMPlexSans") +
  labs(color = NULL)

like step_ica() and step_kpca()
私たちは、どの票が成分に貢献するかについて見ることができます.のトピックは、トップ校長コンポーネントに貢献するトピックを参照してくださいとのロールコールの投票に参加しましょう.

pca_comps <- tidy(pca_prep, 2) %>%
  filter(component %in% paste0("PC", 1:4)) %>%
  left_join(issues %>% mutate(terms = paste0("rcid_", rcid))) %>%
  filter(!is.na(issue)) %>%
  group_by(component) %>%
  top_n(8, abs(value)) %>%
  ungroup()

pca_comps %>%
  mutate(value = abs(value)) %>%
  ggplot(aes(value, fct_reorder(terms, value), fill = issue)) +
  geom_col(position = "dodge") +
  facet_wrap(~component, scales = "free_y") +
  labs(
    x = "Absolute value of contribution",
    y = NULL, fill = NULL,
    title = "What issues are most important in UN voting country differences?",
    subtitle = "Human rights and economic development votes account for the most variation"
  )

PCAインプリメンテーションは投票の話題について知りませんでした、しかし、最初の主要な構成要素が主に人権と経済発展についてどのようにあるかについて注意してください、第2の主成分はほとんど植民地支配についてです.

ウープ

異なる次元性削減アプローチのために切替えるために、我々はちょうど異なるレシピstep_()に変わる必要があります. パッケージ、UMAPパッケージで利用可能なトポロジーデータ解析からのアイデアに基づく次元縮小のための別のアルゴリズムを試してみましょう.

library(embed)

umap_rec <- recipe(~., data = unvotes_df) %>%
  update_role(country, new_role = "id") %>%
  step_normalize(all_predictors()) %>%
  step_umap(all_predictors())

umap_prep <- prep(umap_rec)

umap_prep


## Data Recipe
## 
## Inputs:
## 
## role #variables
## id 1
## predictor 6202
## 
## Training data contained 200 data points and no missing data.
## 
## Operations:
## 
## Centering and scaling for rcid_3, rcid_4, rcid_5, rcid_6, rcid_7, ... [trained]
## UMAP embedding for rcid_3, rcid_4, rcid_5, rcid_6, rcid_7, ... [trained]

私たちが国がどこにこの次元縮小アプローチによって作成された空間にあるかを視覚化するとき、それは非常に異なります!

bake(umap_prep, new_data = NULL) %>%
  ggplot(aes(umap_1, umap_2, label = country)) +
  geom_point(color = "midnightblue", alpha = 0.7, size = 2) +
  geom_text(check_overlap = TRUE, hjust = "inward", family = "IBMPlexSans") +
  labs(color = NULL)

embed