【R语言技巧】apply家族篇 sumNotes

卡西莫多的猫

已于 2023-03-23 23:27:47 修改

阅读量445

点赞数

分类专栏： R语言文章标签： r语言开发语言

于 2022-11-27 16:44:37 首次发布

本文链接：https://blog.csdn.net/ohmmmmmypyr/article/details/128066062

版权

R语言专栏收录该内容

5 篇文章 0 订阅

订阅专栏

apply家族
本篇博客基本上为阅读后笔记加上实际操作情景
（待补充）

实际应用情景1：
在进行gwas与eqtl共定位分析时，需要确定gwas进行共定位分析的区域，

在筛选好indep locus区域后，需要在汇总的gwas数据中筛出所有满足条件的SNP位点
由于对于不同的染色体indep locus数量和位置皆不相同，所以简单使用for循环不能满足需求
思路：
可先自行创建判断函数，判断函数的输入由apply轻量输入

apply

实操代码:
apply(pos,1,myFUN,arg)

# 判断函数
myFUN <- function(a,arg){
  n <- length(arg)
  for(i in seq(1,n,2)){  # 实现不同数量判断条件
    start <- arg[i]
    end <- arg[i+1]
    if (a>=start & a<=end){
      return(TRUE)
    }
  }
  return(FALSE)
}

library(data.table)
# 汇总gwas数据
gwas <- fread("COVID19_HGI_B2_ALL_leave_23andme_20220403_GRCh37.tsv.gz")

chr_indep_locus <- read.table('gwas_coloc_b37area.txt',header = FALSE,sep = ' ')

for (c in chr){
  # 获取对于chr gwas
  subgwas <- gwas[which(gwas$`#CHR`==c),]
  # 获取arg参数
  r <- which(chr_indep_locus$V1 == c)
  arg <- chr_indep_locus[r,]$V2
  # 获取pos参数
  pos <- data.frame(subgwas$POS)
  # 判断
  rr <- apply(pos,1,myFUN,arg)  # 1 按行输入参数
  # 获取共定位区域SNPs
  write.table(subgwas[rr,],paste('coloc_area_chr',c,'gwas_b37SNPs.txt',sep = ''),col.names = FALSE,row.names = FALSE,quote = FALSE,sep = '\t',append = FALSE)
}

lapply

现在遇到一个问题
想要把数据框中某单独一列取出来作为参数传递给apply进行处理：

> ids <- read.table('Ensembl_id_test1.txt',header = FALSE)
> ids
                  V1
1 ENSG00000000003.13
2  ENSG00000000005.5
3 ENSG00000000419.11
4 ENSG00000000457.12
5 ENSG00000000460.15
6 ENSG00000000938.11
> ids$ensembl_id <- apply(ids$V1,1,function(x){
+   return(strsplit(x,'.',fixed=TRUE)[[1]][1])
+ })
Error in apply(ids$V1, 1, function(x) { : dim(X)的值必需是正数

阅读博客 Error in apply(df$var1, 2, mean) : dim(X) must have a positive length
发现，apply只能处理数据框或者矩阵数据类型，我们取出数据框单独一列它已经变成了字符串向量
所以报错
这一点与我们在上文传递的pos 数据框结构一致

> class(ids$V1)
[1] "character"

发现了一同学与我有一样的问题

> id<- 210222001:210222100
> AdvMath<- round(runif(100,75,100),0)
> Engish<- round(rnorm(100,80,7),0)
> WebDev<- round(rnorm(100,83,18))
> WebDev[which(WebDev > 100)] =100
> student <- data.frame(id,AdvMath,Engish,WebDev)
> data.entry(student)
> avg <- apply(student[2:4] ,1, mean)
Error in apply(student[2:4], 1, mean) : dim(X)的值必需是正数

在他使用data.entry()函数打开数据编辑器之前一切正常，student仍是数据框结构
但data.entry()函数可以打开数据编辑器，但是不适用于数据框。如果用data.entry()修改了数据框，会转换成列表(list)类型。

编辑数据框需要使用edit()函数：

 xnew<-edit(xold)

edit()函数只是编辑，并不赋值。如果要直接修改数据框，需要使用如下的形式：

x = edit(x)
fix(x)        #等价于上面的形式

要解决这些因希望处理非数据框格式数据如提取某一列，进行apply
方法：
使用lapply

ids$ensembl_id <- unlist(lapply(ids$V1, function(x){
  strsplit(x, "[.]")[[1]][1]
}))

–sapply 和 vapply sapply(x,fun,…) 返回向量或者矩阵，比lapply更加用户友好
vapply和sapply相似，但要预先预定fun函数的返回值类型，用起来更安全
https://blog.csdn.net/yichao0630/article/details/105514230/

联系do.call

【R语言技巧】列表各元素输出为文本文件单行时paste函数collapse参数

tapply

我想要在R语言中利用apply在分组的基础上计算平均值

好的，你可以使用apply函数来对分组后的数据计算平均值。以下是一个示例代码，假设有一个数据框df，其中包含三列Group、Value1和Value2，我们想要按照Group列进行分组，并计算每组的Value1和Value2的平均值：

创建示例数据框
df <- data.frame(Group = c("A", "A", "B", "B", "B", "C"),
                 Value1 = c(1, 2, 3, 4, 5, 6),
                 Value2 = c(10, 20, 30, 40, 50, 60))

使用apply计算每组的平均值

apply(df[, 2:3], 2, tapply, df$Group, mean)

上述代码中，df[, 2:3]表示选取数据框中第2列和第3列，即Value1和Value2列，2表示对选中的列进行操作，tapply函数将数据按照df$Group分组，并计算每组的平均值，最终apply函数将平均值转化为矩阵的形式输出。

输出结果如下：

css
Copy code
Value1 Value2
A 1.500000e+00 15
B 4.000000e+00 40
C 6.000000e+00 60
可以看到，输出的结果为一个2行3列的矩阵，其中每行代表一个变量（Value1和Value2），每列代表一个分组（A、B和C），矩阵中的元素为对应变量在对应分组中的平均值。

+分组计算描述性统计量函数—by()函数

biotrainee <- data.frame(name = c('xg','xj','hj','wh','xs'),
                         gender = c('male','female','female','male','female'),
                         ages = c(23,24,25,26,27))
> biotrainee  #看下数据框内容
  name gender ages
1   xg   male   23
2   xj female   24
3   hj female   25
4   wh   male   26
5   xs female   27

> by(biotrainee,biotrainee$gender,function(x) mean(x[,3]))
biotrainee$gender: female
[1] 25.33333
----------------------------------------------------------------------------- 
biotrainee$gender: male
[1] 24.5

# 熟悉split()函数的可以看出，按照gender列分组那步，split()函数可以到达同样的效果：
> split(biotrainee,biotrainee$gender)
$`female`
  name gender ages
2   xj female   24
3   hj female   25
5   xs female   27

$male
  name gender ages
1   xg   male   23
4   wh   male   26
# split()函数分好组之后，我们再用lapply就可以看到：
> lapply(split(biotrainee,biotrainee$gender),function(x) mean(x[,3]))
$`female`
[1] 25.33333

$male
[1] 24.5