2013-11-01 3 views
4

У меня есть следующий код R:Реализация R в C++ Rcpp

CutMatrix <- FullMatrix[, colSums(FullMatrix[-1,] != FullMatrix[-nrow(FullMatrix), ]) > 0] 

Который берет матрицу - FullMatrix и делает CutMatrix, находя какие столбцы в FullMatrix имеют столбцы с более чем 1 уникальным значением - так все столбцы с одинаковым значением исключаются. Мне интересно, могу ли я использовать Rcpp для ускорения этого для больших матриц, но я не уверен в том, что это лучший способ сделать это - есть ли простой способ сделать это с помощью сахара (скажем, перейдя через столбцы и подсчитывая количество уникальных значений), или если мне придется использовать что-то более сложное из STL.

Я думал, может быть, что-то вроде следующего было началом (мне не удалось полностью пройти) - попытка выполнить операцию между скобками colSums в функции R, но я не думаю, m правильно устанавливает матрицу, так как она не работает.

src <- ' 
//Convert the inputted character matrix of DNA sequences an Rcpp class. 
Rcpp::CharacterMatrix mymatrix(inmatrix); 

//Get the number of columns and rows in the matrix 
int ncolumns = mymatrix.ncol(); 
int numrows = mymatrix.nrow(); 

//Get the dimension names 
Rcpp::List dimnames = mymatrix.attr("dimnames"); 

Rcpp::CharacterMatrix vec1 = mymatrix(Range(1,numrows),_); 
Rcpp::CharacterMatrix vec2 = mymatrix(Range(0,numrows-1),_); 
' 

uniqueMatrix <- cxxfunction(signature(inmatrix="character"), src, plugin="Rcpp") 

Thanks, Ben.

+0

Посмотрите на эти две должности Rcpp Галерея на Armadillo индексации. С другой стороны, если у вас есть типы символов, возможно, вам просто нужен простой цикл (быстрый в C++) для сравнения строк с предыдущими строками. Вам не нужно кодировать это как векторное решение ... –

+0

Бен - любой товар? –

ответ

2

Это возвращает LogicalVector который FALSE для всех этих колонок с только один unique значения, которые вы можете использовать для подмножества вашей R matrix.

require(Rcpp) 
cppFunction(' 
    LogicalVector unq_mat(CharacterMatrix x){ 

    int nc = x.ncol() ; 
    LogicalVector out(nc); 

    for(int i=0; i < nc; i++) { 
    out[i] = unique(x(_,i)).size() != 1 ; 
    } 
    return out; 
}' 
) 

Вы можете использовать его как это ...

# Generate toy data 
set.seed(1) 
mat <- matrix(as.character(c(rep(1,5),sample(3,15,repl=TRUE),rep(5,5))),5) 
    [,1] [,2] [,3] [,4] [,5] 
[1,] "1" "1" "3" "1" "5" 
[2,] "1" "2" "3" "1" "5" 
[3,] "1" "2" "2" "3" "5" 
[4,] "1" "3" "2" "2" "5" 
[5,] "1" "1" "1" "3" "5" 

mat[ , unq_mat(mat) ] 
    [,1] [,2] [,3] 
[1,] "1" "3" "1" 
[2,] "2" "3" "1" 
[3,] "2" "2" "3" 
[4,] "3" "2" "2" 
[5,] "1" "1" "3" 

Некоторые основные бенчмаркинг ...

applyR <- function(y) { y[ , apply(y , 2 , function(x) length(unique(x)) != 1L) ] } 
rcpp <- function(x) x[ , unq_mat(x) ] 

require(microbenchmark) 
microbenchmark(applyR(mat) , rcpp(mat)) 
#Unit: microseconds 
#  expr min  lq median  uq max neval 
# applyR(mat) 131.94 134.737 136.31 139.29 268.07 100 
# rcpp(mat) 4.20 4.901 7.70 8.05 13.30 100 
Смежные вопросы