第6章: forcats & purrr

# 顧客満足度調査データの作成 library(tidyverse) library(forcats) # サンプルデータ生成 survey_data <- tibble( customer_id = 1:1000, satisfaction = sample(c( "非常に不満", "不満", "普通", "満足", "非常に満足" ), 1000, replace = TRUE, prob = c(0.05, 0.15, 0.35, 0.35, 0.1)), product_category = sample(c( "スマートフォン", "ラップトップ", "タブレット", "ヘッドフォン", "スマートウォッチ", "その他" ), 1000, replace = TRUE), age_group = sample(c("18-24", "25-34", "35-44", "45-54", "55+"), 1000, replace = TRUE), purchase_amount = round(rnorm(1000, 50000, 20000), 0) ) # 因子化と順序設定 survey_data <- survey_data %>% mutate( # 満足度を順序付き因子に変換 satisfaction = factor(satisfaction, levels = c("非常に不満", "不満", "普通", "満足", "非常に満足"), ordered = TRUE), # 製品カテゴリを頻度でソート product_category = fct_infreq(product_category), # 年齢グループを論理的順序に age_group = fct_relevel(age_group, "18-24", "25-34", "35-44", "45-54", "55+") )

# 1. 稀なカテゴリを「その他」にまとめる lumped_data <- survey_data %>% mutate( # 上位3カテゴリのみ残して他は「その他」に product_simplified = fct_lump_n(product_category, 3, other_level = "その他商品") ) # 2. 満足度を3段階に再分類 recoded_data <- survey_data %>% mutate( satisfaction_simple = fct_recode(satisfaction, "不満" = "非常に不満", "不満" = "不満", "普通" = "普通", "満足" = "満足", "満足" = "非常に満足" ) ) # 3. 購入金額による満足度の順序変更 reordered_data <- survey_data %>% mutate( # 平均購入金額でソート age_group_by_spending = fct_reorder(age_group, purchase_amount, mean) ) # 結果確認 recoded_data %>% count(satisfaction, satisfaction_simple) %>% print()

library(purrr) library(rvest) library(httr) # 複数のECサイトの商品価格を取得する関数 scrape_product_price <- function(url) { # エラー処理を含む安全な実行 safe_scrape <- safely(function(url) { read_html(url) %>% html_nodes(".price") %>% html_text() %>% str_extract("[0-9,]+") %>% str_remove_all(",") %>% as.numeric() }) result <- safe_scrape(url) if(is.null(result$error)) { result$result } else { NA } } # 商品URL一覧（実際のサイトではない） product_urls <- c( "https://example-shop1.com/product/123", "https://example-shop2.com/item/456", "https://example-shop3.com/goods/789" ) # 並列処理で価格を一括取得 prices <- product_urls %>% map_dbl(scrape_product_price) %>% set_names(paste0("サイト", 1:3)) # 結果をデータフレームに整理 price_comparison <- tibble( site = names(prices), price = prices, url = product_urls ) %>% filter(!is.na(price)) %>% arrange(price)

# 複数地域の売上データ分析 sales_data <- tibble( region = rep(c("東京", "大阪", "名古屋", "福岡"), each = 100), month = rep(1:12, 33)[1:400], sales = rnorm(400, 1000000, 200000), marketing_spend = rnorm(400, 100000, 20000) ) # 地域別にデータをネスト化 nested_sales <- sales_data %>% group_by(region) %>% nest() # 各地域に対して回帰分析を実行 regression_results <- nested_sales %>% mutate( # 線形回帰モデルの作成 model = map(data, ~ lm(sales ~ marketing_spend, data = .x)), # モデルの統計サマリー summary = map(model, broom::glance), # 係数の抽出 coefficients = map(model, broom::tidy), # 予測値の計算 predictions = map2(model, data, ~ predict(.x, newdata = .y)), # R-squaredの抽出 r_squared = map_dbl(summary, ~ .x$r.squared), # マーケティング効果（係数）の抽出 marketing_effect = map_dbl(coefficients, ~ .x$estimate[2]) ) # 結果の可視化用データ results_summary <- regression_results %>% select(region, r_squared, marketing_effect) %>% arrange(desc(marketing_effect))

# 多言語アンケートデータの統合処理 multilingual_data <- list( japanese = tibble( satisfaction = sample(c("とても不満", "不満", "普通", "満足", "とても満足"), 200, TRUE), product = sample(c("製品A", "製品B", "製品C"), 200, TRUE), country = "Japan" ), english = tibble( satisfaction = sample(c("Very Unsatisfied", "Unsatisfied", "Neutral", "Satisfied", "Very Satisfied"), 150, TRUE), product = sample(c("Product A", "Product B", "Product C"), 150, TRUE), country = "USA" ), chinese = tibble( satisfaction = sample(c("非常不满", "不满", "一般", "满意", "非常满意"), 180, TRUE), product = sample(c("产品A", "产品B", "产品C"), 180, TRUE), country = "China" ) ) # 標準化のためのマッピング辞書 satisfaction_mapping <- list( japanese = c( "とても不満" = "Very Unsatisfied", "不満" = "Unsatisfied", "普通" = "Neutral", "満足" = "Satisfied", "とても満足" = "Very Satisfied" ), chinese = c( "非常不满" = "Very Unsatisfied", "不满" = "Unsatisfied", "一般" = "Neutral", "满意" = "Satisfied", "非常满意" = "Very Satisfied" ) ) product_mapping <- list( japanese = c("製品A" = "Product A", "製品B" = "Product B", "製品C" = "Product C"), chinese = c("产品A" = "Product A", "产品B" = "Product B", "产品C" = "Product C") ) # purrrとforcatsを組み合わせた標準化処理 standardized_data <- multilingual_data %>% imap_dfr(~ { language <- .y data <- .x # 満足度の標準化 if(language != "english") { data$satisfaction <- fct_recode(data$satisfaction, !!!satisfaction_mapping[[language]]) data$product <- fct_recode(data$product, !!!product_mapping[[language]]) } # 満足度を順序付き因子に data$satisfaction <- fct_relevel(data$satisfaction, "Very Unsatisfied", "Unsatisfied", "Neutral", "Satisfied", "Very Satisfied") data %>% mutate(language = language) }) # 国別・製品別の満足度分析 country_analysis <- standardized_data %>% group_by(country, product) %>% nest() %>% mutate( # 満足度の数値化（5段階評価） satisfaction_scores = map(data, ~ as.numeric(.x$satisfaction)), mean_score = map_dbl(satisfaction_scores, mean), median_score = map_dbl(satisfaction_scores, median), count = map_int(data, nrow) ) %>% select(-data, -satisfaction_scores) %>% arrange(desc(mean_score))

library(furrr) # 並列処理用 library(future) # 並列処理環境の設定 plan(multisession, workers = availableCores() - 1) # 大規模データの並列処理例 large_dataset <- map(1:10, ~ { tibble( group = .x, value = rnorm(100000), category = sample(letters[1:10], 100000, replace = TRUE) ) }) # 安全で高速な処理関数 safe_complex_analysis <- safely(function(data) { data %>% mutate(category = fct_lump_n(category, 5)) %>% group_by(category) %>% summarise( mean_value = mean(value), sd_value = sd(value), count = n(), .groups = "drop" ) }) # 並列処理での実行 results <- large_dataset %>% future_map(safe_complex_analysis, .progress = TRUE) %>% map("result") %>% compact() %>% # NULLの除去 imap_dfr(~ mutate(.x, group = .y)) # 関数合成の例 data_cleaner <- compose( ~ filter(.x, !is.na(value)), ~ mutate(.x, category = fct_drop(category)), ~ arrange(.x, category, value) ) cleaned_results <- results %>% data_cleaner()