显示R函数的源代码[重复]
machine-learning
r
8
0

我可以使用lmclass::knn来查看源代码,但是我无法显示princomp的代码。是否用R或其他字节码编写了此函数(或其他函数)。我也无法使用“ 如何在程序包中显示S4函数的源代码”的建议找到源代码 。谢谢你的帮助。

> princomp
function (x, ...) 
UseMethod("princomp")
<bytecode: 0x9490010>
<environment: namespace:stats>
参考资料:
Stack Overflow
收藏
评论
共 2 个回答
高赞 时间 活跃

您必须询问使用该功能使用的相应方法。尝试这个:

princomp # this is what you did without having a good enough answer
methods(princomp) # Next step, ask for the method: 'princomp.default'
getAnywhere('princomp.default') # this will show you the code

您要查找的代码是:

function (x, cor = FALSE, scores = TRUE, covmat = NULL, subset = rep(TRUE, 
    nrow(as.matrix(x))), ...) 
{
    cl <- match.call()
    cl[[1L]] <- as.name("princomp")
    if (!missing(x) && !missing(covmat)) 
        warning("both 'x' and 'covmat' were supplied: 'x' will be ignored")
    z <- if (!missing(x)) 
        as.matrix(x)[subset, , drop = FALSE]
    if (is.list(covmat)) {
        if (any(is.na(match(c("cov", "n.obs"), names(covmat))))) 
            stop("'covmat' is not a valid covariance list")
        cv <- covmat$cov
        n.obs <- covmat$n.obs
        cen <- covmat$center
    }
    else if (is.matrix(covmat)) {
        cv <- covmat
        n.obs <- NA
        cen <- NULL
    }
    else if (is.null(covmat)) {
        dn <- dim(z)
        if (dn[1L] < dn[2L]) 
            stop("'princomp' can only be used with more units than variables")
        covmat <- cov.wt(z)
        n.obs <- covmat$n.obs
        cv <- covmat$cov * (1 - 1/n.obs)
        cen <- covmat$center
    }
    else stop("'covmat' is of unknown type")
    if (!is.numeric(cv)) 
        stop("PCA applies only to numerical variables")
    if (cor) {
        sds <- sqrt(diag(cv))
        if (any(sds == 0)) 
            stop("cannot use cor=TRUE with a constant variable")
        cv <- cv/(sds %o% sds)
    }
    edc <- eigen(cv, symmetric = TRUE)
    ev <- edc$values
    if (any(neg <- ev < 0)) {
        if (any(ev[neg] < -9 * .Machine$double.eps * ev[1L])) 
            stop("covariance matrix is not non-negative definite")
        else ev[neg] <- 0
    }
    cn <- paste("Comp.", 1L:ncol(cv), sep = "")
    names(ev) <- cn
    dimnames(edc$vectors) <- if (missing(x)) 
        list(dimnames(cv)[[2L]], cn)
    else list(dimnames(x)[[2L]], cn)
    sdev <- sqrt(ev)
    sc <- if (cor) 
        sds
    else rep(1, ncol(cv))
    names(sc) <- colnames(cv)
    scr <- if (scores && !missing(x) && !is.null(cen)) 
        scale(z, center = cen, scale = sc) %*% edc$vectors
    if (is.null(cen)) 
        cen <- rep(NA_real_, nrow(cv))
    edc <- list(sdev = sdev, loadings = structure(edc$vectors, 
        class = "loadings"), center = cen, scale = sc, n.obs = n.obs, 
        scores = scr, call = cl)
    class(edc) <- "princomp"
    edc
}
<environment: namespace:stats>

我认为这是您要的。

收藏
评论
> stats:::princomp.default

我在以下位置找到它: 在R中查看源代码

收藏
评论
新手导航
  • 社区规范
  • 提出问题
  • 进行投票
  • 个人资料
  • 优化问题
  • 回答问题

关于我们

常见问题

内容许可

联系我们

@2020 AskGo
京ICP备20001863号