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