From noreply at r-forge.r-project.org Sat Feb 7 16:50:22 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 7 Feb 2015 16:50:22 +0100 (CET) Subject: [Uwgarp-commits] r219 - pkg/GARPFRM/R Message-ID: <20150207155022.588A31868B4@r-forge.r-project.org> Author: rossbennett34 Date: 2015-02-07 16:50:21 +0100 (Sat, 07 Feb 2015) New Revision: 219 Modified: pkg/GARPFRM/R/riskMetricsAndHedges.R Log: replacing Modified.bondDuration and bondDuration with a single function to compute modified or macaulay duration. Modified: pkg/GARPFRM/R/riskMetricsAndHedges.R =================================================================== --- pkg/GARPFRM/R/riskMetricsAndHedges.R 2014-11-15 20:10:31 UTC (rev 218) +++ pkg/GARPFRM/R/riskMetricsAndHedges.R 2015-02-07 15:50:21 UTC (rev 219) @@ -1,268 +1,268 @@ -########## Hedge Section-Convexity and Duration########## -#' Calculate the macaulay duration of a bond -#' -#' The function estimates maculay duration of a fixed rate coupon bond -#' given the discount curve and bond data. The macaulay duration is calculated -#' using the continuously compounded yield -#' -#' @param bond a \code{bond} object in discountFactorArbitrage -#' @param discountCurve vector of discount rates -#' @param percentChangeYield optional elasticity measure -#' @return duration of the bond -#' @examples -#' time = seq(from=0.5, to=2, by=0.5) -#' DF = rbind(0.968,0.9407242,0.9031545,0.8739803) -#' bond = bondSpec(time, face=100, m=2, couponRate = 0.0475) -#' mDuration = bondDuration(bond,DF) -#' @author Thomas Fillebeen -#' @export -bondDuration <- function(bond, discountCurve, percentChangeYield = 0){ - # Get data from the bond and discount curve - nDC = length(discountCurve) - m = bond$m - couponRate = bond$couponRate - face = bond$face - time = bond$time - # Calculate the ytm - ytm = bondYTM(bond=bond, discountCurve=discountCurve) + percentChangeYield - # Convert to continuously compounded rate - y_c = m * log(1 + ytm / m) - # Get the cashflows of coupon amounts and face value - couponAmount = face * couponRate / m - cashflows = rep(couponAmount, nDC) - cashflows[nDC] = couponAmount + face - # Calculate the price based on the continuously compounded rate - price = sum(cashflows * exp(-y_c * time)) - # Calculate the duration - duration = sum(-time * cashflows * exp(-y_c * time)) / -price - return(duration) -} - -#' Calculate the modified duration of a bond -#' -#' The function estimates modified duration of a fixed rate coupon bond -#' given the discount curve and bond data. The modified duration is calculated -#' using the continuously compounded yield -#' -#' @param bond a \code{bond} object in discountFactorArbitrage -#' @param discountCurve vector of discount rates -#' @param percentChangeYield optional elasticity measure -#' @return modified duration of the bond -#' @examples -#' time = seq(from=0.5, to=2, by=0.5) -#' DF = rbind(0.968,0.9407242,0.9031545,0.8739803) -#' bond = bondSpec(time, face=100, m=2, couponRate = 0.0475) -#' mDuration = Modified.bondDuration(bond,DF) -#' @author Jaiganesh Prabhakaran -#' @export -Modified.bondDuration <- function(bond, discountCurve, percentChangeYield = 0){ - #Get the Duration using bondDuration Function - duration = bondDuration(bond, discountCurve, percentChangeYield) - #Calculating yield to maturity using bondYTM Function - ytm = bondYTM(bond,df) - mduration = duration/(1+ytm/bond$m) - return(mduration) -} - -#' Calculate the convexity of a fixed rate coupon bond -#' -#' This function estimates the convexity of a fixed rate coupon bond -#' given the discount curve and bond data. -#' -#' @param bond a \code{bond} object in discountFactorArbitrage -#' @param discountCurve vector of discount rates -#' @return convexity of the bond -#' @examples -#' time = seq(from=0.5, to=2, by=0.5) -#' DF = rbind(0.968,0.9407242,0.9031545,0.8739803) -#' bond = bondSpec(time, face=100, m=2, couponRate = 0.0475) -#' convexity = bondConvexity(bond,DF) -#' @author Thomas Fillebeen -#' @export -bondConvexity <- function(bond, discountCurve){ - # Get data from the bond and discount curve - nDC = length(discountCurve) - m = bond$m - couponRate = bond$couponRate - face = bond$face - time = bond$time - # Get the cashflows of coupon amounts and face value - couponAmount = face * couponRate / m - cashflows = rep(couponAmount, nDC) - cashflows[nDC] = couponAmount + face - # The price is the sum of the discounted cashflows - price = sum(discountCurve * cashflows) - weights = (discountCurve * cashflows) / price - convexity = sum(weights * time^2) - return(convexity) -} - -#' Calculate the yield to maturity of a bond -#' -#' This function calculates the yield to maturity of a fixed rate coupon bond -#' given the discount curve and bond data. -#' -#' @param bond a \code{bond} object -#' @param discountCurve vector of discount rates -#' @return yield to maturity of the bond -#' @examples -#' time = seq(from=0.5, to=2, by=0.5) -#' DF = rbind(0.968,0.9407242,0.9031545,0.8739803) -#' bond = bondSpec(time, face=100, m=2, couponRate = 0.0475) -#' bondYTM(bond,DF) -#' @author Thomas Fillebeen -#' @export -bondYTM <- function(bond, discountCurve){ - # First step is to calculate the price based on the discount curve - price <- bondPrice(bond=bond, discountCurve=discountCurve) - - # Get the data from the bond object - m <- bond$m - couponRate <- bond$couponRate - face <- bond$face - time <- bond$time - - # Use optimize to solve for the yield to maturity - tmp <- optimize(ytmSolve, interval=c(-1,1), couponRate=couponRate, m=m, nPayments=length(time), face=face, targetPrice=price, tol=.Machine$double.eps) - ytm <- tmp$minimum - return(ytm) -} - -#' Solve for the yield to maturity of a bond -#' -#' This function solves for the yield to maturity of a fixed rate coupon bond -#' given the discount curve and bond data. -#' -#' @param ytm yield to maturity -#' @param couponRate coupon rate -#' @param m compounding frequency -#' @param nPayments is the number of payments -#' @param face is the face value -#' @param targetPrice is the price of the bond -#' @return Absolute value of difference between the price and the present value -#' @author Thomas Fillebeen -#' @export -ytmSolve <- function(ytm, couponRate, m, nPayments, face, targetPrice){ - C <- face * couponRate / m - tmpPrice <- 0 - for(i in 1:nPayments){ - tmpPrice <- tmpPrice + C / ((1 + (ytm / m))^i) - } - tmpPrice <- tmpPrice + face / (1 + ytm / m)^nPayments - return(abs(tmpPrice - targetPrice)) -} - - -############ Hedge section-Empirical############### - -#' Estimate the delta hedge of for a bond -#' -#' This function estimates the delta for hedging a particular bond -#' given bond data -#' -#' @param regressand a \code{bond} object in discountFactorArbitrage -#' @param regressor the right hand side -#' @return delta of the hedge -#' @examples -#' # Load Data for historcal analysis tools -#' data(crsp.short) -#' data = largecap.ts[,2:6] -#' head(data) -#' # Empirical application: Linear hedge estimation -#' # OLS Level-on-Level regression -#' deltas = linearHedge(data[,1],data[,2:5]) -#' # Insert the normalized hedged contract versus hedgeable contract value -#' deltas = c(1,deltas) -#' # In sample illustration: random, mean reverting spreads -# ' hedgedInstruments = data%*%deltas -#' @author Thomas Fillebeen -#' @export -linearHedge <- function(regressand, regressor){ - deltas = matrix(0,nrow=1,ncol= ncol(regressor)) - reg = lm(regressand ~ regressor) - deltas = -coef(reg)[seq(2,ncol(data),1)] - return(deltas) -} - -#' Estimate PCA loadings and create a PCA object -#' -#' This function estimates the delta for hedging a particular bond -#' given bond data -#' -#' @param data time series data -#' @param nfactors number of components to extract -#' @param rotate "none", "varimax", "quatimax", "promax", "oblimin", "simplimax", and "cluster" are possible rotations/transformations of the solution. -#' @return pca object loadings -#' @author Thomas Fillebeen -#' @export -PCA <- function(data, nfactors, rotate = "none"){ - stopifnot("package:psych" %in% search() || require("psych", quietly = TRUE)) - - pca = principal(data, nfactors, rotate="none") - class(pca) <- c("PCA","psych", "principal") - return(pca) -} - -#' Retrieve PCA loadings -#' -#' @param object is a pca object created by \code{\link{PCA}} -#' @author Thomas Fillebeen -#' @export -getLoadings <- function(object){ -loadings = object$loadings - return(loadings) -} - -#' Retrieve PCA weights -#' -#' @param object is a pca object created by \code{\link{PCA}} -#' @author Thomas Fillebeen -#' @export -getWeights <- function(object){ - weights = object$weight - return(weights) -} - -#' Plotting method for PCA -#' -#' Plot a fitted PCA object -#' -#' @param x a PCA object created by \code{\link{PCA}} -#' @param y not used -#' @param number specify the nunber of loadings -#' @param \dots passthrough parameters to \code{\link{plot}}. -#' @param main a main title for the plot -#' @param separate if TRUE plot of same, and if FALSE plot separately -#' @author Thomas Fillebeen -#' @method plot PCA -#' @S3method plot PCA -plot.PCA <- function(x, y, ..., main="Beta from PCA regression",separate=TRUE){ - if(ncol(x$loading)> 3) warning("Only first 3 loadings will be graphically displayed") - # Plot the first three factors - if (ncol(x$loading) >= 3){ - if(!separate){ - plot(x$loading[,1], type="l", main = main, - xlab="Maturity/Items", ylab="Loadings") - lines(x$loading[,2], col="blue",lty=2) - lines(x$loading[,3], col="red",lty=2) - legend("topleft",legend=c("PCA1","PCA2","PCA3"),bty="n",lty=c(1,2,2),col=c("black","blue","red"), cex=0.8) - }else{ - plot.zoo(pca$loading[,1:3], type="l", main = main, - xlab="Maturity/Items") - } - }else if(ncol(x$loading) == 2){ - if(!separate){ - plot(x$loading[,1], type="l", main = main, - xlab="Maturity/Items", ylab="Loadings") - lines(x$loading[,2], col="blue",lty=2) - legend("topleft",legend=c("PCA1","PCA2"),bty="n",lty=c(1,2),col=c("black","blue"), cex=0.8) - }else{ - plot.zoo(pca$loading[,1:2], type="l", main = main, - xlab="Maturity/Items") - } - }else{ - plot(x$loading[,1], type="l", main = main, - xlab="Maturity/Items", ylab="Loadings") - legend("topleft",legend=c("PCA1"),bty="n",lty=c(1),col=c("black"), cex=0.8) - } -} \ No newline at end of file +########## Hedge Section-Convexity and Duration########## + +# macaulay duration +bondDuration.MC <- function(bond, discountCurve, percentChangeYield = 0){ + # Get data from the bond and discount curve + nDC = length(discountCurve) + m = bond$m + couponRate = bond$couponRate + face = bond$face + time = bond$time + # Calculate the ytm + ytm = bondYTM(bond=bond, discountCurve=discountCurve) + percentChangeYield + # Convert to continuously compounded rate + y_c = m * log(1 + ytm / m) + # Get the cashflows of coupon amounts and face value + couponAmount = face * couponRate / m + cashflows = rep(couponAmount, nDC) + cashflows[nDC] = couponAmount + face + # Calculate the price based on the continuously compounded rate + price = sum(cashflows * exp(-y_c * time)) + # Calculate the duration + duration = sum(-time * cashflows * exp(-y_c * time)) / -price + return(duration) +} + +# modified duration +bondDuration.Mod <- function(bond, discountCurve, percentChangeYield = 0){ + #Get the macaulay duration using bondDuration.MC function + duration = bondDuration.MC(bond, discountCurve, percentChangeYield) + #Calculating yield to maturity using bondYTM function + ytm = bondYTM(bond,df) + mduration = duration/(1+ytm/bond$m) + return(mduration) +} + +#' Calculate the duration of a bond +#' +#' Estimate the macaulay or modified duration of a fixed rate coupon bond +#' given the discount curve and bond data. The duration is calculated +#' using the continuously compounded yield +#' +#' @param bond a \code{bond} object created with \code{\link{bondSpec}} +#' @param discountCurve vector of discount rates +#' @param percentChangeYield optional elasticity measure +#' @param type specify modified or macaulay duration +#' @return duration of the bond +#' @examples +#' time = seq(from=0.5, to=2, by=0.5) +#' DF = rbind(0.968,0.9407242,0.9031545,0.8739803) +#' bond = bondSpec(time, face=100, m=2, couponRate = 0.0475) +#' mcDuration = bondDuration(bond,DF, type="macaulay") +#' modDuration = bondDuration(bond,DF, type="modified") +#' @author Thomas Fillebeen and Jaiganesh Prabhakaran +#' @export +bondDuration <- function(bond, discountCurve, percentChangeYield = 0, type=c("modified", "macaulay")){ + type <- match.arg(type) + switch(type, + modified = { + out <- bondDuration.Mod(bond, discountCurve, percentChangeYield) + }, + macaulay = { + out <- bondDuration.MC(bond, discountCurve, percentChangeYield) + } + ) + return(out) +} + +#' Calculate the convexity of a fixed rate coupon bond +#' +#' This function estimates the convexity of a fixed rate coupon bond +#' given the discount curve and bond data. +#' +#' @param bond a \code{bond} object in discountFactorArbitrage +#' @param discountCurve vector of discount rates +#' @return convexity of the bond +#' @examples +#' time = seq(from=0.5, to=2, by=0.5) +#' DF = rbind(0.968,0.9407242,0.9031545,0.8739803) +#' bond = bondSpec(time, face=100, m=2, couponRate = 0.0475) +#' convexity = bondConvexity(bond,DF) +#' @author Thomas Fillebeen +#' @export +bondConvexity <- function(bond, discountCurve){ + # Get data from the bond and discount curve + nDC = length(discountCurve) + m = bond$m + couponRate = bond$couponRate + face = bond$face + time = bond$time + # Get the cashflows of coupon amounts and face value + couponAmount = face * couponRate / m + cashflows = rep(couponAmount, nDC) + cashflows[nDC] = couponAmount + face + # The price is the sum of the discounted cashflows + price = sum(discountCurve * cashflows) + weights = (discountCurve * cashflows) / price + convexity = sum(weights * time^2) + return(convexity) +} + +#' Calculate the yield to maturity of a bond +#' +#' This function calculates the yield to maturity of a fixed rate coupon bond +#' given the discount curve and bond data. +#' +#' @param bond a \code{bond} object +#' @param discountCurve vector of discount rates +#' @return yield to maturity of the bond +#' @examples +#' time = seq(from=0.5, to=2, by=0.5) +#' DF = rbind(0.968,0.9407242,0.9031545,0.8739803) +#' bond = bondSpec(time, face=100, m=2, couponRate = 0.0475) +#' bondYTM(bond,DF) +#' @author Thomas Fillebeen +#' @export +bondYTM <- function(bond, discountCurve){ + # First step is to calculate the price based on the discount curve + price <- bondPrice(bond=bond, discountCurve=discountCurve) + + # Get the data from the bond object + m <- bond$m + couponRate <- bond$couponRate + face <- bond$face + time <- bond$time + + # Use optimize to solve for the yield to maturity + tmp <- optimize(ytmSolve, interval=c(-1,1), couponRate=couponRate, m=m, nPayments=length(time), face=face, targetPrice=price, tol=.Machine$double.eps) + ytm <- tmp$minimum + return(ytm) +} + +#' Solve for the yield to maturity of a bond +#' +#' This function solves for the yield to maturity of a fixed rate coupon bond +#' given the discount curve and bond data. +#' +#' @param ytm yield to maturity +#' @param couponRate coupon rate +#' @param m compounding frequency +#' @param nPayments is the number of payments +#' @param face is the face value +#' @param targetPrice is the price of the bond +#' @return Absolute value of difference between the price and the present value +#' @author Thomas Fillebeen +#' @export +ytmSolve <- function(ytm, couponRate, m, nPayments, face, targetPrice){ + C <- face * couponRate / m + tmpPrice <- 0 + for(i in 1:nPayments){ + tmpPrice <- tmpPrice + C / ((1 + (ytm / m))^i) + } + tmpPrice <- tmpPrice + face / (1 + ytm / m)^nPayments + return(abs(tmpPrice - targetPrice)) +} + + +############ Hedge section-Empirical############### + +#' Estimate the delta hedge of for a bond +#' +#' This function estimates the delta for hedging a particular bond +#' given bond data +#' +#' @param regressand a \code{bond} object in discountFactorArbitrage +#' @param regressor the right hand side +#' @return delta of the hedge +#' @examples +#' # Load Data for historcal analysis tools +#' data(crsp.short) +#' data = largecap.ts[,2:6] +#' head(data) +#' # Empirical application: Linear hedge estimation +#' # OLS Level-on-Level regression +#' deltas = linearHedge(data[,1],data[,2:5]) +#' # Insert the normalized hedged contract versus hedgeable contract value +#' deltas = c(1,deltas) +#' # In sample illustration: random, mean reverting spreads +# ' hedgedInstruments = data%*%deltas +#' @author Thomas Fillebeen +#' @export +linearHedge <- function(regressand, regressor){ + deltas = matrix(0,nrow=1,ncol= ncol(regressor)) + reg = lm(regressand ~ regressor) + deltas = -coef(reg)[seq(2,ncol(data),1)] + return(deltas) +} + +#' Estimate PCA loadings and create a PCA object +#' +#' This function estimates the delta for hedging a particular bond +#' given bond data +#' +#' @param data time series data +#' @param nfactors number of components to extract +#' @param rotate "none", "varimax", "quatimax", "promax", "oblimin", "simplimax", and "cluster" are possible rotations/transformations of the solution. +#' @return pca object loadings +#' @author Thomas Fillebeen +#' @export +PCA <- function(data, nfactors, rotate = "none"){ + stopifnot("package:psych" %in% search() || require("psych", quietly = TRUE)) + + pca = principal(data, nfactors, rotate="none") + class(pca) <- c("PCA","psych", "principal") + return(pca) +} + +#' Retrieve PCA loadings +#' +#' @param object is a pca object created by \code{\link{PCA}} +#' @author Thomas Fillebeen +#' @export +getLoadings <- function(object){ +loadings = object$loadings + return(loadings) +} + +#' Retrieve PCA weights +#' +#' @param object is a pca object created by \code{\link{PCA}} +#' @author Thomas Fillebeen +#' @export +getWeights <- function(object){ + weights = object$weight + return(weights) +} + +#' Plotting method for PCA +#' +#' Plot a fitted PCA object +#' +#' @param x a PCA object created by \code{\link{PCA}} +#' @param y not used +#' @param \dots passthrough parameters to \code{\link{plot}}. +#' @param main a main title for the plot +#' @param separate if TRUE plot of same, and if FALSE plot separately +#' @author Thomas Fillebeen +#' @method plot PCA +#' @S3method plot PCA +plot.PCA <- function(x, y, ..., main="Beta from PCA regression",separate=TRUE){ + if(ncol(x$loading)> 3) warning("Only first 3 loadings will be graphically displayed") + # Plot the first three factors + if (ncol(x$loading) >= 3){ + if(!separate){ + plot(x$loading[,1], type="l", main = main, + xlab="Maturity/Items", ylab="Loadings", ...=...) + lines(x$loading[,2], col="blue",lty=2) + lines(x$loading[,3], col="red",lty=2) + legend("topleft",legend=c("PCA1","PCA2","PCA3"),bty="n",lty=c(1,2,2),col=c("black","blue","red"), cex=0.8) + }else{ + plot.zoo(pca$loading[,1:3], type="l", main = main, + xlab="Maturity/Items", ...=...) + } + }else if(ncol(x$loading) == 2){ + if(!separate){ + plot(x$loading[,1], type="l", main = main, + xlab="Maturity/Items", ylab="Loadings", ...=...) + lines(x$loading[,2], col="blue",lty=2) + legend("topleft",legend=c("PCA1","PCA2"),bty="n",lty=c(1,2),col=c("black","blue"), cex=0.8) + }else{ + plot.zoo(pca$loading[,1:2], type="l", main = main, + xlab="Maturity/Items", ...=...) + } + }else{ + plot(x$loading[,1], type="l", main = main, + xlab="Maturity/Items", ylab="Loadings", ...=...) + legend("topleft",legend=c("PCA1"),bty="n",lty=c(1),col=c("black"), cex=0.8) + } +} From noreply at r-forge.r-project.org Sat Feb 7 17:24:39 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 7 Feb 2015 17:24:39 +0100 (CET) Subject: [Uwgarp-commits] r220 - pkg/GARPFRM/R Message-ID: <20150207162439.586B4187716@r-forge.r-project.org> Author: rossbennett34 Date: 2015-02-07 17:24:38 +0100 (Sat, 07 Feb 2015) New Revision: 220 Modified: pkg/GARPFRM/R/riskMetricsAndHedges.R Log: fixing bug in modified duration function Modified: pkg/GARPFRM/R/riskMetricsAndHedges.R =================================================================== --- pkg/GARPFRM/R/riskMetricsAndHedges.R 2015-02-07 15:50:21 UTC (rev 219) +++ pkg/GARPFRM/R/riskMetricsAndHedges.R 2015-02-07 16:24:38 UTC (rev 220) @@ -28,7 +28,7 @@ #Get the macaulay duration using bondDuration.MC function duration = bondDuration.MC(bond, discountCurve, percentChangeYield) #Calculating yield to maturity using bondYTM function - ytm = bondYTM(bond,df) + ytm = bondYTM(bond,discountCurve) mduration = duration/(1+ytm/bond$m) return(mduration) } From noreply at r-forge.r-project.org Sat Feb 7 18:16:00 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 7 Feb 2015 18:16:00 +0100 (CET) Subject: [Uwgarp-commits] r221 - in pkg/GARPFRM: . R data demo man sandbox Message-ID: <20150207171600.AB346185DD8@r-forge.r-project.org> Author: rossbennett34 Date: 2015-02-07 18:16:00 +0100 (Sat, 07 Feb 2015) New Revision: 221 Added: pkg/GARPFRM/man/impliedVolBS.Rd pkg/GARPFRM/man/spotForwardRates.Rd pkg/GARPFRM/man/vasicekPrice.Rd pkg/GARPFRM/man/yieldCurveVasicek.Rd pkg/GARPFRM/sandbox/CAPM_TF.R pkg/GARPFRM/sandbox/GARPFRM_Outline.Rmd Removed: pkg/GARPFRM/data/.Rapp.history pkg/GARPFRM/demo/CAPM_TF.R pkg/GARPFRM/demo/WebApplications.R pkg/GARPFRM/man/Modified.bondDuration.Rd pkg/GARPFRM/man/plot.loadings.Rd Modified: pkg/GARPFRM/NAMESPACE pkg/GARPFRM/R/discountFactorArbitrage.R pkg/GARPFRM/R/options.R pkg/GARPFRM/R/riskMetricsAndHedges.R pkg/GARPFRM/demo/00Index pkg/GARPFRM/demo/DelineatingEfficientPortfolios.R pkg/GARPFRM/demo/EWMA.R pkg/GARPFRM/man/CAPM.Rd pkg/GARPFRM/man/EWMA.Rd pkg/GARPFRM/man/PCA.Rd pkg/GARPFRM/man/backtestVaR.GARCH.Rd pkg/GARPFRM/man/backtestVaR.Rd pkg/GARPFRM/man/bondConvexity.Rd pkg/GARPFRM/man/bondDuration.Rd pkg/GARPFRM/man/bondFullPrice.Rd pkg/GARPFRM/man/bondPrice.Rd pkg/GARPFRM/man/bondSpec.Rd pkg/GARPFRM/man/bondYTM.Rd pkg/GARPFRM/man/bootCor.Rd pkg/GARPFRM/man/bootCov.Rd pkg/GARPFRM/man/bootES.Rd pkg/GARPFRM/man/bootFUN.Rd pkg/GARPFRM/man/bootMean.Rd pkg/GARPFRM/man/bootSD.Rd pkg/GARPFRM/man/bootSimpleVolatility.Rd pkg/GARPFRM/man/bootStdDev.Rd pkg/GARPFRM/man/bootVaR.Rd pkg/GARPFRM/man/chartSML.Rd pkg/GARPFRM/man/compoundingRate.Rd pkg/GARPFRM/man/computeGreeks.Rd pkg/GARPFRM/man/discountFactor.Rd pkg/GARPFRM/man/efficientFrontier.Rd pkg/GARPFRM/man/efficientFrontierTwoAsset.Rd pkg/GARPFRM/man/endingPrices.Rd pkg/GARPFRM/man/estimateLambdaCor.Rd pkg/GARPFRM/man/estimateLambdaCov.Rd pkg/GARPFRM/man/estimateLambdaVol.Rd pkg/GARPFRM/man/forecast.Rd pkg/GARPFRM/man/forecast.uvEWMAvol.Rd pkg/GARPFRM/man/forecast.uvGARCH.Rd pkg/GARPFRM/man/getAlphas.Rd pkg/GARPFRM/man/getBetas.Rd pkg/GARPFRM/man/getCor.Rd pkg/GARPFRM/man/getCov.Rd pkg/GARPFRM/man/getEstimate.Rd pkg/GARPFRM/man/getFit.Rd pkg/GARPFRM/man/getLoadings.Rd pkg/GARPFRM/man/getSpec.Rd pkg/GARPFRM/man/getStatistics.Rd pkg/GARPFRM/man/getVaREstimates.Rd pkg/GARPFRM/man/getVaRViolations.Rd pkg/GARPFRM/man/getWeights.Rd pkg/GARPFRM/man/hypTest.Rd pkg/GARPFRM/man/impliedVolatility.Rd pkg/GARPFRM/man/is.bond.Rd pkg/GARPFRM/man/linearHedge.Rd pkg/GARPFRM/man/minVarPortfolio.Rd pkg/GARPFRM/man/monteCarlo.Rd pkg/GARPFRM/man/optionSpec.Rd pkg/GARPFRM/man/optionValue.Rd pkg/GARPFRM/man/plot.EWMA.Rd pkg/GARPFRM/man/plot.PCA.Rd pkg/GARPFRM/man/plot.backtestVaR.Rd pkg/GARPFRM/man/plot.capm_mlm.Rd pkg/GARPFRM/man/plot.capm_uv.Rd pkg/GARPFRM/man/plot.efTwoAsset.Rd pkg/GARPFRM/man/plot.efficient.frontier.Rd pkg/GARPFRM/man/plot.uvGARCH.Rd pkg/GARPFRM/man/plotEndingPrices.Rd pkg/GARPFRM/man/portReturnTwoAsset.Rd pkg/GARPFRM/man/portSDTwoAsset.Rd pkg/GARPFRM/man/realizedCor.Rd pkg/GARPFRM/man/realizedCov.Rd pkg/GARPFRM/man/realizedVol.Rd pkg/GARPFRM/man/rollCor.Rd pkg/GARPFRM/man/rollCov.Rd pkg/GARPFRM/man/rollSD.Rd pkg/GARPFRM/man/rollSimpleVolatility.Rd pkg/GARPFRM/man/simpleVolatility.Rd pkg/GARPFRM/man/tangentPortfolio.Rd pkg/GARPFRM/man/uvGARCH.Rd pkg/GARPFRM/man/ytmSolve.Rd Log: major cleanup of code and documentation for R CMD check Modified: pkg/GARPFRM/NAMESPACE =================================================================== --- pkg/GARPFRM/NAMESPACE 2015-02-07 16:24:38 UTC (rev 220) +++ pkg/GARPFRM/NAMESPACE 2015-02-07 17:16:00 UTC (rev 221) @@ -1,4 +1,4 @@ -# Generated by roxygen2 (4.0.1): do not edit by hand +# Generated by roxygen2 (4.1.0): do not edit by hand S3method(forecast,uvEWMAvol) S3method(forecast,uvGARCH) @@ -73,6 +73,7 @@ export(getVaRViolations) export(getWeights) export(hypTest) +export(impliedVolBS) export(impliedVolatility) export(is.bond) export(linearHedge) Modified: pkg/GARPFRM/R/discountFactorArbitrage.R =================================================================== --- pkg/GARPFRM/R/discountFactorArbitrage.R 2015-02-07 16:24:38 UTC (rev 220) +++ pkg/GARPFRM/R/discountFactorArbitrage.R 2015-02-07 17:16:00 UTC (rev 221) @@ -1,285 +1,290 @@ -# Ch 6 Prices, Discount Factors, and Arbitrage (Law of one Price) -# The Cash Flows from Fixed-Rate Government Coupon Bonds, Discount Faors, Law of One Price -# Arbitrage opportunity: trade that generates profits without any chance of losing money. -# If there is a deviation from the law of one price, there exists an arbitrage opportunity. -# In order to estimate the discount factor for a particular term gives the value today, -# or the present alue of one unit of currency to be received at the end of that term.(Pg.129) - -#' Constructor for bond specification -#' -#' Created a bond object \code{bond.spec} with data for bond specification. -#' -#' @param time vector of sequence of coupon payments in years -#' @param face face value of bond -#' @param m compounding frequency -#' @param couponRate rate the coupon pays -#' @return a \code{bond} object with the bond data used for pricing -#' @examples -#' time = seq(from=0.5, to=2, by=0.5) -#' bond = bondSpec(time, face=100, m=2, couponRate = 0.0475) -#' @author Thomas Fillebeen -#' @export -bondSpec = function(time=seq(from=0.5,to=2,by=0.5), face=100, m=2, couponRate=0.01){ - if(!all(diff(time) == (1/m))) stop("misspecification of sequence of time and compounding frequency") - bond = list() - bond$m = m - bond$couponRate = couponRate - bond$face = face - bond$time = time - class(bond) = c("bond.spec", "bond") - return(bond) -} - -#' To determine if user is specifying bond parameters correctly -#' -#' @param object a capm object created by \code{\link{bond.spec}} -#' @author TF -#' @export -is.bond = function(object){ - inherits(object, "bond.spec") -} - -#' Estimate price of bond -#' -#' This function calculates the price of a fixed rate coupon bond given the -#' discount curve and bond data. First it converts the discountCurve into CF -#' @param bond a \code{bondSpec} object -#' @param discountCurve vector of discount rates -#' @return price of the bond -#' @examples -#' time = seq(from=0.5, to=2, by=0.5) -#' bond = bondSpec(time, face=100, m=2, couponRate = 0.0475) -#' DF = rbind(0.968,0.9407242,0.9031545,0.8739803) -#' price = bondPrice(bond,DF) -#' @author Thomas Fillebeen -#' @export -bondPrice = function(bond, discountCurve){ - if(!is.bond(bond)) stop("bond must be an object of class 'bond'") - # Number of periods in discount curve - nDC <- length(discountCurve) - m <- bond$m - couponRate <- bond$couponRate - face <- bond$face - time <- bond$time - - couponAmount <- face * couponRate / m - cashflows <- rep(couponAmount, nDC) - cashflows[nDC] <- couponAmount + face - price <- sum(cashflows * discountCurve) - return(price) -} - -#' Estimate discountFactor -#' -#' This function calculates the discountFactor (DF) given price -#' and cashFlows. -#' @param price of a bond -#' @param cashFlow of a bond -#' @return discount factors -#' @examples -#' cashFlow = rbind(c(100+(1+1/4)/2,0,0),c((4 +7/8)/2,100+(4+7/8)/2,0),c((4+1/2)/2,(4+1/2)/2,100+(4+1/2)/2)) -#' # Created Price of the bond -#' price = matrix(c(100.550, 104.513, 105.856), ncol=1) -#' DF = discountFactor(price, cashFlow) -#' @author Thomas Fillebeen -#' @export -discountFactor = function(price, cashFlow){ - DF = solve(cashFlow) %*% price - return(DF) -} - -#' bondFullPrice -#' -#' Estimate price of bond w/ acrrued interest -#' The present value of a bond's cash flows should be equated or -#' compared with its full price, with the amount a pruchaser actually -#' pays to purchase those cash flows. The flat price is p, accrued -#' interest is AI, the present value of the cash flows by PV, and the -#' full price by P: -#' P=p+AI=PV -#' -#' This function calculates the price of a fixed rate coupon bond given coupon rate, yield, -#' compoundPd, cashFlowPd, face value, previous coupon date, next coupon date. -#' @param bond is a bondSpec object created by \code{\link{bondSpec}} -#' @param yield is the yield on the bond -#' @param cashFlowPd cash flow period -#' @param t0 previous coupon date -#' @param t1 next coupon period -#' @param currentDate current date -#' @examples -#' t0 = as.Date("2013-08-15") -#' t1 = as.Date("2014-02-15") -#' tn = as.Date("2013-10-04") -#' currentDate = tn -#' bond = bondSpec(face=100, m=2, couponRate = 0.0475) -#' y1 = 0.00961 -#' bondFullPrice(bond, y1, 8, t0, t1, tn)$clean -#' bondFullPrice(bond, y1, 8, t0, t1, tn)$dirty -#' bondFullPrice(bond, y1, 8, t0, t1, tn)$accruedInterest -#' @return price of the bond: clean, dirty and accrued interest -#' @author Thomas Fillebeen -#' @export -bondFullPrice = function(bond, yield, cashFlowPd, t0, t1, currentDate){ - compoundPd = bond$m - face = bond$face - couponRate = bond$couponRate - # Apply a general dayCount (weekend included) - d1 = as.numeric(t1-currentDate) - d2 = as.numeric(t1-t0) - # Initialize - tmp = 0 - - #Will go through the loop only if the number of cashFlow periods are at least 2 - if (cashFlowPd > 1){ - for(k in 1:(cashFlowPd-1)){ - tmp = tmp + ((couponRate / compoundPd * face) / ((1 + yield/compoundPd)^k)) - } - } - # Calculate dirty price based on partial periods formula - dirtyP = (1 / ((1 + yield / compoundPd)^(d1/d2))) * (couponRate / compoundPd * face + tmp + face / ((1 + yield/compoundPd)^(cashFlowPd-1))) - # Calculate accruedInterest - aiDays = as.numeric(currentDate-t0) - couponDays = as.numeric(t1-t0) - ai = couponRate / compoundPd * face * aiDays / couponDays - cleanP = dirtyP - ai - return(list(dirty=dirtyP, clean=cleanP, accruedInterest=ai)) -} - -#' Estimate continuously conpounding rate to be used in term structure -#' -#' This function calculates the continuously compounding rate given an initial dataset -#' with specific format, date of reference coumpounding frequency, and face value -#' @param dat is a dataset with cusip, issueDate, MaturityDate, Name, Coupon, Bid/Ask -#' @param intialDate is the date when the estimation should be conducted: date of reference -#' @param m compounding frequency -#' @param face face value -#' @return continuously compounding rates -#' @author Thomas Fillebeen -#' @export -compoundingRate = function(dat, initialDate=as.Date("1995-05-15"), m, face=100){ - # Convert the dates to a date class - dat[, "IssueDate"] = as.Date(dat[, "IssueDate"], format="%m/%d/%Y") - dat[, "MaturityDate"] = as.Date(dat[, "MaturityDate"], format="%m/%d/%Y") - # Convert the coupon column to a numeric - # Vector of prices - price = (dat[, "Bid"] + dat[, "Ask"]) / 2 - - # Generate cash flow dates for each bond - bondData = list() - for(i in 1:nrow(dat)){ - maturityDate = dat[i, "MaturityDate"] - # Intialize a new list for every price, coupon, coupon date. - bondData[[i]] = list() - # Store price and the number of the coupon - bondData[[i]]$price = price[i] - bondData[[i]]$coupon = dat[i, "Coupon"] - # Remove initialDate - tmpSeq <- seq(from=initialDate, to=maturityDate, by="3 months") - bondData[[i]]$couponDates = tmpSeq[-1] - tmpDates = bondData[[i]]$couponDates - tmpCoupons = vector("numeric", length(tmpDates)) - for(j in 1:length(tmpDates)){ - tmpCoupons[j] = bondData[[i]]$coupon / m * face - if(j == length(tmpDates)){ - tmpCoupons[j] = face + bondData[[i]]$coupon / m * face - } - } - bondData[[i]]$cashFlow = tmpCoupons - } - # Create a matrix of cash flows - CF = matrix(0, length(price), length(price)) - # Populate the CF matrix - for(i in 1:nrow(CF)){ - tmp = bondData[[i]]$cashFlow - index = 1:length(tmp) - CF[i, index] = tmp - } - # Utilize the discountFactor function - DF = discountFactor(price,CF) - - dates = bondData[[nrow(dat)]]$couponDates - years = vector("numeric", length(dates)) - for(i in 1:length(years)){ - years[i] = (as.numeric(strftime(dates[i], "%Y")) + as.numeric(strftime(dates[i], "%m"))/12) - (as.numeric(strftime(initialDate, "%Y")) + as.numeric(strftime(initialDate, "%m"))/12) - } - # Calculate continuously compounded rates from discount factors - ccRate = vector("numeric", length(years)) - for(i in 1:length(ccRate)){ - ccRate[i] = - log(DF[i]) / years[i] - } - rate = list() - rate$years = years - rate$ccRate = ccRate - return(rate) -} - -#' Estimate spot and forward rates -#' -#' This function calculates the forward or forward rates given an discount factors -#' and time increments -#' @param time increments of time when discount factors are estimated -#' @param DF discount factor for during time increments -#' @examples -#' DF = c(0.996489, 0.991306, 0.984484, 0.975616, 0.964519) -#' time = seq(from=0.5, to=2.5, by=0.5) -#' rates = spotForwardRates(time,DF) -#' rates -#' @author Thomas Fillebeen -#' @export -spotForwardRates = function(time, DF){ - if(length(time) != length(DF)) stop("both time and DF parameter need to be of the same length") -spotRates = matrix(0,length(time),1) -for(i in 1:(length(time))){ - spotRates[i] = (2-2*DF[i]^(1/(2*time[i]))) / DF[i]^(1/(2*time[i])) -} - -forwardRates = matrix(0,length(time),1) -forwardRates[1] = spotRates[1] -for(j in 1:(length(time)-1)){ - forwardRates[j+1] = (DF[j]/DF[j+1] - 1) *2 -} -rates = cbind(spotRates, forwardRates) -colnames(rates)= cbind("Spot","Forward") -return(rates) -} - -### Modelling a Zero-Coupon Bond (ZCB) -#' There are three main types of yield curve shapes: normal, inverted and flat (or humped) -#' Estimate Vasicek zero-coupon bond to be used in term structure -#' -#' This function calculates the Vasicek Price given an initial data calibration -#' The function is a subfunction for yieldCurveVasicek -#' @param r initial short rate -#' @param k speed of reversion parameter -#' @param theta long-term reversion yield -#' @param sigma randomness parameter. Modelled after Brownan Motion -#' @return t length of time modelled for -#' @author Thomas Fillebeen -#' @export -vasicekPrice = function(r, k, theta, sigma, maturity){ - mean = (1/k)*(1 - exp(-maturity*k)) - variance = (theta - sigma^2/(2*k^2))*(maturity - mean) + (sigma^2)/(4*k)*mean^2 - price = exp(-variance - mean*r) - return(price) - } - -#' Estimate Vasicek zero-coupon yield -#' -#' This function calculates the Vasicek yield given an initial data calibration -#' @param r initial short rate -#' @param k speed of reversion parameter -#' @param theta long-term reversion yield -#' @param sigma randomness parameter. Modelled after Brownan Motion -#' @return t length of time modelled for -#' @author Thomas Fillebeen -#' @export -yieldCurveVasicek = function(r, k, theta, sigma, maturity){ - n = length(r) - yield = matrix(0, maturity, n) - for(i in 1:n){ - for(t in 1:maturity){ - yield[t,i] = -log(vasicekPrice(r[i], k, theta, sigma, t))/t - } - } - return(yield) +# Ch 6 Prices, Discount Factors, and Arbitrage (Law of one Price) +# The Cash Flows from Fixed-Rate Government Coupon Bonds, Discount Faors, Law of One Price +# Arbitrage opportunity: trade that generates profits without any chance of losing money. +# If there is a deviation from the law of one price, there exists an arbitrage opportunity. +# In order to estimate the discount factor for a particular term gives the value today, +# or the present alue of one unit of currency to be received at the end of that term.(Pg.129) + +#' Constructor for bond specification +#' +#' Create a bond specification. +#' +#' @param time vector of sequence of coupon payments in years +#' @param face face value of bond +#' @param m compounding frequency +#' @param couponRate rate the coupon pays +#' @return a \code{bond} object with the bond data used for pricing +#' @examples +#' time = seq(from=0.5, to=2, by=0.5) +#' bond = bondSpec(time, face=100, m=2, couponRate = 0.0475) +#' @author Thomas Fillebeen +#' @export +bondSpec = function(time=seq(from=0.5,to=2,by=0.5), face=100, m=2, couponRate=0.01){ + if(!all(diff(time) == (1/m))) stop("misspecification of sequence of time and compounding frequency") + bond = list() + bond$m = m + bond$couponRate = couponRate + bond$face = face + bond$time = time + class(bond) = c("bond.spec", "bond") + return(bond) +} + +#' To determine if user is specifying bond parameters correctly +#' +#' @param object a bond specification object created by \code{\link{bondSpec}} +#' @author Thomas Fillebeen +#' @export +is.bond = function(object){ + inherits(object, "bond.spec") +} + +#' Estimate price of bond +#' +#' This function calculates the price of a fixed rate coupon bond given the +#' discount curve and bond data. First it converts the discountCurve into CF +#' @param bond a \code{bondSpec} object +#' @param discountCurve vector of discount rates +#' @return price of the bond +#' @examples +#' time = seq(from=0.5, to=2, by=0.5) +#' bond = bondSpec(time, face=100, m=2, couponRate = 0.0475) +#' DF = rbind(0.968,0.9407242,0.9031545,0.8739803) +#' price = bondPrice(bond,DF) +#' @author Thomas Fillebeen +#' @export +bondPrice = function(bond, discountCurve){ + if(!is.bond(bond)) stop("bond must be an object of class 'bond'") + # Number of periods in discount curve + nDC <- length(discountCurve) + m <- bond$m + couponRate <- bond$couponRate + face <- bond$face + time <- bond$time + + couponAmount <- face * couponRate / m + cashflows <- rep(couponAmount, nDC) + cashflows[nDC] <- couponAmount + face + + price <- sum(cashflows * discountCurve) + return(price) +} + +#' Estimate discountFactor +#' +#' This function calculates the discountFactor (DF) given price +#' and cashFlows. +#' @param price of a bond +#' @param cashFlow of a bond +#' @return discount factors +#' @examples +#' cashFlow = rbind(c(100+(1+1/4)/2,0,0),c((4 +7/8)/2,100+(4+7/8)/2,0),c((4+1/2)/2,(4+1/2)/2,100+(4+1/2)/2)) +#' # Created Price of the bond +#' price = matrix(c(100.550, 104.513, 105.856), ncol=1) +#' DF = discountFactor(price, cashFlow) +#' @author Thomas Fillebeen +#' @export +discountFactor = function(price, cashFlow){ + DF = solve(cashFlow) %*% price + return(DF) +} + +#' bondFullPrice +#' +#' Estimate price of bond w/ acrrued interest +#' The present value of a bond's cash flows should be equated or +#' compared with its full price, with the amount a purchaser actually +#' pays to purchase those cash flows. The flat price is denoted by p, accrued +#' interest is AI, the present value of the cash flows by PV, and the +#' full price by P: +#' P=p+AI=PV +#' +#' This function calculates the price of a fixed rate coupon bond given coupon rate, yield, +#' compoundPd, cashFlowPd, face value, previous coupon date, next coupon date. +#' @param bond is a bondSpec object created by \code{\link{bondSpec}} +#' @param yield is the yield on the bond +#' @param cashFlowPd cash flow period +#' @param t0 previous coupon date +#' @param t1 next coupon period +#' @param currentDate current date +#' @examples +#' t0 = as.Date("2013-08-15") +#' t1 = as.Date("2014-02-15") +#' tn = as.Date("2013-10-04") +#' currentDate = tn +#' bond = bondSpec(face=100, m=2, couponRate = 0.0475) +#' y1 = 0.00961 +#' bondFullPrice(bond, y1, 8, t0, t1, tn)$clean +#' bondFullPrice(bond, y1, 8, t0, t1, tn)$dirty +#' bondFullPrice(bond, y1, 8, t0, t1, tn)$accruedInterest +#' @return price of the bond: clean, dirty and accrued interest +#' @author Thomas Fillebeen +#' @export +bondFullPrice = function(bond, yield, cashFlowPd, t0, t1, currentDate){ + compoundPd = bond$m + face = bond$face + couponRate = bond$couponRate + # Apply a general dayCount (weekend included) + d1 = as.numeric(t1-currentDate) + d2 = as.numeric(t1-t0) + # Initialize + tmp = 0 + + #Will go through the loop only if the number of cashFlow periods are at least 2 + if (cashFlowPd > 1){ + for(k in 1:(cashFlowPd-1)){ + tmp = tmp + ((couponRate / compoundPd * face) / ((1 + yield/compoundPd)^k)) + } + } + # Calculate dirty price based on partial periods formula + dirtyP = (1 / ((1 + yield / compoundPd)^(d1/d2))) * (couponRate / compoundPd * face + tmp + face / ((1 + yield/compoundPd)^(cashFlowPd-1))) + # Calculate accruedInterest + aiDays = as.numeric(currentDate-t0) + couponDays = as.numeric(t1-t0) + ai = couponRate / compoundPd * face * aiDays / couponDays + cleanP = dirtyP - ai + return(list(dirty=dirtyP, clean=cleanP, accruedInterest=ai)) +} + +#' Estimate continuously conpounding rate to be used in term structure +#' +#' This function calculates the continuously compounding rate given an initial dataset +#' with specific format, date of reference coumpounding frequency, and face value +#' @param dat is a dataset with cusip, issueDate, MaturityDate, Name, Coupon, Bid/Ask +#' @param initialDate is the date when the estimation should be conducted: date of reference +#' @param m compounding frequency +#' @param face face value +#' @return continuously compounding rates +#' @author Thomas Fillebeen +#' @export +compoundingRate = function(dat, initialDate=as.Date("1995-05-15"), m, face=100){ + # Convert the dates to a date class + dat[, "IssueDate"] = as.Date(dat[, "IssueDate"], format="%m/%d/%Y") + dat[, "MaturityDate"] = as.Date(dat[, "MaturityDate"], format="%m/%d/%Y") + # Convert the coupon column to a numeric + # Vector of prices + price = (dat[, "Bid"] + dat[, "Ask"]) / 2 + + # Generate cash flow dates for each bond + bondData = list() + for(i in 1:nrow(dat)){ + maturityDate = dat[i, "MaturityDate"] + # Intialize a new list for every price, coupon, coupon date. + bondData[[i]] = list() + # Store price and the number of the coupon + bondData[[i]]$price = price[i] + bondData[[i]]$coupon = dat[i, "Coupon"] + # Remove initialDate + tmpSeq <- seq(from=initialDate, to=maturityDate, by="3 months") + bondData[[i]]$couponDates = tmpSeq[-1] + tmpDates = bondData[[i]]$couponDates + tmpCoupons = vector("numeric", length(tmpDates)) + for(j in 1:length(tmpDates)){ + tmpCoupons[j] = bondData[[i]]$coupon / m * face + if(j == length(tmpDates)){ + tmpCoupons[j] = face + bondData[[i]]$coupon / m * face + } + } + bondData[[i]]$cashFlow = tmpCoupons + } + # Create a matrix of cash flows + CF = matrix(0, length(price), length(price)) + # Populate the CF matrix + for(i in 1:nrow(CF)){ + tmp = bondData[[i]]$cashFlow + index = 1:length(tmp) + CF[i, index] = tmp + } + # Utilize the discountFactor function + DF = discountFactor(price,CF) + + dates = bondData[[nrow(dat)]]$couponDates + years = vector("numeric", length(dates)) + for(i in 1:length(years)){ + years[i] = (as.numeric(strftime(dates[i], "%Y")) + as.numeric(strftime(dates[i], "%m"))/12) - (as.numeric(strftime(initialDate, "%Y")) + as.numeric(strftime(initialDate, "%m"))/12) + } + # Calculate continuously compounded rates from discount factors + ccRate = vector("numeric", length(years)) + for(i in 1:length(ccRate)){ + ccRate[i] = - log(DF[i]) / years[i] + } + rate = list() + rate$years = years + rate$ccRate = ccRate + return(rate) +} + +#' Estimate spot and forward rates +#' +#' This function calculates the forward or forward rates given an discount factors +#' and time increments +#' @param time increments of time when discount factors are estimated +#' @param DF discount factor for during time increments +#' @examples +#' DF = c(0.996489, 0.991306, 0.984484, 0.975616, 0.964519) +#' time = seq(from=0.5, to=2.5, by=0.5) +#' rates = spotForwardRates(time,DF) +#' rates +#' @author Thomas Fillebeen +#' @export +spotForwardRates = function(time, DF){ + if(length(time) != length(DF)) stop("both time and DF parameter need to be of the same length") + spotRates = matrix(0,length(time),1) + for(i in 1:(length(time))){ + spotRates[i] = (2-2*DF[i]^(1/(2*time[i]))) / DF[i]^(1/(2*time[i])) + } + + forwardRates = matrix(0,length(time),1) + forwardRates[1] = spotRates[1] + for(j in 1:(length(time)-1)){ + forwardRates[j+1] = (DF[j]/DF[j+1] - 1) *2 + } + rates = cbind(spotRates, forwardRates) + colnames(rates)= cbind("Spot","Forward") + return(rates) +} + +### Modelling a Zero-Coupon Bond (ZCB) +#' There are three main types of yield curve shapes: normal, inverted and flat (or humped) +#' +#' Estimate Vasicek zero-coupon bond to be used in term structure +#' +#' This function calculates the Vasicek Price given an initial data calibration +#' The function is a subfunction for yieldCurveVasicek +#' @param r initial short rate +#' @param k speed of reversion parameter +#' @param theta long-term reversion yield +#' @param sigma randomness parameter. Modelled after Brownan Motion +#' @param maturity maturity of the bond +#' @return zero coupon bond price estimated from Vasicek model +#' @author Thomas Fillebeen +#' @export +vasicekPrice = function(r, k, theta, sigma, maturity){ + mean = (1/k)*(1 - exp(-maturity*k)) + variance = (theta - sigma^2/(2*k^2))*(maturity - mean) + (sigma^2)/(4*k)*mean^2 + price = exp(-variance - mean*r) + return(price) + } + +#' Estimate Vasicek zero-coupon yield +#' +#' This function calculates the Vasicek yield given an initial data calibration +#' +#' @param r initial short rate +#' @param k speed of reversion parameter +#' @param theta long-term reversion yield +#' @param sigma randomness parameter. Modelled after Brownian Motion +#' @param maturity maturity of the bond +#' @return yield curve estimate from Vasicek model +#' @author Thomas Fillebeen +#' @export +yieldCurveVasicek = function(r, k, theta, sigma, maturity){ + n = length(r) + yield = matrix(0, maturity, n) + for(i in 1:n){ + for(t in 1:maturity){ + yield[t,i] = -log(vasicekPrice(r[i], k, theta, sigma, t))/t + } + } + return(yield) } \ No newline at end of file Modified: pkg/GARPFRM/R/options.R =================================================================== --- pkg/GARPFRM/R/options.R 2015-02-07 16:24:38 UTC (rev 220) +++ pkg/GARPFRM/R/options.R 2015-02-07 17:16:00 UTC (rev 221) @@ -58,6 +58,8 @@ #' @param option an \code{option} object created with \code{\link{optionSpec}} #' @param method the method used to value the option #' @param N number of steps in binomial tree +#' @param verbose TRUE/FALSE default FALSE. TRUE prints the node information +#' of the binomial tree #' @param \dots any other passthrough parameters #' @return the estimated value of the option #' @author Ross Bennett @@ -415,6 +417,15 @@ #' 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}} +#' @param S0 underlying asset price +#' @param K strike price +#' @param r risk free rate +#' @param q continuous dividend yield rate for options on stocks or stock +#' indices paying a dividend. Also the foreign risk free rate for options on +#' currencies +#' @param vol volatility of the underlying asset price +#' @param ttm tmie to maturity, the life of the option, measured in years +#' @param type type of the option; "call" or "put" #' @author Ross Bennett #' @examples #' euro.call <- optionSpec(style="european", type="call", S0=30, K=30, maturity=1, r=0.05, volatility=0.25, q=0) @@ -428,6 +439,7 @@ #' # Plotting #' computeGreeks(euro.call, "delta", prices = seq(20, 40, 1), plot = TRUE) #' computeGreeks(euro.call, "delta", maturities = seq(0.5, 0.01, -0.01), plot = TRUE) +#' @aliases deltaBS, thetaBS, gammaBS, vegaBS, rhoBS #' @export computeGreeks <- function(option, greek=c("delta", "theta", "gamma", "rho", "vega"), @@ -507,6 +519,7 @@ } } +#' @name computeGreeks #' @export deltaBS <- function(S0, K, r, q, vol, ttm, type){ d1 <- (log(S0 / K) + (r - q + (vol^2 / 2)) * ttm) / (vol * sqrt(ttm)) @@ -533,6 +546,7 @@ # return(delta) # } +#' @name computeGreeks #' @export thetaBS <- function(S0, K, r, q, vol, ttm, type){ d1 <- (log(S0 / K) + (r - q + (vol^2 / 2)) * ttm) / (vol * sqrt(ttm)) @@ -562,6 +576,7 @@ # return(theta) # } +#' @name computeGreeks #' @export gammaBS <- function(S0, K, r, q, vol, ttm, type){ d1 <- (log(S0 / K) + (r - q + (vol^2 / 2)) * ttm) / (vol * sqrt(ttm)) @@ -577,6 +592,7 @@ # # gamma.put <- gamma.call +#' @name computeGreeks #' @export vegaBS <- function(S0, K, r, q, vol, ttm, type){ d1 <- (log(S0 / K) + (r - q + (vol^2 / 2)) * ttm) / (vol * sqrt(ttm)) @@ -592,6 +608,7 @@ # # vega.put <- vega.call +#' @name computeGreeks #' @export rhoBS <- function(S0, K, r, q, vol, ttm, type){ d2 <- (log(S0 / K) + (r - q - (vol^2 / 2)) * ttm) / (vol * sqrt(ttm)) @@ -660,6 +677,31 @@ } } +#' Implied Volatility Bisection Method +#' +#' Bisection method to compute the implied volatility of a european option +#' using the Black-Scholes-Merton model. +#' +#' @details A bisection algorithm is used to compute the implied volatility +#' of a European option priced with the Black-Scholes-Merton model +#' +#' @param vol_range c(lower, upper) the lower and upper bounds of the implied +#' volatility range to search +#' @param S0 underlying asset price +#' @param K strike price +#' @param r risk free rate +#' @param q continuous dividend yield rate for options on stocks or stock +#' indices paying a dividend. Also the foreign risk free rate for options on +#' currencies +#' @param ttm time to maturity, the life of the option, measured in years +#' @param P_mkt market price +#' @param type type of the option; "call" or "put" +#' @param tol tolerance used for stopping criteria +#' @param max_it maximum number of iterations +#' +#' @return implied volatility estimate +#' @author Ross Bennett +#' @export impliedVolBS <- function(vol_range, S0, K, r, q, ttm, P_mkt, type, tol=.Machine$double.eps, max_it=200){ # use bisection to compute the implied volatility # http://en.wikipedia.org/wiki/Bisection_method Modified: pkg/GARPFRM/R/riskMetricsAndHedges.R =================================================================== --- pkg/GARPFRM/R/riskMetricsAndHedges.R 2015-02-07 16:24:38 UTC (rev 220) +++ pkg/GARPFRM/R/riskMetricsAndHedges.R 2015-02-07 17:16:00 UTC (rev 221) @@ -247,7 +247,7 @@ lines(x$loading[,3], col="red",lty=2) legend("topleft",legend=c("PCA1","PCA2","PCA3"),bty="n",lty=c(1,2,2),col=c("black","blue","red"), cex=0.8) }else{ - plot.zoo(pca$loading[,1:3], type="l", main = main, + plot.zoo(x$loading[,1:3], type="l", main = main, xlab="Maturity/Items", ...=...) } }else if(ncol(x$loading) == 2){ @@ -257,7 +257,7 @@ lines(x$loading[,2], col="blue",lty=2) legend("topleft",legend=c("PCA1","PCA2"),bty="n",lty=c(1,2),col=c("black","blue"), cex=0.8) }else{ - plot.zoo(pca$loading[,1:2], type="l", main = main, + plot.zoo(x$loading[,1:2], type="l", main = main, xlab="Maturity/Items", ...=...) } }else{ Deleted: pkg/GARPFRM/data/.Rapp.history =================================================================== --- pkg/GARPFRM/data/.Rapp.history 2015-02-07 16:24:38 UTC (rev 220) +++ pkg/GARPFRM/data/.Rapp.history 2015-02-07 17:16:00 UTC (rev 221) @@ -1,10 +0,0 @@ -load("/Users/tfillebeen/devel/R/UWGARP/uwgarp/pkg/GARPFRM/data/returns.rda") -returns -colnames(returns) -returns(,1) -returns[],1] -returns[,1] -returns[,"SPY"] -load("/Users/tfillebeen/devel/R/UWGARP/uwgarp/pkg/GARPFRM/data/consumption.rda") -load("/Users/tfillebeen/devel/R/UWGARP/uwgarp/pkg/GARPFRM/data/bonds.rda") -load("/Users/tfillebeen/devel/R/UWGARP/uwgarp/pkg/GARPFRM/data/treasuryts.RData") Modified: pkg/GARPFRM/demo/00Index =================================================================== --- pkg/GARPFRM/demo/00Index 2015-02-07 16:24:38 UTC (rev 220) +++ pkg/GARPFRM/demo/00Index 2015-02-07 17:16:00 UTC (rev 221) @@ -1,7 +1,15 @@ backtest_VaR demonstrate backtesting a Value at Risk model bootstrap demonstrate applying the bootstrap method to various statistics +DataAccess demonstrate methods of accessing financial data demo_CAPM demonstrate Capital Asset Pricing Model demo_EWMA_GARCH11 demonstrate fitting EWMA and GARCH models EWMA demonstrate fitting an EWMA model to estimate volatility, covariance, and correlation for univariate and multivariate time series of returns +EstimatingVolatilitiesCorrelation R code from vignette on estimating volatilities and correlations +Fixed demonstrate functions fixed income analysis monte_carlo demonstrate running a Monte Carlo simulation to simulate asset price paths +MonteCarloMethods R code from vignette on Monte Carlo methods vignette +PerformanceMeasures R code from Performance Measures vignette +QuantifyingVolatilityVaRModels R code from Quantifying Volatility and VaR models vignette +QuantitativeAnalysisBasics R code from Quantitative Analysis Basics vignette +RiskMetricsAndHedges R code from Risk Metrics and Hedges vignette univariate_GARCH demonstrate fitting a GARCH model to estimate and forecast volatility for a univariate time series of returns Deleted: pkg/GARPFRM/demo/CAPM_TF.R =================================================================== --- pkg/GARPFRM/demo/CAPM_TF.R 2015-02-07 16:24:38 UTC (rev 220) +++ pkg/GARPFRM/demo/CAPM_TF.R 2015-02-07 17:16:00 UTC (rev 221) @@ -1,73 +0,0 @@ -# 'Load the GARPFRM package and CRSP dataset for CAPM analysis. -# Standard Capital Asset Pricing Model (CAPM) fitting and testing using CRSP data. -# Where CAPM describes the relationship between risk and expected return. -suppressMessages(library(GARPFRM)) -options(digits=3) -data(crsp.short) - -stock.df <- largecap.ts[, 1:20] -mrkt <- largecap.ts[, "market"] -rfr <- largecap.ts[, "t90"] - -# Plot first four stocks from -plot.zoo(stock.df[,1:4], main="First Four Large Cap Returns") - -# Illustrate the type of data being analzyed: start-end dates. -start(stock.df[,1:4]) -end(stock.df[,1:4]) -# Count the number of rows: sample size. -nrow(stock.df) - -# Excess Returns initialized before utilizing in CAPM -exReturns <- Return.excess(stock.df, rfr) -colnames(exReturns)= c(colnames(stock.df)) - - -# Univariate CAPM -uv <- CAPM(exReturns[,1], mrkt) -getStatistics(uv) - -# Plot data with regression line -plot(uv) - -# MLM CAPM for AMAT, AMGN, and CAT -mlm <- CAPM(exReturns[,1:3], mrkt) -getStatistics(mlm) - -# Plot data with regression line -plot(mlm) - -# For uv example -# Estimate CAPM with ? = 0 & ? = 1 for asset -getBetas(uv) -getAlphas(uv) -hypTest(uv, significanceLevel=0.05) -# For mlm -getBetas(mlm) -getAlphas(mlm) -hypTest(mlm, significanceLevel=0.05) - -# The CAPM function can handle multiple assets at once, -# and will cycle through each asset one at a time and output the results. -# MLM CAPM -mlm <- CAPM(exReturns[,], mrkt) - -# Plot expected returns versus betas -chartSML(mlm) - - -# Load FED consumption data: CONS -# To illustate the power of the CAPM model -# test its relationship with explanatory variable con- sumption. -data(consumption) - -# Convert to yearmon index and align consumption and mrkt -consumption <- xts(consumption, as.yearmon(index(consumption))) -mrkt <- xts(mrkt, as.yearmon(index(mrkt))) -consumption <- consumption[index(mrkt)] - -capm.cons = CAPM(consumption, mrkt) -coef(summary(capm.cons)) - -# Plot data with regression line -plot(capm.cons) \ No newline at end of file Modified: pkg/GARPFRM/demo/DelineatingEfficientPortfolios.R =================================================================== --- pkg/GARPFRM/demo/DelineatingEfficientPortfolios.R 2015-02-07 16:24:38 UTC (rev 220) +++ pkg/GARPFRM/demo/DelineatingEfficientPortfolios.R 2015-02-07 17:16:00 UTC (rev 221) @@ -1,8 +1,5 @@ -library(knitr) -opts_chunk$set(tidy=FALSE, warning=FALSE, fig.width=5, fig.height=5) +library(GARPFRM) -suppressPackageStartupMessages(library(GARPFRM)) - # Colonel Motors expected return R_C <- 0.14 @@ -21,10 +18,10 @@ # Create a vector of portfolio weights X_C <- seq(from=0, to=1, by=0.2) -# Calculate the portfolio expected return (? = ?1) +# Calculate the portfolio expected return (rho = -1) R_P <- portReturnTwoAsset(R_C, R_S, X_C) -# Calculate the portfolio standard deviation (? = 0) +# Calculate the portfolio standard deviation (rho = 0) sigma_P <- portSDTwoAsset(R_C, R_S, X_C, sigma_C, sigma_S, rho) # Combine the portfolio returns and standard deviations in a data.frame object. @@ -99,7 +96,7 @@ minRisk(R_C, R_S, sigma_C, sigma_S, rho) -# Correlation coefficient (? = 0.5) +# Correlation coefficient (rho = 0.5) rho <- 0.5 # Calculate the portfolio expected return @@ -184,19 +181,13 @@ # Estimated correlation between equity and bonds rho <- 0.45 - - # Calculate the allocation and values for the minimum variance portfolio minRisk(R_SP, R_B, sigma_SP, sigma_B, rho) - - ef <- efficientFrontierTwoAsset(R_SP, R_B, sigma_SP, sigma_B, rho, [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/uwgarp -r 221