Rev 5 | Rev 8 | 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="n",
xlab=bdp()$xlab, ylab=bdp()$ylab,
xlim=range(x,bdp()$xlim,na.rm=TRUE),
ylim=range(bdp()$ylim,y,na.rm=TRUE),
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()
##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)
## Do the plot
## the method variable could be used more intelligently. If x is numeric, only three methods are possible: plot, barplot, image.plot.
## maybe this check can be skipped. I guess x and y can just be deleted from these commands
## if( prm$method=="xy"){
if(!is.null(y)){
## cat("The Bacher/Delff Plotting System (R), (C), TM operating in xy-plotting mode.\n")
plot(x, y,
type=type,
xaxt=xaxt, yaxt="n",
cex=cex.plot,
xlab=xlab,
ylab=ylab,
xlim=xlim,
ylim=ylim,
col=col,
main=main,
...)
} else if (is.numeric(x)){
if(prm$method=="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,
...)
prm$draw.xaxis <- FALSE
prm$draw.yaxis <- FALSE
} else {
plot(x,
type=type,
xaxt="n", yaxt="n",
cex=cex.plot,
xlab=xlab,
ylab=ylab,
ylim=xlim,
col=col,
main=main,
...)
}
} else if( class(x) == "acf"){
## Not cleaned up/checked
plot(x, xlab="", ylab="", xaxt="n", yaxt="n", 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 with bdp(hcol="color").
plot(x,
xlab=xlab, ylab=ylab,
main=prm$main,
xaxt="n",yaxt="n",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.
prm$draw.xaxis <- FALSE
prm$draw.yaxis <- FALSE
}
else if (prm$method=="image.plot"){
cat("The Bacher/Delff Plotting System (R), (C), TM operating in image plotting mode.\nx and y axis can not be configured.\n")
image.plot(x=x,y=y,z=z,
xlab=xlab,
ylab=ylab,
...)
}
## We could make default values for grid.v og grid.h. Man maa kunne lave noget kvalificeret ud fra range og noget heltalsdivision
##Grid stuff
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
if(prm$draw.xaxis){
## mgp.old <- par()$mgp
## par(mgp) <- mgp.xaxis
options(warn=-1)
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)
}
options(warn=0)
}
if(prm$draw.yaxis){ axis(2, mgp=prm$mgp.yaxis, lwd=prm$lwd) }
##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$xxlab, side=3, line=0.25, cex=prm$cex.lab/scale) }
if( !is.na(prm$rightlab) ){ mtext(prm$yylab, side=4, line=0.25, cex=prm$cex.lab/scale) }
}
## a function to add points or lines to a plot. det kan skrives meget
## paenere, om en streng indeholder en karakter.
## grep("l",type)
bdxyadd <- function(x,y=NULL,type=bdp()$type,lwd=bdp()$lwd,pch=bdp()$pch,col=bdp()$col,...){
prm <- .bdgetpars()
if(any(type=="p",type=="l",type=="s")){
if(!is.null(y)){
points(x,y,cex=prm$cex.plot,pch=prm$pch,type=type,col=col,...)
} else {
points(x,cex=prm$cex.plot,pch=prm$pch,col=col,type=type,...)
}
} else if (type=="lp"|type=="pl"){
if(!is.null(y)){
points(x,y,cex=prm$cex.plot,pch=prm$pch,col=col,...)
lines(x,y,lwd=lwd,col=col,...)
} else {
points(x,cex=prm$cex.plot,pch=prm$pch,col=col,...)
lines(x,lwd=lwd,col=col,...)
}
}
}
bdlegend <- function(legend,cex=bdp()$cex.legend,x=bdp()$pos.legend,bg=bdp()$bg.legend,col=bdp()$col,...){
prm <- .bdgetpars()
## dette er noget rod med baade x og pos, hvis man giver begge dele fucker det op.
legend(x=x,
cex=cex,
legend=legend,
bg=bg,
col=col,
...)
}