Question

我正在尝试在Rcpp中创建一个函数，它将成对数字矩阵作为输入，以及向量列表，每个元素都是行/列名称的子集。我希望这个函数识别匹配这些名称的矩阵的子集，并返回值的平均值。

下面我生成了一些类似于我所拥有的数据类型的虚拟数据，然后尝试使用Rcpp函数。

library(Rcpp)

dat <- c(spA = 4, spB = 10, spC = 8, spD = 1, spE = 5, spF = 9)
pdist <- as.matrix(dist(dat))
pdist[upper.tri(pdist, diag = TRUE)] <- NA

这里我有一个由pdist中行/列名称的各个子集的字符向量组成的列表

subsetList <- replicate(10, sample(names(dat), 4), simplify=FALSE)

对于这些名称中的每一组，我想确定成对矩阵的子集并取值的平均值

这是我到目前为止所做的，但这不起作用，但我认为它说明了我想要得到的地方。

cppFunction('
    List meanDistByCell(List input, NumericMatrix pairmat) {
    int n = input.size();
    List out(n);

    List dimnames = pairmat.attr( "dimnames" );
    CharacterVector colnames = dimnames[1];

    for (int i = 0; i < n; i++) {

        CharacterVector sp = as< CharacterVector >(input[i]);

        if (sp.size() > 0) {
            out[i] = double(mean(pairmat(sp, sp)));
        } else {
            out[i] = NA_REAL;
        }
    }
    return out;
}
')

任何帮助将不胜感激！谢谢！

Answer 1

虽然（连续的）基于范围的子集可用（例如x(Range(first_row, last_row), Range(first_col, last_col))），如无外套指出，目前不支持CharacterVector的子集，因此您必须自己滚动时间存在。一般的方法可能看起来像这样：

template <int RTYPE> inline Matrix<RTYPE>
Subset2D(const Matrix<RTYPE>& x, CharacterVector crows, CharacterVector ccols) {
    R_xlen_t i = 0, j = 0, rr = crows.length(), rc = ccols.length(), pos;
    Matrix<RTYPE> res(rr, rc);

    CharacterVector xrows = rownames(x), xcols = colnames(x);
    IntegerVector rows = match(crows, xrows), cols = match(ccols, xcols);

    for (; j < rc; j++) {
        // NB: match returns 1-based indices
        pos = cols[j] - 1;
        for (i = 0; i < rr; i++) {
            res(i, j) = x(rows[i] - 1, pos);
        }
    }

    rownames(res) = crows;
    colnames(res) = ccols;

    return res;
}

// [[Rcpp::export]]
NumericMatrix subset2d(NumericMatrix x, CharacterVector rows, CharacterVector cols) {
    return Subset2D(x, rows, cols);
}

这假设输入矩阵具有行名和列名，并且行和列查找向量是这些dimnames的有效子集;可以添加额外的防御性代码以使其更加强大。为了演示，

subset2d(pdist, subsetList[[1]], subsetList[[1]])
#     spB spD spE spC
# spB  NA  NA  NA  NA
# spD   9  NA  NA   7
# spE   5   4  NA   3
# spC   2  NA  NA  NA

pdist[subsetList[[1]], subsetList[[1]]]
#     spB spD spE spC
# spB  NA  NA  NA  NA
# spD   9  NA  NA   7
# spE   5   4  NA   3
# spC   2  NA  NA  NA

Subset2D负责实施meanDistByCell所涉及的大多数样板文件;剩下的就是遍历输入列表，将其应用于每个列表元素，并将结果的平均值存储在输出列表中：

// [[Rcpp::export]]
List meanDistByCell(List keys, NumericMatrix x, bool na_rm = false) {
    R_xlen_t i = 0, sz = keys.size();
    List res(sz);

    if (!na_rm) {
        for (; i < sz; i++) {
            res[i] = NumericVector::create(
                mean(Subset2D(x, keys[i], keys[i]))
            );
        }
    } else {
        for (; i < sz; i++) {
            res[i] = NumericVector::create(
                mean(na_omit(Subset2D(x, keys[i], keys[i])))
            );
        }
    }

    return res;
}

all.equal(
    lapply(subsetList, function(x) mean(pdist[x, x], na.rm = TRUE)),
    meanDistByCell2(subsetList, pdist, TRUE)
)
# [1] TRUE

尽管使用Subset2D可以更清晰地实现meanDistByCell，但在这种情况下，至少有几个原因它是低效的：

它设置了返回对象（rownames(res) = crows;，colnames(res) = ccols;）的dimnames，这里你不需要它。
调用match获取 rownames和colnames的每个的索引，这是不必要的，因为您事先知道{{1} }}。

对于长度为rownames(x) == colnames(x)的输入列表，您将产生这两个点k次的费用。

更有效 - 但因此不那么简洁 - 的方法是基本上只实现k内嵌所需的Subset2D方面：

meanDistByCell

// [[Rcpp::export]]
List meanDistByCell2(List keys, NumericMatrix x, bool na_rm = false) {
    R_xlen_t k = 0, sz = keys.size(), i = 0, j = 0, nidx, pos;
    List res(sz);
    CharacterVector cx = colnames(x);

    if (!na_rm) {
        for (; k < sz; k++) {
            // NB: match returns 1-based indices
            IntegerVector idx = match(as<CharacterVector>(keys[k]), cx) - 1;
            nidx = idx.size();
            NumericVector tmp(nidx * nidx);

            for (j = 0; j < nidx; j++) {
                pos = idx[j];
                for (i = 0; i < nidx; i++) {
                    tmp[nidx * j + i] = x(idx[i], pos);
                }
            }

            res[k] = NumericVector::create(mean(tmp));
        }
    } else {
        for (; k < sz; k++) {
            IntegerVector idx = match(as<CharacterVector>(keys[k]), cx) - 1;
            nidx = idx.size();
            NumericVector tmp(nidx * nidx);

            for (j = 0; j < nidx; j++) {
                pos = idx[j];
                for (i = 0; i < nidx; i++) {
                    tmp[nidx * j + i] = x(idx[i], pos);
                }
            }

            res[k] = NumericVector::create(mean(na_omit(tmp)));
        }
    }

    return res;
}

Rcpp中按行和列名称的子集NumericMatrix

1 个答案: