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
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.