R数据科学-3

---

R数据科学（R for Data Science）

Part 3：编程

---

转换——可视化——模型

--------------第13章 使用magrittr进行管道操作--------------------

library(tidyverse)

#管道不能支持以下函数：
#①使用当前环境的函数：如assign/get/load
assign("x",10)
x
"x" %>% assign(100) # 这里的赋值是由%>% 建立的临时环境进行的
env <- environment()
"x" %>% assign(100,envir = env) #指定环境实现赋值

#②惰性求值的函数：如tryCatch(捕获并处理程序错误)/try/suppresMessages/suppressWarnings
tryCatch(stop("!"),error=function(e)"an error")
stop("!") %>% tryCatch(error=function(e)"an error")

#管道不适用情形：
  #操作步骤太多，如10个以上
  #有多个输入输出
  #步骤有复杂依赖关系

-----------------第14章 函数-------------------------------------

#一段代码复制粘贴超过2次，就应该考虑写一个函数

#创建一个函数名称
#列出函数输入，即参数
#将已经编好的代码放在函数体中
#简单输入测试

rescale01 <- function(x){
  rng <- range(x,na.rm = T,finite=T)
  (x-rng[1])/(rng[2]-rng[1])
}
rescale01(c(1,2,3.4,NA))

#函数名最好是动词，参数一般是名词
?`if` #获取if帮助
#if条件操作符组合 || && ，不同于向量化操作符| &
#常用条件：== all() any() identical()
identical(0L,0) #很严格,类型需一致
x <- sqrt(2)^2
x==2
x-2
dplyr::near(x,2)

#多重条件:
# if()else if()else
# switch()

#参数两类：数据；细节
#使用近似正态分布计算均值两端的置信区间
mean_ci <- function(x,conf = 0.95){
  se <- sd(x) / sqrt(length(x))
  alpha <- 1-conf
  mean(x)+se*qnorm(c(alpha/2,1-alpha/2))
}
x <- runif(100)
mean_ci(x)
mean_ci(x,conf = 0.99)

#检查参数:stop函数
wt_mean <- function(x,w){
  if(length(x)!=length(w)){
    stop("`x` and `w` must be the same length",call. = F)
  }
  sum(w*x)/sum(x)
}

#内置函数:stopifnot
wt_mean <- function(x, w, na.rm = FALSE){
  stopifnot(is.logical(na.rm),length(na.rm) == 1)
  stopifnot(length(x) == length(w))
  if(na.rm){
    miss <- is.na(x) | is.na(w)
    x <- x[!miss]
    w <- w[!miss]
  }
  sum(w * x) / sum(x)
}

wt_mean(1:4,1:6,na.rm = T)
wt_mean(1:6,1:6,na.rm = "foo")
wt_mean(1:5,1:5,na.rm = F)

#捕获任意数量的未匹配参数...
commas <- function(...)stringr::str_c(...,collapse = ", ")
commas(letters[1:10])

#返回值
#显示返回return（有节制的使用，用于提前返回，一般都是比较简单的情况）
complicated_fun <- function(x,y,z){
  if(length(x)==0 || length(y)==0){
    return(0)
  }
  #这里是复杂代码
}

f <- function(){
  if(!x){
    return("this is not correct")
  }
  #这里是长的复杂代码
}

#使函数支持管道操作
#环境

--------------第15章 向量------------------------------------------------

typeof(letters)
typeof(1:10)
typeof(1)
typeof(1L)

1:10 %% 3 == 0

pryr::object_size(x) #占内存空间大小
pryr::object_size(mtcars)

#对象的特性：如名称、维度、类
x <- 1:10
attr(x,"greeting")
attr(x,"greeting") <- "hi" #设置特性
attr(x,"farewell") <- "bye"
attributes(x)

##泛型函数是R实现面向对象编程的关键，根据不同的输入类型采用不同函数操作。类用来控制泛型函数的运行方式。
as.Date
methods("as.Date")
getS3method("as.Date","default") #查看该方法的实现形式
getS3method("as.Date","numeric")

#最重要的S3泛型函数print()

#基础向量：原子向量和列表
#扩展向量：具有附加特性，包括类。如因子、日期、日期时间、tibble

x <- factor(c("a","b","c"),levels = c("one","two","three"))
typeof(x)
attributes(x)

x <- as.Date("2019-04-14")
unclass(x)
typeof(x)
attributes(x)

x <- lubridate::ymd_hm("1970-01-01 01:00")
unclass(x)
typeof(x)
attributes(x)

tb <- tibble(x=1:5,y=5:1)
typeof(tb)
attributes(tb) #tibble的类继承了data.frame

df <- data.frame(x=1:5,y=5:1)
typeof(df)
attributes(df)

---------------第16章 使用purrr实现迭代----------------------------

#同函数一样，迭代目的也是为减少重复代码
#迭代有命令式编程（for/while循环）和函数式编程

#1.for循环
df <- tibble(a=rnorm(10),
             b=rnorm(10),
             c=rnorm(10),
             d=rnorm(10))
df
#如计算每列的中位值
output <- vector("double",ncol(df)) #输出分配空间，vector函数logical/interger/double/character+长度
for (i in seq_along(df)) { #序列：确定哪些值进行循环
  output[[i]] <- median(df[[i]]) #循环体：执行具体操作代码
}
output

output <- c() #每次迭代都用c()来保存结果，对于大处理速度会很慢
for (i in seq_along(df)) { #seq_along(df)等同于1:ncol(df)
  output[[i]] <- median(df[[i]]) #循环体   #要向量化
}
output
#在所有for循环中使用的都是[[]]，原子向量也是，明确处理的是单个元素

#确定flights数据集中每列的类型
output <- vector("list",ncol(flights))
names(output) <- names(flights)
for (i in names(flights)) {
  output[[i]] <- class(flights[[i]])
}
output

#iris数据集中每列唯一值的数目
data("iris")
iris_uniq <- vector("double", ncol(iris))
names(iris_uniq) <- names(iris)
for (i in names(iris)) {
  iris_uniq[i] <- length(unique(iris[[i]]))
}
iris_uniq

#用均值分别为-10,0,10,100的正态分布生成10个随机数
n <- 10
mu <- c(-10,0,10,100)
output <- vector("list",length(mu))
for(i in seq_along(output)){
  output[[i]] <- rnorm(n,mean = mu[i])
}
output
#等于
matrix(rnorm(n * length(mu), mean = mu), ncol = n)

#2.for循环的变体
##1）修改现有对象，而不是创建新对象
df
#已经有输出，和输入是相同的
for(i in seq_along(df)){ #序列：数据框是数据列的列表
  df[[i]] <- rescale01(df[[i]]) #函数体
}
df

##2）使用名称或值进行迭代，而非索引
#使用元素循环：for(x in xs)，用于绘图或保存文件
#使用名称进行循环：for(nm in names(xs))：图表标题或文件名使用元素，x[[nm]]来访问元素值
results <- vector("list",length(x))
names(results) <- names(x)

#数值索引仍是最常用的方法，给定位置后，就可直接提取元素的名称和值
for(i in seq_along(x)){
  name <- names(x)[[i]]
  value <- x[[i]]
}

##3）处理未知长度的输出
#如模拟长度随机的向量，可通过逐渐增加向量长度的方式来实现
means <- c(0,1,2)
output <- double()
for(i in seq_along(means)){
  n <- sample(1:100,1)
  output <- c(output,rnorm(n,means[[i]]))
}
str(output)

#以上每次迭代都要赋值上次迭代的所有数据，并非高效
#最好先将结果保存在一个列表里，循环结束后再组合成一个新的向量：
out <- vector("list",length(means))
for(i in seq_along(means)){
  n <- sample(1:100,1)
  out[[i]] <- rnorm(n,means[[i]])
}
str(out)
str(unlist(out))

#同理，如果要生成一个很长的字符串，不要用paste函数将每次迭代结果与上次连接
#而是将每次迭代放在字符向量中，再用paste(output,collapse="")组合起来

#如果要生成一个很大的数据框，不要每次迭代用rbind函数
#而是每次迭代结果保存在列表中，最后再dplyr::bind_rows(output)组合

#用一个更复杂的对象来保存每次迭代结果，最后一次性组合起来

##4）处理未知长度的序列
#事先不知迭代次数，模拟时最常见，此时用while循环：
#如连续三次丢出正面向上的硬币所需的投掷次数
flip <- function()sample(c("T","H"),1)
flip <- 0
nheads <- 0
while (nheads<3) {
  if(flip()=="H"){
    nheads <- nheads+1
  }else{
    nheads <- 0
  }
  flips <- flips+1
}
flips
#??error:could not find function "flip"

#练习题：
#1.写一个循环批量读取一个目录下的csv文件，并加载到一个数据框
getwd()
files <- dir("data/",pattern = "\\.csv$",full.names = T)
out <- vector("list",length(files))
for(i in seq_along(files)){
  out[[i]] <- read.csv(files[[i]])
}
str(out)
df <- bind_rows(out)

#2.写一个函数，能输出iris数据框中所有数值列的均值及其名称，并使数值能整齐排列
head(iris)
show_mean <- function(df, digits = 2) {
  # Get max length of all variable names in the dataset
  maxstr <- max(str_length(names(df)))
  for (nm in names(df)) {
    if (is.numeric(df[[nm]])) {
      cat(
        str_c(str_pad(str_c(nm, ":"), maxstr + 1L, side = "right"),
              format(mean(df[[nm]]), digits = digits, nsmall = digits),
              sep = " "
        ),
        "\n"
      )
    }
  }
}
show_mean(iris)

#函数式编程：将for循环包装在函数中，再调用函数
#将函数作为参数传入另一个函数中

#编写一个函数计算数据框每列均值、中位数、标准差等
col_summary <- function(df,fun){
  out <- vector("double",length(df))
  for(i in seq_along(df)){
    out[i] <- fun(df[[i]])
  }
  out
}

df <- tibble(
  a=rnorm(10),
  b=rnorm(10),
  c=rnorm(10),
  d=rnorm(10)
)
col_summary(df,median)
col_summary(df,mean)
col_summary(df,sd)

#映射函数：处理列表、数据框
#类似基础函数apply族函数：计算每列
map(df,mean) #返回列表
map_dbl(df,sd) #返回双精度向量
map_chr(df,mean) #返回字符向量

map_int()#返回整型向量
map_lgl() #返回逻辑向量

#map函数可加参数：
map_dbl(df,mean,trim=0.5)

#快捷方式.f
models <- mtcars %>%
  split(.$cyl) %>%
  map(function(df) lm(mpg~wt,data=df))
#等于
models <- mtcars %>%
  split(.$cyl) %>%
  map(~lm(mpg~wt,data=.)) #.表示当前列表元素

models %>% map(summary) %>% map_dbl(~.$r.squared)
models %>% map(summary) %>% map_dbl("r.squared")

x <- list(list(1,2,3),list(4,5,6),list(7,8,9))
x %>% map_dbl(2) #按位置选取元素

#对操作失败的处理
safely()#类似基础函数try()
safe_log <- safely(log)
str(safe_log(10))
str(safe_log("a"))
#修饰函数
possibly()/quietly()

#多参数映射：map2()/pmap()
#模拟几个均值不等的随机正态分布
mu <- list(5,10,-3)
mu %>% map(rnorm,n=5) %>% str
#再加个参数，让标准差也不同
sigma <- list(1,5,10)
map2(mu,sigma,rnorm,n=5) %>% str

#如果再加一个样本数参数呢？可用列表/数据框作为参数传入
n <- list(1,3,5)
args1 <- list(n,mu,sigma)
args1 %>% pmap(rnorm) %>% str

#使用命名参数无需按位置对应，更为安全
args2 <- list(mean=mu,sd=sigma,n=n)
args2 %>% pmap(rnorm) %>% str

#游走函数：重在操作过程，而非返回值
x <- list(1,"a",3)
x %>% walk(print)

#预测函数
#keep/discard保留输入值中预测值为TRUE/FALSE的元素
iris %>% keep(is.factor) %>% str
iris %>% discard(is.factor) %>% str

#some/every确定预测值是否对某个元素/所有元素为真
x <- list(1:5,letters,list(10))
x %>% some(is_character)
x %>% every(is_vector)

#detect/detect_index找出预测值为真的第一个元素/索引
x <- sample(10)
x
x %>% detect(~.>5)
x %>% detect_index(~.>5)

#head_while/tail_while从向量的开头/结尾找出预测值为真的元素
x %>% head_while(~.>5)
x %>% tail_while(~.>5)

#归约函数reduce
#尤其适合多个数据框合并，多个向量取交集等情况
dfs <- list(
  age=tibble(name="jianxiang",age=18),
  sex=tibble(name=c("jianxiang","siyuan"),sex=c("M","F")),
  trt=tibble(name="siyuan",treatment="A")
)
dfs %>% reduce(full_join)

vs <- list(c(1:5),c(3:8),c(4:10))
vs %>% reduce(intersect)

#累计函数accumulate，会保留所有累计中间结果
x <- sample(10)
x
x %>% accumulate(`+`)

#练习
#将摘要函数应用于数据框的每个数值列：
col_sum2 <- function(df, f, ...) {
  map(keep(df, is.numeric), f, ...)
}