| 5 |
pdel |
1 |
### bdplot.R
|
|
|
2 |
#### This is a collection of functions that must bpre reachable by the user This is called
|
|
|
3 |
|
|
|
4 |
|
|
|
5 |
|
|
|
6 |
## strategy missing for xytype
|
|
|
7 |
## Could we test if there is an active graphics device? And if not, run bdopen()?
|
|
|
8 |
bdplot <- function(x, y=NULL, z=NULL,
|
|
|
9 |
## The rest is irrelevant for the user
|
|
|
10 |
cex.plot=bdp()$cex.plot,
|
|
|
11 |
xaxt="n",
|
|
|
12 |
xlab=bdp()$xlab, ylab=bdp()$ylab,
|
|
|
13 |
xlim=range(x,bdp()$xlim,na.rm=TRUE),
|
|
|
14 |
ylim=range(bdp()$ylim,y,na.rm=TRUE),
|
|
|
15 |
col=bdp()$col,main=NULL,
|
|
|
16 |
## only used in case of plot mode
|
|
|
17 |
type=bdp()$type,
|
|
|
18 |
## Only used in case of histogram plotting
|
|
|
19 |
border=bdp()$border,
|
|
|
20 |
...)
|
|
|
21 |
{
|
|
|
22 |
prm <- bdp()
|
|
|
23 |
|
|
|
24 |
|
| 9 |
pdel |
25 |
par(cex.main=prm$cex.main, cex.lab=prm$cex.lab, cex.axis=prm$cex.axis)
|
|
|
26 |
par(tcl=prm$tcl)
|
|
|
27 |
par(lwd=prm$lwd)
|
|
|
28 |
par(bty=prm$bty)
|
|
|
29 |
|
|
|
30 |
|
| 5 |
pdel |
31 |
##Set margins
|
|
|
32 |
mar <- prm$mar.nolab
|
|
|
33 |
if( !is.na(prm$xlab) ){ mar[1] <- prm$mar.lab[1] }
|
|
|
34 |
if( !is.na(prm$ylab) ){ mar[2] <- prm$mar.lab[2] }
|
|
|
35 |
if( any(!is.na(prm$toplab),!is.null(main)) ) { mar[3] <- prm$mar.lab[3] }
|
|
|
36 |
if( !is.na(prm$rightlab) ){ mar[4] <- prm$mar.lab[4] }
|
|
|
37 |
par(mar=mar)
|
|
|
38 |
|
|
|
39 |
par(mgp=prm$mgp.global)
|
|
|
40 |
|
|
|
41 |
## Do the plot
|
|
|
42 |
## the method variable could be used more intelligently. If x is numeric, only three methods are possible: plot, barplot, image.plot.
|
|
|
43 |
## maybe this check can be skipped. I guess x and y can just be deleted from these commands
|
|
|
44 |
## if( prm$method=="xy"){
|
|
|
45 |
|
|
|
46 |
if(!is.null(y)){
|
|
|
47 |
## cat("The Bacher/Delff Plotting System (R), (C), TM operating in xy-plotting mode.\n")
|
|
|
48 |
|
|
|
49 |
plot(x, y,
|
|
|
50 |
type=type,
|
|
|
51 |
xaxt=xaxt, yaxt="n",
|
|
|
52 |
cex=cex.plot,
|
|
|
53 |
xlab=xlab,
|
|
|
54 |
ylab=ylab,
|
|
|
55 |
xlim=xlim,
|
|
|
56 |
ylim=ylim,
|
|
|
57 |
col=col,
|
|
|
58 |
main=main,
|
|
|
59 |
...)
|
|
|
60 |
} else if (is.numeric(x)){
|
| 7 |
pdel |
61 |
if(prm$method=="barplot"){
|
|
|
62 |
barplot(height=x,
|
|
|
63 |
## maybe these two are wrong/stupid?
|
|
|
64 |
cex.axis=prm$cex.lab,
|
|
|
65 |
cex.names=prm$cex.lab,
|
|
|
66 |
col=bdp()$hcol,
|
|
|
67 |
border=border,
|
|
|
68 |
xlab=xlab,
|
|
|
69 |
ylab=ylab,
|
|
|
70 |
main=main,
|
|
|
71 |
...)
|
|
|
72 |
prm$draw.xaxis <- FALSE
|
|
|
73 |
prm$draw.yaxis <- FALSE
|
|
|
74 |
|
|
|
75 |
} else {
|
|
|
76 |
plot(x,
|
|
|
77 |
type=type,
|
|
|
78 |
xaxt="n", yaxt="n",
|
|
|
79 |
cex=cex.plot,
|
|
|
80 |
xlab=xlab,
|
|
|
81 |
ylab=ylab,
|
|
|
82 |
ylim=xlim,
|
|
|
83 |
col=col,
|
|
|
84 |
main=main,
|
|
|
85 |
...)
|
|
|
86 |
}
|
| 5 |
pdel |
87 |
} else if( class(x) == "acf"){
|
|
|
88 |
## Not cleaned up/checked
|
|
|
89 |
plot(x, xlab="", ylab="", xaxt="n", yaxt="n", cex=prm$cex.plot, xlim=prm$xlim, ylim=prm$ylim,col=col,...)
|
|
|
90 |
}
|
|
|
91 |
else if( class(x) == "histogram"){
|
|
|
92 |
## Notice: the color of the bars can ONLY be set with bdp(hcol="color").
|
|
|
93 |
plot(x,
|
|
|
94 |
xlab=xlab, ylab=ylab,
|
|
|
95 |
main=prm$main,
|
|
|
96 |
xaxt="n",yaxt="n",col=bdp()$hcol,
|
|
|
97 |
border=border,
|
|
|
98 |
...)
|
|
|
99 |
} else if( class(x) == "trellis"){
|
|
|
100 |
## Not cleaned up/checked
|
|
|
101 |
## very experimental
|
|
|
102 |
cat("The Bacher/Delff Plotting System (R), (C), TM operating in lattice mode.\n Remeber that labels must written in the lattice object.\n")
|
|
|
103 |
##lattice.options(layout.widths = prm$lattice.width,
|
|
|
104 |
## layout.heights = prm$lattice.height)
|
|
|
105 |
trellis.par.set(prm$myLatticeSettings())
|
|
|
106 |
plot(x,col=col,...)
|
|
|
107 |
## with lattice/trellis, the axis drawing doesn't work.
|
|
|
108 |
prm$draw.xaxis <- FALSE
|
|
|
109 |
prm$draw.yaxis <- FALSE
|
|
|
110 |
}
|
|
|
111 |
else if (prm$method=="image.plot"){
|
|
|
112 |
cat("The Bacher/Delff Plotting System (R), (C), TM operating in image plotting mode.\nx and y axis can not be configured.\n")
|
|
|
113 |
image.plot(x=x,y=y,z=z,
|
|
|
114 |
xlab=xlab,
|
|
|
115 |
ylab=ylab,
|
|
|
116 |
...)
|
|
|
117 |
}
|
| 7 |
pdel |
118 |
|
| 5 |
pdel |
119 |
## We could make default values for grid.v og grid.h. Man maa kunne lave noget kvalificeret ud fra range og noget heltalsdivision
|
|
|
120 |
|
|
|
121 |
##Grid stuff
|
|
|
122 |
if( prm$grid ){
|
|
|
123 |
grid(col=prm$grid.col)
|
|
|
124 |
}
|
|
|
125 |
## vertical lines
|
|
|
126 |
if( !is.na(prm$grid.v) ){
|
|
|
127 |
if(prm$grid.v=="Def"){
|
|
|
128 |
grid(nx=NULL,ny=NA,col=prm$grid.col)
|
|
|
129 |
} else
|
|
|
130 |
{
|
|
|
131 |
abline(v=prm$grid.v, lty="dotted", col=prm$grid.col)
|
|
|
132 |
}
|
|
|
133 |
}
|
|
|
134 |
|
|
|
135 |
if( !is.na(prm$grid.h) ){
|
|
|
136 |
if(prm$grid.h=="Def"){
|
|
|
137 |
grid(nx=NA,ny=NULL,col=prm$grid.col)
|
|
|
138 |
}else{
|
|
|
139 |
abline(h=prm$grid.h, lty="dotted", col=prm$grid.col)}
|
|
|
140 |
}
|
|
|
141 |
|
|
|
142 |
## Axis stuff
|
|
|
143 |
if(prm$draw.xaxis){
|
|
|
144 |
## mgp.old <- par()$mgp
|
|
|
145 |
## par(mgp) <- mgp.xaxis
|
|
|
146 |
options(warn=-1)
|
|
|
147 |
if( "POSIXt"%in%class(x[1])){
|
|
|
148 |
axis.POSIXct(1, x,mgp=prm$mgp.xaxis, lwd=prm$lwd)
|
|
|
149 |
} else {
|
|
|
150 |
axis(1, mgp=prm$mgp.xaxis, lwd=prm$lwd)
|
|
|
151 |
}
|
|
|
152 |
options(warn=0)
|
|
|
153 |
|
|
|
154 |
}
|
|
|
155 |
if(prm$draw.yaxis){ axis(2, mgp=prm$mgp.yaxis, lwd=prm$lwd) }
|
|
|
156 |
|
|
|
157 |
##Title stuff
|
|
|
158 |
## Hvorfor??
|
|
|
159 |
scale <- 1
|
|
|
160 |
## if( prm$type=="hist" & !is.na(prm$xlab) )
|
|
|
161 |
# if( !is.na(prm$xlab) ){ mtext(prm$xlab, line=prm$xlabLine, side=1, cex=prm$cex.lab/scale) }
|
|
|
162 |
## if( prm$type=="hist" &!is.na(prm$ylab) )
|
|
|
163 |
# if( !is.na(prm$ylab) ){ mtext(prm$ylab, line=prm$ylabLine, side=2, cex=prm$cex.lab/scale) }
|
|
|
164 |
if( !is.na(prm$toplab) ){ mtext(prm$xxlab, side=3, line=0.25, cex=prm$cex.lab/scale) }
|
|
|
165 |
if( !is.na(prm$rightlab) ){ mtext(prm$yylab, side=4, line=0.25, cex=prm$cex.lab/scale) }
|
|
|
166 |
}
|
|
|
167 |
|
|
|
168 |
|
|
|
169 |
|