> # test.plotd.R
> 
> source("test.prolog.R")
> library(earth)
Loading required package: Formula
Loading required package: plotmo
Loading required package: plotrix
Loading required package: TeachingDemos
> data(etitanic)
> 
> printh <- function(caption)
+     cat("===", caption, "\n", sep="")
> 
> multifigure <- function(caption)
+ {
+     printh(caption)
+     par(mfrow=c(2, 2))
+     par(cex = 0.7)
+     par(mar = c(4, 3, 1.7, 0.5))    # small margins and text to pack figs in
+     par(mgp = c(1.6, 0.6, 0))       # flatten axis elements
+     oma <- par("oma") # make space for caption
+     oma[3] <- 2.4
+     par(oma=oma)
+ }
> do.caption <- function(caption)
+     mtext(caption, outer=TRUE, font=2, line=1, cex=1)
> old.par <- par(no.readonly=TRUE)
> 
> # test plotd basic functionality on a numeric response
> 
> multifigure("a1") # start a new page
===a1
> a1 <- earth(survived ~ ., data=etitanic, degree=2, glm=list(family=binomial))
> 
> plotd(a1)
> do.caption("a1")
> 
> plotd(a1, main="earth-glm, numeric, kernel=epan adjust=.3", trace=TRUE,
+       kernel="epan", adjust=.3, legend.names=c("mylegend", "mylegend2"),
+       legend.pos=c(.3,4), cex.legend=1, legend.extra=TRUE,
+       col=c(1, "green"), fill="red")
observed response: numeric or logical vector
predicted response: numeric or logical vector   (predict type is "response")
grouping criterion: CLASS1 survived == 0, CLASS2 survived != 0
        predicted.response.per.class[not survived][619,1] with no column names, and values 0.9485, 0.4324, 0.9485, 0.369...
        predicted.response.per.class[survived    ][427,1] with no column names, and values 0.9485, 0.9669, 0.2946, 0.851...

> 
> plotd(a1, main="earth-glm, numeric, type=earth, params",
+       type="earth", xlab="my xlab", ylab="my ylab",
+       legend.pos="topleft", xlim=c(-.5, 1.5), zero.line=TRUE, vline.col="green",
+       col=c("pink", "red"), fill="pink")
> 
> plotd(a1, main="earth-glm, numeric, type=link, params", type="link", legend=FALSE,
+       col=c("red", "blue"), lty=c(1,2),
+       vline.thresh=1, vline.col="gray", vline.lty=2)
> 
> # test with earth.default (as opposed to earth.formula)
> multifigure("a2") # start a new page
===a2
> a2 <- earth(etitanic[,-2], etitanic$survived, degree=2, glm=list(family=binomial))
> plotd(a2, main="earth.default-glm, numeric response")
> do.caption("a2")
> 
> printh("a3")
===a3
> a3 <- earth(etitanic[,-1], etitanic$pclass, degree=2, glm=list(family=binomial))
> plotd(a3, main="earth.default-glm, 3 lev fac")
> 
> # test plotd with histograms
> 
> plotd(a3, main="earth-glm, 3 lev fac, hist", hist=TRUE)
> 
> plotd(a3, main="earth-glm, 3 lev fac, hist, params",
+       hist=TRUE, col=c("green", "red", "black"), fill="pink", lty=c(1,3),
+       xlab="my xlab", ylab="my ylab", xlim=c(-.2, 1.2),
+       vline.thresh=.65, vline.col="brown", vline.lty=2, breaks=5)
> 
> # xlim and ylim tests
> 
> multifigure("xlim and ylim tests") # start a new page
===xlim and ylim tests
> plotd(a1, xlim=c(.25,.75), fill="gray")
> printh("xlim and ylim tests")
===xlim and ylim tests
> plotd(a1, xlim=c(.25,1), ylim=c(0,2))
> plotd(a1, xlim=c(.25,.75), hist=TRUE)
> plotd(a1, xlim=c(.25,1), ylim=c(0,100), hist=TRUE)
> 
> # test plotd with a logical response
> 
> multifigure("a5")
===a5
> bool.survived <- as.logical(etitanic$survived)
> a5 <- earth(bool.survived ~ . - survived, data=etitanic, degree=2, glm=list(family=binomial))
> plotd(a5, main="earth-glm, logical")
> do.caption("a5")
> plotd(a5, main="earth-glm, logical, hist", hist=TRUE)
> 
> # test plotd with a two level factor
> 
> multifigure("a6")
===a6
> a6 <- earth(sex ~ ., data=etitanic, glm=list(family=binomial))
> plotd(a6, main="earth-glm, 2 lev fac", fill="gray70")
> do.caption("a6")
> plotd(a6, main="earth-glm, 2 lev fac, type=class", type="class", fill="gray70")
> plotd(a6, main="earth-glm, 2 lev fac, hist ", hist=TRUE)
> plotd(a6, main="earth-glm, 2 lev fac, hist, type=class", type="class", hist=TRUE, labels=TRUE)
> 
> # test plotd with a 3 level factor
> 
> multifigure("a7")
===a7
> a7 <- earth(pclass ~ ., data=etitanic, glm=list(family=binomial))
> 
> plotd(a7, main="earth-glm, 3 lev fac",
+       col=c("pink", "red", "brown"), fill="pink")
> do.caption("a7")
> 
> plotd(a7, main="earth-glm, 3 lev fac, params",
+       xlab="my xlab", ylab="my ylab", xlim=c(-.2, 1.2),
+       col=c("pink", "black", "green"), lty=c(1,3,1),
+       vline.thresh=.2, vline.col="blue", vline.lty=3,
+       adjust=.3)
> 
> plotd(a7, main="earth-glm, 3 lev fac, hist", hist=TRUE)
> 
> plotd(a7, main="earth-glm, 3 lev fac, hist, params",
+       hist=TRUE, col=c("pink", "red", "black"), fill=c("pink"), lty=c(1,2,3),
+       xlab="my xlab", ylab="my ylab", xlim=c(-.2, 1.2),
+       vline.thresh=.65, vline.col="gray", vline.lty=1,
+       breaks=5)
> 
> multifigure("a7 part 2")
===a7 part 2
> plotd(a7, type="class", main="earth-glm, 3 lev fac, type=class", fill="gray70")
> do.caption("a7 part 2")
> plotd(a7, type="class", main="earth-glm, 3 lev fac, hist, type=class", hist=TRUE, labels=TRUE)
> 
> # test nresponse
> 
> multifigure("a7 with nresponse")
===a7 with nresponse
> plotd(a7, main="earth.default-glm, 3 lev fac")
> do.caption("a7  with nresponse")
> plotd(a7, main="earth.default-glm, 3 lev fac, nresp=1", nresp=1)
> plotd(a7, main="earth.default-glm, 3 lev fac, nresp=2", nresp=2)
> #plotd(a7, main="earth.default-glm, 3 lev fac, nresp=c(1,2)", nresp=c(1,2))
> 
> # test plotd with earth not glm
> 
> multifigure("a8")
===a8
> a8 <- earth(survived ~ ., data=etitanic, degree=2)
> plotd(a8, main="earth, numeric, no glm arg")
> do.caption("a8")
> plotd(a8, main="earth, hist, num, no glm arg, type=class", hist=TRUE, type="class")
> 
> printh("a9")
===a9
> a9 <- earth(survived - .5 ~ .-survived, data=etitanic, degree=2)
> plotd(a9, main="earth, survived-.5, type=class, thresh=0", hist=TRUE, type="class",thresh=0,vline.col="brown",xaxis.cex=.8, fill="pink",breaks=4,labels=TRUE)
> plotd(a9, main="earth, survived-.5, type=class, thresh=0.3", hist=TRUE, type="class",thresh=0.3,vline.col="brown", xaxis.cex=.7,breaks=3,labels=TRUE)
> 
> multifigure("a10")
===a10
> bool.survived <- as.logical(etitanic$survived)
> a10 <- earth(bool.survived ~ . - survived, data=etitanic, degree=2)
> plotd(a10, main="earth, logical, no glm arg")
> do.caption("a10")
> 
> printh("a11")
===a11
> a11 <- earth(sex ~ ., data=etitanic, degree=2)
> plotd(a11, main="earth, 2 lev fac, no glm arg")
> 
> printh("a12")
===a12
> a12 <- earth(pclass ~ ., data=etitanic, degree=2)
> plotd(a12, main="earth, 3 lev fac, no glm arg")
> 
> # test that we can change the order of the levels and still get the same results
> multifigure("compare pclass with different factor levels")
===compare pclass with different factor levels
> printh("fit.pclass")
===fit.pclass
> fit.pclass <- earth(pclass ~ ., data=etitanic, degree=2)
> plotd(fit.pclass, type="class", hist=1, main="fit.pclass", fill=0,
+            col=c(2, 1, "lightblue"))
> do.caption("left and right graphs should match, up to level order")
> printh("fit.pclass.reorder")
===fit.pclass.reorder
> tit <- etitanic
> pclass <- as.character(tit$pclass)
> pclass[pclass == "1st"] <- "first"
> pclass[pclass == "2nd"] <- "class2"
> pclass[pclass == "3rd"] <- "classthird"
> tit$pclass <- factor(pclass, levels=c("class2", "classthird", "first"))
> fit.pclass.reorder <- earth(pclass ~ ., data=tit, degree=2)
> plotd(fit.pclass.reorder, type="class", hist=1, main="fit.pclass.reorder",
+       col=c(1, "lightblue", 2), fill=0, legend.pos="topright")
> 
> # examples from the man page
> 
> printh("example(plotd)")
===example(plotd)
> example(plotd)

plotd> if (require(earth)) {
plotd+     old.par <- par(no.readonly=TRUE);
plotd+     par(mfrow=c(2,2), mar=c(4, 3, 1.7, 0.5), mgp=c(1.6, 0.6, 0), par(cex = 0.8))
plotd+     data(etitanic)
plotd+     mod <- earth(survived ~ ., data=etitanic, degree=2, glm=list(family=binomial))
plotd+ 
plotd+     plotd(mod)
plotd+ 
plotd+     plotd(mod, hist=TRUE, legend.pos=c(.25,220))
plotd+ 
plotd+     plotd(mod, hist=TRUE, type="class", labels=TRUE, xlab="", xaxis.cex=.8)
plotd+ 
plotd+     par(old.par)
plotd+ }
> do.caption("example(plotd)")
> 
> multifigure("glm.model example from man page")
===glm.model example from man page
> library(earth); data(etitanic)
> glm.model <- glm(sex ~ ., data=etitanic, family=binomial)
> plotd(glm.model)
> do.caption("glm.model example from man page")
> 
> printh("lm.model example from man page")
===lm.model example from man page
> library(earth); data(etitanic)
> lm.model <- lm(as.numeric(sex) ~ ., data=etitanic)
> plotd(lm.model, trace=2)
plotd trace 2: plotd(object=lm.model, trace=2)
object call is lm(formula=as.numeric(sex)~., data=etitanic)
--get.model.env for lm object
using the environment saved with the lm model: R_GlobalEnv
--plotmo_prolog for lm object lm.model
observed response[1046,1]:
     as.numeric(sex)
1                  1
2                  2
3                  1
...                2
1046               2

calling predict.lm with NULL newdata
stats::predict(lm.object, NULL, type="response")
predict returned[1046,1] with no column names:
             
1    1.392914
2    1.212219
3    1.733813
...  1.723106
1309 1.882905
predict after processing with nresponse=NULL is [1046,1] with no column names:
             
1    1.392914
2    1.212219
3    1.733813
...  1.723106
1309 1.882905
single column yhat

observed response: numeric or logical vector
predicted response: numeric or logical vector   (predict type is "response")
grouping criterion: CLASS1 as.numeric(sex) == 1, CLASS2 as.numeric(sex) != 1

predicted.response.per.class[as.numeric(sex) == 1][388,1] with no column names:
            
1   1.392914
2   1.733813
3   1.725018
... 1.353087
388 1.861625

predicted.response.per.class[as.numeric(sex) != 1][658,1] with no column names:
            
1   1.212219
2   1.723106
3   1.385648
... 1.911098
658 1.882905

> plot(1,1) # empty.plot
> plot(1,1)
> 
> # test with rpart (also test nresponse with a character value)
> printh("rpart")
===rpart
> library(rpart); library(earth); data(etitanic)
> rpart.model <- rpart(sex ~ ., data = etitanic, method="class")
> plotd(rpart.model, type="prob", nresponse="female")
> plotd(rpart.model, type="prob", nresponse="ma")
> plotd(rpart.model, type="class", hist=TRUE, labels=TRUE)
> plotd(rpart.model, hist=TRUE, labels=TRUE) # default type is "vector"
> 
> printh("lda.model examples from man pages")
===lda.model examples from man pages
> library(MASS); library(earth); data(etitanic)
> lda.model <- lda(sex ~ ., data=etitanic)
> plotd(lda.model, type="response")
> plotd(lda.model, hist=TRUE, labels=TRUE)
> 
> library(MASS); library(earth); set.seed(420)
> example(lda)

lda> Iris <- data.frame(rbind(iris3[,,1], iris3[,,2], iris3[,,3]),
lda+                    Sp = rep(c("s","c","v"), rep(50,3)))

lda> train <- sample(1:150, 75)

lda> table(Iris$Sp[train])

 c  s  v 
30 22 23 

lda> ## your answer may differ
lda> ##  c  s  v
lda> ## 22 23 30
lda> z <- lda(Sp ~ ., Iris, prior = c(1,1,1)/3, subset = train)

lda> predict(z, Iris[-train, ])$class
 [1] s s s s s s s s s s s s s s s s s s s s s s s s s s s s c c c c c c c c c c
[39] c c c c c c c c c c v v v v v v v v v v v v v v v v v v c c v v v v v v v
Levels: c s v

lda> ##  [1] s s s s s s s s s s s s s s s s s s s s s s s s s s s c c c
lda> ## [31] c c c c c c c v c c c c v c c c c c c c c c c c c v v v v v
lda> ## [61] v v v v v v v v v v v v v v v
lda> (z1 <- update(z, . ~ . - Petal.W.))
Call:
lda(Sp ~ Sepal.L. + Sepal.W. + Petal.L., data = Iris, prior = c(1, 
    1, 1)/3, subset = train)

Prior probabilities of groups:
        c         s         v 
0.3333333 0.3333333 0.3333333 

Group means:
  Sepal.L. Sepal.W. Petal.L.
c 5.910000 2.746667 4.250000
s 5.036364 3.490909 1.459091
v 6.565217 2.939130 5.573913

Coefficients of linear discriminants:
                LD1        LD2
Sepal.L.  0.8709036 -0.3591731
Sepal.W.  1.1535614  2.7990902
Petal.L. -2.8007048  0.5780621

Proportion of trace:
   LD1    LD2 
0.9903 0.0097 
> plotd(z, type="response", nresponse=1) # nresponse=1 selects first linear discriminant
> do.caption("lda.model example from example(lda)")
> 
> a.qda <- qda(survived ~ ., data=etitanic)
> plotd(a.qda)
> plotd(a.qda, type="post")
> 
> # test plotd with lm models
> 
> multifigure("lm1")
===lm1
> lm1 <- lm(survived ~ ., data=etitanic)
> plotd(lm1)
> do.caption("lm1")
> plotd(lm1, main="lm1, survived")
> plotd(lm1, hist=TRUE, main="lm1, survived, hist=TRUE, labels=1", labels=1)
> 
> printh("lm2")
===lm2
> bool.survived <- as.logical(etitanic$survived)
> lm2 <- lm(bool.survived ~ . - survived, data=etitanic)
> plotd(lm2, main="lm, logical")
> 
> # following commented out because lm doesn't like factor responses(?)
> # printh("lm3")
> # lm3 <- lm(sex ~ ., data=etitanic)
> # plotd(lm3, main="lm, 2 lev fac")
> #
> # printh("lm4")
> # lm4 <- lm(pclass ~ ., data=etitanic)
> # plotd(lm4, main="lm, 3 lev fac")
> 
> multifigure("lm5")
===lm5
> lm5 <- lm(age - mean(age)~ ., data=etitanic)
> plotd(lm5, main="lm5, age - mean(age)")
> do.caption("lm5")
> 
> printh("lm6")
===lm6
> lm6 <- lm(unclass(pclass)-1 ~ ., data=etitanic)
> plotd(lm6, main="lm6, unclass(pclass)-1")
> plotd(lm6, main="lm6, unclass(pclass)-1, fac=TRUE", hist=TRUE)
> 
> printh("lm7")
===lm7
> lm7 <- lm(cbind(survived, sin(age)) ~ ., data=etitanic) # nonsense model
> plotd(lm7, xlim=c(-.5,1.5), hist=TRUE, main="lm7, NCOL(y)==2")
> 
> multifigure("lm5")
===lm5
> lm8 <- lm(cbind(survived, sin(age), cos(age)) ~ ., data=etitanic) # nonsense model
> plotd(lm8, hist=TRUE, main="lm8, NCOL(y)==3")
> do.caption("lm8")
> 
> # test plotd with glm models
> 
> multifigure("glm1")
===glm1
> glm1 <- glm(survived ~ ., data=etitanic, family=binomial)
> plotd(glm1, main="glm1, survived")
> do.caption("glm1")
> 
> printh("glm2")
===glm2
> glm2 <- glm(pclass ~ ., data=etitanic, family=binomial)
> plotd(glm2, main="glm2, pclass")
> 
> printh("glm3")
===glm3
> glm3 <- glm(sex ~ ., data=etitanic, family=binomial)
> plotd(glm3, main="glm3, sex")
> 
> multifigure("glm, 3 level factor with dichot")
===glm, 3 level factor with dichot
> glm4 <- glm(pclass ~ ., data=etitanic, family=binomial)
> plotd(glm4, dichot = TRUE, type="link")
> do.caption("glm, 3 level factor with dichot")
> plotd(glm4, dichot = FALSE, type="link")
> plotd(glm4, dichot = TRUE) # default type="response"
> plotd(glm4, dichot = FALSE, type=NULL) # default type="response"
> 
> # lda with formula interface
> 
> library(MASS)
> multifigure("lda1")
===lda1
> lda1 <- lda(sex ~ ., data=etitanic)
> plotd(lda1, main="lda1, 2 lev fac", trace=1)
observed response: two-level factor
predicted response: numeric or logical vector   (predict type is "class")
grouping criterion: CLASS1 predicted[observed == female], CLASS2 predicted[observed == male]
        predicted.response.per.class[female][388,1] with no column names, and values 1, 2, 2, 1, 1, 1, 1, 1, 1, 1,...
        predicted.response.per.class[male  ][658,1] with no column names, and values 1, 2, 1, 2, 2, 2, 1, 2, 2, 1,...

> do.caption("lda1")
> plotd(lda1, main="lda1, 2 lev fac, hist=TRUE", type="response", hist=TRUE)
> plotd(lda1, main="lda1, 2 lev fac, hist=TRUE, type=post", hist=TRUE, type="post")
> plotd(lda1, main="lda1, 2 lev fac, hist=TRUE, type=class", hist=TRUE, type="class", labels=TRUE)
> 
> multifigure("lda2")
===lda2
> lda2 <- lda(pclass ~ ., data=etitanic)
> plotd(lda2, type="response", main="lda2, 3 lev fac, nresponse=1", jitter=TRUE, nresponse=1)
> do.caption("lda2")
> plotd(lda2, type="response", main="lda2, 3 lev fac, nresponse=1", jitter=TRUE, nresponse=1)
> plotd(lda2, type="response", main="lda2, 3 lev fac, nresponse=2", jitter=TRUE, nresponse=2)
> # plotd(lda2, main="lda2, 3 lev fac, nresponse=NULL", jitter=TRUE, nresponse=NULL)
> 
> multifigure("lda2 part 2")
===lda2 part 2
> # plotd(lda2, type="response", main="lda2, 3 lev fac, hist=TRUE", hist=TRUE)
> plotd(lda2, main="lda2, 3 lev fac, hist=TRUE, type=p, nresponse=1", hist=TRUE, type="p", nresponse=1)
> do.caption("lda2 part 2")
> plotd(lda2, main="lda2, 3 lev fac, type=p", type="p")
> plotd(lda2, main="lda2, 3 lev fac, hist=TRUE, type=class, nresponse=1", hist=TRUE, type="class", nresponse=1)
> 
> multifigure("lda2 with dichot")
===lda2 with dichot
> plotd(lda2, main="lda2, 3 lev fac, type=p, nresponse=1", hist=TRUE, type="p", nresponse=1)
> do.caption("lda2 with dichot")
> plotd(lda2, main="lda2, 3 lev fac, dichot=1, type=p, nresponse=1", hist=TRUE, type="p", nresponse=1, dichot=TRUE)
> plotd(lda2, main="lda2, 3 lev fac, type=p, nresponse=1", type="p", nresponse=1)
> plotd(lda2, main="lda2, 3 lev fac, dichot=1, type=p, nresponse=1", type="p", nresponse=1, dichot=TRUE)
> 
> multifigure("lda3")
===lda3
> lda3 <- lda(survived ~ ., data=etitanic)
> plotd(lda3, type="response", main="lda3, logical")
> do.caption("lda3")
> plotd(lda3, type="response", main="lda3, logical, hist=TRUE", hist=TRUE)
> plotd(lda3, main="lda3, logical, hist=TRUE, type=posterior", hist=TRUE, type="posterior")
> plotd(lda3, main="lda3, logical, hist=TRUE, type=class", hist=TRUE, type="class", labels=TRUE)
> 
> # lda with default interface
> 
> # predict.lda (called by plotd) can't deal with factors in x argument
> etitanic1 <- etitanic
> etitanic1[,1] <- as.numeric(etitanic1[,1]) # pclass
> etitanic1[,3] <- as.numeric(etitanic1[,3]) # sex
> 
> multifigure("ldad1")
===ldad1
> ldad1 <- lda(etitanic1[,-3], etitanic$sex)
> plotd(ldad1, type="response", main="ldad1, 2 lev fac")
> do.caption("ldad1")
> plotd(ldad1, type="response", main="ldad1, 2 lev fac, hist=TRUE", hist=TRUE)
> plotd(ldad1, main="ldad1, 2 lev fac, hist=TRUE, type=post", hist=TRUE, type="post")
> plotd(ldad1, main="ldad1, 2 lev fac, hist=TRUE, type=class", hist=TRUE, type="class")
> 
> multifigure("ldad2")
===ldad2
> ldad2 <- lda(etitanic1[,-1], etitanic$pclass)
> # plotd(ldad2, type="response", main="ldad2, 3 lev fac", jitter=TRUE)
> plotd(ldad2, type="response", main="ldad2, 3 lev fac, nresponse=1", jitter=TRUE, nresponse=1)
> do.caption("ldad2")
> plotd(ldad2, type="response", main="ldad2, 3 lev fac, nresponse=2", jitter=TRUE, nresponse=2)
> multifigure("ldad2 part 2")
===ldad2 part 2
> plotd(ldad2, type="response", main="ldad2, 3 lev fac, hist=TRUE, nresponse=1", hist=TRUE, nresponse=1)
> do.caption("ldad2 part 2")
> plotd(ldad2, main="ldad2, 3 lev fac, hist=TRUE, type=p, nresponse=1", hist=TRUE, type="p", nresponse=1)
> plotd(ldad2, main="ldad2, 3 lev fac, type=p, nresponse=1", type="po", nresponse=1)
> plotd(ldad2, main="ldad2, 3 lev fac, hist=TRUE, type=class, nresponse=1", hist=TRUE, type="cla", nresponse=1)
> 
> multifigure("ldad3")
===ldad3
> ldad3 <- lda(etitanic1[,-2], etitanic$survived)
> plotd(ldad3, type="response", main="ldad3, logical")
> do.caption("ldad3")
> plotd(ldad3, type="response", main="ldad3, logical, hist=TRUE", hist=TRUE)
> plotd(ldad3, main="ldad3, logical, hist=TRUE, type=post", hist=TRUE, type="post")
> plotd(ldad3, main="ldad3, logical, hist=TRUE, type=cl", hist=TRUE, type="cl")
> 
> # err shading
> 
> multifigure("err shading")
===err shading
> a.shade <- earth(survived ~ ., data=etitanic, degree=2, glm=list(family=binomial))
> plotd(a.shade, vline.col="gray", err.col=c("slategray1","slategray3"), fill=0)
> do.caption("err shading")
> plotd(a.shade, vline.col="gray", err.col=c(0, 0,"pink"), fill=0, vline.thresh = .6, err.border=c(0,0,2))
> # try various err.shade options
> plotd(a.shade, vline.thresh = .7, vline.col=1, vline.lty=2, vline.lwd=3, fill=0, col=c(2,1),
+       err.col=c("slategray1","slategray3","pink"),
+       err.border=c(3,4,5), err.lwd=c(1,2,3))
> # reverse direction of reducible error area
> a1.shade <- earth(!survived ~ ., data=etitanic, degree=2, glm=list(family=binomial))
> plotd(a1.shade, vline.col="gray", err.col=c("slategray1","slategray3","pink"), err.border=c("slategray1","slategray3","red"))
> 
> # clip xlim into the shaded area and make sure area is still shaded correctly
> multifigure("err shading with xlim")
===err shading with xlim
> a.shade <- earth(survived ~ ., data=etitanic, degree=2, glm=list(family=binomial))
> plotd(a.shade, vline.thresh = .7, vline.col=1, vline.lty=2, vline.lwd=3, fill=0, col=c(2,1),
+       err.col=c("slategray1","slategray3","pink"),
+       err.border=c(3,4,5), err.lwd=c(1,2,3), xlim=c(.3,1))
> plotd(a.shade, vline.thresh = .7, vline.col=1, vline.lty=2, vline.lwd=3, fill=0, col=c(2,1),
+       err.col=c("slategray1","slategray3","pink"),
+       err.border=c(3,4,5), err.lwd=c(1,2,3), xlim=c(.5,1))
> plotd(a.shade, vline.thresh = .7, vline.col=1, vline.lty=2, vline.lwd=3, fill=0, col=c(2,1),
+       err.col=c("slategray1","slategray3","pink"),
+       err.border=c(3,4,5), err.lwd=c(1,2,3), xlim=c(.3,.6))
> # reverse direction of reducible error area
> a1.shade <- earth(!survived ~ ., data=etitanic, degree=2, glm=list(family=binomial))
> plotd(a1.shade, vline.col="gray", err.col=c("slategray1","slategray3","pink"),
+       err.border=c("slategray1","slategray3","red"), xlim=c(.52, .9))
> 
> par(old.par)
> 
> source("test.epilog.R")
