Check failed after compilation (PR#7159)

# ../../bin/R --vanilla < stats-Ex.R                

### * <HEADER>
###
attach(NULL, name = "CheckExEnv")
assign(".CheckExEnv", as.environment(2), pos = length(search())) # base
## add some hooks to label plot pages, at least for base graphics
.newplot.hook <- function()

setHook("plot.new", .newplot.hook)
setHook("persp", .newplot.hook)
rm(.newplot.hook)
## add some hooks to label plot pages for grid graphics
.gridplot.hook <- function()

setHook("grid.newpage", .gridplot.hook)
rm(.gridplot.hook)
assign("cleanEx",

assign("..nameEx", "__{must remake R-ex/*.R}__", env = .CheckExEnv) # for now
assign("ptime", proc.time(), env = .CheckExEnv)
graphics::postscript("stats-Examples.ps")
assign("par.postscript", graphics::par(no.readonly = TRUE), env =

options(contrasts = c(unordered = "contr.treatment", ordered = "contr.poly"))
library('stats')

assign(".oldSearch", search(), env = .CheckExEnv)
cleanEx(); ..nameEx <- "AIC"

### * AIC

flush(stderr()); flush(stdout())

### Name: AIC
### Title: Akaike's An Information Criterion
### Aliases: AIC
### Keywords: models

### ** Examples

data(swiss)
lm1 <- lm(Fertility ~ . , data = swiss)
AIC(lm1)

stopifnot(all.equal(AIC(lm1),

## a version of BIC or Schwarz' BC :
AIC(lm1, k = log(nrow(swiss)))

cleanEx(); ..nameEx <- "ARMAacf"

### * ARMAacf

flush(stderr()); flush(stdout())

### Name: ARMAacf
### Title: Compute Theoretical ACF for an ARMA Process
### Aliases: ARMAacf
### Keywords: ts

### ** Examples

ARMAacf(c(1.0, -0.25), 1.0, lag.max = 10)

## Example from Brockwell & Davis (1991, pp.92-4)
## answer 2^(-n) * (32/3 + 8 * n) /(32/3)
n <- 1:10; 2^(-n) * (32/3 + 8 * n) /(32/3)

ARMAacf(c(1.0, -0.25), 1.0, lag.max = 10, pacf = TRUE)

ARMAacf(c(1.0, -0.25), lag.max = 10, pacf = TRUE)

cleanEx(); ..nameEx <- "ARMAtoMA"

### * ARMAtoMA

flush(stderr()); flush(stdout())

### Name: ARMAtoMA
### Title: Convert ARMA Process to Infinite MA Process
### Aliases: ARMAtoMA
### Keywords: ts

### ** Examples

ARMAtoMA(c(1.0, -0.25), 1.0, 10)

## Example from Brockwell & Davis (1991, p.92)
## answer (1 + 3*n)*2^(-n)
n <- 1:10; (1 + 3*n)*2^(-n)

cleanEx(); ..nameEx <- "AirPassengers"

### * AirPassengers

flush(stderr()); flush(stdout())

### Name: AirPassengers
### Title: Monthly Airline Passenger Numbers 1949-1960
### Aliases: AirPassengers
### Keywords: datasets

### ** Examples

## Not run: ## These are quite slow and so not run by example(AirPassengers)
##D 
##D data(AirPassengers)
##D ## The classic 'airline model', by full ML
##D (fit <- arima(log10(AirPassengers), c(0, 1, 1),
##D               seasonal = list(order=c(0, 1 ,1), period=12)))
##D update(fit, method = "CSS")
##D update(fit, x=window(log10(AirPassengers), start = 1954))
##D pred <- predict(fit, n.ahead = 24)
##D tl <- pred$pred - 1.96 * pred$se
##D tu <- pred$pred + 1.96 * pred$se
##D ts.plot(AirPassengers, 10^tl, 10^tu, log = "y", lty = c(1,2,2))
##D 
##D ## full ML fit is the same if the series is reversed, CSS fit is not
##D ap0 <- rev(log10(AirPassengers))
##D attributes(ap0) <- attributes(AirPassengers)
##D arima(ap0, c(0, 1, 1), seasonal = list(order=c(0, 1 ,1), period=12))
##D arima(ap0, c(0, 1, 1), seasonal = list(order=c(0, 1 ,1), period=12),
##D       method = "CSS")
##D 
##D ## Structural Time Series
##D ap <- log10(AirPassengers) - 2
##D (fit <- StructTS(ap, type= "BSM"))
##D par(mfrow=c(1,2))
##D plot(cbind(ap, fitted(fit)), plot.type = "single")
##D plot(cbind(ap, tsSmooth(fit)), plot.type = "single")
## End(Not run)


cleanEx(); ..nameEx <- "BOD"

### * BOD

flush(stderr()); flush(stdout())

### Name: BOD
### Title: Biochemical Oxygen Demand
### Aliases: BOD
### Keywords: datasets

### ** Examples

data(BOD)
# simplest form of fitting a first-order model to these data
fm1 <- nls(demand ~ A*(1-exp(-exp(lrc)*Time)), data = BOD,

coef(fm1)

print(fm1)

# using the plinear algorithm
fm2 <- nls(demand ~ (1-exp(-exp(lrc)*Time)), data = BOD,

# using a self-starting model
fm3 <- nls(demand ~ SSasympOrig(Time, A, lrc), data = BOD)
summary( fm3 )

cleanEx(); ..nameEx <- "Beta"

### * Beta

flush(stderr()); flush(stdout())

### Name: Beta
### Title: The Beta Distribution
### Aliases: Beta dbeta pbeta qbeta rbeta
### Keywords: distribution

### ** Examples

x <- seq(0, 1, length=21)
dbeta(x, 1, 1)

pbeta(x, 1, 1)

cleanEx(); ..nameEx <- "Binomial"

### * Binomial

flush(stderr()); flush(stdout())

### Name: Binomial
### Title: The Binomial Distribution
### Aliases: Binomial dbinom pbinom qbinom rbinom
### Keywords: distribution

### ** Examples

# Compute P(45 < X < 55) for X Binomial(100,0.5)
sum(dbinom(46:54, 100, 0.5))

## Using "log = TRUE" for an extended range :
n <- 2000
k <- seq(0, n, by = 20)
plot (k, dbinom(k, n, pi/10, log=TRUE), type='l', ylab="log density",

lines(k, log(dbinom(k, n, pi/10)), col='red', lwd=2)
## extreme points are omitted since dbinom gives 0.
mtext("dbinom(k, log=TRUE)", adj=0)
mtext("extended range", adj=0, line = -1, font=4)
mtext("log(dbinom(k))", col="red", adj=1)



cleanEx(); ..nameEx <- "Cauchy"

### * Cauchy

flush(stderr()); flush(stdout())

### Name: Cauchy
### Title: The Cauchy Distribution
### Aliases: Cauchy dcauchy pcauchy qcauchy rcauchy
### Keywords: distribution

### ** Examples

dcauchy(-1:4)

cleanEx(); ..nameEx <- "ChickWeight"

### * ChickWeight

flush(stderr()); flush(stdout())

### Name: ChickWeight
### Title: Weight versus age of chicks on different diets
### Aliases: ChickWeight
### Keywords: datasets

### ** Examples

data(ChickWeight)
coplot(weight ~ Time | Chick, data = ChickWeight,

## fit a representative chick
fm1 <- nls(weight ~ SSlogis( Time, Asym, xmid, scal ),

summary( fm1 )

cleanEx(); ..nameEx <- "Chisquare"

### * Chisquare

flush(stderr()); flush(stdout())

### Name: Chisquare
### Title: The (non-central) Chi-Squared Distribution
### Aliases: Chisquare dchisq pchisq qchisq rchisq
### Keywords: distribution

### ** Examples

dchisq(1, df=1:3)

pchisq(1, df= 3)

pchisq(1, df= 3, ncp = 0:4)# includes the above

x <- 1:10
## Chi-squared(df = 2) is a special exponential distribution
all.equal(dchisq(x, df=2), dexp(x, 1/2))

all.equal(pchisq(x, df=2), pexp(x, 1/2))

## non-central RNG -- df=0 is ok for ncp > 0:  Z0 has point mass at 0!
Z0 <- rchisq(100, df = 0, ncp = 2.)
graphics::stem(Z0)

## Not run: 
##D ## visual testing
##D ## do P-P plots for 1000 points at various degrees of freedom
##D L <- 1.2; n <- 1000; pp <- ppoints(n)
##D op <- par(mfrow = c(3,3), mar= c(3,3,1,1)+.1, mgp= c(1.5,.6,0),
##D           oma = c(0,0,3,0))
##D for(df in 2^(4*rnorm(9))) {
##D   plot(pp, sort(pchisq(rr <- rchisq(n,df=df, ncp=L), df=df, ncp=L)),
##D        ylab="pchisq(rchisq(.),.)", pch=".")
##D   mtext(paste("df = ",formatC(df, digits = 4)), line= -2, adj=0.05)
##D   abline(0,1,col=2)
##D }
##D mtext(expression("P-P plots : Noncentral  "*
##D                  chi^2 *"(n=1000, df=X, ncp= 1.2)"),
##D       cex = 1.5, font = 2, outer=TRUE)
##D par(op)
## End(Not run)



cleanEx(); ..nameEx <- "DNase"

### * DNase

flush(stderr()); flush(stdout())

### Name: DNase
### Title: Elisa assay of DNase
### Aliases: DNase
### Keywords: datasets

### ** Examples

data(DNase)
coplot(density ~ conc | Run, data = DNase,

coplot(density ~ log(conc) | Run, data = DNase,

## fit a representative run
fm1 <- nls(density ~ SSlogis( log(conc), Asym, xmid, scal ),

## compare with a four-parameter logistic
fm2 <- nls(density ~ SSfpl( log(conc), A, B, xmid, scal ),

summary(fm2)

anova(fm1, fm2)

cleanEx(); ..nameEx <- "Exponential"

### * Exponential

flush(stderr()); flush(stdout())

### Name: Exponential
### Title: The Exponential Distribution
### Aliases: Exponential dexp pexp qexp rexp
### Keywords: distribution

### ** Examples

dexp(1) - exp(-1) #-> 0

cleanEx(); ..nameEx <- "Fdist"

### * Fdist

flush(stderr()); flush(stdout())

### Name: FDist
### Title: The F Distribution
### Aliases: FDist df pf qf rf
### Keywords: distribution

### ** Examples

## the density of the square of a t_m is 2*dt(x, m)/(2*x)
# check this is the same as the density of F_{1,m}
x <- seq(0.001, 5, len=100)
all.equal(df(x^2, 1, 5), dt(x, 5)/x)

## Identity:  qf(2*p - 1, 1, df)) == qt(p, df)^2)  for  p >= 1/2
p <- seq(1/2, .99, length=50); df <- 10
rel.err <- function(x,y) ifelse(x==y,0, abs(x-y)/mean(abs(c(x,y))))
quantile(rel.err(qf(2*p - 1, df1=1, df2=df), qt(p, df)^2), .90)# ~= 7e-9

cleanEx(); ..nameEx <- "GammaDist"

### * GammaDist

flush(stderr()); flush(stdout())

### Name: GammaDist
### Title: The Gamma Distribution
### Aliases: GammaDist dgamma pgamma qgamma rgamma
### Keywords: distribution

### ** Examples

-log(dgamma(1:4, shape=1))

p <- (1:9)/10
pgamma(qgamma(p,shape=2), shape=2)

1 - 1/exp(qgamma(p, shape=1))

cleanEx(); ..nameEx <- "Geometric"

### * Geometric

flush(stderr()); flush(stdout())

### Name: Geometric
### Title: The Geometric Distribution
### Aliases: Geometric dgeom pgeom qgeom rgeom
### Keywords: distribution

### ** Examples

qgeom((1:9)/10, prob = .2)

Ni <- rgeom(20, prob = 1/4); table(factor(Ni, 0:max(Ni)))

cleanEx(); ..nameEx <- "Harman23.cor"

### * Harman23.cor

flush(stderr()); flush(stdout())

### Name: Harman23.cor
### Title: Harman Example 2.3
### Aliases: Harman23.cor
### Keywords: datasets

### ** Examples

data(Harman23.cor)
(Harman23.FA <- factanal(factors = 1, covmat = Harman23.cor))

for(factors in 2:4) print(update(Harman23.FA, factors = factors))