[Returnanalytics-commits] r3336 - in pkg/PerformanceAnalytics/sandbox: . PAenhance PAenhance/R PAenhance/inst PAenhance/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 25 20:47:36 CET 2014
Author: kecoli
Date: 2014-02-25 20:47:36 +0100 (Tue, 25 Feb 2014)
New Revision: 3336
Added:
pkg/PerformanceAnalytics/sandbox/PAenhance/
pkg/PerformanceAnalytics/sandbox/PAenhance/R/
pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.Boxplot.R
pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.QQplot.R
pkg/PerformanceAnalytics/sandbox/PAenhance/R/lpm.Rd
pkg/PerformanceAnalytics/sandbox/PAenhance/inst/
pkg/PerformanceAnalytics/sandbox/PAenhance/inst/PA-KirkLi.Rnw
pkg/PerformanceAnalytics/sandbox/PAenhance/inst/PA-KirkLi.pdf
pkg/PerformanceAnalytics/sandbox/PAenhance/man/
pkg/PerformanceAnalytics/sandbox/PAenhance/man/chart.Boxplot.Rd
pkg/PerformanceAnalytics/sandbox/PAenhance/man/chart.QQPlot.Rd
pkg/PerformanceAnalytics/sandbox/PAenhance/man/lpm.R
Log:
commit to sandbox/PAenhance, major changes on chart.Boxplot.R and chart.QQplot.R per comments made by Douglass Martin. Plan to merge to trunk version soon.
For details see sandbox/PAenhance/inst/PA-KirkLi.pdf
Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.Boxplot.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.Boxplot.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.Boxplot.R 2014-02-25 19:47:36 UTC (rev 3336)
@@ -0,0 +1,423 @@
+#' box whiskers plot wrapper
+#'
+#' A wrapper to create box and whiskers plot with some defaults useful for
+#' comparing distributions.
+#'
+#' 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 Edward Tufte. Another default, set by \code{as.Notch=TRUE}, will draw a notch in each side of the boxes. It can also be useful when comparing several series to sort them in the order of ascending or descending return or risk measurement by use of \code{sort.by} and \code{sort.ascending=TRUE}. In addition, one can compare this with another user specified order, called base order, e.g., to see the relative change of the orders of the series between two measurements of interest.
+#'
+#'
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+#' @param horizontal TRUE/FALSE plot horizontal (TRUE) or vertical (FALSE)
+#' @param names logical. if TRUE, show the names of each series
+#' @param as.Tufte logical. default FALSE. if TRUE use method derived for Tufte
+#' for limiting chartjunk
+#' @param as.Notch logical. default FALSE. if TRUE a notch is drawn in each side of the boxes.
+#' See \code{\link[graphics]{boxplot}}
+#' @param sort.by one of the return or risk measure c("NULL", "mean", "median", "variance", "sharp ratio", "mean absolute deviation", "std dev", "sterling ratio", "calmar ratio", "burke ratio", "pain index", "ulcer index","martin ratio", "downside risk", "omega ratio", "sortino ratio", "upside risk","upside potential ratio", "omega sharpe ratio"). default is "NULL".
+#' @param sort.base one of the return or risk measure as listed in \code{sort.by},
+#' add the base order number next to the labels sorted by \code{sort.by}
+#' @param sort.ascending logical. If TRUE sort the distributions by ascending
+#' \code{sort.by} and \code{sort.base}
+#' @param colorset color palette to use, set by default to rational choices
+#' @param symbol.color draws the symbols described in
+#' \code{mean.symbol},\code{median.symbol},\code{outlier.symbol} in the color
+#' specified
+#' @param mean.symbol symbol to use for the mean of the distribution
+#' @param median.symbol symbol to use for the median of the distribution
+#' @param outlier.symbol symbol to use for the outliers of the distribution
+#' @param show.data numerical vector of column numbers to display on top of
+#' boxplot, default NULL
+#' @param add.mean logical. if TRUE, show a line for the mean of all
+#' distributions plotted
+#' @param xlab set the x-axis label, same as in \code{\link{plot}}
+#' @param main set the chart title, same as in \code{\link{plot}}
+#' @param element.color specify the color of chart elements. Default is
+#' "darkgray"
+#' @param \dots any other passthru parameters
+#' @return box plot of returns
+#' @author Peter Carl
+#' @author Ke Li \email{kirkli@@stat.washington.edu}
+#' @seealso \code{\link[graphics]{boxplot}}
+#' @references Tufte, Edward R. \emph{The Visual Display of Quantitative
+#' Information}. Graphics Press. 1983. p. 124-129
+#' @keywords ts multivariate distribution models hplot
+#' @examples
+#'
+#' data(edhec)
+#' chart.Boxplot(edhec)
+#' chart.Boxplot(edhec,as.Tufte=TRUE)
+#' chart.Boxplot(R=edhec,sort.by="upside risk",
+#' horizontal=TRUE, sort.base="std dev",
+#' sort.ascending=TRUE)
+#' @export
+chart.Boxplot <-
+ function (R, horizontal = TRUE, names = TRUE, as.Tufte = FALSE, as.Notch=FALSE, sort.by = NULL, sort.base=NULL, sort.ascending = FALSE, colorset = "black", symbol.color = "red", mean.symbol = 1, median.symbol = "|", outlier.symbol = 1, show.data = NULL, add.mean = TRUE, xlab="Return", main = "Return Distribution Comparison", element.color = "darkgray", ...)
+{ # @ author Peter Carl, updated by Kirk Li.
+ # DESCRIPTION:
+ # A wrapper to create box and whiskers plot, but with some sensible defaults
+ # useful for comparing distributions.
+
+ # mar: a numerical vector of the form c(bottom, left, top, right) which
+ # gives the number of lines of margin to be specified on the four sides
+ # of the plot. The default is c(5, 4, 4, 2) + 0.1
+
+ sort.by <- tolower(sort.by)
+
+ sort.by = sort.by[1]
+
+ pool <- c("NA","mean", "median", "variance", "sharp ratio", "mean absolute deviation", "std dev", "sterling ratio", "calmar ratio", "burke ratio", "pain index", "ulcer index","martin ratio", "downside risk", "omega ratio", "sortino ratio", "upside risk","upside potential ratio", "omega sharpe ratio")
+
+ sort.by <- match.arg(sort.by, pool, several.ok = FALSE)
+
+ R = checkData(R, method="data.frame")
+ R.xts = checkData(R,method="xts")
+ columns = ncol(R)
+ rows = nrow(R)
+ columnnames = colnames(R)
+
+ column.order = NULL
+
+ sort.by <- tolower(sort.by)
+
+ sort.by = sort.by[1]
+
+ op <- par(no.readonly=TRUE)
+
+ if(names){
+ par(mar=c(5,12,4,2) + 0.2)
+ }
+
+ if(length(colorset) < columns)
+ colorset = rep(colorset, length.out = columns)
+
+ if(length(symbol.color) < columns)
+ symbol.color = rep(symbol.color, length.out = columns)
+
+ if(length(mean.symbol) < columns)
+ mean.symbol = rep(mean.symbol, length.out = columns)
+
+ means = sapply(R, mean, na.rm = TRUE)
+
+
+ asc.desc <- ifelse(sort.ascending,"ascending","descending")
+
+ switch(sort.by,
+ mean = {
+ column.order = order(means, decreasing=!sort.ascending)
+ sort.by = paste("Mean", sep="")
+ },
+ median = {
+ medians = sapply(R, median, na.rm = TRUE)
+ column.order = order(medians, decreasing=!sort.ascending)
+ sort.by = paste("Median", sep="")
+ },
+ variance = {
+ variances = sapply(R, var, na.rm = TRUE)
+ column.order = order(variances, decreasing=!sort.ascending)
+ sort.by = paste("Variance", sep="")
+ },
+ "sharp ratio" = {
+ sharpratio = sapply(R,function(x)mean(x,na.rm = TRUE)/sd(x,na.rm = TRUE))
+ column.order = order(sharpratio, decreasing=!sort.ascending)
+ sort.by = paste("Sharp Ratio",sep="")
+ },
+ "mean absolute deviation" = {
+ MeanAbsoluteDeviation = sapply(R,MeanAbsoluteDeviation)
+ column.order = order(MeanAbsoluteDeviation, decreasing=!sort.ascending)
+ sort.by = paste("Mean Absolute Dev",sep="")
+ },
+ "std dev" = {
+ StdDev.annualized = sapply(R.xts,function(x)StdDev.annualized(x))
+ column.order = order(StdDev.annualized, decreasing=!sort.ascending)
+ sort.by = paste("Std Dev",sep="")
+ },
+ "sterling ratio" = {
+ SterlingRatio = sapply(R.xts,SterlingRatio)
+ column.order = order(SterlingRatio, decreasing=!sort.ascending)
+ sort.by = paste("Sterling Ratio",sep="")
+ },
+ "calmar ratio" = {
+ CalmarRatio = sapply(R.xts,CalmarRatio)
+ column.order = order(CalmarRatio, decreasing=!sort.ascending)
+ sort.by = paste("Calmar Ratio",sep="")
+ },
+ "burke ratio" = {
+ BurkeRatio = sapply(R.xts,BurkeRatio)
+ column.order = order(BurkeRatio, decreasing=!sort.ascending)
+ sort.by = paste("Burke Ratio",sep="")
+ },
+ "pain index" = {
+ PainIndex = sapply(R,PainIndex)
+ column.order = order(PainIndex, decreasing=!sort.ascending)
+ sort.by = paste("Pain Index",sep="")
+ },
+ "ulcer index" = {
+ UlcerIndex = sapply(R,UlcerIndex)
+ column.order = order(UlcerIndex, decreasing=!sort.ascending)
+ sort.by = paste("Ulcer Index",sep="")
+ },
+ "martin ratio" = {
+ MartinRatio = sapply(R.xts,MartinRatio)
+ column.order = order(MartinRatio, decreasing=!sort.ascending)
+ sort.by = paste("Martin Ratio",sep="")
+ },
+ "downside risk" = {
+ DownsideDeviation = sapply(R,DownsideDeviation)
+ column.order = order(DownsideDeviation, decreasing=!sort.ascending)
+ sort.by = paste("Downside Risk",sep="")
+ },
+ "omega ratio" = {
+ Omega = sapply(R,Omega)
+ column.order = order(Omega, decreasing=!sort.ascending)
+ sort.by = paste("Omega Ratio",sep="")
+ },
+ "sortino ratio" = {
+ SortinoRatio = sapply(R,SortinoRatio)
+ column.order = order(SortinoRatio, decreasing=!sort.ascending)
+ sort.by = paste("Sortino Ratio",sep="")
+ },
+ "upside risk" = {
+ UpsideRisk = sapply(R,UpsideRisk)
+ column.order = order(UpsideRisk, decreasing=!sort.ascending)
+ sort.by = paste("Upside Risk",sep="")
+ },
+ "upside potential ratio" = {
+ UpsidePotentialRatio = sapply(R,UpsidePotentialRatio)
+ column.order = order(UpsidePotentialRatio, decreasing=!sort.ascending)
+ sort.by = paste("Upside Potential Ratio",sep="")
+ },
+ "omega sharpe ratio" = {
+ OmegaSharpeRatio = sapply(R,OmegaSharpeRatio)
+ column.order = order(OmegaSharpeRatio, decreasing=!sort.ascending)
+ sort.by = paste("Omega Sharpe Ratio",sep="")
+ },
+ {
+ column.order = 1:columns
+ sort.by = paste("Unsorted", sep="")
+ }
+ ) # end switch
+
+ ylab=paste("Sorted by:",asc.desc,sort.by)
+
+
+ # base order
+ if(!is.null(sort.base)){
+ colum.order.base = NULL
+
+ sort.base <- tolower(sort.base)
+
+ sort.base <- match.arg(sort.base, pool, several.ok = FALSE)
+
+ switch(sort.base,
+ mean = {
+ means = sapply(R, mean, na.rm = TRUE)
+ column.order.base = order(means, decreasing=!sort.ascending)
+ sort.base = paste("Mean", sep="")
+ },
+ median = {
+ medians = sapply(R, median, na.rm = TRUE)
+ column.order.base = order(medians, decreasing=!sort.ascending)
+ sort.base = paste("Median", sep="")
+ },
+ variance = {
+ variances = sapply(R, var, na.rm = TRUE)
+ column.order.base = order(variances, decreasing=!sort.ascending)
+ sort.base = paste("Variance", sep="")
+ },
+ "sharp ratio" = {
+ sharpratio = sapply(R,function(x)mean(x,na.rm = TRUE)/sd(x,na.rm = TRUE))
+ column.order.base = order(sharpratio, decreasing=!sort.ascending)
+ sort.base = paste("Sharp Ratio",sep="")
+ },
+ "mean absolute deviation" = {
+ MeanAbsoluteDeviation = sapply(R,MeanAbsoluteDeviation)
+ column.order.base = order(MeanAbsoluteDeviation, decreasing=!sort.ascending)
+ sort.base = paste("Mean Absolute Dev",sep="")
+ },
+ "std dev" = {
+ StdDev.annualized = sapply(R.xts,StdDev.annualized)
+ column.order.base = order(StdDev.annualized, decreasing=!sort.ascending)
+ sort.base = paste("Std Dev",sep="")
+ },
+ "sterling ratio" = {
+ SterlingRatio = sapply(R.xts,SterlingRatio)
+ column.order.base = order(SterlingRatio, decreasing=!sort.ascending)
+ sort.base = paste("Sterling Ratio",sep="")
+ },
+ "calmar ratio" = {
+ CalmarRatio = sapply(R.xts,function(x)mean(x,na.rm = TRUE)/sd(x,na.rm = TRUE))
+ column.order.base = order(CalmarRatio, decreasing=!sort.ascending)
+ sort.base = paste("Calmar Ratio",sep="")
+ },
+ "burke ratio" = {
+ BurkeRatio = sapply(R.xts,BurkeRatio)
+ column.order.base = order(BurkeRatio, decreasing=!sort.ascending)
+ sort.base = paste("Burke Ratio",sep="")
+ },
+ "ulcer index" = {
+ UlcerIndex = sapply(R,UlcerIndex)
+ column.order.base = order(UlcerIndex, decreasing=!sort.ascending)
+ sort.base = paste("Ulcer Index",sep="")
+ },
+ "pain index" = {
+ PainRatio = sapply(R.xts,PainRatio)
+ column.order.base = order(PainRatio, decreasing=!sort.ascending)
+ sort.base = paste("Pain Index",sep="")
+ },
+ "martin ratio" = {
+ MartinRatio = sapply(R.xts,MartinRatio)
+ column.order.base = order(MartinRatio, decreasing=!sort.ascending)
+ sort.base = paste("Martin Ratio",sep="")
+ },
+ "downside risk" = {
+ DownsideDeviation = sapply(R,DownsideDeviation)
+ column.order.base = order(DownsideDeviation, decreasing=!sort.ascending)
+ sort.base = paste("Downside Risk",sep="")
+ },
+ "omega ratio" = {
+ Omega = sapply(R,Omega)
+ column.order.base = order(Omega, decreasing=!sort.ascending)
+ sort.base = paste("Omega Ratio",sep="")
+ },
+ "sortino ratio" = {
+ SortinoRatio = sapply(R,SortinoRatio)
+ column.order.base = order(SortinoRatio, decreasing=!sort.ascending)
+ sort.base = paste("Sortino Ratio",sep="")
+ },
+ "upside risk" = {
+ UpsideRisk = sapply(R,UpsideRisk)
+ column.order.base = order(UpsideRisk, decreasing=!sort.ascending)
+ sort.base = paste("Upside Risk",sep="")
+ },
+ "upside potential ratio" = {
+ UpsidePotentialRatio = sapply(R,UpsidePotentialRatio)
+ column.order.base = order(UpsidePotentialRatio, decreasing=!sort.ascending)
+ sort.base = paste("Upside Potential Ratio",sep="")
+ },
+ "omega sharpe ratio" = {
+ OmegaSharpeRatio = sapply(R,OmegaSharpeRatio)
+ column.order.base = order(OmegaSharpeRatio, decreasing=!sort.ascending)
+ sort.base = paste("Omega Sharpe Ratio",sep="")
+ },
+ {
+ column.order.base = 1:columns
+ sort.base = paste("Unsorted", sep="")
+ }
+ ) # end switch
+
+ ylab.base=paste(asc.desc,sort.base)
+ }
+
+ if(horizontal) {
+ par(mar=c(5,8,4,2)+1)
+ column.order.box <- rev(column.order)
+ if(!is.null(sort.base))
+ column.order.base.box <- rev(column.order.base)
+ } else {
+ par(mar=c(8,4,4,2)+1)
+ column.order.box <- column.order
+ if(!is.null(sort.base))
+ column.order.base.box <- column.order.base
+
+ }
+
+
+ if(as.Tufte){
+ boxplot(R[,column.order.box], horizontal = horizontal, names = names, main = main, xlab = ifelse(horizontal,xlab,""), ylab = ifelse(horizontal,"",xlab), pars = list(boxcol = "white", medlty = "blank", medpch = median.symbol, medlwd = 2, medcex = .8, medcol = colorset[column.order.box], whisklty = c(1,1), whiskcol = colorset[column.order.box], staplelty = "blank", outpch = outlier.symbol, outcex = .5, outcol = colorset[column.order.box] ), axes = FALSE, cex.lab=0.7,...)
+ mtext(side=3,text=ylab,cex=0.7)
+ if(!is.null(sort.base))
+ mtext(side=3,
+ text=paste("Base order: ",ylab.base,sep=" "),line=1,cex=0.7)
+ } else if(as.Notch){
+
+ boxplot(R[,column.order.box], horizontal = horizontal, names = names, main = main, xlab = ifelse(horizontal,xlab,""), ylab = ifelse(horizontal,"",xlab), pars = list(boxcol = colorset[column.order.box], medlwd = 1, medcol = colorset[column.order.box], whisklty = c(1,1), whiskcol = colorset[column.order.box], staplelty = 1, staplecol = colorset[column.order.box], staplecex = .5, outpch = outlier.symbol, outcex = .5, outcol = colorset[column.order.box] ), axes = FALSE, boxwex=.6, cex.lab=0.7, notch=TRUE,...)
+ mtext(side=3,text=ylab,cex=0.7)
+
+ if(!is.null(sort.base))
+ mtext(side=3,
+ text=paste("Base order: ",ylab.base,sep=" "),line=1,cex=0.7)
+ } else{
+
+ boxplot(R[,column.order.box], horizontal = horizontal, names = names, main = main, xlab = ifelse(horizontal,xlab,""), ylab = ifelse(horizontal,"",xlab), pars = list(boxcol = colorset[column.order.box], medlwd = 1, medcol = colorset[column.order.box], whisklty = c(1,1), whiskcol = colorset[column.order.box], staplelty = 1, staplecol = colorset[column.order.box], staplecex = .5, outpch = outlier.symbol, outcex = .5, outcol = colorset[column.order.box] ), axes = FALSE, boxwex=.6, cex.lab=0.7,...)
+ mtext(side=3,text=ylab,cex=0.7)
+ if(!is.null(sort.base))
+ mtext(side=3,
+ text=paste("Base order: ", ylab.base,sep=" "),line=1,cex=0.7)
+ } # end else
+
+ if(!is.null(show.data)) {
+ highlight.color=1:24
+ for (item in show.data) {
+ points(as.vector(R[item,column.order]), 1:columns, col=highlight.color[item]) #, pch = mean.symbol[column.order], col=symbol.color[column.order])
+ }
+ }
+
+ if(add.mean){
+ if(horizontal)
+ points(means[column.order], columns:1, pch = mean.symbol[column.order], col=symbol.color[column.order],cex=0.5) else
+ points(1:columns, means[column.order], pch = mean.symbol[column.order], col=symbol.color[column.order],cex=0.5)
+ }
+
+ if(names){
+ if(!is.null(sort.base)){
+ if(horizontal){
+ labels = paste(columnnames[column.order]," ",sep="")
+ labels.sec =paste("(",(match(column.order,column.order.base)),")",sep="")
+ labels=rev(labels)
+ } else{
+ labels = paste(columnnames[column.order]," ",sep="")
+ labels.sec = paste("(",match(column.order,column.order.base),")",sep="")
+ }
+ } else labels = columnnames[column.order]
+
+ if(!horizontal){
+# axis(1,labels=FALSE)
+ text(1:length(labels), par("usr")[1] - 0.2, srt = 45, adj = 1,
+ labels = labels, xpd = TRUE, cex=0.7)
+ if(!is.null(sort.base))
+ text(1:length(labels), par("usr")[1] - 0.2, srt = 0, adj = 1,
+ labels = labels.sec, xpd = TRUE, cex=0.5)
+ ## Plot x axis label at line 6 (of 7)
+ }else{
+# axis(2, cex.axis = 0.9, col = element.color, labels = labels, at = 1:columns, las = 2)
+ text(par("usr")[3] - 0.24, 1:length(labels), srt = 0, adj = 1,
+ labels = labels, xpd = TRUE, cex=0.7)
+ if(!is.null(sort.base))
+ text(par("usr")[3] - 0.24, 1:length(labels), srt = 0, adj = 0,
+ labels = labels.sec, xpd = TRUE, cex=0.5)
+ }
+ } else{
+ labels = ""
+ axis(2, cex.axis = 0.8, col = element.color, labels = labels, at = 1:columns, las = 1, tick = FALSE)
+ }
+
+# if(names)
+# title(sub=ylab)
+# else
+# title(sub=ylab)
+ box(col=element.color)
+
+ if(horizontal) {
+ abline(v=0, lty="solid",col=element.color)
+ } else {
+ abline(h=0, lty="solid",col=element.color)
+ }
+
+
+ par(op)
+}
+
+###############################################################################
+# R (http://r-project.org/) Econometrics for Performance and Risk Analysis
+#
+# Copyright (c) 2004-2012 Peter Carl and Brian G. Peterson
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: chart.Boxplot.R 2621 2013-07-22 19:36:44Z peter_carl $
+#
+###############################################################################
Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.QQplot.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.QQplot.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.QQplot.R 2014-02-25 19:47:36 UTC (rev 3336)
@@ -0,0 +1,311 @@
+#' Plot a QQ chart
+#'
+#' Plot the return data against any theoretical distribution.
+#'
+#' A Quantile-Quantile (QQ) plot is a scatter plot designed to compare the data
+#' to the theoretical distributions to visually determine if the observations
+#' are likely to have come from a known population. The empirical quantiles are
+#' plotted to the y-axis, and the x-axis contains the values of the theorical
+#' model. A 45-degree reference line is also plotted. If the empirical data
+#' come from the population with the choosen distribution, the points should
+#' fall approximately along this reference line. The larger the departure from
+#' the reference line, the greater the evidence that the data set have come
+#' from a population with a different distribution.
+#'
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+#' @param distribution root name of comparison distribution - e.g., 'norm' for
+#' the normal distribution; 't' for the t-distribution. See examples for other
+#' ideas.
+#' @param xlab set the x-axis label, as in \code{\link{plot}}
+#' @param ylab set the y-axis label, as in \code{\link{plot}}
+#' @param xaxis if true, draws the x axis
+#' @param yaxis if true, draws the y axis
+#' @param ylim set the y-axis limits, same as in \code{\link{plot}}
+#' @param main set the chart title, same as in \code{plot}
+#' @param las set the direction of axis labels, same as in \code{plot}
+#' @param envelope confidence level for point-wise confidence envelope, or
+#' FALSE for no envelope.
+#' @param labels vector of point labels for interactive point identification,
+#' or FALSE for no labels.
+#' @param col color for points and lines; the default is the \emph{second}
+#' entry in the current color palette (see 'palette' and 'par').
+#' @param lwd set the line width, as in \code{\link{plot}}
+#' @param pch symbols to use, see also \code{\link{plot}}
+#' @param cex symbols to use, see also \code{\link{plot}}
+#' @param line 'quartiles' to pass a line through the quartile-pairs, or
+#' 'robust' for a robust-regression line; the latter uses the 'rlm' function
+#' in the 'MASS' package. Specifying 'line = "none"' suppresses the line.
+#' @param element.color provides the color for drawing chart elements, such as
+#' the box lines, axis lines, etc. Default is "darkgray"
+#' @param cex.legend The magnification to be used for sizing the legend
+#' relative to the current setting of 'cex'
+#' @param cex.axis The magnification to be used for axis annotation relative to
+#' the current setting of 'cex'
+#' @param cex.lab The magnification to be used for x- and y-axis labels
+#' relative to the current setting of 'cex'
+#' @param cex.main The magnification to be used for the main title relative to
+#' the current setting of 'cex'.
+#' @param \dots any other passthru parameters to the distribution function
+#'
+#' @author John Fox, ported by Peter Carl
+#' @author For QQplot with mixture normal distribution, Ke Li \email{kirkli@@stat.washington.edu}
+#' @seealso
+#' \code{\link[stats]{qqplot}} \cr
+#' \code{\link[car]{qq.plot}} \cr
+#' \code{\link{plot}} \cr
+#' CRAN package \code{\link[nor1mix]{norMixFit}} for mixture normal distribution
+#' @references main code forked/borrowed/ported from the excellent: \cr Fox,
+#' John (2007) \emph{car: Companion to Applied Regression} \cr
+#' \url{http://www.r-project.org},
+#' \url{http://socserv.socsci.mcmaster.ca/jfox/}
+#' @keywords ts multivariate distribution models hplot
+#' @examples
+#,library(MASS)
+#,data(managers)
+
+#,x = checkData(managers[,2, drop = FALSE], na.rm = TRUE, method = "vector")
+
+#layout(rbind(c(1,2),c(3,4)))
+
+# Panel 1, Normal distribution
+#,chart.QQPlot(x, main = "Normal Distribution", distribution = 'norm', envelope=0.95)
+# Panel 2, Log-Normal distribution
+#,fit = fitdistr(1+x, 'lognormal')
+#,chart.QQPlot(1+x, main = "Log-Normal Distribution", envelope=0.95, distribution='lnorm')
+#other options could include
+#, meanlog = fit$estimate[[1]], sdlog = fit$estimate[[2]])
+
+#,\dontrun{
+#, # Panel 3, Skew-T distribution
+#, library(sn)
+#, fit = st.mle(y=x)
+#, chart.QQPlot(x, main = "Skew T Distribution", envelope=0.95,
+#, distribution = 'st', location = fit$dp[[1]],
+#, scale = fit$dp[[2]], shape = fit$dp[[3]], df=fit$dp[[4]])
+#,
+# Panel 4: Stable Parietian
+#,library(fBasics)
+#,fit.stable = stableFit(x,doplot=FALSE)
+#,chart.QQPlot(x, main = "Stable Paretian Distribution", envelope=0.95,
+#, distribution = 'stable', alpha = fit(stable.fit)$estimate[[1]],
+#, beta = fit(stable.fit)$estimate[[2]], gamma = fit(stable.fit)$estimate[[3]],
+#, delta = fit(stable.fit)$estimate[[4]], pm = 0)
+#,
+#,Panel 5: Mixture Normal distribution
+#,chart.QQPlot(x, main = "Normal Mixture Distribution",
+#, line=c("quartiles"), para=list(m=2), distribution = 'mixnormal',
+#, envelope=0.95)
+#,}
+#'
+#' #end examples
+#'
+#' @export
+
+
+
+chart.QQPlot <-
+ function(R, distribution="norm", ylab=NULL,
+ xlab=paste(distribution, "Quantiles"), main=NULL, las=par("las"),
+ envelope=FALSE, labels=FALSE, col=c(1,4), lwd=2, pch=1, cex=1,
+ line=c("quartiles", "robust", "none"), element.color = "darkgray",
+ cex.axis = 0.8, cex.legend = 0.8, cex.lab = 1, cex.main = 1, xaxis=TRUE, yaxis=TRUE, ylim=NULL, ...)
+ { # @author Peter Carl
+
+ # DESCRIPTION:
+ # A wrapper to create a chart of relative returns through time
+
+ # Inputs:
+ # R: a matrix, data frame, or timeSeries of returns
+
+ # Outputs:
+ # A Normal Q-Q Plot
+
+ # FUNCTION:
+
+ x = checkData(R, method = "vector", na.rm = TRUE)
+ # n = length(x)
+
+ if(is.null(main)){
+ if(!is.null(colnames(R)[1]))
+ main=colnames(R)[1]
+ else
+ main = "QQ Plot"
+ }
+ if(is.null(ylab)) ylab = "Empirical Quantiles"
+ # the core of this function is taken from John Fox's qq.plot, which is part of the car package
+ result <- NULL
+ line <- match.arg(line)
+ good <- !is.na(x)
+ ord <- order(x[good])
+ ord.x <- x[good][ord]
+ n <- length(ord.x)
+ P <- ppoints(n)
+
+ if(distribution=="mixnormal")
+ {
+ qmixnormal <- function(q, ...){
+ # norMix distribution
+ para=list(...)$para
+
+ if(!is.list(para))stop(" 'para' must be a 'list' object")
+
+ if(is.null(para$m)|is.na(para$m))
+ stop("The number of component must be specified in 'para$m'")
+
+ require(nor1mix)
+ out = norMixEM(x, para$m, trace=0)
+
+ if (length(q)!=2){
+ # only print once
+ print("fitted model:")
+ print(out[1:para$m,],digits=3)
+ }
+ if(is.null(para$mu) | is.null(para$sig2))
+ # using fitted distribution
+ {
+ if (length(q)!=2)
+ print("using fitted model as theoretical distribution")
+ obj <- out
+ } else{
+ # using specified distribution
+ if(length(para$mu)!=para$m | length(para$sig2)!=para$m)
+ stop("the number of components mismatch with parameter inputs")
+
+ obj <- norMix(mu = para$mu, sig2 = para$sig2, w = para$w)
+ }
+ qnorMix(q,obj)
+ }
+
+
+ dmixnormal<- function(p, ...){
+ # norMix distribution
+ para=list(...)$para
+ if(!is.list(para))stop(" 'para' must be a 'list' object")
+ if(is.null(para$m)|is.na(para$m))
+ stop("The number of component must be specified in 'para$m'")
+ library(nor1mix)
+ out = norMixEM(x, para$m, trace=0)
+
+ if(is.null(para$mu) | is.null(para$sig2))
+ # using fitted distribution
+ {
+ obj <- out
+ } else{
+ # using specified distribution
+ if(length(para$mu) != para$m | length(para$sig2) != para$m)
+ stop("the number of components mismatch with parameter inputs")
+
+ obj <- norMix(mu = para$mu, sig2 = para$sig2, w = para$w)
+ }
+ dnorMix(p,obj)
+ }
+
+ }
+
+
+ q.function <- eval(parse(text=paste("q",distribution, sep="")))
+ d.function <- eval(parse(text=paste("d",distribution, sep="")))
+
+ z <- q.function(P,...)
+
+ plot(z, ord.x, xlab=xlab, ylab=ylab, main=main, las=las, col=col[1], pch=pch,
+ cex=cex, cex.main = cex.main, cex.lab = cex.lab, axes=FALSE, ylim=ylim)
+
+ if (line=="quartiles"){
+ Q.x<-quantile(ord.x, c(.25,.75))
+ Q.z<-q.function(c(.25,.75), ...)
+ b<-(Q.x[2]-Q.x[1])/(Q.z[2]-Q.z[1])
+ a<-Q.x[1]-b*Q.z[1]
+ abline(a, b, col=col[2], lwd=lwd)
+ }
+ if (line=="robust"){
+ stopifnot("package:MASS" %in% search() || require("MASS",quietly=TRUE))
+ coef<-coefficients(rlm(ord.x~z))
+ a<-coef[1]
+ b<-coef[2]
+ abline(a,b, col=col[2])
+ }
+ if (line != 'none' & envelope != FALSE) {
+ zz<-qnorm(1-(1-envelope)/2)
+ SE<-(b/d.function(z,...))*sqrt(P*(1-P)/n)
+ fit.value<-a+b*z
+ upper<-fit.value+zz*SE
+ lower<-fit.value-zz*SE
+ lines(z, upper, lty=2, lwd=lwd/2, col=col[2])
+ lines(z, lower, lty=2, lwd=lwd/2, col=col[2])
+ }
+ if (labels[1]==TRUE & length(labels)==1) labels<-seq(along=z)
+ if (labels[1] != FALSE) {
+ selected<-identify(z, ord.x, labels[good][ord])
+ result <- seq(along=x)[good][ord][selected]
+ }
+ if (is.null(result)) invisible(result) else sort(result)
+
+ # if(distribution == "normal") {
+ # if(is.null(xlab)) xlab = "Normal Quantiles"
+ # if(is.null(ylab)) ylab = "Empirical Quantiles"
+ # if(is.null(main)) main = "Normal QQ-Plot"
+ #
+ # # Normal Quantile-Quantile Plot:
+ # qqnorm(x, xlab = xlab, ylab = ylab, main = main, pch = symbolset, axes = FALSE)
+ # # qqline(x, col = colorset[2], lwd = 2)
+ # q.theo = qnorm(c(0.25,0.75))
+ # }
+ # if(distribution == "sst") {
+ # library("sn")
+ # if(is.null(xlab)) xlab = "Skew-T Quantiles"
+ # if(is.null(ylab)) ylab = "Empirical Quantiles"
+ # if(is.null(main)) main = "Skew-T QQ-Plot"
+ #
+ # # Skew Student-T Quantile-Quantile Plot:
+ # y = qst(c(1:n)/(n+1))
+ # qqplot(y, x, xlab = xlab, ylab = ylab, axes=FALSE, main=main)
+ # q.theo = qst(c(0.25,0.75))
+ # }
+ # if(distribution == "cauchy") {
+ # if(is.null(xlab)) xlab = "Cauchy Quantiles"
+ # if(is.null(ylab)) ylab = "Empirical Quantiles"
+ # if(is.null(main)) main = "Cauchy QQ-Plot"
+ #
+ # # Skew Student-T Quantile-Quantile Plot:
+ # y = qcauchy(c(1:n)/(n+1))
+ # qqplot(y, x, xlab = xlab, ylab = ylab, axes=FALSE, main=main)
+ # q.theo = qcauchy(c(0.25,0.75))
+ # }
+ # if(distribution == "lnorm") {
+ # if(is.null(xlab)) xlab = "Log Normal Quantiles"
+ # if(is.null(ylab)) ylab = "Empirical Quantiles"
+ # if(is.null(main)) main = "Log Normal QQ-Plot"
+ #
+ # # Skew Student-T Quantile-Quantile Plot:
+ # y = qlnorm(c(1:n)/(n+1))
+ # qqplot(y, x, xlab = xlab, ylab = ylab, axes=FALSE, main=main)
+ # q.theo = qlnorm(c(0.25,0.75))
+ # }
+ #
+ # q.data=quantile(x,c(0.25,0.75))
+ # slope = diff(q.data)/diff(q.theo)
+ # int = q.data[1] - slope* q.theo[1]
+ #
+ # if(line) abline(int, slope, col = colorset[2], lwd = 2)
+ if(xaxis)
+ axis(1, cex.axis = cex.axis, col = element.color)
+ if(yaxis)
+ axis(2, cex.axis = cex.axis, col = element.color)
+
+ box(col=element.color)
+
+ }
+
+###############################################################################
+# R (http://r-project.org/) Econometrics for Performance and Risk Analysis
+#
+# Copyright (c) 2004-2014 Peter Carl and Brian G. Peterson
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: chart.QQPlot.R 3301 2014-01-18 15:26:12Z braverock $
+#
+###############################################################################
Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/lpm.Rd
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAenhance/R/lpm.Rd (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/lpm.Rd 2014-02-25 19:47:36 UTC (rev 3336)
@@ -0,0 +1,30 @@
+\name{lpm}
+\alias{lpm}
+\title{calculate the lower partial moment of a time series}
+\usage{
+lpm(R, n, threshold, about_mean = FALSE)
+}
+\arguments{
+ \item{R}{xts data}
+
+ \item{n}{the n-th moment to return}
+
+ \item{threshold}{threshold can be the mean or any point
+ as desired}
+
+ \item{about_mean}{TRUE/FALSE calculate LPM about the mean
+ under the threshold or use the threshold to calculate the
+ LPM around (if FALSE)}
+}
+\description{
+Code to calculate the Lower Partion Moments around the mean
+or a specified threshold from Huffman S,P & Moll C.R. 2011
+"The impact of Asymmetry on Expected Stock Returns: An
+Investigation of Alternative Risk Measures" Algorithmic
+Finance 1 (2011) 79-93
+}
+\author{
+Kyle Balkissoon \email{kylebalkissoon at gmail.com}
+\email{kyle at corporateknights.com}
+}
+
Added: pkg/PerformanceAnalytics/sandbox/PAenhance/inst/PA-KirkLi.Rnw
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAenhance/inst/PA-KirkLi.Rnw (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAenhance/inst/PA-KirkLi.Rnw 2014-02-25 19:47:36 UTC (rev 3336)
@@ -0,0 +1,142 @@
+%
+\documentclass[a4paper]{article}
+\usepackage{Sweave}
+\usepackage{listings}
+\title{PerformanceAnalytics Changed by Kirk Li}
+\author{kirkli at u.washington.edu}
+
+\begin{document}
+
+\maketitle
+
+\tableofcontents
+
+<<setup, cache=FALSE,echo=FALSE>>=
+# global chunk options
+library(knitr)
+opts_chunk$set(cache=FALSE, tidy=FALSE, autodep=TRUE,
+ fig.width=6, fig.height=6)
+options(width=60)
+listing <- function(x, options) {
+ paste("\\begin{lstlisting}[basicstyle=\\ttfamily,breaklines=true]\n",
+ x, "\\end{lstlisting}\n", sep = "")
+}
+knit_hooks$set(source=listing, output=listing)
+
+
+@
+
+<<echo = FALSE, message = FALSE>>=
+library(PAKK)
+library(nor1mix)
+@
+
+\section{Changes on chart.Boxplot}
+Remarks:
+\begin{itemize}
+ \item Sorting boxplot by different risk measure
+ \begin{itemize}
+ \item Enable the ascending sorting and descending sorting
+ \item Enable one of 18 measures that adopted from table.Distributions,
+ table.DrawdownsRatio,
+ table.DownsideRiskRatio,
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3336
More information about the Returnanalytics-commits
mailing list