Demo Result
To compute the fair value of a chooser option which expires after 10 period. At expiration the owner have the option to choose(at no cost) a European call/put option. The call and put each have strike K = 100 and mature 5 periods later(n=15).
Other settings: T = 0.25 years, S0 = 100, r = 2%, sigma = 30%, dividend = 1%
Solution: p_chooser = 10.81245
chooser.p <- OptionPrice(100, mtrty = 0.25, prd = 15, r = 0.02, dvd = 0.01, sigma = 0.3, strike = 100, call = FALSE)
chooser.c <- OptionPrice(100, mtrty = 0.25, prd = 15, r = 0.02, dvd = 0.01, sigma = 0.3, strike = 100)
chooser <- pmax(chooser.c$Payoff, chooser.p$Payoff)[1:11, 1:11]
r.real <- exp(0.02*0.25/10)
discount(chooser[1:11,1:11], q = 0.49247, maturity = 0.25, r = r.real)
Output
> discount(chooser[1:11,1:11], q = 0.49247, maturity = 0.25, r = 0.02)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11]
[1,] 10.81245 11.08461 12.324800 14.585646 17.809620 21.819826 26.368571 31.250030 36.394629 41.761927 47.343416
[2,] 0.00000 10.55546 9.888508 10.139137 11.466918 13.930107 17.420391 21.649281 26.278614 31.210502 36.373491
[3,] 0.00000 0.00000 11.209553 9.651811 8.857415 9.084352 10.552541 13.328428 17.171535 21.510333 26.221217
[4,] 0.00000 0.00000 0.000000 12.728436 10.428976 8.643030 7.665696 7.865955 9.608114 12.972762 16.953365
[5,] 0.00000 0.00000 0.000000 0.000000 14.968025 12.168778 9.597041 7.476415 6.180659 6.349616 9.118798
[6,] 0.00000 0.00000 0.000000 0.000000 0.000000 17.694042 14.672197 11.661045 8.738632 6.020775 3.666776
[7,] 0.00000 0.00000 0.000000 0.000000 0.000000 0.000000 20.637842 17.603637 14.504401 11.381583 8.308878
[8,] 0.00000 0.00000 0.000000 0.000000 0.000000 0.000000 0.000000 23.595568 20.622473 17.544082 14.370588
[9,] 0.00000 0.00000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 26.495943 23.623065 20.634933
[10,] 0.00000 0.00000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 29.300977 26.538048
[11,] 0.00000 0.00000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 32.001170
Compute the fair value of an american call option with strike K = 110 with n = 10 period, where the option is written on a contract that expires after n = 15 periods.
Other settings: T = 0.25 years, S0 = 100, r = 2%, sigma = 30%, dividend = 1%
Solution: 1.65
f <- FuturePrice(100, maturity=0.25, prd=15, sigma=0.3, r=0.02)
FO <- OptionPrice(f$price.tree[1:11,1:11], maturity= 0.25, prd=10, sigma = 0.3, strike = 110, r=0.02, dvd = 0.01, US = TRUE)
#output
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11]
[1,] 1.649131 2.5944232 3.9920002 5.98656496 8.7139819 12.2549386 16.5754937 21.4919571 26.638969 31.98745 37.545291
[2,] 0.000000 0.7396968 1.2500131 2.07359718 3.3638119 5.3098333 8.1029056 11.8533789 16.454495 21.40432 26.547907
[3,] 0.000000 0.0000000 0.2485901 0.45748611 0.8321493 1.4915772 2.6231381 4.4962288 7.430552 11.61002 16.370220
[4,] 0.000000 0.0000000 0.0000000 0.04750429 0.0968422 0.1974224 0.4024652 0.8204651 1.672600 3.40976 6.951134
[5,] 0.000000 0.0000000 0.0000000 0.00000000 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.00000 0.000000
[6,] 0.000000 0.0000000 0.0000000 0.00000000 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.00000 0.000000
[7,] 0.000000 0.0000000 0.0000000 0.00000000 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.00000 0.000000
[8,] 0.000000 0.0000000 0.0000000 0.00000000 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.00000 0.000000
[9,] 0.000000 0.0000000 0.0000000 0.00000000 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.00000 0.000000
[10,] 0.000000 0.0000000 0.0000000 0.00000000 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.00000 0.000000
[11,] 0.000000 0.0000000 0.0000000 0.00000000 0.0000000 0.0000000 0.0000000 0.0000000 0.000000 0.00000 0.000000
##Call Option price-Spot price
Price of ZCB matures at time N = 10, face value F = 100. Basic settings: r0=5%, u = 1.1, d = 0.9, q = 1 - 1 = 0.5
Solution:
#over ride bio.tree function, set d=0.9
short.rate <- bio.tree.sr(0.05, 10, 1.1, 0.9) + 1
ZCB <- matrix(100, 11, 11)
ZCB.dis <- discount(ZCB, 0.5, short.rate)
#output
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11]
[1,] 61.62196 61.96508 62.67640 63.83811 65.55598 67.96856 71.26063 75.68322 81.58394 89.45365 100
[2,] 100.00000 67.44103 68.06992 69.09854 70.61709 72.74145 75.62290 79.46229 84.53103 91.20247 100
[3,] 100.00000 100.00000 72.88183 73.78023 75.10481 76.95195 79.44508 82.74473 87.06306 92.68502 100
[4,] 100.00000 100.00000 100.00000 77.88686 79.02946 80.61870 82.75509 85.56698 89.22057 93.93434 100
[5,] 100.00000 100.00000 100.00000 100.00000 82.42222 83.77759 85.59360 87.97292 91.04621 94.98185 100
[6,] 100.00000 100.00000 100.00000 100.00000 100.00000 86.47456 88.00790 90.00938 92.58205 95.85643 100
[7,] 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 90.04746 91.72288 93.86782 96.58407 100
[8,] 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 93.15753 94.93992 97.18768 100
[9,] 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 95.83085 97.68719 100
[10,] 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 98.09971 100
[11,] 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 100.00000 100
>
Calculation of interest rate of 4 period under term structure
B4 <- ZCB(prd=4, r.start=0.05, u=1.1, d=0.9, bprice=1)
interest.rate <- (1/B4[1,1])^(1/4)
#Out
[,1] [,2] [,3] [,4] [,5]
[1,] 0.8228896 0.8517064 0.8891864 0.9376026 1
[2,] 0.0000000 0.8763617 0.9079141 0.9483617 1
[3,] 0.0000000 0.0000000 0.9236819 0.9573501 1
[4,] 0.0000000 0.0000000 0.0000000 0.9648319 1
[5,] 0.0000000 0.0000000 0.0000000 0.0000000 1
10yrZCB <- ZCB(n=10, r.start=0.05, u=1.1, d=0.9, bprice=100)
fwd.lattic <- TenyrZCB[1:5, 1:5]
fwd.lattic <- discount(fwd.lattic, 0.5, (short.rate[1:5, 1:5]+1)
> fwd.lattic
[,1] [,2] [,3] [,4] [,5]
[1,] 61.62196 61.96508 62.67640 63.83811 65.55598
[2,] 0.00000 67.44103 68.06992 69.09854 70.61709
[3,] 0.00000 0.00000 72.88183 73.78023 75.10481
[4,] 0.00000 0.00000 0.00000 77.88686 79.02946
[5,] 0.00000 0.00000 0.00000 0.00000 82.42222
B4.factor <- B4[1,1]
fwd.price <- fwd.lattic[1,1]/B4.factor