嵌套列表不适合操作vector中的单个元素吗?

zaqlnxep  于 12个月前  发布在  其他
关注(0)|答案(1)|浏览(128)

我有以下代码:

for(i in 1:length(hh_temp)){
  hh_temp_save = hh_temp[[i]]
  for(j in 4:nrow(hh_temp_save)){
    hh_temp_save$max_min_sum_5days[j] = ifelse(sum(hh_temp_save$max_min_sum[(j-4):j])>2,1,0)
    hh_temp[[i]] = hh_temp_save
 }
}

字符串
其中hh_temp是一个长度(hh_temp)= 12的列表,hh_temp中的每个元素都是一个嵌套框。
我试图将for循环转换为嵌套的apply,但我发现,

lapply(hh_temp,\(x){
  x = lapply(32:nrow(x),\(y){
             x$max_min_sum_5days[y] = ifelse(sum(x$max_min_sum[(y-4):y])>2,1,0)
             x
             })
  return(x)
               })


我只能返回操作过的vector而不是整个数据集。有没有办法返回整个数据集?这是否意味着嵌套的lapply不适合操作vector中的单个元素?
很抱歉,我无法提供数据集的详细信息,可以提供一些描述性统计数据:

> str(hh_temp)
List of 12
 $ : tibble [3,684 × 36] (S3: tbl_df/tbl/data.frame)
  ..$ max_min_sum                                      : num [1:3684] 0 0 0 0 0 0 0 0 0 0 ...
  ..$ max_min_sum_5days                                : num [1:3684] NA NA NA NA NA NA NA NA NA NA ...
 $ : tibble [3,684 × 36] (S3: tbl_df/tbl/data.frame)
  ..$ max_min_sum                                      : num [1:3684] 0 0 0 0 0 0 0 0 0 0 ...
  ..$ max_min_sum_5days                                : num [1:3684] NA NA NA NA NA NA NA NA NA NA ...

#repeated for 12 times
#max_min_sum is a binary variable


示例数据:

df = data.frame(a = as.factor(c(1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,1,0,1)),
                b = rep(NA,18))

sample_list = list(df,df,df,df,df,df)


我的预期结果是计算a中5个连续元素的累积和,然后如果连续和大于2,则B中相应的元素将被重新编码为1,否则为0。
| 一|B|
| --|--|
| 1 |NA|
| 1 |NA|
| 1 |NA|
| 1 |NA|
| 0 | 1 |
| 0 | 1 |
| 0 | 0 |
在a中的第5个元素中,由于有4个1s和1个0,因此,连续和大于2,B中的相应元素将被重新编码为1

vxqlmq5t

vxqlmq5t1#

我的预期结果是计算a中5个连续元素的累积和,然后如果连续和大于2,则B中相应的元素将被重新编码为1,否则为0。
如果a是一个因子变量,我们需要预先运行as.numeric(as.character(a))来强制a为数值。我们可以使用{zoo}中的rollsum()进行滚动求和计算。
使用lapply()的解决方案适用于稍微修改的样本数据。

验证码

# sample_list = 
  lapply(sample_list, 
         \(x) { x$b = ifelse(
           zoo::rollsum(as.numeric(as.character(x$a)), 
                        k = 5, fill = NA, align = "right") > 2L, 1L, 0L)
         x})

字符串
或者像@G. Grothendieck建议的那样,以更紧凑的方式,

lapply(sample_list, transform, 
       b = +(zoo::rollsumr(as.numeric(as.character(a)), k = 5L, fill = NA) > 2L))

结果

#> [[1]]
#>    a  b
#> 1  1 NA
#> 2  1 NA
#> 3  1 NA
#> 4  1 NA
#> 5  0  1
#> 6  0  1
#> 7  0  0
#> 8  0  0
#> 9  1  0
#> 10 1  0
#> 11 1  1
#> 12 1  1
#> 13 1  1
#> 14 0  1
#> 15 0  1
#> 16 1  1
#> 17 0  0
#> 18 1  0
#> 
#> [[2]]
#>    a  b
#> 1  1 NA
#> 2  2 NA
#> 3  3 NA
#> 4  4 NA
#> 5  5  1
#> 6  6  1
#> 7  7  1
#> 8  8  1
#> 9  1  1
#> 10 1  1
#> 11 1  1
#> 12 1  1
#> 13 1  1
#> 14 1  1
#> 15 1  1
#> 16 1  1
#> 17 1  1
#> 18 1  1
#> 
#> [[3]]
#>    a  b
#> 1  1 NA
#> 2  1 NA
#> 3  1 NA
#> 4  1 NA
#> 5  0  1
#> 6  0  1
#> 7  0  0
#> 8  0  0
#> 9  1  0
#> 10 1  0
#> 11 1  1
#> 12 1  1
#> 13 1  1
#> 14 0  1
#> 15 0  1
#> 16 1  1
#> 17 0  0
#> 18 1  0
#> 
#> [[4]]
#>    a  b
#> 1  1 NA
#> 2  1 NA
#> 3  1 NA
#> 4  1 NA
#> 5  0  1
#> 6  0  1
#> 7  0  0
#> 8  0  0
#> 9  1  0
#> 10 1  0
#> 11 1  1
#> 12 1  1
#> 13 1  1
#> 14 0  1
#> 15 0  1
#> 16 1  1
#> 17 0  0
#> 18 1  0
#> 
#> [[5]]
#>    a  b
#> 1  1 NA
#> 2  1 NA
#> 3  1 NA
#> 4  1 NA
#> 5  0  1
#> 6  0  1
#> 7  0  0
#> 8  0  0
#> 9  1  0
#> 10 1  0
#> 11 1  1
#> 12 1  1
#> 13 1  1
#> 14 0  1
#> 15 0  1
#> 16 1  1
#> 17 0  0
#> 18 1  0
#> 
#> [[6]]
#>    a  b
#> 1  1 NA
#> 2  1 NA
#> 3  1 NA
#> 4  1 NA
#> 5  0  1
#> 6  0  1
#> 7  0  0
#> 8  0  0
#> 9  1  0
#> 10 1  0
#> 11 1  1
#> 12 1  1
#> 13 1  1
#> 14 0  1
#> 15 0  1
#> 16 1  1
#> 17 0  0
#> 18 1  0

修改数据

df = data.frame(a = as.factor(c(1,1,1,1,0,0,0,0,1,1,1,1,1,0,0,1,0,1)),
                b = rep(NA,18))
df2 = data.frame(a = as.factor(c(1:8, rep(1, 5), rep(1,5))), 
                 b = rep(NA,18))
sample_list = list(df,df2,df,df,df,df)


创建于2023-12-08带有reprex v2.0.2

编辑

如果你的数据很小,并且你不想依赖像{zoo}这样的外部软件包,你可以考虑自己编写滚动求和函数。非常基本的例子:

basic_rollsum = \(x, k) {
  # stopifnot(is.numeric(x), is.integer(k))
  res = rep(NA, length(x))
  for (i in seq_along(x)) 
    # adjust indexing if needed 
    # look at na.rm-argument of sum
    if (i > k) res[i] = sum( x[(i-k+1L):(i)] )
  res
}
lapply(sample_list, 
       \(x) { x$b = ifelse(
         basic_rollsum(as.numeric(as.character(x$a)), k = 5L) > 2L, 1L, 0L)
       x})

相关问题