R包调用.Fortran()时出错,说明函数不可用

时间:2017-04-23 13:10:55

标签: r fortran

我尝试使用eCBS包,该包在函数.Fortran()中调用gev_mle。当我使用其中一个函数estcpt时,它给了我这个错误:

Error in .Fortran("estcpt", n = as.integer(current.n), x = as.double(current.genomdat),  : 
"estcpt" not available for .Fortran() for package "eCBS"

手动解压缩包并随R CMD INSTALL一起安装并放入"/Users/pgweb/Library/R/3.3/library/eCBS"。我检查Fortran子例程脚本不在此文件夹中,而解压缩的包中包含src文件夹,其中包含*.f个文件。但即使我将这个解压缩的文件夹也移动到库目录中,也会发生同样的错误。

我尝试R CMD SHLIB创建共享对象,并尝试使用dyn.load()加载脚本。没有帮助。我检查了R代码并试图找到它是否加载了函数(在调用.Fortran()之前),这似乎不是这样:

function (genomdati, chromi, uchrom, data.type = "logratio", 
alpha = 0.01, nperm, verbose = 1) 
{
skew <- sum((genomdati - mean(genomdati))^3)/((length(genomdati) - 
    1) * sd(genomdati)^3)
kurt <- sum((genomdati - mean(genomdati))^4)/((length(genomdati) - 
    1) * sd(genomdati)^4)
genomdat.new <- NULL
for (ic in uchrom) {
    genomdat = genomdati[chromi == ic]
    n <- length(genomdat)
    seg.end <- c(0, n)
    k <- length(seg.end)
    change.loc <- NULL
    min.width = 10
    while (k > 1) {
        current.n <- seg.end[k] - seg.end[k - 1]
        if (current.n >= 2 * min.width) {
            current.genomdat <- genomdat[(seg.end[k - 1] + 
              1):seg.end[k]]
            current.genomdat <- current.genomdat - mean(current.genomdat)
            current.tss <- sum(current.genomdat^2)
            gev_parameter <- c(0, 0, 0)
            if (current.n <= 10000) {
              gev_parameter <- gev(current.n, skew, kurt)
            }
            zzz <- .Fortran("estcpt", n = as.integer(current.n), 
              x = as.double(current.genomdat), tss = as.double(current.tss), 
              px = double(current.n), sx = double(current.n), 
              nperm = as.integer(nperm), cpval = as.double(alpha), 
              ncpt = integer(1), icpt = integer(2), ibin = as.logical(data.type == 
                "binary"), al0 = as.integer(min.width), gev_p = as.double(gev_parameter), 
              PACKAGE = "eCBS")
        }
        else {
            zzz <- list()
            zzz$ncpt <- 0
        }
        if (zzz$ncpt == 0) {
            change.loc <- c(change.loc, seg.end[k])
        }
        seg.end <- switch(1 + zzz$ncpt, seg.end[-k], c(seg.end[1:(k - 
            1)], seg.end[k - 1] + zzz$icpt[1], seg.end[k]), 
            c(seg.end[1:(k - 1)], seg.end[k - 1] + zzz$icpt, 
              seg.end[k]))
        k <- length(seg.end)
    }
    seg.ends <- rev(change.loc)
    nseg <- length(seg.ends)
    lseg <- diff(c(0, seg.ends))
    genomdatj <- genomdat
    ll <- uu <- 0
    for (i in 1:length(lseg)) {
        uu <- uu + lseg[i]
        genomdatj[(ll + 1):uu] <- genomdat[(ll + 1):uu] - 
            mean(genomdat[(ll + 1):uu])
        ll <- uu
    }
    genomdat.new <- c(genomdat.new, genomdatj)
}
gev_mle <- NULL
gev_mle[1] <- sum((genomdat.new - mean(genomdat.new))^3)/((length(genomdat.new) - 
    1) * sd(genomdat.new)^3)
gev_mle[2] <- sum((genomdat.new - mean(genomdat.new))^4)/((length(genomdat.new) - 
    1) * sd(genomdat.new)^4)
gev_mle
}
<environment: namespace:eCBS>

0 个答案:

没有答案