In raredd/rawr: rawr miscellaneous

rawr

personal package with miscellaneous functions, stuff in progress, and tools I use regularly

to install:

# install.packages('devtools')
devtools::install_github('raredd/rawr')

some useful things for ...

library('rawr')

options(width = 100)

library('knitr')
opts_chunk$set(fig.width = 10, fig.height = 8)

survival analysis

library('survival')
s <- survfit(Surv(time, status) ~ factor(ph.ecog), cancer)

## kaplan-meier with a whole bunch of extra junk
kmplot(
  s,
  atrisk.col = TRUE, strata.lab = TRUE,
  median = TRUE, hr_text = TRUE, pw_test = TRUE
)

## convenience function for survival analysis
kmplot_by(
  'factor(ph.ecog)', time = 'time', event = 'status', cancer,
  tt_test = TRUE, by = 'sex', strata_lab = FALSE, atrisk.type = 'survival',
  atrisk.col = TRUE, median = TRUE, hr_text = TRUE, pw_test = TRUE
)

## get the pairwise differences easily
survdiff_pairs(s)

## make a summary table
combine_table(
  surv_table(s),
  caption = 'Survival summary'
)

misc plots

box plot + violin plot + dot plot + testing + ...

tplot(
  mpg ~ vs + gear, mtcars, test = TRUE,
  type = c('dv', 'v', 'd', 'db', 'b', 'd'),
  ## options for violin plots
  quantiles = c(0.25, 0.5, 0.75), lwd = c(1, 2.5, 1)
)

heatmap + row/column matrices + formatting

x <- scale(as.matrix(mtcars))

## row and column colors
rc <- cbind(gear = x[, 'gear'], am = x[, 'am'], vs = x[, 'vs'])
rc[] <- palette()[rc + 2L]

cc <- rbind(var1 = nchar(colnames(x)), var2 = nchar(sort(colnames(x))))
cc[] <- palette()[cc]

heatmap.3(
  x, scale = 'column', distfun = 'spearman', hclustfun = 'ward.D2',
  RowSideColors = rc, ColSideColors = cc,
  labRowCol = rc[, 3], labColCol = cc[1, ],
  margins = c(5, 10),
  colsep = c(2, 6), rowsep = c(9, 14, 21), sepwidth = c(5, 2)
)

binomial CI forest plot

dat <- mtcars[sample(nrow(mtcars), 100L, TRUE), ]
dat[1, 2] <- NA
vv  <- c('cyl', 'vs', 'gear', 'carb')
dat$gear <- factor(dat$gear, 3:6)

bplot(
  dat, setNames(vv, case(vv)), 'am',
  col = c('red', 'grey50', 'blue', 'grey50', 'blue'),
  conf = 0.9, alpha_missing = 0.4
)

stat things

tests for doubly- (jonckheere-terpstra) or singly-ordered (kruskal-wallis) tables

tbl <- table(mtcars$gear, mtcars$cyl)
# fisher.test(tbl)
jt.test(tbl)

kw.test(tbl, simulate.p.value = TRUE)

test for ordered kruskal-wallis rank-sum

# kruskal.test(mpg ~ cyl, mtcars)
cuzick.test(mpg ~ cyl, mtcars)

knitr/convenience things

basically a table

tabler_by2(
  mtcars, c('gear', 'vs'), 'cyl',
  stratvar = 'am', n = table(mtcars$am),
  zeros = '-', pct = TRUE, pct.total = TRUE
)

basically a table

tabler_stat2(
  within(mtcars, cyl <- factor(cyl, ordered = TRUE)),
  c('Miles/gal' = 'mpg', 'Engine (V/S)' = 'vs', Cylinders = 'cyl'),
  c('# of gears' = 'gear'), correct = 'BH',
  htmlArgs = list(caption = 'Table 1.')
)

a table, basically

set.seed(1)
r <- c('CR', 'PR', 'SD', 'PD', 'NE')
x <- factor(sample(r, 30, replace = TRUE), r)

table(x)
t(t(tabler_resp(x, 3:1)))

in-line convenience functions

intr(mtcars$mpg)
intr(mtcars$mpg, conf = 0.95)

countr(mtcars$cyl)
countr(table(mtcars$vs), frac = TRUE)

for survival analysis

surv_median(s)
surv_median(s, ci = TRUE)

surv_prob(s)
surv_prob(s, times = c(1, 3) * 100, ci = TRUE)

## unexported but useful (log-rank, pair-wise log-rank, tarone trend, wald)
rawr:::lr_pval(s)
rawr:::pw_pval(s)
rawr:::tt_pval(s)
rawr:::hr_pval(s)

stats

binconr(25, 50)
binconr(25, 50, show_conf = FALSE, frac = TRUE, percent = FALSE)

## length 2 vectors assume two-stage confidence intervals
binconr(c(10, 25), c(20, 30), show_conf = FALSE, frac = TRUE)


## p-values
pvalr(1e-3)
pvalr(1e-8, show.p = TRUE)

in-line test summaries

x <- mtcars$vs
y <- mtcars$am

# fisher.test(x, y)
inl_fisher(x, y)
inl_fisher(x, y, details = FALSE)

# chisq.test(table(x, y))
inl_chisq(x, y)
inl_chisq(x, y, details = FALSE)

# wilcox.test(mtcars$mpg ~ y)
inl_wilcox(mtcars$mpg, y)

# cuzick.test(mpg ~ gear, mtcars)
inl_cuzick(mtcars$mpg, mtcars$gear)

# jt.test(table(mtcars$gear, mtcars$cyl))
inl_jt(mtcars$gear, mtcars$cyl)

# kw.test(table(mtcars$vs, mtcars$cyl))
inl_kw(mtcars$vs, mtcars$cyl)

etc

iprint(letters[1:3])
iprint(letters[1:3], copula = ' & ')

num2char(-5)
num2char(134)

raredd/rawr documentation built on April 29, 2024, 10:29 a.m.