Skip to content

Commit f810e0b

Browse files
mfidinomfidino
authored
Merge pull request #1 from mfidino/axis_blank_plus_ribbon
Axis blank plus ribbon
2 parents dc439e8 + fe95e80 commit f810e0b

File tree

12 files changed

+694
-1
lines changed

12 files changed

+694
-1
lines changed

‎.Rbuildignore‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,6 @@
11
^ancillary$
22
^\.travis\.yml$
33
^CONTRIBUTING\.md$
4-
^CODE_OF_CONDUCT\.md$
4+
^CODE_OF_CONDUCT\.md$
5+
^.*\.Rproj$
6+
^\.Rproj\.user$

‎.gitignore‎

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
# History files
2+
.Rhistory
3+
.Rapp.history
4+
5+
# Session Data files
6+
.RData
7+
8+
# Example code in package build process
9+
*-Ex.R
10+
11+
# Output files from R CMD build
12+
/*.tar.gz
13+
14+
# Output files from R CMD check
15+
/*.Rcheck/
16+
17+
/reports/
18+
19+
/
20+
21+
# RStudio files
22+
.Rproj.user/
23+
24+
# produced vignettes
25+
vignettes/*.html
26+
vignettes/*.pdf
27+
28+
# OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
29+
.httr-oauth
30+
31+
# knitr and R markdown default cache directories
32+
/*_cache/
33+
/cache/
34+
35+
# Temporary files created by R markdown
36+
*.utf8.md
37+
*.knit.md
38+
39+
# Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html
40+
rsconnect/
41+
42+
*.Rproj

‎NAMESPACE‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
# Generated by roxygen2: do not edit by hand
22

3+
export(axis_blank)
4+
export(axis_text)
35
export(blank)
46
export(default_nvalues)
57
export(default_violin_type)
@@ -8,6 +10,7 @@ export(dist_x_values)
810
export(dist_y_values)
911
export(draw_probs)
1012
export(draw_violin)
13+
export(ribbon)
1114
export(violin)
1215
export(violin_length_values)
1316
export(violin_location)

‎R/axis_blank.R‎

Lines changed: 89 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,89 @@
1+
#' @title Add an axis to a plot without labels as the default
2+
#'
3+
#' @description A wrapper function for \code{\link[base]{axis}}
4+
#' with three changes.
5+
#'
6+
#' 1. \code{labels = FALSE} is now the default.
7+
#' 2. \code{tck} has been added as an argument, which is used to specify the size of the tick mark.
8+
#' 3. \code{minor} has been added as an argument. Used to add minor (i.e., smaller) tickmarks equally between the first axis.
9+
10+
#'
11+
#' @param side an integer specifying which side of the plot the axis is to be drawn on. The axis is placed as follows: 1=below, 2=left, 3=above and 4=right.
12+
#'
13+
#' @param at The points at which tick-marks are to be drawn. Non-finite (infinite, NaN or NA) values are omitted. By default (when NULL) tickmark locations are computed using \code{\link[graphics]{axTicks}}.
14+
#'
15+
#' @param labels Set to \code{FALSE}. See \code{\link[graphics]{axis}}.
16+
#'
17+
#' @param tick See \code{\link[graphics]{axis}}.
18+
#'
19+
#' @param line See \code{\link[graphics]{axis}}.
20+
#'
21+
#' @param pos See \code{\link[graphics]{axis}}.
22+
#'
23+
#' @param outer See \code{\link[graphics]{axis}}.
24+
#'
25+
#' @param font See \code{\link[graphics]{axis}}.
26+
#'
27+
#' @param lty See \code{\link[graphics]{axis}}.
28+
#'
29+
#' @param lwd See \code{\link[graphics]{axis}}.
30+
#'
31+
#' @param lwd.ticks See \code{\link[graphics]{axis}}.
32+
#'
33+
#' @param col See \code{\link[graphics]{axis}}.
34+
#'
35+
#' @param col.ticks See \code{\link[graphics]{axis}}.
36+
#'
37+
#' @param hadj See \code{\link[graphics]{axis}}.
38+
#'
39+
#' @param padj See \code{\link[graphics]{axis}}.
40+
#'
41+
#' @param gap.axis See \code{\link[graphics]{axis}}.
42+
#'
43+
#' @param tck The length of tick marks as a fraction of the smaller of the width or height of the plotting region. If tck >= 0.5 it is interpreted as a fraction of the relevant side, so if tck = 1 grid lines are drawn. The default setting is (tck = -0.025).
44+
#'
45+
#' @param minor Whether or not to add smaller tick marks spaced equally between the larger tickmarks specified by the at argument. Tick length is set to \code{tck * 0.5}.
46+
#'
47+
#' @param ... Other graphical parameters that may apply to \code{\link[graphics]{axis}}.
48+
#'
49+
#'
50+
#'
51+
#' @examples
52+
#' \dontrun{
53+
#' blank(
54+
#' xlim = c(0,50),
55+
#' ylim = c(0,100),
56+
#' bty ="l"
57+
#' )
58+
#'
59+
#' axis_blank(1, at = seq(0,50,10))
60+
#' axis_blank(2, at = seq(0,100,20))
61+
#'
62+
#' }
63+
#'
64+
#' @export
65+
axis_blank <- function(side, at = NULL, labels = FALSE, tick = TRUE, line = NA,
66+
pos = NA, outer = FALSE, font = NA, lty = "solid",
67+
lwd = 1, lwd.ticks = lwd, col = NULL, col.ticks = NULL,
68+
hadj = NA, padj = NA, gap.axis = NA, ..., tck = -0.02, minor = TRUE){
69+
if(!is.numeric(side)){
70+
stop("side must be numeric. 1=below, 2=left, 3=above and 4=right.")
71+
}
72+
if(is.null(at)){
73+
is_logged <- ifelse(side %in% c(1,3), par("xlog"), par("ylog"))
74+
75+
at <- axTicks(side = side, log = is_logged)
76+
}
77+
axis(side = side, at = at, labels = labels, tick = tick, line = line, pos = pos,
78+
outer = outer, font = font, lty = lty, lwd = lwd, lwd.ticks = lwd, col = col,
79+
col.ticks = col.ticks, hadj = hadj, padj = padj, gap.axis = gap.axis,
80+
tck = tck, ...)
81+
if(minor){
82+
smaller_seq <- seq(at[1], max(at), (at[2] - at[1])/2)
83+
axis(side = side, at = smaller_seq, labels = labels, tick = tick, line = line, pos = pos,
84+
outer = outer, font = font, lty = lty, lwd = lwd, lwd.ticks = lwd, col = col,
85+
col.ticks = col.ticks, hadj = hadj, padj = padj, gap.axis = gap.axis,
86+
tck = tck/2, ...)
87+
88+
}
89+
}

‎R/axis_text.R‎

Lines changed: 72 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,72 @@
1+
#' @title Add labels to the axis labels
2+
#'
3+
#' @description A wrapper function for \code{\link[graphics]{mtext}}
4+
#' with two changes.
5+
#'
6+
#' 1. The default for \code{text} and \code{at} is now \code{NULL}. If both are \code{NULL}, \code{\link[graphics]{axTicks}} will be used to determine what values to include on the x (\code{side = 1}) or y (\code{side = 2}) axis.
7+
#' 2. If \code{length(text) == 1} and \code{at = NULL}, then the appropriate \code{side} will find the central point of the axis to put the text (e.g., for an axis title).
8+
9+
#' @param text a character or expression vector specifying the text to be written. See \code{\link[graphics]{mtext}}.
10+
#'
11+
#' @param side an integer specifying which side of the plot the axis is to be drawn on. The axis is placed as follows: 1=below, 2=left, 3=above and 4=right.
12+
#'
13+
#' @param line on which MARgin line, starting at 0 counting outwards.
14+
#'
15+
#' @param outer use outer margins if available.
16+
#'
17+
#' @param at The location of each string in user coordinates (i.e., the text). See \code{\link[graphics]{mtext}}.
18+
#'
19+
#' @param labels Set to \code{FALSE}. See \code{\link[graphics]{axis}}.
20+
#'
21+
#' @param adj adjustment for each string in reading direction. For strings parallel to the axes, adj = 0 means left or bottom alignment, and adj = 1 means right or top alignment. See \code{\link[graphics]{mtext}}.
22+
#'
23+
#' @param padj adjustment for each string perpendicular to the reading direction (which is controlled by \code{adj}). See \code{\link[graphics]{mtext}}.
24+
#'
25+
#' @param cex character expansion factor. Can be a vector.
26+
#'
27+
#' @param col color to use. Can be a vector. \code{NA} values (the default) means use \code{par("col")}.
28+
#'
29+
#' @param font font for text. Can be a vector. \code{NA} values (the default) means use \code{par("font")}.
30+
31+
32+
#' @param ... Other graphical parameters that may apply to \code{\link[graphics]{mtext}}.
33+
#'
34+
#'
35+
#'
36+
#' @examples
37+
#' \dontrun{
38+
#' blank(
39+
#' xlim = c(0,50),
40+
#' ylim = c(0,100),
41+
#' bty ="l"
42+
#' )
43+
#'
44+
#' axis_blank(1, at = seq(0,50,10))
45+
#' axis_text(side = 1)
46+
#' axis_blank(2, at = seq(0,100,20))
47+
#' axis_text(side = 2)
48+
#'
49+
#' }
50+
#'
51+
#' @export
52+
axis_text <- function(text = NULL, side = 3, line = 0, outer = FALSE, at = NULL,
53+
adj = NA, padj = NA, cex = NA, col = NA, font = NA, ...){
54+
if(!is.numeric(side)){
55+
stop("side must be numeric. 1=below, 2=left, 3=above and 4=right.")
56+
}
57+
if(is.null(at) & is.null(text)){
58+
is_logged <- ifelse(side %in% c(1,3), par("xlog"), par("ylog"))
59+
60+
at <- text <- axTicks(side = side, log = is_logged)
61+
}
62+
if(length(text == 1) & is.null(at)){
63+
if(side %% 2 == 1){
64+
at <- mean(par("usr")[1:2])
65+
} else {
66+
at <- mean(par("usr")[3:4])
67+
}
68+
}
69+
mtext(text = text, side = side, line = line, outer = outer,
70+
at = at, adj = adj, padj = padj, cex = cex, col = col, font = font,
71+
...)
72+
}

‎R/ribbon.R‎

Lines changed: 137 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,137 @@
1+
#' @title Add a polygon to a plot
2+
#'
3+
#' @description A slight modification to \code{\link[graphics]{polygon}}
4+
#' with quality of life improvements to make it easier to add colored confidence
5+
#' intervals to a plot. Default values are taken for all
6+
#' \code{\link[graphics]{polygon}} arguments, except for \code{border}, which
7+
#' is set to \code{NA}. Additionally, an \code{alpha} argument has been added to
8+
#' accommodate partially transparent confidence intervals. Any of the input values
9+
#' can be overwritten within this function's call.
10+
#'
11+
#' @param x vector containing the x-axis coordinates of the polygon vertices. See details for more information..
12+
#'
13+
#' @param y Either a vector containing the y-axis coordinates of the polygon vertices, or a two column data.frame / matrix with the vertices. See details for more information.
14+
#'
15+
#' @param density Set to \code{NULL}. See \code{\link[graphics]{polygon}}.
16+
#'
17+
#' @param angle Set to \code{45}. See \code{\link[graphics]{polygon}}.
18+
#'
19+
#' @param col Set to \code{NA}. See \code{\link[graphics]{polygon}}.
20+
#'
21+
#' @param border Set to \code{NA}. See \code{\link[graphics]{polygon}}.
22+
#'
23+
#' @param lty Set to \code{par("lty")}. See \code{\link[graphics]{polygon}}.
24+
#'
25+
#' @param ... Additional arguments such as \code{xpd}, \code{lend}, \code{ljoin}, and \code{lmitre} can be given as arugments.
26+
#'
27+
#' @param fillOddEven Set to \code{FALSE}. See \code{\link[graphics]{polygon}}.
28+
#'
29+
#' @param alpha new alpha level in [0,1]. If \code{col} is a HEX color that already includes
30+
#' an alpha channel, the \code{alpha} argument will be ignored.
31+
#'
32+
#' @details
33+
#'
34+
#' If \code{y} is a two column data.frame or matrix, \code{ribbon} will convert \code{y} to a vector
35+
#' such that \code{y = c(y[,1], rev(y[,2]))} in order to create the lower and upper bounds of
36+
#' the polygon. Additionally, when \code{y} is a two column data.frame or matrix, \code{x} can have the same
37+
#' length as the number of rows in \code{y}, and \code{ribbon} will concatenate the reverse of the
38+
#' vector \code{x} to ensure it has equal length.
39+
#'
40+
#' @examples
41+
#' \dontrun{
42+
#' # Load data
43+
#' data(cars)
44+
#' # fit model
45+
#' m1 <- lm(
46+
#' dist ~ speed,
47+
#' data = cars
48+
#' )
49+
#' # make predictions
50+
#' preds <- predict(
51+
#' m1,
52+
#' newdata = data.frame(speed = 10:25),
53+
#' interval = "confidence"
54+
#' )
55+
#' # base plot
56+
#' blank(
57+
#' xlim = c(10,25),
58+
#' ylim = c(15,120),
59+
#' xlab = "Speed",
60+
#' ylab = "Stopping distance",
61+
#' xaxt = "s",
62+
#' yaxt = "s",
63+
#' bty = "l",
64+
#' las = 1
65+
#' )
66+
#' # add 95% confidence interval
67+
#' ribbon(
68+
#' x=10:25,
69+
#' y=preds[,c("lwr","upr")],
70+
#' col = "purple",
71+
#' alpha = 0.5
72+
#' )
73+
#' # add mean prediction
74+
#' lines(
75+
#' x=10:25,
76+
#' y = preds[,"fit"],
77+
#' lwd =2,
78+
#' col = "purple"
79+
#' )
80+
#' # add data
81+
#' points(
82+
#' x = cars$speed,
83+
#' y = cars$dist,
84+
#' pch = 16
85+
#' )
86+
#' }
87+
#'
88+
#' @export
89+
ribbon <- function(x, y, density=NULL, angle=45, border=NA,
90+
col=NA, lty= par("lty"),...,fillOddEven=FALSE,
91+
alpha = NULL
92+
){
93+
# error checks
94+
if(!any(is.na(col)) & length(col)>1){
95+
warning("Two values input to col. Only first element used.")
96+
col <- col[1]
97+
}
98+
# check if y is a matrix
99+
if(is.matrix(y)|is.data.frame(y)){
100+
y <- c(y[,1], rev(y[,2]))
101+
# check if x is half the length of y
102+
if(length(y)/length(x) == 2){
103+
x <- c(x, rev(x))
104+
}
105+
}
106+
# evaluate color and alpha channel
107+
if( is.na(col) ){
108+
my_col <- NA
109+
} else { # otherwise go through color process
110+
#
111+
if(
112+
length(grep("^#", col)) == 1 & # if start with hash
113+
nchar(col)>7 # & alpha channel is present
114+
){
115+
if(!is.null(alpha)){
116+
warning("col already has alpha channel, ignoring alpha argument.")
117+
my_col <- col
118+
} else {
119+
my_col <- col
120+
}
121+
} else {
122+
# get rgb
123+
my_rgbs <- col2rgb(col)
124+
# set color
125+
my_col <- rgb(
126+
my_rgbs[1],my_rgbs[2],my_rgbs[3],max = 255,alpha = 255 * alpha
127+
)
128+
}
129+
}
130+
polygon(
131+
x = x, y = y, density = density, angle = angle,
132+
border = border, col = my_col, lty = lty,
133+
fillOddEven = fillOddEven, ...
134+
)
135+
}
136+
137+

0 commit comments

Comments
 (0)