[Returnanalytics-commits] r3437 - in pkg/PerformanceAnalytics/sandbox: . PAenhance PAenhance/R PAenhance/man PAenhance/vignettes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jun 22 22:52:01 CEST 2014
Author: kecoli
Date: 2014-06-22 22:52:01 +0200 (Sun, 22 Jun 2014)
New Revision: 3437
Added:
pkg/PerformanceAnalytics/sandbox/PAenhance/
pkg/PerformanceAnalytics/sandbox/PAenhance/DESCRIPTION
pkg/PerformanceAnalytics/sandbox/PAenhance/LICENSE
pkg/PerformanceAnalytics/sandbox/PAenhance/NAMESPACE
pkg/PerformanceAnalytics/sandbox/PAenhance/Plan for next release
pkg/PerformanceAnalytics/sandbox/PAenhance/R/
pkg/PerformanceAnalytics/sandbox/PAenhance/R/PAenhance-internal.R
pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R
pkg/PerformanceAnalytics/sandbox/PAenhance/R/cbind.na.R
pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.Boxplot.R
pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.QQplot.R
pkg/PerformanceAnalytics/sandbox/PAenhance/R/inslib.R
pkg/PerformanceAnalytics/sandbox/PAenhance/R/table.Performance.R
pkg/PerformanceAnalytics/sandbox/PAenhance/R/table.Performance.pool.R
pkg/PerformanceAnalytics/sandbox/PAenhance/R/table.Performance.pool.cran.R
pkg/PerformanceAnalytics/sandbox/PAenhance/README.md
pkg/PerformanceAnalytics/sandbox/PAenhance/man/
pkg/PerformanceAnalytics/sandbox/PAenhance/man/SharpeRatio.Rd
pkg/PerformanceAnalytics/sandbox/PAenhance/man/chart.Boxplot.Rd
pkg/PerformanceAnalytics/sandbox/PAenhance/man/chart.QQPlot.Rd
pkg/PerformanceAnalytics/sandbox/PAenhance/man/table.Performance.Rd
pkg/PerformanceAnalytics/sandbox/PAenhance/man/table.Performance.pool.Rd
pkg/PerformanceAnalytics/sandbox/PAenhance/man/table.Performance.pool.cran.Rd
pkg/PerformanceAnalytics/sandbox/PAenhance/vignettes/
pkg/PerformanceAnalytics/sandbox/PAenhance/vignettes/PA-KirkLi.Rnw
pkg/PerformanceAnalytics/sandbox/PAenhance/vignettes/PA-KirkLi.pdf
Log:
merging Kirk's github work to R-forge
including Chart.Boxplot, Chart.QQplot, table.performance.R
Added: pkg/PerformanceAnalytics/sandbox/PAenhance/DESCRIPTION
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAenhance/DESCRIPTION (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAenhance/DESCRIPTION 2014-06-22 20:52:01 UTC (rev 3437)
@@ -0,0 +1,13 @@
+Package: PAenhance
+Type: Package
+Title: Enhancement of PerformanceAnalytics developed by Kirk Li and Douglass
+ Martin
+Version: 1.0
+Date: 2014-05-10
+Author: Kirk Li, Douglass Martin
+Maintainer: Kirk Li <kirkli at stat.washington.edu>
+Description: Develop various enhancement to PerformanceAnalytics Package
+License: GPL
+Copyright: (c) 2014-2014
+Contributors:
+Roxygen: list(wrap = TRUE)
Added: pkg/PerformanceAnalytics/sandbox/PAenhance/LICENSE
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAenhance/LICENSE (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAenhance/LICENSE 2014-06-22 20:52:01 UTC (rev 3437)
@@ -0,0 +1,21 @@
+The MIT License (MIT)
+
+Copyright (c) 2014 kecoli
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
\ No newline at end of file
Added: pkg/PerformanceAnalytics/sandbox/PAenhance/NAMESPACE
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAenhance/NAMESPACE (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAenhance/NAMESPACE 2014-06-22 20:52:01 UTC (rev 3437)
@@ -0,0 +1,8 @@
+# Generated by roxygen2 (4.0.1.99): do not edit by hand
+
+export(SharpeRatio)
+export(chart.Boxplot)
+export(chart.QQPlot)
+export(table.Performance)
+export(table.Performance.pool)
+export(table.Performance.pool.cran)
Added: pkg/PerformanceAnalytics/sandbox/PAenhance/Plan for next release
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAenhance/Plan for next release (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAenhance/Plan for next release 2014-06-22 20:52:01 UTC (rev 3437)
@@ -0,0 +1,7 @@
+6/22
+
+adding export to excel
+
+5/10
+
+Per Doug's comments, adding interactive=NULL and latex=TRUE functionailites
Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/PAenhance-internal.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAenhance/R/PAenhance-internal.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/PAenhance-internal.R 2014-06-22 20:52:01 UTC (rev 3437)
@@ -0,0 +1,24 @@
+.ls.objects <-
+function (pos = 1, pattern, order.by,
+ decreasing=FALSE, head=FALSE, n=5) {
+ napply <- function(names, fn) sapply(names, function(x)
+ fn(get(x, pos = pos)))
+ names <- ls(pos = pos, pattern = pattern)
+ obj.class <- napply(names, function(x) as.character(class(x))[1])
+ obj.mode <- napply(names, mode)
+ obj.type <- ifelse(is.na(obj.class), obj.mode, obj.class)
+ obj.prettysize <- napply(names, function(x) {
+ capture.output(print(object.size(x), units = "auto")) })
+ obj.size <- napply(names, object.size)
+ obj.dim <- t(napply(names, function(x)
+ as.numeric(dim(x))[1:2]))
+ vec <- is.na(obj.dim)[, 1] & (obj.type != "function")
+ obj.dim[vec, 1] <- napply(names, length)[vec]
+ out <- data.frame(obj.type, obj.size, obj.prettysize, obj.dim)
+ names(out) <- c("Type", "Size", "PrettySize", "Rows", "Columns")
+ if (!missing(order.by))
+ out <- out[order(out[[order.by]], decreasing=decreasing), ]
+ if (head)
+ out <- head(out, n)
+ out
+}
Property changes on: pkg/PerformanceAnalytics/sandbox/PAenhance/R/PAenhance-internal.R
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R 2014-06-22 20:52:01 UTC (rev 3437)
@@ -0,0 +1,154 @@
+#' A modified version of SharpeRatio that compatible with table.Peroformance
+#'
+#' The Sharpe ratio is simply the return per unit of risk (represented by
+#' variability). In the classic case, the unit of risk is the standard
+#' deviation of the returns.
+#'
+#' \deqn{\frac{\overline{(R_{a}-R_{f})}}{\sqrt{\sigma_{(R_{a}-R_{f})}}}}
+#'
+#' William Sharpe now recommends \code{\link{InformationRatio}} preferentially
+#' to the original Sharpe Ratio.
+#'
+#' The higher the Sharpe ratio, the better the combined performance of "risk"
+#' and return.
+#'
+#' As noted, the traditional Sharpe Ratio is a risk-adjusted measure of return
+#' that uses standard deviation to represent risk.
+#'
+#' A number of papers now recommend using a "modified Sharpe" ratio using a
+#' Modified Cornish-Fisher VaR or CVaR/Expected Shortfall as the measure of
+#' Risk.
+#'
+#' We have recently extended this concept to create multivariate modified
+#' Sharpe-like Ratios for standard deviation, Gaussian VaR, modified VaR,
+#' Gaussian Expected Shortfall, and modified Expected Shortfall. See
+#' \code{\link{VaR}} and \code{\link{ES}}. You can pass additional arguments
+#' to \code{\link{VaR}} and \code{\link{ES}} via \dots{} The most important is
+#' probably the 'method' argument/
+#'
+#' This function returns a traditional or modified Sharpe ratio for the same
+#' periodicity of the data being input (e.g., monthly data -> monthly SR)
+#'
+#'
+#' @aliases SharpeRatio.modified SharpeRatio
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+#' @param Rf risk free rate, in same period as your returns
+#' @param p confidence level for calculation, default p=.95
+#' @param FUN one of "StdDev" or "VaR" or "ES" to use as the denominator
+#' @param weights portfolio weighting vector, default NULL, see Details in
+#' \code{\link{VaR}}
+#' @param annualize if TRUE, annualize the measure, default FALSE
+#' @param \dots any other passthru parameters to the VaR or ES functions
+#' @author Brian G. Peterson, Kirk Li
+#' @seealso \code{\link{SharpeRatio.annualized}} \cr
+#' \code{\link{InformationRatio}} \cr \code{\link{TrackingError}} \cr
+#' \code{\link{ActivePremium}} \cr \code{\link{SortinoRatio}} \cr
+#' \code{\link{VaR}} \cr \code{\link{ES}} \cr
+#' @references Sharpe, W.F. The Sharpe Ratio,\emph{Journal of Portfolio
+#' Management},Fall 1994, 49-58.
+#'
+#' Laurent Favre and Jose-Antonio Galeano. Mean-Modified Value-at-Risk
+#' Optimization with Hedge Funds. Journal of Alternative Investment, Fall 2002,
+#' v 5.
+#' @keywords ts multivariate distribution models
+#' @examples
+#'
+#' data(managers)
+#' SharpeRatio(managers[,1,drop=FALSE], Rf=.035/12, FUN="StdDev")
+#' SharpeRatio(managers[,1,drop=FALSE], Rf = managers[,10,drop=FALSE], FUN="StdDev")
+#' SharpeRatio(managers[,1:6], Rf=.035/12, FUN="StdDev")
+#' SharpeRatio(managers[,1:6], Rf = managers[,10,drop=FALSE], FUN="StdDev")
+#'
+#'
+#'
+#' data(edhec)
+#' SharpeRatio(edhec[, 6, drop = FALSE], FUN="VaR")
+#' SharpeRatio(edhec[, 6, drop = FALSE], Rf = .04/12, FUN="VaR")
+#' SharpeRatio(edhec[, 6, drop = FALSE], Rf = .04/12, FUN="VaR" , method="gaussian")
+#' SharpeRatio(edhec[, 6, drop = FALSE], FUN="ES")
+#'
+#' # and all the methods
+#' SharpeRatio(managers[,1:9], Rf = managers[,10,drop=FALSE])
+#' SharpeRatio(edhec,Rf = .04/12)
+#'
+#' @export
+#' @rdname SharpeRatio
+SharpeRatio <-
+function (R, Rf = 0, p = 0.95, method = c("StdDev", "VaR", "ES"),
+ weights = NULL, annualize = FALSE, ...)
+{
+ R = checkData(R)
+
+ method <- match.arg(method)
+
+ if (!is.null(dim(Rf)))
+ Rf = checkData(Rf)
+ if (annualize) {
+ freq = periodicity(R)
+ switch(freq$scale, minute = {
+ stop("Data periodicity too high")
+ }, hourly = {
+ stop("Data periodicity too high")
+ }, daily = {
+ scale = 252
+ }, weekly = {
+ scale = 52
+ }, monthly = {
+ scale = 12
+ }, quarterly = {
+ scale = 4
+ }, yearly = {
+ scale = 1
+ })
+ }
+ else {
+ scale = 1
+ }
+ srm <- function(R, ..., Rf, p, FUNC) {
+ FUNCT <- match.fun(FUNC)
+ xR = Return.excess(R, Rf)
+ SRM = mean(xR, na.rm = TRUE)/FUNCT(R = R, p = p, ... = ...,
+ invert = FALSE)
+ SRM
+ }
+ sra <- function(R, ..., Rf, p, FUNC) {
+ if (FUNC == "StdDev")
+ FUNC = "StdDev.annualized"
+ FUNCT <- match.fun(FUNC)
+ xR = Return.excess(R, Rf)
+ SRA = Return.annualized(xR)/FUNCT(R = R, p = p, ... = ...,
+ invert = FALSE)
+ SRA
+ }
+ i = 1
+ if (is.null(weights)) {
+ result = matrix(nrow = length(method), ncol = ncol(R))
+ colnames(result) = colnames(R)
+ }
+ else {
+ result = matrix(nrow = length(method))
+ }
+ tmprownames = vector()
+
+ for (FUNCT in method) {
+ if (is.null(weights)) {
+ if (annualize)
+ result[i, ] = sapply(R, FUN = sra, Rf = Rf, p = p,
+ FUNC = FUNCT, ...)
+ else result[i, ] = sapply(R, FUN = srm, Rf = Rf,
+ p = p, FUNC = FUNCT, ...)
+ }
+ else {
+ result[i, ] = mean(R %*% weights, na.rm = TRUE)/match.fun(FUNCT)(R,
+ Rf = Rf, p = p, weights = weights, portfolio_method = "single",
+ ... = ...)
+ }
+ tmprownames = c(tmprownames, paste(if (annualize) "Annualized ",
+ FUNCT, " Sharpe", " (Rf=", round(scale * mean(Rf) *
+ 100, 1), "%, p=", round(p * 100, 1), "%):", sep = ""))
+ i = i + 1
+ }
+ rownames(result) = tmprownames
+ return(result)
+}
Property changes on: pkg/PerformanceAnalytics/sandbox/PAenhance/R/SharpeRatio.R
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: pkg/PerformanceAnalytics/sandbox/PAenhance/R/cbind.na.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/PAenhance/R/cbind.na.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/PAenhance/R/cbind.na.R 2014-06-22 20:52:01 UTC (rev 3437)
@@ -0,0 +1,89 @@
+cbind.na <-
+function (..., deparse.level = 1)
+{
+ na <- nargs() - (!missing(deparse.level))
+ deparse.level <- as.integer(deparse.level)
+ stopifnot(0 <= deparse.level, deparse.level <= 2)
+ argl <- list(...)
+ while (na > 0 && is.null(argl[[na]])) {
+ argl <- argl[-na]
+ na <- na - 1
+ }
+ if (na == 0)
+ return(NULL)
+ if (na == 1) {
+ if (isS4(..1))
+ return(cbind2(..1))
+ else return(matrix(...))
+ }
+ if (deparse.level) {
+ symarg <- as.list(sys.call()[-1L])[1L:na]
+ Nms <- function(i) {
+ if (is.null(r <- names(symarg[i])) || r == "") {
+ if (is.symbol(r <- symarg[[i]]) || deparse.level ==
+ 2)
+ deparse(r)
+ }
+ else r
+ }
+ }
+ if (na == 0) {
+ r <- argl[[2]]
+ fix.na <- FALSE
+ }
+ else {
+ nrs <- unname(lapply(argl, nrow))
+ iV <- sapply(nrs, is.null)
+ fix.na <- identical(nrs[(na - 1):na], list(NULL, NULL))
+ if (deparse.level) {
+ if (fix.na)
+ fix.na <- !is.null(Nna <- Nms(na))
+ if (!is.null(nmi <- names(argl)))
+ iV <- iV & (nmi == "")
+ ii <- if (fix.na)
+ 2:(na - 1)
+ else 2:na
+ if (any(iV[ii])) {
+ for (i in ii[iV[ii]]) if (!is.null(nmi <- Nms(i)))
+ names(argl)[i] <- nmi
+ }
+ }
+ nRow <- as.numeric(sapply(argl, function(x) NROW(x)))
+ maxRow <- max(nRow, na.rm = TRUE)
+ argl <- lapply(argl, function(x) if (is.null(nrow(x)))
+ c(x, rep(NA, maxRow - length(x)))
+ else rbind.na(x, matrix(, maxRow - nrow(x), ncol(x))))
+ r <- do.call(cbind, c(argl[-1L], list(deparse.level = deparse.level)))
+ }
+ d2 <- dim(r)
+ r <- cbind2(argl[[1]], r)
+ if (deparse.level == 0)
+ return(r)
+ ism1 <- !is.null(d1 <- dim(..1)) && length(d1) == 2L
+ ism2 <- !is.null(d2) && length(d2) == 2L && !fix.na
+ if (ism1 && ism2)
+ return(r)
+ Ncol <- function(x) {
+ d <- dim(x)
+ if (length(d) == 2L)
+ d[2L]
+ else as.integer(length(x) > 0L)
+ }
+ nn1 <- !is.null(N1 <- if ((l1 <- Ncol(..1)) && !ism1) Nms(1))
+ nn2 <- !is.null(N2 <- if (na == 2 && Ncol(..2) && !ism2) Nms(2))
+ if (nn1 || nn2 || fix.na) {
+ if (is.null(colnames(r)))
+ colnames(r) <- rep.int("", ncol(r))
+ setN <- function(i, nams) colnames(r)[i] <<- if (is.null(nams))
+ ""
+ else nams
+ if (nn1)
+ setN(1, N1)
+ if (nn2)
+ setN(1 + l1, N2)
+ if (fix.na)
+ setN(ncol(r), Nna)
+ }
+ r
+}
+
Property changes on: pkg/PerformanceAnalytics/sandbox/PAenhance/R/cbind.na.R
___________________________________________________________________
Added: svn:mime-type
+ text/plain
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-06-22 20:52:01 UTC (rev 3437)
@@ -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 $
+#
+###############################################################################
Property changes on: pkg/PerformanceAnalytics/sandbox/PAenhance/R/chart.Boxplot.R
___________________________________________________________________
Added: svn:mime-type
+ text/plain
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-06-22 20:52:01 UTC (rev 3437)
@@ -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
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 3437
More information about the Returnanalytics-commits
mailing list