Getting example codes of R functions into knitr using helpExtract function

Question

I want to get the example codes of R functions to use in knitr. There might be an easy way but tried the following code using helpExtract function which can be obtained from here (written by @AnandaMahto). With my approach I have to look whether a function has Examples or not and have to include only those functions which have Examples.

This is very inefficient and naive approach. Now I'm trying to include only those functions which have Examples. I tried the following code but it is not working as desired. How can I to extract Examples codes from an R package?

\documentclass{book}
\usepackage[T1]{fontenc}

\begin{document}

<< label=packages, echo=FALSE>>=
library(ggplot2)
library(devtools)
source_gist("https://gist.github.com/mrdwab/7586769")
library(noamtools)     # install_github("noamtools", "noamross")
@


\chapter{Linear Model}

<< label = NewTest1, results="asis">>=
tryCatch(
    {helpExtract(lm, section="Examples", type = "s_text");
    cat(
        "\\Sexpr{
          knit_child(
                  textConnection(helpExtract(lm, section=\"Examples\", type = \"s_text\"))
                , options = list(tidy = FALSE, eval = TRUE)
                )
             }", "\n"
        )
     }
  , error=function(e) FALSE
  )
@


\chapter{Modify properties of an element in a theme object}

<< label = NewTest2, results="asis">>=
tryCatch(
    {helpExtract(add_theme , section="Examples", type = "s_text");
    cat(
        "\\Sexpr{
          knit_child(
                  textConnection(helpExtract(add_theme , section=\"Examples\", type = \"s_text\"))
                , options = list(tidy = FALSE, eval = TRUE)
                )
             }", "\n"
        )
     }
  , error=function(e) FALSE
  )
@

\end{document}

Answer 1

I've done some quick work modifying the function (which I've included at this Gist). The Gist also includes a sample Rnw file (I haven't had a chance to check an Rmd file yet).

The function now looks like this:

helpExtract <- function(Function, section = "Usage", type = "m_code", sectionHead = NULL) {
  A <- deparse(substitute(Function))
  x <- capture.output(tools:::Rd2txt(utils:::.getHelpFile(utils::help(A)),
                                     options = list(sectionIndent = 0)))
  B <- grep("^_", x)                      ## section start lines
  x <- gsub("_\b", "", x, fixed = TRUE)   ## remove "_\b"
  X <- rep(FALSE, length(x))              ## Create a FALSE vector
  X[B] <- 1                               ## Initialize
  out <- split(x, cumsum(X))              ## Create a list of sections
  sectionID <- vapply(out, function(x)    ## Identify where the section starts
    grepl(section, x[1], fixed = TRUE), logical(1L))

  if (!any(sectionID)) {                  ## If the section is missing...
    ""                                    ## ... just return an empty character 
  } else {                                ## Else, get that list item
    out <- out[[which(sectionID)]][-c(1, 2)]
    while(TRUE) {                         ## Remove the extra empty lines
      out <- out[-length(out)]            ##   from the end of the file
      if (out[length(out)] != "") { break }
    } 

    switch(                               ## Determine the output type
      type,
      m_code = {
        before <- "```r"
        after <- "```"
        c(sectionHead, before, out, after)
      },
      s_code = {
        before <- "<<eval = FALSE>>="
        after <- "@"
        c(sectionHead, before, out, after)
      },
      m_text = {
        c(sectionHead, paste("    ", out, collapse = "\n"))
      },
      s_text = {
        before <- "\\begin{verbatim}"
        after <- "\\end{verbatim}"
        c(sectionHead, before, out, after)
      },
      stop("`type` must be either `m_code`, `s_code`, `m_text`, or `s_text`")
    )
  }
}

---

What has changed?

• A new argument sectionHead has been added. This is used to be able to specify the section title in the call to the helpExtract function.
• The function checks to see whether the relevant section is available in the parsed document. If it is not, it simply returns a "" (which doesn't get printed).

---

Example use would be:

<<echo = FALSE>>=
mySectionHeading <- "\\section{Some cool section title}"
@

\Sexpr{knit_child(textConnection(
helpExtract(cor, section = "Examples", type = "s_code", 
sectionHead = mySectionHeading)), 
options = list(tidy = FALSE, eval = FALSE))}

Note: Since Sexpr doesn't allow curly brackets to be used ({), we need to specify the title outside of the Sexpr step, which I have done in a hidden code chunk.

Answer 2

This is not a complete answer so I'm marking it as community wiki. Here are two simple lines to get the examples out of the Rd file for a named function (in this case lm). The code is much simpler than Ananda's gist in my opinion:

x <- utils:::.getHelpFile(utils::help(lm))
sapply(x[sapply(x, function(z) attr(z, "Rd_tag") == "\\examples")][[1]], `[[`, 1)

The result is a simple vector of all of the text in the Rd "examples" section, which should be easy to parse, evaluate, or include in a knitr doc.

 [1] "\n"                                                                          
 [2] "require(graphics)\n"                                                         
 [3] "\n"                                                                          
 [4] "## Annette Dobson (1990) \"An Introduction to Generalized Linear Models\".\n"
 [5] "## Page 9: Plant Weight Data.\n"                                             
 [6] "ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14)\n"               
 [7] "trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69)\n"               
 [8] "group <- gl(2, 10, 20, labels = c(\"Ctl\",\"Trt\"))\n"                       
 [9] "weight <- c(ctl, trt)\n"                                                     
[10] "lm.D9 <- lm(weight ~ group)\n"                                               
[11] "lm.D90 <- lm(weight ~ group - 1) # omitting intercept\n"                     
[12] "\n"                                                                          
[13] "\n"                                                                          
[14] "opar <- par(mfrow = c(2,2), oma = c(0, 0, 1.1, 0))\n"                        
[15] "plot(lm.D9, las = 1)      # Residuals, Fitted, ...\n"                        
[16] "par(opar)\n"                                                                 
[17] "\n"                                                                          
[18] "\n"                                                                          
[19] "### less simple examples in \"See Also\" above\n"

Answer 3

Perhaps the following might be useful.

get.examples <- function(pkg=NULL) {
  suppressWarnings(f <- unique(utils:::index.search(TRUE, find.package(pkg))))
  out <- setNames(sapply(f, function(x) {
    tf <- tempfile("Rex")
    tools::Rd2ex(utils:::.getHelpFile(x), tf)  
    if (!file.exists(tf)) return(invisible())
    readLines(tf)
  }), basename(f))
  out[!sapply(out, is.null)]
}

ex.base <- get.examples('base')

This returns the examples for all functions (that have documentation containing examples) within the specified vector of packages. If pkg=NULL, it returns the examples for all functions within loaded packages.

For example:

ex.base['scan']
# $scan
#  [1] "### Name: scan"                                                                         
#  [2] "### Title: Read Data Values"                                                            
#  [3] "### Aliases: scan"                                                                      
#  [4] "### Keywords: file connection"                                                          
#  [5] ""                                                                                       
#  [6] "### ** Examples"                                                                        
#  [7] ""                                                                                       
#  [8] "cat(\"TITLE extra line\", \"2 3 5 7\", \"11 13 17\", file = \"ex.data\", sep = \"\\n\")"
#  [9] "pp <- scan(\"ex.data\", skip = 1, quiet = TRUE)"                                        
# [10] "scan(\"ex.data\", skip = 1)"                                                            
# [11] "scan(\"ex.data\", skip = 1, nlines = 1) # only 1 line after the skipped one"            
# [12] "scan(\"ex.data\", what = list(\"\",\"\",\"\")) # flush is F -> read \"7\""              
# [13] "scan(\"ex.data\", what = list(\"\",\"\",\"\"), flush = TRUE)"                           
# [14] "unlink(\"ex.data\") # tidy up"                                                          
# [15] ""                                                                                       
# [16] "## \"inline\" usage"                                                                    
# [17] "scan(text = \"1 2 3\")"                                                                 
# [18] ""                                                                                       
# [19] ""                                                                                       
# [20] ""                                                                                       
# [21] ""