将自定义函数应用于每一行仅使用参数的第一个值
Applying custom function to each row uses only first value of argument
我正在尝试使用以下数据集将列子集中的 NA 值重新编码为 0：
set.seed(1)
df <- data.frame(
id = c(1:10),
trials = sample(1:3, 10, replace = T),
t1 = c(sample(c(1:9, NA), 10)),
t2 = c(sample(c(1:7, rep(NA, 3)), 10)),
t3 = c(sample(c(1:5, rep(NA, 5)), 10))
)
每一行都有一定数量的相关试验（1-3 之间），由 trials 列指定。 t1-t3 列代表每个试验的分数。
试验次数表示 NA 应重新编码为 0 的列的子集：试验次数内的 NA 表示缺失数据，并且应该重新编码为0，而试验次数之外的NAs没有意义，应该保持NAs。因此，对于 trials == 3 行，t3 列中的 NA 将被重新编码为 0，但在 trials == 2 行中，[=15] =] 在 t3 中将保持 NA.
所以，我尝试使用这个函数：
replace0 <- function(x, num.sun) {
x[which(is.na(x[1:(num.sun + 2)]))] <- 0
return(x)
}
这适用于单个向量。当我尝试将相同的函数应用于具有 apply() 的数据框时，虽然：
apply(df, 1, replace0, num.sun = df$trials)
我收到警告说：
In 1:(num.sun + 2) :
numerical expression has 10 elements: only the first used
结果是 num.sun 的值不是根据 trials 中的值更改每一行，apply() 只是使用 [=17= 中的第一个值] 每一行的列。我怎样才能应用该函数，使 num.sun 参数根据 df$trials 的值而变化？
谢谢！
编辑： 正如某些人评论的那样，原始示例数据有一些非 NA 分数，根据试验列，这些分数没有意义。这是更正后的数据集：
df <- data.frame(
id = c(1:5),
trials = c(rep(1, 2), rep(2, 1), rep(3, 2)),
t1 = c(NA, 7, NA, 6, NA),
t2 = c(NA, NA, 3, 7, 12),
t3 = c(NA, NA, NA, 4, NA)
)
这里有一个方法：
x <- is.na(df)
df[x & t(apply(x, 1, cumsum)) > 3 - df$trials] <- 0
输出如下所示：
> df
id trials t1 t2 t3
1 1 1 3 NA 5
2 2 2 2 2 NA
3 3 2 6 6 4
4 4 3 0 1 2
5 5 1 5 NA NA
6 6 3 7 0 0
7 7 3 8 7 0
8 8 2 4 5 1
9 9 2 1 3 NA
10 10 1 9 4 3
> x <- is.na(df)
> df[x & t(apply(x, 1, cumsum)) > 3 - df$trials] <- 0
> df
id trials t1 t2 t3
1 1 1 3 NA 5
2 2 2 2 2 NA
3 3 2 6 6 4
4 4 3 0 1 2
5 5 1 5 NA NA
6 6 3 7 0 0
7 7 3 8 7 0
8 8 2 4 5 1
9 9 2 1 3 NA
10 10 1 9 4 3
注意：第 1/3/10 行有问题，因为非 NA 值比试验多。
这里我只是用双子集 x[paste0('t',x['trials'])] 重写了你的函数，它克服了其他两个解决方案中的问题 第 6 行
replace0 <- function(x){
#browser()
x_na <- x[paste0('t',x['trials'])]
if(is.na(x_na)){x[paste0('t',x['trials'])] <- 0}
return(x)
}
t(apply(df, 1, replace0))
id trials t1 t2 t3
[1,] 1 1 3 NA 5
[2,] 2 2 2 2 NA
[3,] 3 2 6 6 4
[4,] 4 3 NA 1 2
[5,] 5 1 5 NA NA
[6,] 6 3 7 NA 0
[7,] 7 3 8 7 0
[8,] 8 2 4 5 1
[9,] 9 2 1 3 NA
[10,] 10 1 9 4 3
另一种方法：
# create an index of the NA values
w <- which(is.na(df), arr.ind = TRUE)
# create an index with the max column by row where an NA is allowed to be replaced by a zero
m <- matrix(c(1:nrow(df), (df$trials + 2)), ncol = 2)
# subset 'w' such that only the NA's which fall in the scope of 'm' remain
i <- w[w[,2] <= m[,2][match(w[,1], m[,1])],]
# use 'i' to replace the allowed NA's with a zero
df[i] <- 0
给出：
> df
id trials t1 t2 t3
1 1 1 3 NA 5
2 2 2 2 2 NA
3 3 2 6 6 4
4 4 3 0 1 2
5 5 1 5 NA NA
6 6 3 7 0 0
7 7 3 8 7 0
8 8 2 4 5 1
9 9 2 1 3 NA
10 10 1 9 4 3
您可以轻松地将它包装在一个函数中：
replace.NA.with.0 <- function(df) {
w <- which(is.na(df), arr.ind = TRUE)
m <- matrix(c(1:nrow(df), (df$trials + 2)), ncol = 2)
i <- w[w[,2] <= m[,2][match(w[,1], m[,1])],]
df[i] <- 0
return(df)
}
现在，使用 replace.NA.with.0(df) 将产生上述结果。
正如其他人所指出的，某些行（1、3 和 10）的值比轨迹多。您可以通过将上述函数重写为：
来解决该问题
replace.with.NA.or.0 <- function(df) {
w <- which(is.na(df), arr.ind = TRUE)
df[w] <- 0
v <- tapply(m[,2], m[,1], FUN = function(x) tail(x:5,-1))
ina <- matrix(as.integer(unlist(stack(v)[2:1])), ncol = 2)
df[ina] <- NA
return(df)
}
现在，使用 replace.with.NA.or.0(df) 会产生以下结果：
id trials t1 t2 t3
1 1 1 3 NA NA
2 2 2 2 2 NA
3 3 2 6 6 NA
4 4 3 0 1 2
5 5 1 5 NA NA
6 6 3 7 0 0
7 7 3 8 7 0
8 8 2 4 5 NA
9 9 2 1 3 NA
10 10 1 9 NA NA
这是一个 tidyverse 方法，请注意，它不会提供与其他解决方案相同的输出。
您的示例数据显示了 "didn't happen" 的试验结果，我假设您的真实数据没有。
library(tidyverse)
df %>%
nest(matches("^t\d")) %>%
mutate(data = map2(data,trials,~mutate_all(.,replace_na,0) %>% select(.,1:.y))) %>%
unnest
# id trials t1 t2 t3
# 1 1 1 3 NA NA
# 2 2 2 2 2 NA
# 3 3 2 6 6 NA
# 4 4 3 0 1 2
# 5 5 1 5 NA NA
# 6 6 3 7 0 0
# 7 7 3 8 7 0
# 8 8 2 4 5 NA
# 9 9 2 1 3 NA
# 10 10 1 9 NA NA
使用更常用的 gather 策略是：
df %>%
gather(k,v,matches("^t\d")) %>%
arrange(id) %>%
group_by(id) %>%
slice(1:first(trials)) %>%
mutate_at("v",~replace(.,is.na(.),0)) %>%
spread(k,v)
# # A tibble: 10 x 5
# # Groups: id [10]
# id trials t1 t2 t3
# <int> <int> <dbl> <dbl> <dbl>
# 1 1 1 3 NA NA
# 2 2 2 2 2 NA
# 3 3 2 6 6 NA
# 4 4 3 0 1 2
# 5 5 1 5 NA NA
# 6 6 3 7 0 0
# 7 7 3 8 7 0
# 8 8 2 4 5 NA
# 9 9 2 1 3 NA
# 10 10 1 9 NA NA
我正在尝试使用以下数据集将列子集中的 NA 值重新编码为 0：
set.seed(1)
df <- data.frame(
id = c(1:10),
trials = sample(1:3, 10, replace = T),
t1 = c(sample(c(1:9, NA), 10)),
t2 = c(sample(c(1:7, rep(NA, 3)), 10)),
t3 = c(sample(c(1:5, rep(NA, 5)), 10))
)
每一行都有一定数量的相关试验（1-3 之间），由 trials 列指定。 t1-t3 列代表每个试验的分数。
试验次数表示 NA 应重新编码为 0 的列的子集：试验次数内的 NA 表示缺失数据，并且应该重新编码为0，而试验次数之外的NAs没有意义，应该保持NAs。因此，对于 trials == 3 行，t3 列中的 NA 将被重新编码为 0，但在 trials == 2 行中，[=15] =] 在 t3 中将保持 NA.
所以，我尝试使用这个函数：
replace0 <- function(x, num.sun) {
x[which(is.na(x[1:(num.sun + 2)]))] <- 0
return(x)
}
这适用于单个向量。当我尝试将相同的函数应用于具有 apply() 的数据框时，虽然：
apply(df, 1, replace0, num.sun = df$trials)
我收到警告说：
In 1:(num.sun + 2) :
numerical expression has 10 elements: only the first used
结果是 num.sun 的值不是根据 trials 中的值更改每一行，apply() 只是使用 [=17= 中的第一个值] 每一行的列。我怎样才能应用该函数，使 num.sun 参数根据 df$trials 的值而变化？
谢谢！
编辑： 正如某些人评论的那样，原始示例数据有一些非 NA 分数，根据试验列，这些分数没有意义。这是更正后的数据集：
df <- data.frame(
id = c(1:5),
trials = c(rep(1, 2), rep(2, 1), rep(3, 2)),
t1 = c(NA, 7, NA, 6, NA),
t2 = c(NA, NA, 3, 7, 12),
t3 = c(NA, NA, NA, 4, NA)
)
这里有一个方法：
x <- is.na(df)
df[x & t(apply(x, 1, cumsum)) > 3 - df$trials] <- 0
输出如下所示：
> df
id trials t1 t2 t3
1 1 1 3 NA 5
2 2 2 2 2 NA
3 3 2 6 6 4
4 4 3 0 1 2
5 5 1 5 NA NA
6 6 3 7 0 0
7 7 3 8 7 0
8 8 2 4 5 1
9 9 2 1 3 NA
10 10 1 9 4 3
> x <- is.na(df)
> df[x & t(apply(x, 1, cumsum)) > 3 - df$trials] <- 0
> df
id trials t1 t2 t3
1 1 1 3 NA 5
2 2 2 2 2 NA
3 3 2 6 6 4
4 4 3 0 1 2
5 5 1 5 NA NA
6 6 3 7 0 0
7 7 3 8 7 0
8 8 2 4 5 1
9 9 2 1 3 NA
10 10 1 9 4 3
注意：第 1/3/10 行有问题，因为非 NA 值比试验多。
这里我只是用双子集 x[paste0('t',x['trials'])] 重写了你的函数，它克服了其他两个解决方案中的问题 第 6 行
replace0 <- function(x){
#browser()
x_na <- x[paste0('t',x['trials'])]
if(is.na(x_na)){x[paste0('t',x['trials'])] <- 0}
return(x)
}
t(apply(df, 1, replace0))
id trials t1 t2 t3
[1,] 1 1 3 NA 5
[2,] 2 2 2 2 NA
[3,] 3 2 6 6 4
[4,] 4 3 NA 1 2
[5,] 5 1 5 NA NA
[6,] 6 3 7 NA 0
[7,] 7 3 8 7 0
[8,] 8 2 4 5 1
[9,] 9 2 1 3 NA
[10,] 10 1 9 4 3
另一种方法：
# create an index of the NA values
w <- which(is.na(df), arr.ind = TRUE)
# create an index with the max column by row where an NA is allowed to be replaced by a zero
m <- matrix(c(1:nrow(df), (df$trials + 2)), ncol = 2)
# subset 'w' such that only the NA's which fall in the scope of 'm' remain
i <- w[w[,2] <= m[,2][match(w[,1], m[,1])],]
# use 'i' to replace the allowed NA's with a zero
df[i] <- 0
给出：
> df id trials t1 t2 t3 1 1 1 3 NA 5 2 2 2 2 2 NA 3 3 2 6 6 4 4 4 3 0 1 2 5 5 1 5 NA NA 6 6 3 7 0 0 7 7 3 8 7 0 8 8 2 4 5 1 9 9 2 1 3 NA 10 10 1 9 4 3
您可以轻松地将它包装在一个函数中：
replace.NA.with.0 <- function(df) {
w <- which(is.na(df), arr.ind = TRUE)
m <- matrix(c(1:nrow(df), (df$trials + 2)), ncol = 2)
i <- w[w[,2] <= m[,2][match(w[,1], m[,1])],]
df[i] <- 0
return(df)
}
现在，使用 replace.NA.with.0(df) 将产生上述结果。
正如其他人所指出的，某些行（1、3 和 10）的值比轨迹多。您可以通过将上述函数重写为：
来解决该问题replace.with.NA.or.0 <- function(df) {
w <- which(is.na(df), arr.ind = TRUE)
df[w] <- 0
v <- tapply(m[,2], m[,1], FUN = function(x) tail(x:5,-1))
ina <- matrix(as.integer(unlist(stack(v)[2:1])), ncol = 2)
df[ina] <- NA
return(df)
}
现在，使用 replace.with.NA.or.0(df) 会产生以下结果：
id trials t1 t2 t3 1 1 1 3 NA NA 2 2 2 2 2 NA 3 3 2 6 6 NA 4 4 3 0 1 2 5 5 1 5 NA NA 6 6 3 7 0 0 7 7 3 8 7 0 8 8 2 4 5 NA 9 9 2 1 3 NA 10 10 1 9 NA NA
这是一个 tidyverse 方法，请注意，它不会提供与其他解决方案相同的输出。
您的示例数据显示了 "didn't happen" 的试验结果，我假设您的真实数据没有。
library(tidyverse)
df %>%
nest(matches("^t\d")) %>%
mutate(data = map2(data,trials,~mutate_all(.,replace_na,0) %>% select(.,1:.y))) %>%
unnest
# id trials t1 t2 t3
# 1 1 1 3 NA NA
# 2 2 2 2 2 NA
# 3 3 2 6 6 NA
# 4 4 3 0 1 2
# 5 5 1 5 NA NA
# 6 6 3 7 0 0
# 7 7 3 8 7 0
# 8 8 2 4 5 NA
# 9 9 2 1 3 NA
# 10 10 1 9 NA NA
使用更常用的 gather 策略是：
df %>%
gather(k,v,matches("^t\d")) %>%
arrange(id) %>%
group_by(id) %>%
slice(1:first(trials)) %>%
mutate_at("v",~replace(.,is.na(.),0)) %>%
spread(k,v)
# # A tibble: 10 x 5
# # Groups: id [10]
# id trials t1 t2 t3
# <int> <int> <dbl> <dbl> <dbl>
# 1 1 1 3 NA NA
# 2 2 2 2 2 NA
# 3 3 2 6 6 NA
# 4 4 3 0 1 2
# 5 5 1 5 NA NA
# 6 6 3 7 0 0
# 7 7 3 8 7 0
# 8 8 2 4 5 NA
# 9 9 2 1 3 NA
# 10 10 1 9 NA NA