【R】データサイエンス100本ノック（構造化データ加工編）をtidyverseでやった

2020/09/06：投稿
2020/09/08：R-078に別解追加

GitHubで公開されているデータサイエンス100本ノック（構造化データ加工編）のRの問題100問を終わらせた。
公式の解答例ではBase Rを使った解答とtidyverseを使った解答が混在しているが、最近1.0になったdplyrを初めとしたtidyverseとtidymodelsの関数をなるべく使い、パイプラインで処理するようにした。

Qiitaで検索するとRでデータサイエンス100本ノックをやった記事は見当たらなかったのと、後で自分で見返すために投稿。

以下、問題文は上記リポジトリから引用。

環境

Windows10(1909) + WSL2 + Ubuntu20.04 + Docker Desktopを用意、Ubuntuからgit cloneしてdocker-compose up -dしたコンテナにVisual Studio Code + Remote-Containersで接続、VSCodeにPython拡張を入れた上でpreprocess_knock_R.ipynbを開いて作業した。JupyterのカーネルをRにしても動作するし、補完も多少効く。

• R version 3.6.3 (2020-02-29) -- "Holding the Windsock"

Console

> library(tidyverse)
── Attaching packages ─────────────────────────────────────── tidyverse 1.3.0 ──
✔ ggplot2 3.3.2     ✔ purrr   0.3.4
✔ tibble  3.0.3     ✔ dplyr   1.0.2
✔ tidyr   1.1.1     ✔ stringr 1.4.0
✔ readr   1.3.1     ✔ forcats 0.5.0
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
> library(tidymodels)
── Attaching packages ────────────────────────────────────── tidymodels 0.1.1 ──
✔ broom     0.7.0      ✔ recipes   0.1.13
✔ dials     0.0.8      ✔ rsample   0.0.7 
✔ infer     0.5.3      ✔ tune      0.1.1 
✔ modeldata 0.0.2      ✔ workflows 0.1.3 
✔ parsnip   0.1.3      ✔ yardstick 0.0.7 
── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
✖ scales::discard() masks purrr::discard()
✖ dplyr::filter()   masks stats::filter()
✖ recipes::fixed()  masks stringr::fixed()
✖ dplyr::lag()      masks stats::lag()
✖ yardstick::spec() masks readr::spec()
✖ recipes::step()   masks stats::step()

印象に残った問題

R-010

R-010: 店舗データフレーム（df_store）から、店舗コード（store_cd）が"S14"で始まるものだけ全項目抽出し、10件だけ表示せよ。

df_store %>%
  filter(store_cd %>% str_detect('^S14')) %>%
  head(10)

特定の文字列を含むレコードを抽出する問題。
この問題に限らず、stringr::str_detectによる文字列の検出が大活躍した。

R-029

R-029: レシート明細データフレーム（df_receipt）に対し、店舗コード（store_cd）ごとに商品コード（product_cd）の最頻値を求めよ。

df_receipt %>%
  group_by(store_cd, product_cd) %>%
  summarise(n = n(), .groups = 'drop_last') %>%
  filter(n == n %>% max()) %>%
  ungroup()

一番数の多い項目を求める問題。
Base Rにもtidyverseにも最頻値を求める関数はないため、最頻値の定義通り、項目毎に数を数えてから件数が最大値になっているレコードだけ残す。

dplyr::summariseで.groups = 'drop_last'を指定するとdplyr::group_byで指定した最後の列のグルーピングだけが解除される。
上記の例ではproduct_cdが解除されてstore_cdだけでグルーピングされた状態になるので、base::maxはstore_cd毎に最大値を計算する。

……という風に最初は解いたのだが（そして当初公式の解答例では一位タイのレコードが漏れていることをissueで指摘しつつ上記の解答を提示して公式解答に載せてもらったのだが）、上位のレコードを返すdplyr::slice_maxを使って以下のようにした方が簡潔だった。

df_receipt %>%
  group_by(store_cd, product_cd) %>%
  summarise(n = n(), .groups = 'drop_last') %>%
  slice_max(n, n = 1) %>%
  ungroup()

R-030

R-030: レシート明細データフレーム（df_receipt）に対し、店舗コード（store_cd）ごとに売上金額（amount）の標本分散を計算し、降順でTOP5を表示せよ。

var_sample <- function(x) {x %>% {var(.) * (length(.) - 1) / length(.)}}

df_receipt %>%
  group_by(store_cd) %>%
  summarise(var = amount %>% var_sample()) %>%
  slice_max(var, n = 5)

項目毎の標本分散を求める問題。
Base Rにもtidyverseにも標本分散を求める関数はないため、自作関数を使う。

dplyr::arrangeで並べ替えてutils::headで5件表示させる方法の場合、複数レコードが同じ順位の可能性もあるのでdplyr::slice_maxの方が適切。
なおdplyr::slice_maxはwith_ties = FALSEにしてやればタイを無視してnレコードの表示になる。

R-031

R-031: レシート明細データフレーム（df_receipt）に対し、店舗コード（store_cd）ごとに売上金額（amount）の標本標準偏差を計算し、降順でTOP5を表示せよ。

sd_sample <- function(x) {x %>% {var(.) * (length(.) - 1) / length(.)} %>% sqrt()}

df_receipt %>%
  group_by(store_cd) %>%
  summarise(sd = amount %>% sd_sample()) %>%
  slice_max(sd, n = 5)

項目毎の標本標準偏差を求める問題。
Base Rにもtidyverseにも以下略

R-042

R-042: レシート明細データフレーム（df_receipt）の売上金額（amount）を日付（sales_ymd）ごとに集計し、各日付のデータに対し、１日前、２日前、３日前のデータを結合せよ。結果は10件表示すればよい。

df_receipt %>%
  group_by(sales_ymd) %>%
  summarise(amount_daily = sales_ymd %>% sum()) %>%
  mutate(
    across(
      everything(),
      list(lag_1 = ~ lag(.x, n = 1), lag_2 = ~ lag(.x, n = 2), lag_3 = ~ lag(.x, n = 3))
    )
  ) %>%
  head(10)

複数の列に複数の関数を適用した列を追加する問題。
公式解答例ではforループを使っているが、dplyr1.0.0ではdplyr::acrossをtidyselect::everythingと dplyr::mutateと組み合わせて使うことで、「全ての列に対してそれぞれdplyr::lag関数を適用した列を作って追加」という処理を上記のようにパイプラインの中で書ける。

ただ、これは追加する列が少ないときは良いが、多いと式が冗長になる。上の例でも冗長気味。
回避するには、dplyr::acrossで適用する式をあらかじめformula型で用意して名前付きベクトルやリストに収納しておけば良い。

for (i in 1:3) {
  if (i == 1) formula <- list()
  formula[[i]] <- str_c('~ lag(.x, n = ', i, ')') %>% as.formula()
  names(formula)[i] <- str_c('lag_', i)
}

df_receipt %>%
  group_by(sales_ymd) %>%
  summarise(amount_daily = sales_ymd %>% sum()) %>%
  mutate(across(everything(), {{formula}})) %>%
  head(10)

ベクトルでforループ使わずに作れそうだと思ったのだが、上手く行かなかったのでforを使って名前付きリストを作った。

R-044

R-044: 前設問で作成した売上サマリデータフレーム（df_sales_summary）は性別の売上を横持ちさせたものであった。このデータフレームから性別を縦持ちさせ、年代、性別コード、売上金額の3項目に変換せよ。ただし、性別コードは男性を'00'、女性を'01'、不明を'99'とする。

df_sales_summary %>%
  pivot_longer(cols = - era, names_to = 'gender_cd', values_to = 'amount') %>%
  mutate(gender_cd = recode(gender_cd, male = '00', female = '01', .default = '99'))

横持ちを縦持ちに変換し、値を置換する問題。
公式解答例ではdplyr::case_whenを使っているが、このような単純な置換はdplyr::recodeでより簡潔に書ける。

R-051

R-051: レシート明細データフレーム（df_receipt）の売上エポック秒（sales_epoch）を日付型（POSIXct）に変換し、"日"だけ取り出してレシート番号(receipt_no)、レシートサブ番号（receipt_sub_no）とともに抽出せよ。なお、"日"は0埋め2桁で取り出すこと。データは10件を抽出すれば良い。

df_receipt %>%
  transmute(
    receipt_no,
    receipt_sub_no,
    sales_posix = sales_epoch %>% as_datetime() %>% format('%d')
  ) %>%
  head(10)

エポック秒からの変換。lubridate::as_datetimeからのbase::formatの万能感。

R-053

R-053: 顧客データフレーム（df_customer）の郵便番号（postal_cd）に対し、東京（先頭3桁が100〜209のもの）を1、それ以外のものを０に２値化せよ。さらにレシート明細データフレーム（df_receipt）と結合し、全期間において買い物実績のある顧客数を、作成した2値ごとにカウントせよ。

df_customer %>%
  inner_join(df_receipt, by = 'customer_id') %>%
  mutate(
    postal_bit = case_when(
      postal_cd %>% str_sub(end = 3) %>% as.numeric() %>% between(100, 209) ~ 1,
      TRUE ~ 0
    )
  ) %>%
  group_by(postal_bit) %>%
  summarise(n_customer = customer_id %>% n_distinct())

二つのデータフレームを結合した後、二値化する問題。
dplyr::case_whenは条件に複雑な式を入れられて便利。

R-058

R-058: 顧客データフレーム（df_customer）の性別コード（gender_cd）をダミー変数化し、顧客ID（customer_id）とともに抽出せよ。結果は10件表示させれば良い。

df_customer %>%
  select(customer_id, gender_cd) %>%
  recipe() %>%
  step_dummy(gender_cd, one_hot = T) %>%
  prep() %>%
  juice() %>%
  head(10)

ダミー変数化する問題。tidymodelsの領分。
recipes::step_dummyはデフォルトだと水準の数-1個のダミー変数を作るので、公式解答例に合わせて水準と同じ数のダミー変数を作るなら上記のようにone_hot = Tにする必要がある。

R-060

R-060: レシート明細データフレーム（df_receipt）の売上金額（amount）を顧客ID（customer_id）ごとに合計し、合計した売上金額を最小値0、最大値1に正規化して顧客ID、売上金額合計とともに表示せよ。ただし、顧客IDが"Z"から始まるのものは非会員を表すため、除外して計算すること。結果は10件表示させれば良い。

df_receipt %>%
  filter(! customer_id %>% str_detect('^Z')) %>%
  group_by(customer_id) %>%
  summarise(amount_all = amount %>% sum()) %>%
  mutate(amount_all_normalized = amount_all %>% scale(center = min(.), scale = max(.) - min(.)) %>% as.vector()) %>%
  head(10)

正規化の問題。
R-059もなのだが、正規化する関数base::scaleはマトリックスを返すためbase::as.vectorに繋げてベクトルに直している。

R-069

R-069: レシート明細データフレーム（df_receipt）と商品データフレーム（df_product）を結合し、顧客毎に全商品の売上金額合計と、カテゴリ大区分（category_major_cd）が"07"（瓶詰缶詰）の売上金額合計を計算の上、両者の比率を求めよ。抽出対象はカテゴリ大区分"07"（瓶詰缶詰）の購入実績がある顧客のみとし、結果は10件表示させればよい。

df_receipt %>%
  inner_join(df_product, by = 'product_cd') %>%
  mutate(amount_07 = amount * (category_major_cd == '07')) %>%
  group_by(customer_id) %>%
  summarise(across(starts_with('amount'), list(all = sum))) %>%
  filter(amount_07_all > 0) %>%
  mutate(rate_07 = amount_07_all / amount_all) %>%
  head(10)

売上げ全体に占める特定カテゴリの売上げの割合を顧客毎に計算する問題。
公式解答例では二回joinしているが、カテゴリ07の売上げ合計を上記のように算出して別の列に追加すれば一回のjoinで済む。
dplyr::acrossで売上げを合計する計算はすっきり書ける。

R-070

R-070: レシート明細データフレーム（df_receipt）の売上日（sales_ymd）に対し、顧客データフレーム（df_customer）の会員申込日（application_date）からの経過日数を計算し、顧客ID（customer_id）、売上日、会員申込日とともに表示せよ。結果は10件表示させれば良い（なお、sales_ymdは数値、application_dateは文字列でデータを保持している点に注意）。

df_receipt %>%
  inner_join(df_customer, by = 'customer_id') %>%
  mutate(elapsed_days = as_date(sales_ymd %>% as.character) - as_date(application_date)) %>%
  select(customer_id, sales_ymd, application_date, elapsed_days) %>%
  head(10)

二つの日付の経過日数を計算する問題。
lubridateパッケージの関数群は特に形式を指定しなくても良い感じに型を変換してくれる。
ここではlubridate::as_dateで日付を出して引き算で経過日数を算出。

これを解いているときは思い出せなかったので使わなかったが、lubridate::as_dateの代わりにlubridate::ymdを使えば下記のようにsales_ymdを文字列に直すことなく一発でDateクラスに変換できる。
（lubridate::as_dateは数値を与えると1970年1月1日からの経過日数だと解釈するが、lubridate::ymdは文字列を与えたとき同様にymd形式の日付だと解釈する）

df_receipt %>%
  inner_join(df_customer, by = 'customer_id') %>%
  mutate(elapsed_days = ymd(sales_ymd) - ymd(application_date)) %>%
  select(customer_id, sales_ymd, application_date, elapsed_days) %>%
  head(10)

R-071

R-071: レシート明細データフレーム（df_receipt）の売上日（sales_ymd）に対し、顧客データフレーム（df_customer）の会員申込日（application_date）からの経過月数を計算し、顧客ID（customer_id）、売上日、会員申込日とともに表示せよ。結果は10件表示させれば良い（なお、sales_ymdは数値、application_dateは文字列でデータを保持している点に注意）。1ヶ月未満は切り捨てること。

df_receipt %>%
  inner_join(df_customer, by = 'customer_id') %>%
  mutate(elapsed_months = interval(as_date(application_date), as_date(sales_ymd %>% as.character)) %/% months(1)) %>%
  select(customer_id, sales_ymd, application_date, elapsed_months) %>%
  head(10)

経過月数を算出する問題。月によって日数が違うので、R-070のような単純な計算では出せない。

そこでlubridate::intervalを使って作るIntervalクラスのオブジェクトをbase::monthsで作ったPeriodクラスオブジェクトで割って月数を算出する。今回は一ヶ月未満切り捨てなので、整数商が求める値となる。
R-072では同じように年を表すPeriodクラスオブジェクトで割ってやれば良くて、lubridate::yearsを使う。

公式解答例のように、lubridate::time_lengthを使ってIntervalクラスのオブジェクトを経過時間に変換することもできる。

R-073

R-073: レシート明細データフレーム（df_receipt）の売上日（sales_ymd）に対し、顧客データフレーム（df_customer）の会員申込日（application_date）からのエポック秒による経過時間を計算し、顧客ID（customer_id）、売上日、会員申込日とともに表示せよ。結果は10件表示させれば良い（なお、sales_ymdは数値、application_dateは文字列でデータを保持している点に注意）。なお、時間情報は保有していないため各日付は0時0分0秒を表すものとする。

df_receipt %>%
  inner_join(df_customer, by = 'customer_id') %>%
  mutate(elapsed_epoch = (as_date(sales_ymd %>% as.character) - as_date(application_date)) %>% as.numeric(units = 'secs')) %>%
  select(customer_id, sales_ymd, application_date, elapsed_epoch) %>%
  head(10)

経過時間をエポック秒で算出する問題。
difftimeクラスのオブジェクトをbase::as.numericに渡して単位を秒にすると簡単にエポック秒に変換できる。

R-074

R-074: レシート明細データフレーム（df_receipt）の売上日（sales_ymd）に対し、当該週の月曜日からの経過日数を計算し、顧客ID、売上日、当該週の月曜日付とともに表示せよ。結果は10件表示させれば良い（なお、sales_ymdは数値でデータを保持している点に注意）。

df_receipt %>%
  mutate(
    elapsed_weekday = sales_ymd %>% as.character %>% as_date %>% wday(week_start = 1) - 1,
    monday = sales_ymd %>% as.character %>% as_date - elapsed_weekday
  ) %>%
  select(customer_id, sales_ymd, monday, elapsed_weekday %>%
  head(10)

曜日を求める問題。
lubridate::wdayで、週の始まりの曜日を1としたときの日数を取得できる。
今回は月曜日からの経過日数なので、week_start = 1により月曜日を1として指定し、後で1引いている。

上の計算だとelapsed_weekdayはdbl型になる。公式解答例のようにdifftimeにしたい場合は下記のようにbase::as.difftimeで変換する。

df_receipt %>%
  mutate(
    elapsed_weekday = sales_ymd %>% as.character %>% as_date %>% {wday(., week_start = 1) - 1} %>% as.difftime(units = 'days'),
    monday = sales_ymd %>% as.character %>% as_date - elapsed_weekday
  ) %>%
  select(customer_id, sales_ymd, monday, elapsed_weekday) %>%
  head(10)

R-078

R-078: レシート明細データフレーム（df_receipt）の売上金額（amount）を顧客単位に合計し、合計した売上金額の外れ値を抽出せよ。ただし、顧客IDが"Z"から始まるのものは非会員を表すため、除外して計算すること。なお、ここでは外れ値を第一四分位と第三四分位の差であるIQRを用いて、「第一四分位数-1.5×IQR」よりも下回るもの、または「第三四分位数+1.5×IQR」を超えるものとする。結果は10件表示させれば良い。

df_receipt %>%
  filter(! customer_id %>% str_detect('^Z')) %>%
  group_by(customer_id) %>%
  summarise(amount_all = amount %>% sum) %>%
  filter(
    amount_all %>% {
      . > quantile(., 0.75) + 1.5 * (quantile(., 0.75) - quantile(., 0.25)) |
      . < quantile(., 0.25) - 1.5 * (quantile(., 0.75) - quantile(., 0.25))
    }
  ) %>%
  head(10)

外れ値を求める問題。
パイプラインを使うことで公式解答例よりも若干簡潔になったが、そもそもstats::quantileを連発しているため長い……。

（2020/09/08追記）
……と思っていたらRには最初からstats::IQRという便利な関数が入っていた。

df_receipt %>%
  filter(! customer_id %>% str_detect('^Z')) %>%
  group_by(customer_id) %>%
  summarise(amount_all = amount %>% sum) %>%
  filter(
    amount_all %>%
      {. > quantile(., 0.75) + 1.5 * IQR(.) | . < quantile(., 0.25) - 1.5 * IQR(.)}
  ) %>%
  head(10)

R-079

R-079: 商品データフレーム（df_product）の各項目に対し、欠損数を確認せよ。

df_product %>%
  summarise(across(everything(), ~ is.na(.) %>% sum()))

NAの個数の確認。
公式解答例のbase::sapplyを使う場合と比べ、上のようにするとデータフレームが出力されるので見やすいか……？

R-081

R-081: 単価（unit_price）と原価（unit_cost）の欠損値について、それぞれの平均値で補完した新たなdf_product_2を作成せよ。なお、平均値について1円未満は四捨五入とし、0.5については偶数寄せでかまわない。補完実施後、各項目について欠損が生じていないことも確認すること。

df_product_2 <- df_product %>%
  recipe() %>%
  step_meanimpute(unit_price, unit_cost) %>%
  prep() %>%
  juice() %T>%
  {(nrow(df_product) - nrow(.)) %>% print}

欠損値（NA）を平均値で埋める問題。
tidymodelsに含まれるrecipes::step_meanimputeを使う。処理前後での行数差分表示までmagrittrのT演算子%T>%で繋いでいる。

tidyverse内の関数だけを使うなら、tidyr::replace_naを使って以下のようにも書ける。

df_product_2 <- df_product %>%
  replace_na(list(unit_price = mean(.$unit_price, na.rm = T) %>% round, unit_cost = mean(.$unit_cost, na.rm = T) %>% round)) %T>%
  {(nrow(df_product) - nrow(.)) %>% print}

base::meanで平均値を出すために列を.$unit_costのように指定する必要があるのと、base::roundで丸める必要があるため引数が長くなってしまうのが欠点。
列のtypeがintegerからdoubleに変わってもいる。

R-083

R-083: 単価（unit_price）と原価（unit_cost）の欠損値について、各商品の小区分（category_small_cd）ごとに算出した中央値で補完した新たなdf_product_4を作成せよ。なお、中央値について1円未満は四捨五入とし、0.5については偶数寄せでかまわない。補完実施後、各項目について欠損が生じていないことも確認すること。

df_product_4 <- df_product %>%
  nest(data = - category_small_cd) %>%
  mutate(
    data = map(
      data,
      ~ recipe(.x) %>%
        step_medianimpute(unit_price, unit_cost) %>%
        prep() %>%
        juice()
    )
  ) %>%
  unnest(cols = data) %T>%
  {(nrow(df_product) - nrow(.)) %>% print}

カテゴリ毎の欠損値処理。
dplyr::group_byした後R-081と同じようにすれば行けるかと思いきやこれではグループ毎に欠損値処理されない。
なのでtidyr::nestでカテゴリー毎にネストしたデータフレームにpurrr::mapでそれぞれrecipes::step_medianimputeした後tidyr::unnestで展開し元に戻す。

tidyr::replace_naを使う場合もやはりdplyr::group_byによる分割はできないのでtidyr::nestを使い、以下のようになる。

df_product_4 <- df_product %>%
  nest(data = - category_small_cd) %>%
  mutate(
    data = map(
      data,
      ~ .x %>%
        replace_na(list(unit_price = median(.$unit_price, na.rm = T) %>% round, unit_cost = median(.$unit_cost, na.rm = T) %>% round))
    )
  ) %>%
  unnest(cols = data) %T>%
  {(nrow(df_product) - nrow(.)) %>% print}

R-087

R-087: 顧客データフレーム（df_customer）では、異なる店舗での申込みなどにより同一顧客が複数登録されている。名前（customer_name）と郵便番号（postal_cd）が同じ顧客は同一顧客とみなし、1顧客1レコードとなるように名寄せした名寄顧客データフレーム（df_customer_u）を作成せよ。ただし、同一顧客に対しては売上金額合計が最も高いものを残すものとし、売上金額合計が同一もしくは売上実績の無い顧客については顧客ID（customer_id）の番号が小さいものを残すこととする。

df_customer_u <- df_customer %>%
  left_join(df_receipt, by = 'customer_id') %>%
  group_by(across(names(df_customer))) %>%
  summarise(amount_all = amount %>% sum(), .groups = 'drop') %>%
  group_by(customer_name, postal_cd) %>%
  arrange(customer_id, amount_all %>% desc) %>%
  distinct(customer_name, .keep_all = T) %>%
  ungroup()

条件による行選択の問題。複数の条件で並べ替えた後でdplyr::distinctで重複削除することで一件選択している。
このようなとき同じように使える関数としてdplyr::slice_headもあり、こちらは抽出する件数を設定できる。

df_receiptからはamount列だけ必要なので、結合に必要なcustomer_id列とamount列だけをdplyr::selectしてからjoinしても良いのだけど、どうせ後でdplyr::summariseするので列を絞らずにjoinし、その後dplyr::group_byでdf_customerの全部の列を指定することでdf_customer元々の列を保護した。

R-090

R-090: レシート明細データフレーム（df_receipt）は2017年1月1日〜2019年10月31日までのデータを有している。売上金額（amount）を月次で集計し、学習用に12ヶ月、テスト用に6ヶ月のモデル構築用データを3セット作成せよ。

splits_receipt <- df_receipt %>%
  mutate(sales_month = sales_ymd %>% as.character %>% as_date %>% format('%Y-%m')) %>%
  group_by(sales_month) %>%
  summarise(amount = amount %>% sum) %>%
  arrange(sales_month) %>%
  rolling_origin(initial = 12, assess = 6, skip = 5, cumulative = F)

df_amount_train_1 <- splits_receipt %>% use_series(splits) %>% extract2(1) %>% analysis
df_amount_train_2 <- splits_receipt %>% use_series(splits) %>% extract2(2) %>% analysis
df_amount_train_3 <- splits_receipt %>% use_series(splits) %>% extract2(3) %>% analysis

df_amount_test_1 <- splits_receipt %>% use_series(splits) %>% extract2(1) %>% assessment
df_amount_test_2 <- splits_receipt %>% use_series(splits) %>% extract2(2) %>% assessment
df_amount_test_3 <- splits_receipt %>% use_series(splits) %>% extract2(3) %>% assessment

時系列データを分割する問題。
tidymodelsに含まれるrsample::rolling_originが使える。rsample::analysisで学習用データを、rsample::assessmentでテスト用データを取り出す。

上記の例ではmagrittr::use_seriesとmagrittr::extract2を使って要素を指定している。

R-091

R-091: 顧客データフレーム（df_customer）の各顧客に対し、売上実績のある顧客数と売上実績のない顧客数が1:1となるようにアンダーサンプリングで抽出せよ。

df_customer %>%
  left_join(df_receipt %>% select(customer_id, amount), by = 'customer_id') %>%
  group_by(across(- amount)) %>%
  summarise(amount_bool = amount %>% sum(na.rm = T) %>% {if_else(. > 0, 1, 0)} %>% as_factor(), .groups = 'drop') %>%
  recipe() %>%
  step_downsample(amount_bool) %>%
  prep() %>%
  juice() %T>%
  {group_by(., amount_bool) %>% summarise(n = n()) %>% print()}

アンダーサンプリングの問題。
tidymodelsに含まれるrecipes::step_downsampleが使えるのだが、公式解答例にも書かれているようにsoft-deprecatedになっており、themis::step_downsampleを代わりに使うようにメッセージが出る。
しかしthemisは今回のコンテナにインストールされていなかったので公式の解答例と同じくrecipes::step_downsamplをそのまま使った。

factor型への変換時にはforcats::as_factorを使うようにしている。

なおR-087と違って列を絞ってから結合しているが、そこの違いに特に意図はない。どちらが良いのでしょう？

R-093

R-093: 商品データフレーム（df_product）では各カテゴリのコード値だけを保有し、カテゴリ名は保有していない。カテゴリデータフレーム（df_category）と組み合わせて非正規化し、カテゴリ名を保有した新たな商品データフレームを作成せよ。

df_product_n <- df_product %>%
  left_join(df_category %>% select(category_major_cd, ends_with('name')), by = 'category_major_cd') %T>%
  {head(.) %>% print}

テーブルを結合して非正規化する問題。
df_categoryの内、カテゴリ名である列名の末尾に'name'の付く列だけ追加したいので、dplyr::end_withで指定してやると早い。

R-095

R-095: 先に作成したカテゴリ名付き商品データを以下の仕様でファイル出力せよ。なお、出力先のパスはdata配下とする。

• ファイル形式はCSV（カンマ区切り）
• ヘッダ有り
• 文字コードはCP932

df_product_n %>% write.csv('/home/jovyan/work/data/R_df_product_full_CP932_header.csv', fileEncoding = 'CP932')

データフレームをcsvファイルに出力する問題。
普段はreadr::write_csvの方を使っているのだが、文字コードをUTF-8から変更できないので標準のutils::write.csvを使った。
今回VSCodeのPython拡張からJupyterに接続してやっていたところワーキングディレクトリが変なところにあったので、絶対パスで保存場所を指定した。

感想

思っていたよりかなり大変だったが、様々な面で勉強になりとても良かった。
残るPythonとSQLについてもやっていきたい。いつ終わるのかは分からないが……。