pre-chapter-script.Rmd

```{r pre-chapter-script, echo=FALSE}
#
# This script needs to run at the beginning of every chapter
#
# Include at the start of each chapter with:
# ```{r child = 'pre-chapter-script.Rmd'}
# ```
#
# Potentially, this could be done with the _bookdown.yml file using:
#    before_chapter_script: pre-chapter-script.R
# However, as of Dec 2020 this functionality is broken when using knit-then-merge builds
# see https://github.com/rstudio/bookdown/issues/1049
#

# restrict R output width so it won't overflow the PDF page width
#  - 64 for default Latex book document class
#  - 72 for krantz
#
options(width = 72)

# tidy all source code by default
# (this fails in a before_chapter_script)
#
knitr::opts_chunk$set(tidy = "styler")

#
# Output hook to wrap error messages which are intentionally displayed
# They don't get autowrapped by R.
# (this hook code fails in a before_chapter_script)
#
local({
  hook_old <- knitr::knit_hooks$get("error")  # save the old hook
  error_too_long_wrapper <- function(x, options) {
    # wrap x
    x <- paste(strwrap(x, 76), collapse="\n## ")
    x <- paste(x, "\n", sep="")
    # pass the new x to the old hook
    hook_old(x, options)
  }
  knitr::knit_hooks$set(error = error_too_long_wrapper)
})

# Output hook to wrap Call in summary(mod) and Model in anova
#
local({
  hook_old <- knitr::knit_hooks$get("output")  # save the old hook
  call_wrapper <- function(x, options) {
    # wrap x
    if(stringr::str_detect(x, "Model.*?\\+[ ]*\\n")) {
      x <- stringr::str_replace(x, "(?<=Model 1[\\S\\s]{63})[\\S\\s]{3}", "...")
      x <- stringr::str_replace(x, "(?<=Model 2[\\S\\s]{63})[\\S\\s]{3}", "...")
      x <- stringr::str_remove_all(x, "(?<=\\.\\.\\.)[\\S\\s]*?(?=\\n##[\\s]*?[MR])")
    }
    if(stringr::str_detect(x, "Call:")) {
      if(stringr::str_length(stringr::str_extract(x, "lm\\([\\s\\S]*?,")) > 73) {
        x <- stringr::str_replace(x, "(?<=lm[\\S\\s]{66})[\\S\\s]{3}", "...")
        x <- stringr::str_remove_all(x, "(?<=\\.\\.\\.)[\\S\\s]*?(?=\\n##[\\s]*?Residuals)") 
        x <- stringr::str_remove(x, "[\\s]*?\\n##(?=[\\s]*?\\.\\.\\.)")
      }
    }
    hook_old(x, options)
  }
  knitr::knit_hooks$set(output = call_wrapper)
})

#
#  Command to produce appropriate image credits
#
photo_credit <- function(figure=NULL, person, description=NULL, explanation, url=NULL) {
  # figure: (optional) Leave out for an inline figure, and for a floated figure give the r chunk name.
  # person: Name of person or persons to credit
  # description: (optional) "hovertext" sort of description for the image
  # explanation: why we have the rights to use this image
  # url: (optional) url linking to the image rights page

  # Always works out the output for both latex and html, then chooses at the end.
  lstring <- ''
  hstring <- ''

  # Handle the floating credit that actually appears with the image
  # Only do this for inline figures in latex, but always in html.
  if (is.null(figure)) {
      lstring <- paste(lstring, '\\hfill\\emph{\\footnotesize Image credit: ', person,'.}',sep='')
  }
  hstring <- paste(hstring, '<div class="photocredit" onclick = "this.getElementsByTagName(\'span\')[0].classList.toggle(\'show\')">',sep='')
  hstring <- paste(hstring, '<a>Image credit: ', person, '.</a>',sep='')
  
  # Handle the fully detailed photo credit
  lstring <- paste(lstring,"\\photocredit{",sep='')
  hstring <- paste(hstring,'<span class="photocreditpopup" id="myPopup"><b>Image Credit</b><br/>',sep='')
  
  if (!is.null(description)) {
    lstring <- paste(lstring,'[',description,'] ',sep='')
  }
  if (!is.null(figure)) {
    lstring <- paste(lstring,'{\\bf Figure \\ref{fig:',figure,'}}. ',sep='')
  }
  if (!is.null(person)) {
    lstring <- paste(lstring,'\\emph{',person,'.}',sep='')
    hstring <- paste(hstring,person,'. ',sep='')
  }
  lstring <- paste(lstring, explanation)
  hstring <- paste(hstring, ' ', explanation, ' ', sep='')
  
  if (!is.null(url)) {
    lstring <- paste(lstring, ' \\url{', url, '}', sep='')
    hstring <- paste(hstring,'<a href="',url,'">',url,'</a>',sep='')
  }
  
  lstring <- paste(lstring,'}',sep='')
  hstring <- paste(hstring,'</span></div>',sep='')
  
  if (knitr::is_latex_output()) {
    knitr::asis_output(lstring)
  } else {
    knitr::asis_output(hstring)
  }
}
```

```{r pre-chapter-latex-only, echo=FALSE, include=knitr::is_latex_output()}
#
# LaTeX only portion
#

#
# Set chapter number for single chapter PDF builds.
# The Makefile produces the chapterfile, which contains the
# chapter number it's trying to build.
#
local({
chapterfile <- "_single_chapter_build_number.txt"
if (file.exists(chapterfile)) {
  x <- scan(chapterfile, what = list(p=0))
  if (x$p > 0) {
    cstring <- paste('\\setcounter{chapter}{',x$p-1,'}',sep='')
    knitr::asis_output(cstring)
  }
}
})
```

```{r pre-chapter-setup, echo=FALSE}
#
# Force R v4 behavior stringsAsFactors = FALSE
#
options(stringsAsFactors = FALSE)

#
# load ggplot and dplyr, needed for (almost) all chapters
#
suppressMessages(suppressWarnings(library(ggplot2)))
suppressMessages(suppressWarnings(library(dplyr)))

set.seed(3850)  # so our book is not random
```