Использование Rollapply на двух столбцах - PullRequest
Новая
       13

Использование Rollapply на двух столбцах

2 голосов
/ 25 декабря 2010

Я пытаюсь сделать что-то похожее, что я просил здесь и, к сожалению, я не могу решить это.

Это мои данные (данные), временной ряд цен: 

Date          Price   Vol
1998-01-01     200      0.3
1998-01-02     400      0.4
1998-01-03     600     -0.2
1998-01-04     100      0.1
...
1998-01-20     100      0.1
1998-01-21     200     -0.4
1998-01-21     500      0.06
....
1998-02-01     100      0.2
1998-02-02     200      0.4
1998-02-03     500      0.3
1998-02-04     100      0.1
etc.

Я бы хотел сказать R,

  • возьмите 1-е значение "Vol" и разделите его на 20-е значение "Price", затем
  • возьмите 2-е значение "Vol" и затем разделите его на 21-е значение "Price".
  • возьмите 3-е значение "Vol" и разделите его на 22-е значение "Price", затем
  • и т.д.

В моем другом посте я смог использовать эту функцию для расчета доходности за период владения 20 дней: 

> data.xts <- xts(data[, -1], data[, 1])
> hold <- 20
> f <- function(x) log(tail(x, 1)) - log(head(x, 1))
> data.xts$returns.xts <- rollapply(data.xts$Price, FUN=f, 
  width=hold+1, align="left", na.pad=T)

Есть ли способ сделать что-то очень похожее для указанной выше проблемы? Так что-то вроде 

f1 <- function(x,y) head(x, 1) / tail(y,1)

где x - это "Vol", а y - "цена", а затем применить "rollapply"?

Большое спасибо

ОБНОВЛЕНИЕ: @ Dr G: Спасибо за ваши предложения. С небольшим изменением он сделал то, что хотел! 

data.xts <- xts(data[, -1], data[, 1])
hold <- 20
data.xts$quo <- lag(data.xts[,2], hold) / data.xts[,1]

Теперь моя проблема в том, что результирующий фрейм данных выглядит следующим образом: 

    Date          Price   Vol     quo
1 1998-01-01     200      0.3     NA
2 1998-01-02     400      0.4     NA
3 1998-01-03     600     -0.2     NA
4 1998-01-04     100      0.1     NA
...
21 1998-01-20    180      0.2     0.003

Я знаю, что в качестве результата должны быть НС, но только для последних 20 наблюдений, а не для первых 20 наблюдений. Формула, указанная выше, вычисляет правильные значения, однако помещает их начиная с 21-й строки вместо первой. Вы знаете, как я мог это изменить?

Ответы [ 3 ]

2 голосов
/ 25 декабря 2010

Используйте by.column = FALSE в rollapply. Чтобы использовать опубликованные данные, мы разделим объем в первом ряду на цену в 3-м ряду и так далее для целей воспроизводимой иллюстрации: 

library(zoo)

Lines <- "Date          Price   Vol
1998-01-01     200      0.3
1998-01-02     400      0.4
1998-01-03     600     -0.2
1998-01-04     100      0.1
1998-01-20     100      0.1
1998-01-21     200     -0.4
1998-01-21     500      0.06
1998-02-01     100      0.2
1998-02-02     200      0.4
1998-02-03     500      0.3
1998-02-04     100      0.1"


# read in and use aggregate to remove all but last point in each day.
# In reality we would replace textConnection(Lines) with something 
#  like "myfile.dat"

z <- read.zoo(textConnection(Lines), header = TRUE, 
       aggregate = function(x) tail(x, 1))

# divide Volume by the Price of the point 2 rows ahead using by.column = FALSE
# Note use of align = "left" to align with the volume.
# If we used align = "right" it would align with the price.

rollapply(z, 3, function(x) x[1, "Vol"] / x[3, "Price"], by.column = FALSE,
    align = "left")

# and this is the same as rollapply with align = "left" as above
z$Vol / lag(z$Price, 2)

# this is the same as using rollapply with align = "right"
lag(z$Vol, -2) / z$Price

Кстати, обратите внимание, что zoo использует то же самое соглашение для знака lag, что и R, но xts использует противоположное соглашение, поэтому, если вы преобразуете выше в xts, вам придется отрицать лаги.

1 голос
/ 25 декабря 2010

Это на самом деле проще, чем это. Просто сделай это: 

data.xts <- xts(data[, -1], data[, 1])
hold <- 20
returns.xts = data.xts[,2] / lag(data.xts[,1], hold)

На самом деле для этого также подойдет zoo вместо xts: 

data.zoo<- zoo(data[, -1], data[, 1])
hold <- 20
returns.zoo = data.zoo[,2] / lag(data.zoo[,1], -hold)

Единственное, что меняется - это знак лагов (зоопарк отличается от xts)

0 голосов
/ 25 декабря 2010

Вам просто нужно использовать 

data.xts$quo <- data.xts[,2] / lag( data.xts[,1], -hold)
...