Ｒで関数のソースコードを見る方法

忘れやすいので備忘メモ。

Rでpackageに入っている関数のソースコードを確認する方法は以下です。

例として、caret::confusionMatrixの中身を見る方法は以下です。

まず、methods()関数に調べたい関数名を入れます。すると、更に調べる候補が出てきます。

>methods(confusionMatrix)
[1] confusionMatrix.default* confusionMatrix.rfe*    
[3] confusionMatrix.sbf*     confusionMatrix.table*  
[5] confusionMatrix.train   
see '?methods' for accessing help and source code

ここから1つを選んで、getAnywhere()関数でソースコードを開けます。

>getAnywhere("confusionMatrix.table")
A single object matching ‘confusionMatrix.table’ was found
It was found in the following places
  registered S3 method for confusionMatrix from namespace caret
  namespace:caret
with value

function (data, positive = NULL, prevalence = NULL, mode = "sens_spec", 
    ...) 
{
    requireNamespaceQuietStop("e1071")
    if (!(mode %in% c("sens_spec", "prec_recall", "everything"))) 
        stop("`mode` should be either 'sens_spec', 'prec_recall', or 'everything'")
    if (length(dim(data)) != 2) 
        stop("the table must have two dimensions")
    if (!all.equal(nrow(data), ncol(data))) 
        stop("the table must nrow = ncol")
    if (!all.equal(rownames(data), colnames(data))) 
        stop("the table must the same classes in the same order")
    if (!is.character(positive) & !is.null(positive)) 
        stop("positive argument must be character")
    classLevels <- rownames(data)
    numLevels <- length(classLevels)
    if (numLevels < 2) 
        stop("there must be at least 2 factors levels in the data")
    if (numLevels == 2 & is.null(positive)) 
        positive <- rownames(data)[1]
    if (numLevels == 2 & !is.null(prevalence) && length(prevalence) != 
        1) 
        stop("with two levels, one prevalence probability must be specified")
    if (numLevels > 2 & !is.null(prevalence) && length(prevalence) != 
        numLevels) 
        stop("the number of prevalence probability must be the same as the number of levels")
    if (numLevels > 2 & !is.null(prevalence) && is.null(names(prevalence))) 
        stop("with >2 classes, the prevalence vector must have names")
    propCI <- function(x) {
        res <- try(binom.test(sum(diag(x)), sum(x))$conf.int, 
            silent = TRUE)
        if (inherits(res, "try-error")) 
            res <- rep(NA, 2)
        res
    }
    propTest <- function(x) {
        res <- try(binom.test(sum(diag(x)), sum(x), p = max(apply(x, 
            2, sum)/sum(x)), alternative = "greater"), silent = TRUE)
        res <- if (inherits(res, "try-error")) 
            c(`null.value.probability of success` = NA, p.value = NA)
        else res <- unlist(res[c("null.value", "p.value")])
        res
    }
    overall <- c(unlist(e1071::classAgreement(data))[c("diag", 
        "kappa")], propCI(data), propTest(data), mcnemar.test(data)$p.value)
    names(overall) <- c("Accuracy", "Kappa", "AccuracyLower", 
        "AccuracyUpper", "AccuracyNull", "AccuracyPValue", "McnemarPValue")
    if (numLevels == 2) {
        if (is.null(prevalence)) 
            prevalence <- sum(data[, positive])/sum(data)
        negative <- classLevels[!(classLevels %in% positive)]
        tableStats <- c(sensitivity.table(data, positive), specificity.table(data, 
            negative), posPredValue.table(data, positive, prevalence = prevalence), 
            negPredValue.table(data, negative, prevalence = prevalence), 
            precision.table(data, relevant = positive), recall.table(data, 
                relevant = positive), F_meas.table(data, relevant = positive), 
            prevalence, sum(data[positive, positive])/sum(data), 
            sum(data[positive, ])/sum(data))
        names(tableStats) <- c("Sensitivity", "Specificity", 
            "Pos Pred Value", "Neg Pred Value", "Precision", 
            "Recall", "F1", "Prevalence", "Detection Rate", "Detection Prevalence")
        tableStats["Balanced Accuracy"] <- (tableStats["Sensitivity"] + 
            tableStats["Specificity"])/2
    }
    else {
        tableStats <- matrix(NA, nrow = length(classLevels), 
            ncol = 11)
        for (i in seq(along = classLevels)) {
            pos <- classLevels[i]
            neg <- classLevels[!(classLevels %in% classLevels[i])]
            prev <- if (is.null(prevalence)) 
                sum(data[, pos])/sum(data)
            else prevalence[pos]
            tableStats[i, ] <- c(sensitivity.table(data, pos), 
                specificity.table(data, neg), posPredValue.table(data, 
                  pos, prevalence = prev), negPredValue.table(data, 
                  neg, prevalence = prev), precision.table(data, 
                  relevant = pos), recall.table(data, relevant = pos), 
                F_meas.table(data, relevant = pos), prev, sum(data[pos, 
                  pos])/sum(data), sum(data[pos, ])/sum(data), 
                NA)
            tableStats[i, 11] <- (tableStats[i, 1] + tableStats[i, 
                2])/2
        }
        rownames(tableStats) <- paste("Class:", classLevels)
        colnames(tableStats) <- c("Sensitivity", "Specificity", 
            "Pos Pred Value", "Neg Pred Value", "Precision", 
            "Recall", "F1", "Prevalence", "Detection Rate", "Detection Prevalence", 
            "Balanced Accuracy")
    }
    structure(list(positive = positive, table = data, overall = overall, 
        byClass = tableStats, mode = mode, dots = list(...)), 
        class = "confusionMatrix")
}
<bytecode: 0x000000003b730570>
<environment: namespace:caret>

以上