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=bdp()$xaxt,yaxt=bdp()$yaxt,
-                   xaxt.in=NULL,yaxt.in=NULL,
+                   xaxt.in=bdp()$xaxt.in,yaxt.in=bdp()$xaxt.in,
                    xlab=bdp()$xlab, ylab=bdp()$ylab,
-                   xlim=NULL,ylim=NULL,
+                   xlim=bdp()$xlim,ylim=bdp()$ylim,
                    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,
                    ...)
+{
+  ## experimental. Is this the right consequence of not having a
+  ## device opened?
+  if(length(dev.list())==0){
+    cat("No graphics device is initialised. Running bdopen() without arguments.\n")
+    bdopen()
+  }
   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(class(xaxt)=="function") {
     if(prm$debug)
       print(class(x))
-    if(is.null(xaxt.in)){
+    if(is.null(xaxt.in))
-      xinterval <- x
+      xaxt.in <- x
-    } else {
-      xinterval <- xax.in
-    }
     draw.xaxis <- "fun"
     xaxt.fun <- xaxt
     xaxt <- "n"
   } else if(xaxt=="axis"){
     xaxt <- "n"
     draw.xaxis <- TRUE
   } else {
     draw.xaxis <- FALSE
+  }
   if(class(yaxt)=="function") {
     yaxt(ifelse(is.null(yaxt.in),range(y),yaxt.in))
     draw.yaxis <- FALSE
   } else 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)
+### this variable needs to be initialized
-  #prm$draw.yaxis <- ifelse(yaxt=="n",prm$draw.yaxis,FALSE)
+  addcase <- NULL
   ## 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)
+        xlim <- range(x,na.rm=TRUE) #,bdp()$xlim,na.rm=TRUE)
       if(is.null(ylim))
-        ylim <- range(y,bdp()$ylim,na.rm=TRUE)
+        ylim <- range(y,na.rm=TRUE) #,bdp()$ylim,na.rm=TRUE)
       plot(x, y,
-           type=type,
+           type="n",
            xaxt=xaxt, yaxt=yaxt,
            cex=cex.plot,
            xlab=xlab,
            ylab=ylab,
            xlim=xlim,
            ylim=ylim,
-           col=col,
            main=main,
            ...)
+      addcase <- "plotxy"
+    }
   } 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)
+        xlim <- c(1,length(x))#,bdp()$xlim),na.rm=TRUE)
       if(is.null(ylim))
-        ylim <- range(x,bdp()$ylim,na.rm=TRUE)
+        ylim <- range(x,na.rm=TRUE)#,bdp()$ylim,na.rm=TRUE)
       plot(x,
-           type=type,
+           type="n",
            xaxt=xaxt, yaxt=yaxt,
            cex=cex.plot,
            xlab=xlab,
            ylab=ylab,
            xlim=xlim,
            ylim=ylim,
-           col=col,
            main=main,
            ...)
+      addcase <- "plotx"
+    }
   } 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)}
+    }
+### Now, grid has bee drawn. Then contents can be added.
+ ## add support for more cases!
+  if(!is.null(addcase)){
+    if(addcase=="plotxy") {
+      bdpoints(x, y,
+               type=type,
+               cex=cex.plot,
+               xlim=xlim,
+               ylim=ylim,
+               col=col,
+               ...)
+    } else if (addcase=="plotx"){
+      bdpoints(x, y,
+               type=type,
+               cex=cex.plot,
+               xlim=xlim,
+               ylim=ylim,
+               col=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=="fun"){
-    xaxt.fun(xinterval)
+    xaxt.fun(xaxt.in)
   } else if(draw.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)
+  }
+}

Subversion Repositories bdplot

(root)/bdgraphics/R/4_bdplot.R – Rev 35 → 36