R/reportR.R

In emwozniak/reportR: Miscellaneous tools to stylize reports

############################
# Customized ggplot2 theme #
############################

custom_theme <- function (base_size = 18, 
                          base_family = "serif") {
  theme_grey(base_size = 18, base_family = base_family) %+replace% 
    theme(
      # Serif font, larger text, more whitespace between axes and labels
      text = element_text(family = base_family, 
                          face   = "plain", 
                          colour = "black", 
                          size   = base_size,
                          hjust  = 0.5, 
                          vjust  = 0.5, 
                          angle  = 0, 
                          lineheight = 0.9),
      axis.text = element_text(size   = rel(0.8), 
                               colour = "black"), 
      axis.ticks = element_line(colour = "black"), 
      axis.title.x = element_text(vjust = 0.4),
      axis.title.y = element_text(angle = 90, 
                                  vjust = 3),
      
      # Smaller legend with solid white background
      legend.key = element_rect(fill   = "white", 
                                colour = "white"),
      legend.text = element_text(size = rel(0.9)),
      legend.title = element_blank(),
      
      # Border around plot and slightly darker gridlines
      panel.background = element_rect(fill = "white", 
                                      colour = NA), 
      panel.border = element_rect(fill = NA, 
                                  colour = "black"), 
      panel.grid.major = element_line(colour = "gray91", 
                                      size = 0.2), 
      panel.grid.minor = element_line(colour = "gray97", 
                                      size = 0.5), 
      
      # Bolder facetting labels 
      strip.background = element_rect(fill = "grey85", 
                                      colour = NA),
      
      strip.text.x = element_text(size = 20, 
                                  face = "bold"),
      strip.text.y = element_text(size = 20, 
                                  face = "bold"),
      
      plot.background = element_rect(colour = "white"),
      
      # Larger title with more whitespace
      plot.title = element_text(size = rel(1.3), 
                                vjust = 0)
    )
}

#################################
# CSS style for knitr reporting #
#################################
sink_css <-  function(dir         = getwd(), 
                      font_body   = "Palatino Linotype", 
                      font_table  = "Palatino Linotype",
                      font_header = "Palatino Linotype",
                      font_size   = 11, 
                      max_width   = 45) {
  
  sink(paste(dir, "/style.css", sep = ""))
  cat(
          "body  {",
    paste("  font-family: ", font_body, ";", sep = ""),
    paste("  font-size: ", as.character(font_size), "pt;", sep = ""),
          "  background-color: white;",
          "  padding-top: 1em;",
          "  margin: auto;",
    paste("  max-width: ", as.character(max_width), "em;", sep = ""),
          "}",
          " ",
          "p {",
          "  padding: 0;",
          "  margin: 0;",
          "  margin-bottom: 10pt;",
          "}",
          " ",
          "table{",
          "  margin: auto;",
          "  margin-top: 1em;",
          "  margin-bottom: 1em;",
          "  border: none;",
          "}",
          " ",
          "td, tr{",
    paste("  font: ", as.character(ceiling(font_size*0.91)), "pt ", font_table, ";", sep=""),
          "  padding: 0px;",
          "  margin: 0px;",
          "}",
          " ",
          "td {",
          "  padding: 4px;",
          "  padding-bottom: 2px;",
          "}",
          " ",
          "h1, h2, h3, h4, h5, h6 {",
          "  margin: 10pt 0pt 0pt 0pt;",
    paste("  font-family: ", font_header, ";", sep = ""),
          "  font-weight: bold;",
          "}",
          " ",
          "h1 {",
          "  margin: 24pt 0pt 0pt 0pt;",
    paste("  font-size: ", as.character(ceiling(font_size*1.45)), "pt;", sep = ""),
          "  color: #365F91;",
          "}",
          " ",
          "h2 {",
    paste("  font-size: ", as.character(ceiling(font_size*1.27)), "pt;", sep = ""),
          "  color: #4F81BD;",
          "}",
          " ",
          "h3 {",
    paste("  font-size: ", font_size, "pt;", sep = ""),   
          "  color: #4F81BD;",
          "}",
          " ",
          "h4 {",
    paste("  font-size: ", font_size, "pt;", sep = ""),   
          "  font-weight: bold;",
          "  font-style: italic;",
          "  color: #4F81BD;",
          "}",
          " ",
          "h5 {",
    paste("  font-size: ", font_size, "pt;", sep = ""),   
          "  font-weight: normal;",
          "  color: #243F5D;",
          "}",
          " ",
          "h6 {",
    paste("  font-size: ", font_size, "pt;", sep = ""),   
          "  font-weight: normal;",
          "  font-style: italic;",
          "  color: #243F5D;",
          "}",
          " ",
          "tt, code, pre {",
          "  font-family: 'DejaVu Sans Mono', 'Droid Sans Mono', 'Lucida Console', Consolas, Monaco, monospace;",
          "}",
          " ",
          "a:visited {",
          "  color: rgb(50%, 0%, 50%);",
          "}",
          " ",
          "pre {",  
          "  margin-top: 0;",
          "  max-width: 95%;",
          "  border: 1px solid #ccc;",
          "  white-space: pre-wrap;",
          "}",
          " ",
          "pre code {",
          "  display: block; padding: 0.5em;",
          "}",
          " ",
          "code.r, code.cpp {",
          "  background-color: #F8F8F8;",
          "}",
          " ",
          "blockquote {",
          "  color:#666666;",
          "    margin:0;",
          "  padding-left: 1em;",
          "  border-left: 0.5em #EEE solid;",
          "}",
          " ",
          "hr {",
          "  height: 0px;",
          "  border-bottom: none;",
          "  border-top-width: thin;",
          "  border-top-style: dotted;",
          "  border-top-color: #999999;",
          "}",
          " ",
          "@media print {",
          "  * {",
          "    background: transparent !important;",
          "    color: black !important;",
          "    filter: none !important;",
          "    -ms-filter: none !important;",
          "  }",
          " ",  
          "  body {",
    paste("    font-size:", font_size, "pt;", sep = ""),
          "    max-width:100%;",
          "  }",
          " ",  
          "  a, a:visited {",
          "    text-decoration: underline;",
          "  }",
          " ",  
          "  hr {",
          "    visibility: hidden;",
          "    page-break-before: always;",
          "  }",
          " ",  
          "  pre, blockquote {",
          "    padding-right: 1em;",
          "    page-break-inside: avoid;",
          "  }",
          " ",  
          "  tr, img {",
          "    page-break-inside: avoid;",
          "  }",
          " ",  
          "  img {",
          "    max-width: 100% !important;",
          "  }",
          " ",  
          "  @page {",
          "    margin-top: 2cm;",
          "    margin-bottom: 1.5cm;",
          "    margin-left: 3cm;",
          "    margin-right: 3cm;",
          "  }",
          " ",  
          "  p, h2, h3 {",
          "    orphans: 3; widows: 3;",
          "  }",
          " ",  
          "  h2, h3 {",
          "    page-break-after: avoid;",
          "  }",
          "}",
    sep="\n")
  sink()
}

################
# knitr header #
################

print_header <- function(title, author, date = "`r format(Sys.Date(), '%d %B %Y')`") {
  cat(
    "---",
    paste("title:", noquote(dQuote(title)), sep = " "),
    paste("author:", noquote(dQuote(author)), sep = " "),
    paste("date:", noquote(dQuote(date)), sep = " "),
    "output:",
    "  html_document:",
    "    css: style.css",
    "    toc: yes",
    "---",
      
    "***",
    "&nbsp;",
    sep = "\n"
    )
  }