README.Rmd

---
title: README
output:
  md_document:
    toc: yes
    variant: gfm
---

```{r, echo = FALSE}
library('plotr')
library('knitr')

knitr::opts_chunk$set(
  fig.align = 'center', fig.path = 'inst/etc/', fig.width = 8
)
```

## plotr

miscellaneous plots and things

---

## Installation

```r
# install.packages('devtools')
devtools::install_github('raredd/plotr')
```

## these are actually useful

### barplot2

```{r barplot2}
## 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)})
```

### methods for tsne, pca, umap

```{r dimr}
## 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)
```

### loess_smooth

```{r loess_smooth}
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')
```

### tableplot

```{r tableplot}
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
)
```

### scattergram

```{r scattergram}
with(mtcars, {
  scattergram(mpg, wt, cyl, col = rainbow(3), pch = 16)
})
```

## ggplot-style base plots

```{r gplot}
gplot(1:10, col = ggcols(10), pch = 16, cex = 5)

gmatplot(1:10, matrix(rnorm(100), 10), type = 'l', col = ggcols(10))
```

see all:

```{r}
grep('^g[^g]', ls('package:plotr'), value = TRUE)
```

## Some useful and not-so-useful plots and tools

### shist

```{r shist}
set.seed(1)
x <- lapply(sample(1:10, 4), rpois, n = 500)
shist(x)
```

### propfall

```{r propfall}
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'))
```

### bibar

```{r bibar}
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')
```

### dose_esc

```{r dose_esc, fig.height=10, fig.width=10}
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))
```

### boxline

```{r boxline}
set.seed(1)
x <- lapply(0:10, function(x) rnorm(25, x / 2, sd = 0.5))
boxplot(x)
boxline(x, add = TRUE)
```

### inbar

```{r inbar}
set.seed(1)
tbl <- sapply(1:3, function(x) sort(rpois(3, 10), decreasing = TRUE))
inbar(tbl, col = 1:3)
```

### tracebar

```{r tracebar}
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)
```

### toxplot

```{r toxplot, fig.width=10, fig.height=10}
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
```

### spider

```{r spider}
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)
})
```

### dotplot

```{r dotplot, fig.height=10, fig.width=8}
# 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')
```

## not so useful

### prettypie2

```{r prettypie2}
prettypie2(mtcars$mpg, group = mtcars$gear)
```

### barmap

```{r barmap}
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))
})
```

### bump

```{r bump}
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))
```

### minbars

```{r minbars}
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)
```

## Session info

```{r}
within.list(sessionInfo(), loadedOnly <- NULL)
```