搜索
查看: 529|回复: 0

[R] 第16章

[复制链接]

31

主题

36

帖子

1020

积分

金牌会员

Rank: 6Rank: 6

积分
1020
发表于 2018-11-9 22:50:03 | 显示全部楼层 |阅读模式
# chapter 16
[AppleScript] 纯文本查看 复制代码
library(tidyverse)


# for 循环
[AppleScript] 纯文本查看 复制代码
df <- tibble(

  a = rnorm(10),

  b = rnorm(10),

  c = rnorm(10),

  d = rnorm(10)

)


# 计算每列的中位数
[AppleScript] 纯文本查看 复制代码
median(df$a)

median(df$b)

median(df$c)

median(df$d)


# 虽然能达到计算中位数的效果,但是反复黏贴,还是比较麻烦的
# 可以使用for循环
[AppleScript] 纯文本查看 复制代码
output <- vector("double",ncol(df))# 输出

for(i in seq_along(df)){# 序列

  output[[i]] <- median(df[[i]])# 循环体

}

output


# for 循环包括3个部分
#1 输出
# 开始循环前,为输出结果分配足够空间
# 创建给定长度的空向量一般使用vector()函数,有两个参数,向量类型+向量长度
#2 序列
# 确定哪些值用于进行循环,seq_along()和1:length()的作用相同,但更安全
#3 循环体
# 执行具体操作的代码

# for循环的变体
#1 修改现有对象,而非创建新对象
[AppleScript] 纯文本查看 复制代码
df <- tibble(

  a = rnorm(10),

  b = rnorm(10),

  c = rnorm(10),

  d = rnorm(10)

)

rescale01 <- function(x){

  rng <- range(x,na.rm = T)

  (x-rng[1])/(rng[2]-rng[1])

}

df$a <- rescale01(df$a)



# 修改后的循环体
[AppleScript] 纯文本查看 复制代码
df <- tibble(

  a = rnorm(10),

  b = rnorm(10),

  c = rnorm(10),

  d = rnorm(10)

)

for(i in seq_along(df)){

  df[[i]] <- rescale01(df[[i]])

}

df




#2 使用名称或值进行迭代,而非使用索引——循环模式
# 三种循环方式
#2.1 最常用 for (i in seq_along(xs))
#2.2 使用元素进行循环: for (x in xs)
#2.3 使用名称进行循环: for (nm in names(xs))
[AppleScript] 纯文本查看 复制代码
results <- vector("list",length(x))

names(results) <- names(x)


# 使用数值索引进行循环是最常用的方式
[AppleScript] 纯文本查看 复制代码
for(i in seq_along(x)){

  name <- names(x)[[i]]

  value <- x[[i]]

}



#3 处理未知长度的输出
[AppleScript] 纯文本查看 复制代码
means <- c(0,1,2)

output <- double()

for(i in seq_along(means)){

  n <- sample(100,1)

  output <- c(output,rnorm(n,mean[[i]]))

}

str(output)


# 以上代码并不是一个好的方法,更好的解决方式是将结果保存在一个列表中,循环
# 结束后再组合成一个向量
[AppleScript] 纯文本查看 复制代码
out <- vector("list", length(means))

for(i in seq_along(means)){

  n <- sample(100,1)

  out[[i]] <- rnorm(n, means[[i]])

}

str(out)

str(unlist(out))


#4 处理未知长度的序列
# while循环比for循环更简单,只需2部分:条件和循环体
while (condition){
  # 循环体
}
# 任何for循环都可以使用while循环重新实现,
# 但并非所有所有while循环都能使用for循环重新实现
# 以下两段代码等价
for(i in seq_along(X)){
  # 循环体
}

i <- 1
while (i <= length(x)){
  # 循环体
  i <- i + 1
}

# 书中使用while的一个示例
[AppleScript] 纯文本查看 复制代码
flip <- function()sample(c("T","H"),1)



flips <- 0

nheads <- 0



while (nheads < 3){

  if (flip() == "H"){

  nheads <- nheads + 1  

  }else{

    nheads <- 0

  }

  flips <- flips + 1

}

flips


# for循环与函数式编程
[AppleScript] 纯文本查看 复制代码
df <- tibble(

  a = rnorm(10),

  b = rnorm(10),

  c = rnorm(10),

  d = rnorm(10)

)




# 计算每列均值,可使用for循环完成
[AppleScript] 纯文本查看 复制代码
output <- vector("double", length(df))

for(i in seq_along(df)){

  output[[i]] <- mean(df[[i]])

}

output


# 提取代码转换为函数
[AppleScript] 纯文本查看 复制代码
col_mean <- function(df){

  output <- vector("double", length(df))

  for(i in seq_along(df)){

    output[[i]] <- mean(df[[i]])

  }

  output

}


# 同理,转换中位数、标准差函数,计算每列的中位数、标准差
# 中位数
[AppleScript] 纯文本查看 复制代码
col_median <- function(df){

  output <- vector("double", length(df))

  for(i in seq_along(df)){

    output[i] <- median(df[[i]])

  }

  output

}

output


# 标准差
[AppleScript] 纯文本查看 复制代码
col_sd <- function(df){

  output <- vector("double", length(df))

  for(i in seq_along(df)){

    output[i] <- sd(df[[i]])

  }

  output

}

output


# 但是,如果计算其他参数,反复的黏贴也是蛮烦的,尤其是黏贴的过程中,
# 部分代码还是需要进行修改的,因此合理的扩展该段代码就很重要了
# 通过添加支持函数应用到每列的一个参数,可使用同一函数完成三个函数相同的操作
[AppleScript] 纯文本查看 复制代码
col_summary <- function(df,fun){

  out <- vector("double", length(df))

  for(i in seq_along(df)){

    out[i] <- fun(df[[i]])

  }

  out

}

col_summary(df,median)

col_summary(df,sd)


# 5 映射函数
# purrr包提供了函数族
# map()用于输出列表
# map_lgl()用于输出逻辑型向量
# map_int()用于输出整型向量
# map_dbl()用于输出双精度型向量
# map_chr()用于输出字符型向量

# 掌握函数后,在解决迭代问题时可以节省大量时间,及时非常的复杂。。。理解需要一定时间
[AppleScript] 纯文本查看 复制代码
map_dbl(df, mean)

map_dbl(df, median)

map_dbl(df, sd)


# 与for循环相比,映射函数的重点在于需要执行的操作(即mean()、median()),
# 而非在所有元素中循环所需的跟踪记录以及保存结果

[AppleScript] 纯文本查看 复制代码
df %>% map_dbl(mean)

df %>% map_dbl(median)


# map_*()与col_summary()具有以下几点区别
# purrr函数都是用C实现的,速度非常快,但牺牲了一些可读性
# 第二个参数(即.f,要应用的函数)可以是一个公式、字符向量或整型向量
# map_*()使用...向.f传递一些附加参数,供其每次调用时使用
# 映射函数可保留名称
[AppleScript] 纯文本查看 复制代码
z <- list(x = 1:3, y = 4:5)

map_int(z, length)


# 快捷方式
[AppleScript] 纯文本查看 复制代码
models <- mtcars %>% 

  split(.$cyl) %>%

  map(function(df) lm(mpg ~ wt, data = df))


# 以上代码 将mtcars数据集拆分为3个部分,并对每个部分拟合一个线性模型
# purrr提供了更方便的快捷方式,单侧公式
[AppleScript] 纯文本查看 复制代码
models <- mtcars %>%

  split(.$cyl) %>%

  map(~lm(mpg ~ wt, data = .))


# .作为一个代词,表示当前列表元素

# 检查多个模型时,可能需要提取R2这样的摘要统计量,一般需要先运行summary()函数,
# 然后提取结果中的r.squared
[AppleScript] 纯文本查看 复制代码
models %>% 

  map(summary) %>%

  map_dbl(~.$r.squared)


# purrr提供了更为简洁的快捷方式,使用字符串
[AppleScript] 纯文本查看 复制代码
models %>%

  map(summary)%>%

  map_dbl("r.squared")


# 还可以使用整数按照位置选取元素
[AppleScript] 纯文本查看 复制代码
x <- list(list(1,2,3), list(4,5,6), list(7,8,9))

x %>% map_dbl(2)



# R基础包
# lapply()函数与map函数的功能基本相同,差别在于map()函数与purrr包中的其他函数一致,
# 可以对.f使用快捷方式
# R基础包中的sapply()函数式对lapply()的包装,可自动简化输出,作为函数是有问题的
[AppleScript] 纯文本查看 复制代码
x1 <- list(

  c(.27, .37, .57, .91, .2),

  c(.9, .94, .66, .63, .06),

  c(.21, .18, .69, .38, .77)

)

x2 <- list(

  c(.50, .72, .99, .38, .78),

  c(.93, .21, .65, .13, .27),

  c(.39, .01, .38, .87, .34)

)

threshold <- function(x, cutoff = .8)x[x > cutoff]

x1 %>% sapply(threshold) %>% str()

x2 %>% sapply(threshold) %>% str()



# vapply()函数是sapply()的一种安全替代方式,可以提供额外的参数来定义类型,
# vapply()的缺点是输入量较大,vapply(df, is.numeric, logical(1))等价于map_lgl(df, is.numeric)
# vapply()优于purrr中映射函数的一点是可以生成矩阵,映射函数只能生成向量

# 对操作失败的处理
# safely()是一个修饰函数(副词),接受一个函数(动词),对其进行修改并返回修改后的函数
# result 原始函数,如出现错误,就是NULL
# error 错误对象,如操作成功,就是NULL
[AppleScript] 纯文本查看 复制代码
safe_log <- safely(log)

str(safe_log(10))

str(safe_log("a"))


# safely()也可与map()共同使用
x <- list(1, 10, "a")
y <- x %>% map(safely(log))
str(y)
# 如将上述结果转换为两个列表,一个列表包含所有错误对象,
# 一个列表包含所有原始结果,那么处理起来更为容易
# 使用purrr::transpose()函数轻松完成该任务
[AppleScript] 纯文本查看 复制代码
y <- y %>% transpose()

str(y)


# 可自行决定如何处理错误对象,但一般来说,
# 应检查一下y中错误对象所对应的x值,或使用y中的正常结果进行处理
[AppleScript] 纯文本查看 复制代码
is_ok <- y$error %>% map_lgl(is_null)

x[!is_ok]

y$result[is_ok] %>% flatten_dbl()  



# purrr还提供另两个有用的修饰函数
# possibly()函数也总是成功返回。它比safely()更简单一些,可以设定出现错误时返回一个默认值
[AppleScript] 纯文本查看 复制代码
x <- list(1, 10, "a")

x %>%map_dbl(possibly(log, NA_real_))


# quietly()函数的作用与safely()基本相同,但前者的结果中不包含错误对象,而是包含输出、消息、警告
[AppleScript] 纯文本查看 复制代码
x <- list(1, -1)

x %>% map(quietly(log)) %>% str()



# 多参数映射

[AppleScript] 纯文本查看 复制代码
mu <- list(5, 10, -3)

mu %>% 

  map(rnorm, n =5) %>%

  str()



sigma <- list(1, 5, 10)

seq_along(mu) %>%

  map(~rnorm(5, mu[[.]], sigma[[.]])) %>%

  str()



# 以上代码使人难以理解代码的本意,应该使用map2()函数,该函数可对两个向量进行同步迭代
[AppleScript] 纯文本查看 复制代码
map2(mu, sigma, rnorm, n = 5) %>% str()



# 注意,每次调用时值发生变化的参数(此处的mu和sigma)要放在映射函数(这里是rnorm)的前面,
# 值保持不变的参数(此处为n)要放在映射函数的后面
[AppleScript] 纯文本查看 复制代码
map2 <- function(x, y, f, ...){

  out <- vector("list", length(x))

  for (i in seq_along(x)){

    out[[i]] <- f(x[[i]],y[[i]], ...)

  }

  out

}


# purrr提供了pmap()函数,可将一个列表作为参数
[AppleScript] 纯文本查看 复制代码
n <- list(1, 3, 5)

args1 <- list(n, mu, sigma)

args1 %>%

  pmap(rnorm) %>%

  str()


# 如果没有为列表的元素命名,那么pmap()在调用函数时就会按照位置匹配
[AppleScript] 纯文本查看 复制代码
args2 <- list(mean = mu, sd = sigma, n = n)

args2 %>% 

  pmap(rnorm) %>%

  str()


# 由于长度相同,所以可以将各个参数保存在一个数据框中

[AppleScript] 纯文本查看 复制代码
params <- tribble(

  ~mean, ~sd, ~n,

  5,1,1,

  10,5,3,

  -3,10,5

)

params %>%

  pmap(rnorm)



# 当代码变得复杂时,使用数据框是一种非常好的方法,可以确保每列具有名称,
# 而且与其他列具有相同的长度

# 调用不同函数
[AppleScript] 纯文本查看 复制代码
f <- c("runif", "rnorm", "rpois")

param <- list(

  list(min = -1, max = 1),

  list(sd = 5),

  list(lambda = 10)

)


# 更复杂的情况:不但传给函数的参数不同,甚至函数本身也不同
# 可以使用invoke_map()函数
[AppleScript] 纯文本查看 复制代码
invoke_map(f, param, n = 5) %>%

  str()


# 第一个参数是一个函数列表或包含函数名称的字符向量,
# 第二个参数是列表的一个列表,其中给出了要传给各个函数的不同参数

[AppleScript] 纯文本查看 复制代码
sim <- tribble(

  ~f,~params,

  "runif",list(min = -1, max = 1),

  "rnorm",list(sd = 5),

  "rpois",list(lambda = 10)

)

sim %>%

  mutate(sim = invoke_map(f, params, n = 10))


# 游走函数
# 如果调用函数的目的为利用其副作用,而非返回值时,那么就该使用游走函数,而非映射函数
[AppleScript] 纯文本查看 复制代码
x <- list(1, "a", 3)

x %>%

  walk(print)

library(ggplot2)

plots <- mtcars %>%

  split(.$cyl)%>%

  map(~ggplot(., aes(mpg, wt)) + geom_point())

paths <- stringr::str_c(names(plots),".pdf")

pwalk(list(paths,plots),ggsave,path = tempdir())


# for循环的其他模式
# 预测函数
# keep()和discard()可以分别保留输入中预测值为T和F的元素
[AppleScript] 纯文本查看 复制代码
iris %>%

  keep(is.factor) %>%

  str()



iris %>%

  discard(is.factor) %>%

  str()



# some()和every()分别用来确定预测值是否对某个元素为真以及是否对所有元素为真
[AppleScript] 纯文本查看 复制代码
x <- list(1:5, letters, list(10))

x %>%

  some(is_character)

x %>%

  every(is_vector)


# detect()函数可找出预测值为真的第一个元素,detect_index()可以返回该元素的位置
[AppleScript] 纯文本查看 复制代码
x <- sample(10)

x

x %>%

  detect(~.>5)

x %>%

  detect_index(~.>5)


# head_while()和tail_while()分别从向量的开头和结尾找出预测值为真的元素
[AppleScript] 纯文本查看 复制代码
x %>%

  head_while(~.>5)

x %>%

  tail_while(~.>5)


# 归约与累计

[AppleScript] 纯文本查看 复制代码
dfs <- list(

  age = tibble(name = "John", age = 30),

  sex = tibble(name = c("John","Mary"),sex = c("M","F")),

  trt = tibble(name = "Mary", treatment = "A")

)

dfs %>% reduce(full_join)



vs <- list(

  c(1,3,5,6,10),

  c(1,2,3,7,8,10),

  c(1,2,3,4,8,9,10)

)


vs %>% reduce(intersect)
# reduce()使用“二元”函数,将其不断应用于列表,直到最后只剩下一个元素为止

# 累计函数与归约函数相似,但累计函数会保留所有中间结果
[AppleScript] 纯文本查看 复制代码
x <- sample(10) 

x

x %>% accumulate('+')






上一篇:1109 chapter16
下一篇:慧美——R for data science 第8章 使用readr进行数据导入
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|手机版|小黑屋|生信技能树 ( 粤ICP备15016384号  

GMT+8, 2019-8-22 22:35 , Processed in 0.033022 second(s), 26 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.