hockey_vignette.R
In BRcal: Boldness-Recalibration of Binary Events

## ----include = FALSE----------------------------------------------------------
# Save original options and par to reset at the end
original_options <- options()
original_par <- par(no.readonly=TRUE)

# save the built-in output hook
hook_output <- knitr::knit_hooks$get("output")

# set a new output hook to truncate text output
knitr::knit_hooks$set(output = function(x, options) {
  if (!is.null(ns <- c(options$out.lines.head,
                       options$out.lines.tail))) {
    x <- xfun::split_lines(x)
    if (length(x) > sum(ns)) {
      # truncate the output
      x <- c(head(x, ns[1]), "...\n", tail(x, ns[2]))
    }
    x <- paste(x, collapse = "\n")
  }
  hook_output(x, options)
})

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = ">"
)

library(ggplot2)
library(devtools)
library(gridExtra)

## ----eval=FALSE---------------------------------------------------------------
#  # Install via github
#  devtools::install_github("apguthrie/BRcal")

## ----eval=FALSE---------------------------------------------------------------
#  # Install via tarball
#  install.packages("path_to_file\BRcal_1.0.0.tar.gz", repos = NULL, type="source")

## ----eval=FALSE---------------------------------------------------------------
#  # Install via CRAN
#  install.packages("BRcal")

## ----setup--------------------------------------------------------------------
library(BRcal)

## -----------------------------------------------------------------------------
data("hockey")

## -----------------------------------------------------------------------------
bt538 <- bayes_ms(hockey$x, hockey$y)
bt538

## -----------------------------------------------------------------------------
bayes_ms(hockey$x, hockey$y, Pmc=0.2)

## -----------------------------------------------------------------------------
llo_lrt(hockey$x, hockey$y)

## ----out.lines.head=4, out.lines.tail=23--------------------------------------
mle_recal(hockey$x, hockey$y)

## ----out.lines.head=3, out.lines.tail=3---------------------------------------
mle_recal(hockey$x, hockey$y, probs_only=TRUE)

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lineplot(hockey$x, hockey$y)

## ----br90, cache=TRUE, out.lines.head=12, out.lines.tail=9--------------------
br90 <- brcal(hockey$x, hockey$y, t=0.9)

## ----out.lines.head=43, out.lines.tail=3--------------------------------------
br90

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lineplot(x=hockey$x, y=hockey$y, t_levels = c(0.95, 0.9))

## ----br90_tau, cache=TRUE, out.lines.head=12, out.lines.tail=9----------------
br90_tau <- brcal(hockey$x, hockey$y, t=0.9, tau=TRUE)

## ----out.lines.head=43, out.lines.tail=3--------------------------------------
br90_tau

## ----out.lines.head=12, out.lines.tail=14-------------------------------------
try(brcal(hockey$x, hockey$y, x0 = c(10, -5), start_at_MLEs = FALSE))

## ----out.lines.head=8, out.lines.tail=9---------------------------------------
br90_inMMA <- brcal(hockey$x, hockey$y, t=0.9, 
                    opts=list(local_opts=list(algorithm="NLOPT_LD_MMA")))

## -----------------------------------------------------------------------------
br90_inMMA$nloptr

## ----out.lines.head=8, out.lines.tail=9---------------------------------------
br90_outMMA <- brcal(hockey$x, hockey$y, t=0.9, x0=c(1, 2), start_at_MLEs = FALSE,
                     xtol_rel_outer = 1e-05, 
                     opts=list(algorithm="NLOPT_LD_MMA"))

## -----------------------------------------------------------------------------
br90_outMMA$nloptr

## ----out.lines.head=8, out.lines.tail=9---------------------------------------
br90_bound <- brcal(hockey$x, hockey$y, t=0.9, lb=c(0.25, -Inf), ub=c(5, Inf))

## -----------------------------------------------------------------------------
br90_bound$nloptr

## ----out.lines.head=8, out.lines.tail=9---------------------------------------
br90_stop <- brcal(hockey$x, hockey$y, t=0.9, maxeval=100, maxtime = 30, 
      xtol_rel_outer = 0.001, xtol_rel_inner = 0.001)

## -----------------------------------------------------------------------------
br90_stop$nloptr

## ----br95_2, cache=TRUE, out.lines.head=6, out.lines.tail=7-------------------
br90 <- brcal(hockey$x, hockey$y, t=0.9, print_level=1)

## ----br95_3, cache=TRUE, out.lines.head=9, out.lines.tail=10------------------
br90 <- brcal(hockey$x, hockey$y, t=0.9, print_level=2)

## ----br95, cache=TRUE, out.lines.head=12, out.lines.tail=9--------------------
br90 <- brcal(hockey$x, hockey$y, t=0.9, print_level=0)

## -----------------------------------------------------------------------------
bayes_ms(hockey$x, hockey$y, par = c(10, -5))

## -----------------------------------------------------------------------------
bayes_ms(hockey$x, hockey$y, control=list(reltol=1e-10))

## -----------------------------------------------------------------------------
bayes_ms(hockey$x, hockey$y, method = "L-BFGS-B", lower = c(0, -1), upper = c(10, 25))

## -----------------------------------------------------------------------------
bayes_ms(hockey$x, hockey$y, method = "L-BFGS-B", 
         lower = c(0, -Inf), upper = c(Inf, Inf))

## -----------------------------------------------------------------------------
bayes_ms(hockey$x, hockey$y, optim_details=FALSE)

## -----------------------------------------------------------------------------
br <- brcal(hockey$x, hockey$y, t=0.9, print_level = 0,
            optim_options=list(method="L-BFGS-B", 
                               lower=c(0.0001, 10), 
                               upper=c(0.0001, 10), 
                               control=list(maxit=200)))
br$nloptr

## ----out.lines.head=3, out.lines.tail=3---------------------------------------
hockey$x_mle <- LLO(x=hockey$x, delta=bt538$MLEs[1], gamma=bt538$MLEs[2])
hockey$x_mle

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
# plot original vs LLO-adjusted via MLEs
ggplot2::ggplot(data=hockey, mapping=aes(x=x, y=x_mle)) +
  stat_function(fun=LLO,
                args=list(delta=bt538$MLEs[1], 
                          gamma=bt538$MLEs[2]),
                geom="line",
                linewidth=1,
                color="black",
                xlim=c(0, 1)) +
  geom_point(aes(color=winner), alpha=0.75, size=2) +
  lims(x=c(0,1), y=c(0,1)) +
  labs(x="Original", y="LLO(x, 2, 2)", color="Winner") +
  theme_bw()

## ----out.lines.head=3, out.lines.tail=3---------------------------------------
LLO(x=hockey$x, br90$BR_params[1], br90$BR_params[2])

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
# LLO-adjust using delta=2, gamma=1000
hockey$x2 <- LLO(hockey$x, delta=2, gamma=1000)

# plot original vs LLO-adjusted via 2,2
ggplot2::ggplot(data=hockey, mapping=aes(x=x, y=x2)) +
  stat_function(fun=LLO,
                args=list(delta=2, gamma=1000),
                geom="line",
                linewidth=1,
                color="black",
                xlim=c(0, 1)) +
  geom_point(aes(color=winner), alpha=0.75, size=2) +
  lims(x=c(0,1), y=c(0,1)) +
  labs(x="Original", y="LLO(x, 2, 1000)", color="Winner") +
  theme_bw()

## -----------------------------------------------------------------------------
bayes_ms(hockey$x, hockey$winner, event="home", optim_details=FALSE)

## -----------------------------------------------------------------------------
bayes_ms(1-hockey$x, hockey$y, event=0, optim_details=FALSE)

## -----------------------------------------------------------------------------
bayes_ms(1-hockey$x, hockey$winner, event="away", optim_details=FALSE)

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
plot_params(hockey$x, hockey$y)

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
plot_params(hockey$x, hockey$y, dlim=c(0.5, 1.5), glim=c(0.25, 2.75))

## ----eval=FALSE, fig.align='center', fig.height=4, fig.width=6, include=TRUE----
#  plot_params(hockey$x, hockey$y, k=200, dlim=c(0.5, 1.5), glim=c(0.25, 2.75))

## ----echo=FALSE, fig.align='center', fig.height=4, fig.width=6----------------
zmat_list <- plot_params(hockey$x, hockey$y, k=200, dlim=c(0.5, 1.5), glim=c(0.25, 2.75), 
                         return_z = TRUE)

## ----save_z, eval=FALSE, fig.align='center', fig.height=4, fig.width=6, include=TRUE----
#  zmat_list <- plot_params(hockey$x, hockey$y, k=200, dlim=c(0.5, 1.5), glim=c(0.25, 2.75),
#                           return_z = TRUE)

## ----echo=FALSE, fig.align='center', fig.height=4, fig.width=6----------------
plot_params(z=zmat_list$z, k=200, dlim=c(0.5, 1.5), glim=c(0.25, 2.75))

## ----out.lines.head=4, out.lines.tail=9---------------------------------------
zmat_list

## -----------------------------------------------------------------------------
class(zmat_list$z)
dim(zmat_list$z)

## ----fig.width=8, fig.height=4, fig.align='center'----------------------------
par(mfrow=c(1,3))
plot_params(z=zmat_list$z, k=200, dlim=c(0.5, 1.5), glim=c(0.25, 2.75), main="Same range as z")
plot_params(z=zmat_list$z, k=200, dlim=c(0.7, 1.3), glim=c(0.5, 2.5), main="Smaller range than z")
plot_params(z=zmat_list$z, k=200, dlim=c(1e-04, 5), glim=c(1e-04, 5), main="Larger range than z")

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
plot_params(z=zmat_list$z, t_levels=c(0.95, 0.9, 0.8),
            k=200, dlim=c(0.5, 1.5), glim=c(0.25, 2.75))

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
plot_params(z=zmat_list$z, t_levels=c(0.99, 0.95, 0.9, 0.8, 0.7),
            k=200, dlim=c(0.5, 1.5), glim=c(0.25, 2.75), contours_only=TRUE)

## ----fig.width=6, fig.height=6, fig.align='center'----------------------------
plot_params(z=zmat_list$z, k=200, dlim=c(0.5, 1.5), glim=c(0.25, 2.75),
            imgplt_options=list(horizontal = TRUE, nlevel=10, legend.lab="Posterior Model Prob"))

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
plot_params(z=zmat_list$z, k=200, dlim=c(0.5, 1.5), glim=c(0.25, 2.75), t_levels = c(0.99, 0.1), 
            contour_options=list(lty = "dotted", col="hotpink", lwd=2))

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lineplot(x=hockey$x, y=hockey$y)

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lineplot(x=hockey$x, y=hockey$y, t_levels = c(0.95, 0.9, 0.8))

## -----------------------------------------------------------------------------
lp <- lineplot(x=hockey$x, y=hockey$y, return_df = TRUE, t_levels = c(0.95, 0.9, 0.8))

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lp$plot

## ----out.lines.head=7, out.lines.tail=6---------------------------------------
lp$df

## -----------------------------------------------------------------------------
summary(lp$df)

## -----------------------------------------------------------------------------
nrow(lp$df)

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lineplot(df=lp$df, t_levels=c(0.95, 0.9, 0.8))

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lineplot(df=lp$df, t_levels=c(0.95))

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lineplot(df=lp$df, t_levels=c(0.95, 0.9, 0.8), plot_original=FALSE)

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lineplot(df=lp$df, t_levels=c(0.95, 0.9, 0.8), ggpoint_options=list(size=3, shape=1))

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lineplot(df=lp$df, t_levels=c(0.95, 0.9, 0.8), ggline_options=list(linewidth=2, alpha=0.1))

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lineplot(df=lp$df, t_levels=c(0.95, 0.9, 0.8)) + 
  scale_color_manual(values = c("orchid", "darkgreen"))

## ----fig.width=10, fig.height=4, fig.align='center'---------------------------
lp1 <- lineplot(df=lp$df, t_levels=c(0.95, 0.9, 0.8), thin_to=500)
lp2 <- lineplot(df=lp$df, t_levels=c(0.95, 0.9, 0.8), thin_prop=0.5)
lp3 <- lineplot(df=lp$df, t_levels=c(0.95, 0.9, 0.8), thin_by=2)
gridExtra::grid.arrange(lp1, lp2, lp3, ncol=3)

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lineplot(df=lp$df, t_levels=c(0.95, 0.9, 0.8), thin_to=500, seed = 47)

## ----fig.width=6, fig.height=4, fig.align='center'----------------------------
lineplot(df=lp$df, t_levels=c(0.95, 0.9, 0.8), thin_to=500, seed=NULL)

## ----include=FALSE------------------------------------------------------------
# Reset user options and par
options(original_options)
par(original_par)