Question

我正在开发包中进行一些单元测试。其中一项测试失败了。具体来说，我有代码和非并行版本的并行版本。非并行版本完美运行。并行版本未通过单元测试，看似无意义的错误。

## load my development package.
library(devtools) # for install_github
install_github("alexwhitworth/imputation")

## do some setup:
library(imputation)
library(kernlab)
library(parallel)


x1 <- matrix(rnorm(200), 20, 10)
x1[x1 > 1.25] <- NA
x3 <- create_canopies(x1, n_canopies= 5, q= 2)
prelim <- imputation:::impute_prelim(x3[[1]], parallel= TRUE, leave_cores= 1)

opt_h <- (4 * sd(x3[[1]][, -ncol(x3[[1]])], na.rm=T)^5 / (3 * nrow(x3[[1]])))^(1/5)
kern <- rbfdot(opt_h)


## write 2 identical functions:
## one in parallel
## one not in parallel

foo_parallel <- function(x_missing, x_complete, k, q, leave_cores) {
  cl <- makeCluster(detectCores() - leave_cores)
  x_missing_imputed <- parRapply(cl= cl, x_missing, function(i, x_complete) {
    rowID = as.numeric(i[1])
    i_original = unlist(i[-1])
    x_comp_rowID <- which(as.integer(rownames(x_complete)) == rowID)
    missing_cols <- which(is.na(x_complete[x_comp_rowID,]))

    # calculate distances
    distances <- imputation:::dist_q.matrix(x=rbind(x_complete[x_comp_rowID, ], 
                                                    x_complete[-x_comp_rowID,]), ref= 1L,  q= q)
    return(distances)
  }, x_complete= x_complete)
  stopCluster(cl)
  return(x_missing_imputed)
}

foo_nonparallel <- function(x_missing, x_complete, k, q) {
  x_missing_imputed <- t(apply(x_missing, 1, function(i, x_complete) {
    rowID = as.numeric(i[1])
    i_original = unlist(i[-1])
    x_comp_rowID <- which(as.integer(rownames(x_complete)) == rowID)
    missing_cols <- which(is.na(x_complete[x_comp_rowID,]))

    # calculate distances
    distances <- imputation:::dist_q.matrix(x=rbind(x_complete[x_comp_rowID, ], 
                                                    x_complete[-x_comp_rowID,]), ref= 1L,  q= q)
    return(distances)
  }, x_complete= x_complete))
  return(x_missing_imputed)
}

## test them
foo_parallel(prelim$x_missing, x3[[1]],k=3,q=2, leave_cores= 1) # fails
foo_nonparallel(prelim$x_missing, x3[[1]],k=3,q=2) # works

checkForRemoteErrors（val）出错： 2个节点产生错误;第一个错误：ref必须是{1，nrow（x）}中的整数。

如您所见，ref明确定义为ref= 1L，其为1，nrow（x）。

与library(parallel)的互动导致此错误的原因是什么？

修改 - 我在Windows机器上：

R> sessionInfo()
R version 3.2.2 (2015-08-14)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1

Answer 1

我已经弄明白是什么导致了这个问题。在我看来，这是一个library(parallel) bug / edge-case，特定于apply函数的并行化版本（在本例中为parRapply）。也许有些年龄更大，更聪明的人可以解释为什么library(parallel)没有抓住这个边缘案例。

问题似乎与任务数量与可用工作人员数量有关。在我的机器上，我有一个8核处理器。在这种情况下，有5个任务（prelim$x_missing每行一个）。

当然，在典型的使用中，我不会为5行并行工作。这只是一个单元测试。

R> prelim$x_missing
              X1         X2         X3         X4         X5          X6         X7         X8          X9        X10 d_factor
6   6  0.2604170 -0.5966874         NA         NA -0.3013053  0.24313272  0.2836760  0.3977164 -0.60711109 -0.2929253        1
7   7 -0.8540576  0.1409047         NA  0.4801685 -0.9324517 -0.06487733 -0.2220201         NA  1.19077335 -0.3702607        2
8   8  0.5118453 -0.8750674         NA  0.1787238  0.6897163  0.20695122         NA -0.3488021  0.84200408 -0.4791230        1
12 12  0.3695746 -0.4919277 -1.2509180  1.1642152         NA  0.04018417         NA         NA -0.53436589 -1.5400345        2
15 15         NA -0.3608242 -0.6761515 -0.5366562  0.1763501          NA         NA  0.4967595  0.02635203 -0.6015536        1

请注意，我通过cl <- parallel::makeCluster(detectCores() - leave_cores)创建群集，其中detectCores（）将为当前计算机返回8。函数调用接受一个参数，表示要保持打开leave_cores的核心数。当我在用例中创建一个核心/节点多于行的集群时，该函数将失败。当我使用＆lt; =行数创建一个集群时，该函数有效：

 # works : detectCores() == 8, 8 - 3 == 5 (number of rows / processes)
R> foo_parallel(prelim$x_missing, x3[[1]],k=3,q=2, leave_cores= 3)
 [1] 1.0216313 0.7355635 0.9201501 0.6906554 0.6613939 0.3628872 0.9995641 0.8571252 0.9271800 0.9201501 0.9238215 0.9798824 0.9059506
[14] 0.6891484 1.0158223 0.5442953 0.6906554 0.9238215 0.8607280 0.5897955 1.1084943 0.8518322 0.9227102 0.6613939 0.9798824 0.8607280
[27] 0.9518105 0.9792209 1.1968528 0.4447104 0.3628872 0.9059506 0.5897955 0.9518105 1.1249624

# fails : 8-2 = 6; 6 > nrow(prelim$x_missing)
R> foo_parallel(prelim$x_missing, x3[[1]],k=3,q=2, leave_cores= 2) 
Error in checkForRemoteErrors(val) : 
  one node produced an error: ref must be an integer in {1, nrow(x)}.

TL，博士

如rparallel vignette中所述，detectCores用于简单地检测核心，它非常合理地不会尝试将任务智能分配给工作人员。

function detectCores（）尝试确定运行R的机器中的CPU核心数量：它有办法在所有已知的当前R上执行此操作平台。它的具体措施是针对特定操作系统的：我们尽可能地报告可用的物理内核数量。在Windows上，默认情况下是报告逻辑CPU的数量。在现代硬件（例如Intel Core i7）上，后者可能并非不合理，因为超线程确实具有重要意义额外吞吐量。

我正在调用函数parallel::parRapply来进行计算。 parRapply通过splitRows函数将工作分发给工作人员。但似乎没有任何情报或错误捕捉到splitRows功能。

R> parRapply
function (cl = NULL, x, FUN, ...) 
{
    cl <- defaultCluster(cl)
    do.call(c, clusterApply(cl = cl, x = splitRows(x, length(cl)), 
        fun = apply, MARGIN = 1L, FUN = FUN, ...), quote = TRUE)
}
<bytecode: 0x00000000380ca530>
<environment: namespace:parallel>

我无法找到splitRows的源代码，但parallel::splitIndices似乎相似：

R> parallel:::splitIndices
function (nx, ncl) 
{
    i <- seq_len(nx)
    if (ncl == 0L) 
        list()
    else if (ncl == 1L || nx == 1L) 
        list(i)
    else {
        fuzz <- min((nx - 1L)/1000, 0.4 * nx/ncl)
        breaks <- seq(1 - fuzz, nx + fuzz, length = ncl + 1L)
        structure(split(i, cut(i, breaks)), names = NULL)
    }
}
<bytecode: 0x00000000380a7828>
<environment: namespace:parallel>

在我的单元测试中，这将按以下方式执行：

# all 8 cores:
nx <- 5; ncl <- 8
i <- seq_len(nx)
fuzz <- min((nx - 1L)/1000, 0.4 * nx / ncl)
breaks <- seq(1 - fuzz, nx + fuzz, length= ncl + 1L)
structure(split(i, cut(i, breaks)), names = NULL)
[[1]]
[1] 1

[[2]]
integer(0)

[[3]]
[1] 2

[[4]]
integer(0)

[[5]]
[1] 3

[[6]]
[1] 4

[[7]]
integer(0)

[[8]]
[1] 5

如果有3个整数（0）s，则会导致调用堆栈进一步失效。

# 3 cores (just showing the return):
structure(split(i, cut(i, breaks)), names = NULL)
[[1]]
[1] 1 2

[[2]]
[1] 3

[[3]]
[1] 4 5

如果有人可以在下面的评论中为splitRows的源代码提供链接，我会很高兴地更新此答案。可以轻松找到parallel::clusterApply和parallel:::staticClusterApply的代码

R并行 - parRapply无法正常工作

1 个答案:

TL，博士