R语言学习：字符串替换、tidy系列包、Bland-Altman图、RODBC包、UMAP降维

library(tidyverse)
# 第一组：str_replace和str_replace_all函数
# 选择采用什么内容来替换掉与模式匹配成功的字符

fruits <- c("one apple", "two pears", "three bananas")
(fruits)
str_replace(fruits, "[aeiou]", "-")
# 基于模式匹配成功后，替换掉满足要求首个字母

str_replace_all(fruits, "[aeiou]", "-")
# 基于模式匹配成功后，替换掉满足要求所有的字母

# 第二组：str_remove和str_remove_all
# 有点类似第一组，直接移除操作
library(tidyverse)
fruits <- c("one apple", "two pears", "three bananas")
(fruits)
str_remove(fruits, "[aeiou]")
str_remove_all(fruits, "[aeiou]")

# 数据准备
data <- data.frame(A=c(6, 5, 3, 5, 6, 6, 5, 4, 7, 8, 9,
                       10, 11, 13, 10, 4, 15, 8, 22, 5),
                   B=c(5, 4, 3, 5, 5, 6, 8, 6, 4, 7, 7, 11,
                       13, 5, 10, 11, 14, 8, 9, 4))
head(data)

# 数据处理
data$avg <- rowMeans(data)
data$diff <- data$A - data$B
head(data)

# 置信度计算
mean_diff <- mean(data$diff)
(mean_diff)
lower <- mean_diff - 1.96*sd(data$diff)
(lower)
upper <- mean_diff + 1.96*sd(data$diff)
(upper)

# 画Bland-Altman图
library(ggplot2)
library(showtext)
font_add("my_font1", "timesbd.ttf")  # my_font1赋予字体的名称，timesbd.ttf 为 Times New Roman粗体
showtext_auto()  # 全局自动使用
ggplot(data, aes(x = avg, y = diff)) +
  geom_point(size=2) +
  geom_hline(yintercept = mean_diff, size = 1.5) +
  geom_hline(yintercept = lower, color = "red", linetype="dashed", size=1.5) +
  geom_hline(yintercept = upper, color = "red", linetype="dashed", size=1.5) +
  ggtitle("Bland-Altman Plot") +
  ylab("Difference Between Instruments") +
  xlab("Average") + 
  theme_classic() +
  theme(
    axis.line.x = element_line(size = 1.5),
    axis.line.y = element_line(size = 1.5),
    plot.title = element_text(face = 'bold', family = "my_font1"),
    axis.title = element_text(face = 'bold', size = 15, family = 'my_font1'),
    axis.text = element_text(face = 'bold', size = 15, family = 'my_font1')
  )

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

# R包
library(tidyverse)
library(tidymodels)

# 数据导入
boston_cocktails <- readr::read_csv("./raw_data/boston_cocktails.csv")

# 数据探索
boston_cocktails %>% 
  count(ingredient, sort = TRUE)

# 数据清洗工作
# 把数据清洗干净
# 从行或者列入手
# 通常从列入手

cocktails_parsed <- boston_cocktails %>%
  mutate(
    ingredient = str_to_lower(ingredient),
    ingredient = str_replace_all(ingredient, "-", " "),
    ingredient = str_remove(ingredient, " liqueur$"),
    ingredient = str_remove(ingredient, " (if desired)$"),
    ingredient = case_when(
      str_detect(ingredient, "bitters") ~ "bitters",
      str_detect(ingredient, "lemon") ~ "lemon juice",
      str_detect(ingredient, "lime") ~ "lime juice",
      str_detect(ingredient, "grapefruit") ~ "grapefruit juice",
      str_detect(ingredient, "orange") ~ "orange juice",
      TRUE ~ ingredient
    ),
    measure = case_when(
      str_detect(ingredient, "bitters") ~ str_replace(measure, "oz$", "dash"),
      TRUE ~ measure
    ),
    measure = str_replace(measure, " ?1/2", ".5"),
    measure = str_replace(measure, " ?3/4", ".75"),
    measure = str_replace(measure, " ?1/4", ".25"),
    measure_number = parse_number(measure),
    measure_number = if_else(str_detect(measure, "dash$"),
                             measure_number / 50,
                             measure_number
    )
  ) %>%
  add_count(ingredient) %>%
  filter(n > 15) %>%
  select(-n) %>%
  distinct(row_id, ingredient, .keep_all = TRUE) %>%
  na.omit()

cocktails_parsed

# 把数据转换成用于建模的格式
cocktails_df <- cocktails_parsed %>%
  select(-ingredient_number, -row_id, -measure) %>%
  pivot_wider(names_from = ingredient, values_from = measure_number, values_fill = 0) %>%
  janitor::clean_names() %>%
  na.omit()

cocktails_df

# 无监督学习
# 主成分分析
# PCA

library(tidymodels)
pca_rec <- recipe(~., data = cocktails_df) %>%
  update_role(name, category, new_role = "id") %>%
  step_normalize(all_predictors()) %>%
  step_pca(all_predictors())

pca_prep <- prep(pca_rec)

pca_prep

# PCA数据可视化
tidied_pca <- tidy(pca_prep, 2)

tidied_pca %>%
  filter(component %in% paste0("PC", 1:5)) %>%
  mutate(component = fct_inorder(component)) %>%
  ggplot(aes(value, terms, fill = terms)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~component, nrow = 1) +
  labs(y = NULL)

library(tidytext)
# 获取每个主成分的Top8
tidied_pca %>%
  filter(component %in% paste0("PC", 1:4)) %>%
  group_by(component) %>%
  top_n(8, abs(value)) %>%
  ungroup() %>%
  mutate(terms = reorder_within(terms, abs(value), component)) %>%
  ggplot(aes(abs(value), terms, fill = value > 0)) +
  geom_col() +
  facet_wrap(~component, scales = "free_y") +
  scale_y_reordered() +
  labs(
    x = "Absolute value of contribution",
    y = NULL, fill = "Positive?"
  )

# 基于主成分的可视化分析
juice(pca_prep) %>%
  ggplot(aes(PC1, PC2, label = name)) +
  geom_point(aes(color = category), alpha = 0.7, size = 2) +
  geom_text(check_overlap = TRUE, hjust = "inward", family = "IBMPlexSans") +
  labs(color = NULL) +
  theme_classic()

# 无监督学习UMAP算法
# 拓扑结构数据分析
# 流形学习思想
library(embed)
umap_rec <- recipe(~., data = cocktails_df) %>%
  update_role(name, category, new_role = "id") %>%
  step_normalize(all_predictors()) %>%
  step_umap(all_predictors())

umap_prep <- prep(umap_rec)

umap_prep

# 基于UMAP的数据可视化
juice(umap_prep) %>%
  ggplot(aes(umap_1, umap_2, label = name)) +
  geom_point(aes(color = category), alpha = 0.7, size = 2) +
  geom_text(check_overlap = TRUE, hjust = "inward", family = "IBMPlexSans") +
  labs(color = NULL) +
  theme_classic()

# R 包
library(tidyverse)
library(readxl)
# 数据导入
df <- read_excel("./raw_data/fires_statistics.xlsx")

# 定制绘图函数
pic_Func <- function(data, country="Greece"){


  data %>% 
    .[.$country==country,] %>% 
    ggplot(aes(x=year))+
    geom_bar(aes(y=burnt_areas_ha),stat = "identity",fill="orange")+
    #Bar labels(burnt_areas_ha)
    geom_text(aes(y=burnt_areas_ha,label=burnt_areas_ha),vjust=-0.2,color="orange")+
    #multiplied by transformation rate to tune in with the main y-axis(Burnt Areas) 
    geom_line(aes(y=fires_number*100),size=2,color="lightblue")+
    #Line labels(fires_number)
    geom_text(aes(y=fires_number,label=fires_number),vjust=1,color="lightblue")+
    scale_x_continuous(breaks = seq(2009,2021,1))+

    scale_y_continuous(

      #for the main y-axis
      labels = scales::label_number_si(),
      breaks = scales::pretty_breaks(n=7),

      #for the second y-axis
      sec.axis = sec_axis(~./100,#divided by transformation rate, in order to be represented based on the first y-axis
                          name = "Number of Fires",
                          breaks = scales::pretty_breaks(7)),

    )+
    xlab("")+ylab("Burnt Areas(ha)")+
    ggtitle(paste("The comparison of the volume(ha) and numbers of Forest Fires in",
                  country))+
    theme_minimal()+
    theme(

      #Main y-axis
      axis.title.y = element_text(color = "orange",
                                  #puts distance with the main axis labels
                                  margin = margin(r=0.5,unit = "cm"),
                                  hjust = 1),#sets the main axis title top left

      #Second y-axis
      axis.title.y.right = element_text(color = "lightblue",
                                        #puts distance with the second axis labels
                                        margin = margin(l=0.5,unit = "cm"),
                                        hjust = 0.01),#sets the second axis title bottom right

      #adjusts the date labels to avoid overlap line numbers
      axis.text.x = element_text(angle = 30,
                                 vjust = 1,
                                 hjust = 1),

      panel.grid.minor = element_blank(),#removes the minor grid of panel
      plot.title=element_text(face = "bold.italic",hjust = 0.5)


    ) 

}

# 可视化
pic_Func(df, "Italy")