読者です 読者をやめる 読者になる 読者になる

メモ:utils::example()のコードを読む

R

RPubs - Run All Examples in Documentationを書いたときのメモ

utils::example
#> function (topic, package = NULL, lib.loc = NULL, character.only = FALSE, 
#>     give.lines = FALSE, local = FALSE, echo = TRUE, verbose = getOption("verbose"), 
#>     setRNG = FALSE, ask = getOption("example.ask"), prompt.prefix = abbreviate(topic, 
#>         6), run.dontrun = FALSE, run.donttest = interactive()) 
#> {
#>     if (!character.only) {
#>         topic <- substitute(topic)
#>         if (!is.character(topic)) 
#>             topic <- deparse(topic)[1L]
#>     }
#>     pkgpaths <- find.package(package, lib.loc, verbose = verbose)
#>     file <- index.search(topic, pkgpaths, TRUE)
#>     if (!length(file)) {
#>         warning(gettextf("no help found for %s", sQuote(topic)), 
#>             domain = NA)
#>         return(invisible())
#>     }
#>     packagePath <- dirname(dirname(file))
#>     pkgname <- basename(packagePath)
#>     lib <- dirname(packagePath)
#>     tf <- tempfile("Rex")
#>     tools::Rd2ex(.getHelpFile(file), tf, commentDontrun = !run.dontrun, 
#>         commentDonttest = !run.donttest)
#>     if (!file.exists(tf)) {
#>         if (give.lines) 
#>             return(character())
#>         warning(gettextf("%s has a help file but no examples", 
#>             sQuote(topic)), domain = NA)
#>         return(invisible())
#>     }
#>     on.exit(unlink(tf))
#>     if (give.lines) 
#>         return(readLines(tf))
#>     if (pkgname != "base") 
#>         library(pkgname, lib.loc = lib, character.only = TRUE)
#>     if (!is.logical(setRNG) || setRNG) {
#>         if ((exists(".Random.seed", envir = .GlobalEnv))) {
#>             oldSeed <- get(".Random.seed", envir = .GlobalEnv)
#>             on.exit(assign(".Random.seed", oldSeed, envir = .GlobalEnv), 
#>                 add = TRUE)
#>         }
#>         else {
#>             oldRNG <- RNGkind()
#>             on.exit(RNGkind(oldRNG[1L], oldRNG[2L]), add = TRUE)
#>         }
#>         if (is.logical(setRNG)) {
#>             RNGkind("default", "default")
#>             set.seed(1)
#>         }
#>         else eval(setRNG)
#>     }
#>     zz <- readLines(tf, n = 1L)
#>     skips <- 0L
#>     if (echo) {
#>         zcon <- file(tf, open = "rt")
#>         while (length(zz) && !length(grep("^### \\*\\*", zz))) {
#>             skips <- skips + 1L
#>             zz <- readLines(zcon, n = 1L)
#>         }
#>         close(zcon)
#>     }
#>     if (ask == "default") 
#>         ask <- echo && grDevices::dev.interactive(orNone = TRUE)
#>     if (ask) {
#>         if (.Device != "null device") {
#>             oldask <- grDevices::devAskNewPage(ask = TRUE)
#>             if (!oldask) 
#>                 on.exit(grDevices::devAskNewPage(oldask), add = TRUE)
#>         }
#>         op <- options(device.ask.default = TRUE)
#>         on.exit(options(op), add = TRUE)
#>     }
#>     source(tf, local, echo = echo, prompt.echo = paste0(prompt.prefix, 
#>         getOption("prompt")), continue.echo = paste0(prompt.prefix, 
#>         getOption("continue")), verbose = verbose, max.deparse.length = Inf, 
#>         encoding = "UTF-8", skip.echo = skips, keep.source = TRUE)
#> }#> 

find.package()

パッケージが置いてある場所までのパスを探すやつっぽい。

formals(find.package)
#> $package
#> NULL
#> 
#> $lib.loc
#> NULL
#> 
#> $quiet
#> [1] FALSE
#> 
#> $verbose
#> getOption("verbose")

とりあえずパッケージ名だけ指定すればいいっぽい。

find.package("GGally")
#> [1] "/home/vagrant/R/x86_64-pc-linux-gnu-library/3.2/GGally"

utils:::index.search()

ドキュメントのファイルまでのパスを返す。

formals(utils:::index.search)
#> $topic
#> 
#> 
#> $paths
#> 
#> 
#> $firstOnly
#> [1] FALSE

こんな感じ。pathsは名前からして複数指定可能っぽい。

utils:::index.search("ggpairs", find.package("GGally"))
#> [1] "/home/vagrant/R/x86_64-pc-linux-gnu-library/3.2/GGally/help/ggpairs"

でも、ここに実際のファイルがあるとは限らない(aliases.rdsみたいなファイルに入ってることもあるらしい)。ややこしい。。

file.exists(utils:::index.search("ggpairs", find.package("GGally")))
#> [1] FALSE

utils:::.getHelpFile()

ヘルプファイルまでのパスからRdオブジェクトを返す。

formals(utils:::.getHelpFile)
#> $file
#> 
#> 

Rdオブジェクトってなんなのかは不明。たぶんただの文字列のリスト。?parse_Rdでドキュメントが読める(けどめんどくさくて読んでない)。

f <- utils:::index.search("ggpairs", find.package("GGally"))
Rd <- utils:::.getHelpFile(f)
is(Rd)
#> [1] "Rd"

Rd
#> \title{ggpairs - A GGplot2 Matrix}\name{ggpairs}\alias{ggpairs}\keyword{hplot}\description{
#> Make a matrix of plots with a given data set
#> }\usage{
#> ggpairs(data, columns = 1:ncol(data), title = "", upper = list(),
#>   lower = list(), diag = list(), params = NULL, ...,
#>   axisLabels = "show", columnLabels = colnames(data[, columns]),
#>   legends = FALSE, verbose = FALSE)
...snip...

Rd2ex

Rd2HTMLとかRd2txtとかRd2latexは名前通りのフォーマットに変換する関数だけど、Rd2ex

Rd2ex extracts the examples in the format used by example and R utilities.

らしい。(?Rd2exで読めるドキュメントより)

> formals(Rd2ex)
#> $Rd
#> 
#> 
#> $out
#> [1] ""
#> 
#> $defines
#> .Platform$OS.type
#> 
#> $stages
#> [1] "render"
#> 
#> $outputEncoding
#> [1] "UTF-8"
#> 
#> $commentDontrun
#> [1] TRUE
#> 
#> $commentDonttest
#> [1] FALSE
#> 
#> $...
#> 
#> 

outにファイル名を指定すればそのファイルに出力される。空の時の挙動は謎。

Rd2ex(Rd)
#> ### Name: ggpairs
#> ### Title: ggpairs - A GGplot2 Matrix
#> ### Aliases: ggpairs
#> ### Keywords: hplot
#> 
#> ### ** Examples
#> 
#> # plotting is reduced to the first couple of examples.
#> # Feel free to print the ggpair objects created in the examples
...snip...

これを↓のようになにか適当なセクションで囲ってknitすればおk。

github.com