inst/doc/tutorial.R

In EloSteepness: Bayesian Dominance Hierarchy Steepness via Elo Rating and David's Scores

params <-
list(EVAL = TRUE)

## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  eval = if (isTRUE(exists("params"))) params$EVAL else FALSE, # deal with CRAN
  comment = "#>"
)

library(xtable)
compile_start <- Sys.time()
# store original pars to satisfy CRAN (needs to be restored at the end)
ori_pars <- par(no.readonly = TRUE)

## ---- echo=FALSE--------------------------------------------------------------
suppressPackageStartupMessages(library(EloSteepness))

## ----setup, eval = FALSE------------------------------------------------------
#  library(EloSteepness)

## -----------------------------------------------------------------------------
data("dommats", package = "EloRating")
mat <- dommats$badgers

## ----badgermatrix, fig.retina= 2, echo=FALSE, fig.width=6, fig.height=2.8, out.width="50%", fig.align="center", fig.cap="An example network of seven badgers."----
par(family = "serif", mar = c(0.1, 1.6, 1.1, 0.1), cex = 1.3)
EloSteepness:::plot_matrix(mat, greyout = 0)

## ---- echo=FALSE--------------------------------------------------------------
set.seed(12345)

## ----elo_steep_01, cache=TRUE-------------------------------------------------
elo_res <- elo_steepness_from_matrix(mat = mat, n_rand = 2, refresh = 0, 
                                     cores = 2, iter = 1000, seed = 1)

## -----------------------------------------------------------------------------
summary(elo_res)

## ----elo01_plot1, fig.retina= 2, echo=2:2, fig.width=7, fig.height=4.7, out.width="70%", fig.align='center'----
par(family = "serif")
plot_steepness(elo_res)

## -----------------------------------------------------------------------------
p <- steepness_precis(elo_res, quantiles = c(0.055, 0.25, 0.75, 0.945))
round(p, 2)

## ---- eval = FALSE------------------------------------------------------------
#  elo_res$steepness

## ---- eval=FALSE--------------------------------------------------------------
#  hist(elo_res$steepness, xlim = c(0, 1))

## ---- eval = FALSE------------------------------------------------------------
#  elo_res$stanfit

## ----elo01_plot2, fig.retina= 2, echo=2:3, fig.width=7, fig.height=4.7, out.width="70%", fig.align='center'----
par(family = "serif")
my_colors <- hcl.colors(n = 7, palette = "zissou1", alpha = 0.7)
plot_scores(elo_res, color = my_colors)

## -----------------------------------------------------------------------------
my_scores <- scores(elo_res, quantiles = c(0.055, 0.945))

## ---- eval=FALSE--------------------------------------------------------------
#  my_scores

## ---- results='asis', echo=FALSE----------------------------------------------
print(xtable(my_scores), comment = FALSE, include.rownames = FALSE)

## ----elo01_plot3, fig.retina= 2, echo=2:2, fig.width=7, fig.height=4.7, out.width="70%", fig.align='center'----
par(family = "serif")
plot_scores(elo_res, color = my_colors, subset_ids = "d")

## ----elo01_plot4, fig.retina= 2, echo=2:2, fig.width=7, fig.height=4.7, out.width="70%", fig.align='center'----
par(family = "serif")
plot_scores(elo_res, color = my_colors, subset_ids = "a")

## ----elo01_plot5, fig.retina= 2, echo=2:2, fig.width=7, fig.height=4.7, out.width="70%", fig.align='center'----
par(family = "serif")
plot_scores(elo_res, color = my_colors, subset_ids = c("b", "c"))

## ----elo01_plot6, fig.retina= 2, echo=2:2, fig.width=7, fig.height=4.7, out.width="70%", fig.align='center'----
par(family = "serif")
plot_steepness_regression(elo_res, color = my_colors, width_fac = 0.5)

## -----------------------------------------------------------------------------
data("dommats", package = "EloRating")
mat <- dommats$badgers

set.seed(123)
mat1 <- mat / 2
und <- mat1 - floor(mat1) != 0
mat1[und] <- round(mat1[und] + runif(sum(und), -0.1, 0.1))
mat1["f", "d"] <- 1 # just make sure that 'd' keeps its one loss to 'f'

## -----------------------------------------------------------------------------
mat2 <- mat * 2

## ----elo_steep_02, cache=TRUE-------------------------------------------------
elo_res_half <- elo_steepness_from_matrix(mat = mat1, n_rand = 2, refresh = 0, 
                                          cores = 2, iter = 1000, seed = 2)
elo_res_doubled <- elo_steepness_from_matrix(mat = mat2, n_rand = 2, refresh = 0, 
                                             cores = 2, iter = 1000, seed = 3)

## ----elo02_plot1, fig.retina= 2, echo=2:10, fig.width=9, fig.height=6.5, out.width="90%", fig.align='center'----
par(mfrow = c(2, 3), family = "serif")
plot_steepness(elo_res_half)
plot_steepness(elo_res)
plot_steepness(elo_res_doubled)

plot_scores(elo_res_half, color = my_colors)
plot_scores(elo_res, color = my_colors)
plot_scores(elo_res_doubled, color = my_colors)

## ----simu_elo_ex_1, cache=TRUE------------------------------------------------
set.seed(123)

# generate matrices
m1 <- simple_steep_gen(n_ind = 6, n_int = 40, steep = 0.9)$matrix
m2 <- m1 * 2
m5 <- m1 * 5

# calculate steepness
r1 <- elo_steepness_from_matrix(mat = m1, n_rand = 2, cores = 2, iter = 1000, 
                                seed = 1, refresh = 0)
r2 <- elo_steepness_from_matrix(mat = m2, n_rand = 2, cores = 2, iter = 1000,
                                seed = 2, refresh = 0)
r5 <- elo_steepness_from_matrix(mat = m5, n_rand = 2, cores = 2, iter = 1000, 
                                seed = 3, refresh = 0)

## ----simu_elo_ex_plot1, fig.retina= 2, echo=2:15, fig.width=9, fig.height=5.8, out.width="90%", fig.align='center'----
par(mfrow = c(2, 3), family = "serif", mar = c(3.5, 2.5, 1, 1))
mycols <- hcl.colors(6, palette = "Dark 2", alpha = 0.7)

plot_steepness(r1)
plot_steepness(r2)
plot_steepness(r5)

plot_scores(r1, color = mycols)
plot_scores(r2, color = mycols)
plot_scores(r5, color = mycols)

## -----------------------------------------------------------------------------
data("baboons1", package = "EloRating")

## ---- echo=FALSE--------------------------------------------------------------
s <- baboons1[1:200, ]

## ----babsteep, echo = 2:10, cache=TRUE----------------------------------------
# babseq <- elo_steepness_from_sequence(winner = s$Winner, loser = s$Loser, refresh = 100, cores = 4)
s <- baboons1[1:200, ]
babseq <- elo_steepness_from_sequence(winner = s$Winner,
                                      loser = s$Loser,
                                      refresh = 0,
                                      cores = 2,
                                      seed = 1,
                                      iter = 1000)

## ----elo_bab_plot1, fig.retina= 2, echo=2:10, fig.width=10, fig.height=3, out.width="100%", fig.align='center'----
par(family = "serif", mfrow = c(1, 3))
plot_steepness(babseq)
plot_scores(babseq)
plot_steepness_regression(babseq, width_fac = 0.2)

## ----elo_bab_plot2, fig.retina= 2, echo=2:100, fig.width=9, fig.height=5, out.width="60%", fig.align='center'----
par(family = "serif")

# extract number of interactions
ints <- table(c(s$Winner, s$Loser))
ints <- ints[order(names(ints))]
# get the scores for all individuals
the_scores <- scores(babseq)
the_scores <- the_scores[order(the_scores$id), ]

plot(as.numeric(ints), the_scores$q955 - the_scores$q045,
     xlab = "interactions", ylab = "width of credible interval", las = 1)

## -----------------------------------------------------------------------------
data("dommats", package = "EloRating")
mat <- dommats$badgers

## ----david_steep_01, cache=TRUE-----------------------------------------------
david_res <- davids_steepness(mat, refresh = 0, seed = 1, iter = 1000, cores = 2)

## ----david_steep_01_plot1, fig.retina= 2, fig.height=4.5, fig.width=7, out.width="70%", fig.align='center', echo=2:2----
par(family = "serif", mar = c(3.5, 2.5, 1, 1))
plot_steepness(david_res)

## -----------------------------------------------------------------------------
summary(david_res)

## -----------------------------------------------------------------------------
round(steepness_precis(david_res), 2)

## ----david_steep_01_plot2, fig.retina= 2, fig.height=4.5, fig.width=7, out.width="70%", fig.align='center', echo=2:2----
par(family = "serif", mar = c(3.5, 2.5, 1, 1))
plot_scores(david_res)

## ---- eval=FALSE--------------------------------------------------------------
#  scores(david_res)

## ---- results='asis', echo=FALSE----------------------------------------------
# knitr::kable(my_scores, digits = 3)
my_scores <- scores(david_res)
print(xtable(my_scores), comment = FALSE, include.rownames = FALSE)

## ----david_steep_01_plot3, fig.retina= 2, fig.height=4.5, fig.width=7, out.width="70%", fig.align='center', echo=2:2----
par(family = "serif", mgp = c(2, 0.8, 0), mar = c(3.5, 3.5, 1, 1), tcl = -0.4)
plot_steepness_regression(david_res, width_fac = 1)

## ---- echo=FALSE, eval = TRUE-------------------------------------------------
# this is forced to be evaluated!
stime <- "unknown"
if (identical(Sys.getenv("NOT_CRAN"), "true")) {
  stime <- round(as.numeric(difftime(time2 = compile_start, time1 = Sys.time(), units = "mins")), 1)
}

## ---- eval = TRUE, echo=FALSE, include=FALSE----------------------------------
# this is forced to be evaluated!
# reset original par
par(ori_pars)