このブログは、旧・はてなダイアリー「檜山正幸のキマイラ飼育記 メモ編」（http://d.hatena.ne.jp/m-hiyama-memo/）のデータを移行・保存したものであり、今後（2019年1月以降）更新の予定はありません。

今後の更新は、新しいブログ http://m-hiyama-memo.hatenablog.com/ で行います。

名前空間の操作

R言語

↓は古い論説だが、必要なことはだいたい書いてある。

基本的な操作方法：

  1. nsreg <- .Internal(getNamespaceRegistry()) で名前空間データベース（namespace registory）を取得する。名前空間データベースは環境オブジェクトである。
  2. names(nsreg) または ls(nsreg) で名前の一覧を得られる。ls(nsreg, all.names=T) としても変わらない。
  3. 特定の名前空間は、nsreg$名前空間名 または nsreg[["名前空間名"]] で取得する。データベースへの登録名としての名前空間名は、名前空間の実体である環境の名前と同じ（environmentName(ns)）だが、表示のときは namespace: が付く。
  4. 環境が名前空間であるかどうかは、隠し名 .__NAMESPACE__. があるかどうかで決まる。
  5. ns$.__NAMESPACE__. もまた環境である。名前空間nsの名前空間情報と呼ばれる。
  6. nsのパッケージ名は ns$.packageName で取れる。現状はフラットネームである。
  7. 名前空間情報が持つ項目名は下のコンソール。exportsとimportsが重要。
  8. exportsはエクスポートされる名前のキーとして値も同じ名前文字列の環境（ハッシュテーブル）。これ自体はエクスポーター（アドバタイザー）にはならない。
  9. importsは名前付きリストで、名前がインポートするパッケージ名＝名前空間名になっている。リストの成分は文字列ベクトルで、その名前空間からインポートすべき名前が列挙されている。文字列ベクトルも名前付きなので、名前は二重に記録されている。冗長感がある。
  10. imports$baseは真偽値でTRUEになっている。これはフラグだろう。
  11. ns$.__S3MethodsTable__. も環境で、関数名と関数実体の束縛が入っている。
  12. 特殊な隠し名＝メタデータ項目を除いて、その他の名前はまさに名前空間を構成する。
  13. パッケージのエクスポーター（アドバタイザー）の環境名は package:パッケージ名 となる。名前空間の環境名がパッケージ名そのものであるのとは違う。
  14. detach("package:パッケージ名") しても、loadedNamespaces() では表示される。つまり、サーチパス＝トップレベルからのスコープチェーンから外されるだけ。



> ls(nsreg$utils$.__NAMESPACE__., all.names=T)

[1] "DLLs"      "dynlibs"   "exports"   "imports"   "lazydata"  "path"      "S3methods"

[8] "spec"     

> ls(nsreg$stringr$.__NAMESPACE__., all.names=T)

[1] "dynlibs"   "exports"   "imports"   "lazydata"  "path"      "S3methods" "spec"     

>

目ぼしい環境へのアクセス

  • baseenv()
  • globalenv()
  • topenv()
  • emptyenv()
  • environment()
  • environment(f)
  • parent.env(env)
  • parent.frame(n) n = 1, 2, 3, ...
as.environmen とサーチ環境リストの取得

as.environment(番号)で、search() により得られるサーチパスの番号の環境を得られる。この番号は ls(番号) でも使える。したがって、スコープチェーンは次で得られる。

  • lapply(seq_along(search()), as.environment)

もっと簡単には

  • as.environment(seq_along(search()))

身も蓋もない。ちょっとプログラミングするなら、

scopeChain  <- function(start = parent.env(environment())) scopeChainAccum(list(), start)

scopeChainAccum <- function(accum, here) {
  accum[[length(accum) + 1]] <- here
  if (identical(here, emptyenv()))
    return(structure(accum, class='scopeChain'))
  # recursion
  scopeChainAccum(accum,   parent.env(here))
}

print.scopeChain <- function(sc) {
  names <- sapply(sc, environmentName)
  print(names)
}
loadedNamespaces
function () 
  names(.Internal(getNamespaceRegistry()))
getNamespace
function (name) 
{
    ns <- .Internal(getRegisteredNamespace(name))
    if (!is.null(ns)) 
        ns
    else tryCatch(loadNamespace(name), error = function(e) stop(e))
}
getFromNamespace
function (x, ns, pos = -1, envir = as.environment(pos)) 
{
    if (missing(ns)) {
        nm <- attr(envir, "name", exact = TRUE)
        if (is.null(nm) || substring(nm, 1L, 8L) != "package:") 
            stop("environment specified is not a package")
        ns <- asNamespace(substring(nm, 9L))
    }
    else ns <- asNamespace(ns)
    get(x, envir = ns, inherits = FALSE)
}
..getNamespace
function (name, where) 
{
    ns <- .Internal(getRegisteredNamespace(name))
    if (!is.null(ns)) 
        ns
    else tryCatch(loadNamespace(name), error = function(e) {
        warning(gettextf("namespace %s is not available and has been replaced\nby .GlobalEnv when processing object %s", 
            sQuote(name)[1L], sQuote(where)), domain = NA, call. = FALSE, 
            immediate. = TRUE)
        .GlobalEnv
    })
}
.getNamespaceInfo
function (ns, which) 
{
    ns[[".__NAMESPACE__."]][[which]]
}
getNamespaceInfo
function (ns, which) 
{
    ns <- asNamespace(ns, base.OK = FALSE)
    get(which, envir = ns[[".__NAMESPACE__."]])
}




> getNamespace[TAB]
getNamespace        getNamespaceExports getNamespaceImports getNamespaceInfo    

getNamespaceName    getNamespaceUsers   getNamespaceVersion
> namespace[TAB]
namespaceExport        namespaceImport        namespaceImportClasses 

namespaceImportFrom    namespaceImportMethods
>

setNamespaceInfo
function (ns, which, val) 
{
    ns <- asNamespace(ns, base.OK = FALSE)
    info <- ns[[".__NAMESPACE__."]]
    info[[which]] <- val
}
isNamespace
function (ns) 
  .Internal(isNamespaceEnv(ns))
isBaseNamespace
function (ns) 
  identical(ns, .BaseNamespaceEnv)
asNamespace
function (ns, base.OK = TRUE) 
{
    if (is.character(ns) || is.name(ns)) 
        ns <- getNamespace(ns)
    if (!isNamespace(ns)) 
        stop("not a namespace")
    else if (!base.OK && isBaseNamespace(ns)) 
        stop("operation not allowed on base namespace")
    else ns
}
getNamespaceName
function (ns) 
{
    ns <- asNamespace(ns)
    if (isBaseNamespace(ns)) 
        "base"
    else .getNamespaceInfo(ns, "spec")["name"]
}
get0
function (x, envir = pos.to.env(-1L), mode = "any",
          inherits = TRUE, ifnotfound = NULL) 
  .Internal(get0(x, envir, mode, inherits, ifnotfound))
getExportedValue
function (ns, name) 
{
    ns <- asNamespace(ns)
    if (isBaseNamespace(ns)) 
        get(name, envir = ns, inherits = FALSE)
    else {
        if (!is.null(oNam <- .getNamespaceInfo(ns, "exports")[[name]])) {
            get0(oNam, envir = ns)
        }
        else {
            ld <- .getNamespaceInfo(ns, "lazydata")
            if (!is.null(obj <- get0(name, envir = ld, inherits = FALSE))) 
                obj
            else {
                if (exists(name, envir = ld, inherits = FALSE)) 
                  NULL
                else stop(gettextf("'%s' is not an exported object from 'namespace:%s'", 
                  name, getNamespaceName(ns)), call. = FALSE, 
                  domain = NA)
            }
        }
    }
}
attachNamespace
function (ns, pos = 2L, depends = NULL) 
{
    runHook <- function(hookname, env, libname, pkgname) {
        if (!is.null(fun <- get0(hookname, envir = env, inherits = FALSE))) {
            res <- tryCatch(fun(libname, pkgname), error = identity)
            if (inherits(res, "error")) {
                stop(gettextf("%s failed in %s() for '%s', details:\n  call: %s\n  error: %s", 
                  hookname, "attachNamespace", nsname, deparse(conditionCall(res))[1L], 
                  conditionMessage(res)), call. = FALSE, domain = NA)
            }
        }
    }
    runUserHook <- function(pkgname, pkgpath) {
        hook <- getHook(packageEvent(pkgname, "attach"))
        for (fun in hook) try(fun(pkgname, pkgpath))
    }
    ns <- asNamespace(ns, base.OK = FALSE)
    nsname <- getNamespaceName(ns)
    nspath <- .getNamespaceInfo(ns, "path")
    attname <- paste("package", nsname, sep = ":")
    if (attname %in% search()) 
        stop("namespace is already attached")
    env <- attach(NULL, pos = pos, name = attname)
    on.exit(.Internal(detach(pos)))
    attr(env, "path") <- nspath
    exports <- getNamespaceExports(ns)
    importIntoEnv(env, exports, ns, exports)
    dimpenv <- .getNamespaceInfo(ns, "lazydata")
    dnames <- names(dimpenv)
    .Internal(importIntoEnv(env, dnames, dimpenv, dnames))
    if (length(depends)) 
        assign(".Depends", depends, env)
    Sys.setenv(`_R_NS_LOAD_` = nsname)
    on.exit(Sys.unsetenv("_R_NS_LOAD_"), add = TRUE)
    runHook(".onAttach", ns, dirname(nspath), nsname)
    lockEnvironment(env, TRUE)
    runUserHook(nsname, nspath)
    on.exit()
    Sys.unsetenv("_R_NS_LOAD_")
    invisible(env)
}
loadNamespace, unloadNamespace

長いので省略。