Subversion Repositories bdplot

Rev

Rev 54 | Rev 56 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 54 Rev 55
Line 28... Line 28...
28 
  if(length(dev.list())==0){
 28 
  if(length(dev.list())==0){
29 
    cat("No graphics device is initialised. Running bdopen() without arguments.\n")
 29 
    cat("No graphics device is initialised. Running bdopen() without arguments.\n")
30 
    bdopen()
 30 
    bdopen()
31 
  }
 31 
  }
32
32
33 
 
 - 
 
- 
 
 33 
## we'd like to be able to setup the plotting device from different functions. It's better to use bdp() to handle values then.
- 
 
 34 
  bdp(xlab=xlab,ylab=ylab,rlab=rlab,tlab=tlab,
- 
 
 35 
      cex.plot=cex.plot)
34
36
35 
  prm <- bdp()
 37 
  prm <- bdp()
36 
 
 38 
 
- 
 
 39 
############# init starts - to be put in seperate function?
- 
 
 40
37 
## It's a mess to set cex.lab here. Or it should not be set in
 41 
## It's a mess to set cex.lab here. Or it should not be set in
38 
##  functions calls. If set both ways, it's scaled twice, meaning that
 42 
##  functions calls. If set both ways, it's scaled twice, meaning that
39 
##  we don't know how to make it fit with mtext for eg rlab.
 43 
##  we don't know how to make it fit with mtext for eg rlab.
40 
  par(cex.main=prm$cex.main, cex.lab=prm$cex.lab,
 44 
  par(cex.main=prm$cex.main, cex.lab=prm$cex.lab,
41 
  cex.axis=prm$cex.axis)
 45 
  cex.axis=prm$cex.axis)
42 
##   par(cex.main=prm$cex.main, cex.axis=prm$cex.axis)
 - 
 
- 
 
 46 
 
43 
  par(tcl=prm$tcl)
 47 
  par(tcl=prm$tcl)
44 
  par(lwd=prm$lwd)
 48 
  par(lwd=prm$lwd)
45 
  par(bty=prm$bty)
 49 
  par(bty=prm$bty)
46 
 
 50 
 
47 
 
 51 
 
- 
 
 52 
 ##Set margins. If mar is set, then that should be used.
- 
 
 53 
  if (!is.null(prm$mar)){
48 
 ##Set margins
 54 
    print(prm$mar)
49 
  mar <- prm$mar.nolab
 55 
    mar <- prm$mar
- 
 
 56 
  } else {
50 
 
 57 
 
51 
  detmar <- function(idx,lab){
 58 
    detmar <- function(idx,lab){
52 
    if (is.null(lab)) {
 59 
      if (is.null(lab)) {
53 
      mar <- prm$mar.lab[idx]
 60 
        mar <- prm$mar.lab[idx]
54 
    } else if(all(is.na(lab))) {
 61 
      } else if(all(is.na(lab))) {
55 
      mar <- prm$mar.nolab[idx]
 62 
        mar <- prm$mar.nolab[idx]
56 
    } else {
 63 
      } else {
57 
      mar <- prm$mar.lab[idx]
 64 
        mar <- prm$mar.lab[idx]
- 
 
 65 
      }
- 
 
 66 
      return(mar)
58 
    }
 67 
    }
59 
    mar
 - 
 
60 
  }
 - 
 
61 
  mar[1] <- detmar(1,xlab)
 68 
    mar <- c(detmar(1,xlab),
62 
  mar[2] <- detmar(2,ylab)
 69 
             detmar(2,ylab),
63 
  mar[3] <- detmar(3,tlab)
 70 
             detmar(3,tlab),
64 
  mar[4] <- detmar(4,rlab)
 71 
             detmar(4,rlab))
65
72
66 
  ## if( any(!is.na(prm$toplab),!is.null(main)) ) { mar[3] <- prm$mar.lab[3] }
 - 
 
67 
  ## if( !is.na(prm$rightlab) ){ mar[4] <- prm$mar.lab[4] }
 - 
 
- 
 
 73 
  }
68 
  par(mar=mar)
 74 
  par(mar=mar)
69 
 
 75 
 
70 
  par(mgp=prm$mgp.global)
 76 
  par(mgp=prm$mgp.global)
- 
 
 77 
 
- 
 
 78 
########### init done
- 
 
 79 
 
71
80
72 
### xaxt and yaxt can be set to "axis" which is the special case where the axis is drawn with the axis
 81 
### xaxt and yaxt can be set to "axis" which is the special case where the axis is drawn with the axis
73 
  if(class(xaxt)=="function") {
 82 
  if(class(xaxt)=="function") {
74 
 
 83 
 
75 
    if(prm$debug)
 - 
 
76 
      print(class(x))
 - 
 
77 
 
 - 
 
78 
    if(is.null(xaxt.in))
 84 
    if(is.null(xaxt.in))
79 
      xaxt.in <- x
 85 
      xaxt.in <- x
80
86
81
- 
 
82 
    draw.xaxis <- "fun"
 87 
    draw.xaxis <- "fun"
83 
    xaxt.fun <- xaxt
 88 
    xaxt.fun <- xaxt
84 
    xaxt <- "n"
 89 
    xaxt <- "n"
85 
  } else if(xaxt=="axis"){
 90 
  } else if(xaxt=="axis"){
86 
    xaxt <- "n"
 91 
    xaxt <- "n"
Line 126... Line 131...
126 
      xlabel <- if (!missing(x))
131 
      xlabel <- if (!missing(x))
127 
        deparse(substitute(x))
 132 
        deparse(substitute(x))
128 
      ylabel <- if (!missing(y))
133 
      ylabel <- if (!missing(y))
129 
        deparse(substitute(y))
 134 
        deparse(substitute(y))
130 
      ##       xy <- xy.coords(x, y, xlabel, ylabel, log)
 135 
      ##       xy <- xy.coords(x, y, xlabel, ylabel, log)
131 
      xlab <- if (is.null(xlab))
136 
      xlab <- ifelse(is.null(xlab), xlabel, xlab)
132 
        xlabel
 - 
 
133 
      else xlab
 - 
 
134 
      ylab <- if (is.null(ylab))
137 
      ylab <- ifelse(is.null(ylab), ylabel, ylab)
135 
        ylabel
 - 
 
136 
      else ylab
 - 
 
137 
 
 138 
 
138 
      ## here we make the empty plot
 139 
      ## here we make the empty plot
139 
      plot(x, y,
 140 
      plot(x, y,
140 
           type="n",
 141 
           type="n",
141 
           xaxt=xaxt, yaxt=yaxt,
 142 
           xaxt=xaxt, yaxt=yaxt,
Line 223... Line 224...
223 
    par(mar=c(2,2,2,.3))
 224 
    par(mar=c(2,2,2,.3))
224 
    par(oma = c(0, 0, 0, 0))
 225 
    par(oma = c(0, 0, 0, 0))
225 
    par(cex=0.4)
 226 
    par(cex=0.4)
226 
    ### cex.caption is the title over each plot, cex.id magnification of point labels. What is eg "Cook's distance" written inside the plots?
 227 
    ### cex.caption is the title over each plot, cex.id magnification of point labels. What is eg "Cook's distance" written inside the plots?
227 
    plot.lm(x,cex.caption=cex.sub,cex.id=.5)##,cex=cex.plot)
 228 
    plot.lm(x,cex.caption=cex.sub,cex.id=.5)##,cex=cex.plot)
- 
 
 229 
  }  else if (class(x)=="data.frame") {
- 
 
 230 
    print("data.frame mode")
- 
 
 231 
    plot(x,main=prm$main,
- 
 
 232 
         xaxt=xaxt,yaxt=yaxt)
228 
  } else if (prm$method=="image.plot"){
 233 
  }else if (prm$method=="image.plot"){
229 
    ### This could be checked in the beginning by is.null(z)
 234 
    ### This could be checked in the beginning by is.null(z)
230 
  }
 235 
  }
231
236
232 
###Grid stuff
 237 
###Grid stuff
233 
  ## This really hould be done before adding the rest of the plot contents.
 238 
  ## This really hould be done before adding the rest of the plot contents.
Line 311... Line 316...
311 
  ##  if( prm$type=="hist" & !is.na(prm$xlab) )
 316 
  ##  if( prm$type=="hist" & !is.na(prm$xlab) )
312 
#  if( !is.na(prm$xlab)  ){ mtext(prm$xlab, line=prm$xlabLine, side=1, cex=prm$cex.lab/scale) }
 317 
#  if( !is.na(prm$xlab)  ){ mtext(prm$xlab, line=prm$xlabLine, side=1, cex=prm$cex.lab/scale) }
313 
  ##  if( prm$type=="hist" &!is.na(prm$ylab) )
 318 
  ##  if( prm$type=="hist" &!is.na(prm$ylab) )
314 
#  if( !is.na(prm$ylab)  ){ mtext(prm$ylab, line=prm$ylabLine, side=2, cex=prm$cex.lab/scale) }
 319 
#  if( !is.na(prm$ylab)  ){ mtext(prm$ylab, line=prm$ylabLine, side=2, cex=prm$cex.lab/scale) }
315 
  if( !is.na(prm$tlab) ){ mtext(prm$tlab, side=3, line=0.25, cex=prm$cex.lab/scale) }
 320 
  if( !is.na(prm$tlab) ){ mtext(prm$tlab, side=3, line=0.25, cex=prm$cex.lab/scale) }
316 
  if( !is.na(prm$rlab) ){
 321 
  if( !is.na(rlab) ){
317 
    mtext(prm$rlab, side=4, line=0.75, cex=prm$cex.lab/scale,mgp=prm$mgp.raxis)
 322 
    mtext(prm$rlab, side=4, line=0.75, cex=prm$cex.lab/scale,mgp=prm$mgp.raxis)
318 
  }
 323 
  }
319 
}
 324 
}
320 
 
 325 
 
321 
 
 326