R语言学习：长宽数据转换、研究生学习R指南、特征重要性分析、文件合并

library(tidyr)
library(magrittr)

# 1 长数据--> 宽数据
fish_encounters %>% View
names(fish_encounters)
sapply(fish_encounters, class)
fish_encounters %>% 
  pivot_wider(names_from = station,
              values_from = seen) %>% 
  View

# 参数values_fill进行缺失值处理
fish_encounters %>% 
  pivot_wider(names_from = station,
              values_from = seen,
              values_fill = 0) %>% 
  View

# 值的来源，也可以是多个变量
us_rent_income %>% View
names(us_rent_income)
us_rent_income %>% 
  pivot_wider(names_from = variable,
              values_from = c(estimate, moe)) %>% 
  View

# 2 宽数据-->长数据
relig_income %>% View
names(relig_income)
sapply(relig_income, class)

relig_income %>% 
  pivot_longer(-religion,
               names_to = "income",
               values_to = "count") %>% 
  View

# R包
library(readxl)
library(dplyr)
library(ggplot2)
library(randomForest)
library(varImp)
library(caret)

# 数据导入
df <- read_excel("./raw_data/cpi.xlsx")
names(df)
# 构建RF模型
rf <- train(CPI ~ funding_rate+exchange_rate+CDS, 
            data = df,
            method = "rf",
            trControl = trainControl(method = "oob"),
            importance = TRUE,
            verbose = TRUE)

i_scores <- varImp(rf$finalModel, conditional=TRUE)
i_scores <- i_scores %>% tibble::rownames_to_column("var") 
i_scores$var<- i_scores$var %>% as.factor()

# 特征重要性可视化
i_bar <- ggplot(data = i_scores) + 
  geom_bar(
    stat = "identity",
    mapping = aes(x = var, y=Overall, fill = var), 
    show.legend = FALSE,
    width = 1
  ) + 
  labs(x = NULL, y = NULL)

i_bar + coord_polar() + theme_minimal()
i_bar + coord_flip() + theme_minimal()

data <- data.frame(actual=c(44, 47, 34, 47, 58, 48, 46, 53, 32, 37, 26, 24),
                   pred=c(44, 40, 46, 43, 46, 58, 45, 44, 53, 30, 32, 23))

data
# 计算方法1
mean(abs((data$actual-data$pred)/data$actual)) * 100

# 计算方法2
library(MLmetrics)
MAPE(data$pred, data$actual) * 100

graphics.off()
rm(list = ls())
path<- file.path(getwd())

v.filename <- list.files(
  path, pattern="\.(csv|txt)$", 
  ignore.case = TRUE, 
  full.names = FALSE)

# 方式一
df.all <- do.call(
  rbind, lapply(v.filename, 
                function(x) read.csv(x)))
print(df.all)

# 方式二
library(vroom)
df.all.vroom <- vroom(v.filename)
print(df.all.vroom)

library(tibble)

df <- data.frame(A = c(1, 2, 3), B = c(10, 20, 30))
row.names(df) <- c("A", "B", "C")

(df)

df <- df %>% tibble::rownames_to_column("row_name")
(df)

mix_func <- function(a, b, c) {
  a + b * c
}

x <-  c(1,5,10)
sapply(x, mix_func, a = 1, b = 2)

options(warn = -1)
options(scipen = 999)

library(tidyverse)
library(ggbeeswarm)
library(tidymodels)

# 01 数据合规性分析
# 2021年9月1日数据安全法实施
# 数据合规性监管
# GDPR 通用数据保护条例


write_csv(gdpr_raw, './raw_data/gdpr_raw.csv')
gdpr_raw

# 探索数据
# 1) 罚款的分布
# 严重有偏数据，采用对数变换，正态分布或者近似正态分布
gdpr_raw %>%
  ggplot(aes(price + 1)) +
  geom_histogram(fill = "midnightblue", alpha = 0.7) +
  scale_x_log10(labels = scales::dollar_format(prefix = "€")) +
  labs(x = "GDPR fine (EUR)", y = "GDPR violations") +
  theme_classic()

gdpr_raw %>%
  ggplot(aes(price + 1)) +
  geom_histogram(fill = "midnightblue", alpha = 0.7) +
  labs(x = "GDPR fine (EUR)", y = "GDPR violations") +
  theme_classic()

# 数据整洁
# 数据嵌套操作的处理 unnest
# 数据生成新的列 transmute
# 函数化编程 map系列函数

gdpr_tidy <- gdpr_raw %>%
  transmute(id,
            price,
            country = name,
            article_violated,
            articles = str_extract_all(article_violated, "Art.[:digit:]+|Art. [:digit:]+")
  ) %>%
  mutate(total_articles = map_int(articles, length)) %>% 
  unnest(articles) %>% 
  add_count(articles) %>% 
  filter(n > 10) %>%
  select(-n)

gdpr_tidy

gdpr_tidy %>%
  dplyr::mutate(
    articles = str_replace_all(articles, "Art. ", "Article "),
    articles = fct_reorder(articles, price)
  ) %>%
  ggplot(aes(articles, price + 1, color = articles, fill = articles)) +
  geom_boxplot(alpha = 0.2, outlier.colour = NA) +
  geom_quasirandom() +
  scale_y_log10(labels = scales::dollar_format(prefix = "€")) +
  labs(
    x = NULL, y = "GDPR fine (EUR)",
    title = "GDPR fines levied by article",
    subtitle = "For 250 violations in 25 countries"
  ) +
  theme(legend.position = "none")

# 模型构建
gdpr_violations <- gdpr_tidy %>%
  mutate(value = 1) %>%
  select(-article_violated) %>% 
  pivot_wider(
    names_from = articles, values_from = value,
    values_fn = list(value = max), values_fill = list(value = 0)
  ) %>% 
  janitor::clean_names()

gdpr_violations %>% View

gdpr_rec <- recipe(price ~ ., data = gdpr_violations) %>%
  update_role(id, new_role = "id") %>%
  step_log(price, base = 10, offset = 1, skip = TRUE) %>%
  step_other(country, other = "Other") %>%
  step_dummy(all_nominal()) %>%
  step_zv(all_predictors())

gdpr_prep <- prep(gdpr_rec)

gdpr_prep

gdpr_wf <- workflow() %>%
  add_recipe(gdpr_rec) %>%
  add_model(linear_reg() %>%
              set_engine("lm"))

gdpr_wf

gdpr_fit <- gdpr_wf %>%
  fit(data = gdpr_violations)

gdpr_fit

# 数据结果展示
gdpr_fit %>%
  pull_workflow_fit() %>%
  tidy() %>%
  arrange(estimate) %>%
  knitr::kable()


# 探索模型结果
# 生成测试样例数据集
new_gdpr <- crossing(
  country = "Other",
  art_5 = 0:1,
  art_6 = 0:1,
  art_13 = 0:1,
  art_15 = 0:1,
  art_32 = 0:1
) %>%
  mutate(
    id = row_number(),
    total_articles = art_5 + art_6 + art_13 + art_15 + art_32
  )

new_gdpr %>% View

# 模型应用和预测
mean_pred <- predict(gdpr_fit,
                     new_data = new_gdpr
)

conf_int_pred <- predict(gdpr_fit,
                         new_data = new_gdpr,
                         type = "conf_int"
)

gdpr_res <- new_gdpr %>%
  bind_cols(mean_pred) %>%
  bind_cols(conf_int_pred)

gdpr_res %>% View


# 违反每种类型下GDPR罚款预期
gdpr_res %>%
filter(total_articles == 1) %>%
  pivot_longer(art_5:art_32) %>%
  filter(value > 0) %>%
  mutate(
    name = str_replace_all(name, "art_", "Article "),
    name = fct_reorder(name, .pred)
  ) %>%
  ggplot(aes(name, 10^.pred, color = name)) +
  geom_point(size = 3.5) +
  geom_errorbar(aes(
    ymin = 10^.pred_lower,
    ymax = 10^.pred_upper
  ),
  width = 0.2, alpha = 0.7
  ) +
  labs(
    x = NULL, y = "Increase in fine (EUR)",
    title = "Predicted fine for each type of GDPR article violation",
    subtitle = "Modeling based on 250 violations in 25 countries"
  ) +
  scale_y_log10(labels = scales::dollar_format(prefix = "€", accuracy = 1)) +
  theme(legend.position = "none")