[Returnanalytics-commits] r2516 - in pkg/PerformanceAnalytics/sandbox/Shubhankit: . Week1 Week2 Week3
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jul 8 02:36:43 CEST 2013
Author: shubhanm
Date: 2013-07-08 02:36:43 +0200 (Mon, 08 Jul 2013)
New Revision: 2516
Added:
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/GLMSmoothIndex.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpeRatio.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/UnsmoothReturn.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.UnsmoothReturn.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/EmaxDDGBM.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/chart.Autocorrelation.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/table.normDD.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week4/
Log:
Repository File Paths Chronological Change
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/GLMSmoothIndex.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/GLMSmoothIndex.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/GLMSmoothIndex.R 2013-07-08 00:36:43 UTC (rev 2516)
@@ -0,0 +1,36 @@
+GLMSmoothIndex<-
+ function(R = NULL, ...)
+ {
+ columns = 1
+ columnnames = NULL
+ #Error handling if R is not NULL
+ if(!is.null(R)){
+ x = checkData(R)
+ columns = ncol(x)
+ n = nrow(x)
+ count = q
+ x=edhec
+ columns = ncol(x)
+ columnnames = colnames(x)
+
+ # Calculate AutoCorrelation Coefficient
+ for(column in 1:columns) { # for each asset passed in as R
+ y = checkData(edhec[,column], method="vector", na.rm = TRUE)
+
+ acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7]
+ values = sum(acflag6*acflag6)/(sum(acflag6)*sum(acflag6))
+
+ if(column == 1) {
+ result.df = data.frame(Value = values)
+ colnames(result.df) = columnnames[column]
+ }
+ else {
+ nextcol = data.frame(Value = values)
+ colnames(nextcol) = columnnames[column]
+ result.df = cbind(result.df, nextcol)
+ }
+ }
+ return(result.df)
+
+ }
+ }
\ No newline at end of file
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpeRatio.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpeRatio.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week1/LoSharpeRatio.R 2013-07-08 00:36:43 UTC (rev 2516)
@@ -0,0 +1,71 @@
+LoSharpeRatio<-
+ function(R = NULL,Rf=0.,q = 0., ...)
+ {
+columns = 1
+columnnames = NULL
+#Error handling if R is not NULL
+if(!is.null(R)){
+ x = checkData(R)
+ columns = ncol(x)
+ n = nrow(x)
+
+ if(q==0){
+ stop("AutoCorrelation Coefficient Should be greater than 0")
+
+ }
+ else{
+ # A potfolio is constructed by applying the weights
+
+ count = q
+ x=edhec
+ columns = ncol(x)
+ columnnames = colnames(x)
+
+ # Calculate AutoCorrelation Coefficient
+ for(column in 1:columns) { # for each asset passed in as R
+ y = checkData(edhec[,column], method="vector", na.rm = TRUE)
+
+ acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7]
+ LjungBox = Box.test(y,type="Ljung-Box",lag=q)
+ values = c(acflag6, LjungBox$p.value)
+ # values = base::round(as.numeric(values),digits)
+
+ if(column == 1) {
+ result.df = data.frame(Value = values)
+ colnames(result.df) = columnnames[column]
+ }
+ else {
+ nextcol = data.frame(Value = values)
+ colnames(nextcol) = columnnames[column]
+ result.df = cbind(result.df, nextcol)
+ }
+ }
+ # Calculate Neta's
+ for(column in 1:columns) {
+ sum = 0
+ z = checkData(edhec[,column], method="vector", na.rm = TRUE)
+ for(q in 1:(q-1) )
+ {
+ sum = sum + (count-q)*result.df[column,q]
+
+ }
+
+ netaq = count/(sqrt(count+2*sum))
+ if(column == 1) {
+ netacol = data.frame(Value = netaq)
+ colnames(netacol) = columnnames[column]
+ }
+ else {
+ nextcol = data.frame(Value = netaq)
+ colnames(nextcol) = columnnames[column]
+ netacol = cbind(netacol, nextcol)
+ }
+
+ }
+ shrp = SharpeRatio(x, Rf, FUN="VaR" , method="gaussian")
+ results = Shrp*netacol
+ colnames(results) = colnames(x)
+ return(results)
+ }
+ }
+}
\ No newline at end of file
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/UnsmoothReturn.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/UnsmoothReturn.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/UnsmoothReturn.R 2013-07-08 00:36:43 UTC (rev 2516)
@@ -0,0 +1,36 @@
+UnSmoothReturn<-
+ function(R = NULL,q, ...)
+ {
+ columns = 1
+ columnnames = NULL
+ #Error handling if R is not NULL
+ if(!is.null(R)){
+ x = checkData(R)
+ columns = ncol(x)
+ n = nrow(x)
+ count = q
+ x=edhec
+ columns = ncol(x)
+ columnnames = colnames(x)
+
+ # Calculate AutoCorrelation Coefficient
+ for(column in 1:columns) { # for each asset passed in as R
+ y = checkData(edhec[,column], method="vector", na.rm = TRUE)
+
+ acflag6 = acf(y,plot=FALSE,lag.max=6)[[1]][2:7]
+ values = sum(acflag6*acflag6)/(sum(acflag6)*sum(acflag6))
+
+ if(column == 1) {
+ result.df = data.frame(Value = values)
+ colnames(result.df) = columnnames[column]
+ }
+ else {
+ nextcol = data.frame(Value = values)
+ colnames(nextcol) = columnnames[column]
+ result.df = cbind(result.df, nextcol)
+ }
+ }
+ return(result.df[1:q,]*R) # Unsmooth Return
+
+ }
+ }
\ No newline at end of file
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.UnsmoothReturn.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.UnsmoothReturn.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week2/table.UnsmoothReturn.R 2013-07-08 00:36:43 UTC (rev 2516)
@@ -0,0 +1,79 @@
+#' Compenent Decomposition of Table of Unsmooth Returns
+#'
+#' Creates a table of estimates of moving averages for comparison across
+#' multiple instruments or funds as well as their standard error and
+#' smoothing index
+#'
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+#' @param ci confidence interval, defaults to 95\%
+#' @param n number of series lags
+#' @param p confidence level for calculation, default p=.99
+#' @param digits number of digits to round results to
+#' @author R
+#' @keywords ts smooth return models
+#'
+#' @export
+table.UnsmoothReturn <-
+ function (R, n = 3, p= 0.95, digits = 4)
+ {# @author
+
+ # DESCRIPTION:
+ # Downside Risk Summary: Statistics and Stylized Facts
+
+ # Inputs:
+ # R: a regular timeseries of returns (rather than prices)
+ # n : Number of lags
+ # p = Confifence Level
+ # Output:
+ # A table of estimates of Moving Average
+
+ y = checkData(R, method = "xts")
+ columns = ncol(y)
+ rows = nrow(y)
+ columnnames = colnames(y)
+ rownames = rownames(y)
+
+ # for each column, do the following:
+ for(column in 1:columns) {
+ x = y[,column]
+
+ z = c(arma(x,0,2)$theta[1],
+ arma(x,0,2)$se.theta[1],
+ arma(x,0,2)$theta[2],
+ arma(x,0,2)$se.theta[2],
+ arma(x,0,2)$se.theta[2])
+ znames = c(
+ "Moving Average(1)",
+ "Std Error of MA(1)",
+ "Moving Average(2)",
+ "Std Error of MA(2)",
+ "Smoothing Invest"
+
+ )
+ if(column == 1) {
+ resultingtable = data.frame(Value = z, row.names = znames)
+ }
+ else {
+ nextcolumn = data.frame(Value = z, row.names = znames)
+ resultingtable = cbind(resultingtable, nextcolumn)
+ }
+ }
+ colnames(resultingtable) = columnnames
+ ans = base::round(resultingtable, digits)
+ ans
+
+
+}
+
+###############################################################################
+# R (http://r-project.org/)
+#
+# Copyright (c) 2004-2013
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: table.UnSmoothReturn.R
+#
+###############################################################################
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/EmaxDDGBM.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/EmaxDDGBM.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/EmaxDDGBM.R 2013-07-08 00:36:43 UTC (rev 2516)
@@ -0,0 +1,194 @@
+#' Expected Drawdown using Brownian Motion Assumptions
+#'
+#' Works on the model specified by Maddon-Ismail
+#'
+#'
+#'
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+
+#' @author R
+#' @keywords Expected Drawdown Using Brownian Motion Assumptions
+#'
+#' @export
+table.EMaxDDGBM <-
+ function (R,digits =4)
+ {# @author
+
+ # DESCRIPTION:
+ # Downside Risk Summary: Statistics and Stylized Facts
+
+ # Inputs:
+ # R: a regular timeseries of returns (rather than prices)
+ # Output: Table of Estimated Drawdowns
+
+ y = checkData(R, method = "xts")
+ columns = ncol(y)
+ rows = nrow(y)
+ columnnames = colnames(y)
+ rownames = rownames(y)
+ T= nyears(y);
+
+ # for each column, do the following:
+ for(column in 1:columns) {
+ x = y[,column]
+ mu = Return.annualized(x, scale = NA, geometric = TRUE)
+ sig=StdDev(x)
+ gamma<-sqrt(pi/8)
+
+ if(mu==0){
+
+ Ed<-2*gamma*sig*sqrt(T)
+
+ }
+
+ else{
+
+ alpha<-mu*sqrt(T/(2*sig^2))
+
+ x<-alpha^2
+
+ if(mu>0){
+
+ mQp<-matrix(c(
+
+ 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125,
+
+ 0.0150, 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350,
+
+ 0.0375, 0.0400, 0.0425, 0.0450, 0.0500, 0.0600, 0.0700, 0.0800, 0.0900,
+
+ 0.1000, 0.2000, 0.3000, 0.4000, 0.5000, 1.5000, 2.5000, 3.5000, 4.5000,
+
+ 10, 20, 30, 40, 50, 150, 250, 350, 450, 1000, 2000, 3000, 4000, 5000, 0.019690,
+
+ 0.027694, 0.033789, 0.038896, 0.043372, 0.060721, 0.073808, 0.084693, 0.094171,
+
+ 0.102651, 0.110375, 0.117503, 0.124142, 0.130374, 0.136259, 0.141842, 0.147162,
+
+ 0.152249, 0.157127, 0.161817, 0.166337, 0.170702, 0.179015, 0.194248, 0.207999,
+
+ 0.220581, 0.232212, 0.243050, 0.325071, 0.382016, 0.426452, 0.463159, 0.668992,
+
+ 0.775976, 0.849298, 0.905305, 1.088998, 1.253794, 1.351794, 1.421860, 1.476457,
+
+ 1.747485, 1.874323, 1.958037, 2.020630, 2.219765, 2.392826, 2.494109, 2.565985,
+
+ 2.621743),ncol=2)
+
+
+
+ if(x<0.0005){
+
+ Qp<-gamma*sqrt(2*x)
+
+ }
+
+ if(x>0.0005 & x<5000){
+
+ Qp<-spline(log(mQp[,1]),mQp[,2],n=1,xmin=log(x),xmax=log(x))$y
+
+ }
+
+ if(x>5000){
+
+ Qp<-0.25*log(x)+0.49088
+
+ }
+
+ Ed<-(2*sig^2/mu)*Qp
+
+ }
+
+ if(mu<0){
+
+ mQn<-matrix(c(
+
+ 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, 0.0150,
+
+ 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, 0.0375, 0.0400,
+
+ 0.0425, 0.0450, 0.0475, 0.0500, 0.0550, 0.0600, 0.0650, 0.0700, 0.0750, 0.0800,
+
+ 0.0850, 0.0900, 0.0950, 0.1000, 0.1500, 0.2000, 0.2500, 0.3000, 0.3500, 0.4000,
+
+ 0.5000, 1.0000, 1.5000, 2.0000, 2.5000, 3.0000, 3.5000, 4.0000, 4.5000, 5.0000,
+
+ 0.019965, 0.028394, 0.034874, 0.040369, 0.045256, 0.064633, 0.079746, 0.092708,
+
+ 0.104259, 0.114814, 0.124608, 0.133772, 0.142429, 0.150739, 0.158565, 0.166229,
+
+ 0.173756, 0.180793, 0.187739, 0.194489, 0.201094, 0.207572, 0.213877, 0.220056,
+
+ 0.231797, 0.243374, 0.254585, 0.265472, 0.276070, 0.286406, 0.296507, 0.306393,
+
+ 0.316066, 0.325586, 0.413136, 0.491599, 0.564333, 0.633007, 0.698849, 0.762455,
+
+ 0.884593, 1.445520, 1.970740, 2.483960, 2.990940, 3.492520, 3.995190, 4.492380,
+
+ 4.990430, 5.498820),ncol=2)
+
+
+
+
+
+ if(x<0.0005){
+
+ Qn<-gamma*sqrt(2*x)
+
+ }
+
+ if(x>0.0005 & x<5000){
+
+ Qn<-spline(mQn[,1],mQn[,2],n=1,xmin=x,xmax=x)$y
+
+ }
+
+ if(x>5000){
+
+ Qn<-x+0.50
+
+ }
+
+ Ed<-(2*sig^2/mu)*(-Qn)
+
+ }
+
+ }
+
+ # return(Ed)
+
+ z = c((mu*100),
+ (sig*100),
+ (Ed*100))
+ znames = c(
+ "Annual Returns in %",
+ "Std Devetions in %",
+ "Expected Drawdown in %"
+ )
+ if(column == 1) {
+ resultingtable = data.frame(Value = z, row.names = znames)
+ }
+ else {
+ nextcolumn = data.frame(Value = z, row.names = znames)
+ resultingtable = cbind(resultingtable, nextcolumn)
+ }
+ }
+ colnames(resultingtable) = columnnames
+ ans = base::round(resultingtable, digits)
+ ans
+
+
+ }
+
+###############################################################################
+# R (http://r-project.org/)
+#
+# Copyright (c) 2004-2013
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: EMaxDDGBM
+#
+###############################################################################
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/chart.Autocorrelation.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/chart.Autocorrelation.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/chart.Autocorrelation.R 2013-07-08 00:36:43 UTC (rev 2516)
@@ -0,0 +1,47 @@
+#' Stacked Bar Plot of Autocorrelation Lag Coefficients
+#'
+#' A wrapper to create box and whiskers plot of comparitive inputs
+#'
+#' We have also provided controls for all the symbols and lines in the chart.
+#' One default, set by \code{as.Tufte=TRUE}, will strip chartjunk and draw a
+#' Boxplot per recommendations by Burghardt, Duncan and Liu(2013)
+#'
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+#' @return Stack Bar plot of lagged return coefficients
+#' @author R
+#' @seealso \code{\link[graphics]{boxplot}}
+#' @references Burghardt, Duncan and Liu(2013) \emph{It's the autocorrelation, stupid}. AlternativeEdge Note November, 2012 }
+#' @keywords Autocorrelation lag factors
+#' @examples
+#'
+#' data(edhec)
+#' chart.Autocorrelation(edhec)
+#'
+#'
+#' @export
+chart.Autocorrelation <-
+ function (R, ...)
+ { # @author R
+
+ # DESCRIPTION:
+ # A wrapper to create box and whiskers plot, of autocorrelation lag coeffiecients
+ # of the First six factors
+
+ R = checkData(R, method="xts")
+
+# Graph autos with adjacent bars using rainbow colors
+
+aa= table.Autocorrelation(R)
+barplot(as.matrix(aa), main="Auto Correlation Lag", ylab= "Value of Coefficient",
+ , xlab = "Fund Type",beside=TRUE, col=rainbow(6))
+
+ # Place the legend at the top-left corner with no frame
+ # using rainbow colors
+ legend("topright", c("1","2","3","4","5","6"), cex=0.6,
+ bty="n", fill=rainbow(6));
+
+
+
+
+}
\ No newline at end of file
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/table.normDD.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/table.normDD.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/table.normDD.R 2013-07-08 00:36:43 UTC (rev 2516)
@@ -0,0 +1,86 @@
+#' Expected Drawdown using Brownian Motion Assumptions
+#'
+#' Works on the model specified by Maddon-Ismail
+#'
+#'
+#'
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+
+#' @author R
+#' @keywords Expected Drawdown Using Brownian Motion Assumptions
+#'
+#' @export
+table.NormDD <-
+ function (R,digits =4)
+ {# @author
+
+ # DESCRIPTION:
+ # Downside Risk Summary: Statistics and Stylized Facts
+
+ # Inputs:
+ # R: a regular timeseries of returns (rather than prices)
+ # Output: Table of Estimated Drawdowns
+
+ y = checkData(R, method = "xts")
+ columns = ncol(y)
+ rows = nrow(y)
+ columnnames = colnames(y)
+ rownames = rownames(y)
+ T= nyears(y);
+ n <- 1000
+ dt <- 1/T;
+ r0 <- 100;
+ # for each column, do the following:
+ for(column in 1:columns) {
+ x = y[,column]
+ mu = Return.annualized(x, scale = NA, geometric = TRUE)
+ sig=StdDev.annualized(x)
+ r <- matrix(0,T+1,n) # matrix to hold short rate paths
+ r[1,] <- r0
+ drawdown <- matrix(0,n)
+ # return(Ed)
+
+ for(j in 1:n){
+ for(i in 2:(T+1)){
+
+ dr <- mu*dt + sig*sqrt(dt)*rnorm(1,0,1)
+ r[i,j] <- r[i-1,j] + dr
+ }
+ drawdown[j] = maxDrawdown(r[,j])
+ }
+ z = c((mu*100),
+ (sig*100),
+ ((mean(drawdown)*100)))
+ znames = c(
+ "Annual Returns in %",
+ "Std Devetions in %",
+ "Normalized Drawdown Drawdown in %"
+ )
+ if(column == 1) {
+ resultingtable = data.frame(Value = z, row.names = znames)
+ }
+ else {
+ nextcolumn = data.frame(Value = z, row.names = znames)
+ resultingtable = cbind(resultingtable, nextcolumn)
+ }
+ }
+ colnames(resultingtable) = columnnames
+ ans = base::round(resultingtable, digits)
+ ans
+ t <- seq(0, T, dt)
+ matplot(t, r[1,1:T], type="l", lty=1, main="Short Rate Paths", ylab="rt")
+
+ }
+
+###############################################################################
+# R (http://r-project.org/)
+#
+# Copyright (c) 2004-2013
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: EMaxDDGBM
+#
+###############################################################################
More information about the Returnanalytics-commits
mailing list