← Back to branch summary

~showard314/ubuntu/karmic/r-base/remove_start_comments

« back to all changes in this revision

Viewing changes to src/library/stats/R/nls.R

  • Committer: Bazaar Package Importer
  • Author(s): Dirk Eddelbuettel
  • Date: 2009-01-19 12:40:24 UTC
  • mfrom: (5.1.4 sid)
  • Revision ID: james.westby@ubuntu.com-20090119124024-abxsf4e0y7713w9m
Tags: 2.8.1-2
http://bugs.debian.org/512324
debian/control: Add another Build-Depends: exclusion for the 
'kfreebsd-i386 kfreebsd-amd64 hurd-i386' architecture to openjdk-6-jdk.
Thanks to Petr Salinger for the heads-up.               (Closes: 512324)

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/library/stats/R/nls.R
23
23
###            Nonlinear least squares for R
24
24
###
25
25
 
26
 
numericDeriv <- function(expr, theta, rho = parent.frame(), dir=1)
 
26
numericDeriv <- function(expr, theta, rho = parent.frame(), dir=1.0)
27
27
{
28
28
    dir <- rep(dir, length.out = length(theta))
29
29
    val <- .Call(R_numeric_deriv, expr, theta, rho, dir)
531
531
 
532
532
    if(length(n) > 0) {
533
533
        varIndex <- n %% respLength == 0
534
 
        if(is.list(data) && diff(range(n)) > 0) {
 
534
        if(is.list(data) && diff(range(n[names(n) %in% names(data)])) > 0) {
535
535
            ## 'data' is a list that can not be coerced to a data.frame
536
536
            mf <- data
 
537
            if(!missing(subset))
 
538
                warning("argument 'subset' will be ignored")
 
539
            if(!missing(na.action))
 
540
                warning("argument 'na.action' will be ignored")
537
541
            if(missing(start))
538
542
                start <- getInitial(formula, mf)
539
543
            startEnv <- new.env(parent = environment(formula))
541
545
                assign(i, start[[i]], envir = startEnv)
542
546
            rhs <- eval(formula[[3]], data, startEnv)
543
547
            n <- NROW(rhs)
 
548
            ## mimic what model.frame.default does
 
549
            wts <- if (mWeights) rep(1, n) else
 
550
                eval(substitute(weights), data, environment(formula))
544
551
        }
545
552
        else {
546
553
            mf$formula <-  # replace by one-sided linear model formula
552
559
            mf <- eval.parent(mf)
553
560
            n <- nrow(mf)
554
561
            mf <- as.list(mf)
 
562
            wts <- if (!mWeights) model.weights(mf) else rep(1, n)
555
563
        }
556
 
        wts <- if (!mWeights) model.weights(mf) else rep(1, n)
557
564
        if (any(wts < 0 | is.na(wts)))
558
565
            stop("missing or negative weights not allowed")
559
566
    }