-
Notifications
You must be signed in to change notification settings - Fork 14
Expand file tree
/
Copy patherror_bars.R
More file actions
98 lines (85 loc) · 2.99 KB
/
error_bars.R
File metadata and controls
98 lines (85 loc) · 2.99 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
#' gsplot error bars
#'
#' Creates vertical and horizontal error bars around plot points.
#'
#' @param object gsplot object
#' @param \dots Further graphical parameters may also be supplied as arguments. See 'Details'.
#'
#' @rdname error_bar
#' @export
#' @examples
#' gs <- gsplot()
#' gsNew <- points(gs, y=c(3,1,2), x=1:3, xlim=c(0,NA),ylim=c(0,NA),
#' col="blue", pch=18, legend.name="Points")
#' gsNew <- lines(gsNew, c(3,4,3), c(2,4,6), legend.name="Lines")
#' gsNew <- abline(gsNew, b=1, a=0, legend.name="1:1")
#' gsNew <- legend(gsNew, location = "topleft",title="Awesome!")
#' gsNew <- grid(gsNew)
#' gsNew <- error_bar(gsNew, 1:3, y=c(3,1,2), y.high=c(0.5,0.25,1), y.low=0.1)
#' gsNew <- error_bar(gsNew, x=1:3, y=c(3,1,2), x.low=c(.2,NA,.2), x.high=.2, col="red",lwd=3)
#' gsNew <- title(gsNew, "Graphing Fun")
#' gsNew
#'
#' yData <- rnorm(100,mean=10000, sd=1000)
#' gs <- gsplot() %>%
#' points(1:100, yData, log="y") %>%
#' error_bar(50:60, yData[50:60], y.high=250)
#' gs
#'
#' gs <- gsplot() %>%
#' points(1:10, 1:10) %>%
#' error_bar(5, 5, y.high=1)
#' gs
error_bar <- function(object, ...) {
override("gsplot", "error_bar", object, ...)
}
error_bar.gsplot <- function(object, x, y, ..., y.high=0, y.low=0, x.high=0, x.low=0,
epsilon=0.1, legend.name=NULL, side=c(1,2)){
args <- c(...)
if (length(args) != 0) {
for (i in 1:length(args)) {
assign(names(args)[i], value=args[[i]])
}
args <- args[!names(args) %in% c("y.high", "y.low", "x.high", "x.low")]
}
y.high[is.na(y.high)] <- 0
y.low[is.na(y.low)] <- 0
x.high[is.na(x.high)] <- 0
x.low[is.na(x.low)] <- 0
if(!all(y.low == 0)){
y.low.coord <- y-y.low
errorIndex <- (y-y.low.coord) != 0
y.low.coord <- y.low.coord[errorIndex]
y.error <- y[errorIndex]
x.error <- x[errorIndex]
object <- arrows(object, x0=x.error, y0=y.error, x1=x.error, y1=y.low.coord, length=epsilon, angle=90, args)
}
if(!all(y.high == 0)){
y.high.coord <- y+y.high
errorIndex <- (y-y.high.coord) != 0
y.high.coord <- y.high.coord[errorIndex]
y.error <- y[errorIndex]
x.error <- x[errorIndex]
object <- arrows(object, x0=x.error, y0=y.error, x1=x.error, y1=y.high.coord, length=epsilon, angle=90, args)
}
if(!all(x.low == 0)){
x.low.coord <- x-x.low
errorIndex <- (x-x.low.coord) != 0
x.low.coord <- x.low.coord[errorIndex]
x.error <- x[errorIndex]
y.error <- y[errorIndex]
object <- arrows(object, x0=x.error, y0=y.error, x1=x.low.coord, y1=y.error, length=epsilon, angle=90, args)
}
if(!all(x.high == 0)){
x.high.coord <- x+x.high
errorIndex <- (x-x.high.coord) != 0
x.high.coord <- x.high.coord[errorIndex]
x.error <- x[errorIndex]
y.error <- y[errorIndex]
object <- arrows(object, x0=x.error, y0=y.error, x1=x.high.coord, y1=y.error, length=epsilon, angle=90, args)
}
return(object)
}
error_bar.default <- function(x, y, y.high, y.low, x.high, x.low, epsilon=0.1, ...){
return()
}