- 以前の記事はこちら
- 基本、２通り
- バイナリで表示できる部分
- ソースをダウンロードして、ソースファイルを探して読んでみる部分
- C.Fortanの部分はソースファイルをダウンロードしないと読めない
- Ｒのソースはすぐに見られるものと、１回手間をかけないと読めないものに分かれる
- Ｒの構成関数(読み込み&言語)
- Ｒの基本骨格部分
- 基本骨格は、バイナリで入手したときに、すでにコンパイル済みです
- この部分に何がどう含まれるかは、Ｒの管理チームが管轄しています
- その中には、CとFortranとRで書かれたものがあります
- C(とFortran)で書かれたソースは、.Internarl関数か.Primitive関数を用いて呼び出されます
- .Internalで呼び出されるか.Primitiveで呼び出されるかは、Ｒの設計上の分類によります
- 例
> runif
function (n, min = 0, max = 1)
.Internal(runif(n, min, max))
<environment: namespace:stats>
> sqrt
function (x) .Primitive("sqrt")
>
-
-
-
- Rのrunif関数は、.Internalを使って、runifという関数(これは、Cに紐付けられている)が呼び出されていることがわかります
- Rのsqrt関数は、.Primitiveを使って、sqrtという関数(Ｃの)が呼び出されていることがわかります
- Cの中での実際の名前は、ちょっと変えてあります。その名前の探し方は次の通り
- "...\src\main\names.c"というファイルは、.Internal .Primitiveが呼び出している"runif","sqrt"がＣで何という関数かの情報を提供します。
/* Table of .Internal(.) and .Primitive(.) R functions
* ===== ========= ==========
*
* Each entry is a line with
*
* printname c-entry offset eval arity pp-kind precedence rightassoc
* --------- ------- ------ ---- ----- ------- ---------- ----------
*2 name cfun code eval arity gram.kind gram.precedence gram.rightassoc
*3 PRIMNAME PRIMFUN PRIMVAL [*] PRIMARITY PPINFO PPINFO PPINFO
...
{"sqrt", do_math1, 3, 1, 1, {PP_FUNCALL, PREC_FN, 0}},
...
{"runif", do_random2, 9, 11, 3, {PP_FUNCALL, PREC_FN, 0}},
-
-
-
- "sqrt"は"do_math1"に、"runif"は"do_random2"と言うCの関数名です。
- Cの"do_math1"、"do_random2"は、"...\src\main\"以下にあるのですが、関数名=ファイル名になっていないので、(少なくとも僕には)探すのが大変です
- 名前の類推から見つけるとすると、"random.c"というファイルがあって、その中に以下のような関数を見つけることができて、これが、求めているものの入り口です
SEXP attribute_hidden do_random2(...){}
-
-
-
- これらの、ビルドされているC,Fortranの関数は、基本骨格のＲ関数・アドオンパッケージのＲ関数の中から呼び出されて使われることがあります
- その呼び出し関数が、以下でも述べる".C"、".Fortran"関数です
- アドオンパッケージのＲ関数ソースに".C",".Fortran"が出てきたら、ビルドのＣ，Fortran関数をファイルディレクトリに探しに行きます
- アドオンパッケージ(と自作関数)がC,Fortranでコードを書いて、それらを呼び出すときには、".Call"関数、".External"関数を使います
- ".Call"と".External"は、引数の扱い方の違いによるもので、実現したい仕事の中味は同じです
- ですから、アドオンパッケージ内のＲソースに".Call",".External"が出てきて、それらの呼び出し関数のソースが見たいときには、そのパッケージの中にある"src"ディレクトリに収められているはずです
- Rで書かれているものは、Ｒの配布基本ライブラリを納めた場所"...\src\library\"以下にあります
- パッケージごとに分けて納めてあります
- たとえば、"ave"は以下のようにコードが表示できますが、"stats"の中にあることがわかりますから、ファイルで確認すると"ave.R"に書いてある内容がコンソールに表示されることがわかります
> ave
function (x, ..., FUN = mean)
{
n <- length(list(...))
if (n) {
g <- interaction(...)
split(x, g) <- lapply(split(x, g), FUN)
}
else x[] <- FUN(x)
x
}
<environment: namespace:stats>
-
-
-
- 中味が見えないものもあります
- kruskal.testは"stats"の中にあることがわかります
- "UseMethods"という関数を用いていることがわかります
> kruskal.test
function (x, ...)
UseMethod("kruskal.test")
<environment: namespace:stats>
-
-
-
- "...\src\library\stats\R\"を見ると、"kruskal.test.R"という名前のファイルがあります
- "kruskal.test.default"と"kruskal.test.formura"という２つが納められています
----"UseMethods"は、help(UseMethods)で検索するとわかるとおり、S3と呼ばれる一群の関数に関する情報を呼び出す機能を提供しているのですが、S3シリーズであることがわかりますから、この機能群の関数の１つである"mesthods"関数を使うと、もう少し、"kruskal.test"に関する情報をコンソール経由で得られます。
> methods(kruskal.test)
[1] kruskal.test.default* kruskal.test.formula*
Non-visible functions are asterisked
-
-
-
- "krusukal.test.default"と"krusukal.test.formula"の2種類があって、それは、"Non-visible"にしてあることがわかります。
- 同じく、S3関数群の情報を取り出す関数である、"getS3method"を用いると以下のように、表示に成功します。
> getS3method("kruskal.test","default")
function (x, g, ...)
{
if (is.list(x)) {
if (length(x) < 2)
stop("'x' must be a list with at least 2 elements")
DNAME <- deparse(substitute(x))
x <- lapply(x, function(u) u <- u[complete.cases(u)])
k <- length(x)
l <- sapply(x, "length")
if (any(l == 0))
stop("all groups must contain data")
g <- factor(rep(1:k, l))
x <- unlist(x)
}
else {
if (length(x) != length(g))
stop("'x' and 'g' must have the same length")
DNAME <- paste(deparse(substitute(x)), "and", deparse(substitute(g)))
OK <- complete.cases(x, g)
x <- x[OK]
g <- g[OK]
if (!all(is.finite(g)))
stop("all group levels must be finite")
g <- factor(g)
k <- nlevels(g)
if (k < 2)
stop("all observations are in the same group")
}
n <- length(x)
if (n < 2)
stop("not enough observations")
r <- rank(x)
TIES <- table(x)
STATISTIC <- sum(tapply(r, g, "sum")^2/tapply(r, g, "length"))
STATISTIC <- ((12 * STATISTIC/(n * (n + 1)) - 3 * (n + 1))/(1 -
sum(TIES^3 - TIES)/(n^3 - n)))
PARAMETER <- k - 1
PVAL <- pchisq(STATISTIC, PARAMETER, lower.tail = FALSE)
names(STATISTIC) <- "Kruskal-Wallis chi-squared"
names(PARAMETER) <- "df"
RVAL <- list(statistic = STATISTIC, parameter = PARAMETER,
p.value = PVAL, method = "Kruskal-Wallis rank sum test",
data.name = DNAME)
class(RVAL) <- "htest"
return(RVAL)
}
<environment: namespace:stats>
-
-
- 呼び出されているＣのソースのありかを探すとすると、
- たとえば、dist()関数。中で、.C("R_distance" ... と、"R_distance"という関数を呼び出している。
> dist
function (x, method = "euclidean", diag = FALSE, upper = FALSE,
p = 2)
{
if (!is.na(pmatch(method, "euclidian")))
method <- "euclidean"
METHODS <- c("euclidean", "maximum", "manhattan", "canberra",
"binary", "minkowski")
method <- pmatch(method, METHODS)
if (is.na(method))
stop("invalid distance method")
if (method == -1)
stop("ambiguous distance method")
N <- nrow(x <- as.matrix(x))
d <- .C("R_distance", x = as.double(x), nr = N, nc = ncol(x),
d = double(N * (N - 1)/2), diag = as.integer(FALSE),
method = as.integer(method), p = as.double(p), DUP = FALSE,
NAOK = TRUE, PACKAGE = "stats")$d
attr(d, "Size") <- N
attr(d, "Labels") <- dimnames(x)[[1L]]
attr(d, "Diag") <- diag
attr(d, "Upper") <- upper
attr(d, "method") <- METHODS[method]
if (method == 6)
attr(d, "p") <- p
attr(d, "call") <- match.call()
class(d) <- "dist"
return(d)
}
<environment: namespace:stats>
-
-
-
- なので、"\src\library\stats\src"を探すと、それらしいファイル"distance.c"がある
- 開くと、以下がある
void R_distance(double *x, int *nr, int *nc, double *d, int *diag,
int *method, double *p)
{}
