Subversion Repositories bdplot

Rev

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

Rev 33 Rev 34
Line 1... Line 1...
1
### bdplot.R
1
### bdplot.R
2
#### This is a collection of functions that must bpre reachable by the user This is called 
2
#### This is a collection of functions that must bpre reachable by the user This is called 
3
 
3
 
4
 
4
 
5
 
-
 
6
## strategy missing for xytype
5
## strategy missing for xytype
7
## 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()?
8
bdplot <- function(x, y=NULL, z=NULL,
7
bdplot <- function(x, y=NULL, z=NULL,
9
                   ## The rest is irrelevant for the user
8
                   ## The rest is irrelevant for the user
10
                   cex.plot=bdp()$cex.plot,
9
                   cex.plot=bdp()$cex.plot,
11
                   xaxt="n",
-
 
12
                   yaxt="n",
10
                   xaxt=bdp()$xaxt,yaxt=bdp()$yaxt,
13
                   xlab=bdp()$xlab, ylab=bdp()$ylab,
11
                   xlab=bdp()$xlab, ylab=bdp()$ylab,
14
                   xlim=NULL,
-
 
15
                   ylim=NULL,
12
                   xlim=NULL,ylim=NULL,
16
                   col=bdp()$col,main=NULL,
13
                   col=bdp()$col,main=NULL,
17
                   ## only used in case of plot mode
14
                   ## only used in case of plot mode
18
                   type=bdp()$type,
15
                   type=bdp()$type,
19
                   ## Only used in case of histogram plotting
16
                   ## Only used in case of histogram plotting
20
                   border=bdp()$border,
17
                   border=bdp()$border,
Line 26... Line 23...
26
  par(cex.main=prm$cex.main, cex.lab=prm$cex.lab, cex.axis=prm$cex.axis)
23
  par(cex.main=prm$cex.main, cex.lab=prm$cex.lab, cex.axis=prm$cex.axis)
27
  par(tcl=prm$tcl)
24
  par(tcl=prm$tcl)
28
  par(lwd=prm$lwd)
25
  par(lwd=prm$lwd)
29
  par(bty=prm$bty)
26
  par(bty=prm$bty)
30
 
27
 
31
  
28
 
32
  ##Set margins
29
 ##Set margins
33
  mar <- prm$mar.nolab
30
  mar <- prm$mar.nolab
34
  if( !is.na(prm$xlab) ){ mar[1] <- prm$mar.lab[1] }
31
  if( !is.na(prm$xlab) ){ mar[1] <- prm$mar.lab[1] }
35
  if( !is.na(prm$ylab) ){ mar[2] <- prm$mar.lab[2] }
32
  if( !is.na(prm$ylab) ){ mar[2] <- prm$mar.lab[2] }
36
  if( any(!is.na(prm$toplab),!is.null(main)) ) { mar[3] <- prm$mar.lab[3] }
33
  if( any(!is.na(prm$toplab),!is.null(main)) ) { mar[3] <- prm$mar.lab[3] }
37
  if( !is.na(prm$rightlab) ){ mar[4] <- prm$mar.lab[4] }
34
  if( !is.na(prm$rightlab) ){ mar[4] <- prm$mar.lab[4] }
38
  par(mar=mar)
35
  par(mar=mar)
39
 
36
 
40
  par(mgp=prm$mgp.global)
37
  par(mgp=prm$mgp.global)
-
 
38
  
-
 
39
### xaxt and yaxt can be set to "axis" which is the special case where the axis is drawn with the axius
-
 
40
  if(xaxt=="axis"){
-
 
41
    xaxt <- "n"
-
 
42
    draw.xaxis <- TRUE
-
 
43
  } else {
-
 
44
    draw.xaxis <- FALSE
-
 
45
  }
-
 
46
  if(yaxt=="axis"){
-
 
47
    yaxt <- "n"
-
 
48
    draw.yaxis <- TRUE
-
 
49
  } else {
-
 
50
    draw.yaxis <- FALSE
-
 
51
  }
-
 
52
  
-
 
53
 
41
 
54
 
42
  ## if xaxt or yaxt set, axis are drawn automatically in the plot command. Then it should not be done with axis() later
55
  ## if xaxt or yaxt set, axis are drawn automatically in the plot command. Then it should not be done with axis() later
43
  prm$draw.xaxis <- ifelse(xaxt=="n",prm$draw.xaxis,FALSE)
56
  #prm$draw.xaxis <- ifelse(xaxt=="n",prm$draw.xaxis,FALSE)
44
  prm$draw.yaxis <- ifelse(yaxt=="n",prm$draw.yaxis,FALSE)
57
  #prm$draw.yaxis <- ifelse(yaxt=="n",prm$draw.yaxis,FALSE)
45
  
58
  
46
  ## Do the plot
59
  ## Do the plot
47
  if(!is.null(y)){
60
  if(!is.null(y)){
48
    if(prm$debug)
-
 
49
      cat("The Bacher/Delff Plotting System (R), (C), TM operating in xy-plotting mode.\n")
-
 
50
 
61
 
-
 
62
    if(!is.null(z)){
-
 
63
      if(prm$debug)
-
 
64
        cat("bdgraphics operating in image plotting mode.\nx and y axis can not be configured.\n")
-
 
65
      image(x=x,y=y,z=z,
-
 
66
            xlab=xlab,
-
 
67
            ylab=ylab,
-
 
68
            ...)
-
 
69
    } else {
-
 
70
      if(prm$debug)
-
 
71
        cat("The Bacher/Delff Plotting System (R), (C), TM operating in xy-plotting mode.\n")
-
 
72
      
-
 
73
      ## this is ugly, non standard.
51
    if(is.null(xlim))
74
      if(is.null(xlim))
52
      xlim <- range(x,bdp()$xlim,na.rm=TRUE)
75
      xlim <- range(x,bdp()$xlim,na.rm=TRUE)
53
    if(is.null(ylim))
76
      if(is.null(ylim))
54
      ylim <- range(y,bdp()$ylim,na.rm=TRUE)
77
        ylim <- range(y,bdp()$ylim,na.rm=TRUE)
55
    
78
      
56
    plot(x, y,
79
      plot(x, y,
57
         type=type,
80
           type=type,
58
         xaxt=xaxt, yaxt=yaxt,
81
           xaxt=xaxt, yaxt=yaxt,
59
         cex=cex.plot,
82
           cex=cex.plot,
60
         xlab=xlab,
83
           xlab=xlab,
61
         ylab=ylab,
84
           ylab=ylab,
62
         xlim=xlim,
85
           xlim=xlim,
63
         ylim=ylim,
86
           ylim=ylim,
64
         col=col,
87
           col=col,
65
         main=main,
88
           main=main,
66
         ...)
89
           ...)
-
 
90
    }
67
  } else if (is.numeric(x)){
91
  } else if (is.numeric(x)){
68
    if(prm$method=="barplot"){
92
    if(prm$method=="barplot"){
-
 
93
      if(prm$debug)
-
 
94
        cat("The Bacher/Delff Plotting System (R), (C), TM operating in barplot mode.\n")
69
      ## this does not provide the full x,y functionality of barplot
95
      ## this does not provide the full x,y functionality of barplot
70
      barplot(height=x,
96
      barplot(height=x,
71
              ## maybe these two are wrong/stupid?
97
              ## maybe these two are wrong/stupid?
72
              cex.axis=prm$cex.lab,
98
              cex.axis=prm$cex.lab,
73
              cex.names=prm$cex.lab,
99
              cex.names=prm$cex.lab,
Line 75... Line 101...
75
              border=border,
101
              border=border,
76
              xlab=xlab,
102
              xlab=xlab,
77
              ylab=ylab,
103
              ylab=ylab,
78
              main=main,
104
              main=main,
79
              ...)
105
              ...)
80
      prm$draw.xaxis <- FALSE
106
      draw.xaxis <- FALSE
81
      prm$draw.yaxis <- FALSE
107
      draw.yaxis <- FALSE
82
      
108
      
83
    } else {
109
    } else {
84
 
-
 
-
 
110
      if(prm$debug)
-
 
111
        cat("The Bacher/Delff Plotting System operating in xy-plotting mode, only plotting x.\n")
85
      if(is.null(xlim))
112
      if(is.null(xlim))
86
        xlim <- range(c(1:length(x),bdp()$xlim),na.rm=TRUE)
113
        xlim <- range(c(1:length(x),bdp()$xlim),na.rm=TRUE)
87
 
114
      
88
      if(is.null(ylim))
115
      if(is.null(ylim))
89
        ylim <- range(x,bdp()$ylim,na.rm=TRUE)
116
        ylim <- range(x,bdp()$ylim,na.rm=TRUE)
90
      
117
      
91
      plot(x,
118
      plot(x,
92
           type=type,
119
           type=type,
Line 118... Line 145...
118
    ##lattice.options(layout.widths = prm$lattice.width,
145
    ##lattice.options(layout.widths = prm$lattice.width,
119
    ##                layout.heights = prm$lattice.height)
146
    ##                layout.heights = prm$lattice.height)
120
    trellis.par.set(prm$myLatticeSettings()) 
147
    trellis.par.set(prm$myLatticeSettings()) 
121
    plot(x,col=col,...)
148
    plot(x,col=col,...)
122
    ## with lattice/trellis, the axis drawing doesn't work.
149
    ## with lattice/trellis, the axis drawing doesn't work.
123
    prm$draw.xaxis <- FALSE
150
    draw.xaxis <- FALSE
124
    prm$draw.yaxis <- FALSE
151
    draw.yaxis <- FALSE
125
  } else if (class(x)=="princomp") {
152
  } else if (class(x)=="princomp") {
-
 
153
    if(prm$debug)
-
 
154
      cat("The Bacher/Delff Plotting System operating in princomp plotting mode.\n")
126
    plot(x,
155
    plot(x,
127
         main=prm$main,
156
         main=prm$main,
128
         ...)
157
         ...)
129
  } else if (prm$method=="image.plot"){
158
  } else if (prm$method=="image.plot"){
130
    ### This could be checked in the beginning by is.null(z)
159
    ### This could be checked in the beginning by is.null(z)
131
    cat("The Bacher/Delff Plotting System (R), (C), TM operating in image plotting mode.\nx and y axis can not be configured.\n")
-
 
132
    image.plot(x=x,y=y,z=z,
-
 
133
               xlab=xlab,
-
 
134
               ylab=ylab,
-
 
135
               ...)
-
 
136
  } 
160
  }
137
  
161
  
138
###Grid stuff
162
###Grid stuff
139
  ## This really hould be done before adding the rest of the plot contents.
163
  ## This really hould be done before adding the rest of the plot contents.
140
  ## We could make default values for grid.v og grid.h. Man maa kunne lave noget kvalificeret ud fra range og noget heltalsdivision
164
  ## We could make default values for grid.v og grid.h. Man maa kunne lave noget kvalificeret ud fra range og noget heltalsdivision
141
  
165
  
Line 164... Line 188...
164
### supply whatever vector to base it on (especially relevant for
188
### supply whatever vector to base it on (especially relevant for
165
### taxis and raxis)
189
### taxis and raxis)
166
  
190
  
167
  ## this is because the use of mgp gives a ridiculous warning when too small
191
  ## this is because the use of mgp gives a ridiculous warning when too small
168
  options(warn=-1)
192
  options(warn=-1)
169
  if(prm$draw.xaxis){
193
  if(draw.xaxis){
170
    ##    mgp.old <- par()$mgp
194
    ##    mgp.old <- par()$mgp
171
    ##    par(mgp) <- mgp.xaxis
195
    ##    par(mgp) <- mgp.xaxis
172
    ## is the abscissa a time object?
196
    ## is the abscissa a time object?
173
    if( "POSIXt"%in%class(x[1])){
197
    if( "POSIXt"%in%class(x[1])){
174
      axis.POSIXct(1, x,mgp=prm$mgp.xaxis, lwd=prm$lwd)
198
      axis.POSIXct(1, x,mgp=prm$mgp.xaxis, lwd=prm$lwd)
Line 176... Line 200...
176
      axis(1, mgp=prm$mgp.xaxis, lwd=prm$lwd)
200
      axis(1, mgp=prm$mgp.xaxis, lwd=prm$lwd)
177
    }
201
    }
178
    
202
    
179
  }
203
  }
180
 
204
 
181
  if(prm$draw.yaxis){ axis(2, y,mgp=prm$mgp.yaxis, lwd=prm$lwd) }
205
  if(draw.yaxis){ axis(2, y,mgp=prm$mgp.yaxis, lwd=prm$lwd) }
182
  ## top axis
206
  ## top axis
183
  if(prm$draw.taxis){ axis(3, mgp=prm$mgp.taxis, lwd=prm$lwd) }
207
  if(prm$draw.taxis){ axis(3, mgp=prm$mgp.taxis, lwd=prm$lwd) }
184
  ## axis to the right
208
  ## axis to the right
185
  if(prm$draw.raxis){ axis(4, mgp=prm$mgp.raxis, lwd=prm$lwd) }
209
  if(prm$draw.raxis){ axis(4, mgp=prm$mgp.raxis, lwd=prm$lwd) }
186
 
210