使用helpExtract函数将R函数的示例代码编入针织机

Question

我想获得要在knitr中使用的R函数的示例代码。可能有一个简单的方法，但尝试使用helpExtract函数，可以从here（由@AnandaMahto编写）获得以下代码（共享任何其他高效代码将高度赞赏）。用我的方法，我必须看看一个函数是否有例子，并且只能包含那些有例子的函数。这是非常低效和天真的做法。现在我试图只包含那些有示例的函数。我尝试了下面的代码，但它不能按需要工作。如果有人帮我弄清楚如何从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

这不是一个完整的答案，所以我把它标记为社区维基。下面是两条简单的线路，用于从Rd文件中获取命名函数的示例（在此例中为lm）。该代码是在我看来，比阿难的要点简单得多：

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

结果是所有部分中的路“实例”的文本，这应该很容易分析的一个简单的载体，评估，或将其纳入针织文件。

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