[Uwgarp-commits] r176 - in pkg/GARPFRM: . R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jun 10 03:21:29 CEST 2014
Author: tfillebeen
Date: 2014-06-10 03:21:28 +0200 (Tue, 10 Jun 2014)
New Revision: 176
Modified:
pkg/GARPFRM/NAMESPACE
pkg/GARPFRM/R/discountFactorArbitrage.R
pkg/GARPFRM/R/riskMetricsAndHedges.R
pkg/GARPFRM/sandbox/test_discountFactorArbitrage.R
Log:
outline of three functionalities TO DO
Modified: pkg/GARPFRM/NAMESPACE
===================================================================
--- pkg/GARPFRM/NAMESPACE 2014-06-09 22:34:13 UTC (rev 175)
+++ pkg/GARPFRM/NAMESPACE 2014-06-10 01:21:28 UTC (rev 176)
@@ -33,6 +33,7 @@
export(bondFullPrice)
export(bondPrice)
export(bondSpec)
+export(bondYTM)
export(bootCor)
export(bootCov)
export(bootES)
@@ -64,6 +65,7 @@
export(getVaRViolations)
export(hypTest)
export(is.bond)
+export(linearHedge)
export(minVarPortfolio)
export(monteCarlo)
export(plotEndingPrices)
@@ -79,3 +81,4 @@
export(simpleVolatility)
export(tangentPortfolio)
export(uvGARCH)
+export(ytmSolve)
Modified: pkg/GARPFRM/R/discountFactorArbitrage.R
===================================================================
--- pkg/GARPFRM/R/discountFactorArbitrage.R 2014-06-09 22:34:13 UTC (rev 175)
+++ pkg/GARPFRM/R/discountFactorArbitrage.R 2014-06-10 01:21:28 UTC (rev 176)
@@ -177,10 +177,4 @@
rate$years = years
rate$ccRate = ccRate
return(rate)
-}
-
-
-## Plot of continuously compounded spot rates
-#plot(x=years, y=ccRate, type="l", ylab="rate", xlab="Time to Maturity",
-# main="Term Structure of Spot Rates")
-#dev.off()
+}
\ No newline at end of file
Modified: pkg/GARPFRM/R/riskMetricsAndHedges.R
===================================================================
--- pkg/GARPFRM/R/riskMetricsAndHedges.R 2014-06-09 22:34:13 UTC (rev 175)
+++ pkg/GARPFRM/R/riskMetricsAndHedges.R 2014-06-10 01:21:28 UTC (rev 176)
@@ -2,73 +2,188 @@
#' Calculate the modified duration of a bond
#'
-#' This function calculates the modified duration of a fixed rate coupon 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
+#' @param bond a \code{bond} object in discountFactorArbitrage
#' @param discountCurve vector of discount rates
+#' @param percentChangeYield optional elasticity measure
#' @return duration of the bond
#' @export
-bondDuration <- function(bond, discountCurve){
-
+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
-
+ nDC = length(discountCurve)
+ m = bond$m
+ couponRate = bond$couponRate
+ face = bond$face
+ time = bond$time
# Calculate the ytm
- ytm <- bondYTM(bond=bond, discountCurve=discountCurve)
-
+ ytm = bondYTM(bond=bond, discountCurve=discountCurve) + percentChangeYield
# Convert to continuously compounded rate
- y_c <- m * log(1 + ytm / m)
-
+ 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
-
+ 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))
-
+ price = sum(cashflows * exp(-y_c * time))
# Calculate the duration
- duration <- sum(-time * cashflows * exp(-y_c * time)) / -price
+ duration = sum(-time * cashflows * exp(-y_c * time)) / -price
return(duration)
}
#' Calculate the convexity of a fixed rate coupon bond
#'
-#' This function calculates 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
+#' @param bond a \code{bond} object in discountFactorArbitrage
#' @param discountCurve vector of discount rates
#' @return convexity of the bond
#' @export
bondConvexity <- function(bond, discountCurve){
# Get data from the bond and discount curve
- nDC <- length(discountCurve)
+ 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
+#' @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
- # Get the cashflows of coupon amounts and face value
- couponAmount <- face * couponRate / m
- cashflows <- rep(couponAmount, nDC)
- cashflows[nDC] <- couponAmount + face
+ # 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
+#' @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))
+}
+
+#' Calculate the convexity of a fixed rate coupon bond
+#'
+#' This function estimates the delta for hedging a particular bond
+#' given bond data
+#'
+#' @param bond a \code{bond} object in discountFactorArbitrage
+#' @return delta of the hedge
+#' @export
+linearHedge <- function(bond){
+ ### Write body####
- # The price is the sum of the discounted cashflows
- price <- sum(discountCurve * cashflows)
- weights <- (discountCurve * cashflows) / price
- # weights <- ((discountCurve * cashflows) / price) * time^2
- convexity <- sum(weights * time^2)
- return(convexity)
+ return(delta)
}
-#### linear hedge####
+#' Estimate PCA loadings and creat PCA object
+#'
+#' This function estimates the delta for hedging a particular bond
+#' given bond data
+#'
+#' @param data time series data
+#' @return pca object loadings
+#' @export
+PCA <- function(data){
+ ### Write body####
+
+
+
+ return(delta)
+}
+#' PCA loadings
+#'
+#' Extract the computed loadings.
+#'
+#' @param object a capm object created by loadings PCA
+#' @author TF
+#' @export
+getthreeLoadings <- function(object){
+ UseMethod("getthreeLoadings")
+}
+
+#' @method getthreeLoadings
+#' @S3method getthreeLoadings
+getthreeLoadings <- function(object){
+ ### Write body####
+
+
+ return(threeLoadings)
+}
+
+#' Plotting method for PCA
+#'
+#' Plot a fitted PCA object
+#'
+#' @param x a PCA object created.
+#' @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
+#' @author Thomas Fillebeen
+#' @method plot pca loadings
+#' @S3method plot capm_uv
+plot.capm_uv <- function(x, y, number, ..., main="CAPM"){
+ ### Write body####
+
+
+
+
+ # Plot the first three factors
+ plot(pca$loading[,1], type="l", main="Beta from PCA regression",
+ xlab="maturity", ylab="beta")
+ lines(pca$loading[,2], col="blue",lty=2)
+ lines(pca$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)
+
+}
+
Modified: pkg/GARPFRM/sandbox/test_discountFactorArbitrage.R
===================================================================
--- pkg/GARPFRM/sandbox/test_discountFactorArbitrage.R 2014-06-09 22:34:13 UTC (rev 175)
+++ pkg/GARPFRM/sandbox/test_discountFactorArbitrage.R 2014-06-10 01:21:28 UTC (rev 176)
@@ -14,14 +14,26 @@
DF = discountFactor(price , cashFlow)
+
# Estimate bondPrice
-# Choose a 2 year bond with semiannual payments
+# Choose a 2 year bond with semiannual payments to match number of bond prices and CFs
time = seq(from=0.5, to=2, by=0.5)
# First define a bond object to be used throughout the analysis
bond = bondSpec(time, face=100, m=2, couponRate = 0.0475)
+# Estimate price, yield, convexity and duration
price = bondPrice(bond,DF)
+bondYTM(bond,DF)
+# Duration measures the effect of a small parallel shift in the yield curve
+mDuration = bondDuration(bond,DF)
+# Duration plus convexity measure the effect of a larger parallel shift in the yield curve
+# Note however, they do not measure the effect of non-parallel shifts
+convexity = bondConvexity(bond,DF)
+# Measure a 10% increase in yield on duration
+newmDuration = bondDuration(bond,DF, 0.1)
+
+
# Appliation: Idiosyncratic Pricing of US Treasury Notes and Bonds
t0 = as.Date("2013-08-15")
t1 = as.Date("2014-02-15")
@@ -34,6 +46,10 @@
bondFullPrice(bond, y1, 8, t0, t1, tn)$dirty
bondFullPrice(bond, y1, 8, t0, t1, tn)$accruedInterest
+
+
+
+
# Estimating the term structure: compounded rates from discount factors
# Ulitzing data in the following format: Cusip, IssueDate, MaturityDate, Name, Coupon, Bid/Ask
head(dat)
More information about the Uwgarp-commits
mailing list