R/mod_montecarlo.R

In lampoverde/Der: Derivatives and Structured Products

# PENSARE SE/COME SOSTITUIRE LE CLOSURE CON LOCAL-INVIRONMENT APPROACH (sito cyclismo)

# GENERANO UN SINGOLO PATH (UNI/MULTIVARIATO) => delegare a Rcpp
# genBSproc<-function(N=1, grid, T, dt, S0, sigma, rand=rnorm)
# genBSprocVect<-function(N=1, grid, T, dt, S0, sigma=list(), correl, rand=rnorm)

# genDupireproc<-function(N=1, grid, T, dt, S0, rand=rnorm)
# genDupireprocVect<-function(N=1, grid, T, dt, S0, rand=rnorm)

# genBSexact<-function(S0, sigma)


# PENSARE VERSIONI RAPIDE
# a) Funzione C++ che fa ciclo e chiama direttamente le c++ dei processi
# b) versione parallela su processori
# c) versione su cluster
# d) versione su GPU
# MC<-function(N, procFunct, param)  --> do.call(procFunct, param) for => media/sd


# In QL e' lo strumento che imposta il timegrid dopo che e' stato creato il processo
# qui no, il processo ha il timegrid


# Esempio
# gen<-gbmFixed(to=1,mand=list(final=0.9),r=-0.02,dvd=.0363,sd=.1963)
# mc(N=30000, pathgen=gen, quote(call(s=path$final,strike = 1.0)), quote(disc(t$final,.002)))
# mc(N=100, pathgen=gen, quote(callspread2(s=path$final,strike1 = 1.0,strike2 = 1.2)), quote(disc(t$final,.002)),nris=3)


# Path dependent
# gen<-gbmFixed(to=1,mand=list(final=1),r=-0.02,dvd=.0363,sd=.1963)
# payoff<-quote(barrOption(s=pathAll, cond=s<0.9, put(path$final,1), reb=0))
# mc(N=100, pathgen=gen, payoff, quote(disc(t$final,.002)))


# gen<-gbmFixed(to=1,mand=list(final=1),r=-0.02,dvd=.0363,sd=.1963)
# payoff<-quote(capGar(s=path$final, gar=1, strike=1, gear=1))
# mc(N=30000, pathgen=gen, payoff, quote(disc(t$final,.002)),nris=3)



# TODO: fare in modo da non dover scrivere "quote" forse con match.call si riesce
#       nris deve diventare automatico
#       valutare versione in C++ parallela (openmc / gpu)

mc<-function(N, pathgen, payoff,disc,nris=1){

    # substitute evita che la funzione venga valutata nell'enclosing environment
    # e che quindi arrivi qui solo il risultato, evita di dover scrivere
    # mc(..., payoff=quote(call(s=path$final,strike = 1.0), ...)
    payoff<-substitute(payoff)
    disc<-substitute(disc)

    val<-array(NA, dim = c(N,nris))
    gr<-environment(pathgen)$grid # SOSTITUIRE PATHGEN CON LOCAL-ENVIRONMENT APPROACH!!!
    pos<-gr$mand_pos
    t<-lapply(pos,at,x=gr$t)
    for(i in 1:N){
        pathAll<-pathgen()
        path<-at_mand(pathAll, pos); path$all<-pathAll
        # disc e payoff valutati nell'envir dei dati da cui devono pescare (valore e time)
        if(is.na( eval(payoff,envir=path))) print(path)
        val[i,]<- eval(disc,envir=at_mand(gr$t,gr$mand_pos)) * eval(payoff,envir=path)
    }
    m<-apply(val,2,mean)
    sd<-apply(val,2,sd)
    list(m=m,s=sd/sqrt(N))
}


mc_pi<-function(N, Pathgen, pathgenPar, payoff,payoffPar, disc,nris=1){

    # substitute evita che la funzione venga valutata nell'enclosing environment
    # e che quindi arrivi qui solo il risultato, evita di dover scrivere
    # mc(..., payoff=quote(call(s=path$final,strike = 1.0), ...)

    #payoff<-substitute(payoff)
    disc<-substitute(disc)
    payoffPar<-substitute(payoffPar)


    pathgenPar$mand$final<-environment(payoff)$mat
    pathgenPar$to<-environment(payoff)$mat
    pathgen<-do.call(Pathgen, pathgenPar)


    val<-array(NA, dim = c(N,nris))
    gr<-environment(pathgen)$grid
    pos<-gr$mand_pos
    t<-lapply(pos,at,x=gr$t)
    for(i in 1:N){
        pathAll<-pathgen()
        path<-at_mand(pathAll, pos)
        val[i,]<- eval(disc,envir=at_mand(gr$t,gr$mand_pos)) * do.call(payoff,eval(payoffPar,envir=path))
        #val[i,]<- eval(disc,envir=at_mand(gr$t,gr$mand_pos)) * eval(payoff,envir=path)
        #val[i,]<- eval(disc,envir=at_mand(gr$t,gr$mand_pos)) * payoff(path$final)
    }
    m<-apply(val,2,mean)
    sd<-apply(val,2,sd)
    list(m=m,s=sd/sqrt(N))
}