# This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2007, Diethelm Wuertz, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: BOX PLOTS: # assetsBoxPlot Displays standard box plots # assetsBoxPercentilePlot Displays side-by-side box-percentile plots ################################################################################ assetsBoxPlot <- function(x, col = "bisque", ...) { # A function Implemented by Diethelm Wuertz # Description: # Displays standard box plots # Arguments: # x - a 'timeSeries' object or any other rectangular object # which cab be transformed by the function as.matrix into # a numeric matrix. # FUNCTION: # Settings: x = as.matrix(x) assetNames = colnames(x) # Plot: ans = boxplot(as.data.frame(x), col = col, ...) colnames(ans$stats) = ans$names rownames(ans$stats) = c("lower whisker", "lower hinge", "median", "upper hinge", "upper whisker") abline(h = 0 , lty = 3) # Return Value: invisible(ans) } # ------------------------------------------------------------------------------ assetsBoxPercentilePlot <- function(x, col = "bisque", ...) { # A modified copy from Hmisc # Description: # Displays side-by-side box-percentile plots # Arguments: # x - a 'timeSeries' object or any other rectangular object # which cab be transformed by the function as.matrix into # a numeric matrix. # Details: # Box-percentile plots are similiar to boxplots, except box-percentile # plots supply more information about the univariate distributions. At # any height the width of the irregular "box" is proportional to the # percentile of that height, up to the 50th percentile, and above the # 50th percentile the width is proportional to 100 minus the percentile. # Thus, the width at any given height is proportional to the percent of # observations that are more extreme in that direction. As in boxplots, # the median, 25th and 75th percentiles are marked with line segments # across the box. [Source: Hmisc] # FUNCTION: # Settings: x = as.matrix(x) assetNames = colnames(x) n = ncol(x) all.x = list() for (i in 1:n) all.x[[i]] = as.vector(x[, i]) centers = seq(from = 0, by = 1.2, length = n) ymax = max(sapply(all.x, max, na.rm = TRUE)) ymin = min(sapply(all.x, min, na.rm = TRUE)) xmax = max(centers) + 0.5 xmin = -0.5 # Plot: plot(c(xmin, xmax), c(ymin, ymax), type = "n", xlab = "", ylab = "", xaxt = "n", ...) xpos = NULL for (i in 1:n) { # plot.values = .bpxAssetsPlot(all.x[[i]], centers[i]) y = all.x[[i]] offset = centers[i] y = y[!is.na(y)] n = length(y) delta = 1/(n + 1) prob = seq(delta, 1 - delta, delta) quan = sort(y) med = median(y) q1 = median(y[y < med]) q3 = median(y[y > med]) first.half.p = prob[quan <= med] second.half.p = 1 - prob[quan > med] plotx = c(first.half.p, second.half.p) options(warn = -1) qx = approx(quan, plotx, xout = q1)$y q1.x = c(-qx, qx) + offset qx = approx(quan, plotx, xout = q3)$y options(warn = 0) q3.x = c(-qx, qx) + offset q1.y = c(q1, q1) q3.y = c(q3, q3) med.x = c(-max(first.half.p), max(first.half.p)) + offset med.y = c(med, med) plot.values = list(x1 = (-plotx) + offset, y1 = quan, x2 = plotx + offset, y2 = quan, q1.y = q1.y, q1.x = q1.x, q3.y = q3.y, q3.x = q3.x, med.y = med.y, med.x = med.x) # Continue: xpos = c(xpos, mean(plot.values$med.x)) x.p = c(plot.values$x1, plot.values$x2) y.p = c(plot.values$y1, plot.values$y2) polygon(x.p, y.p, col = col, border = "grey") lines(plot.values$x1, plot.values$y1) lines(plot.values$x2, plot.values$y2) lines(plot.values$q1.x, plot.values$q1.y) lines(plot.values$q3.x, plot.values$q3.y) lines(plot.values$med.x, plot.values$med.y) } axis(side = 1, at = xpos, labels = assetNames) abline(h = 0, lty = 3, col = "black") # Return Value: invisible() } ################################################################################