[Uwgarp-commits] r187 - in pkg/GARPFRM: . R sandbox

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jun 12 03:10:07 CEST 2014


Author: tfillebeen
Date: 2014-06-12 03:10:05 +0200 (Thu, 12 Jun 2014)
New Revision: 187

Modified:
   pkg/GARPFRM/NAMESPACE
   pkg/GARPFRM/R/discountFactorArbitrage.R
   pkg/GARPFRM/R/riskMetricsAndHedges.R
   pkg/GARPFRM/sandbox/principleComponent.R
   pkg/GARPFRM/sandbox/test_discountFactorArbitrage.R
Log:
yield simulation Vasicek pg.172

Modified: pkg/GARPFRM/NAMESPACE
===================================================================
--- pkg/GARPFRM/NAMESPACE	2014-06-11 18:23:34 UTC (rev 186)
+++ pkg/GARPFRM/NAMESPACE	2014-06-12 01:10:05 UTC (rev 187)
@@ -89,4 +89,6 @@
 export(simpleVolatility)
 export(tangentPortfolio)
 export(uvGARCH)
+export(vasicekPrice)
+export(yieldCurveVasicek)
 export(ytmSolve)

Modified: pkg/GARPFRM/R/discountFactorArbitrage.R
===================================================================
--- pkg/GARPFRM/R/discountFactorArbitrage.R	2014-06-11 18:23:34 UTC (rev 186)
+++ pkg/GARPFRM/R/discountFactorArbitrage.R	2014-06-12 01:10:05 UTC (rev 187)
@@ -126,7 +126,6 @@
   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
-  dat[, "Coupon"] = as.numeric(gsub("%", "", dat[, "Coupon"])) / 100
   # Vector of prices
   price = (dat[, "Bid"] + dat[, "Ask"]) / 2
   
@@ -177,4 +176,46 @@
   rate$years = years
   rate$ccRate = ccRate 
   return(rate)
+}
+
+
+### 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 TF
+#' @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 TF
+#' @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/riskMetricsAndHedges.R
===================================================================
--- pkg/GARPFRM/R/riskMetricsAndHedges.R	2014-06-11 18:23:34 UTC (rev 186)
+++ pkg/GARPFRM/R/riskMetricsAndHedges.R	2014-06-12 01:10:05 UTC (rev 187)
@@ -18,7 +18,7 @@
   face = bond$face
   time = bond$time
   # Calculate the ytm
-  ytm = bondYTM(bond=bond, discountCurve=discountCurve) + percentChangeYield
+  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
@@ -175,11 +175,22 @@
 #' @method plot PCA
 #' @S3method plot PCA
 plot.PCA <- function(x, y, ..., main="Beta from PCA regression"){
-  if(ncol(x$loading)> 3) warning("Only first 3 loadings will be graphically displayed")
+ if(ncol(x$loading)> 3) warning("Only first 3 loadings will be graphically displayed")
   # Plot the first three factors
-  plot(pca$loading[,1], type="l", main, 
-       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)
+ if (ncol(x$loading) >= 3){
+   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 if(ncol(x$loading) == 2){
+   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(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

Modified: pkg/GARPFRM/sandbox/principleComponent.R
===================================================================
--- pkg/GARPFRM/sandbox/principleComponent.R	2014-06-11 18:23:34 UTC (rev 186)
+++ pkg/GARPFRM/sandbox/principleComponent.R	2014-06-12 01:10:05 UTC (rev 187)
@@ -42,16 +42,15 @@
 # to random data with the same properties as the real data set.
 fa.parallel(data)
 
-# 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)
+# Plot up to the first three factors
+plot(pca)
+pca = PCA(data, nfactors = 2, rotate="none")
+plot(pca)
 
 # Creating factor scores: Linear composite of the weighted observed variables
   # Determine weights
   # Multiply variable for each observation by these weights
   # Sum the products
 pca.r = principal(data, nfactors=2, rotate="varimax", scores=T)
-scores = pca.r$scores
\ No newline at end of file
+scores = pca.r$scores
+plot(pca$scores[,1],pca$scores[,2], xlab="PCA1", ylab="PCA2", main = "Scores: Observable Pattern")
\ No newline at end of file

Modified: pkg/GARPFRM/sandbox/test_discountFactorArbitrage.R
===================================================================
--- pkg/GARPFRM/sandbox/test_discountFactorArbitrage.R	2014-06-11 18:23:34 UTC (rev 186)
+++ pkg/GARPFRM/sandbox/test_discountFactorArbitrage.R	2014-06-12 01:10:05 UTC (rev 187)
@@ -3,6 +3,7 @@
 options(digits=3)
 data(bonds)
 
+
 # The Cash Flows from Fixed-Rate Government Coupon Bonds
 # Discount Factors and the Law of One Price
 # Initialize: The Cash Flows from Fixed-Rate: treasury bonds ticking in quarters
@@ -12,9 +13,10 @@
 
 # Estimate the Discount Factors (DF)
 DF = discountFactor(price , cashFlow)
+# To confirm solution check that price is replicable
+(cashFlow%*%price)/100
 
 
-
 # Estimate bondPrice
 # 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)
@@ -35,7 +37,7 @@
 # Measure a 10% increase in yield on duration
 newmDuration = bondDuration(bond,DF, 0.1)
 
-
+## Example with a longer compounding time sequence:
 # Yields of bond with varying coupons over  Estimation and Plot
 # Utilizing a discount factor trable rewrite DF 10 years semiannually
 DF = rbind( 0.9615, 0.94305, 0.9246, 0.90591, 0.889, 0.87019, 0.8548, 0.8358825, 0.8219, 0.80294,
@@ -46,6 +48,34 @@
 bondYTM(bond,DF)
 
 
+### Valuation and Risk Model Section- Yield Curve Shapes
+# Vasicek Modeling to illustrate different yield curve calibrations
+# Initialize Model
+theta = 0.10
+k = 0.8
+sigma = 0.08
+# Seven Yield Curves to estimate
+r = seq(0, 0.15, 0.025)
+length(r)
+maturity = 10
+# Illustraton #1 for standard theta and initial r estimate yield path
+yieldCurves = yieldCurveVasicek(r, k, theta, sigma, maturity)
+# Plot using matplot-plot the columns of one matrix against the columns of another
+maturity = seq(1,maturity,1)
+matplot(maturity, yieldCurves, type="l", lty=1, main="Yield Curves")
+# choose h = theta for y horizontal line
+abline(h = theta, col="red", lty=2)
+
+# Illustration #2 for high theta and low initial r estimate yield path
+theta = 0.45
+yieldCurves = yieldCurveVasicek(r, k, theta, sigma, maturity)
+# Plot using matplot-plot the columns of one matrix against the columns of another
+maturity = seq(1,maturity,1)
+matplot(maturity, yieldCurves, type="l", lty=1, main="Yield Curves")
+# choose h = theta for y horizontal line
+abline(h = theta, col="red", lty=2)
+
+
 # Appliation: Idiosyncratic Pricing of US Treasury Notes and Bonds
 t0 = as.Date("2013-08-15")
 t1 = as.Date("2014-02-15")
@@ -59,15 +89,12 @@
 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)
-ccRate = compoundingRate(dat, initialDate=as.Date("1995-05-15"), m=4, face=100)
+ccRate = compoundingRate(dat, initialDate=as.Date("2000-05-15"), m=4, face=100)
 
 years = ccRate$years
 rate = ccRate$ccRate
 # Plot of continuously compounded spot rates
-plot(x=years, y=rate, type="l", ylab="rate", xlab="Time to Maturity", main="Term Structure of Spot Rates")
\ No newline at end of file
+plot(x=years, y=rate, type="l", ylab="Rate", xlab="Time to Maturity", main="Term Structure: Spot Rates")



More information about the Uwgarp-commits mailing list