列表首元素全为NA与转DataFrame列名异常的解决方法

问题现象 #

1. 并行计算返回的列表dfTemp中，所有内部列表的首个值均为NA：

Browse[1]> str(dfTemp)
List of 100
 $ : num [1:15] NA 0.598 0.948 0.179 0.284 ...
 $ : num [1:15] NA 0.355 0.834 0.312 0.243 ...
 $ : num [1:15] NA 0.425 0.521 0.361 0.296 ...

2. 将列表转换为数据框时，列名被自动拼接成一串数值，无法得到自定义的规范名称：

'data.frame':    15 obs. of  2 variables:
 $ c.NA..0.598119527934818..0.947653884049345..0.178908501367397..: num  NA 0.598 0.948 0.179 0.284 ...
 $ c.NA..0.354694348429857..0.833605540582925..0.312442033011144..: num  NA 0.355 0.834 0.312 0.243 ...

核心问题代码片段 #

出现异常的并行计算逻辑：

dfTemp <- parLapply(cl, 1:X,
                    function(j) {
                      library(matrixStats) #matrixStats needs to be loaded within each worker node
                      result <- colMeans2(
                        mapply(
                        function(i) rowMeans2(
                          matrix(
                            sample(sample(bdf[, 1], i), B * i, replace = TRUE), B, i),
                          na.rm = TRUE),
                        N1:N2), 
                        na.rm = TRUE)
                      return(result)  
                      }
                    )

完整可复现代码 #

#### LIBRARIES ####
library(parallel)
library(tidyverse)
library(matrixStats)

#### BOOTSTRAPPING FUNCTIONS ####
bootstrap_function <- function(column, N1, N2, B, X, param) {
  bdf <- as.data.frame(column)
  colnames(bdf) <- names(column)
  
  cl <- makeCluster(detectCores() - 1)  # Enable parallel processing with n-1 cores
  clusterExport(cl, c("bdf", "N1", "N2", "B", "X", "param"), envir = environment())  # Export the objects for parallel processing
  
  dfTemp <- switch(
    param,
    "mean" = {
        parLapply(cl, 1:X,
                  function(j) {
                    library(matrixStats) #matrixStats needs to be loaded within each worker node
                    result <- colMeans2(
                      mapply(
                      function(i) rowMeans2(
                        matrix(
                          sample(sample(bdf[, 1], i), B * i, replace = TRUE), B, i),
                        na.rm = TRUE),
                      N1:N2), 
                      na.rm = TRUE)
                    return(result)  
                    }
                  )
      }, 
    "sd" = {
      parLapply(cl, 1:X, 
                function(j) {
                  browser()
                  library(matrixStats) #matrixStats needs to be loaded within each worker node
                  result <- colSds(
                    mapply(
                    function(i) rowSds(
                      matrix(
                        sample(sample(bdf[, 1], i), B * i, replace = TRUE), B, i),
                      na.rm = TRUE),
                    N1:N2), 
                    na.rm = TRUE)
                  return(result)  
                  }
                )
      }
    )
      
  stopCluster(cl)

  browser() #use for debugging... 
  
  # Convert to dataframe and then name columns
  dfTemp <- as.data.frame(dfTemp)
  #colnames(dfTemp) <- paste0("est", 1:X)

  # Add identifiers
  dfTemp <- cbind("Group" = rep(names(column), nrow(dfTemp)), dfTemp)  # Add column with group identifier
  dfTemp <- cbind("n" = row.names(dfTemp), dfTemp) # Add column with sample size identifier
  
  return(dfTemp)
}


#### PREP THE DATA ####
df <- data.frame(
  "1.A"= c(10.7,9.7,10.7,11.9,10,10.5,9,10.9,9.6,11.8,8.7,11.9,10.7,10.4,12.7),
  "1.B"= c(11.7,10.2,10.9,11.4,10.3,9.8,9.7,10.2,10.6,8.6,9.1,9.8,13.3,9.8,8.3),
  "2.A"= c(11.6,10.6,9.9,10,11.3,10.4,11.2,8.3,9.2,11.2,11.3,11.2,11,8,9.2),
  "2.B"= c(10.7,11.5,10.1,8.9,11.5,9.5,12.1,10.7,8.2,10.2,9.6,10.4,8.3,11.1,9.4)
)


#### RUN THE ANALYSIS ####

# Replace any zero values with NA
df[df == 0] <- NA

# define lower and upper bounds for sample sizes to estimate
N1 <- 1
N2 <- nrow(df)

# set number of bootstrap replicates
B <- 100

# set number of times to repeat the estimate
X <- 100

# define which parameter to estimate - functions for "mean" and "sd" are supported
param <- "sd"


# Apply the bootstrap function to each column of the data frame
dfBoot <- as.data.frame(
  do.call(
    rbind, lapply(seq_along(df), function(x) {
      browser() # used to enter break mode inside lapply function call for debugging
      colname <- names(df)[x]
      print(paste("Processing column:", colname))
      bootstrap_function(column = df[x], N1 = N1, N2 = N2, B = B, X = X, param = param)
    })
    )
  )

问题原因与修复方案 #

1. 首个值NA的修复 #

当i=1时，matrix(..., B, i)生成B行1列的矩阵，rowSds计算单行标准差时，单个值的标准差为NaN，后续colSds处理时会转为NA；均值计算时rowMeans2不会出现此问题，但标准差逻辑需要特殊处理。

修复代码：
修改mapply内部的计算逻辑，单独处理i=1的情况：

function(i) {
  if (i == 1) {
    rep(0, B) # 单个值的标准差为0
  } else {
    rowSds(matrix(sample(sample(bdf[, 1], i), B * i, replace = TRUE), B, i), na.rm = TRUE)
  }
}

2. 数据框列名异常的修复 #

你注释掉了自定义列名的代码#colnames(dfTemp) <- paste0("est", 1:X)，导致as.data.frame(dfTemp)自动用向量值生成混乱的列名；同时row.names(dfTemp)是字符型行号，作为样本量标识不合理。

修复代码：
取消注释自定义列名代码，直接用N1:N2作为样本量列的值：

# Convert to dataframe and then name columns
dfTemp <- as.data.frame(dfTemp)
colnames(dfTemp) <- paste0("est", 1:X)

# Add identifiers
dfTemp <- cbind("Group" = rep(names(column), nrow(dfTemp)), dfTemp)
dfTemp <- cbind("n" = N1:N2, dfTemp) # 直接使用样本量范围数值，而非行名

额外优化建议 #

• 不要在每个并行任务中重复加载matrixStats，可以在集群初始化时一次性加载，提升效率：

cl <- makeCluster(detectCores() - 1)
clusterEvalQ(cl, library(matrixStats)) # 集群节点统一加载包
clusterExport(cl, c("bdf", "N1", "N2", "B", "X", "param"), envir = environment())

• 并行任务中的j参数未被使用，可简化为：parLapply(cl, rep(1,X), function(...) {...})

修复后的核心代码示例 #

以param="sd"为例：

"sd" = {
  parLapply(cl, 1:X, 
            function(...) {
              result <- colSds(
                mapply(
                  function(i) {
                    if (i == 1) {
                      rep(0, B)
                    } else {
                      rowSds(matrix(sample(sample(bdf[, 1], i), B * i, replace = TRUE), B, i), na.rm = TRUE)
                    }
                  },
                  N1:N2), 
                na.rm = TRUE)
              return(result)  
            }
          )
}

内容的提问来源于stack exchange，提问作者CBRF23