如何从RCPP调用model.matrix或等价物，可能在线程代码中？

Question

我们希望在具有许多循环的算法中使用线程来使事情变得更快，这些循环的结果不是相互依赖的。

在我们希望移植到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)

这不是一个基于结果的问题，更多的是基于方法/方法的问题

Answer 1

您可以在C ++中调用model.matrix，但不能以多线程方式执行此操作。

也会有开销，但如果在代码中间需要函数调用，那么为方便起见可能是值得的。

例：

// [[Rcpp::export]]
RObject call(RObject x, RObject y){
  Environment env = Environment::global_env();
  Function f = env["model.matrix"];
  RObject res = f(x,y);
  return res;
}