Subversion Repositories bdplot

Rev

Rev 35 | Rev 37 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 35 Rev 36
Line 6... Line 6...
6 
## Could we test if there is an active graphics device? And if not, run bdopen()?
 6 
## Could we test if there is an active graphics device? And if not, run bdopen()?
7 
bdplot <- function(x, y=NULL, z=NULL,
 7 
bdplot <- function(x, y=NULL, z=NULL,
8 
                   ## The rest is irrelevant for the user
 8 
                   ## The rest is irrelevant for the user
9 
                   cex.plot=bdp()$cex.plot,
 9 
                   cex.plot=bdp()$cex.plot,
10 
                   xaxt=bdp()$xaxt,yaxt=bdp()$yaxt,
 10 
                   xaxt=bdp()$xaxt,yaxt=bdp()$yaxt,
11 
                   xaxt.in=NULL,yaxt.in=NULL,
 11 
                   xaxt.in=bdp()$xaxt.in,yaxt.in=bdp()$xaxt.in,
12 
                   xlab=bdp()$xlab, ylab=bdp()$ylab,
 12 
                   xlab=bdp()$xlab, ylab=bdp()$ylab,
13 
                   xlim=NULL,ylim=NULL,
 13 
                   xlim=bdp()$xlim,ylim=bdp()$ylim,
14 
                   col=bdp()$col,main=NULL,
 14 
                   col=bdp()$col,main=NULL,
15 
                   ## only used in case of plot mode
 15 
                   ## only used in case of plot mode
16 
                   type=bdp()$type,
 16 
                   type=bdp()$type,
17 
                   ## Only used in case of histogram plotting
 17 
                   ## Only used in case of histogram plotting
18 
                   border=bdp()$border,
 18 
                   border=bdp()$border,
19 
                   ...)
 19 
                   ...)
20 
{
 20 
{
- 
 
 21 
 
- 
 
 22 
 
- 
 
 23 
  ## experimental. Is this the right consequence of not having a
- 
 
 24 
  ## device opened?
- 
 
 25
- 
 
 26 
  if(length(dev.list())==0){
- 
 
 27 
    cat("No graphics device is initialised. Running bdopen() without arguments.\n")
- 
 
 28 
    bdopen()
- 
 
 29 
  }
- 
 
 30
- 
 
 31 
 
- 
 
 32
21 
  prm <- bdp()
 33 
  prm <- bdp()
22 
 
 34 
 
23 
 
 35 
 
24 
  par(cex.main=prm$cex.main, cex.lab=prm$cex.lab, cex.axis=prm$cex.axis)
 36 
  par(cex.main=prm$cex.main, cex.lab=prm$cex.lab, cex.axis=prm$cex.axis)
25 
  par(tcl=prm$tcl)
 37 
  par(tcl=prm$tcl)
Line 40... Line 52...
40 
### xaxt and yaxt can be set to "axis" which is the special case where the axis is drawn with the axius
 52 
### xaxt and yaxt can be set to "axis" which is the special case where the axis is drawn with the axius
41 
  if(class(xaxt)=="function") {
 53 
  if(class(xaxt)=="function") {
42 
 
 54 
 
43 
    if(prm$debug)
 55 
    if(prm$debug)
44 
      print(class(x))
 56 
      print(class(x))
- 
 
 57 
 
45 
    if(is.null(xaxt.in)){
 58 
    if(is.null(xaxt.in))
46 
      xinterval <- x
 59 
      xaxt.in <- x
47 
    } else {
 60
48 
      xinterval <- xax.in
 - 
 
49 
    }
 61
50 
    draw.xaxis <- "fun"
 62 
    draw.xaxis <- "fun"
51 
    xaxt.fun <- xaxt
 63 
    xaxt.fun <- xaxt
52 
    xaxt <- "n"
 64 
    xaxt <- "n"
53 
  } else if(xaxt=="axis"){
 65 
  } else if(xaxt=="axis"){
54 
    xaxt <- "n"
 66 
    xaxt <- "n"
Line 66... Line 78...
66 
    draw.yaxis <- FALSE
 78 
    draw.yaxis <- FALSE
67 
  }
 79 
  }
68
80
69
81
70 
 
 82 
 
71 
  ## if xaxt or yaxt set, axis are drawn automatically in the plot command. Then it should not be done with axis() later
 - 
 
72 
  #prm$draw.xaxis <- ifelse(xaxt=="n",prm$draw.xaxis,FALSE)
 83 
### this variable needs to be initialized
73 
  #prm$draw.yaxis <- ifelse(yaxt=="n",prm$draw.yaxis,FALSE)
 84 
  addcase <- NULL
74
85
75 
  ## Do the plot
 86 
  ## Do the plot
76 
  if(!is.null(y)){
 87 
  if(!is.null(y)){
77 
 
 88 
 
78 
    if(!is.null(z)){
 89 
    if(!is.null(z)){
Line 86... Line 97...
86 
      if(prm$debug)
 97 
      if(prm$debug)
87 
        cat("The Bacher/Delff Plotting System (R), (C), TM operating in xy-plotting mode.\n")
 98 
        cat("The Bacher/Delff Plotting System (R), (C), TM operating in xy-plotting mode.\n")
88
99
89 
      ## this is ugly, non standard.
 100 
      ## this is ugly, non standard.
90 
      if(is.null(xlim))
 101 
      if(is.null(xlim))
91 
      xlim <- range(x,bdp()$xlim,na.rm=TRUE)
 102 
        xlim <- range(x,na.rm=TRUE) #,bdp()$xlim,na.rm=TRUE)
92 
      if(is.null(ylim))
 103 
      if(is.null(ylim))
93 
        ylim <- range(y,bdp()$ylim,na.rm=TRUE)
 104 
        ylim <- range(y,na.rm=TRUE) #,bdp()$ylim,na.rm=TRUE)
94
105
95 
      plot(x, y,
 106 
      plot(x, y,
96 
           type=type,
 107 
           type="n",
97 
           xaxt=xaxt, yaxt=yaxt,
 108 
           xaxt=xaxt, yaxt=yaxt,
98 
           cex=cex.plot,
 109 
           cex=cex.plot,
99 
           xlab=xlab,
 110 
           xlab=xlab,
100 
           ylab=ylab,
 111 
           ylab=ylab,
101 
           xlim=xlim,
 112 
           xlim=xlim,
102 
           ylim=ylim,
 113 
           ylim=ylim,
103 
           col=col,
 - 
 
104 
           main=main,
 114 
           main=main,
105 
           ...)
 115 
           ...)
- 
 
 116 
 
- 
 
 117 
      addcase <- "plotxy"
- 
 
 118
106 
    }
 119 
    }
107 
  } else if (is.numeric(x)){
 120 
  } else if (is.numeric(x)){
108 
    if(prm$method=="barplot"){
 121 
    if(prm$method=="barplot"){
109 
      if(prm$debug)
 122 
      if(prm$debug)
110 
        cat("The Bacher/Delff Plotting System (R), (C), TM operating in barplot mode.\n")
 123 
        cat("The Bacher/Delff Plotting System (R), (C), TM operating in barplot mode.\n")
Line 123... Line 136...
123 
      draw.yaxis <- FALSE
 136 
      draw.yaxis <- FALSE
124
137
125 
    } else {
 138 
    } else {
126 
      if(prm$debug)
 139 
      if(prm$debug)
127 
        cat("The Bacher/Delff Plotting System operating in xy-plotting mode, only plotting x.\n")
 140 
        cat("The Bacher/Delff Plotting System operating in xy-plotting mode, only plotting x.\n")
- 
 
 141 
 
128 
      if(is.null(xlim))
 142 
      if(is.null(xlim))
129 
        xlim <- range(c(1:length(x),bdp()$xlim),na.rm=TRUE)
 143 
        xlim <- c(1,length(x))#,bdp()$xlim),na.rm=TRUE)
130
144
131 
      if(is.null(ylim))
 145 
      if(is.null(ylim))
132 
        ylim <- range(x,bdp()$ylim,na.rm=TRUE)
 146 
        ylim <- range(x,na.rm=TRUE)#,bdp()$ylim,na.rm=TRUE)
133
147
134 
      plot(x,
 148 
      plot(x,
135 
           type=type,
 149 
           type="n",
136 
           xaxt=xaxt, yaxt=yaxt,
 150 
           xaxt=xaxt, yaxt=yaxt,
137 
           cex=cex.plot,
 151 
           cex=cex.plot,
138 
           xlab=xlab,
 152 
           xlab=xlab,
139 
           ylab=ylab,
 153 
           ylab=ylab,
140 
           xlim=xlim,
 154 
           xlim=xlim,
141 
           ylim=ylim,
 155 
           ylim=ylim,
142 
           col=col,
 - 
 
143 
           main=main,
 156 
           main=main,
144 
           ...)
 157 
           ...)
- 
 
 158 
      addcase <- "plotx"
145 
    }
 159 
    }
146 
  } else if( class(x) == "acf"){
 160 
  } else if( class(x) == "acf"){
147 
    ## Not cleaned up/checked
 161 
    ## Not cleaned up/checked
148 
    plot(x, xlab="", ylab="", xaxt=xaxt, yaxt=yaxt, cex=prm$cex.plot, xlim=prm$xlim, ylim=prm$ylim,col=col,...)
 162 
    plot(x, xlab="", ylab="", xaxt=xaxt, yaxt=yaxt, cex=prm$cex.plot, xlim=prm$xlim, ylim=prm$ylim,col=col,...)
149 
  }  else if( class(x) == "histogram"){
 163 
  }  else if( class(x) == "histogram"){
Line 197... Line 211...
197 
      grid(nx=NA,ny=NULL,col=prm$grid.col)
 211 
      grid(nx=NA,ny=NULL,col=prm$grid.col)
198 
    }else{
 212 
    }else{
199 
      abline(h=prm$grid.h, lty="dotted", col=prm$grid.col)}
 213 
      abline(h=prm$grid.h, lty="dotted", col=prm$grid.col)}
200 
    }
 214 
    }
201 
 
 215 
 
- 
 
 216 
### Now, grid has bee drawn. Then contents can be added.
- 
 
 217 
 ## add support for more cases!
- 
 
 218 
  if(!is.null(addcase)){
- 
 
 219 
    if(addcase=="plotxy") {
- 
 
 220 
      bdpoints(x, y,
- 
 
 221 
               type=type,
- 
 
 222 
               cex=cex.plot,
- 
 
 223 
               xlim=xlim,
- 
 
 224 
               ylim=ylim,
- 
 
 225 
               col=col,
- 
 
 226 
               ...)
- 
 
 227 
    } else if (addcase=="plotx"){
- 
 
 228 
      bdpoints(x, y,
- 
 
 229 
               type=type,
- 
 
 230 
               cex=cex.plot,
- 
 
 231 
               xlim=xlim,
- 
 
 232 
               ylim=ylim,
- 
 
 233 
               col=col,
- 
 
 234 
               ...)
- 
 
 235 
    }
- 
 
 236 
  }
- 
 
 237 
 
202 
### Axis stuff This part should be improved. A function that draws
 238 
### Axis stuff This part should be improved. A function that draws
203 
### axis should be run for all four axis. And it should be possible to
 239 
### axis should be run for all four axis. And it should be possible to
204 
### supply whatever vector to base it on (especially relevant for
 240 
### supply whatever vector to base it on (especially relevant for
205 
### taxis and raxis)
 241 
### taxis and raxis)
206
242
207 
  ## this is because the use of mgp gives a ridiculous warning when too small
 243 
  ## this is because the use of mgp gives a ridiculous warning when too small
208 
  options(warn=-1)
 244 
  options(warn=-1)
209 
  if(draw.xaxis=="fun"){
 245 
  if(draw.xaxis=="fun"){
210 
    xaxt.fun(xinterval)
 246 
    xaxt.fun(xaxt.in)
211 
  } else if(draw.xaxis){
 247 
  } else if(draw.xaxis){
212 
    ## is the abscissa a time object?
 248 
    ## is the abscissa a time object?
213 
    if( "POSIXt"%in%class(x[1])){
 249 
    if( "POSIXt"%in%class(x[1])){
214 
      axis.POSIXct(1, x,mgp=prm$mgp.xaxis, lwd=prm$lwd)
 250 
      axis.POSIXct(1, x,mgp=prm$mgp.xaxis, lwd=prm$lwd)
215 
    } else {
 251 
    } else {