WebSVN – bdplot – Diff – /bdgraphics/R/4_bdplot.R

 ### 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",
-                   yaxt="n",
+                   xaxt=bdp()$xaxt,yaxt=bdp()$yaxt,
                    xlab=bdp()$xlab, ylab=bdp()$ylab,
-                   xlim=NULL,
-                   ylim=NULL,
+                   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
+ ##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.xaxis <- ifelse(xaxt=="n",prm$draw.xaxis,FALSE)
-  prm$draw.yaxis <- ifelse(yaxt=="n",prm$draw.yaxis,FALSE)
+  #prm$draw.yaxis <- ifelse(yaxt=="n",prm$draw.yaxis,FALSE)
   ## Do the plot
   if(!is.null(y)){
-    if(prm$debug)
-      cat("The Bacher/Delff Plotting System (R), (C), TM operating in xy-plotting mode.\n")
+    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))
+      if(is.null(xlim))
       xlim <- range(x,bdp()$xlim,na.rm=TRUE)
-    if(is.null(ylim))
+      if(is.null(ylim))
-      ylim <- range(y,bdp()$ylim,na.rm=TRUE)
+        ylim <- range(y,bdp()$ylim,na.rm=TRUE)
-    plot(x, y,
+      plot(x, y,
-         type=type,
+           type=type,
-         xaxt=xaxt, yaxt=yaxt,
+           xaxt=xaxt, yaxt=yaxt,
-         cex=cex.plot,
+           cex=cex.plot,
-         xlab=xlab,
+           xlab=xlab,
-         ylab=ylab,
+           ylab=ylab,
-         xlim=xlim,
+           xlim=xlim,
-         ylim=ylim,
+           ylim=ylim,
-         col=col,
+           col=col,
-         main=main,
+           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,
               ...)
-      prm$draw.xaxis <- FALSE
+      draw.xaxis <- FALSE
-      prm$draw.yaxis <- 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.
-    prm$draw.xaxis <- FALSE
+    draw.xaxis <- FALSE
-    prm$draw.yaxis <- 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)
-    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,
-               ...)
   }
 ###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(prm$draw.xaxis){
+  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(prm$draw.yaxis){ axis(2, y,mgp=prm$mgp.yaxis, 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)
+  }
+}

Subversion Repositories bdplot

(root)/bdgraphics/R/4_bdplot.R – Rev 33 → 34