mlr-org / parallelMap

R package to interface some popular parallelization backends with a unified interface
https://parallelmap.mlr-org.com
Other
57 stars 14 forks source link

mcmapply executes sequentially #1

Closed mllg closed 10 years ago

mllg commented 11 years ago

See this (over a year old) bug report : https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=15016

I'd not suspect it to get fixed anytime soon, but it is rather easy to bypass.

berndbischl commented 10 years ago

Michel, how would you bypass it? In parallelMap I mean?

I added a unit test to check this for now.

berndbischl commented 10 years ago

I talked to Uwe. I will try to fix this upstream in "parallel".

berndbischl commented 10 years ago

TODO: reenable test when this is done

mllg commented 10 years ago

Did you manage to push this upstream?

mcmapply uses a wrapper to mclapply, so I did the same w/o this strange if clause (n <= mc.cores).

berndbischl commented 10 years ago

No, no I need at least a few days for this.

I talked to Uwe about this like 48h hours ago in very general terms, I havent even had time to check the parallel sources.

ETA: around Friday, if the code does not suck.

berndbischl commented 10 years ago

Apparently, I don't have time for this to fix it upstream now. Hopefully I can do it later, will disable test for now, so we can check / travis works.

mllg commented 10 years ago

Maybe the best solution for now: Keep a fixed version of mcmapply in the package. You only need to fix one line, see comment.

mcmapply_fixed = function (FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES = TRUE,
    mc.preschedule = TRUE, mc.set.seed = TRUE, mc.silent = FALSE,
    mc.cores = getOption("mc.cores", 2L), mc.cleanup = TRUE) {
    FUN <- match.fun(FUN)
    dots <- list(...)
    if (!length(dots))
        return(list())
    lens <- sapply(dots, length)
    n <- max(lens)
    if (n && min(lens) == 0L)
        stop("Zero-length inputs cannot be mixed with those of non-zero length")
    answer <- if (mc.cores == 1L) # <- only touched this line!
        .mapply(FUN, dots, MoreArgs)
    else {
        X <- if (!all(lens == n))
            lapply(dots, function(x) rep(x, length.out = n))
        else dots
        do_one <- function(indices, ...) {
            dots <- lapply(X, function(x) x[indices])
            .mapply(FUN, dots, MoreArgs)
        }
        answer <- mclapply(seq_len(n), do_one, mc.preschedule = mc.preschedule,
            mc.set.seed = mc.set.seed, mc.silent = mc.silent,
            mc.cores = mc.cores, mc.cleanup = mc.cleanup)
        do.call(c, answer)
    }
    if (USE.NAMES && length(dots)) {
        if (is.null(names1 <- names(dots[[1L]])) && is.character(dots[[1L]]))
            names(answer) <- dots[[1L]]
        else if (!is.null(names1))
            names(answer) <- names1
    }
    if (!identical(SIMPLIFY, FALSE) && length(answer))
        simplify2array(answer, higher = (SIMPLIFY == "array"))
    else answer
}
berndbischl commented 10 years ago

I hate doing stuff like that, but this is better then being annoyed by this stupid thing anymore.

Thanks a lot for putting in the work.

I included thus now, and re-enabled the unit test. We pass.