R/mod_payoff.R

In lampoverde/Der: Derivatives and Structured Products

# Maturity giusto che stia in instrument, qui lasciata in caso si
# voglia fare a meno di definire un instrument e lavorare solo sul payoff

delta1<-function(b=1,strike=1,mat=NULL){
    function(s){b + call(strike)(s)-put(strike)(s)}
}

call<-function(strike, mat=NULL){function(s) max(s-strike, 0)}
put<-function(strike, mat=NULL){function(s) max(strike-s, 0)}

digitalCall<-function(strike, mat=NULL){function(s) ifelse(s>=strike,1,0)}
digitalPut<-function(strike, mat=NULL){function(s) ifelse(s<=strike,1,0)}

# ATTENZIONE: valuta cond e il payoff nel parent.frame
# vantaggio: flessibilità di mettere la condizione
# di barriera ad esempio su worst e payoff su basket
# svantaggio barr non e' esplicitata negli argg della closure
barrOption<-function(cond, payoff, reb=0){
    # barrOption(s<0.9, 2*put(strike=1)(last(s)), reb=0)()
    # barrOption(last(s)<0.95, 2*put(strike=1)(last(s)), reb=0)()
    function() ifelse(any(eval(substitute(cond))), eval(substitute(payoff)), reb)
}


# tmp<-function(cond,b=5){
#     y<-c(-2,-1, 1,3,6)
#     eval(substitute(cond))
# }
# 
# tmp(y<b)
# 
# tmp2<-function(cond,b=5,y){
#     eval(substitute(cond))
# }
# 
# tmp2(cond=y<b, b=5, y=c(-2,-1, 1,3,6))
# 
# tmp3<-function(cond,b=5){
#     function(y){
#         substitute(cond)
#         eval(substitute(cond),envir = parent.env())
#     }
# }
# 
# 
# tmp3(cond=y<5, b=5)(y=c(-2,-1, 1,3,6))
# 
# 
# 
# 
# 
# barrOption(s<0.95, put(strike=5)(last(s)), reb=0)()
# 
# ftemp<-function(){
#     s<-s
#     s[10]<-2
#     out<-barrOption(s<0.95, put(strike=5)(last(s)), reb=0)()
#     print(out)
# }
# 
# 
# ftemp()
# 



asian<-function(payoff){
    # Generale
    # s saranno esattamente i punti su cui fare average
    # asian(call(strike=0))(s)
    # asian(digitalCall(strike=0))(s)
    function(s) {sm<-mean(s); payoff(sm)}
}

# Lookback ?

callspread<-function(strike1,strike2){
    function(s){call(strike1)(s)-call(strike2)(s)}
}

putspread<-function(strike1,strike2){
    function(s){put(strike1)(s)-put(strike2)(s)}
}


certPlus<-function(cond, payoffNoBarr, payoffBarr){
    # certPlus(s<0.9, 1+ call(strike=1)(last(s)), delta1()(last(s)))()
    function() ifelse(any(eval(substitute(cond))),
                      eval(substitute(payoffBarr)),
                      eval(substitute(payoffNoBarr)))
}



struttura<-function(s1,s2,gar){

    basket<- (s1+s2)/2
    worst<- apply(cbind(s1,s2),1,min)

    bond<- PV(gar)
    putDI<-barrOption(worst<=0.9, put(strike=1)(basket))
    call<-call(strike = 1)(baseket)

    bond-putDI+call

}








# Particolare
call_asian<-function(strike, mat=NULL){function(s) max(mean(s)-strike, 0)}



callspread<-function(s,strike1,strike2){
    lc<-call(s,strike1)(s); sc<-call(s,strike2)(s)
    c(lc-sc,lc,sc)
}





# Path independent
call<-function(s,strike){max(s-strike, 0)}
put<-function(s,strike){max(strike-s, 0)}

digitalCall<-function(s, strike){ifelse(s>=strike,1,0)}
digitalPut<-function(s, strike){ifelse(s<=strike,1,0)}

barrOption<-function(s, cond, payoff, reb=0){
    # cond: it TRUE option active, else rebate
    # Example (geared PUT amer and eur barrier)
    # barrOption(s=sim[,1], cond=s<0.9, 2*put(sim[nrow(sim),1],1), reb=0)
    # barrOption(s=sim[nrow(sim),1], cond=s<0.95, 2*put(sim[nrow(sim),1],1), reb=0)
    ifelse(any(eval(substitute(cond))), payoff, reb)
}

callspread<-function(s,strike1,strike2){call(s,strike1)-call(s,strike2)}
putspread<-function(s,strike1,strike2){put(s,strike1)-put(s,strike2)}

callspread2<-function(s,strike1,strike2){
    lc<-call(s,strike1)
    sc<-call(s,strike2)
    c(lc-sc,lc,sc)
}

# due underl (b,w) per avere ad es call su basket, put su worst
callput<-function(b,w, strike1,strike2){
    lc<-call(b,strike1)
    sc<-put(w,strike2)
    c(lc-sc,lc,sc)
}




capGar<-function(s, gar, strike, gear){
    opt<-call(s, strike)
    c(gar+gear*opt,gar, opt)
}


# capGar<-function(s, gar, gear){
#     #gar + s[1]*gear*max(0, rend(s[1], s[length(s)]))
#     gar + s[1]*gear*max(0, rend(first(s), last(s)))
# }



# Path dependent con payoff a scadenza
certPlus<-function(s, gar,barr){
    #ifelse(min(s)>barr,max(gar,s[length(s)]),s[length(s)])
    ifelse(min(s)>barr,max(gar,last(s)),last(s))  # Perde 10% tempo
}


# Path dependent su basket, con payoff a scadenza
#certPlus<-function(s, gar,barr,fbarr,fperf, ...){
#  ifelse(min(fbarr(s,...))>barr,max(gar,fperf(s[length(s)],...)),fperf(s[length(s)]))
#}



# Path dependent con payoff eventualmente anticipato

# Gestire caso barriera europea
autocallable<-function(sim, t, obs, trig, barr, cpn, cap){
    w<-match(obs, t)
    wmin<-which.min(sim[w]>=trig)
    tmin<-t[w[wmin]]
    coup<-wmin*cpn
    prot<-ifelse(min(sim)<=barr,sim[length(sim)],cap)
    ifelse(coup>0,{out<-c(cap+cpn,tmin,wmin)},{out<-c(prot,t[length(t)],length(obs))})
    names(out)<-c('pay','t','i')
    return(out)
}