в R, если матрица выбирает первые элементы по строкам, если вектор выбирает первые элементы - PullRequest
Новая
       17

в R, если матрица выбирает первые элементы по строкам, если вектор выбирает первые элементы

0 голосов
/ 05 июня 2018

Существует ли элегантный синтаксис R для выбора, в зависимости от типа объекта, либо первые n элементы матрицы по строкам, либо первые n элементы вектора.

Iочевидно, можно сделать это с помощью условных выражений, но мне интересно, есть ли простое решение.Я также хочу избежать вызова t() для всей матрицы из-за проблем эффективности. 

M = matrix(1:12,3,4)
x = 1:12

slct = function(obj,n){
  if(is.matrix(obj)) res = c(t(obj))[1:n]
  if(is.vector(obj)) res = obj[1:n]
  res
}
slct(M,5); slct(x,5)

Ответы [ 5 ]

0 голосов
/ 05 июня 2018

Таким образом, ключом является отказ от вызова t() для всей матрицы.Я думаю, что другие решения более интересны и педагогичны, но самое быстрое, что я вижу, заключается в следующем.

Эффективность, вероятно, объясняется тем, что они полагаются на подпрограммы C для выполнения той же векторизации, что и другие.Вероятно, если вам нужно только определенное подмножество элементов 1: n, есть случаи, когда было бы быстрее изменить другие методы.

Я все еще задаюсь вопросом, есть ли какая-то встроенная программа, которая делает это?

Вот мои два решения (благодаря некоторым идеям из других постов): 

funOPmod2 = function(obj,n){
  if(is.matrix(obj)){ 
    nc = ncol(obj)
    nr = (n %/% nc) + 1
    subM = obj[1:nr,]
    res = matrix(subM, ncol = nr,
                 byrow = TRUE)[1:n] }
  if(is.vector(obj)) res = obj[1:n]
  res
}

funOPmod = function(obj,n){
  if(is.matrix(obj)){ 
    nc = ncol(obj)
    nr = (n %/% nc) + 1
    res = t(obj[1:nr,])[1:n] }
  if(is.vector(obj)) res = obj[1:n]
  res
}

funOP = function(obj,n){
  if(is.matrix(obj)) res = c(t(obj))[1:n]
  if(is.vector(obj)) res = obj[1:n]
  res
}


funRyan <- function(x, n){
  if(is.vector(x)) i <- 1:n
  if(is.matrix(x))
    i <- cbind(ceiling(1:n/ncol(x)), rep_len(seq(ncol(x)), n))
  x[i]
}

funEmil <- function(obj, n) {
  myDim <- dim(obj)
  vec <- 1:n
  if (is.null(myDim))
    return(obj[vec])

  nr <- myDim[1]
  nc <- myDim[2]
  vec1 <- vec - 1L
  rem <- vec1 %% nc
  quot <- vec1 %/% nc
  obj[quot + (rem * nr + 1L)]
}

n <- 25000

set.seed(42)
MBig <- matrix(sample(10^7, 10^6, replace = TRUE), nrow = 10^4)

## Returns same results
all.equal(funOPmod2(MBig, n), funOP(MBig, n))
all.equal(funOPmod(MBig, n), funOP(MBig, n))
all.equal(funOP(MBig, n), funEmil(MBig, n))
all.equal(funRyan(MBig, n), funEmil(MBig, n))



library(microbenchmark)
microbenchmark(funOP(MBig, n), funOPmod(MBig, n), funOPmod2(MBig, n), funRyan(MBig, n), funEmil(MBig, n), unit = "relative")

Unit: relative
               expr       min        lq      mean    median        uq        max neval
     funOP(MBig, n) 13.788456 13.343185 15.776079 13.104634 15.064036 13.1959488   100
  funOPmod(MBig, n)  1.052210  1.089507  1.071219  1.118461  1.025714  0.4533697   100
 funOPmod2(MBig, n)  1.000000  1.000000  1.000000  1.000000  1.000000  1.0000000   100
   funRyan(MBig, n)  2.689417  2.694442  2.464471  2.637720  2.351565  0.9274931   100
   funEmil(MBig, n)  2.760368  2.681478  2.434167  2.591716  2.308087  0.8921837   100
0 голосов
/ 05 июня 2018

Вот базовое решение R: 

funEmil <- function(obj, n) {
    myDim <- dim(obj)
    vec <- 1:n
    if (is.null(myDim))
        return(obj[vec])

    nr <- myDim[1]
    nc <- myDim[2]
    vec1 <- vec - 1L
    rem <- vec1 %% nc
    quot <- vec1 %/% nc
    obj[quot + (rem * nr + 1L)]
}

Используется базовая векторизованная модульная арифметика %% и целочисленное деление %/%.Это также очень быстро: 

set.seed(42)
MBig <- matrix(sample(10^7, 10^6, replace = TRUE), nrow = 10^4)

funOP = function(obj,n){
    if(is.matrix(obj)) res = c(t(obj))[1:n]
    if(is.vector(obj)) res = obj[1:n]
    res
}

funRyan <- function(x, n){
    if(is.vector(x)) i <- 1:n
    if(is.matrix(x))
        i <- cbind(ceiling(1:n/ncol(x)), rep_len(seq(ncol(x)), n))
    x[i]
}


n <- 25000

## Returns same results
all.equal(funRyan(MBig, n), funEmil(MBig, n))
[1] TRUE

all.equal(funOP(MBig, n), funEmil(MBig, n))
[1] TRUE

library(microbenchmark)
microbenchmark(funOP(MBig, n), funRyan(MBig, n), funWoody(MBig, n), unit = "relative")
Unit: relative
             expr      min       lq     mean   median       uq       max neval
   funOP(MBig, n) 6.154284 5.915182 5.659250 5.880826 9.140565 1.0344393   100
 funRyan(MBig, n) 1.015332 1.030278 1.028644 1.018446 1.032610 0.8330967   100
 funEmil(MBig, n) 1.000000 1.000000 1.000000 1.000000 1.000000 1.0000000   100

Вот эталонные тесты, использующие пример @Ryan и модифицированное решение OP: 

n <- 1e4
mat <- matrix(runif(n^2), n)
s <- floor(n*2.3)

microbenchmark(funOP(mat, s), funRyan(mat, s), 
               funWoody(mat, s), funOPmod(mat, s), unit = "relative", times = 10)
Unit: relative
            expr         min          lq        mean      median          uq         max neval
   funOP(mat, s) 6189.449838 5558.293891 3871.425974 5139.192594 2443.203331 2222.778805    10
 funRyan(mat, s)    2.633685    3.032467    2.155205    2.863710    1.445421    1.537473    10
 funEmil(mat, s)    2.654739    2.714287    1.969482    2.642673    1.277088    1.326510    10
funOPmod(mat, s)    1.000000    1.000000    1.000000    1.000000    1.000000    1.000000    10

Новое модифицированное намного быстрее и все еще дает правильноерезультаты .. очень впечатляющие !! 

identical(funOPmod(mat, s), funRyan(mat, s))
[1] TRUE
0 голосов
/ 05 июня 2018

Разве вы не можете просто использовать head? ... 

head(c(t(M)),5)
[1]  1  4  7 10  2

head(c(t(x)),5)
[1] 1 2 3 4 5
0 голосов
/ 05 июня 2018

Вы можете воспользоваться индексами массивов в [. 

# new function
slct2 <- function(x, n){
  if(is.vector(x)) i <- 1:n
  if(is.matrix(x))
    i <- cbind(ceiling(1:n/ncol(mat)), rep_len(seq(ncol(mat)), n))
  x[i]
}
# old function
slct = function(obj,n){
  if(is.matrix(obj)) res = c(t(obj))[1:n]
  if(is.vector(obj)) res = obj[1:n]
  res
}

Benchmark 

m <- 1e4
mat <- matrix(runif(m^2), m)
n <- floor(m*2.3)
all.equal(slct(mat, n), slct2(mat, n))
# [1] TRUE
microbenchmark(slct(mat, n), slct2(mat, n), times = 10)
# Unit: milliseconds
#           expr         min          lq        mean      median         uq        max neval
#   slct(mat, n) 2471.438599 2606.071460 3466.046729 3137.255011 4420.69364 4985.20781    10
#  slct2(mat, n)    2.358151    4.748712    6.627644    4.973533   11.05927   13.73906    10
0 голосов
/ 05 июня 2018

А как насчет этого?

slct = function(obj,n){
  if(is.matrix(obj)) res = as.vector(matrix(M, dim(M),
                                            byrow = TRUE))[1:n]
  if(is.vector(obj)) res = obj[1:n]
  res
}
> slct(M,5); slct(x,5)
[1] 1 5 9 2 6
[1] 1 2 3 4 5

Кажется, что в два раза быстрее в соответствии с тестом: 

Unit: microseconds
   expr   min    lq     mean median    uq       max neval cld
    t() 7.654 8.420 9.077494  8.675 8.675 10440.259 1e+05   b
 matrix 3.316 3.827 4.411272  4.082 4.083  9502.881 1e+05  a

Примечание: Вы должны указать is.vector вместо is.numeric во второй строке, поскольку is.numeric(M) дает TRUE.

...