- plotr
- Installation
- these are actually useful
- ggplot-style base plots
- Some useful and not-so-useful plots and tools
- not so useful
- Session info
miscellaneous plots and things
# install.packages('devtools')
devtools::install_github('raredd/plotr')## with arrays
barplot2(with(mtcars, table(cyl, gear, vs)))
set.seed(1)
x <- array(runif(4 * 3 * 3), c(4, 3, 3))
barplot2(x)
## group labels
barplot2(x, names.arg = list(A = 1:3, B = 4:6, C = 7:9))
bp <- barplot2(x)
mtext(1:9, side = 1L, at = bp$at, line = 1)
mtext(1:3, side = 1L, at = bp$group, line = 3)
## simplified space argument
barplot2(
x, space = c(0.1, 1, 2) / 2, las = 1L, col = 1:4,
legend.text = sprintf('Factor %s', 1:4),
args.legend = list(horiz = TRUE, bty = 'n'),
names.arg = list(A = 1:3, B = 4:6, C = 7:9)
)
## missing arguments from plot.default
barplot2(1:5, panel.first = {grid(0, NULL); abline(h = 4, col = 2)})
## feature x sample matrix
dat <- t(unique(iris[, 1:4]))
grp <- unique(iris)$Species
l <- list(
tsne = dimr(dat, type = 'tsne'),
umap = dimr(dat, type = 'umap'),
pca = dimr(dat, type = 'pca'),
rpca = dimr(dat, type = 'rpca')
)
op <- par(mfrow = c(2, 2), mar = c(4, 5, 2, 1))
for (x in l)
plot(x)
par(op)
plot(l$tsne, group2 = as.list(data.frame(t(dat))))
n <- 9
d <- as.list(mtcars[, rep_len(c('mpg', 'wt', 'hp'), n)])
par(mfrow = n2mfrow(n), oma = c(5, 5, 4, 2))
plotr:::gridplot(d, mtcars$mpg, mtcars$wt, legend = TRUE)
title(xlab = 'MPG', ylab = 'Weight', outer = TRUE, cex.lab = 2)
par(mfrow = c(2, 2), mar = c(4, 5, 2, 2))
plot(mpg ~ wt, mtcars)
lo <- loess_smooth(mpg ~ wt, mtcars)
lines(lo$x, lo$y)
lines(lo$x, lo$upper, lty = 2)
lines(lo$x, lo$lower, lty = 2)
plot(lo)
plot(lo, ci = 'lines', col.line = 'red')
plot(lo, ci = 'band', col.ci = 'grey90')
plot(mpg ~ wt, mtcars)
tableplot(
'topright', table = head(mtcars, 3),
title = 'mtcars data set', cex.title = 2
)
tableplot(
par('usr')[1], 35, head(mtcars, 3)[, 1:3],
show.rownames = TRUE, col.rownames = 'red',
font.colnames = 2, hlines = TRUE
)
with(mtcars, {
scattergram(mpg, wt, cyl, col = rainbow(3), pch = 16)
})
gplot(1:10, col = ggcols(10), pch = 16, cex = 5)
gmatplot(1:10, matrix(rnorm(100), 10), type = 'l', col = ggcols(10))
see all:
grep('^g[^g]', ls('package:plotr'), value = TRUE)## [1] "gbarplot" "gboxplot" "gbxp" "gcurve"
## [5] "ghist" "gmatlines" "gmatplot" "gmatpoints"
## [9] "gpairs" "gplot" "gqqnorm" "gqqplot"
## [13] "grcols" "gspineplot" "gstripchart" "gsunflowerplot"
set.seed(1)
x <- lapply(sample(1:10, 4), rpois, n = 500)
shist(x)
dat <- within(mtcars, {
disp <- disp / 10
wt <- wt * 10
})[, c('mpg', 'disp', 'wt')]
dat[] <- t(apply(dat, 1L, function(x) x / sum(x)))
propfall(dat)
propfall(dat, group = colnames(dat)[max.col(dat)],
col = c('grey', 'lightpink', 'indianred1'))
set.seed(1)
x <- datasets::ability.cov$cov
x <- x[sample(seq.int(nrow(x)), 20, TRUE), ]
bibar(x, left = 1:3, right = 4:6, xlim = c(-250, 250))
palette(c('grey90', 'cornflowerblue', 'blue', 'tomato', 'tomato3'))
bibar(x, left = 2:3, right = 4:5, sleft = 1, sright = 6)
legend('topleft', inset = c(0, -0.2), xpd = NA, fill = 3:2,
legend = colnames(x)[3:2], horiz = TRUE, bty = 'n')
legend('topright', inset = c(0, -0.2), xpd = NA, fill = 4:5,
legend = colnames(x)[4:5], horiz = TRUE, bty = 'n')
palette('default')d33 <- rep(1:4, c(3, 3, 6, 4))
c33 <- rep(3, length(d33))
c33[c(9, 14, 15)] <- 2
par(mfrow = c(2, 1), mar = c(2, 2, 2, 2))
dose_esc(d33, c33, dose.exp = rep(4, 10), col.exp = rep(3, 10))
dose_esc(d33, c33, dose.exp = rep(3, 10), col.exp = rep(3, 4))
set.seed(1)
x <- lapply(0:10, function(x) rnorm(25, x / 2, sd = 0.5))
boxplot(x)
boxline(x, add = TRUE)
set.seed(1)
tbl <- sapply(1:3, function(x) sort(rpois(3, 10), decreasing = TRUE))
inbar(tbl, col = 1:3)
set.seed(1)
tbl <- sapply(1:3, function(x) sort(rpois(3, 10), decreasing = TRUE))
tracebar(tbl)
tracebar(replace(tbl, 5, 0), col = 1:3, space = 0.5)
set.seed(1)
f <- function(x, ...) sample(x, 100, replace = TRUE, ...)
tox <- data.frame(
id = rep(1:10, 10), phase = 1:2,
code = f(rawr::ctcae_v4$tox_code[1:100]),
grade = f(1:3, prob = c(.6, .3, .1)),
stringsAsFactors = FALSE
)
tox <- cbind(tox, rawr::match_ctc(tox$code)[, c('tox_cat', 'tox_desc')])
t1 <- ftable(
Category = tox$tox_cat,
Description = tox$tox_desc,
Grade = tox$grade
)
t2 <- ftable(
Description = tox$tox_desc,
Grade = tox$grade
)
n <- 25
## basic usage
toxplot(t1, n) ## three column
toxplot(t2, n, widths = c(1, 3)) ## two column
with(airquality, spider(Day, Temp, group = Month))
with(airquality, {
spider(Day, Temp - mean(Temp), group = Month, start = 0,
labels = month.abb[unique(Month)],
at.labels = par('usr')[2], col.labels = 1:5)
})
# https://twitter.com/RandyRenstrom/status/1318053323828756480/photo/1
x <- c(
39, 55, 36, 47, 32, 58, 57, 17, 14, 17, 43, 49, 40, 38, 28,
60, 57, 56, 52, 49, 46, 45, 43, 43, 42, 40, 36, 36, 33, 23,
85, 68, 73, 58, 69, 48, 43, 68, 64, 62, 44, 35, 31, 36, 19
)
y <- c(
'The coronavirus pandemic',
'Fairness of presidential elections',
'Health care',
'Jobs and employment',
'Foreign interference in presidential elections',
'Crime',
'Terrorism',
'Racial inequality',
'Climate change',
'Growing gap between rich and poor',
'Appointment of U.S. Supreme Court Justices',
'Abortion',
'The federal deficit',
'Immigration',
'Trade agreements with other countries'
)
x <- matrix(x, ncol = 3L, dimnames = list(y, c('R', 'All', 'D')))
dotplot(x, col = c('blue4', 'darkgrey', 'tomato2'))
box('outer')
prettypie2(mtcars$mpg, group = mtcars$gear)
barmap(c(1, 1, 1) / 3, region = 'Germany', cols = c('gold', 'red', 'black'))
voteGermany2013 <- structure(
list(
Party = c("CDU/CSU", "SPD", "LINKE", "GRUENE"),
Result = c(49.4, 30.5, 10.2, 10)
), class = "data.frame", row.names = c("1", "2", "3", "4")
)
with(voteGermany2013, {
barmap(Result / 100, region = 'Germany',
labels = sprintf('%s (%s%%)', Party, Result))
})
set.seed(1)
mat <- replicate(5, sample(1:10))
dimnames(mat) <- list(rownames(mtcars)[1:nrow(mat)],
paste0('time', 1:ncol(mat)))
bump(mat, mar = c(2, 0, 2, 9))
set.seed(1)
layout(matrix(c(1, 1, 1, 2:4), 3), widths = c(1, 1.5))
op <- par(las = 1L, mar = c(1, 1, 2, 2))
minbars(table(rbinom(500, 15, 0.5)), unit = 'Billion',
col = adjustcolor('tomato4', alpha.f = 0.5))
mtext('Group 1', at = par('usr')[1L], adj = 0)
for (ii in 1:3) {
minbars(table(rbinom(500, 15, 0.5)), unit = 'Million', min = 10,
horiz = FALSE, col = adjustcolor(ii, alpha.f = 0.5))
if (ii == 2L)
abline(h = grconvertY(0:1, 'nfc'), xpd = TRUE)
text(0, mean(par('usr')[3:4]), paste('Group', ii + 1L),
xpd = NA, srt = 90, adj = c(0.5, -1), cex = 1.5)
}
par(op)within.list(sessionInfo(), loadedOnly <- NULL)## R version 4.0.2 (2020-06-22)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS Mojave 10.14.6
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRblas.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] mapdata_2.3.0 maps_3.3.0 knitr_1.31 plotr_0.0.7