R 引导两个数据帧的单独列

Question

想要在按列比较具有不同行数的两个数据帧时进行引导。

我有两个数据框，其中行代表实验值，列代表数据集名称（data1、data2、data3、data4）

emp.data1 <- data.frame(
    data1 = c(234,0,34,0,46,0,0,0,2.26,0, 5,8,93,56),
    data2 = c(1.40,1.21,0.83,1.379,2.60,9.06,0.88,1.16,0.64,8.28, 5,8,93,56),
    data3 =c(0,34,43,0,0,56,0,0,0,45,5,8,93,56),
    data4 =c(45,0,545,34,0,35,0,35,0,534, 5,8,93,56),
    stringsAsFactors = FALSE
  )
  
emp.data2 <- data.frame(
    data1 = c(45, 0, 0, 45, 45, 53),
    data2 = c(23, 0, 45, 12, 90, 78),
    data3 = c(72, 45, 756, 78, 763, 98),
    data4 = c(1, 3, 65, 78, 9, 45),
    stringsAsFactors = FALSE
  )

我正在尝试进行引导(n=1000)。值是从 emp.data1(14 * 4) 中随机替换 selected，而 emp.data2(6 * 4) 没有变化。例如，来自 emp.data2 第一列 (data1) select 6 个值 colSum 和来自 emp.data1(data1) select 6 个随机非零值 colSum 将值相除并存储在 temp 中重复相同的 1000 次并取中值 et 最后。像这样我想为数据框的每一列做这件事。我提供的示例代码工作正常，但我无法获得 emp.data1

的非零随机值

nboot <- 1e3

boot_temp_emp<- c()
n_data1 <- nrow(emp.data1); n_data2 <- nrow(emp.data2)

for (j in seq_len(nboot)) {
  boot <- sample(x = seq_len(n_data1), size = n_data2, replace = TRUE)
  value <- colSums(emp.data2)/colSums(emp.data1[boot,])
  boot_temp_emp <- rbind(boot_temp_emp, value)
}
boot_data<- apply(boot_temp_emp, 2, median)

从上面的脚本我可以得到输出，但是每列 emp.data1[boot,] 数据都有零值并求和。我想要 indivisual ramdomly selected 非零值列总和所以我尝试了下面的脚本无法删除零值。无法获得所需的输出请有人帮助我更正我的脚本

nboot <- 1e3
boot_temp_emp<- c()

for (i in colnames(emp.data2)){
  for (j in seq_len(nboot)){
        data1=emp.data1[i]
        data2=emp.data2[i]
        n_data1 <- nrow(data1); n_data2 <- nrow(data2)
        boot <- sample(x = seq_len(n_data1), size = n_data2, replace = TRUE)
        value <- colSums(data2[i])/colSums(data1[boot, ,drop = FALSE])
        boot_temp_emp <- rbind(boot_temp_emp, value)
  }
}
boot_data<- apply(boot_temp_emp, 2, median)

谢谢

Answer 1

这是一个解决方案。
写一个函数让代码更清晰。此函数采用以下参数。

x 输入 data.frame emp.data1;
s2 emp.data2;
n = 6 从 emp.data1 的列中抽样的向量元素数，默认值为 6。

创建结果矩阵，pre-compute emp.data2 的列总和并循环调用函数。

boot_fun <- function(x, s2, n = 6){
  # the loop makes sure ther is no divide by zero
  nrx <- nrow(x)
  repeat{
    i <- sample(nrx, n, replace = TRUE)
    s1 <- colSums(x[i, ])
    if(all(s1 != 0)) break
  }
  s2/s1
}

set.seed(2022)

nboot <- 1e3
sums2 <- colSums(emp.data2)
results <- matrix(nrow = nboot, ncol = ncol(emp.data1))

for(i in seq_len(nboot)){
  results[i, ] <- boot_fun(emp.data1, sums2)
}
ratios_medians <- apply(results, 2, median)

old_par <- par(mfrow = c(2, 2))
for(j in 1:4) {
  main <- paste0("data", j)
  hist(results[, j], main = main, xlab = "ratios", freq = FALSE)
  abline(v = ratios_medians[j], col = "blue", lty = "dashed")
}
par(old_par)

^{由 reprex package (v2.0.1)}

于 2022-02-24 创建

编辑

这里的注释后面是bootstrap函数的修改版。在计算它们的总和之前，它确保采样向量中没有零。

boot_fun2 <- function(x, s2, n = 6){
  nrx <- nrow(x)
  ncx <- ncol(x)
  s1 <- numeric(ncx)
  for(j in seq.int(ncx)) {
    repeat{
      i <- sample(nrx, n, replace = TRUE)
      if(all(x[i, j] != 0)) {
        s1[j] <- sum(x[i, j])
        break
      }
    }
  }
  s2/s1
}

set.seed(2022)

nboot <- 1e3
sums2 <- colSums(emp.data2)
results2 <- matrix(nrow = nboot, ncol = ncol(emp.data1))

for(i in seq_len(nboot)){
  results2[i, ] <- boot_fun2(emp.data1, sums2)
}
ratios_medians2 <- apply(results2, 2, median)

old_par <- par(mfrow = c(2, 2))
for(j in 1:4) {
  main <- paste0("data", j)
  hist(results2[, j], main = main, xlab = "ratios", freq = FALSE)
  abline(v = ratios_medians2[j], col = "blue", lty = "dashed")
}
par(old_par)

^{由 reprex package (v2.0.1)}

于 2022-02-27 创建

R 引导两个数据帧的单独列

R bootstrapping for the two dataframe individual column wise

r

statistics-bootstrap

编辑