[Uwgarp-commits] r197 - in pkg/GARPFRM: . R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 30 00:39:32 CEST 2014
Author: rossbennett34
Date: 2014-06-30 00:39:31 +0200 (Mon, 30 Jun 2014)
New Revision: 197
Added:
pkg/GARPFRM/man/computeGreeks.Rd
Modified:
pkg/GARPFRM/NAMESPACE
pkg/GARPFRM/R/options.R
pkg/GARPFRM/sandbox/test_options.R
Log:
Adding functions and script for option greeks
Modified: pkg/GARPFRM/NAMESPACE
===================================================================
--- pkg/GARPFRM/NAMESPACE 2014-06-29 21:42:15 UTC (rev 196)
+++ pkg/GARPFRM/NAMESPACE 2014-06-29 22:39:31 UTC (rev 197)
@@ -49,6 +49,8 @@
export(bootVaR)
export(chartSML)
export(compoundingRate)
+export(computeGreeks)
+export(deltaBS)
export(discountFactor)
export(efficientFrontier)
export(efficientFrontierTwoAsset)
@@ -57,6 +59,7 @@
export(estimateLambdaCov)
export(estimateLambdaVol)
export(forecast)
+export(gammaBS)
export(getAlphas)
export(getBetas)
export(getCor)
@@ -83,6 +86,7 @@
export(realizedCor)
export(realizedCov)
export(realizedVol)
+export(rhoBS)
export(rollCor)
export(rollCov)
export(rollSD)
@@ -90,7 +94,9 @@
export(simpleVolatility)
export(spotForwardRates)
export(tangentPortfolio)
+export(thetaBS)
export(uvGARCH)
export(vasicekPrice)
+export(vegaBS)
export(yieldCurveVasicek)
export(ytmSolve)
Modified: pkg/GARPFRM/R/options.R
===================================================================
--- pkg/GARPFRM/R/options.R 2014-06-29 21:42:15 UTC (rev 196)
+++ pkg/GARPFRM/R/options.R 2014-06-29 22:39:31 UTC (rev 197)
@@ -208,7 +208,7 @@
# option_value[[j]] <- V.new
#}
V[1:(j+1)] <- V.new[1:(j+1)]
- print(V)
+ #print(V)
}
# calculate the greeks
# delta <- (f_02 - f_00) / (u^2 * S0 - d^2 * S0)
@@ -283,6 +283,100 @@
# vega
# rho
+#' Option Greeks
+#'
+#' Compute the greeks of an option using the Black-Scholes-Merton framework
+#'
+#' @param option an \code{option} object created with \code{\link{optionSpec}}
+#' @param greek one of "delta", "theta", "gamma", "rho", or "vega"
+#' @param prices vector of values to compute the greeks as time
+#' to maturity varies
+#' @param maturities vector of values to compute the greeks as time
+#' to maturity varies
+#' @param plot TRUE/FALSE to plot the greek value as the underlying price and/ time to maturity vary
+#' @param \dots passthrough parameters to \code{\link{plot}}
+#' @author Ross Bennett
+#' @export
+computeGreeks <- function(option,
+ greek=c("delta", "theta", "gamma", "rho", "vega"),
+ prices=NULL,
+ maturities=NULL,
+ plot=FALSE, ...){
+
+ greek <- match.arg(greek)
+ switch(greek,
+ delta = {FUN <- match.fun(deltaBS)},
+ theta = {FUN <- match.fun(thetaBS)},
+ gamma = {FUN <- match.fun(gammaBS)},
+ rho = {FUN <- match.fun(rhoBS)},
+ vega = {FUN <- match.fun(vegaBS)})
+
+ if(!is.null(prices) & !is.null(maturities)){
+ out <- vector("list", 2)
+ # First compute the greek value as we vary the underlying price, holding ttm constant
+ out[[1]] <- FUN(S0 = prices,
+ K = option$K,
+ r = option$r,
+ q = option$q,
+ vol = option$volatility,
+ ttm = option$maturity,
+ type = option$type)
+ # Next compute the greek value as we vary time to maturity, holding S0 constant
+ out[[2]] <- FUN(S0 = option$S0,
+ K = option$K,
+ r = option$r,
+ q = option$q,
+ vol = option$volatility,
+ ttm = maturities,
+ type = option$type)
+ if(plot){
+ par(mfrow=c(2,1))
+ plot(x = prices, y = out[[1]], type="l", ylab=greek, xlab="price", ...=...)
+ plot(x = maturities, y = out[[2]], type="l", xaxt="n", ylab=greek, xlab="time to maturity", ...=...)
+ axis(side = 1, at=maturities, labels = as.character(rev(maturities)))
+ layout(matrix(1,1,1), widths = 1, heights = 1)
+ par(mfrow=c(1,1))
+ }
+ # return the list
+ return(out)
+ }
+
+ if(!is.null(prices)){
+ S0 <- prices
+ xs <- S0
+ } else {
+ S0 <- option$S0
+ }
+
+ if(!is.null(maturities)){
+ ttm <- maturities
+ xs <- ttm
+ } else {
+ ttm <- option$maturity
+ }
+
+ out <- FUN(S0 = S0,
+ K = option$K,
+ r = option$r,
+ q = option$q,
+ vol = option$volatility,
+ ttm = ttm,
+ type = option$type)
+ if(plot){
+ if(!is.null(maturities)){
+ xlabels <- as.character(rev(xs))
+ xlab <- "time to maturity"
+ } else {
+ xlabels <- xs
+ xlab <- "price"
+ }
+ plot(x = xs, y = out, type="l", ylab=greek, xaxt="n", xlab=xlab, ...=...)
+ axis(side = 1, at=xs, labels = xlabels)
+ }
+ return(out)
+}
+
+#' @export
deltaBS <- function(S0, K, r, q, vol, ttm, type){
d1 <- (log(S0 / K) + (r - q + (vol^2 / 2)) * ttm) / (vol * sqrt(ttm))
if(type == "call"){
@@ -308,6 +402,7 @@
# return(delta)
# }
+#' @export
thetaBS <- function(S0, K, r, q, vol, ttm, type){
d1 <- (log(S0 / K) + (r - q + (vol^2 / 2)) * ttm) / (vol * sqrt(ttm))
d2 <- (log(S0 / K) + (r - q - (vol^2 / 2)) * ttm) / (vol * sqrt(ttm))
@@ -336,7 +431,8 @@
# return(theta)
# }
-gammaBS <- function(S0, K, r, q, vol, ttm){
+#' @export
+gammaBS <- function(S0, K, r, q, vol, ttm, type){
d1 <- (log(S0 / K) + (r - q + (vol^2 / 2)) * ttm) / (vol * sqrt(ttm))
out <- dnorm(d1) / (S0 * vol * sqrt(ttm))
return(out)
@@ -350,7 +446,8 @@
#
# gamma.put <- gamma.call
-vegaBS <- function(S0, K, r, q, vol, ttm){
+#' @export
+vegaBS <- function(S0, K, r, q, vol, ttm, type){
d1 <- (log(S0 / K) + (r - q + (vol^2 / 2)) * ttm) / (vol * sqrt(ttm))
out <- S0 * sqrt(ttm) * dnorm(d1)
return(out)
@@ -364,6 +461,7 @@
#
# vega.put <- vega.call
+#' @export
rhoBS <- function(S0, K, r, q, vol, ttm, type){
d2 <- (log(S0 / K) + (r - q - (vol^2 / 2)) * ttm) / (vol * sqrt(ttm))
if(type == "call"){
Added: pkg/GARPFRM/man/computeGreeks.Rd
===================================================================
--- pkg/GARPFRM/man/computeGreeks.Rd (rev 0)
+++ pkg/GARPFRM/man/computeGreeks.Rd 2014-06-29 22:39:31 UTC (rev 197)
@@ -0,0 +1,30 @@
+% Generated by roxygen2 (4.0.1): do not edit by hand
+\name{computeGreeks}
+\alias{computeGreeks}
+\title{Option Greeks}
+\usage{
+computeGreeks(option, greek = "delta", prices = NULL, maturities = NULL,
+ plot = FALSE, ...)
+}
+\arguments{
+\item{option}{an \code{option} object created with \code{\link{optionSpec}}}
+
+\item{greek}{one of "delta", "theta", "gamma", "rho", or "vega"}
+
+\item{prices}{vector of values to compute the greeks as time
+to maturity varies}
+
+\item{maturities}{vector of values to compute the greeks as time
+to maturity varies}
+
+\item{plot}{TRUE/FALSE to plot the greek value as the underlying price and/ time to maturity vary}
+
+\item{\dots}{passthrough parameters to \code{\link{plot}}}
+}
+\description{
+Compute the greeks of an option using the Black-Scholes-Merton framework
+}
+\author{
+Ross Bennett
+}
+
Modified: pkg/GARPFRM/sandbox/test_options.R
===================================================================
--- pkg/GARPFRM/sandbox/test_options.R 2014-06-29 21:42:15 UTC (rev 196)
+++ pkg/GARPFRM/sandbox/test_options.R 2014-06-29 22:39:31 UTC (rev 197)
@@ -9,8 +9,8 @@
am.put.val <- optionValue(am.put)
# European call
-euro.call <- optionSpec(style="european", type="call", S0=810, K=800,
- maturity=0.5, r=0.05, volatility=0.2, q=0.02)
+euro.call <- optionSpec(style="european", type="call", S0=30, K=30,
+ maturity=1, r=0.05, volatility=0.25, q=0)
euro.call.val.bs <- optionValue(euro.call, method="Black-Scholes")
euro.call.val.bin <- optionValue(euro.call, method="Binomial", N=100)
@@ -20,3 +20,37 @@
euro.put.val.bin <- optionValue(euro.put, method="Binomial")
+computeGreeks(euro.call, greek = "delta")
+computeGreeks(euro.call, greek = "gamma")
+computeGreeks(euro.call, greek = "theta")
+computeGreeks(euro.call, greek = "vega")
+computeGreeks(euro.call, greek = "rho")
+
+# delta
+computeGreeks(euro.call, prices = seq(20, 40, 1), plot = TRUE)
+computeGreeks(euro.call, maturities = seq(0.5, 0.01, -0.01), plot = TRUE)
+computeGreeks(euro.call, prices = seq(20, 40, 1), maturities = seq(0.5, 0.01, -0.01), plot = TRUE)
+
+# theta
+computeGreeks(euro.call, "theta", prices = seq(20, 40, 1), plot = TRUE)
+computeGreeks(euro.call, "theta", maturities = seq(0.5, 0.01, -0.01), plot = TRUE)
+
+# gamma
+computeGreeks(euro.call, "gamma", prices = seq(20, 40, 1), plot = TRUE)
+computeGreeks(euro.call, "gamma", maturities = seq(0.5, 0.01, -0.01), plot = TRUE)
+
+# vega
+computeGreeks(euro.call, "vega", prices = seq(20, 40, 1), plot = TRUE)
+computeGreeks(euro.call, "vega", maturities = seq(0.5, 0.01, -0.01), plot = TRUE)
+
+# rho
+computeGreeks(euro.call, "rho", prices = seq(20, 40, 1), plot = TRUE)
+computeGreeks(euro.call, "rho", maturities = seq(0.5, 0.01, -0.01), plot = TRUE)
+
+deltaBS(S0 = 109, K = 100, r = 0.05, q = 0, vol = 0.2, ttm = 1, type = "call")
+deltaBS(S0 = 100:110, K = 100, r = 0.05, q = 0, vol = 0.2, ttm = 1, type = "call")
+
+
+
+
+
More information about the Uwgarp-commits
mailing list