使用 helpExtract 函数将 R 函数的示例代码导入 knitr

Question

我想获取R 函数的示例代码以在knitr 中使用。可能有一种简单的方法，但尝试使用可以从here（由@AnandaMahto 编写）获得的helpExtract 函数尝试以下代码。使用我的方法，我必须查看一个函数是否具有示例，并且必须仅包含那些具有示例的函数。

这是一种非常低效且幼稚的方法。现在我试图只包含那些有示例的函数。我尝试了以下代码，但它没有按预期工作。如何从R 包中提取示例代码？

\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

我已经完成了一些修改函数的快速工作（我已经包含了at this Gist）。 Gist 还包括一个示例 Rnw 文件（我还没有机会检查 Rmd 文件）。

函数现在看起来像这样：

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`")
    )
  }
}

---

发生了什么变化？

• 添加了一个新参数sectionHead。这用于能够在调用helpExtract 函数时指定节标题。
• 该函数检查已解析文档中的相关部分是否可用。如果不是，它只会返回一个""（不会被打印出来）。

---

使用示例如下：

<<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))}

注意：由于Sexpr 不允许使用大括号（{），我们需要在Sexpr 步骤之外指定标题，我已经在隐藏代码块中完成了。

Answer 2

这不是一个完整的答案，所以我将其标记为社区 wiki。这里有两行简单的代码，用于从命名函数的 Rd 文件中获取示例（在本例中为 lm）。在我看来，代码比 Ananda 的要点要简单得多：

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

结果是 Rd“示例”部分中所有文本的简单向量，应该易于解析、评估或包含在 knitr 文档中。

 [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

也许以下内容可能有用。

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')

这将返回指定包向量中所有函数（具有包含示例的文档）的示例。如果为pkg=NULL，则返回已加载包中所有函数的示例。

例如：

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] ""