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,
                   xlab=bdp()$xlab, ylab=bdp()$ylab,
                   xlim=NULL,ylim=NULL,
                   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,
                   ...)
{
  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)){
      xinterval <- 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)
  #prm$draw.yaxis <- ifelse(yaxt=="n",prm$draw.yaxis,FALSE)
  
  ## 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)
      if(is.null(ylim))
        ylim <- range(y,bdp()$ylim,na.rm=TRUE)
      
      plot(x, y,
           type=type,
           xaxt=xaxt, yaxt=yaxt,
           cex=cex.plot,
           xlab=xlab,
           ylab=ylab,
           xlim=xlim,
           ylim=ylim,
           col=col,
           main=main,
           ...)
    }
  } 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)
      
      if(is.null(ylim))
        ylim <- range(x,bdp()$ylim,na.rm=TRUE)
      
      plot(x,
           type=type,
           xaxt=xaxt, yaxt=yaxt,
           cex=cex.plot,
           xlab=xlab,
           ylab=ylab,
           xlim=xlim,
           ylim=ylim,
           col=col,
           main=main,
           ...)
    }
  } 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)}
    }
 
### 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)
  } 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)
  }
}
 
 
 
 

Rev 34	Rev 35
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	`## strategy missing for xytype`	5	`## strategy missing for xytype`
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	`xlab=bdp()$xlab, ylab=bdp()$ylab,`	12	`xlab=bdp()$xlab, ylab=bdp()$ylab,`
12	`xlim=NULL,ylim=NULL,`	13	`xlim=NULL,ylim=NULL,`
13	`col=bdp()$col,main=NULL,`	14	`col=bdp()$col,main=NULL,`
14	`## only used in case of plot mode`	15	`## only used in case of plot mode`
15	`type=bdp()$type,`	16	`type=bdp()$type,`
16	`## Only used in case of histogram plotting`	17	`## Only used in case of histogram plotting`
17	`border=bdp()$border,`	18	`border=bdp()$border,`
18	`...)`	19	`...)`
19	`{`	20	`{`
20	`prm <- bdp()`	21	`prm <- bdp()`
21		22
22		23
23	`par(cex.main=prm$cex.main, cex.lab=prm$cex.lab, cex.axis=prm$cex.axis)`	24	`par(cex.main=prm$cex.main, cex.lab=prm$cex.lab, cex.axis=prm$cex.axis)`
24	`par(tcl=prm$tcl)`	25	`par(tcl=prm$tcl)`
25	`par(lwd=prm$lwd)`	26	`par(lwd=prm$lwd)`
26	`par(bty=prm$bty)`	27	`par(bty=prm$bty)`
27		28
28		29
29	`##Set margins`	30	`##Set margins`
30	`mar <- prm$mar.nolab`	31	`mar <- prm$mar.nolab`
31	`if( !is.na(prm$xlab) ){ mar[1] <- prm$mar.lab[1] }`	32	`if( !is.na(prm$xlab) ){ mar[1] <- prm$mar.lab[1] }`
32	`if( !is.na(prm$ylab) ){ mar[2] <- prm$mar.lab[2] }`	33	`if( !is.na(prm$ylab) ){ mar[2] <- prm$mar.lab[2] }`
33	`if( any(!is.na(prm$toplab),!is.null(main)) ) { mar[3] <- prm$mar.lab[3] }`	34	`if( any(!is.na(prm$toplab),!is.null(main)) ) { mar[3] <- prm$mar.lab[3] }`
34	`if( !is.na(prm$rightlab) ){ mar[4] <- prm$mar.lab[4] }`	35	`if( !is.na(prm$rightlab) ){ mar[4] <- prm$mar.lab[4] }`
35	`par(mar=mar)`	36	`par(mar=mar)`
36		37
37	`par(mgp=prm$mgp.global)`	38	`par(mgp=prm$mgp.global)`
38		39
39	`### xaxt and yaxt can be set to "axis" which is the special case where the axis is drawn with the axius`	40	`### 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") {`
-		42
-		43	`if(prm$debug)`
-		44	`print(class(x))`
-		45	`if(is.null(xaxt.in)){`
-		46	`xinterval <- x`
-		47	`} else {`
-		48	`xinterval <- xax.in`
-		49	`}`
-		50	`draw.xaxis <- "fun"`
-		51	`xaxt.fun <- xaxt`
-		52	`xaxt <- "n"`
40	`if(xaxt=="axis"){`	53	`} else if(xaxt=="axis"){`
41	`xaxt <- "n"`	54	`xaxt <- "n"`
42	`draw.xaxis <- TRUE`	55	`draw.xaxis <- TRUE`
43	`} else {`	56	`} else {`
44	`draw.xaxis <- FALSE`	57	`draw.xaxis <- FALSE`
45	`}`	58	`}`
-		59	`if(class(yaxt)=="function") {`
-		60	`yaxt(ifelse(is.null(yaxt.in),range(y),yaxt.in))`
-		61	`draw.yaxis <- FALSE`
46	`if(yaxt=="axis"){`	62	`} else if(yaxt=="axis"){`
47	`yaxt <- "n"`	63	`yaxt <- "n"`
48	`draw.yaxis <- TRUE`	64	`draw.yaxis <- TRUE`
49	`} else {`	65	`} else {`
50	`draw.yaxis <- FALSE`	66	`draw.yaxis <- FALSE`
51	`}`	67	`}`
52		68
53		69
54		70
55	`## if xaxt or yaxt set, axis are drawn automatically in the plot command. Then it should not be done with axis() later`	71	`## if xaxt or yaxt set, axis are drawn automatically in the plot command. Then it should not be done with axis() later`
56	`#prm$draw.xaxis <- ifelse(xaxt=="n",prm$draw.xaxis,FALSE)`	72	`#prm$draw.xaxis <- ifelse(xaxt=="n",prm$draw.xaxis,FALSE)`
57	`#prm$draw.yaxis <- ifelse(yaxt=="n",prm$draw.yaxis,FALSE)`	73	`#prm$draw.yaxis <- ifelse(yaxt=="n",prm$draw.yaxis,FALSE)`
58		74
59	`## Do the plot`	75	`## Do the plot`
60	`if(!is.null(y)){`	76	`if(!is.null(y)){`
61		77
62	`if(!is.null(z)){`	78	`if(!is.null(z)){`
63	`if(prm$debug)`	79	`if(prm$debug)`
64	`cat("bdgraphics operating in image plotting mode.\nx and y axis can not be configured.\n")`	80	`cat("bdgraphics operating in image plotting mode.\nx and y axis can not be configured.\n")`
65	`image(x=x,y=y,z=z,`	81	`image(x=x,y=y,z=z,`
66	`xlab=xlab,`	82	`xlab=xlab,`
67	`ylab=ylab,`	83	`ylab=ylab,`
68	`...)`	84	`...)`
69	`} else {`	85	`} else {`
70	`if(prm$debug)`	86	`if(prm$debug)`
71	`cat("The Bacher/Delff Plotting System (R), (C), TM operating in xy-plotting mode.\n")`	87	`cat("The Bacher/Delff Plotting System (R), (C), TM operating in xy-plotting mode.\n")`
72		88
73	`## this is ugly, non standard.`	89	`## this is ugly, non standard.`
74	`if(is.null(xlim))`	90	`if(is.null(xlim))`
75	`xlim <- range(x,bdp()$xlim,na.rm=TRUE)`	91	`xlim <- range(x,bdp()$xlim,na.rm=TRUE)`
76	`if(is.null(ylim))`	92	`if(is.null(ylim))`
77	`ylim <- range(y,bdp()$ylim,na.rm=TRUE)`	93	`ylim <- range(y,bdp()$ylim,na.rm=TRUE)`
78		94
79	`plot(x, y,`	95	`plot(x, y,`
80	`type=type,`	96	`type=type,`
81	`xaxt=xaxt, yaxt=yaxt,`	97	`xaxt=xaxt, yaxt=yaxt,`
82	`cex=cex.plot,`	98	`cex=cex.plot,`
83	`xlab=xlab,`	99	`xlab=xlab,`
84	`ylab=ylab,`	100	`ylab=ylab,`
85	`xlim=xlim,`	101	`xlim=xlim,`
86	`ylim=ylim,`	102	`ylim=ylim,`
87	`col=col,`	103	`col=col,`
88	`main=main,`	104	`main=main,`
89	`...)`	105	`...)`
90	`}`	106	`}`
91	`} else if (is.numeric(x)){`	107	`} else if (is.numeric(x)){`
92	`if(prm$method=="barplot"){`	108	`if(prm$method=="barplot"){`
93	`if(prm$debug)`	109	`if(prm$debug)`
94	`cat("The Bacher/Delff Plotting System (R), (C), TM operating in barplot mode.\n")`	110	`cat("The Bacher/Delff Plotting System (R), (C), TM operating in barplot mode.\n")`
95	`## this does not provide the full x,y functionality of barplot`	111	`## this does not provide the full x,y functionality of barplot`
96	`barplot(height=x,`	112	`barplot(height=x,`
97	`## maybe these two are wrong/stupid?`	113	`## maybe these two are wrong/stupid?`
98	`cex.axis=prm$cex.lab,`	114	`cex.axis=prm$cex.lab,`
99	`cex.names=prm$cex.lab,`	115	`cex.names=prm$cex.lab,`
100	`col=bdp()$hcol,`	116	`col=bdp()$hcol,`
101	`border=border,`	117	`border=border,`
102	`xlab=xlab,`	118	`xlab=xlab,`
103	`ylab=ylab,`	119	`ylab=ylab,`
104	`main=main,`	120	`main=main,`
105	`...)`	121	`...)`
106	`draw.xaxis <- FALSE`	122	`draw.xaxis <- FALSE`
107	`draw.yaxis <- FALSE`	123	`draw.yaxis <- FALSE`
108		124
109	`} else {`	125	`} else {`
110	`if(prm$debug)`	126	`if(prm$debug)`
111	`cat("The Bacher/Delff Plotting System operating in xy-plotting mode, only plotting x.\n")`	127	`cat("The Bacher/Delff Plotting System operating in xy-plotting mode, only plotting x.\n")`
112	`if(is.null(xlim))`	128	`if(is.null(xlim))`
113	`xlim <- range(c(1:length(x),bdp()$xlim),na.rm=TRUE)`	129	`xlim <- range(c(1:length(x),bdp()$xlim),na.rm=TRUE)`
114		130
115	`if(is.null(ylim))`	131	`if(is.null(ylim))`
116	`ylim <- range(x,bdp()$ylim,na.rm=TRUE)`	132	`ylim <- range(x,bdp()$ylim,na.rm=TRUE)`
117		133
118	`plot(x,`	134	`plot(x,`
119	`type=type,`	135	`type=type,`
120	`xaxt=xaxt, yaxt=yaxt,`	136	`xaxt=xaxt, yaxt=yaxt,`
121	`cex=cex.plot,`	137	`cex=cex.plot,`
122	`xlab=xlab,`	138	`xlab=xlab,`
123	`ylab=ylab,`	139	`ylab=ylab,`
124	`xlim=xlim,`	140	`xlim=xlim,`
125	`ylim=ylim,`	141	`ylim=ylim,`
126	`col=col,`	142	`col=col,`
127	`main=main,`	143	`main=main,`
128	`...)`	144	`...)`
129	`}`	145	`}`
130	`} else if( class(x) == "acf"){`	146	`} else if( class(x) == "acf"){`
131	`## Not cleaned up/checked`	147	`## Not cleaned up/checked`
132	`plot(x, xlab="", ylab="", xaxt=xaxt, yaxt=yaxt, cex=prm$cex.plot, xlim=prm$xlim, ylim=prm$ylim,col=col,...)`	148	`plot(x, xlab="", ylab="", xaxt=xaxt, yaxt=yaxt, cex=prm$cex.plot, xlim=prm$xlim, ylim=prm$ylim,col=col,...)`
133	`} else if( class(x) == "histogram"){`	149	`} else if( class(x) == "histogram"){`
134	`## Notice: the color of the bars can ONLY be set width bdp(hcol="color").`	150	`## Notice: the color of the bars can ONLY be set width bdp(hcol="color").`
135	`plot(x,`	151	`plot(x,`
136	`xlab=xlab, ylab=ylab,`	152	`xlab=xlab, ylab=ylab,`
137	`main=prm$main,`	153	`main=prm$main,`
138	`xaxt=xaxt,yaxt=yaxt,col=bdp()$hcol,`	154	`xaxt=xaxt,yaxt=yaxt,col=bdp()$hcol,`
139	`border=border,`	155	`border=border,`
140	`...)`	156	`...)`
141	`} else if( class(x) == "trellis"){`	157	`} else if( class(x) == "trellis"){`
142	`## Not cleaned up/checked`	158	`## Not cleaned up/checked`
143	`## very experimental`	159	`## very experimental`
144	`cat("The Bacher/Delff Plotting System (R), (C), TM operating in lattice mode.\n Remeber that labels must written in the lattice object.\n")`	160	`cat("The Bacher/Delff Plotting System (R), (C), TM operating in lattice mode.\n Remeber that labels must written in the lattice object.\n")`
145	`##lattice.options(layout.widths = prm$lattice.width,`	161	`##lattice.options(layout.widths = prm$lattice.width,`
146	`## layout.heights = prm$lattice.height)`	162	`## layout.heights = prm$lattice.height)`
147	`trellis.par.set(prm$myLatticeSettings())`	163	`trellis.par.set(prm$myLatticeSettings())`
148	`plot(x,col=col,...)`	164	`plot(x,col=col,...)`
149	`## with lattice/trellis, the axis drawing doesn't work.`	165	`## with lattice/trellis, the axis drawing doesn't work.`
150	`draw.xaxis <- FALSE`	166	`draw.xaxis <- FALSE`
151	`draw.yaxis <- FALSE`	167	`draw.yaxis <- FALSE`
152	`} else if (class(x)=="princomp") {`	168	`} else if (class(x)=="princomp") {`
153	`if(prm$debug)`	169	`if(prm$debug)`
154	`cat("The Bacher/Delff Plotting System operating in princomp plotting mode.\n")`	170	`cat("The Bacher/Delff Plotting System operating in princomp plotting mode.\n")`
155	`plot(x,`	171	`plot(x,`
156	`main=prm$main,`	172	`main=prm$main,`
157	`...)`	173	`...)`
158	`} else if (prm$method=="image.plot"){`	174	`} else if (prm$method=="image.plot"){`
159	`### This could be checked in the beginning by is.null(z)`	175	`### This could be checked in the beginning by is.null(z)`
160	`}`	176	`}`
161		177
162	`###Grid stuff`	178	`###Grid stuff`
163	`## This really hould be done before adding the rest of the plot contents.`	179	`## This really hould be done before adding the rest of the plot contents.`
164	`## We could make default values for grid.v og grid.h. Man maa kunne lave noget kvalificeret ud fra range og noget heltalsdivision`	180	`## We could make default values for grid.v og grid.h. Man maa kunne lave noget kvalificeret ud fra range og noget heltalsdivision`
165		181
166	`if( prm$grid ){`	182	`if( prm$grid ){`
167	`grid(col=prm$grid.col)`	183	`grid(col=prm$grid.col)`
168	`}`	184	`}`
169	`## vertical lines`	185	`## vertical lines`
170	`if( !is.na(prm$grid.v) ){`	186	`if( !is.na(prm$grid.v) ){`
171	`if(prm$grid.v=="Def"){`	187	`if(prm$grid.v=="Def"){`
172	`grid(nx=NULL,ny=NA,col=prm$grid.col)`	188	`grid(nx=NULL,ny=NA,col=prm$grid.col)`
173	`} else`	189	`} else`
174	`{`	190	`{`
175	`abline(v=prm$grid.v, lty="dotted", col=prm$grid.col)`	191	`abline(v=prm$grid.v, lty="dotted", col=prm$grid.col)`
176	`}`	192	`}`
177	`}`	193	`}`
178		194
179	`if( !is.na(prm$grid.h) ){`	195	`if( !is.na(prm$grid.h) ){`
180	`if(prm$grid.h=="Def"){`	196	`if(prm$grid.h=="Def"){`
181	`grid(nx=NA,ny=NULL,col=prm$grid.col)`	197	`grid(nx=NA,ny=NULL,col=prm$grid.col)`
182	`}else{`	198	`}else{`
183	`abline(h=prm$grid.h, lty="dotted", col=prm$grid.col)}`	199	`abline(h=prm$grid.h, lty="dotted", col=prm$grid.col)}`
184	`}`	200	`}`
185		201
186	`### Axis stuff This part should be improved. A function that draws`	202	`### Axis stuff This part should be improved. A function that draws`
187	`### axis should be run for all four axis. And it should be possible to`	203	`### axis should be run for all four axis. And it should be possible to`
188	`### supply whatever vector to base it on (especially relevant for`	204	`### supply whatever vector to base it on (especially relevant for`
189	`### taxis and raxis)`	205	`### taxis and raxis)`
190		206
191	`## this is because the use of mgp gives a ridiculous warning when too small`	207	`## this is because the use of mgp gives a ridiculous warning when too small`
192	`options(warn=-1)`	208	`options(warn=-1)`
193	`if(draw.xaxis){`	209	`if(draw.xaxis=="fun"){`
194	`## mgp.old <- par()$mgp`	210	`xaxt.fun(xinterval)`
195	`## par(mgp) <- mgp.xaxis`	211	`} else if(draw.xaxis){`
196	`## is the abscissa a time object?`	212	`## is the abscissa a time object?`
197	`if( "POSIXt"%in%class(x[1])){`	213	`if( "POSIXt"%in%class(x[1])){`
198	`axis.POSIXct(1, x,mgp=prm$mgp.xaxis, lwd=prm$lwd)`	214	`axis.POSIXct(1, x,mgp=prm$mgp.xaxis, lwd=prm$lwd)`
199	`} else {`	215	`} else {`
200	`axis(1, mgp=prm$mgp.xaxis, lwd=prm$lwd)`	216	`axis(1, mgp=prm$mgp.xaxis, lwd=prm$lwd)`
201	`}`	217	`}`
202		218
203	`}`	219	`}`
204		220
205	`if(draw.yaxis){ axis(2, y,mgp=prm$mgp.yaxis, lwd=prm$lwd) }`	221	`if(draw.yaxis){ axis(2, y,mgp=prm$mgp.yaxis, lwd=prm$lwd) }`
206	`## top axis`	222	`## top axis`
207	`if(prm$draw.taxis){ axis(3, mgp=prm$mgp.taxis, lwd=prm$lwd) }`	223	`if(prm$draw.taxis){ axis(3, mgp=prm$mgp.taxis, lwd=prm$lwd) }`
208	`## axis to the right`	224	`## axis to the right`
209	`if(prm$draw.raxis){ axis(4, mgp=prm$mgp.raxis, lwd=prm$lwd) }`	225	`if(prm$draw.raxis){ axis(4, mgp=prm$mgp.raxis, lwd=prm$lwd) }`
210		226
211	`## switch back on warnings`	227	`## switch back on warnings`
212	`options(warn=0)`	228	`options(warn=0)`
213		229
214		230
215	`##Title stuff`	231	`##Title stuff`
216	`## Hvorfor??`	232	`## Hvorfor??`
217	`scale <- 1`	233	`scale <- 1`
218	`## if( prm$type=="hist" & !is.na(prm$xlab) )`	234	`## if( prm$type=="hist" & !is.na(prm$xlab) )`
219	`# if( !is.na(prm$xlab) ){ mtext(prm$xlab, line=prm$xlabLine, side=1, cex=prm$cex.lab/scale) }`	235	`# if( !is.na(prm$xlab) ){ mtext(prm$xlab, line=prm$xlabLine, side=1, cex=prm$cex.lab/scale) }`
220	`## if( prm$type=="hist" &!is.na(prm$ylab) )`	236	`## if( prm$type=="hist" &!is.na(prm$ylab) )`
221	`# if( !is.na(prm$ylab) ){ mtext(prm$ylab, line=prm$ylabLine, side=2, cex=prm$cex.lab/scale) }`	237	`# if( !is.na(prm$ylab) ){ mtext(prm$ylab, line=prm$ylabLine, side=2, cex=prm$cex.lab/scale) }`
222	`if( !is.na(prm$toplab) ){ mtext(prm$toplab, side=3, line=0.25, cex=prm$cex.lab/scale) }`	238	`if( !is.na(prm$toplab) ){ mtext(prm$toplab, side=3, line=0.25, cex=prm$cex.lab/scale) }`
223	`if( !is.na(prm$rightlab) ){`	239	`if( !is.na(prm$rightlab) ){`
224	`mtext(prm$rightlab, side=4, line=0.75, cex=prm$cex.lab/scale,mgp=prm$mgp.raxis)`	240	`mtext(prm$rightlab, side=4, line=0.75, cex=prm$cex.lab/scale,mgp=prm$mgp.raxis)`
225	`## mtext(rightlab, side=4, line=0.5, cex=bdp()$cex.lab,mgp=bdp()$mgp.raxis)`	241	`## mtext(rightlab, side=4, line=0.5, cex=bdp()$cex.lab,mgp=bdp()$mgp.raxis)`
226	`}`	242	`}`
227	`}`	243	`}`
228		244
229		245
230		246
231		247

Subversion Repositories bdplot

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