精华内容
下载资源
问答
  • 如何在R中查看函数源代码

    万次阅读 2018-08-02 21:47:06
    1、简单的函数(非类函数),直接在R里面输入函数名就可以查看源代码,例如: > replace function (x, list, values)  {  x[list] <- values  x } 2、对于类函数,直接输入函数名不能显示出...

    1、简单的函数(非类函数),直接在R里面输入函数名就可以查看源代码,例如:

    > replace

    function (x, list, values) 

    {

        x[list] <- values

        x

    }

    2、对于类函数,直接输入函数名不能显示出源代码,例如:

    > summary

    function (object, ...) 

    UseMethod("summary")

    这时候需要用到methods()函数,用法methods(FunctionName)如下:

    > methods(summary)

     [1] summary.aov             summary.aovlist         summary.aspell*        

     [4] summary.connection      summary.data.frame      summary.Date           

     [7] summary.default         summary.ecdf*           summary.factor         

    [10] summary.glm             summary.infl            summary.lm             

    [13] summary.loess*          summary.manova          summary.matrix         

    [16] summary.mlm             summary.nls*            summary.packageStatus* 

    [19] summary.PDF_Dictionary* summary.PDF_Stream*     summary.POSIXct        

    [22] summary.POSIXlt         summary.ppr*            summary.prcomp*        

    [25] summary.princomp*       summary.srcfile         summary.srcref         

    [28] summary.stepfun         summary.stl*            summary.table          

    [31] summary.tukeysmooth*   

     

       Non-visible functions are asterisked 加星号标注的是不可见的方法,也就是说使用summary.prcomp是不能看到源代码的。

    找到这个类函数里面你所关注的函数,输入函数名,回车,就可以查看代码了,如:

    > summary.aovlist

    function (object, ...) 

    {

        if (!is.null(attr(object, "weights"))) 

            cat("Note: The results below are on the weighted scale\n")

        dots <- list(...)

        strata <- names(object)

        if (strata[1L] == "(Intercept)") {

            strata <- strata[-1L]

            object <- object[-1L]

        }

        x <- vector(length = length(strata), mode = "list")

        names(x) <- paste("Error:", strata)

        for (i in seq_along(strata)) x[[i]] <- do.call("summary", 

            c(list(object = object[[i]]), dots))

        class(x) <- "summary.aovlist"

        x

    }

     

     

    对于非类函数使用methods会报出错误:

    > methods("sample")

    [1] sample.int

    Warning message:

    In methods("sample") : function 'sample' appears not to be generic

    对于具体的函数,要搞懂它,可能看这些信息还不够,需要下载*.tar.gz,查看里面的源代码。这时候linux下的find命令就非常有用,具体可以问问谷哥和度娘。

     

    3. The getAnywhere function is helpful when you don't know in which namespace is a function.

    首先,一个扩展包中定义的函数有区分公开和不公开的,会在扩展包根目录下的NAMESPACE文件中定义是否Export,如果一个函数没有Export,则为不公开的函数,只能在包内部调用。

    lattice::qq是一个Generic Function,就像是plot,summary等函数,是由对象的class来确定实际执行的函数(例如对于data frame,执行summary时会执行summary.data.frame,对于lm会执行summary.lm等等,都不是则会执行summary.default)这是R S3 面向对象系统的设计。因此看到qq源代码时只能看到 UseMethod("qq"),还要看到哪些class实现了qq方法,而lattice并没有把这些实现给Export

     

    4. 直接上CRAN 下载源代码包。对于加星号标注的是不可见的方法

    流程如下:

    1)       登入R主页 http://www.r-project.org/ ,点击 Download 下的CRAN

    2)       选择一个镜像

    3)       里面的Source Code for all Platforms就可以下载各种源码了,下面以下载程序包源码包为例,点packages

    4)       选择sorted的方式,推荐by name

    5)       找到你感兴趣的包,比如abind,点进去就可以看见Package source这一项,用tar.gz封装的,download就可以了,解压后就能看见源码了。

    展开全文
  • #R_函数#R中如何函数源代码

    千次阅读 2012-12-14 10:29:22
    作为一个开源软件,R的一个非常大的优点就是我们可以随意查看所有算法的源代码,对这些源代码进行分析的...最直接的方法当然是直接键入函数,大部分函数源代码就可以直接显现出来 > fivenum function (x, na.rm =

    作为一个开源软件,R的一个非常大的优点就是我们可以随意查看所有算法的源代码,在对这些源代码进行分析的过程中不仅可以加深对算法的认识,而且可以大步提高对R语言的掌握程度。所以接下来我重点写点关于各统计方法的R语言源代码的解释。今天先对如何查看源代码做点介绍。

    最直接的方法当然是直接键入函数,大部分函数源代码就可以直接显现出来

    > fivenum
    function (x, na.rm = TRUE) 
    {
        xna <- is.na(x)
        if (na.rm) 
            x <- x[!xna]
        else if (any(xna)) 
            return(rep.int(NA, 5))
        x <- sort(x)
        n <- length(x)
        if (n == 0) 
            rep.int(NA, 5)
        else {
            n4 <- floor((n + 3)/2)/2
            d <- c(1, n4, (n + 1)/2, n + 1 - n4, n)
            0.5 * (x[floor(d)] + x[ceiling(d)])
        }
    }
    <bytecode: 0x01f32270>
    <environment: namespace:stats>

    还有些函数直接键入出不来源代码,主要是因为R是面向对象设计的程序语言,不同的对象,计算方式也不同,所以要通过methods()来进一步定义具体的查看对象
    > mean
    function (x, ...) 
    UseMethod("mean")
    <bytecode: 0x019a54e4>
    <environment: namespace:base>
    不行,用methods查看

    > methods(mean)
    [1] mean.data.frame mean.Date       mean.default    mean.difftime  
    [5] mean.POSIXct    mean.POSIXlt  

    任意选择一个进行查看
    > mean.data.frame
    function (x, ...) 
    {
        msg <- "mean(<data.frame>) is deprecated.\n Use colMeans() or sapply(*, mean) instead."
        warning(paste(msg, collapse = ""), call. = FALSE, domain = NA)
        sapply(X = x, FUN = mean, ...)
    }
    <bytecode: 0x0260c92c>
    <environment: namespace:base>

    查看包里的函数过程一样,例如查看神经网络的源代码过程如下

    > library(nnet)
    > nnet
    function (x, ...) 
    UseMethod("nnet")
    <bytecode: 0x0180d6f4>
    <environment: namespace:nnet>
    > methods(nnet)
    [1] nnet.default nnet.formula
    > nnet.default
    function (x, y, weights, size, Wts, mask = rep(TRUE, length(wts)), 
        linout = FALSE, entropy = FALSE, softmax = FALSE, censored = FALSE, 
        skip = FALSE, rang = 0.7, decay = 0, maxit = 100, Hess = FALSE, 
        trace = TRUE, MaxNWts = 1000, abstol = 1e-04, reltol = 1e-08, 
        ...) 
    {
        net <- NULL
        x <- as.matrix(x)
        y <- as.matrix(y)
        if (any(is.na(x))) 
            stop("missing values in 'x'")
        if (any(is.na(y))) 
            stop("missing values in 'y'")
        if (dim(x)[1L] != dim(y)[1L]) 
            stop("nrows of 'x' and 'y' must match")
        if (linout && entropy) 
            stop("entropy fit only for logistic units")
        if (softmax) {
            linout <- TRUE
            entropy <- FALSE
        }
        if (censored) {
            linout <- TRUE
            entropy <- FALSE
            softmax <- TRUE
        }
        net$n <- c(dim(x)[2L], size, dim(y)[2L])
        net$nunits <- as.integer(1L + sum(net$n))
        net$nconn <- rep(0, net$nunits + 1L)
        net$conn <- numeric(0L)
        net <- norm.net(net)
        if (skip) 
            net <- add.net(net, seq(1L, net$n[1L]), seq(1L + net$n[1L] + 
                net$n[2L], net$nunits - 1L))
        if ((nwts <- length(net$conn)) == 0) 
            stop("no weights to fit")
        if (nwts > MaxNWts) 
            stop(gettextf("too many (%d) weights", nwts), domain = NA)
        nsunits <- net$nunits
        if (linout) 
            nsunits <- net$nunits - net$n[3L]
        net$nsunits <- nsunits
        net$decay <- decay
        net$entropy <- entropy
        if (softmax && NCOL(y) < 2L) 
            stop("'softmax = TRUE' requires at least two response categories")
        net$softmax <- softmax
        net$censored <- censored
        if (missing(Wts)) 
            if (rang > 0) 
                wts <- runif(nwts, -rang, rang)
            else wts <- rep(0, nwts)
        else wts <- Wts
        if (length(wts) != nwts) 
            stop("weights vector of incorrect length")
        if (length(mask) != length(wts)) 
            stop("incorrect length of 'mask'")
        if (trace) {
            cat("# weights: ", length(wts))
            nw <- sum(mask != 0)
            if (nw < length(wts)) 
                cat(" (", nw, " variable)\n", sep = "")
            else cat("\n")
            flush.console()
        }
        if (length(decay) == 1L) 
            decay <- rep(decay, length(wts))
        .C(VR_set_net, as.integer(net$n), as.integer(net$nconn), 
            as.integer(net$conn), as.double(decay), as.integer(nsunits), 
            as.integer(entropy), as.integer(softmax), as.integer(censored))
        ntr <- dim(x)[1L]
        nout <- dim(y)[2L]
        if (missing(weights)) 
            weights <- rep(1, ntr)
        if (length(weights) != ntr || any(weights < 0)) 
            stop("invalid weights vector")
        Z <- as.double(cbind(x, y))
        storage.mode(weights) <- "double"
        tmp <- .C(VR_dovm, as.integer(ntr), Z, weights, as.integer(length(wts)), 
            wts = as.double(wts), val = double(1), as.integer(maxit), 
            as.logical(trace), as.integer(mask), as.double(abstol), 
            as.double(reltol), ifail = integer(1L))
        net$value <- tmp$val
        net$wts <- tmp$wts
        net$convergence <- tmp$ifail
        tmp <- matrix(.C(VR_nntest, as.integer(ntr), Z, tclass = double(ntr * 
            nout), as.double(net$wts))$tclass, ntr, nout)
        dimnames(tmp) <- list(rownames(x), colnames(y))
        net$fitted.values <- tmp
        tmp <- y - tmp
        dimnames(tmp) <- list(rownames(x), colnames(y))
        net$residuals <- tmp
        .C(VR_unset_net)
        if (entropy) 
            net$lev <- c("0", "1")
        if (softmax) 
            net$lev <- colnames(y)
        net$call <- match.call()
        if (Hess) 
            net$Hessian <- nnetHess(net, x, y, weights)
        class(net) <- "nnet"
        net
    }
    <bytecode: 0x01e37238>
    <environment: namespace:nnet>

    展开全文
  • 查看R函数源代码

    2020-08-17 10:52:47
    学习R的过程,当你能够顺利的使用一些R各个包提供给你的函数以后,是否会让你想看一看具体这个过程是如何实现的呢?       我属于这种抱有浓厚兴趣的人之一,而且我也知道使用R...

    在学习R的过程中,当你能够顺利的使用一些R各个包提供给你的函数以后,是否会让你想看一看具体这个过程是如何实现的呢?

     
        我属于这种抱有浓厚兴趣的人之一,而且我也知道在使用R时间稍微长一点的用户中,想看看函数代码的人,不是少数;甚至有这么一些人,他们非常希望通过这些 成熟package中的函数学习如何编写自己的函数,实现自己的算法,达到自己的目的。同时,阅读这些函数代码确实是学习R最好的材料之一,尤其当国内尚 没有相应书籍资料介绍的时候。手册、帮助文件源文件中的函数代码,组成了最为正确,也最为宝贵的学习资料。手册是自带的,前面也已经提到了一些如何寻找帮 助的方法;下面就描述一下如何获得希望阅读到的代码。
     
        在R中,代码可以分为如下几个级别:
       
        首先,是你输入了函数对象名称,你可以直接看到代码的,如要获得函数对象fivenum的代码,就只需要在Console中键入函数对象名称fivenum就可以得到如下结果:
    function (x, na.rm = TRUE)
    {
        xna <- is.na(x)
        if (na.rm)
            x <- x[!xna]
        else if (any(xna))
            return(rep.int(NA, 5))
        x <- sort(x)
        n <- length(x)
        if (n == 0)
            rep.int(NA, 5)
        else {
            n4 <- floor((n + 3)/2)/2
            d <- c(1, n4, (n + 1)/2, n + 1 - n4, n)
            0.5 * (x[floor(d)] + x[ceiling(d)])
        }
    }
    <environment: namespace:stats>
       
        从上面的例子可以看出,这类函数对象的代码是最容易看到的,也是我们学习的最好的材料了,而R中最大多数的函数对象是以这种方式出现的。
     
        其次,我们在输入mean这类函数名次的时候,会出现如下结果:
     
    function (x, ...)
    UseMethod("mean")
    <environment: namespace:base>
       
        这表示函数作者把函数“封”起来了。这个时候我们可以先试一试methods(mean),利用methods函数看看mean这个函数都有哪些类型的,我们得到的结果如下:
     
    [1] mean.data.frame mean.Date       mean.default    mean.difftime   mean.POSIXct   mean.POSIXlt
     
        其实对此可以有一个简单的理解,虽然不够精确。因为在R中,mean函数可以求得属于不同类型对象的平均值,而不同类型对象平均值的求法还是有一些小小差 异的,比如说求一个向量的平均值和求一个数据框的平均值就有所差异,就要编写多个mean函数,然后“封”起来,以一个统一的mean出现,方便我们使 用。这正好也反映了R有一种类似泛型编程语言的性质。
     
        既然我们已经知道mean中还有这么多种类,我们可以输入mean.default试一试就可以得到:
     
    function (x, trim = 0, na.rm = FALSE, ...)
    {
        if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) {
            warning("argument is not numeric or logical: returning NA")
            return(as.numeric(NA))
        }
        if (na.rm)
            x <- x[!is.na(x)]
        trim <- trim[1]
        n <- length(x)
        if (trim > 0 && n > 0) {
            if (is.complex(x))
                stop("trimmed means are not defined for complex data")
            if (trim >= 0.5)
                return(stats::median(x, na.rm = FALSE))
            lo <- floor(n * trim) + 1
            hi <- n + 1 - lo
            x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi]
            n <- hi - lo + 1
        }
        .Internal(mean(x))
    }
    <environment: namespace:base>
        同样就可以得到mean.data.frame、mean.Date、mean.difftime、mean.POSIXct、mean.POSIXlt 的具体内容了。值得注意的是,在R中,出现有多个同样近似功能的函数封装为一个函数的时候(这时候在函数中多半会出现类似UseMethod函数使用的情 况),我们不妨先输入mean.default试一试。这种形式的函数在R中一般作为默认的函数表示。
     
        第三,这是一种特殊的情况,有人认为应该和第二种是一类,但是我还是要提出来单独归类。在这种情况也和第二种的原因有些类似,但并不是完全一致。
       
        也许我们大家都很熟悉plot函数了吧,输入函数名plot的时候,我们会得到如下结果:
     
    function (x, y, ...)
    {
        if (is.null(attr(x, "class")) && is.function(x)) {
            nms <- names(list(...))
            if (missing(y))
                y <- {
                    if (!"from" %in% nms)
                      0
                    else if (!"to" %in% nms)
                      1
                    else if (!"xlim" %in% nms)
                      NULL
                }
            if ("ylab" %in% nms)
                plot.function(x, y, ...)
            else plot.function(x, y, ylab = paste(deparse(substitute(x)),
                "(x)"), ...)
        }
        else UseMethod("plot")
    }
    <environment: namespace:graphics>
     
       请注意plot函数中也出现了UseMethod这个函数,但是和mean不同的是,前面有相当多的语句用于处理其他一些事情。这个时候,我们也使用methods(plot)来看看,得到如下结果:
     
    plot.acf*           plot.data.frame*    plot.Date*          plot.decomposed.ts* plot.default      
    plot.dendrogram*    plot.density        plot.ecdf           plot.factor*        plot.formula*     
    plot.hclust*        plot.histogram*     plot.HoltWinters*   plot.isoreg*        plot.lm           
    plot.medpolish*     plot.mlm            plot.POSIXct*       plot.POSIXlt*       plot.ppr*         
    plot.prcomp*        plot.princomp*      plot.profile.nls*   plot.spec          plot.spec.coherency
    plot.spec.phase     plot.stepfun        plot.stl*           plot.table*         plot.ts            
    plot.tskernel*      plot.TukeyHSD     
     
        不看不知道,一看吓一跳,还以为我们输入plot的输出就是函数本身,结果也许不是如此。可能有人已经理解了,其实最后的UseMethod函数实在默认的调用plot.default函数,赶快再看看plot.default函数吧,发现它再调用plot.xy函数,再看看plot.xy函数,再plot.xy函数中调用了一个.Internal(plot.xy(xy, type, pch, lty, col, bg, cex, lwd, ...))函数,也许这就是真正起作用的函数了吧。思路基本上就是如此了,是否这个时候您可以获得一些阅读查找R函数内容的乐趣。
     
        除了直接输入FUN.default形式外,还可以使用getS3method(FUN,"default")来获得代码。这样就解决了绝大多数函数代码查看的工作了。
     
        在第二种情况种,我们说了一般可以通过FUN.default获得想要的结果。但是只有称为generic的函数才有这种“特权”。而lm等则没有,不过我们也可以尝试使用methods(lm)来看看结果如何,发现:
    [1] lm.fit       lm.fit.null  lm.influence lm.wfit      lm.wfit.null
    Warning message:
    function 'lm' appears not to be generic in: methods(lm)
        出现了警告信息,表示说lm不是泛型函数,但是还是给出了结果lm.fit等,大致上可以看成是和lm相关的系列函数吧。这样子就出现了有趣的局面,比如说既有plot.ts,也有ts.plot。
     
        依照第三种情况,我们发现竟然有的函数用星号标识了的,比如plot.stl*等,当我们输入plot.stl,甚至是plot.stl*的时候都会给出 要么找不到这个对象,要么干脆是代码错误的信息。原来凡是用了*标识的函数,都是隐藏起来的函数,估计是怕被人看见(其实这是玩笑话)!我们要看这些函数 的代码,我们该怎么办呢?其实也很容易,使用功能强大的getAnywhere(FUN),看看这个函数的名称,就可以猜想到它的功能估计是很强大的, Anywhere的内容都可以找到!getAnywhere(plot.stl)的结果如下:
     
    A single object matching 'plot.stl' was found
    It was found in the following places
      registered S3 method for plot from namespace stats
      namespace:stats
    with value
    function (x, labels = colnames(X), set.pars = list(mar = c(0,
        6, 0, 6), oma = c(6, 0, 4, 0), tck = -0.01, mfrow = c(nplot,
        1)), main = NULL, range.bars = TRUE, ..., col.range = "light gray")
    {
        sers <- x$time.series
        ncomp <- ncol(sers)
        data <- drop(sers %*% rep(1, ncomp))
        X <- cbind(data, sers)
        colnames(X) <- c("data", colnames(sers))
        nplot <- ncomp + 1
        if (range.bars)
            mx <- min(apply(rx <- apply(X, 2, range), 2, diff))
        if (length(set.pars)) {
            oldpar <- do.call("par", as.list(names(set.pars)))
            on.exit(par(oldpar))
            do.call("par", set.pars)
        }
        for (i in 1:nplot) {
            plot(X[, i], type = if (i < nplot)
                "l"
            else "h", xlab = "", ylab = "", axes = FALSE, ...)
            if (range.bars) {
                dx <- 1/64 * diff(ux <- par("usr")[1:2])
                y <- mean(rx[, i])
                rect(ux[2] - dx, y + mx/2, ux[2] - 0.4 * dx, y -
                    mx/2, col = col.range, xpd = TRUE)
            }
            if (i == 1 && !is.null(main))
                title(main, line = 2, outer = par("oma")[3] > 0)
            if (i == nplot)
                abline(h = 0)
            box()
            right <- i%%2 == 0
            axis(2, labels = !right)
            axis(4, labels = right)
            axis(1, labels = i == nplot)
            mtext(labels[i], side = 2, 3)
        }
        mtext("time", side = 1, line = 3)
        invisible()
    }
    <environment: namespace:stats>
        注意到前面有一段解释型的语言,描述了我们要找的这个函数放在了什么地方等等。其实对任意我们可以在R中使用的函数,都可以先试一试getAnywhere,看看都有些什么内容。算是一个比较“霸道”的函数。
     
        在上面plot.xy函数中,我们还可以看到.Internal这个函数,类似的也许还可以看到.Primitive、.External、.Call等函数这就和R系统内部工作方式和与外部接口的定义有关了,如果对这些函数有兴趣的话,就要学习组成R系统的源代码了。
     
        最后,如果真的想阅读组成R系统本身的源代码,在各个CRAN中均有下载。你可以得到组成R系统所需要的材料。其中很多C语言(还有就是F)的源代码,均 是精心挑选过的算法,哪怕就是想学从头到尾编写具体的算法,也是学习的好材料。同时,你可以看到R系统内部是如何构成的,理解了这些对于高效使用R有至关 重要的作用。这个范畴的材料就要着重看一看R-Lang和R-inits了。
     
        至此,R中阅读代码的内容就依照我的理解介绍了一下。随后将有一些R代码示例的分析注解、语言本身、R应用的和行业使用的材料翻译和具体例子说明。欢迎大家多多和我交流,一起进步。

    原文路径:http://wangjinshe33.blog.163.com/blog/static/17558281201371301051757/ 

    展开全文
  • 作为一个开源软件,R的一个非常大的优点就是我们可以随意查看所有算法的源代码对这些源代码进行分析的过程不仅可以加深对算法的认识,而且可以大步提高对R语言的掌握程度。所以接下来我重点写点关于各统计方法...

    原文地址:http://blog.163.com/jiangfeng_data/blog/static/20641403820125795819567/

    作为一个开源软件,R的一个非常大的优点就是我们可以随意查看所有算法的源代码,在对这些源代码进行分析的过程中不仅可以加深对算法的认识,而且可以大步提高对R语言的掌握程度。所以接下来我重点写点关于各统计方法的R语言源代码的解释。今天先对如何查看源代码做点介绍。

    最直接的方法当然是直接键入函数,大部分函数源代码就可以直接显现出来

    > fivenum
    function (x, na.rm = TRUE) 
    {
        xna <- is.na(x)
        if (na.rm) 
            x <- x[!xna]
        else if (any(xna)) 
            return(rep.int(NA, 5))
        x <- sort(x)
        n <- length(x)
        if (n == 0) 
            rep.int(NA, 5)
        else {
            n4 <- floor((n + 3)/2)/2
            d <- c(1, n4, (n + 1)/2, n + 1 - n4, n)
            0.5 * (x[floor(d)] + x[ceiling(d)])
        }
    }
    <bytecode: 0x01f32270>
    <environment: namespace:stats>

    还有些函数直接键入出不来源代码,主要是因为R是面向对象设计的程序语言,不同的对象,计算方式也不同,所以要通过methods()来进一步定义具体的查看对象
    > mean
    function (x, ...) 
    UseMethod("mean")
    <bytecode: 0x019a54e4>
    <environment: namespace:base>
    不行,用methods查看

    > methods(mean)
    [1] mean.data.frame mean.Date       mean.default    mean.difftime  
    [5] mean.POSIXct    mean.POSIXlt  

    任意选择一个进行查看
    > mean.data.frame
    function (x, ...) 
    {
        msg <- "mean(<data.frame>) is deprecated.\n Use colMeans() or sapply(*, mean) instead."
        warning(paste(msg, collapse = ""), call. = FALSE, domain = NA)
        sapply(X = x, FUN = mean, ...)
    }
    <bytecode: 0x0260c92c>
    <environment: namespace:base>

    查看包里的函数过程一样,例如查看神经网络的源代码过程如下

    > library(nnet)
    > nnet
    function (x, ...) 
    UseMethod("nnet")
    <bytecode: 0x0180d6f4>
    <environment: namespace:nnet>
    > methods(nnet)
    [1] nnet.default nnet.formula
    > nnet.default
    function (x, y, weights, size, Wts, mask = rep(TRUE, length(wts)), 
        linout = FALSE, entropy = FALSE, softmax = FALSE, censored = FALSE, 
        skip = FALSE, rang = 0.7, decay = 0, maxit = 100, Hess = FALSE, 
        trace = TRUE, MaxNWts = 1000, abstol = 1e-04, reltol = 1e-08, 
        ...) 
    {
        net <- NULL
        x <- as.matrix(x)
        y <- as.matrix(y)
        if (any(is.na(x))) 
            stop("missing values in 'x'")
        if (any(is.na(y))) 
            stop("missing values in 'y'")
        if (dim(x)[1L] != dim(y)[1L]) 
            stop("nrows of 'x' and 'y' must match")
        if (linout && entropy) 
            stop("entropy fit only for logistic units")
        if (softmax) {
            linout <- TRUE
            entropy <- FALSE
        }
        if (censored) {
            linout <- TRUE
            entropy <- FALSE
            softmax <- TRUE
        }
        net$n <- c(dim(x)[2L], size, dim(y)[2L])
        net$nunits <- as.integer(1L + sum(net$n))
        net$nconn <- rep(0, net$nunits + 1L)
        net$conn <- numeric(0L)
        net <- norm.net(net)
        if (skip) 
            net <- add.net(net, seq(1L, net$n[1L]), seq(1L + net$n[1L] + 
                net$n[2L], net$nunits - 1L))
        if ((nwts <- length(net$conn)) == 0) 
            stop("no weights to fit")
        if (nwts > MaxNWts) 
            stop(gettextf("too many (%d) weights", nwts), domain = NA)
        nsunits <- net$nunits
        if (linout) 
            nsunits <- net$nunits - net$n[3L]
        net$nsunits <- nsunits
        net$decay <- decay
        net$entropy <- entropy
        if (softmax && NCOL(y) < 2L) 
            stop("'softmax = TRUE' requires at least two response categories")
        net$softmax <- softmax
        net$censored <- censored
        if (missing(Wts)) 
            if (rang > 0) 
                wts <- runif(nwts, -rang, rang)
            else wts <- rep(0, nwts)
        else wts <- Wts
        if (length(wts) != nwts) 
            stop("weights vector of incorrect length")
        if (length(mask) != length(wts)) 
            stop("incorrect length of 'mask'")
        if (trace) {
            cat("# weights: ", length(wts))
            nw <- sum(mask != 0)
            if (nw < length(wts)) 
                cat(" (", nw, " variable)\n", sep = "")
            else cat("\n")
            flush.console()
        }
        if (length(decay) == 1L) 
            decay <- rep(decay, length(wts))
        .C(VR_set_net, as.integer(net$n), as.integer(net$nconn), 
            as.integer(net$conn), as.double(decay), as.integer(nsunits), 
            as.integer(entropy), as.integer(softmax), as.integer(censored))
        ntr <- dim(x)[1L]
        nout <- dim(y)[2L]
        if (missing(weights)) 
            weights <- rep(1, ntr)
        if (length(weights) != ntr || any(weights < 0)) 
            stop("invalid weights vector")
        Z <- as.double(cbind(x, y))
        storage.mode(weights) <- "double"
        tmp <- .C(VR_dovm, as.integer(ntr), Z, weights, as.integer(length(wts)), 
            wts = as.double(wts), val = double(1), as.integer(maxit), 
            as.logical(trace), as.integer(mask), as.double(abstol), 
            as.double(reltol), ifail = integer(1L))
        net$value <- tmp$val
        net$wts <- tmp$wts
        net$convergence <- tmp$ifail
        tmp <- matrix(.C(VR_nntest, as.integer(ntr), Z, tclass = double(ntr * 
            nout), as.double(net$wts))$tclass, ntr, nout)
        dimnames(tmp) <- list(rownames(x), colnames(y))
        net$fitted.values <- tmp
        tmp <- y - tmp
        dimnames(tmp) <- list(rownames(x), colnames(y))
        net$residuals <- tmp
        .C(VR_unset_net)
        if (entropy) 
            net$lev <- c("0", "1")
        if (softmax) 
            net$lev <- colnames(y)
        net$call <- match.call()
        if (Hess) 
            net$Hessian <- nnetHess(net, x, y, weights)
        class(net) <- "nnet"
        net
    }
    <bytecode: 0x01e37238>
    <environment: namespace:nnet>

    展开全文
  • R语言泛型函数

    2019-04-12 18:30:33
    日常数据处理,我们可能会有这样的情况:即使看了函数的帮助文档, 仍然不能很好的使用这个函数。或者我们仅仅是对这个函数如何实现这样的复杂 功能感到好奇。...本文档包含了查看泛型函数源代码的方法
  • 写一个功能为通过在源代码中查看print_r()打印效果一样的函数方便数据查看测试 &lt;?php function p($var) { echo "&lt;pre&gt;"; print_r($var); echo "&lt...
  • 最近看LINUX书籍时,根据书代码找相应的... 在源代码目录下运行  ctags -R  这样,会递归生成当前目录下及其子目录的tags文件。 2.使用VIM根据tags文件查找函数或结构定义。  1.源码目录下查找  ...
  • 嵌套html 各种EJB之间的调用示例 7个目标文件 摘要:Java源码,初学实例,EJB调用实例 各种EJB之间的调用源码示例,用远程接口的引用访问EJB、函数将被FirstEJB调用,同时它将调用secondEJB 基于JAVA的UDP服务器...
  • 1.打开Fiddler, 菜单栏:Rules->... 在函数中添加一行代码,如下: 3.然后,点击菜单栏:File –> Save 或快捷键 Ctrl+S,关闭窗口。 再次查看Fiddler请求,将多出 “ServerIP” 一列显...
  • 如果您想查看某些代码的字节码(源代码,实时函数对象或代码对象等),则2735741803923223244032模块将告诉您所需的确切信息。 例如:>>> dis.dis('i/3')1 0 LOAD_NAME 0 (i)3 LOAD_CONST 0 (3)6 BINARY_TRUE...
  • 任务52: VBA编程实现抓取网页源代码 任务53: VBA编程实现获取网页表格写入数据表 第6章: MySQL数据库安装、配置与可视化工具 任务54: 安装MySQL 任务55: 使用CMD登录mysql 任务56: 数据库数据类型 任务57: ...
  • Python核心编程第二版(中文)

    热门讨论 2015-04-23 16:40:13
    12.8.4 源代码编码 12.8.5 导入循环 12.8.6 模块执行 12.9 相关模块 12.10 练习 第13章 面向对象编程 13.1 引言 13.2 面向对象编程 13.2.1 面向对象设计与面向对象编程的关系 13.2.2 现实的问题 13.2.3...
  • Python核心编程(中文第二版)

    热门讨论 2009-10-02 12:08:14
     3.4.2 主程序书写测试代码   3.5 内存管理   3.5.1 变量定义   3.5.2 动态类型   3.5.3 内存分配   3.5.4 引用计数   3.5.5 垃圾收集   3.6 第一个Python程序   3.7 相关模块和开发...
  • JAVA上百实例源码以及开源项目

    千次下载 热门讨论 2016-01-03 17:37:40
     Java绘制图片火焰效果,源代码相关注释:前景和背景Image对象、Applet和绘制火焰的效果的Image对象、Applet和绘制火焰的效果的Graphics对象、火焰效果的线程、Applet的高度,图片到图片装载器、绘制火焰效果的X坐标...
  •  3.4.2 主程序书写测试代码   3.5 内存管理   3.5.1 变量定义   3.5.2 动态类型   3.5.3 内存分配   3.5.4 引用计数   3.5.5 垃圾收集   3.6 第一个python程序   3.7 相关模块和开发...
  • asp.net知识库

    2015-06-18 08:45:45
    DataGridView中如何在textbox列限制输入。 ASP.NET 2.0构建动态导航的Web应用程序(TreeView和Menu ) 体验.net2.0的优雅(3) -- 为您的 SiteMap 添加 控制转发功能 GridView控件使用经验 ASP.NET 2.0:弃用 ...
  • 深入理解Python中文版高清PDF

    热门讨论 2012-09-04 19:37:04
     3.4.2 主程序书写测试代码   3.5 内存管理   3.5.1 变量定义   3.5.2 动态类型   3.5.3 内存分配   3.5.4 引用计数   3.5.5 垃圾收集   3.6 第一个Python程序   3.7 相关...
  • Python核心编程第二版

    热门讨论 2009-07-30 17:07:20
     3.4.2 主程序书写测试代码   3.5 内存管理   3.5.1 变量定义   3.5.2 动态类型   3.5.3 内存分配   3.5.4 引用计数   3.5.5 垃圾收集   3.6 第一个Python程序   3.7 相关模块和开发...
  • 精通Oracle PL/SQL--详细书签版

    热门讨论 2012-08-21 13:06:28
    8.3.1 查看过程和函数源代码 341 8.3.2 包的源代码 343 8.3.3 PL/SQL封装工具 343 8.4 小结 348 第9章 Web包 349 9.1 PL/SQL Web工具包基础 349 9.1.1 架构 349 9.1.2 包的汇总 351 9.1.3 从SQL*Plus测试...
  • 结果打印出来的数据正常,不可能为零,仔细查看相关代码,问题只可能指针移位上有问题,果然在函数中发现一处比较隐蔽的错误。 /* 功能:一个BM模块内所有小区CDB侧广播消息忙闲情况 */ /***************************...
  • C#编程经验技巧宝典

    热门讨论 2008-06-01 08:59:33
    C#编程经验技巧宝典源代码,目录如下: 第1章 开发环境 1 <br>1.1 Visual Studio开发环境安装与配置 2 <br>0001 安装Visual Studio 2005开发环境须知 2 <br>0002 配置合适的Visual Studio 2005...
  • C++MFC教程

    热门讨论 2013-05-21 13:37:15
    5、示例:下面有一段伪代码演示如何在窗口过程处理消息 LONG yourWndProc(HWND hWnd,UINT uMessageType,WPARAM wP,LPARAM) { switch(uMessageType) { //使用SWITCH语句将各种消息分开 case(WM_PAINT): ...
  • widget.h 文件添加相应代码,如下,先加入头文件,再加入my2 的定义语 句,这里我们将其放到private 里,因为一般的函数都放在public 里,而变量 都放在private 里。 #ifndef WIDGET_H #define WIDGET_H #...
  • LINGO软件的学习

    2009-08-08 22:36:50
    例1.1 如何在LINGO求解如下的LP问题: 在模型窗口输入如下代码: min=2*x1+3*x2; x1+x2>=350; x1>=100; 2*x1+x2; 然后点击工具条上的按钮 即可。 例1.2 使用LINGO软件计算6个发点8个收点的最小费用运输问题。...
  • 7.6 order by 和where子句使用串函数 127 7.6.1 SOUNDEX 128 7.6.2 国际语言支持 130 7.6.3 正则表达式支持 130 7.7 小结 130 第8章 正则表达式搜索 131 8.1 搜索串 132 8.2 REGEXP_SUBSTR 135 8.3 ...
  • vbio.zip 读写I/0口的VB源代码(18KB) 96,shellex5.zip Sellexecute demo Project(7KB) 97,inicon32.zip VB实现访问WINDOWS INI 文件的源代码(26KB) 98,fileio.zip 读写保存文件的...
  • PHP开发实战宝典

    热门讨论 2011-12-02 07:34:49
    13.5.2 应用GD2函数在照片上添加文字 261 13.5.3 应用图像处理技术生成验证码 262 13.5.4 Jpgraph创建柱状图展示年度收支情况 264 13.5.5 Jpgraph创建折线图统计图书销售走势 265 13.5.6 Jpgraph创建3D饼形图展示...

空空如也

空空如也

1 2 3
收藏数 44
精华内容 17
关键字:

如何在r中查看函数源代码