Skip to content
Prev 5552 / 63424 Next
Original Raw

New Package: gregmisc

Ben Bolker 
Do you have the latest version of plotCI?  (attached below, I didn't
send it as an attachment for the sake of R-devel)  It uses arrows()
instead of segments(), which simplifies the code a bit and incidentally
makes it work with logarithmic axes as well (since the sizes of the bar
ends are specified in absolute rather than user units).

  Should this code be the first entry in the "miscellaneous code"
repository at CRAN that was discussed a while back?

  By the way, something occurred to me ... my "miscellaneous packages"
function (which I haven't made available to CRAN yet, although I probably
will eventually) is called "bbmisc".  Yours is called "gregmisc".  Would
it make any sense to standardize these on "<lastname>misc" or
"<first_initial><lastname>misc" (bolkermisc, bbolkermisc) to avoid
confusion once we have a whole bunch of these packages?

  Also by the way, congratulations for actually getting around to posting
your miscellaneous functions to CRAN!  I hope to do as well.

  Ben Bolker

plotCI <- function (x, y = NULL, uiw, liw = uiw, aui=NULL, ali=aui,
                    err="y", ylim=NULL, xlim=NULL, sfrac = 0.01, gap=0, add=FALSE,
                    col=par("col"), lwd=par("lwd"), slty=par("lty"), xlab=NULL,
                    ylab=NULL, main="", pt.bg = NA, scol=col,
                    axes=TRUE, ...)  {
# from Bill Venables, R-list
  if (is.list(x)) {
    y <- x$y
    x <- x$x
  }
  if (is.null(y)) {
    if (is.null(x))
      stop("both x and y NULL")
    y <- as.numeric(x)
    x <- seq(along = x)
  }
  if (missing(xlab)) xlab <- deparse(substitute(x))
  if (missing(ylab)) ylab <- deparse(substitute(y))
  if (missing(uiw)) {  ## absolute limits
    ui <- aui
    li <- ali
  }
  else {  ## relative limits
    if (err=="y") z <- y else z <- x
    ui <- z + uiw
    li <- z - liw
  }
  if (err=="y" & is.null(ylim))
    ylim <- range(c(y, ui, li), na.rm=TRUE)
  else
    if (err=="x" & is.null(xlim))
      xlim <- range(c(x, ui, li), na.rm=TRUE)
  if (!add)
    plot(x, y, ylim = ylim, xlim = xlim, col=col, lwd=lwd, xlab=xlab, ylab=ylab,
         main=main, type="n", axes=axes, ...)
  if (gap==TRUE) gap <- 0.01  ## default gap size
  ul <- c(li, ui)
  if (err=="y") {
    gap <- rep(gap,length(x))*diff(par("usr")[3:4])
    smidge <- par("fin")[1] * sfrac
    arrows(x , li, x, pmax(y-gap,li), col=col, lwd=lwd, lty=slty, angle=90, length=smidge, code=1)
    arrows(x , ui, x, pmin(y+gap,ui), col=col, lwd=lwd, lty=slty, angle=90, length=smidge, code=1)
  }
  else if (err=="x") {
    gap <- rep(gap,length(x))*diff(par("usr")[1:2])
    smidge <- par("fin")[2] * sfrac
    arrows(li, y, pmax(x-gap,li), y, col=col, lwd=lwd, lty=slty, angle=90, length=smidge, code=1)
    arrows(ui, y, pmin(x+gap,ui), y, col=col, lwd=lwd, lty=slty, angle=90, length=smidge, code=1)
  }
  ## _now_ draw the points (in case we want to have "bg" set for points)
  points(x, y, col=col, lwd=lwd, bg=pt.bg, ...)
  invisible(list(x = x, y = y))
}
On Thu, 24 May 2001, Warnes, Gregory R wrote:

            

      
      
      
    

        

  
    

      
      
    

  


  


  


  
  

    

  

    
      
    
    
Thread (2 messages)

  

  

    
            
        Warnes, Gregory R
        
        New Package: gregmisc
      
      May 24
    
    
      
            
        Ben Bolker
        
        New Package: gregmisc
      
      May 27