Apply function to timeseries object

Question

Say I have the following ts object in R.

x <- ts(data = matrix(1:10, 5, 2), start = 1/12, deltat = 1/12)

Now I want to apply the function f to each record of this time series: the function f depends on the value of the time series and the corresponding time, for example:

f <- function(z, time){z*time}

I am looking for an effective way to do this: so far I have managed to solve some work around such a solution:

timex <- seq(from = 1/12, by = 1/12, length = 5)
apply(x, 2, function(y){ apply(cbind(y, timex),1, function(z) f(z[1], z[2]))})

This solution gives the correct result, but I am sure that there is a more direct approach.

I am looking for a method that works for more "complex functions" f: in particular, it is not possible to directly call f (x, time (x)) if length (x)> 1.

, ts, , , . - . .

- ? .

EDIT: , x ts . , .

apply(x, 2, class)
 Series 1  Series 2 
"integer" "integer"

class(x)
[1] "mts"    "ts"     "matrix"

2: " f: , .

f  <- function(s0, t){
  option.times <- 1:20/2
  tau <- option.times[option.times >= t] - t

  d = (log(1.5/s0) - 0.0098*tau)/(0.0098* sqrt(tau))

  p1 <- pnorm(d)
  p2 <- s0 / 1.5* exp((1/2*0.02^2 + 0.0098)*tau) * pnorm(d-0.02*sqrt(tau)) 
  sum((p1-p2)*exp(-0.02*tau))*100

}

, : 530x10000 ( (x) 0 deltat = 1/52). f ,

> system.time(apply(x, 2, function(y){ apply(cbind(y, timex),1, function(z) f(z[1], z[2]))}))
       User      System verstrichen 
      69.62        0.03       69.75 
> system.time(mapply(f, x, time(x)))
       User      System verstrichen 
      79.01        0.06       79.12 

mapply , .

Answer 1

mapply :

x <- ts(data = matrix(1:10, 5, 2), start = 1/12, deltat = 1/12)
f <- function(z, time){z*time}
mapply(f, x, time(x))
#>  [1] 0.08333333 0.33333333 0.75000000 1.33333333 2.08333333 0.50000000
#>  [7] 1.16666667 2.00000000 3.00000000 4.16666667

EDIT: :

n <- 530
m <- 10000
x <- ts(data = matrix(rlnorm(n * m), n, m), start = 0, deltat = 1/52)
f  <- function(s0, t){
  option.times <- 1:20/2
  tau <- option.times[option.times >= t] - t

  d = (log(1.5/s0) - 0.0098*tau)/(0.0098* sqrt(tau))

  p1 <- pnorm(d)
  p2 <- s0 / 1.5* exp((1/2*0.02^2 + 0.0098)*tau) * pnorm(d-0.02*sqrt(tau)) 
  sum((p1-p2)*exp(-0.02*tau))*100
}
timex <- time(x)
system.time(r1 <- apply(x, 2, function(y){ apply(cbind(y, timex),1, function(z) f(z[1], z[2]))}))
#>        User      System verstrichen 
#>      67.002       0.059      67.089
system.time(r2 <- matrix(mapply(f, x, time(x)), n, m))
#>        User      System verstrichen 
#>      78.975       0.244      79.250
all(r1 == r2)
#> [1] TRUE

, , , () () :

g  <- function(s0, t){
  option.times <- 1:20/2
  tau <- option.times[option.times >= t] - t

  d = outer(-0.0098*tau, log(1.5/s0), FUN = "+")/(0.0098 * sqrt(tau))

  p1 <- pnorm(d)
  p2 <- outer(exp((1/2*0.02^2 + 0.0098)*tau), s0 / 1.5, FUN = "*") * pnorm(d - 0.02*sqrt(tau)) 
  colSums((p1 - p2)*exp(-0.02*tau))*100
}

r3 <- matrix(0, n ,m)
timex <- time(x)
system.time(for (i in seq_along(timex)) {
  r3[i, ] <- g(x[i, ], timex[i])
})
#>        User      System verstrichen 
#>       4.955       0.136       4.919
all(r3 == r2)
#> [1] TRUE

...