第8章: readr

library(readr) library(dplyr) # サンプルCSVデータの作成 sample_csv_content <- "name,age,salary,department,hire_date 田中太郎,28,450000,営業,2020-04-01 佐藤花子,32,520000,開発,2019-03-15 鈴木一郎,45,780000,マネジメント,2015-07-20 高橋美咲,25,380000,デザイン,2021-09-10 山田健太,39,650000,開発,2017-11-05" # 文字列から直接読み込み employee_data <- read_csv(sample_csv_content) print(employee_data) # データ型の確認 str(employee_data) # 列の型を明示的に指定 employee_data_typed <- read_csv(sample_csv_content, col_types = cols( name = col_character(), age = col_integer(), salary = col_double(), department = col_character(), hire_date = col_date() ) ) print("型指定後のデータ:") str(employee_data_typed)

# TSVファイルの読み込み tsv_content <- "name\tage\tsalary\tdepartment 田中太郎\t28\t450000\t営業 佐藤花子\t32\t520000\t開発 鈴木一郎\t45\t780000\tマネジメント" tsv_data <- read_tsv(tsv_content) print(tsv_data) # カスタム区切り文字のファイル custom_delim_content <- "name|age|salary|department 田中太郎|28|450000|営業 佐藤花子|32|520000|開発 鈴木一郎|45|780000|マネジメント" custom_data <- read_delim(custom_delim_content, delim = "|") print(custom_data) # 固定幅ファイルの読み込み fixed_width_content <- "田中太郎 28450000営業 佐藤花子 32520000開発 鈴木一郎 45780000マネジメント" fixed_data <- read_fwf(fixed_width_content, fwf_widths(c(8, 2, 6, 8), c("name", "age", "salary", "department")) ) print(fixed_data) # ヘッダーなしファイルの読み込み no_header_content <- "田中太郎,28,450000,営業 佐藤花子,32,520000,開発 鈴木一郎,45,780000,マネジメント" no_header_data <- read_csv(no_header_content, col_names = c("name", "age", "salary", "department") ) print(no_header_data)

# 欠損値を含むデータ messy_data_content <- "name,age,salary,department,rating 田中太郎,28,450000,営業,4.5 佐藤花子,,520000,開発,N/A 鈴木一郎,45,NULL,マネジメント,5.0 高橋美咲,25,380000,,4.2 山田健太,invalid,650000,開発,3.8" # 欠損値の指定 messy_data <- read_csv(messy_data_content, na = c("", "NA", "N/A", "NULL", "invalid") ) print(messy_data) print(paste("欠損値の数:", sum(is.na(messy_data)))) # 型変換の問題を確認 parsing_problems <- problems(messy_data) if (nrow(parsing_problems) > 0) { print("パース問題:") print(parsing_problems) } # 安全な型指定 safe_data <- read_csv(messy_data_content, col_types = cols( name = col_character(), age = col_integer(), salary = col_double(), department = col_character(), rating = col_double() ), na = c("", "NA", "N/A", "NULL", "invalid") ) print("安全に読み込んだデータ:") print(safe_data) # 欠損値パターンの分析 missing_summary <- safe_data %>% summarise_all(~ sum(is.na(.))) %>% pivot_longer(everything(), names_to = "column", values_to = "missing_count") print("列別欠損値数:") print(missing_summary)

# 日本語ロケールの設定 jp_locale <- locale( encoding = "UTF-8", decimal_mark = ".", grouping_mark = ",", date_format = "%Y-%m-%d", time_format = "%H:%M:%S" ) # 数値形式の異なるデータ numeric_data_content <- "product,price,quantity,date 製品A,\"1,250.50\",100,2023-12-01 製品B,\"2,350.75\",75,2023-12-02 製品C,\"890.25\",200,2023-12-03" # ロケール指定での読み込み numeric_data <- read_csv(numeric_data_content, locale = jp_locale) print(numeric_data) # 異なる日付形式への対応 date_format_content <- "event,date_jp,date_us,date_iso イベント1,2023/12/01,12/01/2023,2023-12-01 イベント2,2023/12/15,12/15/2023,2023-12-15 イベント3,2024/01/05,01/05/2024,2024-01-05" date_data <- read_csv(date_format_content, col_types = cols( event = col_character(), date_jp = col_date(format = "%Y/%m/%d"), date_us = col_date(format = "%m/%d/%Y"), date_iso = col_date() ) ) print(date_data) # 時刻データの処理 time_data_content <- "task,start_time,end_time,duration タスク1,09:30:00,11:45:30,02:15:30 タスク2,14:00:00,16:30:45,02:30:45 タスク3,10:15:30,12:00:00,01:44:30" time_data <- read_csv(time_data_content, col_types = cols( task = col_character(), start_time = col_time(), end_time = col_time(), duration = col_time() ) ) print(time_data) str(time_data)

# 大容量データのサンプル作成 set.seed(123) large_data_sample <- tibble( id = 1:10000, name = paste0("User_", sprintf("%05d", 1:10000)), category = sample(c("A", "B", "C", "D", "E"), 10000, replace = TRUE), value = rnorm(10000, 100, 20), date = sample(seq(as.Date("2023-01-01"), as.Date("2023-12-31"), by = "day"), 10000, replace = TRUE) ) # CSVファイルとして保存（実際のファイル処理をシミュレート） large_csv_content <- format_csv(large_data_sample) # 最初の数行だけ確認 print("大容量データの先頭行:") cat(substr(large_csv_content, 1, 300), "...") # チャンクサイズを指定した読み込み process_chunk <- function(chunk, pos) { # 各チャンクの統計を計算 chunk_stats <- chunk %>% group_by(category) %>% summarise( count = n(), avg_value = mean(value), max_value = max(value), .groups = 'drop' ) %>% mutate(chunk_pos = pos) return(chunk_stats) } # チャンク単位での処理（シミュレーション） chunk_size <- 2000 chunk_results <- list() for (i in seq(1, nrow(large_data_sample), by = chunk_size)) { end_idx <- min(i + chunk_size - 1, nrow(large_data_sample)) chunk <- large_data_sample[i:end_idx, ] chunk_result <- process_chunk(chunk, i) chunk_results[[length(chunk_results) + 1]] <- chunk_result } # チャンク結果の統合 combined_results <- bind_rows(chunk_results) %>% group_by(category) %>% summarise( total_count = sum(count), avg_value = weighted.mean(avg_value, count), max_value = max(max_value), chunks_processed = n_distinct(chunk_pos), .groups = 'drop' ) print("チャンク処理結果:") print(combined_results) # メモリ使用量の比較 print(paste("全データサイズ:", object.size(large_data_sample), "bytes")) print(paste("チャンクサイズ:", object.size(large_data_sample[1:chunk_size, ]), "bytes"))

# 型推定のスキップ（事前に型がわかっている場合） optimized_read <- function(content) { # 型を明示的に指定することで推定処理をスキップ read_csv(content, col_types = cols( id = col_integer(), name = col_character(), category = col_character(), value = col_double(), date = col_date() ), progress = FALSE # プログレスバーを無効化 ) } # 必要な列のみ読み込み selective_read <- function(content, selected_cols) { all_cols <- c("id", "name", "category", "value", "date") col_types_list <- list( id = col_integer(), name = col_character(), category = col_character(), value = col_double(), date = col_date() ) # 不要な列をスキップ skip_cols <- all_cols[!all_cols %in% selected_cols] for (col in skip_cols) { col_types_list[[col]] <- col_skip() } read_csv(content, col_types = do.call(cols, col_types_list)) } # 性能テストの例 print("最適化された読み込み（ID、カテゴリ、値のみ）:") optimized_data <- selective_read(large_csv_content, c("id", "category", "value")) print(head(optimized_data)) # データ変換と同時読み込み transform_on_read <- function(content) { read_csv(content, col_types = cols( id = col_integer(), name = col_character(), category = col_character(), value = col_double(), date = col_date() ) ) %>% mutate( value_category = case_when( value < 80 ~ "低", value < 120 ~ "中", TRUE ~ "高" ), is_weekend = lubridate::wday(date) %in% c(1, 7) ) } # 変換付き読み込みの例 print("変換付き読み込みの結果:") transformed_data <- transform_on_read(head(strsplit(large_csv_content, "\n")[[1]], 10) %>% paste(collapse = "\n")) print(transformed_data)

# 複数の月次ファイルをシミュレート create_monthly_sales <- function(month) { set.seed(month) tibble( month = month, product_id = paste0("P", sprintf("%03d", 1:50)), sales = round(rnorm(50, 1000 + month * 100, 200)), region = sample(c("北海道", "関東", "関西", "九州"), 50, replace = TRUE), date = as.Date(paste0("2023-", sprintf("%02d", month), "-15")) ) } # 12ヶ月分のデータを作成 monthly_files <- map(1:12, create_monthly_sales) names(monthly_files) <- paste0("sales_2023_", sprintf("%02d", 1:12), ".csv") # 各ファイルをCSV文字列に変換 csv_contents <- map(monthly_files, format_csv) # 各ファイルの読み込み関数 read_monthly_file <- function(csv_content, filename) { data <- read_csv(csv_content, col_types = cols( month = col_integer(), product_id = col_character(), sales = col_double(), region = col_character(), date = col_date() ), progress = FALSE ) %>% mutate(source_file = filename) return(data) } # 全ファイルを一括読み込み all_sales_data <- map2_dfr(csv_contents, names(csv_contents), read_monthly_file) # データの統合と検証 data_summary <- all_sales_data %>% group_by(month, region) %>% summarise( total_sales = sum(sales), avg_sales = mean(sales), product_count = n_distinct(product_id), .groups = 'drop' ) %>% arrange(month, region) print("統合データの要約:") print(head(data_summary, 10)) # データ品質チェック quality_check <- all_sales_data %>% summarise( total_records = n(), missing_sales = sum(is.na(sales)), duplicate_records = sum(duplicated(.)), unique_products = n_distinct(product_id), date_range = paste(min(date), "to", max(date)), files_processed = n_distinct(source_file) ) print("データ品質チェック:") print(quality_check)