{
tol <- 1e-6
T
}

{
#q                          
exists("q", mode="function")
}

{
#qbeta
abs(qbeta(.5,1,2)-0.2928932188) < tol
}

{
#qbinom
abs(qbinom(.2,10,.5) - 4) < tol
}

{
#qcauchy
abs(qcauchy(.8) - 1.37638192) < tol
}

{
#qchisq
abs(qchisq(.9,3) - 6.251388631) < tol
}

{
#qexp
abs(qexp(.5) - 0.693147180) < tol
}

{
#qf
abs(qf(.5,3,2) - 1.1349429226) < tol
}

{
#qgamma
abs(qgamma(.5,5)  - 4.6709088828) < tol
}

{
#qgeom
abs(qgeom(.4,.2) - 2) < tol
}

{
#qhyper
abs(qhyper(.5,4,6,5)-2) < tol
}

{
#qlnorm
abs(qlnorm(.4) - 0.7761984141) < tol
}

{
#qlogis
abs(qlogis(.6) - 0.405465108) < tol
}

{
#qnbinom
abs(qnbinom(.5,2,.2) - 7) < tol
}

{
#qnorm
abs(qnorm(.2) + 0.8416212336) < tol
}

{
#qpois
abs(qpois(.8,1) - 2) < tol
}

{
#qr
steam.qr <- qr(steam.x)
all(dim(steam.qr$qr)==dim(steam.x))
}

{
#qr.Q
all(dim(qr.Q(steam.qr))==c(25,9))
}

{
#qr.R
all(dim(qr.R(steam.qr))==c(9,9))
}

{
#qr.X
all(dim(qr.X(steam.qr))==c(25,9))
}

{
#qr.coef
qr.coef(steam.qr,1:25)["Fatty Acid"] + 1.9586988067 < tol
}

{
#qr.fitted
length(qr.fitted(steam.qr,1:25))==25
}

{
#qr.qty
length(qr.qty(steam.qr,1:25))==25
}

{
#qr.qy
length(qr.qy(steam.qr,1:25))==25
}

{
#qr.resid
length(qr.resid(steam.qr,1:25))==25
}

{
#qr.rtr.inv
all(dim(qr.rtr.inv(steam.qr))==c(9,9))
}

{
#qstab                      # No stable quantile function
T
}

{
#qt
qt(.5,23)<tol
}

{
#quantile
all(quantile(car.miles)-c(88.70,193.00,206.00,215.95,379.80)<tol)
}

{
#quasi
quasi()$family[1]=="Quasi-likelihood"
}

{
#quickvu                    # Interactive.
exists("quickvu")
}

{
#qunif
abs(qunif(.5)-.5) < tol
}

{
#qweibull
abs(qweibull(.5,23) - 0.98419095) < tol
}

{
#qwilcox
abs(qwilcox(.5,4,6) -22 )< tol
}

{
##random
   # Need these for later tests:
   x <- factor(c(1,2,1,2,2,2,1,1,2,1,2,1),labels=c("a","b"))
   y <- factor(c(1,2,2,2,1,1,2,1,2,1,1,2),labels=c("c","d"))
   T
#cat("Expect 'all.wam convergence' warning. vvv\n")
#fit <- gam(y~random(x,df=2))
#abs(fit$nl.df -2 )< tol
}

{
#randomize
mydesign <- fac.design(rep(3,2))
perm <- randomize(mydesign,"A")
length(perm) == 9 
}

{
#range
all(range(lynx)-c(39,6991)< tol)
}

{
#rank
all(rank(1:4) == 1:4)
}

{
#raov
praov <- raov(Moisture ~ Batch/Sample, pigment)
class(praov)[1] == "aov"
}

{
#rbeta
all(rbeta(5,1,1) < 1 ) 
}

{
#rbind
foo <- rbind(x,y)
all(dim(foo) == c(2,12))
}

{
#rbinom
all(rbinom(10,40,.4) < 41)
}

{
#rbiwt
is.ts(rbiwt(corn.rain,corn.yield)$resid)
}

{
#rcauchy
length(rcauchy(10))==10
}

{
#rchisq
all(rchisq(10,10) > 1)
}

{
#read.table                  # Interactive
exists("read.table")
}

{
#readline                    # Interactive
exists("readline")
}

{
#rebld.formula               # Support for Functions step.glm(), update.formula
T
}

{
#remove                      
assign("xyz", 1, where=1)
remove("xyz", where=1)
! exists("xyz", w=1)
}

{
#rep
abs(prod(rep(1:3,3)) - 216) < tol
}

{
#rep.int                     # Used by rep() so tested!
T
}

{
#replace
x <- rep(1,12)
y <- replace(x,3,2)
abs(prod(y) - 2*prod(x) )< tol
}

{
#replace.                   # Support for Function terms()
T
}

{
#replications
replications(solder[,1:5])$Opening-300 < tol
}

{
#residuals
#residuals.default
corn.lm <- lm(corn.yield ~ corn.rain)
length(residuals.default(corn.lm))==38
}

{
#residuals.glm
corn.fac <- cut(corn.yield,2)
corn.glm <- glm(corn.fac==1~corn.rain,family=binomial)
length(residuals.glm(corn.glm))==38
}

{
#residuals.lm
length(residuals.lm(corn.lm))==38
}

{
#residuals.tree             # Tested after tree()
T
}

{
#restart                    # This is a function to be used only by the adept 
                            # and strong at  heart.
exists("restart", mode="function")
}

{
#restore
#x <- 1:10
#assign("x",x,w=1)
#dump("x")
#restore("dumpdata")
T
}

{
#rev
all(rev(5:1)==1:5)
}

{
#rexp
rexp(1,3) > tol
}

{
#rf
rf(1,10,10) > tol
}

{
#rgamma
rgamma(1,50) > tol
}

{
#rgeom
length(rgeom(3,.3))==3
}

{
#rhyper
all(rhyper(10,3,2,5) > 1)
}

{
#rle
x <- c(1,2,3,3,3,4,5)
rlex <- rle(x)
max(rlex$lengths)==3
}

{
#rlnorm
rlnorm(1) > 0
}

{
#rlogis
length(rlogis(12))==12
}

{
#rm                          # Tested above with restore()
T
}

{
#rnbinom
length(rbinom(20,10,0.5))==20
}

{
#rnorm
length(rnorm(10))==10
}

{
#robloc
abs(robloc(car.miles, resid=F)$mu - 204.41413879394 )< tol
}

{
#robust
T
}

{
#round
abs(round(1/3,2)-.33) < tol
}

{
#row
all(row(freeny.x))
}

{
#row.names
length(row.names(kyphosis))==81
}

{
#row.names<-
row.names(kyphosis) <- as.character(1:81)
row.names(kyphosis)[81]=="81"
}

{
#rpois
length(rpois(5,1))==5
}

{
#rreg
rreg(corn.rain,corn.yield)$int
}

{
#rstab
length(rstab(5,1))==5
}

{
#rt
length(rt(5,12))==5
}

{
#runif
all(runif(12)>tol)
}

{
#rweibull
length(rweibull(5,5))==5
}

{
#rwilcox
all(rwilcox(12,3,4)>5)
}

{
#s                          # Tested with gam()
T
}

{
#s.wam                      # Support for gam() and s()
T
}

{
#sabl
h <- sabl(hstart)
abs(frequency(h$trend) - frequency(hstart)) < tol
}

{
#safe.predict.gam           # Support for Function predict.gam()
T
}

{
#sample
samp.stat <- sample(state.name, 10)
is.character(samp.stat)
}

{
#sapply
abs(sapply(kyphosis,mean)[3]-4.049382716 )< tol
}

{
#sas.contents            # List the Variables in a SAS Dataset
#sas.datasets            # List SAS Datasets 
#sas.fget                # Indirectly Load SAS Data into S-PLUS
#sas.get                 # Convert a SAS Dataset to an S-PLUS Dataset
T
}
   if(platform() == "WIN386"){
      cat("WARNING: Skipping SAS tests. No SAS functions on WIN386!\n") 
      T } else {
      exists("sas.contents", mode="function")
      exists("sas.datasets", mode="function")
      exists("sas.fget", mode="function")
      exists("sas.get", mode="function")
   }
{
#scale
freeny.std <- scale(freeny.x)
mean(freeny.std[,2]) < tol
}

{
#scan                    # Interactive or need to create unix file
T
}

{
#search
all.dirs <- search()
is.character(all.dirs)
}

{
#select.tree                # Tested after tree()
T
}

{
#seq
all(seq(1,10)==1:10)
}

{
#set.seed
set.seed(12)
T
}

{
#setopti                    # Called by nlmin() No help file
T
}

{
#shbar.plot                 # Support for Function plot.factor()
T
}

{
#shrink.tree                # Tested after tree()
T
}

{
#sign
as.logical(sign(183))
}

{
#signif
abs(signif(1/3,digits=2) - .33) < tol
}

{
#signif.data.frame
freeny.df <- data.frame(Y=as.vector(freeny.y),X=freeny.x[,2:3])
freeny.sig <- signif.data.frame(freeny.df,2)
is.data.frame(freeny.sig)
}

{
#sin                        # Tested with cos() and tan()
T
}

{
#single
z <- single(10)
length(z) == 10
}

{
#sinh
sinh(0) < tol
}

{
	# sink() and source()
	temp <- tempfile()
	sink(temp)
	cat("source.sink <- 1\n")
	sink()
	source(temp)
	unlink(temp)
	source.sink == 1
}

{
#smooth
length(smooth(lynx))==114
}

{
#smooth.spline
fit <- smooth.spline(corn.rain,corn.yield)
abs(round(fit$pen.crit - 380.99649210799947 ,3))<tol
}

{
#predict.smooth.spline
length(predict.smooth.spline(fit)$y)==31
}

{
#snip.tree                   # Tested with other tree() functions
T
}

{
#solve.default
xmat <- matrix(1:4,2,2)
xmat.inv <- solve.default(xmat)
all(diag(xmat %*% xmat.inv) - 1 < tol )
}

{
#solve.qr
xqr <- qr(xmat)
xmat.inv <- solve.qr(xqr)
all(diag(xmat %*% xmat.inv) - 1 < tol )
}

{
#solve.svd.right             # I don't know what this is
T
}

{
#solve.upper                 #  .. or this
T
}

{
#sort
all(sort(c("b","f","a"))==c("a","b","f"))
}

{
#sort.list
all(sort.list(c("b","f","a"))==c(3,1,2))
}

{
#source               
# tested with sink()
T
}

{
#spec.ar
ll.ar <- ar(log(lynx))
ll.spec.ar <- spec.ar(ll.ar, plot=F)
ll.spec.ar$order == 11
}

{
#spec.pgram
spec <- spec.pgram(log(lynx),plot=F)
spec$method == "Raw Periodogram"
}

{
#spec.smo
length(spec.smo(lynx,3,2))==114
}

{
#spec.taper
hstaper <- spec.taper(hstart)
all(end(hstaper,form=T)==c(1974,12))
}

{
#specs.loess
gas.m <- loess(NOx ~ E, data = gas, span = 2/3)
gas.specs <- specs(gas.m)
gas.specs <- specs.loess(gas.m)
gas.specs$COMPUTING$method == "loess"
}

#{
##specs.stl
#co2.m <- stl(co2, ss.window = 17, fc.window = c(101, 25),fc.degree = c(1, 2))
#co2.specs <- specs.stl(co2.m)
#is.character(co2.specs)
#}

{
#spectrum
spectrum(log(lynx),plot=F)$method == "Raw Periodogram"
}

{
#spline
length(spline(steam.x[,1],steam.y)$x) == 70
}

{
#spline.des                 # Support for the functions bs and ns.
T
}

{
#split
length(split(ship, cycle(ship))) == 12
}

{
#sqrt
abs(sqrt(2) - 1.414213562) < tol
}

{
#stamp
x <- stamp(print=F)	# the date
is.character(x) && nchar(x) > 0
}

{
#start
start(lynx)[1] == 1821
}

{
#stat.anova                  # Support for anova.gam anova.glm
exists("stat")
exists("stat.anova")
}

{
#std.factor.names            # Support for design(), fac.design(), etc.
T
}

{
#std.trace
exists("std.trace")
}

{
#std.xtrace
exists("std.xtrace")
}

{
#step.gam                    # Tested after gam()
#step.glm                    # Tested after glm()
T
}

{
#stepfun
x <- 1:5
y <- lynx[1:5]
step.xy <- stepfun(x,y)
length(step.xy$x) == 9
}

{
#stepwise
z1 <- stepwise(evap.x, evap.y)
abs(z1$rss[1] - 3071.255085) < tol
}

{
#stl                        # Tested above with specs.stl()
exists("stl")
}

{
#stl.control
stl.control()$surface == "interpolate"
}

{
#stop
exists("stop")              # Hard to test otherwise
}

{
#storage
any(names(storage())=="freed")
}

{
#storage.mode
storage.mode(freeny.x) == "double"
}

{
#storage.mode<-
x <- 1
storage.mode(x)<-"integer"
storage.mode(x) == "integer"
}

{
#strip.null                 # No HELP file
T
}

{
#structure
xstr <- structure(1:12, dim=c(3, 4))
is.matrix(xstr)
}

{
#substitute
x <- 1
xname <- substitute(x)
xname <- deparse(xname)
is.character(xname)
}

{
#substring
substring("hello",1,4) == "hell"
}

{
#subtree
votes.clust <- hclust(dist(votes.repub), "ave")
# LSG 6/30/93: Replaced old test with one that passes on all platforms:
#abs(subtree(votes.clust,c(1,10))$height - 48.23969269) < tol
abs(subtree(votes.clust,c(1,10))$height - 48.23969269) < 4*tol
}

{
#sum
abs(sum(1:12) - 78) < tol
}

{
#summary.aov
gun.aov <- aov(Rounds ~ Method + Physique/Team, gun)
gun.sum <- summary.aov(gun.aov)
all(class(gun.sum) == c("anova", "data.frame"))
}

{
#summary.aovlist
pig.aov <- aov(Moisture~Batch*Sample+Error(Test),data=pigment)
pig.sum <- summary.aovlist(pig.aov)
any(names(pig.sum)=="Error: Within")
}

{
#summary.data.frame
kyph.sum <- summary.data.frame(kyphosis)
all(class(kyph.sum)==c("table","matrix"))
}

{
#summary.default
lynx.sum <- summary.default(lynx)
abs(round(lynx.sum[4] - mean(lynx))) < tol
}

{
#summary.factor
xfac <- factor(c(1,2,1,2,1,2,2,2),labels=c("dog","cat"))
sumfac <- summary.factor(xfac)
abs(sumfac[[2]] -5) < tol
}

{
#summary.gam                # Already tested with gam()
T
}

{
#summary.glm                # Already tested with glm()
T
}

{
#summary.lm
free.lm <- lm(freeny.x~freeny.y)
free.sum <- summary.lm(free.lm)
abs(free.sum$r.squared - 0.9999707937 )< tol
}

{
#summary.loess
gas.sum <- summary.loess(gas.m)
abs(gas.sum$covariance - 0.9649198055 )< tol
}

{
#summary.mlm
freeny.lm <- lm(freeny.y~freeny.x[,1:2])
free.sum <- summary.mlm(freeny.lm)
is.matrix(free.sum)
}

{
#summary.ms
exists("summary.ms")
}

{
#summary.nls
exists("summary.nls")
}

{
#summary.ordered
xord <- ordered(xfac)
summary.ordered(xord)[1] == 3
}

{
#summary.tree               # Tested after tree()
T
}

{
#supsmu
corn.sup <- supsmu(corn.rain,corn.yield)
abs(max(corn.sup$x) - 16.5) < tol
}

{
#surv.diff
tim <- c(1,2,3,1,2,4,5,4)
sta <- c(0,1,0,1,0,1,0,0)
grp <- c(1,1,1,1,2,2,2,2)
sdf <- surv.diff(tim,sta,grp)
abs(sdf$chisq - 2.882353 )< tol
}

{
#surv.fit
sf <- surv.fit(tim,sta)
abs(sf$surv[1] - 0.8750000) < tol
}

{
#svd
abs(svd(xmat)$u[1,1] + 0.5760484) < tol
}

{
#sweep
a <- steam.x
a <- sweep(a,2,apply(a,2,mean))
mean(a) < tol
}

{
#switch
x <- 2
switch(x,2,T)
}

{
#symbol.C
a <- symbol.C("dgedi")
is.character(a)
}

{
#symbol.For
a <- symbol.For("dgedi")
is.character(a)
}

{
#symbol.S
a <- symbol.S("dgedi")
is.character(a)
}

{
#synchronize
exists("synchronize")
}

{
#sys.call
exists("sys.call")
}

{
#sys.calls
exists("sys.calls")
}

{
#sys.frame
exists("sys.frame")
}

{
#sys.frames
exists("sys.frames")
}

{
#sys.function
exists("sys.function")
}

{
#sys.nframe
exists("sys.nframe")
}

{
#sys.on.exit
exists("sys.on.exit")
}

{
#sys.parent
exists("sys.parent")
}

{
#sys.parents
exists("sys.parents")
}

{
#sys.status
exists("sys.status")
}

{
#sys.trace
exists("sys.trace")
}