← 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-profile.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-profile.R
109
109
                 } else {
110
110
                     iv <- nls_port_fit(fittedModel, startPars[vary],
111
111
                                        lower[vary], upper[vary], ctrl, trace)
112
 
                     dev <- if(!iv[1] %in% 3:6) 
113
 
                        NA_real_ 
114
 
                     else 
 
112
                     dev <- if(!iv[1] %in% 3:6)
 
113
                        NA_real_
 
114
                     else
115
115
                        fittedModel$deviance()
116
116
                 }
117
117
                 profiledModel <- fittedModel
143
143
    upper <- rep(if(!is.null(upper)) as.double(upper) else Inf, length.out = npar)
144
144
    if(is.character(which)) which <- match(which, names(pars), 0)
145
145
    which <- which[which >= 1 & which <= npar]
146
 
    cutoff <- sqrt(npar * qf(1 - alphamax, npar, nobs - npar))
 
146
    ## was 'npar' - length(which) would have made more sense
 
147
    cutoff <- sqrt(qf(1 - alphamax, 1L, nobs - npar))
147
148
    out <- vector("list", npar)
148
149
    on.exit(prof$setDefault())     # in case there is an abnormal exit
149
150
    for(par in which) {
220
221
    out
221
222
}
222
223
 
223
 
plot.profile.nls <- function(x, levels, conf = c(99, 95, 90, 80, 50)/100,
224
 
                             nseg = 50, absVal = TRUE, ...)
 
224
plot.profile.nls <-
 
225
    function(x, levels, conf = c(99, 95, 90, 80, 50)/100, absVal = TRUE, ...)
225
226
{
226
227
    obj <- x
227
228
    dfres <- attr(obj, "summary")$df[2]
228
 
    confstr <- NULL
229
 
    if(missing(levels)) {
 
229
    if(missing(levels))
230
230
        levels <- sqrt(qf(pmax(0, pmin(1, conf)), 1, dfres))
231
 
        confstr <- paste(format(100 * conf), "%", sep = "")
232
 
    }
233
231
    if(any(levels <= 0)) {
234
232
        levels <- levels[levels > 0]
235
233
        warning("levels truncated to positive values only")
236
234
    }
237
 
    if(is.null(confstr)) {
238
 
        confstr <- paste(format(100 * pf(levels^2, 1, dfres)), "%", sep = "")
239
 
    }
240
235
    mlev <- max(levels) * 1.05
241
236
    nm <- names(obj)
242
237
    opar <- par(mar = c(5, 4, 1, 1) + 0.1)