[R] bwplot change whiskers position to percentile 5 and P95

[David Winsemius]

On Oct 14, 2010, at 11:07 AM, Christophe Bouffioux wrote:

> Hi,
>
> I have tried your proposition, and it works properly on the  
> simulated data, but not on my real data, and I do not see any  
> explanations, this is weird, i have no more ideas to explore the  
> problem

You should:
a) provide the code that you used to call boxplot
b) offer str(sasdata03_a) , .... since summary will often obscure  
class-related problems
c) consider running:
sasdata03_a$Cat_F <- factor(sasdata03_a$Cat_F) # to get rid of the  
empty factor level

>
>
> so here i give some information on my data, nothing special actually,
>
> Christophe
>
> > summary(sasdata03_a)
>    jaar           Cat_F              montant_oa             
> nombre_cas        montant_i
>  2006:36854   a      :22591    Min.   :  -112.8        Min.   :    
> -5.0       Min.   :   33.22
>  2007:36538   h      :22056    1st Qu.:  1465.5     1st Qu.:   
> 104.0    1st Qu.:   37.80
>  2008:36579   i      :21844     Median :  4251.5     Median :   
> 307.0   Median :   50.00
>                     k      :21485     Mean   : 13400.0    Mean   :   
> 557.5    Mean   : 1172.17
>                     g      :16217     3rd Qu.: 13648.5    3rd Qu.:   
> 748.0    3rd Qu.:  458.67
>                     d      : 5778      Max.   : 534655.6    Max.   : 
> 13492.0   Max.   :17306.73
>                     (Other):    0
>     nombre_i
>  Min.   :  1.00
>  1st Qu.:  1.00
>  Median :  5.00
>  Mean   : 44.87
>  3rd Qu.: 29.00
>  Max.   :689.00
>
> > is.data.frame(sasdata03_a)
> [1] TRUE
>
> The code of the function:
>
> boxplot2.stats <-  function (x, coef = 1.5, do.conf = TRUE, do.out =  
> TRUE)
> {
>     if (coef < 0)
>         stop("'coef' must not be negative")
>     nna <- !is.na(x)
>     n <- sum(nna)
>     stats <- stats::fivenum(x, na.rm = TRUE)
>     stats[c(1,5)]<- quantile(x, probs=c(0.05, 0.95))
>     iqr <- diff(stats[c(2, 4)])
>     if (coef == 0)
>         do.out <- FALSE
>     else {
>         out <- if (!is.na(iqr)) {
>             x < (stats[2L] - coef * iqr) | x > (stats[4L] + coef *
>                 iqr)
>         }
>         else !is.finite(x)
>         if (any(out[nna], na.rm = TRUE))
>             stats[c(1, 5)] <- range(x[!out], na.rm = TRUE)
>     }
>     conf <- if (do.conf)
>         stats[3L] + c(-1.58, 1.58) * iqr/sqrt(n)
>     list(stats = stats, n = n, conf = conf, out = if (do.out) x[out &
>         nna] else numeric(0L))
> }
>
>
> On Wed, Oct 13, 2010 at 5:13 PM, David Winsemius <dwinsemius at comcast.net 
> > wrote:
>
> On Oct 13, 2010, at 10:05 AM, Christophe Bouffioux wrote:
>
> Dear R-community,
>
> Using bwplot, how can I put the whiskers at percentile 5 and  
> percentile 95,
> in place of the default position coef=1.5??
>
> Using panel=panel.bwstrip, whiskerpos=0.05, from the package  
> agsemisc gives
> satisfaction, but changes the appearance of my boxplot and works  
> with an old
> version of R, what I don’t want, and I didn’t find the option in
> box.umbrella parameters
>
> Nope, you won't find it even if you search harder, but you do have a  
> lattice path forward. Just as base function boxplot() does the  
> calculations and then plots with bxp(), by default panel.bwplot  
> sends the data to boxplot.stats, but panel.bwplot also allows you to  
> specify an alternate function that returns plotting parameters  
> differently as long as those conforms to the requirements for  
> structure. You can look at boxplot.stats (it's not that big)  and  
> then construct an alternative. The line you would need to alter  
> would be the one starting with:  stats<-stats::fivenum(...), since  
> you are changing the values returned by fivenum(). You might get  
> away with just changing stats[1] and stats[5] to your revised  
> specifications, although it has occurred to me that you might get  
> some of those "out" dots inside your whiskers. (Fixing that would  
> not be too hard once you are inside boxplot.stats().
>
> Seemed to work for me with your data (at least the extent of  
> plotting a nice 3 x 2 panel display. All I did was redefine an  
> nboxplot.stats by inserting this line after the line cited above:
>
> stats[c(1,5)]<- quantile(x, probs=c(0.05, 0.95))
>
> and then added an argument  ..., stats=nboxplot.stats)  inside your  
> panel.bwplot.
>
> -- 
> David.
>
>
> Many thanks
> Christophe
>
> Here is the code:
>
> library(lattice)
> ex <- data.frame(v1 = log(abs(rt(180, 3)) + 1),
>                v2 = rep(c("2007", "2006", "2005"), 60),
>                z  = rep(c("a", "b", "c", "d", "e", "f"), e = 30))
>
> ex2 <- data.frame(v1b = log(abs(rt(18, 3)) + 1),
>                v2 = rep(c("2007", "2006", "2005"), 6),
>                z  = rep(c("a", "b", "c", "d", "e", "f"), e = 3))
> ex3 <- merge(ex, ex2, by=c("v2","z"))
> D2007 <- ex3[ex3$z=="d" & ex3$v2==2007, ]
> D2006 <- ex3[ex3$z=="d" & ex3$v2==2006, ]
> C2007 <- ex3[ex3$z=="c" & ex3$v2==2007, ]
>
>
> quantile(D2007$v1, probs = c(0.05, 0.95))
> quantile(D2006$v1, probs = c(0.05, 0.95))
> quantile(C2007$v1, probs = c(0.05, 0.95))
>
> bwplot(v2 ~ v1 | z, data = ex3, layout=c(3,2), X = ex3$v1b,
> pch = "|",
> par.settings = list(
> plot.symbol = list(alpha = 1, col = "transparent",cex = 1,pch = 20)),
> panel = function(x, y, ..., X, subscripts){
> panel.grid(v = -1, h = 0)
> panel.bwplot(x, y, ..., subscripts = subscripts)
> X <- X[subscripts]
> xmax =max(x)
> X <- tapply(X, y, unique)
> Y <- tapply(y, y, unique)
> tg <- table(y)
> panel.points(X, Y, cex=3, pch ="|" , col = "red")
> #vcount <- tapply(v1, v2, length)
> panel.text((xmax-0.2), (Y-0.15), labels = paste("N=", tg))
> })
>
>        [[alternative HTML version deleted]]
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>
> David Winsemius, MD
> West Hartford, CT
>
>

David Winsemius, MD
West Hartford, CT