Rev 33 | Rev 35 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed
### bdplot.R
#### This is a collection of functions that must bpre reachable by the user This is called
## strategy missing for xytype
## Could we test if there is an active graphics device? And if not, run bdopen()?
bdplot <- function(x, y=NULL, z=NULL,
## The rest is irrelevant for the user
cex.plot=bdp()$cex.plot,
xaxt=bdp()$xaxt,yaxt=bdp()$yaxt,
xlab=bdp()$xlab, ylab=bdp()$ylab,
xlim=NULL,ylim=NULL,
col=bdp()$col,main=NULL,
## only used in case of plot mode
type=bdp()$type,
## Only used in case of histogram plotting
border=bdp()$border,
...)
{
prm <- bdp()
par(cex.main=prm$cex.main, cex.lab=prm$cex.lab, cex.axis=prm$cex.axis)
par(tcl=prm$tcl)
par(lwd=prm$lwd)
par(bty=prm$bty)
##Set margins
mar <- prm$mar.nolab
if( !is.na(prm$xlab) ){ mar[1] <- prm$mar.lab[1] }
if( !is.na(prm$ylab) ){ mar[2] <- prm$mar.lab[2] }
if( any(!is.na(prm$toplab),!is.null(main)) ) { mar[3] <- prm$mar.lab[3] }
if( !is.na(prm$rightlab) ){ mar[4] <- prm$mar.lab[4] }
par(mar=mar)
par(mgp=prm$mgp.global)
### xaxt and yaxt can be set to "axis" which is the special case where the axis is drawn with the axius
if(xaxt=="axis"){
xaxt <- "n"
draw.xaxis <- TRUE
} else {
draw.xaxis <- FALSE
}
if(yaxt=="axis"){
yaxt <- "n"
draw.yaxis <- TRUE
} else {
draw.yaxis <- FALSE
}
## if xaxt or yaxt set, axis are drawn automatically in the plot command. Then it should not be done with axis() later
#prm$draw.xaxis <- ifelse(xaxt=="n",prm$draw.xaxis,FALSE)
#prm$draw.yaxis <- ifelse(yaxt=="n",prm$draw.yaxis,FALSE)
## Do the plot
if(!is.null(y)){
if(!is.null(z)){
if(prm$debug)
cat("bdgraphics operating in image plotting mode.\nx and y axis can not be configured.\n")
image(x=x,y=y,z=z,
xlab=xlab,
ylab=ylab,
...)
} else {
if(prm$debug)
cat("The Bacher/Delff Plotting System (R), (C), TM operating in xy-plotting mode.\n")
## this is ugly, non standard.
if(is.null(xlim))
xlim <- range(x,bdp()$xlim,na.rm=TRUE)
if(is.null(ylim))
ylim <- range(y,bdp()$ylim,na.rm=TRUE)
plot(x, y,
type=type,
xaxt=xaxt, yaxt=yaxt,
cex=cex.plot,
xlab=xlab,
ylab=ylab,
xlim=xlim,
ylim=ylim,
col=col,
main=main,
...)
}
} else if (is.numeric(x)){
if(prm$method=="barplot"){
if(prm$debug)
cat("The Bacher/Delff Plotting System (R), (C), TM operating in barplot mode.\n")
## this does not provide the full x,y functionality of barplot
barplot(height=x,
## maybe these two are wrong/stupid?
cex.axis=prm$cex.lab,
cex.names=prm$cex.lab,
col=bdp()$hcol,
border=border,
xlab=xlab,
ylab=ylab,
main=main,
...)
draw.xaxis <- FALSE
draw.yaxis <- FALSE
} else {
if(prm$debug)
cat("The Bacher/Delff Plotting System operating in xy-plotting mode, only plotting x.\n")
if(is.null(xlim))
xlim <- range(c(1:length(x),bdp()$xlim),na.rm=TRUE)
if(is.null(ylim))
ylim <- range(x,bdp()$ylim,na.rm=TRUE)
plot(x,
type=type,
xaxt=xaxt, yaxt=yaxt,
cex=cex.plot,
xlab=xlab,
ylab=ylab,
xlim=xlim,
ylim=ylim,
col=col,
main=main,
...)
}
} else if( class(x) == "acf"){
## Not cleaned up/checked
plot(x, xlab="", ylab="", xaxt=xaxt, yaxt=yaxt, cex=prm$cex.plot, xlim=prm$xlim, ylim=prm$ylim,col=col,...)
} else if( class(x) == "histogram"){
## Notice: the color of the bars can ONLY be set width bdp(hcol="color").
plot(x,
xlab=xlab, ylab=ylab,
main=prm$main,
xaxt=xaxt,yaxt=yaxt,col=bdp()$hcol,
border=border,
...)
} else if( class(x) == "trellis"){
## Not cleaned up/checked
## very experimental
cat("The Bacher/Delff Plotting System (R), (C), TM operating in lattice mode.\n Remeber that labels must written in the lattice object.\n")
##lattice.options(layout.widths = prm$lattice.width,
## layout.heights = prm$lattice.height)
trellis.par.set(prm$myLatticeSettings())
plot(x,col=col,...)
## with lattice/trellis, the axis drawing doesn't work.
draw.xaxis <- FALSE
draw.yaxis <- FALSE
} else if (class(x)=="princomp") {
if(prm$debug)
cat("The Bacher/Delff Plotting System operating in princomp plotting mode.\n")
plot(x,
main=prm$main,
...)
} else if (prm$method=="image.plot"){
### This could be checked in the beginning by is.null(z)
}
###Grid stuff
## This really hould be done before adding the rest of the plot contents.
## We could make default values for grid.v og grid.h. Man maa kunne lave noget kvalificeret ud fra range og noget heltalsdivision
if( prm$grid ){
grid(col=prm$grid.col)
}
## vertical lines
if( !is.na(prm$grid.v) ){
if(prm$grid.v=="Def"){
grid(nx=NULL,ny=NA,col=prm$grid.col)
} else
{
abline(v=prm$grid.v, lty="dotted", col=prm$grid.col)
}
}
if( !is.na(prm$grid.h) ){
if(prm$grid.h=="Def"){
grid(nx=NA,ny=NULL,col=prm$grid.col)
}else{
abline(h=prm$grid.h, lty="dotted", col=prm$grid.col)}
}
### Axis stuff This part should be improved. A function that draws
### axis should be run for all four axis. And it should be possible to
### supply whatever vector to base it on (especially relevant for
### taxis and raxis)
## this is because the use of mgp gives a ridiculous warning when too small
options(warn=-1)
if(draw.xaxis){
## mgp.old <- par()$mgp
## par(mgp) <- mgp.xaxis
## is the abscissa a time object?
if( "POSIXt"%in%class(x[1])){
axis.POSIXct(1, x,mgp=prm$mgp.xaxis, lwd=prm$lwd)
} else {
axis(1, mgp=prm$mgp.xaxis, lwd=prm$lwd)
}
}
if(draw.yaxis){ axis(2, y,mgp=prm$mgp.yaxis, lwd=prm$lwd) }
## top axis
if(prm$draw.taxis){ axis(3, mgp=prm$mgp.taxis, lwd=prm$lwd) }
## axis to the right
if(prm$draw.raxis){ axis(4, mgp=prm$mgp.raxis, lwd=prm$lwd) }
## switch back on warnings
options(warn=0)
##Title stuff
## Hvorfor??
scale <- 1
## if( prm$type=="hist" & !is.na(prm$xlab) )
# if( !is.na(prm$xlab) ){ mtext(prm$xlab, line=prm$xlabLine, side=1, cex=prm$cex.lab/scale) }
## if( prm$type=="hist" &!is.na(prm$ylab) )
# if( !is.na(prm$ylab) ){ mtext(prm$ylab, line=prm$ylabLine, side=2, cex=prm$cex.lab/scale) }
if( !is.na(prm$toplab) ){ mtext(prm$toplab, side=3, line=0.25, cex=prm$cex.lab/scale) }
if( !is.na(prm$rightlab) ){
mtext(prm$rightlab, side=4, line=0.75, cex=prm$cex.lab/scale,mgp=prm$mgp.raxis)
## mtext(rightlab, side=4, line=0.5, cex=bdp()$cex.lab,mgp=bdp()$mgp.raxis)
}
}