如何从RCPP中调用model.matrix或等效项(可能在线程代码中)?

时间:2019-04-30 19:33:56

标签: rcpp

我们希望使用线程来加快算法的运行速度,该算法具有许多循环,而循环的结果彼此无关。

在我们希望移植到rcpp的代码中,有一个对model.matrix的调用。

这看起来并不容易移植。

对此进行进一步的调查(关于在我们的用例中运行什么代码),发现lm对象的S3方法对变量进行了一些准备工作,然后调用了函数的默认版本,如该副本所示。 -粘贴代码:

function (object, ...) 
{
    if (n_match <- match("x", names(object), 0L)) 
        object[[n_match]]
    else {
        data <- model.frame(object, xlev = object$xlevels, ...)
        if (exists(".GenericCallEnv", inherits = FALSE)) 
            NextMethod("model.matrix", data = data, contrasts.arg = object$contrasts)
        else {
            dots <- list(...)
            dots$data <- dots$contrasts.arg <- NULL
            do.call("model.matrix.default", c(list(object = object, 
                data = data, contrasts.arg = object$contrasts), 
                dots))
        }
    }
}

该功能的默认版本至少将其某些功能植入到已编译的C函数中:

function (object, data = environment(object), contrasts.arg = NULL, 
    xlev = NULL, ...) {
    t <- if (missing(data)) 
        terms(object)
    else terms(object, data = data)
    if (is.null(attr(data, "terms"))) 
        data <- model.frame(object, data, xlev = xlev)
    else {
        reorder <- match(vapply(attr(t, "variables"), deparse2, 
            "")[-1L], names(data))
        if (anyNA(reorder)) 
            stop("model frame and formula mismatch in model.matrix()")
        if (!identical(reorder, seq_len(ncol(data)))) 
            data <- data[, reorder, drop = FALSE]
    }
    int <- attr(t, "response")
    if (length(data)) {
        contr.funs <- as.character(getOption("contrasts"))
        namD <- names(data)
        for (i in namD) if (is.character(data[[i]])) 
            data[[i]] <- factor(data[[i]])
        isF <- vapply(data, function(x) is.factor(x) || is.logical(x), 
            NA)
        isF[int] <- FALSE
        isOF <- vapply(data, is.ordered, NA)
        for (nn in namD[isF]) if (is.null(attr(data[[nn]], "contrasts"))) 
            contrasts(data[[nn]]) <- contr.funs[1 + isOF[nn]]
        if (!is.null(contrasts.arg)) {
            if (!is.list(contrasts.arg)) 
                warning("non-list contrasts argument ignored")
            else {
                if (is.null(namC <- names(contrasts.arg))) 
                  stop("'contrasts.arg' argument must be named")
                for (nn in namC) {
                  if (is.na(ni <- match(nn, namD))) 
                    warning(gettextf("variable '%s' is absent, its contrast will be ignored", 
                      nn), domain = NA)
                  else {
                    ca <- contrasts.arg[[nn]]
                    if (is.matrix(ca)) 
                      contrasts(data[[ni]], ncol(ca)) <- ca
                    else contrasts(data[[ni]]) <- contrasts.arg[[nn]]
                  }
                }
            }
        }
    }
    else {
        isF <- FALSE
        data[["x"]] <- raw(nrow(data))
    }
    ans <- .External2(C_modelmatrix, t, data)
    if (any(isF)) 
        attr(ans, "contrasts") <- lapply(data[isF], attr, 
            "contrasts")
    ans
}

是否有某种方法可以从Rcpp调用C_modelmatrix,无论它是单线程还是多线程?是否有任何库或程序包在Rcpp中具有基本相同的功能,所以我不必在这里重新发明轮子吗?如果可以避免的话,我宁愿不必完全重新实现model.matrix所做的一切。

由于我们实际上没有可运行的代码,因此尚无任何显示。

我们试图加速的函数的相关部分将这样调用model.matrix :(“ model.y是lm”,数据都是model.frame(model.y)返回的原始对象的副本)

ymat.t <- model.matrix(terms(model.y), data=pred.data.t)
ymat.c <- model.matrix(terms(model.y), data=pred.data.c)

这实际上不是基于结果的问题,更多是基于方法/方法的问题

1 个答案:

答案 0 :(得分:0)

您可以在C ++中调用 2010 0101 01 3117 2010 0108 08 2850 2010 0115 15 2607 2010 0122 22 2521 2019 0322 22 1107 2019 0329 29 1130 2019 0405 05 1155 2019 0412 12 1247 2019 0419 19 1339 ,但是不能以多线程方式进行。

也会有开销,但是如果在代码中间很深处需要函数调用,为方便起见,值得这样做。

示例:

model.matrix