Векторизации роста

Question

Я ищу решение, которое реализует следующую формулу простого роста курса с применением векторизации в R:

gr <- function(x){ 
a <- matrix(,nrow=nrow(x),ncol=ncol(x)) 
    for (j in 1:ncol(x)){ 
     for (i in 2:nrow(x)){ 
     if (!is.na(x[i,j]) & !is.na(x[i-1,j]) & x[i-1,j] != 0){ 
      result[i,j] <- x[i,j]/x[i-1,j]-1 
     } 
     } 
    } 
return(a) 
} 

Я нашел XTS пакет для создания лагов временных рядов, но в end Мне всегда приходилось сравнивать со многими значениями (см. выше), поэтому я не могу просто использовать ifelse. Одна из возможных проблем заключается в том, что временные ряды (например, индекс цен) имеют нули между ними. Это создало бы NaNs в результате, который я пытаюсь избежать, и который нельзя просто удалить после этого (отредактируйте: видимо, они могут видеть ответы ниже!)

Вкратце: я хотел бы создать таблицу правильные темпы роста для данной таблицы значений. Вот пример:

m <- matrix(c(1:3,NA,2.4,2.8,3.9,0,1,3,0,2,1.3,2,NA,7,3.9,2.4),6,3) 

генерирует:

 [,1] [,2] [,3] 
[1,] 1.0 3.9 1.3 
[2,] 2.0 0.0 2.0 
[3,] 3.0 1.0 NA 
[4,] NA 3.0 7.0 
[5,] 2.4 0.0 3.9 
[6,] 2.8 2.0 2.4 

правильный результат, произведенный gr(m):

  [,1] [,2]  [,3] 
[1,]  NA NA   NA 
[2,] 1.0000000 -1 0.5384615 
[3,] 0.5000000 NA   NA 
[4,]  NA 2   NA 
[5,]  NA -1 -0.4428571 
[6,] 0.1666667 NA -0.3846154 

Но это занимает навсегда с большими таблицами. Есть ли способ использовать условия без циклов так широко?

Answer 1

Вы можете ускорить этот процесс, выполняя весь расчет в одной векторизованных операциях (с одной дополнительной операцией подправить результаты всякий раз, когда вы разделите 0):

out <- rbind(NA, tail(m, -1)/head(m, -1) - 1) 
out[!is.finite(out)] <- NA 
out 
#   [,1] [,2]  [,3] 
#    NA NA   NA 
# [2,] 1.0000000 -1 0.5384615 
# [3,] 0.5000000 NA   NA 
# [4,]  NA 2   NA 
# [5,]  NA -1 -0.4428571 
# [6,] 0.1666667 NA -0.3846154 

Это намного быстрее, чем зацикливание раствор, как показано на примере 1000 x 1000:

set.seed(144) 
m <- matrix(rnorm(10000000), 10000, 1000) 
system.time(j <- josilber(m)) 
# user system elapsed 
# 1.425 0.030 1.446 
system.time(g <- gr(m)) 
# user system elapsed 
# 34.551 0.263 36.581 

Векторное решение обеспечивает ускорение в 25 раз.

Answer 2

Вот несколько способов:

1) нет пакетов

rbind(NA, exp(diff(log(m)))-1) 

дает:

  [,1] [,2]  [,3] 
[1,]  NA NA   NA 
[2,] 1.0000000 -1 0.5384615 
[3,] 0.5000000 Inf   NA 
[4,]  NA 2   NA 
[5,]  NA -1 -0.4428571 
[6,] 0.1666667 Inf -0.3846154 

Если это не важно иметь первую строку NA, то это можно упростить до exp(diff(log(m)))-1.

2) зоопарк Другой способ - использовать функцию геометрии геометрии зоопарка. Преобразуйте в зоопарк, возьмите геометрические отличия и вычтите 1. Если важно иметь первую строку NA, то слейте ее обратно с серией нулевой ширины, имеющей исходные точки времени (в противном случае оставьте оператор слияния и просто используйте g в качестве ответа):

library(zoo) 

zm <- as.zoo(m) 
g <- diff(zm, arithmetic = FALSE) - 1 
merge(g, zoo(, time(zm))) # omit this line if 1st row of NAs not needed 

giving: 

     g.1 g.2  g.3 
1  NA NA   NA 
2 1.0000000 -1 0.5384615 
3 0.5000000 Inf   NA 
4  NA 2   NA 
5  NA -1 -0.4428571 
6 0.1666667 Inf -0.3846154