[med-svn] [r-cran-bbmle] 02/06: New upstream version 1.0.20
Andreas Tille
tille at debian.org
Thu Nov 9 12:24:07 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-bbmle.
commit ec581869aa1f1b5b16d50fb2279b7cbb4504e252
Author: Andreas Tille <tille at debian.org>
Date: Thu Nov 9 13:18:24 2017 +0100
New upstream version 1.0.20
---
DESCRIPTION | 6 +-
MD5 | 37 +-
NAMESPACE | 2 +-
R/IC.R | 38 +-
R/confint.R | 4 +
R/mle.R | 2 +-
R/mle2-class.R | 34 +-
R/profile.R | 39 +-
inst/NEWS.Rd | 15 +
inst/doc/mle2.pdf | Bin 249791 -> 249513 bytes
inst/doc/quasi.pdf | Bin 130748 -> 130968 bytes
tests/ICtab.R | 12 +
tests/ICtab.Rout.save | 20 +-
tests/gradient_vecpar_profile.R | 32 +-
tests/gradient_vecpar_profile.Rout.save | 48 +-
tests/optimx.R | 3 +-
tests/optimx.Rout.save | 51 +-
tests/richards.R | 8 +-
tests/richards.Rout.save | 18 +-
vignettes/chicago.bst | 1654 +++++++++++++++++++++++++++++++
20 files changed, 1907 insertions(+), 116 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index ed3b4eb..353987d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: bbmle
Title: Tools for General Maximum Likelihood Estimation
-Version: 1.0.19
+Version: 1.0.20
Author: Ben Bolker <bolker at mcmaster.ca>, R Development Core Team
Maintainer: Ben Bolker <bolker at mcmaster.ca>
Depends: R (>= 3.0.0), stats4
@@ -15,6 +15,6 @@ License: GPL
Collate: 'mle2-class.R' 'mle2-methods.R' 'mle.R' 'confint.R'
'predict.R' 'profile.R' 'update.R' 'dists.R' 'IC.R' 'slice.R'
NeedsCompilation: no
-Packaged: 2017-04-18 01:11:10 UTC; bolker
+Packaged: 2017-10-30 02:06:08 UTC; bolker
Repository: CRAN
-Date/Publication: 2017-04-18 13:04:25 UTC
+Date/Publication: 2017-10-30 08:49:56 UTC
diff --git a/MD5 b/MD5
index d8bb5e4..9a9cdcb 100644
--- a/MD5
+++ b/MD5
@@ -1,24 +1,24 @@
-88b59c83d28e7e844851b8c2d87d4b95 *DESCRIPTION
-c34f63daf88f9e7118cd29176270a1bb *NAMESPACE
-6df6a983c57b15df0e0132129a336fd1 *R/IC.R
-2625b509110e94cceed414dc1ca9101d *R/confint.R
+10e29e61789a78ccec5eb81fa4fdbf58 *DESCRIPTION
+8b6151fa79b199d3cf6cf2cd8daebdb9 *NAMESPACE
+ca91d50be05ea7ae0f8746da984b479d *R/IC.R
+3547798b5af91c95a35a011f2a3bffa4 *R/confint.R
0a63c5da03a0e73ae29f6c1c4f2fd5cd *R/dists.R
-56ddd6f4b62df8ca7a1b58ad4775aa49 *R/mle.R
-e695b7c949576d0927c0c2bf5a8e203c *R/mle2-class.R
+d2a74ebe19b627495add8e84588e4fd7 *R/mle.R
+c4261cd6324f185a4c20caadde9d38ff *R/mle2-class.R
2a2bfa30b9feb9251dabf7d17f1d1246 *R/mle2-methods.R
2d3da6aaa0a07bd64c320a718d87d31e *R/predict.R
-fcd9d1e3cbb09f66135890a2d3b2bc38 *R/profile.R
+b9399f7cb30d4f70b15da352401d8512 *R/profile.R
2c39b590a0c236bff22bb00252544082 *R/slice.R
28b4b4a714c1beebcc7516b888e1b641 *R/update.R
3d7347481a3e76bb6d57990dd789c3a4 *TODO
492f2ea4bf11ccc85e60de3f41c5bf70 *build/vignette.rds
-d66acccbe4e9bb072d14896195791e29 *inst/NEWS.Rd
+eac5a49a30af442acb03e2bbb5797be5 *inst/NEWS.Rd
b5555aa6d41773a0e4df0590aecc7e14 *inst/doc/mle2.R
e8c369ae9771830ce616d69a1983031b *inst/doc/mle2.Rnw
-966cf0ffc322ff4d63fdfd146ff62933 *inst/doc/mle2.pdf
+a2d83210738176006acd7ad22fae27fe *inst/doc/mle2.pdf
e4073ae8723f00fe0f3b728db2b31a16 *inst/doc/quasi.R
d4a4dc5fd5bd327c231ca1715eb74986 *inst/doc/quasi.Rnw
-e7d03ee71c8bb1f48080fab56da47ac5 *inst/doc/quasi.pdf
+17b2cf46940eb7b7e970759c9ee68d99 *inst/doc/quasi.pdf
a399ce19c47219ea3474978d2f4ecac6 *inst/vignetteData/orob1.rda
fad7f0284df8a44372565c480f8e4dfb *man/BIC-methods.Rd
7a309d55019db340dc2b1fa5e662ab32 *man/ICtab.Rd
@@ -41,8 +41,8 @@ bc2aec35cda556cb0977380afebd4ca9 *man/strwrapx.Rd
1c94867c2e5c5b7239f62290d254da0a *man/summary.mle-class.Rd
677bab474659dbf8e1f16061a32e5f03 *tests/BIC.R
c5f6c880e3fc121e0d6f16193014469c *tests/BIC.Rout.save
-741c879f7b2fa896eb8614d80823bcd5 *tests/ICtab.R
-f8ec8fb8c28cc2029e1c4d3323bd8915 *tests/ICtab.Rout.save
+6ffe0fc4a25d98aa63c54a31029cb391 *tests/ICtab.R
+dcbd7e7eaa44bdc322c970842e1cf719 *tests/ICtab.Rout.save
7e791632cd72a0dab72b6b1059b85273 *tests/RUnit-tests.R
202d16aa2bf77be5df020bda2240703e *tests/binomtest1.R
138465684c603e66d87035baabc03f65 *tests/binomtest1.Rout
@@ -56,8 +56,8 @@ bf9cb0badb64c11e22d1b7d15c060a73 *tests/boundstest.R
6dbd75bdf12de303e957d0ae2d643e04 *tests/formulatest.Rout.save
aa886a9c7ab1b518abd247d7d20e1ef6 *tests/glmcomp.R
631d9de06283af92a3d567576f994553 *tests/glmcomp.Rout.save
-c5eaa3b836964c3c3a3588b13730e098 *tests/gradient_vecpar_profile.R
-332514b495edf939128e0b68c79b59c8 *tests/gradient_vecpar_profile.Rout.save
+c615bec0425bbea67b0b6137b50f14ce *tests/gradient_vecpar_profile.R
+d6a22c3b6f02a01e299385a02c850640 *tests/gradient_vecpar_profile.Rout.save
8e586c21bd27eb96bd0d381d64a216d0 *tests/grtest1.R
4ed1220040a3742acb260754e1656f33 *tests/grtest1.Rout.save
763a796aaa2bfa27693b4a8cb57783e2 *tests/makesavefiles
@@ -70,8 +70,8 @@ bd137b0505a83b54357345cdceb59dcb *tests/methods.Rout.save
103b501ae4106a7da4917889d8019f38 *tests/optimize.Rout.save
5e63a0d8e88b78f5bf84228b62f051fc *tests/optimizers.R
b0cb07cae3015f7e56eef6708a47236e *tests/optimizers.Rout.save
-6c7b4ba28cecd89bb7f829573a2aeec8 *tests/optimx.R
-194b7c7d97d6f090cc2c58a6bb360297 *tests/optimx.Rout.save
+c3db147eadab1109b202e783008c8726 *tests/optimx.R
+89ec92c72b5ccb6122b8ee496c31cc99 *tests/optimx.Rout.save
05f0d13ee00153918cf5d7bbe5acb61c *tests/order.R
4bd3539efe7bdd3e2a6fc045f653b1a4 *tests/order.Rout.save
21cf9832b13ec31b5e67e6763f80d5da *tests/parscale.R
@@ -83,8 +83,8 @@ a714b957cfd9a8f6148160ae18c56472 *tests/prof_newmin.R
0b52fc583dc02c9c422cb878ba3d6128 *tests/prof_spec.R
68edb941f246a47564617d7aea9647bd *tests/profbound.R
ee5f86f38e1dfc8a69958e5d5b07df08 *tests/profbound.Rout.save
-3c624de2efa1f848c87d71e5e7cb5641 *tests/richards.R
-f25a35605243aa846d871f43ad5159af *tests/richards.Rout.save
+b0f4716aa737b972c5cac4bbf1b6830a *tests/richards.R
+f04921cd98c8a8b476365d92dc5292ed *tests/richards.Rout.save
c703480c59bde85cdd3c51bd59d83975 *tests/startvals.R
876a9cad0e580eda029eeb6e7d5168dd *tests/startvals.Rout.save
71d7ebe63a25d910873f75c0a7dfa3a0 *tests/startvals2.R
@@ -105,6 +105,7 @@ dd885bf956855f37df24d0dbe37ba7bd *tests/tmptest.Rout.save
2d49b0803524b896e48d6879d18f8190 *tests/update.R
53661890c555a4f7e5c21accbe775fed *tests/update.Rout.save
0a27805bbe6b6d67ef37f760dc991917 *vignettes/cc-attrib-nc.png
+cd2df3f6f14e5d0af434d1aa53b7a0ed *vignettes/chicago.bst
e8c369ae9771830ce616d69a1983031b *vignettes/mle2.Rnw
ae21998f0dafa40e30841d4abc02ceed *vignettes/mle2.bib
d4a4dc5fd5bd327c231ca1715eb74986 *vignettes/quasi.Rnw
diff --git a/NAMESPACE b/NAMESPACE
index 49586c0..9579bcd 100755
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -4,7 +4,7 @@ export(ICtab,AICtab,BICtab,AICctab)
export(stdEr,vcov)
export(slice,sliceOld,slice1D,slice2D)
export(proffun)
-exportClasses(mle2)
+exportClasses(mle2,summary.mle2)
exportMethods(AIC, AICc, qAICc, qAIC,
profile, coef, confint, logLik,
update, vcov, anova, deviance, residuals,
diff --git a/R/IC.R b/R/IC.R
index 3f1cfd0..fe8205c 100755
--- a/R/IC.R
+++ b/R/IC.R
@@ -108,36 +108,49 @@ setMethod("AICc", "mle2",
function (object, ..., nobs, k) {
L <- list(...)
if (length(L)) {
- L <- c(list(object),L)
+ L = c(list(object), L)
+ # First, we attempt to use the "nobs" attribute
if (is.null(nobs)) {
- nobs <- sapply(L,nobs)
+ nobs <- unlist(lapply(L, attr,"nobs"))
+ }
+ # If that is still null, maybe there's a "nobs" method?
+ if (is.null(nobs)) {
+ nobs <- unlist(lapply(L,nobs))
}
if (length(unique(nobs))>1)
stop("nobs different: must have identical data for all objects")
- logLiks <- sapply(L, logLik)
- df <- sapply(L,attr,"df")
- val <- -2*logLiks+k*df*(df+1)/(nobs-df-1)
+ logLiks <- lapply(L, logLik)
+ df <- sapply(logLiks,attr,"df")
+ val <- -2*unlist(logLiks)+k*df+k*df*(df+1)/(nobs-df-1)
data.frame(AICc=val,df=df)
} else {
- df <- attr(object,"df")
- c(-2*logLik(object)+k*df+k*df*(df+1)/(nobs-df-1))
+ if (is.null(nobs)) {
+ nobs <- attr(object,"nobs")
+ }
+ if (is.null(nobs)) {
+ nobs <- nobs(object)
+ }
+ AICc(object=logLik(object), nobs=nobs, k=k)
}
})
setMethod("AICc", signature(object="logLik"),
- function(object, ..., nobs=NULL, k){
+ function(object, ..., nobs, k){
+ # Handles the "nobs" argument
if (missing(nobs)) {
if (is.null(attr(object,"nobs")))
stop("number of observations not specified")
nobs <- attr(object,"nobs")
}
+ if (length(list(...))>1)
+ warning("additional parameters ignored")
+
df <- attr(object,"df")
- ## FIXME: should second "2" also be k?
- -2 * c(object) + k*df+2*df*(df+1)/(nobs-df-1)
+ -2*c(object)+k*df+k*df*(df+1)/(nobs-df-1)
})
setMethod("AICc", signature(object="ANY"),
- function(object, ..., nobs=NULL, k){
+ function(object, ..., nobs, k){
AICc(object=logLik(object, ...), nobs=nobs, k=k)
})
@@ -146,10 +159,9 @@ setMethod("AIC", "mle2",
L <- list(...)
if (length(L)) {
L <- c(list(object),L)
- if (!all(sapply(L,class)=="mle2")) stop("all objects in list must be class mle2")
logLiks <- lapply(L, logLik)
AICs <- sapply(logLiks,AIC,k=k)
- df <- sapply(L,attr,"df")
+ df <- sapply(logLiks,attr,"df")
data.frame(AIC=AICs,df=df)
} else AIC(logLik(object), k = k)
})
diff --git a/R/confint.R b/R/confint.R
index 2966c66..a8bd93d 100755
--- a/R/confint.R
+++ b/R/confint.R
@@ -33,6 +33,10 @@ function (object, parm, level = 0.95, trace=FALSE, ...)
if (inherits(tt,"try-error")) tt <- rep(NA,2)
}
}
+ if (!any(is.na(tt))) {
+ ## if NAs present, sort() will drop NAs ...
+ tt <- sort(tt)
+ }
ci[Pnames[pm], ] <- tt
}
drop(ci)
diff --git a/R/mle.R b/R/mle.R
index 5803638..cecc072 100755
--- a/R/mle.R
+++ b/R/mle.R
@@ -357,7 +357,7 @@ mle2 <- function(minuslogl,
stop("name/length mismatch in gradient function")
names(v) <- vnames
}
- v[!names(v) %in% nfix] ## from Eric Weese
+ return(v[!names(v) %in% nfix]) ## from Eric Weese
} ## end of gradient function
## FIXME: try to do this by assignment into appropriate
## environments rather than replacing them ...
diff --git a/R/mle2-class.R b/R/mle2-class.R
index 266cfad..334012d 100755
--- a/R/mle2-class.R
+++ b/R/mle2-class.R
@@ -1,16 +1,16 @@
## must go before setAs to avoid warnings
-setClass("mle2", representation(call = "language",
- call.orig = "language",
- coef = "numeric",
- fullcoef = "numeric",
- vcov = "matrix",
- min = "numeric",
- details = "list",
- minuslogl = "function",
- method = "character",
- data="list",
- formula="character",
- optimizer="character"))
+setClass("mle2", slots=c(call = "language",
+ call.orig = "language",
+ coef = "numeric",
+ fullcoef = "numeric",
+ vcov = "matrix",
+ min = "numeric",
+ details = "list",
+ minuslogl = "function",
+ method = "character",
+ data="list",
+ formula="character",
+ optimizer="character"))
setAs("mle","mle2", function(from,to) {
new("mle2",
@@ -29,16 +29,16 @@ setAs("mle","mle2", function(from,to) {
})
-setClass("summary.mle2", representation(call = "language",
+setClass("summary.mle2", slots=c(call = "language",
coef = "matrix",
m2logL = "numeric"))
-setClass("profile.mle2", representation(profile="list",
- summary="summary.mle2"))
+setClass("profile.mle2", slots=c(profile="list",
+ summary="summary.mle2"))
-setClass("slice.mle2", representation(profile="list",
- summary="summary.mle2"))
+setClass("slice.mle2", slots=c(profile="list",
+ summary="summary.mle2"))
setIs("profile.mle2", "slice.mle2")
diff --git a/R/profile.R b/R/profile.R
index 0f4343f..9bc68a1 100755
--- a/R/profile.R
+++ b/R/profile.R
@@ -9,10 +9,12 @@
proffun <- function (fitted, which = 1:p, maxsteps = 100,
alpha = 0.01, zmax = sqrt(qchisq(1 - alpha/2, p)),
del = zmax/5, trace = FALSE, skiperrs=TRUE,
- std.err, tol.newmin = 0.001, debug=FALSE,
- prof.lower, prof.upper, skip.hessian=TRUE,
- continuation = c("none","naive","linear"),
- try_harder=FALSE, ...) {
+ std.err,
+ tol.newmin = 0.001,
+ debug=FALSE,
+ prof.lower, prof.upper, skip.hessian=TRUE,
+ continuation = c("none","naive","linear"),
+ try_harder=FALSE, ...) {
## fitted: mle2 object
## which: which parameters to profile (numeric or char)
## maxsteps: steps to take looking for zmax
@@ -58,15 +60,16 @@ proffun <- function (fitted, which = 1:p, maxsteps = 100,
}
## now try to fit ...
if (skiperrs) {
- pfit <<- try(eval.parent(call, 2L), silent=TRUE)
- pfit <<- try(eval(call, environment(fitted)), silent=TRUE)
+ pfit0 <- try(eval(call, environment(fitted)), silent=TRUE)
} else {
- pfit <<- eval(call, environment(fitted))
+ pfit0 <- eval(call, environment(fitted))
}
- ok <- ! inherits(pfit,"try-error")
+ ok <- !inherits(pfit0,"try-error")
+ ## don't overwrite pfit in environment until we know it's OK ...
+ if (ok) pfit <<- pfit0
if (debug && ok) cat(coef(pfit),-logLik(pfit),"\n")
if(skiperrs && !ok) {
- warning(paste("Error encountered in profile:",pfit))
+ warning(paste("Error encountered in profile:",pfit0))
return(NA)
}
else {
@@ -86,6 +89,7 @@ proffun <- function (fitted, which = 1:p, maxsteps = 100,
## HACK for non-monotonic profiles? z <- -sgn*sqrt(abs(zz))
} else {
## cat() instead of warning(); FIXME use message() instead???
+ ## FIXME: why??? shouldn't this be a warning?
message("Profiling has found a better solution,",
"so original fit had not converged:\n")
message(sprintf("(new deviance=%1.4g, old deviance=%1.4g, diff=%1.4g)",
@@ -95,7 +99,7 @@ proffun <- function (fitted, which = 1:p, maxsteps = 100,
## to top level
newpars_found <<- TRUE
## return(pfit at fullcoef)
- return(pfit) ## return full fit
+ if (!try_harder) return(pfit) ## bail out, return full fit
}
} else {
z <- sgn * sqrt(zz)
@@ -206,6 +210,7 @@ proffun <- function (fitted, which = 1:p, maxsteps = 100,
break
}
z <- onestep(step)
+ if (newpars_found && !try_harder) return(pfit)
## stop on flat spot, unless try_harder
if (step>1 && (identical(oldcurval,curval) || identical(oldz,z))) {
stop_flat <- TRUE
@@ -215,14 +220,12 @@ proffun <- function (fitted, which = 1:p, maxsteps = 100,
}
oldcurval <- curval
oldz <- z
- if (newpars_found) return(z)
if(is.na(z)) {
stop_na <- TRUE
stop_msg[[i]][[dir_ind]] <- paste(stop_msg[[i]][[dir_ind]],wfun("hit NA"),sep=";")
if (!try_harder) break
}
lastz <- z
- if (newpars_found) return(z)
}
stop_cutoff <- (!is.na(z) && abs(z)>=zmax)
stop_maxstep <- (step==maxsteps)
@@ -244,17 +247,18 @@ proffun <- function (fitted, which = 1:p, maxsteps = 100,
if ((sgn==-1 & curval<lbound) ||
(sgn==1 && curval>ubound)) break
z <- onestep(step - 1 + dstep)
- if (newpars_found) return(z)
+ if (newpars_found && !try_harder) return(pfit)
if(is.na(z) || abs(z) > zmax) break
lastz <- z
- if (newpars_found) return(z)
+ if (newpars_found && !try_harder) return(pfit)
}
if (!stop_cutoff && stop_bound) {
if (debug) cat(wfun("bounded and didn't make it, try at boundary"),"\n")
## bounded and didn't make it, try at boundary
if (sgn==-1 && B0[i]>lbound) z <- onestep(bi=lbound)
+ if (newpars_found && !try_harder) return(pfit)
if (sgn==1 && B0[i]<ubound) z <- onestep(bi=ubound)
- if (newpars_found) return(z)
+ if (newpars_found && !try_harder) return(pfit)
}
} else if (length(zi) < 5) { # try smaller steps
if (debug) cat(wfun("try smaller steps"),"\n")
@@ -263,6 +267,7 @@ proffun <- function (fitted, which = 1:p, maxsteps = 100,
step <- 0.5
while ((step <- step + 1) < mxstep) {
z <- onestep(step)
+ if (newpars_found && !try_harder) return(pfit)
}
} ## smaller steps
} ## !zero stepsize
@@ -271,8 +276,10 @@ proffun <- function (fitted, which = 1:p, maxsteps = 100,
prof[[p.i]] <- data.frame(z = zi[si])
prof[[p.i]]$par.vals <- pvi[si,, drop=FALSE]
} ## for i in which
+ if (newpars_found) return(pfit)
return(list(prof=prof,summ=summ,stop_msg=stop_msg))
}
+
setMethod("profile", "mle2",
function(fitted,...) {
## cc <- match.call()
@@ -377,7 +384,7 @@ setMethod("plot", signature(x="profile.mle2", y="missing"),
}
}
## </FIXME>
- if (no.xlim) xlim <- predback(c(-mlev, mlev))
+ if (no.xlim) xlim <- sort(predback(c(-mlev, mlev)))
xvals <- obj[[i]]$par.vals[,nm[i]]
if (is.na(xlim[1]))
xlim[1] <- min(xvals)
diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd
index 6bc1278..01f04e1 100755
--- a/inst/NEWS.Rd
+++ b/inst/NEWS.Rd
@@ -4,6 +4,21 @@
\title{bbmle News}
\encoding{UTF-8}
+\section{Changes in version 1.0.20 (2017-10-30)}{
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item fixed buglet: flipped profile plot axes, confint for negative values
+ }
+ }
+ \subsection{USER-VISIBLE CHANGES}{
+ \itemize{
+ \item \code{summary.mle2} is now exported, for use by other
+ packages
+ \item small fixes to AIC(c) methods
+ }
+ }
+}
+
\section{Changes in version 1.0.19 (2017-04-08)}{
\itemize{
\item fixed bug: evaluate \code{call$method} so that
diff --git a/inst/doc/mle2.pdf b/inst/doc/mle2.pdf
index 933447c..7cf6758 100644
Binary files a/inst/doc/mle2.pdf and b/inst/doc/mle2.pdf differ
diff --git a/inst/doc/quasi.pdf b/inst/doc/quasi.pdf
index 256b247..c869968 100644
Binary files a/inst/doc/quasi.pdf and b/inst/doc/quasi.pdf differ
diff --git a/tests/ICtab.R b/tests/ICtab.R
index c8a3717..cdd1321 100644
--- a/tests/ICtab.R
+++ b/tests/ICtab.R
@@ -15,3 +15,15 @@ m3 <- glm(z~1,family=quasipoisson)
aa <- AICtab(m1,m2,m3,weights=TRUE)
stopifnot(any(!is.na(aa$dAIC)),
any(!is.na(aa$weight)))
+
+set.seed(101)
+x <- rnorm(100)
+dd <- data.frame(y=rnorm(100,2+3*x,sd=1),x)
+m4A <- lm(y~x,dd)
+m4B <- mle2(y~dnorm(mean=a+b*x,sd=exp(logsd)),
+ data=dd,
+ start=list(a=1,b=1,logsd=0))
+## cosmetic differences only
+stopifnot(all.equal(AIC(m4A,m4B)[,"AIC"],
+ AIC(m4B,m4A)[,"AIC"]))
+
diff --git a/tests/ICtab.Rout.save b/tests/ICtab.Rout.save
index 0dda0c5..cf275e0 100644
--- a/tests/ICtab.Rout.save
+++ b/tests/ICtab.Rout.save
@@ -1,6 +1,6 @@
-R Under development (unstable) (2016-12-05 r71733) -- "Unsuffered Consequences"
-Copyright (C) 2016 The R Foundation for Statistical Computing
+R Under development (unstable) (2017-10-27 r73634) -- "Unsuffered Consequences"
+Copyright (C) 2017 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
@@ -17,6 +17,8 @@ Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
+[Previously saved workspace restored]
+
> library(bbmle)
Loading required package: stats4
>
@@ -39,6 +41,18 @@ m1 0 1
> stopifnot(any(!is.na(aa$dAIC)),
+ any(!is.na(aa$weight)))
>
+> set.seed(101)
+> x <- rnorm(100)
+> dd <- data.frame(y=rnorm(100,2+3*x,sd=1),x)
+> m4A <- lm(y~x,dd)
+> m4B <- mle2(y~dnorm(mean=a+b*x,sd=exp(logsd)),
++ data=dd,
++ start=list(a=1,b=1,logsd=0))
+> ## cosmetic differences only
+> stopifnot(all.equal(AIC(m4A,m4B)[,"AIC"],
++ AIC(m4B,m4A)[,"AIC"]))
+>
+>
> proc.time()
user system elapsed
- 1.140 0.212 1.648
+ 1.920 0.208 2.679
diff --git a/tests/gradient_vecpar_profile.R b/tests/gradient_vecpar_profile.R
index 09b438a..178eb08 100644
--- a/tests/gradient_vecpar_profile.R
+++ b/tests/gradient_vecpar_profile.R
@@ -27,7 +27,6 @@ gr <- function(par) with(mydata, {
dnllda <- -sum(((y-model(a,b))/0.1)*x/0.1)
dnlldb <- -sum(((y-model(a,b))/0.1)*1/0.1)
return(c(dnllda, dnlldb))
-
})
## optimization
@@ -38,6 +37,37 @@ parnames(gr) <- c("a", "b")
fit <- mle2(nll, c(a = 1, b=2), gr=gr)
myprof <- profile(fit)
+myprof_c <- profile(fit,continuation="naive")
+confint(myprof)
+confint(myprof_c)
fit <- mle2(nll, c(a = 1, b=2), gr=gr, skip.hessian=TRUE)
myprof2 <- profile(fit,std.err=c(0.1,0.1))
+
+## incomplete!
+model2 <- ~a+b*x+c*x^2
+f0 <- deriv(model2,"x",function.arg=c("a","b","c"))
+## chain rule
+f1 <- function() {
+## memoize
+lastpar <- NULL
+lastval <- NULL
+}
+
+f2 <- function(par) {
+ if (par==lastpar) {
+ return(c(lastval))
+ }
+ lastpar <<- par
+ lastval <<- do.call(f0,par)
+ f1(par)
+}
+f2.gr <- function(par) {
+ if (par==lastpar) {
+ return(attr(lastval,".grad"))
+ }
+ lastpar <<- par
+ lastval <<- do.call(f0,par)
+ f1.gr(par)
+}
+parnames(f2) <- parnames(f2.gr) <- c("a","b","c")
diff --git a/tests/gradient_vecpar_profile.Rout.save b/tests/gradient_vecpar_profile.Rout.save
index 0cdb2ee..2027169 100644
--- a/tests/gradient_vecpar_profile.Rout.save
+++ b/tests/gradient_vecpar_profile.Rout.save
@@ -1,8 +1,7 @@
-R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences"
-Copyright (C) 2012 The R Foundation for Statistical Computing
-ISBN 3-900051-07-0
-Platform: i686-pc-linux-gnu (32-bit)
+R Under development (unstable) (2017-04-17 r72531) -- "Unsuffered Consequences"
+Copyright (C) 2017 The R Foundation for Statistical Computing
+Platform: x86_64-pc-linux-gnu (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
@@ -19,6 +18,7 @@ Type 'demo()' for some demos, 'help()' for on-line help, or
Type 'q()' to quit R.
> library(bbmle)
+Loading required package: stats4
>
> ## Simulate data
>
@@ -47,7 +47,6 @@ Type 'q()' to quit R.
+ dnllda <- -sum(((y-model(a,b))/0.1)*x/0.1)
+ dnlldb <- -sum(((y-model(a,b))/0.1)*1/0.1)
+ return(c(dnllda, dnlldb))
-+
+ })
>
> ## optimization
@@ -58,10 +57,47 @@ Type 'q()' to quit R.
> fit <- mle2(nll, c(a = 1, b=2), gr=gr)
>
> myprof <- profile(fit)
+> myprof_c <- profile(fit,continuation="naive")
+> confint(myprof)
+ 2.5 % 97.5 %
+a 1.9712561 2.095215
+b 0.7076574 1.118783
+> confint(myprof_c)
+ 2.5 % 97.5 %
+a 1.9712561 2.095215
+b 0.7076574 1.118783
>
> fit <- mle2(nll, c(a = 1, b=2), gr=gr, skip.hessian=TRUE)
> myprof2 <- profile(fit,std.err=c(0.1,0.1))
>
+> ## incomplete!
+> model2 <- ~a+b*x+c*x^2
+> f0 <- deriv(model2,"x",function.arg=c("a","b","c"))
+> ## chain rule
+> f1 <- function() {
++ ## memoize
++ lastpar <- NULL
++ lastval <- NULL
++ }
+>
+> f2 <- function(par) {
++ if (par==lastpar) {
++ return(c(lastval))
++ }
++ lastpar <<- par
++ lastval <<- do.call(f0,par)
++ f1(par)
++ }
+> f2.gr <- function(par) {
++ if (par==lastpar) {
++ return(attr(lastval,".grad"))
++ }
++ lastpar <<- par
++ lastval <<- do.call(f0,par)
++ f1.gr(par)
++ }
+> parnames(f2) <- parnames(f2.gr) <- c("a","b","c")
+>
> proc.time()
user system elapsed
- 1.028 1.072 1.970
+ 1.844 0.128 3.349
diff --git a/tests/optimx.R b/tests/optimx.R
index fa59078..971f6c7 100644
--- a/tests/optimx.R
+++ b/tests/optimx.R
@@ -1,6 +1,6 @@
library(bbmle)
old_opt <- options(digits=3)
-require(optimx)
+if (require(optimx)) {
x <- 0:10
y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)
d <- data.frame(x,y)
@@ -19,4 +19,5 @@ suppressWarnings(m1 <- mle2(minuslogl=y~dpois(lambda=ymax/(1+x/xhalf)),
suppressWarnings(head(as.data.frame(profile(m1))))
detach("package:optimx")
+}
options(old_opt)
diff --git a/tests/optimx.Rout.save b/tests/optimx.Rout.save
index 750876b..d215725 100644
--- a/tests/optimx.Rout.save
+++ b/tests/optimx.Rout.save
@@ -1,7 +1,7 @@
-R Under development (unstable) (2013-08-18 r63609) -- "Unsuffered Consequences"
-Copyright (C) 2013 The R Foundation for Statistical Computing
-Platform: i686-pc-linux-gnu (32-bit)
+R Under development (unstable) (2017-10-27 r73634) -- "Unsuffered Consequences"
+Copyright (C) 2017 The R Foundation for Statistical Computing
+Platform: x86_64-pc-linux-gnu (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
@@ -20,36 +20,29 @@ Type 'q()' to quit R.
> library(bbmle)
Loading required package: stats4
> old_opt <- options(digits=3)
-> require(optimx)
-Loading required package: optimx
-Loading required package: numDeriv
-> x <- 0:10
-> y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)
-> d <- data.frame(x,y)
->
-> ## breaks, don't try this
-> ## optimx(fn=Lfn,par=c(15,6),method="Rvmmin")
->
-> suppressWarnings(m1 <- mle2(minuslogl=y~dpois(lambda=ymax/(1+x/xhalf)),
+> if (require(optimx)) {
++ x <- 0:10
++ y <- c(26, 17, 13, 12, 20, 5, 9, 8, 5, 4, 8)
++ d <- data.frame(x,y)
++
++ ## breaks, don't try this
++ ## optimx(fn=Lfn,par=c(15,6),method="Rvmmin")
++
++ suppressWarnings(m1 <- mle2(minuslogl=y~dpois(lambda=ymax/(1+x/xhalf)),
+ start=list(ymax=15,xhalf=6),data=d,
+ optimizer="optimx",
+ method=c("BFGS","Nelder-Mead","CG")))
->
-> ## FIXME!! fails (although not with an error, because
-> ## errors are caught by profiling) due to npar now
-> ## being restricted to >1 in optimx 2012.05.24 ...
->
-> suppressWarnings(head(as.data.frame(profile(m1))))
- param z par.vals.ymax par.vals.xhalf focal
-ymax.1 ymax -3.377 14.0 9.99 14.0
-ymax.2 ymax -2.341 16.7 6.54 16.7
-ymax.3 ymax -1.458 19.5 4.79 19.5
-ymax.4 ymax -0.687 22.2 3.75 22.2
-ymax.5 ymax 0.000 25.0 3.06 25.0
-ymax.6 ymax 0.620 27.7 2.57 27.7
-> detach("package:optimx")
++
++ ## FIXME!! fails (although not with an error, because
++ ## errors are caught by profiling) due to npar now
++ ## being restricted to >1 in optimx 2012.05.24 ...
++
++ suppressWarnings(head(as.data.frame(profile(m1))))
++ detach("package:optimx")
++ }
+Loading required package: optimx
> options(old_opt)
>
> proc.time()
user system elapsed
- 7.848 4.400 12.412
+ 5.852 0.188 13.617
diff --git a/tests/richards.R b/tests/richards.R
index 3155a1e..914fe34 100644
--- a/tests/richards.R
+++ b/tests/richards.R
@@ -54,7 +54,6 @@ gradlikfun <- function(p,dat,times,N,incid=TRUE) {
N <- 1000
p0 <- c(x0=0.1,lambda=1,sigma=0.5,alpha=0.5)
t0 <- 1:10
-
## deterministic versions of data (cumulative and incidence)
dcdat <- model_richardson(t0,p0,N)
ddat <- diff(dcdat)
@@ -75,12 +74,19 @@ grad(likfun,p0,dat=ddat,times=t0,N=N) ## finite differences
library(bbmle)
parnames(likfun) <- names(p0)
+
m1 <- mle2(likfun,start=p0,gr=gradlikfun,data=list(times=t0,N=N,dat=ddat),
vecpar=TRUE)
plot(t0[-1],ddat)
lines(t0[-1],calc_mean(coef(m1),times=t0,N=N))
+if (FALSE) {
+ ## too slow ..
+ pp0 <- profile(m1)
+ pp0C <- profile(m1,continuation="naive")
+}
+
pp1 <- profile(m1,which="lambda")
m0 <- mle2(likfun,start=p0,data=list(times=t0,N=N,dat=ddat),
diff --git a/tests/richards.Rout.save b/tests/richards.Rout.save
index a2c1502..e9ac55e 100644
--- a/tests/richards.Rout.save
+++ b/tests/richards.Rout.save
@@ -1,8 +1,7 @@
-R Under development (unstable) (2012-07-27 r60013) -- "Unsuffered Consequences"
-Copyright (C) 2012 The R Foundation for Statistical Computing
-ISBN 3-900051-07-0
-Platform: i686-pc-linux-gnu (32-bit)
+R Under development (unstable) (2017-04-17 r72531) -- "Unsuffered Consequences"
+Copyright (C) 2017 The R Foundation for Statistical Computing
+Platform: x86_64-pc-linux-gnu (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
@@ -74,7 +73,6 @@ Type 'q()' to quit R.
> N <- 1000
> p0 <- c(x0=0.1,lambda=1,sigma=0.5,alpha=0.5)
> t0 <- 1:10
->
> ## deterministic versions of data (cumulative and incidence)
> dcdat <- model_richardson(t0,p0,N)
> ddat <- diff(dcdat)
@@ -97,8 +95,10 @@ Type 'q()' to quit R.
> ## matches!
>
> library(bbmle)
+Loading required package: stats4
> parnames(likfun) <- names(p0)
>
+>
> m1 <- mle2(likfun,start=p0,gr=gradlikfun,data=list(times=t0,N=N,dat=ddat),
+ vecpar=TRUE)
Warning messages:
@@ -112,6 +112,12 @@ Warning messages:
> plot(t0[-1],ddat)
> lines(t0[-1],calc_mean(coef(m1),times=t0,N=N))
>
+> if (FALSE) {
++ ## too slow ..
++ pp0 <- profile(m1)
++ pp0C <- profile(m1,continuation="naive")
++ }
+>
> pp1 <- profile(m1,which="lambda")
There were 50 or more warnings (use warnings() to see the first 50)
>
@@ -136,4 +142,4 @@ In .local(x, ...) :
>
> proc.time()
user system elapsed
- 8.528 1.180 9.627
+ 7.072 0.628 9.701
diff --git a/vignettes/chicago.bst b/vignettes/chicago.bst
new file mode 100755
index 0000000..511f3aa
--- /dev/null
+++ b/vignettes/chicago.bst
@@ -0,0 +1,1654 @@
+%%% ====================================================================
+%%% @BibTeX-style-file{
+%%% author = "Glenn Paulley",
+%%% version = "4",
+%%% date = "28 August 1992",
+%%% time = "10:23:39 199",
+%%% filename = "chicago.bst",
+%%% address = "Data Structuring Group
+%%% Department of Computer Science
+%%% University of Waterloo
+%%% Waterloo, Ontario, Canada
+%%% N2L 3G1",
+%%% telephone = "(519) 885-1211",
+%%% FAX = "(519) 885-1208",
+%%% checksum = "26323 1654 5143 37417",
+%%% email = "gnpaulle at bluebox.uwaterloo.ca",
+%%% codetable = "ISO/ASCII",
+%%% keywords = "",
+%%% supported = "yes",
+%%% abstract = "A BibTeX bibliography style that follows the
+%%% `B' reference style of the 13th Edition of
+%%% the Chicago Manual of Style. A detailed
+%%% feature list is given below.",
+%%% docstring = "The checksum field above contains a CRC-16
+%%% checksum as the first value, followed by the
+%%% equivalent of the standard UNIX wc (word
+%%% count) utility output of lines, words, and
+%%% characters. This is produced by Robert
+%%% Solovay's checksum utility.",
+%%% }
+%%% ====================================================================
+%
+% "Chicago" BibTeX style, chicago.bst
+% ===================================
+%
+% BibTeX `chicago' style file for BibTeX version 0.99c, LaTeX version 2.09
+% Place it in a file called chicago.bst in the BibTeX search path.
+% You need to include chicago.sty as a \documentstyle option.
+% (Placing it in the same directory as the LaTeX document should also work.)
+% This "chicago" style is based on newapa.bst (American Psych. Assoc.)
+% found at ymir.claremont.edu.
+%
+% Citation format: (author-last-name year)
+% (author-last-name and author-last-name year)
+% (author-last-name, author-last-name, and author-last-name year)
+% (author-last-name et al. year)
+% (author-last-name)
+% author-last-name (year)
+% (author-last-name and author-last-name)
+% (author-last-name et al.)
+% (year) or (year,year)
+% year or year,year
+%
+% Reference list ordering: alphabetical by author or whatever passes
+% for author in the absence of one.
+%
+% This BibTeX style has support for abbreviated author lists and for
+% year-only citations. This is done by having the citations
+% actually look like
+%
+% \citeauthoryear{full-author-info}{abbrev-author-info}{year}
+%
+% The LaTeX style has to have the following (or similar)
+%
+% \let\@internalcite\cite
+% \def\fullcite{\def\citeauthoryear##1##2##3{##1, ##3}\@internalcite}
+% \def\fullciteA{\def\citeauthoryear##1##2##3{##1}\@internalcite}
+% \def\shortcite{\def\citeauthoryear##1##2##3{##2, ##3}\@internalcite}
+% \def\shortciteA{\def\citeauthoryear##1##2##3{##2}\@internalcite}
+% \def\citeyear{\def\citeauthoryear##1##2##3{##3}\@internalcite}
+%
+% These TeX macro definitions are found in chicago.sty. Additional
+% commands to manipulate different components of a citation can be defined
+% so that, for example, you can list author's names without parentheses
+% if using a citation as a noun or object in a sentence.
+%
+% This file was originally copied from newapa.bst at ymir.claremont.edu.
+%
+% Features of chicago.bst:
+% =======================
+%
+% - full names used in citations, but abbreviated citations are available
+% (see above)
+% - if an entry has a "month", then the month and year are also printed
+% as part of that bibitem.
+% - all conjunctions use "and" instead of "\&"
+% - major modification from Chicago Manual of Style (13th ed.) is that
+% only the first author in a reference appears last name first-
+% additional authors appear as J. Q. Public.
+% - pages are listed as "pp. xx-xx" in all entry types except
+% article entries.
+% - book, inbook, and manual use "location: publisher" (or organization)
+% for address and publisher. All other types list publishers separately.
+% - "pp." are used to identify page numbers for all entry types except
+% articles.
+% - organization is used as a citation label if neither author nor editor
+% is present (for manuals).
+% - "et al." is used for long author and editor lists, or when "others"
+% is used.
+%
+% Modifications and bug fixes from newapa.bst:
+% ===========================================
+%
+% - added month, year to bib entries if month is present
+% - fixed bug with In proceedings, added necessary comma after title
+% - all conjunctions changed to "and" from "\&"
+% - fixed bug with author labels in my.full.label: "et al." now is
+% generated when "others" is an author name
+% - major modification from Chicago Manual of Style (13th ed.) is that
+% only the first author in a reference appears last name first-
+% additional authors appear as J. Q. Public.
+% - pages are listed as "pp. xx-xx" in all entry types except
+% article entries. Unnecessary (IMHO) "()" around page numbers
+% were removed, and page numbers now don't end with a period.
+% - created chicago.sty for use with this bibstyle (required).
+% - fixed bugs in FUNCTION {format.vol.num.pages} for missing volume,
+% number, and /or pages. Renamed to format.jour.vol.
+% - fixed bug in formatting booktitles: additional period an error if
+% book has a volume.
+% - fixed bug: editors usually given redundant period before next clause
+% (format.editors.dot) removed.
+% - added label support for organizations, if both author and editor
+% are missing (from alpha.bst). If organization is too long, then
+% the key field is used for abbreviated citations.
+% - In proceedings or books of several volumes, no comma was written
+% between the "Volume x" and the page numbers (this was intentional
+% in newapa.bst). Fixed.
+% - Some journals may not have volumes/numbers, only month/year (eg.
+% IEEE Computer). Fixed bug in article style that assumed volume/number
+% was always present.
+%
+% Original documentation for newapa.sty:
+% =====================================
+%
+% This version was made by modifying the master file made by
+% Oren Patashnik (PATASHNIK at SCORE.STANFORD.EDU), and the 'named' BibTeX
+% style of Peter F. Patel-Schneider.
+%
+% Copyright (C) 1985, all rights reserved.
+% Copying of this file is authorized only if either
+% (1) you make absolutely no changes to your copy, including name, or
+% (2) if you do make changes, you name it something other than 'newapa.bst'.
+% There are undoubtably bugs in this style. If you make bug fixes,
+% improvements, etc. please let me know. My e-mail address is:
+% spencer at cgrg.ohio.state.edu or 71160.3141 at compuserve.com
+%
+% This style was made from 'plain.bst', 'named.bst', and 'apalike.bst',
+% with lots of tweaking to make it look like APA style, along with tips
+% from Young Ryu and Brian Reiser's modifications of 'apalike.bst'.
+
+ENTRY
+ { address
+ author
+ booktitle
+ chapter
+ edition
+ editor
+ howpublished
+ institution
+ journal
+ key
+ month
+ note
+ number
+ organization
+ pages
+ publisher
+ school
+ series
+ title
+ type
+ volume
+ year
+ }
+ {}
+ { label.year extra.label sort.year sort.label }
+
+INTEGERS { output.state before.all mid.sentence after.sentence after.block }
+
+FUNCTION {init.state.consts}
+{ #0 'before.all :=
+ #1 'mid.sentence :=
+ #2 'after.sentence :=
+ #3 'after.block :=
+}
+
+STRINGS { s t u }
+
+FUNCTION {output.nonnull}
+{ 's :=
+ output.state mid.sentence =
+ { ", " * write$ }
+ { output.state after.block =
+ { add.period$ write$
+ newline$
+ "\newblock " write$
+ }
+ { output.state before.all =
+ 'write$
+ { add.period$ " " * write$ }
+ if$
+ }
+ if$
+ mid.sentence 'output.state :=
+ }
+ if$
+ s
+}
+
+% Use a colon to separate output. Used only for address/publisher
+% combination in book/inbook types, address/institution for manuals,
+% and organization:publisher for proceedings (inproceedings).
+%
+FUNCTION {output.nonnull.colon}
+{ 's :=
+ output.state mid.sentence =
+ { ": " * write$ }
+ { output.state after.block =
+ { add.period$ write$
+ newline$
+ "\newblock " write$
+ }
+ { output.state before.all =
+ 'write$
+ { add.period$ " " * write$ }
+ if$
+ }
+ if$
+ mid.sentence 'output.state :=
+ }
+ if$
+ s
+}
+
+FUNCTION {output}
+{ duplicate$ empty$
+ 'pop$
+ 'output.nonnull
+ if$
+}
+
+FUNCTION {output.colon}
+{ duplicate$ empty$
+ 'pop$
+ 'output.nonnull.colon
+ if$
+}
+
+FUNCTION {output.check}
+{ 't :=
+ duplicate$ empty$
+ { pop$ "empty " t * " in " * cite$ * warning$ }
+ 'output.nonnull
+ if$
+}
+
+FUNCTION {output.check.colon}
+{ 't :=
+ duplicate$ empty$
+ { pop$ "empty " t * " in " * cite$ * warning$ }
+ 'output.nonnull.colon
+ if$
+}
+
+FUNCTION {output.year.check}
+{ year empty$
+ { "empty year in " cite$ * warning$ }
+ { write$
+ " (" year * extra.label *
+ month empty$
+ { ")" * }
+ { ", " * month * ")" * }
+ if$
+ mid.sentence 'output.state :=
+ }
+ if$
+}
+
+
+FUNCTION {fin.entry}
+{ add.period$
+ write$
+ newline$
+}
+
+FUNCTION {new.block}
+{ output.state before.all =
+ 'skip$
+ { after.block 'output.state := }
+ if$
+}
+
+FUNCTION {new.sentence}
+{ output.state after.block =
+ 'skip$
+ { output.state before.all =
+ 'skip$
+ { after.sentence 'output.state := }
+ if$
+ }
+ if$
+}
+
+FUNCTION {not}
+{ { #0 }
+ { #1 }
+ if$
+}
+
+FUNCTION {and}
+{ 'skip$
+ { pop$ #0 }
+ if$
+}
+
+FUNCTION {or}
+{ { pop$ #1 }
+ 'skip$
+ if$
+}
+
+FUNCTION {new.block.checka}
+{ empty$
+ 'skip$
+ 'new.block
+ if$
+}
+
+FUNCTION {new.block.checkb}
+{ empty$
+ swap$ empty$
+ and
+ 'skip$
+ 'new.block
+ if$
+}
+
+FUNCTION {new.sentence.checka}
+{ empty$
+ 'skip$
+ 'new.sentence
+ if$
+}
+
+FUNCTION {new.sentence.checkb}
+{ empty$
+ swap$ empty$
+ and
+ 'skip$
+ 'new.sentence
+ if$
+}
+
+FUNCTION {field.or.null}
+{ duplicate$ empty$
+ { pop$ "" }
+ 'skip$
+ if$
+}
+
+%
+% Emphasize the top string on the stack.
+%
+FUNCTION {emphasize}
+{ duplicate$ empty$
+ { pop$ "" }
+ { "{\em " swap$ * "}" * }
+ if$
+}
+
+%
+% Emphasize the top string on the stack, but add a trailing space.
+%
+FUNCTION {emphasize.space}
+{ duplicate$ empty$
+ { pop$ "" }
+ { "{\em " swap$ * "\/}" * }
+ if$
+}
+
+INTEGERS { nameptr namesleft numnames }
+%
+% Format bibliographical entries with the first author last name first,
+% and subsequent authors with initials followed by last name.
+% All names are formatted in this routine.
+%
+FUNCTION {format.names}
+{ 's :=
+ #1 'nameptr := % nameptr = 1;
+ s num.names$ 'numnames := % numnames = num.name$(s);
+ numnames 'namesleft :=
+ { namesleft #0 > }
+
+ { nameptr #1 =
+ {s nameptr "{vv~}{ll}{, jj}{, f.}" format.name$ 't := }
+ {s nameptr "{f.~}{vv~}{ll}{, jj}" format.name$ 't := }
+ if$
+ nameptr #1 >
+ { namesleft #1 >
+ { ", " * t * }
+ { numnames #2 >
+ { "," * }
+ 'skip$
+ if$
+ t "others" =
+ { " et~al." * }
+ { " and " * t * } % from Chicago Manual of Style
+ if$
+ }
+ if$
+ }
+ 't
+ if$
+ nameptr #1 + 'nameptr := % nameptr += 1;
+ namesleft #1 - 'namesleft := % namesleft =- 1;
+ }
+ while$
+}
+
+FUNCTION {my.full.label}
+{ 's :=
+ #1 'nameptr := % nameptr = 1;
+ s num.names$ 'numnames := % numnames = num.name$(s);
+ numnames 'namesleft :=
+ { namesleft #0 > }
+
+ { s nameptr "{vv~}{ll}" format.name$ 't := % get the next name
+ nameptr #1 >
+ { namesleft #1 >
+ { ", " * t * }
+ { numnames #2 >
+ { "," * }
+ 'skip$
+ if$
+ t "others" =
+ { " et~al." * }
+ { " and " * t * } % from Chicago Manual of Style
+ if$
+ }
+ if$
+ }
+ 't
+ if$
+ nameptr #1 + 'nameptr := % nameptr += 1;
+ namesleft #1 - 'namesleft := % namesleft =- 1;
+ }
+ while$
+
+}
+
+FUNCTION {format.names.fml}
+%
+% Format names in "familiar" format, with first initial followed by
+% last name. Like format.names, ALL names are formatted.
+%
+{ 's :=
+ #1 'nameptr := % nameptr = 1;
+ s num.names$ 'numnames := % numnames = num.name$(s);
+ numnames 'namesleft :=
+ { namesleft #0 > }
+
+ { s nameptr "{f.~}{vv~}{ll}{, jj}" format.name$ 't :=
+
+ nameptr #1 >
+ { namesleft #1 >
+ { ", " * t * }
+ { numnames #2 >
+ { "," * }
+ 'skip$
+ if$
+ t "others" =
+ { " et~al." * }
+ { " and " * t * }
+% { " \& " * t * }
+ if$
+ }
+ if$
+ }
+ 't
+ if$
+ nameptr #1 + 'nameptr := % nameptr += 1;
+ namesleft #1 - 'namesleft := % namesleft =- 1;
+ }
+ while$
+}
+
+FUNCTION {format.authors}
+{ author empty$
+ { "" }
+ { author format.names }
+ if$
+}
+
+FUNCTION {format.key}
+{ empty$
+ { key field.or.null }
+ { "" }
+ if$
+}
+
+%
+% Format editor names for use in the "in" types: inbook, incollection,
+% inproceedings: first initial, then last names. When editors are the
+% LABEL for an entry, then format.editor is used which lists editors
+% by last name first.
+%
+FUNCTION {format.editors.fml}
+{ editor empty$
+ { "" }
+ { editor format.names.fml
+ editor num.names$ #1 >
+ { " (Eds.)" * }
+ { " (Ed.)" * }
+ if$
+ }
+ if$
+}
+
+%
+% Format editor names for use in labels, last names first.
+%
+FUNCTION {format.editors}
+{ editor empty$
+ { "" }
+ { editor format.names
+ editor num.names$ #1 >
+ { " (Eds.)" * }
+ { " (Ed.)" * }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.title}
+{ title empty$
+ { "" }
+ { title "t" change.case$ }
+ if$
+}
+
+% Note that the APA style requres case changes
+% in article titles. The following does not
+% change cases. If you perfer it, uncomment the
+% following and comment out the above.
+
+%FUNCTION {format.title}
+%{ title empty$
+% { "" }
+% { title }
+% if$
+%}
+
+FUNCTION {n.dashify}
+{ 't :=
+ ""
+ { t empty$ not }
+ { t #1 #1 substring$ "-" =
+ { t #1 #2 substring$ "--" = not
+ { "--" *
+ t #2 global.max$ substring$ 't :=
+ }
+ { { t #1 #1 substring$ "-" = }
+ { "-" *
+ t #2 global.max$ substring$ 't :=
+ }
+ while$
+ }
+ if$
+ }
+ { t #1 #1 substring$ *
+ t #2 global.max$ substring$ 't :=
+ }
+ if$
+ }
+ while$
+}
+
+FUNCTION {format.btitle}
+{ edition empty$
+ { title emphasize }
+ { title empty$
+ { title emphasize }
+ { volume empty$ % gnp - check for volume, then don't need period
+ { "{\em " title * "\/} (" * edition * " ed.)" * "." * }
+ { "{\em " title * "\/} (" * edition * " ed.)" * }
+ if$
+ }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.emphasize.booktitle}
+{ edition empty$
+ { booktitle emphasize }
+ { booktitle empty$
+ { booktitle emphasize }
+ { volume empty$ % gnp - extra period an error if book has a volume
+ { "{\em " booktitle * "\/} (" * edition * " ed.)" * "." *}
+ { "{\em " booktitle * "\/} (" * edition * " ed.)" * }
+ if$
+ }
+ if$
+ }
+ if$
+ }
+
+
+FUNCTION {tie.or.space.connect}
+{ duplicate$ text.length$ #3 <
+ { "~" }
+ { " " }
+ if$
+ swap$ * *
+}
+
+FUNCTION {either.or.check}
+{ empty$
+ 'pop$
+ { "can't use both " swap$ * " fields in " * cite$ * warning$ }
+ if$
+}
+
+FUNCTION {format.bvolume}
+{ volume empty$
+ { "" }
+ { "Volume" volume tie.or.space.connect % gnp - changed to mixed case
+ series empty$
+ 'skip$
+ { " of " * series emphasize * }
+ if$
+ "volume and number" number either.or.check
+ }
+ if$
+}
+
+FUNCTION {format.number.series}
+{ volume empty$
+ { number empty$
+ { series field.or.null }
+ { output.state mid.sentence =
+ { "Number" } % gnp - changed to mixed case always
+ { "Number" }
+ if$
+ number tie.or.space.connect
+ series empty$
+ { "there's a number but no series in " cite$ * warning$ }
+ { " in " * series * }
+ if$
+ }
+ if$
+ }
+ { "" }
+ if$
+}
+
+INTEGERS { multiresult }
+
+FUNCTION {multi.page.check}
+{ 't :=
+ #0 'multiresult :=
+ { multiresult not
+ t empty$ not
+ and
+ }
+ { t #1 #1 substring$
+ duplicate$ "-" =
+ swap$ duplicate$ "," =
+ swap$ "+" =
+ or or
+ { #1 'multiresult := }
+ { t #2 global.max$ substring$ 't := }
+ if$
+ }
+ while$
+ multiresult
+}
+
+FUNCTION {format.pages}
+{ pages empty$
+ { "" }
+ { pages multi.page.check
+ { "pp.\ " pages n.dashify tie.or.space.connect } % gnp - removed ()
+ { "pp.\ " pages tie.or.space.connect }
+ if$
+ }
+ if$
+}
+
+% By Young (and Spencer)
+% GNP - fixed bugs with missing volume, number, and/or pages
+%
+% Format journal, volume, number, pages for article types.
+%
+FUNCTION {format.jour.vol}
+{ journal empty$
+ { "no journal in " cite$ * warning$
+ "" }
+ { journal emphasize.space }
+ if$
+ number empty$
+ { volume empty$
+ { "no number and no volume in " cite$ * warning$
+ "" * }
+ { "~{\em " * Volume * "}" * }
+ if$
+ }
+ { volume empty$
+ {"no volume for " cite$ * warning$
+ "~(" * number * ")" * }
+ { "~" *
+ volume emphasize.space
+ "(" * number * ")" * * }
+ if$
+ }
+ if$
+ pages empty$
+ {"page numbers missing in " cite$ * warning$
+ "" * } % gnp - place a null string on the stack for output
+ { duplicate$ empty$
+ { pop$ format.pages }
+ { ", " * pages n.dashify * } % gnp - removed pp. for articles
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.chapter.pages}
+{ chapter empty$
+ 'format.pages
+ { type empty$
+ { "Chapter" } % gnp - changed to mixed case
+ { type "t" change.case$ }
+ if$
+ chapter tie.or.space.connect
+ pages empty$
+ {"page numbers missing in " cite$ * warning$} % gnp - added check
+ { ", " * format.pages * }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.in.ed.booktitle}
+{ booktitle empty$
+ { "" }
+ { editor empty$
+ { "In " format.emphasize.booktitle * }
+ { "In " format.editors.fml * ", " * format.emphasize.booktitle * }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.thesis.type}
+{ type empty$
+ 'skip$
+ { pop$
+ type "t" change.case$
+ }
+ if$
+}
+
+FUNCTION {format.tr.number}
+{ type empty$
+ { "Technical Report" }
+ 'type
+ if$
+ number empty$
+ { "t" change.case$ }
+ { number tie.or.space.connect }
+ if$
+}
+
+FUNCTION {format.article.crossref}
+{ "See"
+ "\citeN{" * crossref * "}" *
+}
+
+FUNCTION {format.crossref.editor}
+{ editor #1 "{vv~}{ll}" format.name$
+ editor num.names$ duplicate$
+ #2 >
+ { pop$ " et~al." * }
+ { #2 <
+ 'skip$
+ { editor #2 "{ff }{vv }{ll}{ jj}" format.name$ "others" =
+ { " et~al." * }
+ { " and " * editor #2 "{vv~}{ll}" format.name$ * }
+ if$
+ }
+ if$
+ }
+ if$
+}
+
+FUNCTION {format.book.crossref}
+{ volume empty$
+ { "empty volume in " cite$ * "'s crossref of " * crossref * warning$
+ "In "
+ }
+ { "Volume" volume tie.or.space.connect % gnp - changed to mixed case
+ " of " *
+ }
+ if$
+ editor empty$
+ editor field.or.null author field.or.null =
+ or
+ { key empty$
+ { series empty$
+ { "need editor, key, or series for " cite$ * " to crossref " *
+ crossref * warning$
+ "" *
+ }
+ { "{\em " * series * "\/}" * }
+ if$
+ }
+ { key * }
+ if$
+ }
+ { format.crossref.editor * }
+ if$
+ " \citeN{" * crossref * "}" *
+}
+
+FUNCTION {format.incoll.inproc.crossref}
+{ "See"
+ " \citeN{" * crossref * "}" *
+}
+
+% format.lab.names:
+%
+% determines "short" names for the abbreviated author information.
+% "Long" labels are created in calc.label, using the routine my.full.label
+% to format author and editor fields.
+%
+% There are 4 cases for labels. (n=3 in the example)
+% a) one author Foo
+% b) one to n Foo, Bar and Baz
+% c) use of "and others" Foo, Bar et al.
+% d) more than n Foo et al.
+%
+FUNCTION {format.lab.names}
+{ 's :=
+ s num.names$ 'numnames :=
+ numnames #2 > % change number to number of others allowed before
+ % forcing "et al".
+ { s #1 "{vv~}{ll}" format.name$ " et~al." * }
+ {
+ numnames #1 - 'namesleft :=
+ #2 'nameptr :=
+ s #1 "{vv~}{ll}" format.name$
+ { namesleft #0 > }
+ { nameptr numnames =
+ { s nameptr "{ff }{vv }{ll}{ jj}" format.name$ "others" =
+ { " et~al." * }
+ { " and " * s nameptr "{vv~}{ll}" format.name$ * }
+ if$
+ }
+ { ", " * s nameptr "{vv~}{ll}" format.name$ * }
+ if$
+ nameptr #1 + 'nameptr :=
+ namesleft #1 - 'namesleft :=
+ }
+ while$
+ }
+ if$
+}
+
+FUNCTION {author.key.label}
+{ author empty$
+ { key empty$
+ { "no key, author in " cite$ * warning$
+ cite$ #1 #3 substring$ }
+ 'key
+ if$
+ }
+ { author format.lab.names }
+ if$
+}
+
+FUNCTION {editor.key.label}
+{ editor empty$
+ { key empty$
+ { "no key, editor in " cite$ * warning$
+ cite$ #1 #3 substring$ }
+ 'key
+ if$
+ }
+ { editor format.lab.names }
+ if$
+}
+
+FUNCTION {author.key.organization.label}
+%
+% added - gnp. Provide label formatting by organization if author is null.
+%
+{ author empty$
+ { organization empty$
+ { key empty$
+ { "no key, author or organization in " cite$ * warning$
+ cite$ #1 #3 substring$ }
+ 'key
+ if$
+ }
+ { organization }
+ if$
+ }
+ { author format.lab.names }
+ if$
+}
+
+FUNCTION {editor.key.organization.label}
+%
+% added - gnp. Provide label formatting by organization if editor is null.
+%
+{ editor empty$
+ { organization empty$
+ { key empty$
+ { "no key, editor or organization in " cite$ * warning$
+ cite$ #1 #3 substring$ }
+ 'key
+ if$
+ }
+ { organization }
+ if$
+ }
+ { editor format.lab.names }
+ if$
+}
+
+FUNCTION {author.editor.key.label}
+{ author empty$
+ { editor empty$
+ { key empty$
+ { "no key, author, or editor in " cite$ * warning$
+ cite$ #1 #3 substring$ }
+ 'key
+ if$
+ }
+ { editor format.lab.names }
+ if$
+ }
+ { author format.lab.names }
+ if$
+}
+
+FUNCTION {calc.label}
+%
+% Changed - GNP. See also author.organization.sort, editor.organization.sort
+% Form label for BibTeX entry. The classification of which fields are used
+% for which type of entry (book, inbook, etc.) are taken from alpha.bst.
+% The change here from newapa is to also include organization as a
+% citation label if author or editor is missing.
+%
+{ type$ "book" =
+ type$ "inbook" =
+ or
+ 'author.editor.key.label
+ { type$ "proceedings" =
+ 'editor.key.organization.label
+ { type$ "manual" =
+ 'author.key.organization.label
+ 'author.key.label
+ if$
+ }
+ if$
+ }
+ if$
+
+ author empty$ % generate the full label citation information.
+ { editor empty$
+ { organization empty$
+ { "no author, editor, or organization in " cite$ * warning$
+ "??" }
+ { organization }
+ if$
+ }
+ { editor my.full.label }
+ if$
+ }
+ { author my.full.label }
+ if$
+
+% leave label on the stack, to be popped when required.
+
+ "}{" * swap$ * "}{" *
+% year field.or.null purify$ #-1 #4 substring$ *
+%
+% save the year for sort processing afterwards (adding a, b, c, etc.)
+%
+ year field.or.null purify$ #-1 #4 substring$
+ 'label.year :=
+}
+
+FUNCTION {output.bibitem}
+{ newline$
+
+ "\bibitem[\protect\citeauthoryear{" write$
+ calc.label write$
+ sort.year write$
+ "}]{" write$
+
+ cite$ write$
+ "}" write$
+ newline$
+ ""
+ before.all 'output.state :=
+}
+
+FUNCTION {article}
+{ output.bibitem
+ format.authors
+ "author" output.check
+ author format.key output % added
+ output.year.check % added
+ new.block
+ format.title
+ "title" output.check
+ new.block
+ crossref missing$
+ { format.jour.vol output
+ }
+ { format.article.crossref output.nonnull
+ format.pages output
+ }
+ if$
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {book}
+{ output.bibitem
+ author empty$
+ { format.editors
+ "author and editor" output.check }
+ { format.authors
+ output.nonnull
+ crossref missing$
+ { "author and editor" editor either.or.check }
+ 'skip$
+ if$
+ }
+ if$
+ output.year.check % added
+ new.block
+ format.btitle
+ "title" output.check
+ crossref missing$
+ { format.bvolume output
+ new.block
+ format.number.series output
+ new.sentence
+ address output
+ publisher "publisher" output.check.colon
+ }
+ { new.block
+ format.book.crossref output.nonnull
+ }
+ if$
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {booklet}
+{ output.bibitem
+ format.authors output
+ author format.key output % added
+ output.year.check % added
+ new.block
+ format.title
+ "title" output.check
+ new.block
+ howpublished output
+ address output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {inbook}
+{ output.bibitem
+ author empty$
+ { format.editors
+ "author and editor" output.check
+ }
+ { format.authors output.nonnull
+ crossref missing$
+ { "author and editor" editor either.or.check }
+ 'skip$
+ if$
+ }
+ if$
+ output.year.check % added
+ new.block
+ format.btitle
+ "title" output.check
+ crossref missing$
+ { format.bvolume output
+ format.chapter.pages
+ "chapter and pages" output.check
+ new.block
+ format.number.series output
+ new.sentence
+ address output
+ publisher
+ "publisher" output.check.colon
+ }
+ { format.chapter.pages "chapter and pages" output.check
+ new.block
+ format.book.crossref output.nonnull
+ }
+ if$
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {incollection}
+{ output.bibitem
+ format.authors
+ "author" output.check
+ author format.key output % added
+ output.year.check % added
+ new.block
+ format.title
+ "title" output.check
+ new.block
+ crossref missing$
+ { format.in.ed.booktitle
+ "booktitle" output.check
+ format.bvolume output
+ format.number.series output
+ format.chapter.pages output % gnp - was special.output.nonnull
+% left out comma before page numbers
+ new.sentence
+ address output
+ publisher "publisher" output.check.colon
+ }
+ { format.incoll.inproc.crossref
+ output.nonnull
+ format.chapter.pages output
+ }
+ if$
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {inproceedings}
+{ output.bibitem
+ format.authors
+ "author" output.check
+ author format.key output % added
+ output.year.check % added
+ new.block
+ format.title
+ "title" output.check
+ new.block
+ crossref missing$
+ { format.in.ed.booktitle
+ "booktitle" output.check
+ format.bvolume output
+ format.number.series output
+ address output
+ format.pages output
+ new.sentence
+ organization output
+ publisher output.colon
+ }
+ { format.incoll.inproc.crossref output.nonnull
+ format.pages output
+ }
+ if$
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {conference} { inproceedings }
+
+FUNCTION {manual}
+{ output.bibitem
+ author empty$
+ { editor empty$
+ { organization "organization" output.check
+ organization format.key output } % if all else fails, use key
+ { format.editors "author and editor" output.check }
+ if$
+ }
+ { format.authors output.nonnull }
+ if$
+ output.year.check % added
+ new.block
+ format.btitle
+ "title" output.check
+ organization address new.block.checkb
+% Reversed the order of "address" and "organization", added the ":".
+ address output
+ organization "organization" output.check.colon
+% address output
+% ":" output
+% organization output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {mastersthesis}
+{ output.bibitem
+ format.authors
+ "author" output.check
+ author format.key output % added
+ output.year.check % added
+ new.block
+ format.title
+ "title" output.check
+ new.block
+ "Master's thesis" format.thesis.type output.nonnull
+ school "school" output.check
+ address output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {misc}
+{ output.bibitem
+ format.authors output
+ author format.key output % added
+ output.year.check % added
+ title howpublished new.block.checkb
+ format.title output
+ new.block
+ howpublished output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {phdthesis}
+{ output.bibitem
+ format.authors
+ "author" output.check
+ author format.key output % added
+ output.year.check % added
+ new.block
+ format.btitle
+ "title" output.check
+ new.block
+ "Ph.\ D. thesis" format.thesis.type output.nonnull
+ school "school" output.check
+ address output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {proceedings}
+{ output.bibitem
+ editor empty$
+ { organization output
+ organization format.key output } % gnp - changed from author format.key
+ { format.editors output.nonnull }
+ if$
+% author format.key output % gnp - removed (should be either
+% editor or organization
+ output.year.check % added (newapa)
+ new.block
+ format.btitle
+ "title" output.check
+ format.bvolume output
+ format.number.series output
+ address output
+ new.sentence
+ organization output
+ publisher output.colon
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {techreport}
+{ output.bibitem
+ format.authors
+ "author" output.check
+ author format.key output % added
+ output.year.check % added
+ new.block
+ format.title
+ "title" output.check
+ new.block
+ format.tr.number output.nonnull
+ institution
+ "institution" output.check
+ address output
+ new.block
+ note output
+ fin.entry
+}
+
+FUNCTION {unpublished}
+{ output.bibitem
+ format.authors
+ "author" output.check
+ author format.key output % added
+ output.year.check % added
+ new.block
+ format.title
+ "title" output.check
+ new.block
+ note "note" output.check
+ fin.entry
+}
+
+FUNCTION {default.type} { misc }
+
+MACRO {jan} {"January"}
+
+MACRO {feb} {"February"}
+
+MACRO {mar} {"March"}
+
+MACRO {apr} {"April"}
+
+MACRO {may} {"May"}
+
+MACRO {jun} {"June"}
+
+MACRO {jul} {"July"}
+
+MACRO {aug} {"August"}
+
+MACRO {sep} {"September"}
+
+MACRO {oct} {"October"}
+
+MACRO {nov} {"November"}
+
+MACRO {dec} {"December"}
+
+MACRO {acmcs} {"ACM Computing Surveys"}
+
+MACRO {acta} {"Acta Informatica"}
+
+MACRO {ai} {"Artificial Intelligence"}
+
+MACRO {cacm} {"Communications of the ACM"}
+
+MACRO {ibmjrd} {"IBM Journal of Research and Development"}
+
+MACRO {ibmsj} {"IBM Systems Journal"}
+
+MACRO {ieeese} {"IEEE Transactions on Software Engineering"}
+
+MACRO {ieeetc} {"IEEE Transactions on Computers"}
+
+MACRO {ieeetcad}
+ {"IEEE Transactions on Computer-Aided Design of Integrated Circuits"}
+
+MACRO {ipl} {"Information Processing Letters"}
+
+MACRO {jacm} {"Journal of the ACM"}
+
+MACRO {jcss} {"Journal of Computer and System Sciences"}
+
+MACRO {scp} {"Science of Computer Programming"}
+
+MACRO {sicomp} {"SIAM Journal on Computing"}
+
+MACRO {tocs} {"ACM Transactions on Computer Systems"}
+
+MACRO {tods} {"ACM Transactions on Database Systems"}
+
+MACRO {tog} {"ACM Transactions on Graphics"}
+
+MACRO {toms} {"ACM Transactions on Mathematical Software"}
+
+MACRO {toois} {"ACM Transactions on Office Information Systems"}
+
+MACRO {toplas} {"ACM Transactions on Programming Languages and Systems"}
+
+MACRO {tcs} {"Theoretical Computer Science"}
+
+READ
+
+FUNCTION {sortify}
+{ purify$
+ "l" change.case$
+}
+
+INTEGERS { len }
+
+FUNCTION {chop.word}
+{ 's :=
+ 'len :=
+ s #1 len substring$ =
+ { s len #1 + global.max$ substring$ }
+ 's
+ if$
+}
+
+
+
+FUNCTION {sort.format.names}
+{ 's :=
+ #1 'nameptr :=
+ ""
+ s num.names$ 'numnames :=
+ numnames 'namesleft :=
+ { namesleft #0 > }
+ { nameptr #1 >
+ { " " * }
+ 'skip$
+ if$
+ s nameptr "{vv{ } }{ll{ }}{ f{ }}{ jj{ }}" format.name$ 't :=
+ nameptr numnames = t "others" = and
+ { " et~al" * }
+ { t sortify * }
+ if$
+ nameptr #1 + 'nameptr :=
+ namesleft #1 - 'namesleft :=
+ }
+ while$
+}
+
+FUNCTION {sort.format.title}
+{ 't :=
+ "A " #2
+ "An " #3
+ "The " #4 t chop.word
+ chop.word
+ chop.word
+ sortify
+ #1 global.max$ substring$
+}
+
+FUNCTION {author.sort}
+{ author empty$
+ { key empty$
+ { "to sort, need author or key in " cite$ * warning$
+ "" }
+ { key sortify }
+ if$
+ }
+ { author sort.format.names }
+ if$
+}
+
+FUNCTION {editor.sort}
+{ editor empty$
+ { key empty$
+ { "to sort, need editor or key in " cite$ * warning$
+ ""
+ }
+ { key sortify }
+ if$
+ }
+ { editor sort.format.names }
+ if$
+}
+
+FUNCTION {author.editor.sort}
+{ author empty$
+ { "missing author in " cite$ * warning$
+ editor empty$
+ { key empty$
+ { "to sort, need author, editor, or key in " cite$ * warning$
+ ""
+ }
+ { key sortify }
+ if$
+ }
+ { editor sort.format.names }
+ if$
+ }
+ { author sort.format.names }
+ if$
+}
+
+FUNCTION {author.organization.sort}
+%
+% added - GNP. Stack author or organization for sorting (from alpha.bst).
+% Unlike alpha.bst, we need entire names, not abbreviations
+%
+{ author empty$
+ { organization empty$
+ { key empty$
+ { "to sort, need author, organization, or key in " cite$ * warning$
+ ""
+ }
+ { key sortify }
+ if$
+ }
+ { organization sortify }
+ if$
+ }
+ { author sort.format.names }
+ if$
+}
+
+FUNCTION {editor.organization.sort}
+%
+% added - GNP. Stack editor or organization for sorting (from alpha.bst).
+% Unlike alpha.bst, we need entire names, not abbreviations
+%
+{ editor empty$
+ { organization empty$
+ { key empty$
+ { "to sort, need editor, organization, or key in " cite$ * warning$
+ ""
+ }
+ { key sortify }
+ if$
+ }
+ { organization sortify }
+ if$
+ }
+ { editor sort.format.names }
+ if$
+}
+
+FUNCTION {presort}
+%
+% Presort creates the bibentry's label via a call to calc.label, and then
+% sorts the entries based on entry type. Chicago.bst adds support for
+% including organizations as the sort key; the following is stolen from
+% alpha.bst.
+%
+{ calc.label sortify % recalculate bibitem label
+ year field.or.null purify$ #-1 #4 substring$ * % add year
+ " "
+ *
+ type$ "book" =
+ type$ "inbook" =
+ or
+ 'author.editor.sort
+ { type$ "proceedings" =
+ 'editor.organization.sort
+ { type$ "manual" =
+ 'author.organization.sort
+ 'author.sort
+ if$
+ }
+ if$
+ }
+ if$
+ #1 entry.max$ substring$ % added for newapa
+ 'sort.label := % added for newapa
+ sort.label % added for newapa
+ *
+ " "
+ *
+ title field.or.null
+ sort.format.title
+ *
+ #1 entry.max$ substring$
+ 'sort.key$ :=
+}
+
+ITERATE {presort}
+
+SORT % by label, year, author/editor, title
+
+STRINGS { last.label next.extra }
+
+INTEGERS { last.extra.num }
+
+FUNCTION {initialize.extra.label.stuff}
+{ #0 int.to.chr$ 'last.label :=
+ "" 'next.extra :=
+ #0 'last.extra.num :=
+}
+
+FUNCTION {forward.pass}
+%
+% Pass through all entries, comparing current entry to last one.
+% Need to concatenate year to the stack (done by calc.label) to determine
+% if two entries are the same (see presort)
+%
+{ last.label
+ calc.label year field.or.null purify$ #-1 #4 substring$ * % add year
+ #1 entry.max$ substring$ = % are they equal?
+ { last.extra.num #1 + 'last.extra.num :=
+ last.extra.num int.to.chr$ 'extra.label :=
+ }
+ { "a" chr.to.int$ 'last.extra.num :=
+ "" 'extra.label :=
+ calc.label year field.or.null purify$ #-1 #4 substring$ * % add year
+ #1 entry.max$ substring$ 'last.label := % assign to last.label
+ }
+ if$
+}
+
+FUNCTION {reverse.pass}
+{ next.extra "b" =
+ { "a" 'extra.label := }
+ 'skip$
+ if$
+ label.year extra.label * 'sort.year :=
+ extra.label 'next.extra :=
+}
+
+EXECUTE {initialize.extra.label.stuff}
+
+ITERATE {forward.pass}
+
+REVERSE {reverse.pass}
+
+FUNCTION {bib.sort.order}
+{ sort.label
+ " "
+ *
+ year field.or.null sortify
+ *
+ " "
+ *
+ title field.or.null
+ sort.format.title
+ *
+ #1 entry.max$ substring$
+ 'sort.key$ :=
+}
+
+ITERATE {bib.sort.order}
+
+SORT % by sort.label, year, title --- giving final bib. order.
+
+FUNCTION {begin.bib}
+
+{ preamble$ empty$
+ 'skip$
+ { preamble$ write$ newline$ }
+ if$
+ "\begin{thebibliography}{}" write$ newline$
+}
+
+
+EXECUTE {begin.bib}
+
+EXECUTE {init.state.consts}
+
+ITERATE {call.type$}
+
+FUNCTION {end.bib}
+{ newline$
+ "\end{thebibliography}" write$ newline$
+}
+
+EXECUTE {end.bib}
+
+
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-bbmle.git
More information about the debian-med-commit
mailing list