[r-cran-vgam] 05/63: Import Upstream version 0.7-3
Andreas Tille
tille at debian.org
Tue Jan 24 13:54:21 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-vgam.
commit 97b7190ed01e525d0c751a1a27c9321997a7a1d5
Author: Andreas Tille <tille at debian.org>
Date: Tue Jan 24 14:16:44 2017 +0100
Import Upstream version 0.7-3
---
DESCRIPTION | 6 +-
NAMESPACE | 2 +-
NEWS | 27 ++++++++
R/aamethods.q | 2 +-
R/add1.vglm.q | 2 +-
R/attrassign.R | 2 +-
R/build.terms.vlm.q | 2 +-
R/calibrate.q | 2 +-
R/cao.R | 2 +-
R/cao.fit.q | 9 ++-
R/coef.vlm.q | 2 +-
R/cqo.R | 2 +-
R/cqo.fit.q | 2 +-
R/deviance.vlm.q | 2 +-
R/effects.vglm.q | 2 +-
R/family.basics.q | 2 +-
R/family.binomial.q | 2 +-
R/family.bivariate.q | 2 +-
R/family.categorical.q | 2 +-
R/family.censored.q | 2 +-
R/family.extremes.q | 80 ++++++++++++-----------
R/family.functions.q | 2 +-
R/family.genetic.q | 2 +-
R/family.glmgam.q | 2 +-
R/family.loglin.q | 2 +-
R/family.mixture.q | 2 +-
R/family.nonlinear.q | 2 +-
R/family.normal.q | 2 +-
R/family.positive.q | 2 +-
R/family.qreg.q | 2 +-
R/family.rcqo.q | 2 +-
R/family.rrr.q | 2 +-
R/family.survival.q | 2 +-
R/family.ts.q | 2 +-
R/family.univariate.q | 6 +-
R/family.vglm.q | 2 +-
R/family.zeroinf.q | 11 +++-
R/fitted.vlm.q | 2 +-
R/generic.q | 2 +-
R/links.q | 2 +-
R/logLik.vlm.q | 2 +-
R/model.matrix.vglm.q | 2 +-
R/mux.q | 2 +-
R/plot.vglm.q | 146 +++++++++++++++++++++++++++++++-----------
R/predict.vgam.q | 2 +-
R/predict.vglm.q | 2 +-
R/predict.vlm.q | 2 +-
R/print.summary.others.q | 2 +-
R/print.vglm.q | 2 +-
R/print.vlm.q | 2 +-
R/qrrvglm.control.q | 2 +-
R/qtplot.q | 2 +-
R/residuals.vlm.q | 2 +-
R/rrvglm.R | 2 +-
R/rrvglm.control.q | 2 +-
R/rrvglm.fit.q | 12 ++--
R/s.q | 2 +-
R/s.vam.q | 2 +-
R/smart.R | 2 +-
R/step.vglm.q | 2 +-
R/summary.others.q | 2 +-
R/summary.vgam.q | 2 +-
R/summary.vglm.q | 2 +-
R/summary.vlm.q | 2 +-
R/uqo.R | 2 +-
R/vgam.R | 12 ++--
R/vgam.control.q | 2 +-
R/vgam.fit.q | 29 ++++++---
R/vgam.match.q | 2 +-
R/vglm.R | 2 +-
R/vglm.control.q | 2 +-
R/vglm.fit.q | 11 ++--
R/vlm.R | 2 +-
R/vlm.wfit.q | 2 +-
R/vsmooth.spline.q | 2 +-
R/zzz.R | 2 +-
man/Links.Rd | 2 +-
man/bilogistic4.Rd | 2 +-
man/gev.Rd | 3 +-
man/gpd.Rd | 64 +++++++++++--------
man/logistic.Rd | 5 ++
man/undocumented-methods.Rd | 2 +
man/uqo.Rd | 4 +-
man/vglm.control.Rd | 152 +++++++++++++++++++++++++-------------------
man/weibull.Rd | 1 +
man/zapoisson.Rd | 22 ++++++-
man/zibinomial.Rd | 6 +-
man/zipoisson.Rd | 3 +-
src/vlinpack3.f | 4 +-
89 files changed, 474 insertions(+), 275 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index d4dbf32..bd5db7d 100755
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: VGAM
-Version: 0.7-2
-Date: 2006-12-20
+Version: 0.7-3
+Date: 2007-04-30
Title: Vector Generalized Linear and Additive Models
Author: Thomas W. Yee <t.yee at auckland.ac.nz>
Maintainer: Thomas Yee <t.yee at auckland.ac.nz>
@@ -15,4 +15,4 @@ License: GPL version 2
URL: http://www.stat.auckland.ac.nz/~yee/VGAM
LazyLoad: yes
LazyData: yes
-Packaged: Wed Dec 20 13:59:01 2006; yee
+Packaged: Mon Apr 30 09:53:17 2007; yee
diff --git a/NAMESPACE b/NAMESPACE
index 35c1c38..7d0cb1a 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/NEWS b/NEWS
index 5736bd8..bb1b7a6 100755
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,33 @@
+ CHANGES IN VGAM VERSION 0.7-3
+
+NEW FEATURES
+
+ o gpd() now does not delete any data internally. The user should
+ use the subset argument of vglm() and vgam() in order to select
+ any subset of a data frame.
+ o zapoisson() has a zero argument, and this can be assigned
+ a negative value.
+ o "partial for" is added to the ylabel of linear terms of a vgam()
+ object when it is plotted.
+ o When a vgam() object is plotted with se=TRUE and if there are
+ linear terms then the mean of x is added to the plot (this makes
+ the standard error curves meet there).
+ o This package has been tested (somewhat) under R 2.5.0.
+
+BUG FIXES
+
+ o plotvgam() did not work for vgam() objects using the subset argument.
+ o cao() objects would not show() or print(), at least under R 2.4.1.
+ o summary(vgam.object) failed if vgam.object was a totally linear
+ model (i.e., no s() term in the formula). Now the "R" slot is
+ assigned for all vgam() objects.
+ o preplotvgam() had a bug regarding $se.fit of an atomic pred$se.fit.
+
+
+
CHANGES IN VGAM VERSION 0.7-2
NEW FEATURES
diff --git a/R/aamethods.q b/R/aamethods.q
index 5b5b0f6..543fb01 100644
--- a/R/aamethods.q
+++ b/R/aamethods.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/add1.vglm.q b/R/add1.vglm.q
index 035c323..f45f384 100644
--- a/R/add1.vglm.q
+++ b/R/add1.vglm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/attrassign.R b/R/attrassign.R
index fefece0..c59b8cd 100644
--- a/R/attrassign.R
+++ b/R/attrassign.R
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/build.terms.vlm.q b/R/build.terms.vlm.q
index ee3d94c..030ec25 100644
--- a/R/build.terms.vlm.q
+++ b/R/build.terms.vlm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/calibrate.q b/R/calibrate.q
index 27de56b..b3df9bb 100644
--- a/R/calibrate.q
+++ b/R/calibrate.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/cao.R b/R/cao.R
index 8229906..f4268bb 100644
--- a/R/cao.R
+++ b/R/cao.R
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/cao.fit.q b/R/cao.fit.q
index 7a45e45..eebe7a7 100644
--- a/R/cao.fit.q
+++ b/R/cao.fit.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
@@ -1812,3 +1812,10 @@ setMethod("Tol", "cao", function(object, ...)
+
+
+setMethod("show", "cao", function(object) print.vgam(object))
+setMethod("print", "cao", function(x, ...) print.vgam(x, ...))
+
+
+
diff --git a/R/coef.vlm.q b/R/coef.vlm.q
index c416fcc..c17322c 100644
--- a/R/coef.vlm.q
+++ b/R/coef.vlm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/cqo.R b/R/cqo.R
index 108ec03..a543e95 100644
--- a/R/cqo.R
+++ b/R/cqo.R
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
cqo <- function(formula,
diff --git a/R/cqo.fit.q b/R/cqo.fit.q
index f8e4533..a6ee10b 100644
--- a/R/cqo.fit.q
+++ b/R/cqo.fit.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/deviance.vlm.q b/R/deviance.vlm.q
index 74cb0cc..5d94935 100644
--- a/R/deviance.vlm.q
+++ b/R/deviance.vlm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/effects.vglm.q b/R/effects.vglm.q
index 1287a63..4a635f0 100644
--- a/R/effects.vglm.q
+++ b/R/effects.vglm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.basics.q b/R/family.basics.q
index 461cbbf..6d2a699 100644
--- a/R/family.basics.q
+++ b/R/family.basics.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.binomial.q b/R/family.binomial.q
index 353520b..33c5e5f 100644
--- a/R/family.binomial.q
+++ b/R/family.binomial.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.bivariate.q b/R/family.bivariate.q
index 7ff1016..96eee65 100644
--- a/R/family.bivariate.q
+++ b/R/family.bivariate.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.categorical.q b/R/family.categorical.q
index 99b6836..92dd701 100644
--- a/R/family.categorical.q
+++ b/R/family.categorical.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.censored.q b/R/family.censored.q
index 04aeb88..d04cba8 100644
--- a/R/family.censored.q
+++ b/R/family.censored.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.extremes.q b/R/family.extremes.q
index e5c33ce..2082fbf 100644
--- a/R/family.extremes.q
+++ b/R/family.extremes.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
@@ -175,6 +175,8 @@ gev <- function(llocation="identity",
misc$tshape0 = .tshape0
if(ncol(y)==1)
y = as.vector(y)
+ if(any(xi < -0.5))
+ warning("some values of the shape parameter are less than -0.5")
}), list( .llocation=llocation, .lscale=lscale, .lshape=lshape,
.elocation = elocation, .escale = escale, .eshape= eshape,
.tshape0=tshape0, .percentiles=percentiles ))),
@@ -488,6 +490,8 @@ egev <- function(llocation="identity",
misc$earg= list(location= .elocation, scale= .escale, shape= .eshape)
misc$tshape0 = .tshape0
misc$expected = TRUE
+ if(any(xi < -0.5))
+ warning("some values of the shape parameter are less than -0.5")
}), list( .llocation=llocation, .lscale=lscale, .lshape=lshape,
.elocation = elocation, .escale = escale, .eshape= eshape,
.tshape0=tshape0, .percentiles=percentiles ))),
@@ -881,6 +885,7 @@ qgpd = function(p, location=0, scale=1, shape=0) {
+
gpd = function(threshold=0,
lscale="loge",
lshape="logoff",
@@ -893,7 +898,7 @@ gpd = function(threshold=0,
tshape0=0.001,
method.init=1,
zero=2) {
- if(!is.Numeric(threshold, allow=1))
+ if(!is.Numeric(threshold))
stop("bad input for argument \"threshold\"")
if(!is.Numeric(method.init, allow=1, posit=TRUE, integer=TRUE) ||
method.init > 2.5)
@@ -923,30 +928,25 @@ gpd = function(threshold=0,
initialize=eval(substitute(expression({
if(ncol(as.matrix(y)) != 1)
stop("response must be a vector or one-column matrix")
- extra$orig.n = length(y)
- keep = (y > .threshold)
- orig.y = y[keep]
- y = orig.y - .threshold
- a = attr(x,"assign")
- x = x[keep,,drop=FALSE]
- attr(x,"assign") = a
- extra$sumkeep = sum(keep)
- extra$threshold = .threshold
- w = w[keep] # -> origw
- n = length(w)
+ Threshold = if(is.Numeric( .threshold)) .threshold else 0
+ if(is.Numeric( .threshold)) {
+ orig.y = y
+ }
+ ystar = y - Threshold # Operate on ystar
+ extra$threshold = Threshold
predictors.names=
- c(namesof("scale", .lscale, earg= .escale, short=TRUE),
- namesof("shape", .lshape, earg= .eshape, short=TRUE ))
+ c(namesof("scale", .lscale, earg= .escale, short=TRUE),
+ namesof("shape", .lshape, earg= .eshape, short=TRUE ))
if(!length(etastart)) {
- meany = mean(y)
- vary = var(y)
+ meany = mean(ystar)
+ vary = var(ystar)
xiinit = if(length(.ishape)) .ishape else {
if( .method.init == 1) -0.5*(meany^2/vary - 1) else
- 0.5 * (1 - median(y)^2 / vary)
+ 0.5 * (1 - median(ystar)^2 / vary)
}
siginit = if(length(.iscale)) .iscale else {
if(.method.init==1) 0.5*meany*(meany^2/vary + 1) else
- abs(1-xiinit) * median(y)
+ abs(1-xiinit) * median(ystar)
}
siginit[siginit <= 0] = 0.01 # sigma > 0
xiinit[xiinit <= -0.5] = -0.40 # Fisher scoring works if xi > -0.5
@@ -954,6 +954,7 @@ gpd = function(threshold=0,
if( .lshape == "loge") xiinit[xiinit <= 0.0] = 0.05
siginit = rep(siginit, leng=length(y))
xiinit = rep(xiinit, leng=length(y))
+
etastart = cbind(theta2eta(siginit, .lscale, earg= .escale ),
theta2eta(xiinit, .lshape, earg= .eshape ))
}
@@ -966,19 +967,20 @@ gpd = function(threshold=0,
xi = eta2theta(eta[,2], .lshape, earg= .eshape )
cent = .percentiles
lp = length(cent) # NULL means lp==0 and the mean is returned
+ Threshold = if(is.Numeric( .threshold)) .threshold else 0
if(lp) {
fv = matrix(as.numeric(NA), nrow(eta), lp)
iszero = (abs(xi) < .tshape0)
for(i in 1:lp) {
temp = 1-cent[i]/100
- fv[!iszero,i] = .threshold + (temp^(-xi[!iszero]) -1) *
+ fv[!iszero,i] = Threshold + (temp^(-xi[!iszero]) -1) *
sigma[!iszero] / xi[!iszero]
- fv[iszero,i] = .threshold - sigma[iszero] * log(temp)
+ fv[iszero,i] = Threshold - sigma[iszero] * log(temp)
}
dimnames(fv) = list(dimnames(eta)[[1]],
paste(as.character(.percentiles), "%", sep=""))
} else {
- fv = .threshold + sigma / (1 - xi) # This is the mean, E(Y)
+ fv = Threshold + sigma / (1 - xi) # This is the mean, E(Y)
fv[xi >= 1] = NA # Mean exists only if xi < 1.
}
fv
@@ -986,14 +988,15 @@ gpd = function(threshold=0,
.escale=escale, .eshape=eshape,
.tshape0=tshape0, .percentiles=percentiles ))),
last=eval(substitute(expression({
- y = orig.y # Put in @y, i.e., y slot of the fitted object
misc$links = c(scale = .lscale, shape = .lshape)
misc$true.mu = FALSE # @fitted is not a true mu
misc$earg= list(scale= .escale , shape= .eshape )
misc$percentiles = .percentiles
- misc$threshold = .threshold
+ misc$threshold = if(is.Numeric( .threshold)) .threshold else 0
misc$expected = TRUE
misc$tshape0 = .tshape0
+ if(any(xi < -0.5))
+ warning("some values of the shape parameter are less than -0.5")
}), list( .lscale=lscale, .lshape=lshape, .threshold=threshold,
.escale=escale, .eshape=eshape,
.tshape0=tshape0, .percentiles=percentiles ))),
@@ -1003,19 +1006,21 @@ gpd = function(threshold=0,
xi = eta2theta(eta[,2], .lshape, earg= .eshape )
if(any(iszero <- (abs(xi) < .tshape0))) {
}
- A = 1 + xi*y/sigma
+ Threshold = extra$threshold
+ ystar = y - Threshold # Operate on ystar
+ A = 1 + xi*ystar/sigma
mytolerance = .Machine$double.eps
bad <- (A<=mytolerance) # Range violation
- if(any(bad)) {
+ if(any(sum(w[bad]))) {
cat("There are some range violations\n")
if(exists("flush.console")) flush.console()
}
igpd = !iszero & !bad
iexp = iszero & !bad
if(residuals) stop("loglikelihood residuals not implemented yet") else
- sum(bad) * (-1.0e10) +
+ sum(w[bad]) * (-1.0e10) +
sum(w[igpd] * (-log(sigma[igpd]) - (1+1/xi[igpd])*log(A[igpd]))) +
- sum(w[iexp] * (-log(sigma[iexp]) - y[iexp]/sigma[iexp]))
+ sum(w[iexp] * (-log(sigma[iexp]) - ystar[iexp]/sigma[iexp]))
}, list( .tshape0=tshape0, .lscale=lscale,
.escale=escale, .eshape=eshape,
.lshape=lshape ))),
@@ -1023,11 +1028,13 @@ gpd = function(threshold=0,
deriv=eval(substitute(expression({
sigma = eta2theta(eta[,1], .lscale, earg= .escale )
xi = eta2theta(eta[,2], .lshape, earg= .eshape )
- A = 1 + xi*y/sigma
+ Threshold = extra$threshold
+ ystar = y - Threshold # Operate on ystar
+ A = 1 + xi*ystar/sigma
mytolerance = .Machine$double.eps
bad <- (A <= mytolerance)
- if(any(bad)) {
- cat(sum(bad,na.rm=TRUE), # "; ignoring them"
+ if(any(sum(w[bad]))) {
+ cat(sum(w[bad],na.rm=TRUE), # "; ignoring them"
"observations violating boundary constraints\n")
if(exists("flush.console")) flush.console()
}
@@ -1036,11 +1043,12 @@ gpd = function(threshold=0,
igpd = !iszero & !bad
iexp = iszero & !bad
dl.dxi = dl.dsigma = rep(0, len=length(y))
- dl.dsigma[igpd] = ((1 + xi[igpd]) * y[igpd] / (sigma[igpd] +
- xi[igpd]*y[igpd]) - 1) / sigma[igpd]
- dl.dxi[igpd] = log(A[igpd])/xi[igpd]^2 - (1 + 1/xi[igpd]) * y[igpd] /
- (A[igpd] * sigma[igpd])
- dl.dxi[iexp] = y[iexp] * (0.5*y[iexp]/sigma[iexp] - 1) / sigma[iexp]
+ dl.dsigma[igpd] = ((1 + xi[igpd]) * ystar[igpd] / (sigma[igpd] +
+ xi[igpd]*ystar[igpd]) - 1) / sigma[igpd]
+ dl.dxi[igpd] = log(A[igpd])/xi[igpd]^2 - (1 + 1/xi[igpd]) *
+ ystar[igpd] / (A[igpd] * sigma[igpd])
+ dl.dxi[iexp] = ystar[iexp] *
+ (0.5*ystar[iexp]/sigma[iexp] - 1) / sigma[iexp]
dsigma.deta = dtheta.deta(sigma, .lscale, earg= .escale )
dxi.deta = dtheta.deta(xi, .lshape, earg= .eshape )
w * cbind(dl.dsigma * dsigma.deta, dl.dxi * dxi.deta)
diff --git a/R/family.functions.q b/R/family.functions.q
index 9975da5..6a4840c 100644
--- a/R/family.functions.q
+++ b/R/family.functions.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.genetic.q b/R/family.genetic.q
index 963162a..d0eb84c 100644
--- a/R/family.genetic.q
+++ b/R/family.genetic.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.glmgam.q b/R/family.glmgam.q
index ff4ccb4..34706ba 100644
--- a/R/family.glmgam.q
+++ b/R/family.glmgam.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.loglin.q b/R/family.loglin.q
index c79619c..2b79836 100644
--- a/R/family.loglin.q
+++ b/R/family.loglin.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.mixture.q b/R/family.mixture.q
index d5f9cc2..e93e583 100644
--- a/R/family.mixture.q
+++ b/R/family.mixture.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.nonlinear.q b/R/family.nonlinear.q
index e7b8245..02317e8 100644
--- a/R/family.nonlinear.q
+++ b/R/family.nonlinear.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.normal.q b/R/family.normal.q
index 5b3b690..819f58b 100644
--- a/R/family.normal.q
+++ b/R/family.normal.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.positive.q b/R/family.positive.q
index 8daa2cb..972e668 100644
--- a/R/family.positive.q
+++ b/R/family.positive.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.qreg.q b/R/family.qreg.q
index 8f13022..cab9485 100644
--- a/R/family.qreg.q
+++ b/R/family.qreg.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.rcqo.q b/R/family.rcqo.q
index bab771c..dc289ce 100644
--- a/R/family.rcqo.q
+++ b/R/family.rcqo.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.rrr.q b/R/family.rrr.q
index cbbee2b..a9c19da 100644
--- a/R/family.rrr.q
+++ b/R/family.rrr.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.survival.q b/R/family.survival.q
index 3d6cff5..c18ab40 100644
--- a/R/family.survival.q
+++ b/R/family.survival.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.ts.q b/R/family.ts.q
index 1c6657d..4a2c0e6 100644
--- a/R/family.ts.q
+++ b/R/family.ts.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.univariate.q b/R/family.univariate.q
index bffae55..b1cd434 100644
--- a/R/family.univariate.q
+++ b/R/family.univariate.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
@@ -1883,7 +1883,7 @@ gamma2 = function(lmu="loge", lshape="loge",
ans =
new("vglmff",
blurb=c("2-parameter Gamma distribution",
- " (McCullagh \& Nelder 1989 parameterization)\n",
+ " (McCullagh and Nelder 1989 parameterization)\n",
"Links: ",
namesof("mu", lmu, earg=emu), ", ",
namesof("shape", lshape, earg=eshape), "\n",
@@ -7918,7 +7918,7 @@ logistic2 = function(llocation="identity",
scale.init = sqrt(3) * sd(y) / pi
} else {
location.init = median(rep(y, w))
- scale.init = sqrt(3) * sum(w*(y-location.init)^2) / (sum(w) *pi)
+ scale.init = sqrt(3) * sum(w*(y-location.init)^2) / (sum(w)*pi)
}
location.init = if(length(.ilocation)) rep(.ilocation, len=n) else
rep(location.init, len=n)
diff --git a/R/family.vglm.q b/R/family.vglm.q
index abfe7bd..67a9bd7 100644
--- a/R/family.vglm.q
+++ b/R/family.vglm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/family.zeroinf.q b/R/family.zeroinf.q
index 03f01fb..c7dbd91 100644
--- a/R/family.zeroinf.q
+++ b/R/family.zeroinf.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
@@ -136,7 +136,8 @@ yip88 = function(link.lambda="loge", n.arg=NULL)
zapoisson = function(lp0="logit", llambda="loge",
- ep0=list(), elambda=list())
+ ep0=list(), elambda=list(),
+ zero=NULL)
{
if(mode(lp0) != "character" && mode(lp0) != "name")
lp0 = as.character(substitute(lp0))
@@ -152,6 +153,12 @@ zapoisson = function(lp0="logit", llambda="loge",
namesof("p0", lp0, earg=ep0, tag=FALSE), ", ",
namesof("lambda", llambda, earg= .elambda, tag=FALSE),
"\n"),
+ constraints=eval(substitute(expression({
+ temp752 = .zero
+ if(length(temp752) && all(temp752 == -1))
+ temp752 = 2*(1:ncol(y)) - 1
+ constraints = cm.zero.vgam(constraints, x, temp752, M)
+ }), list( .zero=zero ))),
initialize=eval(substitute(expression({
y = as.matrix(y)
extra$y0 = y0 = ifelse(y==0, 1, 0)
diff --git a/R/fitted.vlm.q b/R/fitted.vlm.q
index d08cfd5..8df6421 100644
--- a/R/fitted.vlm.q
+++ b/R/fitted.vlm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/generic.q b/R/generic.q
index 2a40412..5bd7314 100644
--- a/R/generic.q
+++ b/R/generic.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
add1.vgam <- function(...)
diff --git a/R/links.q b/R/links.q
index 5070705..7917a99 100644
--- a/R/links.q
+++ b/R/links.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/logLik.vlm.q b/R/logLik.vlm.q
index 52628f7..d834f60 100644
--- a/R/logLik.vlm.q
+++ b/R/logLik.vlm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/model.matrix.vglm.q b/R/model.matrix.vglm.q
index cbe7f9c..0cb0eb0 100644
--- a/R/model.matrix.vglm.q
+++ b/R/model.matrix.vglm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/mux.q b/R/mux.q
index 96db8c7..2dbee29 100644
--- a/R/mux.q
+++ b/R/mux.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/plot.vglm.q b/R/plot.vglm.q
index 203d790..1b66f52 100644
--- a/R/plot.vglm.q
+++ b/R/plot.vglm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
@@ -108,19 +108,25 @@ ylim.scale <- function(ylim, scale=0) {
+
+
+
preplotvgam = function(object, newdata=NULL,
- terms=if(is.R()) labels(object) else v.labels.lm(object),
- raw= TRUE, deriv.arg=deriv.arg, se= FALSE)
+ terms=if(is.R()) attr((object at terms)$terms, "term.labels") else
+ v.labels.lm(object),
+ raw= TRUE, deriv.arg=deriv.arg, se= FALSE)
{
Terms <- terms(object) # 11/8/03; object at terms$terms
aa <- attributes(Terms)
-
- if(!is.R()) Call <- object at call
-
+ Call <- object at call
all.terms <- labels(Terms)
- xvars <- as.vector(Terms)
+ xvars <- if(is.R()) parse(text=all.terms) else as.vector(Terms)
+
- if(!is.R()) {
+ if(is.R()) {
+ names(xvars) <- all.terms
+ terms <- sapply(terms, match.arg, all.terms)
+ } else {
names(xvars) <- all.terms
terms <- match.arg(terms, all.terms)
}
@@ -137,13 +143,66 @@ preplotvgam = function(object, newdata=NULL,
}
}
- if(!is.R()) {
+ if(is.R()) {
xvars <- xvars[terms]
xnames <- as.list(terms)
names(xnames) <- terms
modes <- sapply(xvars, mode)
- for(term in terms[modes != "name"])
- {
+ for(term in terms[modes != "name"]) {
+ evars <- all.names(xvars[term], functions= FALSE, unique= TRUE)
+ if(!length(evars))
+ next
+ xnames[[term]] <- evars
+ evars <- parse(text=evars)
+ if(length(evars) == 1)
+ evars <- evars[[1]]
+ else {
+ evars <- c(as.name("list"), evars)
+ mode(evars) <- "call"
+ }
+ xvars[[term]] <- evars
+ }
+
+
+ xvars <- c(as.name("list"), xvars)
+ mode(xvars) <- "call"
+ if(length(newdata)) {
+ xvars <- eval(xvars, newdata)
+ } else {
+ if(!is.null(Call$subset) | !is.null(Call$na.action) |
+ !is.null(options("na.action")[[1]])) {
+ Rownames <- names(fitted(object))
+ if(!(Rl <- length(Rownames)))
+ Rownames <- dimnames(fitted(object))[[1]]
+
+ if(length(object at x) && !(Rl <- length(Rownames)))
+ Rownames <- (dimnames(object at x))[[1]]
+ if(length(object at y) && !(Rl <- length(Rownames)))
+ Rownames <- (dimnames(object at y))[[1]]
+
+ if(!(Rl <- length(Rownames)))
+ stop(paste("need to have names for fitted.values",
+ "when call has a subset or na.action argument"))
+
+ form <- paste("~", unlist(xnames), collapse="+")
+ Mcall <- c(as.name("model.frame"), list(formula =
+ terms(as.formula(form)),
+ subset = Rownames, na.action = function(x) x))
+ mode(Mcall) <- "call"
+ Mcall$data <- Call$data
+ xvars <- eval(xvars, eval(Mcall))
+ } else {
+ ecall <- substitute(eval(expression(xvars)))
+ ecall$local <- Call$data
+ xvars <- eval(ecall)
+ }
+ }
+ } else {
+ xvars <- xvars[terms]
+ xnames <- as.list(terms)
+ names(xnames) <- terms
+ modes <- sapply(xvars, mode)
+ for(term in terms[modes != "name"]) {
evars <- all.names(xvars[term], functions= FALSE, unique= TRUE)
if(!length(evars))
next
@@ -162,12 +221,11 @@ preplotvgam = function(object, newdata=NULL,
xvars <- c(as.name("list"), xvars)
mode(xvars) <- "call"
- if(length(newdata))
- xvars <- eval(xvars, newdata) else
- {
+ if(length(newdata)) {
+ xvars <- eval(xvars, newdata)
+ } else {
if(!is.null(Call$subset) | !is.null(Call$na.action) |
- !is.null(options("na.action")[[1]]))
- {
+ !is.null(options("na.action")[[1]])) {
Rownames <- names(fitted(object))
if(!(Rl <- length(Rownames)))
Rownames <- dimnames(fitted(object))[[1]]
@@ -188,37 +246,36 @@ preplotvgam = function(object, newdata=NULL,
}
}
- if(!length(newdata)) {
- pred <- predict(object, type="terms",
+ if(length(newdata)) {
+ pred <- predict(object, newdata, type="terms",
raw=raw, se.fit=se, deriv.arg=deriv.arg)
} else {
- pred <- predict(object, newdata, type="terms",
+ pred <- predict(object, type="terms",
raw=raw, se.fit=se, deriv.arg=deriv.arg)
}
- fits <- pred$fit
- se.fit <- pred$se.fit
- if(is.null(fits))
+ fits <- if(is.atomic(pred)) NULL else pred$fit
+ se.fit <- if(is.atomic(pred)) NULL else pred$se.fit
+ if(is.null(fits))
fits <- pred
fred <- attr(fits, "vterm.assign") # NULL for M==1
- if(is.R()) {
+ if(FALSE && is.R()) {
xnames <- vector("list", length(fred))
names(xnames) <- names(fred)
}
gamplot <- xnames
- if(is.R()) {
+ if(FALSE && is.R()) {
s.x = if(any(slotNames(object)=="s.xargument")) object at s.xargument else
NULL
n.s.x = names(s.x)
}
loop.var = if(is.R()) names(fred) else terms
- for(term in loop.var)
- {
- if(is.R()) {
+ for(term in loop.var) {
+ if(FALSE && is.R()) {
useterm <- term
if(length(n.s.x) && any(n.s.x == useterm))
useterm <- s.x[useterm]
@@ -233,9 +290,7 @@ preplotvgam = function(object, newdata=NULL,
}
}
- if(!is.R()) {
- .VGAM.x <- xvars[[term]]
- } else {
+ if(FALSE && is.R()) {
.VGAM.x <- if(length(newdata)) newdata[[innerx]] else {
if(( is.R() && object at misc$dataname != "list") ||
(!is.R() && object at misc$dataname != "sys.parent")) {
@@ -249,24 +304,29 @@ preplotvgam = function(object, newdata=NULL,
eval(getx, envir = .GlobalEnv) else eval(getx)
.VGAM.ans
}
- }
+ } # else {
- if(is.R()) {
+ .VGAM.x <- xvars[[term]]
+
+
+ if(FALSE && is.R()) {
class(.VGAM.x)=unique(c(class(.VGAM.x),data.class(unclass(.VGAM.x))))
}
+ myylab = if(all(substring(term, 1:nchar(term), 1:nchar(term)) != "("))
+ paste("partial for", term) else term
+
TT <- list(x = .VGAM.x,
y = fits[, if(is.null(fred)) term else fred[[term]]],
se.y = if(is.null(se.fit)) NULL else
se.fit[, if(is.null(fred)) term else fred[[term]]],
- xlab = if(is.R()) innerx else xnames[[term]],
- ylab = term)
+ xlab = xnames[[term]],
+ ylab = myylab)
class(TT) <- "preplotvgam"
gamplot[[term]] <- TT
}
if(!is.R())
class(gamplot) <- "preplotvgam" # Commented out 8/6/02
-
invisible(gamplot)
}
@@ -372,7 +432,6 @@ plotpreplotvgam <- function(x, y=NULL, residuals=NULL,
uniq.comps <- unique(c(names(x), names(d)))
Call <- c(as.name("vplot"), c(d, x)[uniq.comps])
-
mode(Call) <- "call"
invisible(eval(Call))
}
@@ -529,13 +588,24 @@ vplot.numeric <- function(x, y, se.y=NULL, xlab, ylab,
ylab <- add.hookey(ylab, deriv.arg)
+
+ if(xmeanAdded <- (se && !is.null(se.y) &&
+ all(substring(ylab, 1:nchar(ylab), 1:nchar(ylab)) != "("))) {
+ x = c(x, mean(x))
+ y = rbind(y, 0 * y[1,])
+ se.y = rbind(se.y, 0 * se.y[1,])
+ if(!is.null(residuals))
+ residuals = rbind(residuals, NA*residuals[1,]) # NAs not plotted
+ }
+
ux <- unique(sort(x))
o <- match(ux, x)
uy <- y[o,,drop= FALSE]
xlim <- range(xlim, ux)
ylim <- range(ylim, uy[,which.cf], na.rm= TRUE)
if(rugplot) {
- jx <- jitter(x[!is.na(x)])
+ usex = if(xmeanAdded) x[-length(x)] else x
+ jx <- jitter(usex[!is.na(usex)])
xlim <- range(c(xlim, jx))
}
@@ -658,7 +728,7 @@ vplot.matrix <- function(x, y, se.y=NULL, xlab, ylab,
offset.arg=0, deriv.arg=0, overlay= FALSE,
which.cf=NULL, ...)
{
- stop("you shouldn't ever call this function!")
+ stop("You shouldn't ever call this function!")
}
diff --git a/R/predict.vgam.q b/R/predict.vgam.q
index 69e9432..1bcb3f7 100644
--- a/R/predict.vgam.q
+++ b/R/predict.vgam.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/predict.vglm.q b/R/predict.vglm.q
index 2847cf7..cef470c 100644
--- a/R/predict.vglm.q
+++ b/R/predict.vglm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/predict.vlm.q b/R/predict.vlm.q
index df72664..b5e68cf 100644
--- a/R/predict.vlm.q
+++ b/R/predict.vlm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/print.summary.others.q b/R/print.summary.others.q
index bb20d72..daca261 100644
--- a/R/print.summary.others.q
+++ b/R/print.summary.others.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/print.vglm.q b/R/print.vglm.q
index 5f77ee0..b795cf8 100644
--- a/R/print.vglm.q
+++ b/R/print.vglm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
print.vglm <- function(x, ...)
diff --git a/R/print.vlm.q b/R/print.vlm.q
index 38d6218..193d113 100644
--- a/R/print.vlm.q
+++ b/R/print.vlm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/qrrvglm.control.q b/R/qrrvglm.control.q
index a78553b..c830ad7 100644
--- a/R/qrrvglm.control.q
+++ b/R/qrrvglm.control.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
qrrvglm.control = function(Rank=1,
diff --git a/R/qtplot.q b/R/qtplot.q
index f396671..29a7d55 100644
--- a/R/qtplot.q
+++ b/R/qtplot.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/residuals.vlm.q b/R/residuals.vlm.q
index a14e3a3..31f5d87 100644
--- a/R/residuals.vlm.q
+++ b/R/residuals.vlm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/rrvglm.R b/R/rrvglm.R
index a1b3297..0a3164f 100644
--- a/R/rrvglm.R
+++ b/R/rrvglm.R
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/rrvglm.control.q b/R/rrvglm.control.q
index aa7441d..513f436 100644
--- a/R/rrvglm.control.q
+++ b/R/rrvglm.control.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/rrvglm.fit.q b/R/rrvglm.fit.q
index e57f45a..07b206d 100644
--- a/R/rrvglm.fit.q
+++ b/R/rrvglm.fit.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
@@ -203,20 +203,20 @@ rrvglm.fit <- function(x, y, w=rep(1, length(x[, 1])),
Rank <- control$Rank
rrcontrol <- control #
- if(length(family at initialize))
- eval(family at initialize) # Initialize mu and M (and optionally w)
- n <- n.save
+ if(length(slot(family, "initialize")))
+ eval(slot(family, "initialize")) # Initialize mu & M (and optionally w)
eval(rrr.init.expression)
if(length(etastart)) {
eta <- etastart
- mu <- if(length(mustart)) mustart else family at inverse(eta, extra)
+ mu <- if(length(mustart)) mustart else
+ slot(family, "inverse")(eta, extra)
} else {
if(length(mustart))
mu <- mustart
- eta <- family at link(mu, extra)
+ eta <- slot(family, "link")(mu, extra)
}
M <- if(is.matrix(eta)) ncol(eta) else 1
diff --git a/R/s.q b/R/s.q
index 4d1d2f1..f8c9e69 100644
--- a/R/s.q
+++ b/R/s.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/s.vam.q b/R/s.vam.q
index cde20d3..f9e1e06 100644
--- a/R/s.vam.q
+++ b/R/s.vam.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/smart.R b/R/smart.R
index 895fb1a..aa81523 100644
--- a/R/smart.R
+++ b/R/smart.R
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/step.vglm.q b/R/step.vglm.q
index 8059425..8c388e8 100644
--- a/R/step.vglm.q
+++ b/R/step.vglm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
step.vglm <- function(fit, ...)
diff --git a/R/summary.others.q b/R/summary.others.q
index 30f933d..20f66cf 100644
--- a/R/summary.others.q
+++ b/R/summary.others.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/summary.vgam.q b/R/summary.vgam.q
index 189a8ca..4b33c5d 100644
--- a/R/summary.vgam.q
+++ b/R/summary.vgam.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/summary.vglm.q b/R/summary.vglm.q
index e78e17f..15a2562 100644
--- a/R/summary.vglm.q
+++ b/R/summary.vglm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/summary.vlm.q b/R/summary.vlm.q
index 6c36eb1..a103153 100644
--- a/R/summary.vlm.q
+++ b/R/summary.vlm.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/uqo.R b/R/uqo.R
index 3bd62fc..465396e 100644
--- a/R/uqo.R
+++ b/R/uqo.R
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/vgam.R b/R/vgam.R
index 946c63f..9cf6fe0 100644
--- a/R/vgam.R
+++ b/R/vgam.R
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
@@ -196,6 +196,7 @@ vgam <- function(formula,
"family" = fit$family,
"misc" = fit$misc,
"model" = if(model) mf else data.frame(),
+ "R" = fit$R,
"rank" = fit$rank,
"residuals" = as.matrix(fit$residuals),
"rss" = fit$rss,
@@ -251,10 +252,11 @@ vgam <- function(formula,
if(length(fit$var)) {
slot(answer, "var") = fit$var
}
- if(length(fit$R)) {
- slot(answer, "R") = fit$R # is null if totally parametric model
- } else
- warning("the \"R\" slot is NULL. Best to run vglm()") # zz;
+
+
+
+
+
}
if(length(fit$effects))
diff --git a/R/vgam.control.q b/R/vgam.control.q
index 02074df..4b61aeb 100644
--- a/R/vgam.control.q
+++ b/R/vgam.control.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/vgam.fit.q b/R/vgam.fit.q
index 9c6b7ff..b35d662 100644
--- a/R/vgam.fit.q
+++ b/R/vgam.fit.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
@@ -105,19 +105,20 @@ vgam.fit <- function(x, y, w, mf,
old.coeffs <- coefstart
intercept.only <- ncol(x) == 1 && dimnames(x)[[2]] == "(Intercept)"
- y.names <- predictors.names <- NULL # May be overwritten in $initialize
+ y.names <- predictors.names <- NULL # May be overwritten in @initialize
- n.save <- dim(x)[1]
- eval(family at initialize)
- n <- n.save
+ n.save <- n
+ if(length(slot(family, "initialize")))
+ eval(slot(family, "initialize")) # Initialize mu & M (and optionally w)
if(length(etastart)) {
eta <- etastart
- mu <- if(length(mustart)) mustart else family at inverse(eta, extra)
+ mu <- if(length(mustart)) mustart else
+ slot(family, "inverse")(eta, extra)
} else {
if(length(mustart))
mu <- mustart
- eta <- family at link(mu, extra)
+ eta <- slot(family, "link")(mu, extra)
}
M <- if(is.matrix(eta)) ncol(eta) else 1
@@ -161,7 +162,8 @@ vgam.fit <- function(x, y, w, mf,
bf.call <- if(is.R()) expression(vlm.wfit(xbig.save, z, Blist=NULL,
U=U, matrix.out=FALSE, XBIG=TRUE, qr=qr.arg, xij=NULL)) else
expression(vlm.wfit(xbig.save, z, Blist=NULL,
- U=U, matrix.out=FALSE, XBIG=TRUE, singular.ok=TRUE, qr=qr.arg, xij=NULL))
+ U=U, matrix.out=FALSE, XBIG=TRUE, singular.ok=TRUE, qr=qr.arg,
+ xij=NULL))
bf <- "vlm.wfit"
}
@@ -248,6 +250,16 @@ vgam.fit <- function(x, y, w, mf,
stop("rank < ncol(x) is bad")
} else rank <- ncol(x) # zz 8/12/01 I think rank is all wrong
+ R <- if(is.R()) tfit$qr$qr[1:p.big, 1:p.big, drop=FALSE] else {
+ if(backchat) tfit$qr[1:p.big, 1:p.big, drop=FALSE] else
+ tfit$qr$qr[1:p.big, 1:p.big, drop=FALSE]
+ }
+ R[lower.tri(R)] <- 0
+ attributes(R) <- if(is.R()) list(dim=c(p.big, p.big),
+ dimnames=list(cnames, cnames), rank=rank) else
+ list(dim=c(p.big, p.big),
+ dimnames=list(cnames, cnames), rank=rank, class="upper")
+
dn <- labels(x)
@@ -278,6 +290,7 @@ vgam.fit <- function(x, y, w, mf,
iter=iter,
offset=offset,
rank=rank,
+ R=R,
terms=Terms)))
df.residual <- n.big - rank
diff --git a/R/vgam.match.q b/R/vgam.match.q
index 4fca0b0..bad9f11 100644
--- a/R/vgam.match.q
+++ b/R/vgam.match.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/vglm.R b/R/vglm.R
index 6984465..50e126c 100644
--- a/R/vglm.R
+++ b/R/vglm.R
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/vglm.control.q b/R/vglm.control.q
index 1a5731d..08a7b68 100644
--- a/R/vglm.control.q
+++ b/R/vglm.control.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/vglm.fit.q b/R/vglm.fit.q
index e88382c..bf38307 100644
--- a/R/vglm.fit.q
+++ b/R/vglm.fit.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
@@ -192,13 +192,13 @@ vglm.fit <- function(x, y, w=rep(1, length(x[, 1])),
if(length(slot(family, "initialize")))
- eval(slot(family, "initialize")) # Initialize mu and M (and optionally w)
- n <- n.save
+ eval(slot(family, "initialize")) # Initialize mu & M (and optionally w)
if(length(etastart)) {
eta <- etastart
- mu <- if(length(mustart)) mustart else slot(family, "inverse")(eta, extra)
+ mu <- if(length(mustart)) mustart else
+ slot(family, "inverse")(eta, extra)
} else {
if(length(mustart))
mu <- mustart
@@ -360,7 +360,8 @@ vglm.fit <- function(x, y, w=rep(1, length(x[, 1])),
residuals <- as.vector(residuals)
names(residuals) <- names(tfit$predictors) <- yn
} else {
- dimnames(residuals) <- dimnames(tfit$predictors) <- list(yn, predictors.names)
+ dimnames(residuals) <- dimnames(tfit$predictors) <-
+ list(yn, predictors.names)
}
if(is.matrix(mu)) {
diff --git a/R/vlm.R b/R/vlm.R
index c722d51..0358af1 100644
--- a/R/vlm.R
+++ b/R/vlm.R
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/vlm.wfit.q b/R/vlm.wfit.q
index 4ef0109..d3ff1bd 100644
--- a/R/vlm.wfit.q
+++ b/R/vlm.wfit.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/vsmooth.spline.q b/R/vsmooth.spline.q
index 70cd95a..2a16a3c 100644
--- a/R/vsmooth.spline.q
+++ b/R/vsmooth.spline.q
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/R/zzz.R b/R/zzz.R
index 616e191..d6cf4a6 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -1,5 +1,5 @@
# These functions are
-# Copyright (C) 1998-2006 T.W. Yee, University of Auckland. All rights reserved.
+# Copyright (C) 1998-2007 T.W. Yee, University of Auckland. All rights reserved.
diff --git a/man/Links.Rd b/man/Links.Rd
index f14a6b4..8e1579d 100644
--- a/man/Links.Rd
+++ b/man/Links.Rd
@@ -183,7 +183,7 @@ fit2 = vgam(agaaus ~ altitude, binomialff(link="cloglog"), hunua) # ok
fit3 = vgam(agaaus ~ altitude, binomialff(link="clog"), hunua) # not ok
-# No matter what the link is the estimated var-cov matrix is the same
+# No matter what the link, the estimated var-cov matrix is the same
y = rbeta(n=1000, shape1=exp(0), shape2=exp(1))
fit1 = vglm(y ~ 1, betaff(link="identity"), trace = TRUE, crit="c")
fit2 = vglm(y ~ 1, betaff(link=logoff, earg=list(offset=1.1)),
diff --git a/man/bilogistic4.Rd b/man/bilogistic4.Rd
index a8cbc8a..204d83e 100644
--- a/man/bilogistic4.Rd
+++ b/man/bilogistic4.Rd
@@ -99,7 +99,7 @@ Hoboken, N.J.: Wiley-Interscience.
\author{ T. W. Yee }
\note{
This family function uses the BFGS quasi-Newton update formula for the
- working weight matrices. Consequently the estimated variance-covariance
+ working weight matrices. Consequently the estimated variance-covariance
matrix may be inaccurate or simply wrong! The standard errors must be
therefore treated with caution; these are computed in functions such
as \code{vcov()} and \code{summary()}.
diff --git a/man/gev.Rd b/man/gev.Rd
index e8b65cc..8be85e9 100644
--- a/man/gev.Rd
+++ b/man/gev.Rd
@@ -69,7 +69,8 @@ egev(llocation = "identity", lscale = "loge", lshape = "logoff",
The argument \code{ishape} is more important than the other two because
they are initialized from the initial \eqn{\xi}{xi}.
If a failure to converge occurs, or even to obtain initial values occurs,
- try assigning \code{ishape} some value.
+ try assigning \code{ishape} some value
+ (positive or negative; the sign can be very important).
Also, in general, a larger value of \code{iscale} is better than a
smaller value.
diff --git a/man/gpd.Rd b/man/gpd.Rd
index 51a936a..7d8f047 100644
--- a/man/gpd.Rd
+++ b/man/gpd.Rd
@@ -13,16 +13,13 @@ gpd(threshold = 0, lscale = "loge", lshape = "logoff",
eshape = if(lshape=="logoff") list(offset=0.5) else
if(lshape=="elogit") list(min=-0.5, max=0.5) else NULL,
percentiles = c(90, 95), iscale = NULL, ishape = NULL,
- tshape0=0.001, method.init=1, zero = 2)
+ tshape0=0.001, method.init=1, zero=2)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
\item{threshold}{
- Numeric of length 1. The threshold value.
- Only values of the response which are greater than this value
- are kept. The response actually worked on internally is the difference.
- Only those observations greater than the threshold value are
- returned in the \code{y} slot of the object.
+ Numeric, values are recycled if necessary.
+ The threshold value(s), called \eqn{\mu}{mu} below.
}
\item{lscale}{
@@ -33,11 +30,9 @@ gpd(threshold = 0, lscale = "loge", lshape = "logoff",
\item{lshape}{
Parameter link function for the shape parameter \eqn{\xi}{xi}.
See \code{\link{Links}} for more choices.
- The default constrains the parameter
- to be greater than \eqn{-0.5} (the negative of \code{Offset}).
- This is because if \eqn{\xi \leq -0.5}{xi <= -0.5} then Fisher
+ The default constrains the parameter to be greater than \eqn{-0.5}
+ because if \eqn{\xi \leq -0.5}{xi <= -0.5} then Fisher
scoring does not work.
- However, it can be a little more interpretable if \code{Offset=1}.
See the Details section below for more information.
}
@@ -98,7 +93,7 @@ gpd(threshold = 0, lscale = "loge", lshape = "logoff",
}
\item{method.init}{
Method of initialization, either 1 or 2. The first is the method of
- moments, and the second is a variant of this. If neither work try
+ moments, and the second is a variant of this. If neither work, try
assigning values to arguments \code{ishape} and/or \code{iscale}.
}
@@ -122,7 +117,8 @@ gpd(threshold = 0, lscale = "loge", lshape = "logoff",
\deqn{G(y) = 1 - [1 + \xi (y-\mu) / \sigma ]_{+}^{- 1/ \xi} }{%
G(y) = 1 - [1 + xi (y-mu)/ sigma ]_{+}^{- 1/ xi} }
where
- \eqn{\mu}{mu} is the location parameter (known with value \code{threshold}),
+ \eqn{\mu}{mu} is the location parameter
+ (known, with value \code{threshold}),
\eqn{\sigma > 0}{sigma > 0} is the scale parameter,
\eqn{\xi}{xi} is the shape parameter, and
\eqn{h_+ = \max(h,0)}{h_+ = max(h,0)}.
@@ -139,13 +135,13 @@ gpd(threshold = 0, lscale = "loge", lshape = "logoff",
is known as the nonregular case and problems/difficulties can arise
both theoretically and numerically. For the (regular) case \eqn{\xi >
-0.5}{xi > -0.5} the classical asymptotic theory of maximum likelihood
- estimators is applicable; this is the default because \code{Offset=0.5}.
+ estimators is applicable; this is the default.
Although for \eqn{\xi < -0.5}{xi < -0.5} the usual asymptotic properties
do not apply, the maximum likelihood estimator generally exists and
is superefficient for \eqn{-1 < \xi < -0.5}{-1 < xi < -0.5}, so it is
- ``better'' than normal. To allow for \eqn{-1 < \xi < -0.5}{-1 < xi <
- -0.5} set \code{Offset=1}. When \eqn{\xi < -1}{xi < -1} the maximum
+ ``better'' than normal.
+ When \eqn{\xi < -1}{xi < -1} the maximum
likelihood estimator generally does not exist as it effectively becomes
a two parameter problem.
@@ -155,6 +151,10 @@ gpd(threshold = 0, lscale = "loge", lshape = "logoff",
}
\note{
+ The response in the formula of \code{\link{vglm}}
+ and \code{\link{vgam}} is \eqn{y}.
+ Internally, \eqn{y-\mu}{y-mu} is computed.
+
With functions \code{\link{rgpd}}, \code{\link{dgpd}}, etc., the
argument \code{location} matches with the argument \code{threshold}
here.
@@ -196,31 +196,35 @@ gpd(threshold = 0, lscale = "loge", lshape = "logoff",
\code{\link{rgpd}},
\code{\link{meplot}},
\code{\link{gev}},
- \code{\link{pareto1}}.
+ \code{\link{pareto1}},
+ \code{\link{vglm}},
+ \code{\link{vgam}},
+ \code{\link{s}}.
}
\examples{
# Simulated data from an exponential distribution (xi=0)
-y = rexp(n=3000, rate=2)
-fit = vglm(y ~ 1, gpd(threshold=0.5), trace=TRUE)
+threshold = 0.5
+y = threshold + rexp(n=3000, rate=2)
+fit = vglm(y ~ 1, gpd(threshold=threshold), trace=TRUE)
fitted(fit)[1:5,]
coef(fit, matrix=TRUE) # xi should be close to 0
Coef(fit)
summary(fit)
-yt = y[y>fit at extra$threshold] # Note the threshold is stored here
-all.equal(c(yt), c(fit at y)) # TRUE
+fit at extra$threshold # Note the threshold is stored here
+
# Check the 90 percentile
-i = yt < fitted(fit)[1,"90\%"]
+i = fit at y < fitted(fit)[1,"90\%"]
100*table(i)/sum(table(i)) # Should be 90%
# Check the 95 percentile
-i = yt < fitted(fit)[1,"95\%"]
+i = fit at y < fitted(fit)[1,"95\%"]
100*table(i)/sum(table(i)) # Should be 95%
\dontrun{
-plot(yt, col="blue", las=1, main="Fitted 90\% and 95\% quantiles")
-matlines(1:length(yt), fitted(fit), lty=2:3, lwd=2)
+plot(fit at y, col="blue", las=1, main="Fitted 90\% and 95\% quantiles")
+matlines(1:length(fit at y), fitted(fit), lty=2:3, lwd=2)
}
@@ -229,8 +233,18 @@ nn = 2000; threshold = 0; x = runif(nn)
xi = exp(-0.8)-0.5
y = rgpd(nn, scale=exp(1+0.2*x), shape=xi)
fit = vglm(y ~ x, gpd(threshold), trace=TRUE)
-Coef(fit)
coef(fit, matrix=TRUE)
+
+
+\dontrun{
+# Nonparametric fits
+yy = y + rnorm(nn, sd=0.1)
+fit1 = vgam(yy ~ s(x), gpd(threshold), trace=TRUE) # Not so recommended
+par(mfrow=c(2,1))
+plot(fit1, se=TRUE, scol="blue")
+fit2 = vglm(yy ~ bs(x), gpd(threshold), trace=TRUE) # More recommended
+plotvgam(fit2, se=TRUE, scol="blue")
+}
}
\keyword{models}
\keyword{regression}
diff --git a/man/logistic.Rd b/man/logistic.Rd
index 68e9806..e47c826 100644
--- a/man/logistic.Rd
+++ b/man/logistic.Rd
@@ -104,6 +104,11 @@ Castillo, E., Hadi, A. S., Balakrishnan, N. Sarabia, J. S. (2005)
Engineering and Science},
Hoboken, N.J.: Wiley-Interscience, p.130.
+deCani, J. S. and Stine, R. A. (1986)
+A note on Deriving the Information Matrix for a Logistic Distribution,
+\emph{The American Statistician},
+\bold{40}, 220--222.
+
}
\author{ T. W. Yee }
\note{
diff --git a/man/undocumented-methods.Rd b/man/undocumented-methods.Rd
index 362a9fb..80fea7d 100644
--- a/man/undocumented-methods.Rd
+++ b/man/undocumented-methods.Rd
@@ -123,6 +123,7 @@
\alias{print,Coef.uqo-method}
\alias{print,summary.uqo-method}
\alias{print,vsmooth.spline-method}
+\alias{print,cao-method}
\alias{qtplot,vglm-method}
\alias{qtplot,vgam-method}
\alias{residuals,qrrvglm-method}
@@ -155,6 +156,7 @@
\alias{show,Coef.uqo-method}
\alias{show,summary.uqo-method}
\alias{show,vsmooth.spline-method}
+\alias{show,cao-method}
\alias{summary,grc-method}
\alias{summary,cao-method}
\alias{summary,qrrvglm-method}
diff --git a/man/uqo.Rd b/man/uqo.Rd
index f624b1c..4dcc811 100644
--- a/man/uqo.Rd
+++ b/man/uqo.Rd
@@ -218,6 +218,7 @@ this is not done.
\code{\link{hspider}}.
}
\examples{
+\dontrun{
data(hspider)
set.seed(123) # This leads to the global solution
hspider[,1:6] = scale(hspider[,1:6]) # Standardized environmental vars
@@ -235,10 +236,9 @@ up1 = uqo(cbind(Alopacce, Alopcune, Alopfabr, Arctlute, Arctperi,
Trocterr, Zoraspin) ~ 1,
family = poissonff, data = hspider,
ITolerances = TRUE,
- Crow1positive = TRUE, lvstart = lv(p1))
+ Crow1positive = TRUE, lvstart = -lv(p1))
if(deviance(up1) > 1310.0) stop("suboptimal fit obtained")
-\dontrun{
nos = ncol(up1 at y) # Number of species
clr = (1:(nos+1))[-7] # to omit yellow
lvplot(up1, las=1, y=TRUE, pch=1:nos, scol=clr, lcol=clr,
diff --git a/man/vglm.control.Rd b/man/vglm.control.Rd
index f4b84a1..c864ca4 100644
--- a/man/vglm.control.Rd
+++ b/man/vglm.control.Rd
@@ -5,6 +5,7 @@
\description{
Algorithmic constants and parameters for running \code{vglm} are set
using this function.
+
}
\usage{
vglm.control(backchat = if (is.R()) FALSE else TRUE,
@@ -16,96 +17,119 @@ vglm.control(backchat = if (is.R()) FALSE else TRUE,
}
%- maybe also `usage' for other objects documented here.
\arguments{
- \item{backchat}{ logical indicating if a backchat is to be used (not
- applicable in \R). }
- \item{checkwz}{ logical indicating whether the diagonal elements of
- the working weight matrices should be checked whether they are
- sufficiently positive, i.e., greater than \code{wzepsilon}. If not,
- any values less than \code{wzepsilon} are replaced with this value.
+ \item{backchat}{
+ logical indicating if a backchat is to be used
+ (not applicable in \R).
+
+ }
+ \item{checkwz}{
+ logical indicating whether the diagonal elements of
+ the working weight matrices should be checked whether they are
+ sufficiently positive, i.e., greater than \code{wzepsilon}. If not,
+ any values less than \code{wzepsilon} are replaced with this value.
+
+ }
+ \item{criterion}{
+ character variable describing what criterion is to
+ be used to test for convergence.
+ The possibilities are listed in \code{.min.criterion.VGAM}, but
+ most family functions only implement a few of these.
+
+ }
+ \item{epsilon}{
+ positive convergence tolerance epsilon. Roughly
+ speaking, the Newton-Raphson/Fisher-scoring iterations
+ are assumed to have
+ converged when two successive \code{criterion} values are within
+ \code{epsilon} of each other.
}
- \item{criterion}{ character variable describing what criterion is to
- be used to test for convergence.
- The possibilities are listed in \code{.min.criterion.VGAM}, but
- most family functions only implement a few of these.
+ \item{half.stepsizing}{
+ logical indicating if half-stepsizing is
+ allowed. For example, in maximizing a log-likelihood, if the
+ next iteration has a log-likelihood that is less than the current
+ value of the log-likelihood, then a half step will be taken.
+ If the log-likelihood is still less than at the current position,
+ a quarter-step will be taken etc. Eventually a step will be taken
+ so that an improvement is made to the convergence criterion.
+ \code{half.stepsizing} is ignored if
+ \code{criterion=="coefficients"}.
+
+ }
+ \item{maxit}{
+ maximum number of Newton-Raphson/Fisher-scoring iterations allowed.
+
}
- \item{epsilon}{ positive convergence tolerance epsilon. Roughly
- speaking, the Newton-Raphson/Fisher-scoring iterations
- are assumed to have
- converged when two successive \code{criterion} values are within
- \code{epsilon} of each other.
- }
- \item{half.stepsizing}{ logical indicating if half-stepsizing is
- allowed. For example, in maximizing a log-likelihood, if the
- next iteration has a log-likelihood that is less than the current
- value of the log-likelihood, then a half step will be taken.
- If the log-likelihood is still less than at the current position,
- a quarter-step will be taken etc. Eventually a step will be taken
- so that an improvement is made to the convergence criterion.
- \code{half.stepsizing} is ignored if
- \code{criterion=="coefficients"}.
- }
- \item{maxit}{ maximum number of
- Newton-Raphson/Fisher-scoring iterations allowed. }
- \item{stepsize}{ usual step size to be taken between each
- Newton-Raphson/Fisher-scoring iteration. It should be a value
- between 0 and 1, where
- a value of unity corresponds to an ordinary step.
- A value of 0.5 means half-steps are taken.
- Setting a value near zero will cause convergence
- to be generally slow but may help increase the chances of
- successful convergence for some family functions.
- }
- \item{save.weight}{ logical indicating whether the \code{weights} slot
+ \item{stepsize}{
+ usual step size to be taken between each
+ Newton-Raphson/Fisher-scoring iteration. It should be a value
+ between 0 and 1, where
+ a value of unity corresponds to an ordinary step.
+ A value of 0.5 means half-steps are taken.
+ Setting a value near zero will cause convergence to be generally slow
+ but may help increase the chances of successful convergence for some
+ family functions.
+
+ }
+ \item{save.weight}{
+ logical indicating whether the \code{weights} slot
of a \code{"vglm"} object will be saved on the object. If not, it will
be reconstructed when needed, e.g., \code{summary}.
Some family functions have \code{save.weight=TRUE} and others have
\code{save.weight=FALSE} in their control functions.
-}
- \item{trace}{ logical indicating if output should be produced for
- each iteration. }
+
+ }
+ \item{trace}{
+ logical indicating if output should be produced for each iteration.
+
+ }
\item{wzepsilon}{
Small positive number used to test whether the diagonals of the working
weight matrices are sufficiently positive.
}
\item{xij}{
- formula giving terms making up a covariate-dependent term (a variable
- that takes on different values for each linear/additive predictor.
- For example, the ocular pressure of each eye).
- There should be \eqn{M} unique terms; use
- \code{\link{fill1}}, \code{fill2}, \code{fill3}, etc. if necessary.
- Each formula should have a response which is taken as the name of
- that variable, and the terms are enumerated in sequential order.
- With more than one formula, use a list of formulas.
- See Example 2 below.
+ formula giving terms making up a covariate-dependent term (a variable
+ that takes on different values for each linear/additive predictor.
+ For example, the ocular pressure of each eye).
+ There should be \eqn{M} unique terms; use
+ \code{\link{fill1}}, \code{fill2}, \code{fill3}, etc. if necessary.
+ Each formula should have a response which is taken as the name of
+ that variable, and the terms are enumerated in sequential order.
+ With more than one formula, use a list of formulas.
+ See Example 2 below.
-}
- \item{\dots}{ other parameters that may be picked up from control
- functions that are specific to the \pkg{VGAM} family function. }
+ }
+ \item{\dots}{
+ other parameters that may be picked up from control
+ functions that are specific to the \pkg{VGAM} family function.
+
+ }
}
\details{
- Most of the control parameters are used within \code{vglm.fit} and you
- will have to look at that to understand the full details.
-
- Setting \code{save.weight=FALSE} is useful for some models because the
- \code{weights} slot of the object is the largest and so less memory
- is used to store the object. However, for some \pkg{VGAM} family function,
- it is necessary to set \code{save.weight=TRUE} because the \code{weights}
- slot cannot be reconstructed later.
+ Most of the control parameters are used within \code{vglm.fit} and
+ you will have to look at that to understand the full details.
+
+ Setting \code{save.weight=FALSE} is useful for some models because
+ the \code{weights} slot of the object is the largest and so less
+ memory is used to store the object. However, for some \pkg{VGAM}
+ family function, it is necessary to set \code{save.weight=TRUE}
+ because the \code{weights} slot cannot be reconstructed later.
+
}
\value{
A list with components matching the input names. A little error
checking is done, but not much.
The list is assigned to the \code{control} slot of \code{vglm} objects.
- }
- \references{
+
+}
+\references{
Yee, T. W. and Hastie, T. J. (2003)
Reduced-rank vector generalized linear models.
\emph{Statistical Modelling},
\bold{3}, 15--41.
- }
+}
\author{ Thomas W. Yee}
\note{
In Example 2 below there are two covariates that have linear/additive
diff --git a/man/weibull.Rd b/man/weibull.Rd
index b97e1d1..d3cbc1f 100644
--- a/man/weibull.Rd
+++ b/man/weibull.Rd
@@ -58,6 +58,7 @@ weibull(lshape = "logoff", lscale = "loge",
The density is unbounded for \eqn{a<1}.
The \eqn{k}th moment about the origin is
\eqn{E(Y^k) = b^k \, \Gamma(1+ k/a)}{E(Y^k) = b^k * gamma(1+ k/a)}.
+ The hazard function is \eqn{a t^{a-1} / b^a}{a * t^(a-1) / b^a}.
This \pkg{VGAM} family function handles Type-I right censored data as
well as complete data.
diff --git a/man/zapoisson.Rd b/man/zapoisson.Rd
index 23010b5..decdb4c 100644
--- a/man/zapoisson.Rd
+++ b/man/zapoisson.Rd
@@ -6,10 +6,12 @@
Fits a zero-altered Poisson distribution based on a conditional
model involving a binomial distribution
and a positive-Poisson distribution.
+
}
\usage{
zapoisson(lp0 = "logit", llambda = "loge",
- ep0=list(), elambda=list())
+ ep0=list(), elambda=list(),
+ zero=NULL)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
@@ -28,6 +30,20 @@ zapoisson(lp0 = "logit", llambda = "loge",
See \code{earg} in \code{\link{Links}} for general information.
}
+ \item{zero}{
+ Integer valued vector, usually assigned \eqn{-1} or \eqn{1} if used
+ at all. Specifies which of the two linear/additive predictors are
+ modelled as an intercept only.
+ By default, both linear/additive predictors are modelled using
+ the explanatory variables.
+ If \code{zero=1} then the \eqn{p_0}{p0} parameter
+ (after \code{lp0} is applied) is modelled as a single unknown
+ number that is estimated. It is modelled as a function of the
+ explanatory variables by \code{zero=NULL}. A negative value
+ means that the value is recycled, so setting \eqn{-1} means all \eqn{p_0}{p0}
+ are intercept-only (for multivariate responses).
+
+ }
}
\details{
The response \eqn{Y} is zero with probability \eqn{p_0}{p0}, or \eqn{Y}
@@ -81,12 +97,13 @@ Inference obtained from \code{summary.vglm} and
In particular, the p-values, standard errors and degrees of freedom
may need adjustment. Use simulation on artificial data to check
that these are reasonable.
+
}
\author{ T. W. Yee }
\note{
There are subtle differences between this family function and
- \code{\link{yip88}} and \code{\link{zipoisson}}.
+ \code{\link{zipoisson}} and \code{\link{yip88}}.
In particular, \code{\link{zipoisson}} is a
\emph{mixture} model whereas \code{zapoisson} and \code{\link{yip88}}
are \emph{conditional} models.
@@ -101,6 +118,7 @@ that these are reasonable.
This family function can handle a multivariate response, e.g.,
more than one species.
+
}
\seealso{
diff --git a/man/zibinomial.Rd b/man/zibinomial.Rd
index f69ac4b..e48f7d9 100644
--- a/man/zibinomial.Rd
+++ b/man/zibinomial.Rd
@@ -113,14 +113,14 @@ zibinomial(lphi="logit", link.mu="logit",
\examples{
size = 10 # number of trials; N in the notation above
n = 200
-phi = 0.50
-mubin = 0.3 # Mean of an ordinary binomial distribution
+phi = logit(0,inv=TRUE) # 0.50
+mubin = logit(-1,inv=TRUE) # Mean of an ordinary binomial distribution
sv = rep(size, len=n)
y = rzibinom(n=n, size=sv, prob=mubin, phi=phi) / sv # A proportion
table(y)
fit = vglm(y ~ 1, zibinomial, weight=sv, trace=TRUE)
coef(fit, matrix=TRUE)
-Coef(fit)
+Coef(fit) # Useful for intercept-only models
fit at misc$p0 # Estimate of P(Y=0)
fitted(fit)[1:4,]
mean(y) # Compare this with fitted(fit)
diff --git a/man/zipoisson.Rd b/man/zipoisson.Rd
index d99894d..7df1974 100644
--- a/man/zipoisson.Rd
+++ b/man/zipoisson.Rd
@@ -103,8 +103,7 @@ zipoisson(lphi="logit", llambda = "loge",
\code{\link[stats:Poisson]{rpois}}.
}
\examples{
-n = 5000
-x = runif(n)
+x = runif(n <- 2000)
phi = logit(-0.5 + 1*x, inverse=TRUE)
lambda = loge(0.5 + 2*x, inverse=TRUE)
y = rzipois(n, lambda, phi)
diff --git a/src/vlinpack3.f b/src/vlinpack3.f
index 77ce929..fd03704 100644
--- a/src/vlinpack3.f
+++ b/src/vlinpack3.f
@@ -123,8 +123,8 @@ c
double precision function ddot8(n,dx,incx,dy,incy)
c
c 12/7/02; T.Yee
-c I've modifed "real function ddot" to "double precision function ddot8" for
-c the VGAM package
+c I've modifed "real function ddot" to
+c "double precision function ddot8" for the VGAM package
c I've added the "implicit logical (a-z)" line
implicit logical (a-z)
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/r-cran-vgam.git
More information about the debian-science-commits
mailing list