рекурсивно сортировать вектор в R

Question

У меня есть задача вроде

n <- 5
set.seed(11)
X <- rnorm(n)

X.sort <- {}
for(i in 1:n){
  X.sort <- sort.int(c(X.sort, X[i]), decreasing = TRUE)
  print(X.sort) # actually, other computations with X.sort
}

, что приводит к выводу вида

[1] -0.5910311
[1]  0.02659437 -0.59103110
[1]  0.02659437 -0.59103110 -1.51655310
[1]  0.02659437 -0.59103110 -1.36265335 -1.51655310
[1]  1.17848916  0.02659437 -0.59103110 -1.36265335 -1.51655310

Мне кажется неэффективным «пересортировать» X.sort в каждом раунде цикла, когда вектор уже отсортирован, за исключением новой записи X[i], которая должна быть вставлена.

Я пытался "сказать" R, куда вставить элемент через

library(R.utils)

X.sort <- {}
for(i in 1:n){
  pos <- match(F, X.sort>X[i])
  if(is.na(pos)){
    X.sort <- c(X.sort,X[i])
  } else {
    X.sort <- insert(X.sort, pos, X[i])                      
  }
  print(X.sort)
}

но это не дает никакой выгоды при тестировании.

Есть очевидное улучшение или R уже эффективно использует знание, что X.sort отсортирован?

EDIT:

Бенчмаркинг предлагает [НО ПОЖАЛУЙСТА, ТАКЖЕ РАССМОТРЕТЬ ОТВЕТЫ НИЖЕ] принятого ответа, чтобы быть самым быстрым (по крайней мере, когда n приближается к 1000), что, к тому же, кажется, также работает для больших n и является самым простым один.

library(R.utils)
library(microbenchmark)
n <- 600
set.seed(11)
X <- rnorm(n)

sorted_insert <- function(x, y) { 
  c(x[x >= y], y, x[x < y]) 
}

recursive_fun <- function(ans=list(NULL), vec, i=1) { 
  if (i > length(vec)) {
    tail(ans, -1)
  } else {
    ans <- c(ans, list(sorted_insert(ans[[i]], vec[i]))) 
    recursive_fun(ans=ans, vec, i=i+1) 
  }
}

microbenchmark(
  {
    X.sort <- {}
    for(i in 1:n){
      X.sort <- sort.int(c(X.sort, X[i]), decreasing = TRUE)
    }
  },{
    X.sort <- {}
    for(i in 1:n){
      pos <- match(F, X.sort>X[i])
      if(is.na(pos)){
        X.sort <- c(X.sort,X[i])
      } else {
        X.sort <- insert(X.sort, pos, X[i])                      
      }
    }
    },{
    X.sort <- {X[1]}
    for(i in 2:n){
      X.sort <- append(X.sort, X[i], after = sum(X.sort > X[i]))
    }
  },{
    lapply(seq_along(X), function(a) {sort(X[seq_len(a)], decreasing = T)})
  },{
    lapply(1:length(X), function(i) sort(X[1:i], decreasing = T))
  },
  {
    recursive_fun(vec=X)
  },
  times=50
)

Результат:

       min        lq      mean    median        uq       max neval
 21.308012 22.264314 24.065012 22.798643 26.381362 34.629395    50
 19.554413 20.334643 21.875769 20.617807 24.085896 30.625841    50
  4.497919  4.804550  5.380192  4.912923  5.114310 13.522485    50
 23.540616 24.105807 25.311692 24.335780 24.985024 30.348792    50
 23.251905 24.067122 25.722031 24.745380 27.986197 30.010018    50
  3.928746  4.096568  4.358911  4.258701  4.390684  9.106202    50

Answer 1

Узким местом в вашем коде на самом деле является оператор print.

Вот еще один способ, который примерно в 5 раз быстрее (если вам не нужно печатать):

n <- 10000
set.seed(11)
X <- rnorm(n)

X.sort <- {X[1]}
for(i in 2:n){
  X.sort <- append(X.sort, X[i], after = sum(X.sort > X[i]))
}

Answer 2

Вы можете попробовать этот рекурсивный подход

, работающая функция - sorted_insert, которая вставляет новый элемент в векторное положение между элементами >= new-element, vec[vec >= y] и < new-element, vec[vec < y].Это предполагает, что вектор всегда сортируется (что в данном случае верно).

sorted_insert <- function(x, y) { 
    c(x[x >= y], y, x[x < y]) 
}

sorted_function вызывается рекурсивно recursive_fun.Если счетчик i равен <= длины вектора (то есть весь несортированный входной вектор не был пройден), то он вызовет sorted_function, используя предыдущий отсортированный ответ, ans[[i]] в качестве входноговектор и vec[i] как новый элемент для вставки.Таким образом, отсортированный вектор на каждой итерации создается с использованием отсортированного вектора из предыдущей итерации и нового элемента из unsorted-input-vector.Извините, старался изо всех сил, чтобы объяснить это.

recursive_fun <- function(ans=list(NULL), vec, i=1) { 
    if (i > length(vec)) {
        tail(ans, -1)
    } else {
        ans <- c(ans, list(sorted_insert(ans[[i]], vec[i]))) 
        recursive_fun(ans=ans, vec, i=i+1) 
    }
}

Используя данный пример

n <- 5
set.seed(11)
X <- rnorm(n)
recursive_fun(vec=X)

Более крупный пример

n <- 1000
set.seed(11)
X <- rnorm(n)
recursive_fun(vec=X)

Возникла проблема, если ваш несортированный-вход-вектор большой

n <- 10000
set.seed(11)
X <- rnorm(n)
recursive_fun(vec=X)
# Error: evaluation nested too deeply: infinite recursion / options(expressions=)?

Обратите внимание, что если вы не хотите собирать результат на каждой итерации, вы можете использовать Reduce(sorted_insert, X), что должно быть быстрым.

Answer 3

Вот способ с lapply -

n <- 5
set.seed(11)
x <- rnorm(n)

lapply(seq_along(x), function(a) {
  sort(x[seq_len(a)], decreasing = T)
})

[[1]]
[1] -0.5910311

[[2]]
[1]  0.02659437 -0.59103110

[[3]]
[1]  0.02659437 -0.59103110 -1.51655310

[[4]]
[1]  0.02659437 -0.59103110 -1.36265335 -1.51655310

[[5]]
[1]  1.17848916  0.02659437 -0.59103110 -1.36265335 -1.51655310

Для производительности следует рассмотреть подход @ cyrilb38 с Reduce. См. Контрольные показатели ниже -

n <- 600
set.seed(11)
x <- rnorm(n)

r_sort <- function(x, y) {
  append(x, y, after = sum(x > y))
}


microbenchmark(
  lapply = lapply(seq_along(x), function(a) {
  sort(x[seq_len(a)], decreasing = T)
  }),
  forloop = {
    x.sort <- x[1]
    for(i in 2:n){
      x.sort <- append(x.sort, x[i], after = sum(x.sort > x[i]))
    }
  },
  Reduce = Reduce(r_sort, as.list(x), accumulate = T), # only if you want intermediate results
  Reduce2 = Reduce(r_sort, as.list(x)),
  times = 50
)

Unit: milliseconds
    expr       min        lq      mean    median        uq       max neval
  lapply 35.069533 36.318154 45.302362 37.870738 41.959249 203.45682    50
 forloop  8.366112  8.743501 11.196852  9.128391 11.800904  30.76272    50
  Reduce  4.574459  4.861448  7.418195  5.332593 11.076522  22.40293    50
 Reduce2  4.556300  4.754075  6.918486  5.161860  9.563809  14.41776    50