R语言学习：tidyquery包，R4DS书籍练习题解决方案，热图，STAT454，EDA模板

# tidyquery R数据框运行SQL查询
# 两个函数
# query() 用于执行在R数据框里面运行SQL查询语句
# show_dplyr() 用于把SQL语句转换为dplyr包
library(tidyverse)
library(tidyquery)
library(nycflights13)
query(
  " SELECT origin, dest,
    COUNT(flight) AS num_flts,
    round(SUM(seats)) AS num_seats,
    round(AVG(arr_delay)) AS avg_delay
  FROM flights f LEFT OUTER JOIN planes p
    ON f.tailnum = p.tailnum
  WHERE distance BETWEEN 200 AND 300
    AND air_time IS NOT NULL
  GROUP BY origin, dest
  HAVING num_flts > 3000
  ORDER BY num_seats DESC, avg_delay ASC
  LIMIT 2;"
)

# 查询语句与管道操作和dplyr做结合使用
planes %>%
  filter(engine == "Turbo-fan") %>%
  query("SELECT manufacturer AS maker, COUNT(*) AS num_planes GROUP BY maker") %>%
  arrange(desc(num_planes)) %>%
  head(5)

# show_dplyr()函数举例
# SQL语句转换为dplyr的表示形式
show_dplyr(
  " SELECT manufacturer, 
    COUNT(*) AS num_planes
  FROM planes
  WHERE engine = 'Turbo-fan'
  GROUP BY manufacturer
  ORDER BY num_planes DESC;"
)

# 热图绘制
# tidyHeatmap包的安装操作
install.packages("BiocManager")
BiocManager::install("ComplexHeatmap")
install.packages("tidyHeatmap")

# tidyHeatmap包的使用举例

# 1 数据获取和表示
library(tidyHeatmap)
library(tidyverse)

mtcars_tidy <- 
  mtcars %>%  
  as_tibble(rownames="Car name") %>% 

  # Scale
  mutate_at(vars(-`Car name`, -hp, -vs), scale) %>% 

  # tidyfy
  pivot_longer(cols = -c(`Car name`, hp, vs), names_to = "Property", values_to = "Value")

mtcars_tidy

# 2 热图可视化
mtcars_heatmap <- 
  mtcars_tidy %>% 
  heatmap(`Car name`, Property, Value ) %>% 
  add_tile(hp)
mtcars_heatmap

# 3 图片保存
mtcars_heatmap %>%  save_pdf("./figs/mtcars_heatmap.pdf")


# 4 分组热图
mtcars_tidy  %>%  
  group_by(vs)  %>% 
  heatmap(`Car name`, Property, Value )  %>% 
  add_tile(hp)

# 每个组做配色处理
mtcars_tidy  %>%  
  group_by(vs)  %>% 
  heatmap(
    `Car name`, Property, Value ,
    palette_grouping = list(c("#66C2A5", "#FC8D62"))
  )  %>% 
  add_tile(hp)


mtcars_tidy  %>%  
  heatmap(`Car name`, Property, Value )  %>% 
  split_rows(2)  %>% 
  split_columns(2)

# 使用Kmeans做行聚类和列聚类
mtcars_tidy  %>%  
  heatmap(
    `Car name`, Property, Value ,
    row_km = 2,
    column_km = 2
  ) 

# 自定义调色板
# 字符串或者16进制
mtcars_tidy  %>%  
  heatmap(
    `Car name`, 
    Property, 
    Value,
    palette_value = c("red", "white", "blue")
  )

mtcars_tidy  %>%  
  heatmap(
    `Car name`, 
    Property, 
    Value,
    palette_value = circlize::colorRamp2(
      seq(-2, 2, length.out = 11), 
      RColorBrewer::brewer.pal(11, "RdBu")
    )
  )

mtcars_tidy %>% 
  heatmap(
    `Car name`, 
    Property, 
    Value,
    palette_value = circlize::colorRamp2(c(-2, -1, 0, 1, 2), viridis::magma(5))
  )

# 多个分组和标注
tidyHeatmap::pasilla  %>% 
  group_by(location, type) %>% 
  heatmap(
    .column = sample,
    .row = symbol,
    .value = `count normalised adjusted`
  )  %>% 
  add_tile(condition)  %>% 
  add_tile(activation)

pasilla_plus <- 
  tidyHeatmap::pasilla  %>% 
  dplyr::mutate(act = activation)  %>%  
  tidyr::nest(data = -sample)  %>% 
  dplyr::mutate(size = rnorm(n(), 4,0.5))  %>% 
  dplyr::mutate(age = runif(n(), 50, 200))  %>% 
  tidyr::unnest(data) 
pasilla_plus %>% View

pasilla_plus  %>% 
  heatmap(
    .column = sample,
    .row = symbol,
    .value = `count normalised adjusted`
  )  %>% 
  add_tile(condition)  %>% 
  add_point(activation)  %>% 
  add_tile(act)  %>% 
  add_bar(size)  %>% 
  add_line(age)


library(forcats)
mtcars_tidy  %>%  
  mutate(`Car name` = fct_reorder(`Car name`, `Car name`, .desc = TRUE)) %>% 
  heatmap(
    `Car name`, Property, Value, 
    cluster_rows = FALSE
  ) 

# p_load loads and, if necessary, install missing packages.
# install.packages() + library() = p_load()
# If you just want to install, then use p_install()
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
  tidyverse, # for the tidyverse framework
  palmerpenguins,
  gapminder, 
  kableExtra, 
  flextable,
  modelr,
  nycflights13 
  )