> # test.prp.R
> 
> library(rpart.plot)
Loading required package: rpart
> data(ptitanic)
> library(earth)
Loading required package: Formula
Loading required package: plotmo
Loading required package: plotrix
Loading required package: TeachingDemos
> data(ozone1)
> sessionInfo()
R version 3.5.3 (2019-03-11)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1

Matrix products: default

locale:
[1] LC_COLLATE=English_United States.1252 
[2] LC_CTYPE=English_United States.1252   
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] earth_4.6.3        plotmo_3.4.1       TeachingDemos_2.10 plotrix_3.7-2     
[5] rpart.plot_3.0.4   rpart_4.1-13      

loaded via a namespace (and not attached):
[1] compiler_3.5.0 tools_3.5.0   
> ititanic <- ptitanic
> ititanic$survived <- as.integer(ititanic$survived == "survived")
> options(warn=1) # print warnings as they occur
> 
> if(!interactive())
+     postscript(paper="letter", fonts=c("Helvetica", "NewCenturySchoolbook"))
> 
> cat0 <- function(...) cat(..., sep="")
> 
> # test that we got an error as expected from a try() call
> expect.err <- function(object, expected.msg="")
+ {
+     if(class(object)[1] == "try-error") {
+         msg <- attr(object, "condition")$message[1]
+         if(length(grep(expected.msg, msg, fixed=TRUE)))
+             cat0("Got error as expected from ",
+                  deparse(substitute(object)), "\n")
+         else
+             stop(sprint("Expected: %s\n  Got:      %s",
+                          expected.msg, substr(msg[1], 1, 1000)))
+     } else
+         stop("Did not get expected error: ", expected.msg)
+ }
> 
> example(rpart.plot)

rprt.p> old.par <- par(mfrow=c(2,2))            # put 4 figures on one page

rprt.p> data(ptitanic)

rprt.p> #---------------------------------------------------------------------------
rprt.p> 
rprt.p> binary.model <- rpart(survived ~ ., data=ptitanic, cp=.02)

rprt.p>                                         # cp=.02 for small demo tree
rprt.p> 
rprt.p> rpart.plot(binary.model,
rprt.p+            main="titanic survived\n(binary response)")

rprt.p> rpart.plot(binary.model,
rprt.p+            box.palette="Grays",         # override default GnBu palette
rprt.p+            main="titanic survived\nbox.palette = \"Grays\"")

rprt.p> #---------------------------------------------------------------------------
rprt.p> 
rprt.p> anova.model <- rpart(Mileage ~ ., data=cu.summary)

rprt.p> rpart.plot(anova.model,
rprt.p+            shadow.col="gray",           # add shadows just for kicks
rprt.p+            main="miles per gallon\n(continuous response)\n")

rprt.p> #---------------------------------------------------------------------------
rprt.p> 
rprt.p> multi.class.model <- rpart(Reliability ~ ., data=cu.summary)

rprt.p> rpart.plot(multi.class.model,
rprt.p+            main="vehicle reliability\n(multi class response)")

rprt.p> par(old.par)
> example(rpart.plot.version1)

rpr..1> data(ptitanic)

rpr..1> tree <- rpart(survived ~ ., data=ptitanic, cp=.02)

rpr..1>                          # cp=.02 because want small tree for demo
rpr..1> 
rpr..1> old.par <- par(mfrow=c(2,2))

rpr..1>                          # put 4 figures on one page
rpr..1> 
rpr..1> rpart.plot.version1(tree, main="default rpart.plot.version1\n(type = 0, extra = 0)")

rpr..1> rpart.plot.version1(tree, main="type = 4, extra = 6",
rpr..1+                     type=4, extra=6, faclen=0) # faclen=0 to print full factor names

rpr..1> rpart.plot.version1(tree, main="extra = 106,  under = TRUE",
rpr..1+                     extra=106, under=TRUE, faclen=0)

rpr..1> # compare to the plotting functions in the rpart package
rpr..1> plot(tree, uniform=TRUE, compress=TRUE, branch=.2)

rpr..1> text(tree, use.n=TRUE, cex=.8, xpd=NA) # cex is a guess, depends on your window size

rpr..1> title("compare to the plotting functions\nin the rpart package", cex.sub=.8)

rpr..1> par(old.par)
> example(prp)

prp> data(ptitanic)

prp> tree <- rpart(survived ~ ., data=ptitanic, cp=.02)

prp>                          # cp=.02 because want small tree for demo
prp> 
prp> old.par <- par(mfrow=c(2,2))

prp>                          # put 4 figures on one page
prp> 
prp> prp(tree, main="default prp\n(type = 0, extra = 0)")

prp> prp(tree, main="type = 4,  extra = 6\nbox.palette = \"auto\"",
prp+     type=4, extra=6,     # label all nodes, show prob of second class
prp+     box.palette="auto",  # auto color the nodes based on the model type
prp+     faclen=0)            # faclen=0 to print full factor names

prp> cols <- ifelse(tree$frame$yval == 1, "darkred", "green4")

prp>                          # green if survived
prp> 
prp> prp(tree, main="assorted arguments",
prp+     extra=106,           # display prob of survival and percent of obs
prp+     nn=TRUE,             # display the node numbers
prp+     fallen.leaves=TRUE,  # put the leaves on the bottom of the page
prp+     shadow.col="gray",   # shadows under the leaves
prp+     branch.lty=3,        # draw branches using dotted lines
prp+     branch=.5,           # change angle of branch lines
prp+     faclen=0,            # faclen=0 to print full factor names
prp+     trace=1,             # print the automatically calculated cex
prp+     split.cex=1.2,       # make the split text larger than the node text
prp+     split.prefix="is ",  # put "is " before split text
prp+     split.suffix="?",    # put "?" after split text
prp+     col=cols, border.col=cols,   # green if survived
prp+     split.box.col="lightgray",   # lightgray split boxes (default is white)
prp+     split.border.col="darkgray", # darkgray border on split boxes
prp+     split.round=.5)              # round the split box corners a tad
cex 1   xlim c(-0.2, 1.2)   ylim c(0, 1)

prp> # compare to the plotting functions in the rpart package
prp> plot(tree, uniform=TRUE, compress=TRUE, branch=.2)

prp> text(tree, use.n=TRUE, cex=.8, xpd=NA) # cex is a guess, depends on your window size

prp> title("compare to the plotting functions\nin the rpart package", cex.sub=.8)

prp> par(old.par)
> print(citation("rpart.plot"))
Warning in citation("rpart.plot") :
  no date field in DESCRIPTION file of package 'rpart.plot'
Warning in citation("rpart.plot") :
  could not determine year for 'rpart.plot' from package DESCRIPTION file

To cite package 'rpart.plot' in publications use:

  Stephen Milborrow (NA). rpart.plot: Plot 'rpart' Models: An Enhanced
  Version of 'plot.rpart'. R package version 3.0.8.
  http://www.milbo.org/rpart-plot

A BibTeX entry for LaTeX users is

  @Manual{,
    title = {rpart.plot: Plot 'rpart' Models: An Enhanced Version of 'plot.rpart'},
    author = {Stephen Milborrow},
    note = {R package version 3.0.8},
    url = {http://www.milbo.org/rpart-plot},
  }

ATTENTION: This citation information has been auto-generated from the
package DESCRIPTION file and may need manual editing, see
'help("citation")'.

> 
> # test format0 and formatf
> 
> x <- c(1.2345, 1.6, 1.23456, 12.345, 124.56,
+        123, 123.456789012345, 1234, 9999, 12345, 123456, 1.234e6, 1.234e7,
+        .123, .0123,
+        1, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6,
+        1e-1, 1e-2, 1e-3, 1e-4, 1e-5, 1e-6,
+        .999, .999e1, .999e2, .999e3, .999e4, .999e5, .999e6,
+        .999e-1, .999e-2, .999e-3, .999e-4, .999e-5, .999e-6)
> 
> x1 <- c(x, 1.2345e300, 1.2345e-300)
> 
> x  <- c(NA, Inf, -Inf, 0, x, -x)
> x1 <- c(NA, Inf, -Inf, 0, x1, -x1)
> 
> options(digits=7)
> 
> cat("\n--- format0 ---\n")

--- format0 ---
> s4  <- rpart.plot:::format0(x1, digits=4)
> s2  <- rpart.plot:::format0(x1, digits=2)
> s1  <- rpart.plot:::format0(x1, digits=1)
> s0  <- rpart.plot:::format0(x1, digits=0)
> sm3 <- rpart.plot:::format0(x1, digits=-3)
> tab <- data.frame("digits=4"=s4, "digits=2"=s2, "digits=1"=s1, "digits=0"=s0, "digits=-3"=sm3, check.names=F)
> row.names(tab) <- format(x1, digits=15)
> print(tab)
                          digits=4  digits=2 digits=1     digits=0  digits=-3
                    NA          NA        NA       NA           NA         NA
                   Inf         Inf       Inf      Inf          Inf        Inf
                  -Inf        -Inf      -Inf     -Inf         -Inf       -Inf
  0.00000000000000e+00           0         0        0            0          0
  1.23450000000000e+00       1.234       1.2        1       1.2345       1.23
  1.60000000000000e+00         1.6       1.6        2          1.6        1.6
  1.23456000000000e+00       1.235       1.2        1      1.23456       1.23
  1.23450000000000e+01       12.35        12       12       12.345       12.3
  1.24560000000000e+02       124.6       125      125       124.56        125
  1.23000000000000e+02         123       123      123          123        123
  1.23456789012345e+02       123.5       123      123     123.4568        123
  1.23400000000000e+03        1234      1234     1234         1234       1234
  9.99900000000000e+03        9999      9999     9999         9999       9999
  1.23450000000000e+04    12.35e+3     12e+3    12e+3    12.345e+3      12345
  1.23456000000000e+05    123.5e+3    123e+3   123e+3   123.456e+3     123456
  1.23400000000000e+06    1.234e+6    1.2e+6     1e+6     1.234e+6    1234000
  1.23400000000000e+07    12.34e+6     12e+6    12e+6     12.34e+6   12340000
  1.23000000000000e-01       0.123      0.12      0.1        0.123      0.123
  1.23000000000000e-02      0.0123     0.012     0.01       0.0123     0.0123
  1.00000000000000e+00           1         1        1            1          1
  1.00000000000000e+01          10        10       10           10         10
  1.00000000000000e+02         100       100      100          100        100
  1.00000000000000e+03        1000      1000     1000         1000       1000
  1.00000000000000e+04       10e+3     10e+3    10e+3        10e+3      10000
  1.00000000000000e+05      100e+3    100e+3   100e+3       100e+3      1e+05
  1.00000000000000e+06     1000e+3   1000e+3  1000e+3      1000e+3      1e+06
  1.00000000000000e-01         0.1       0.1      0.1          0.1        0.1
  1.00000000000000e-02        0.01      0.01     0.01         0.01       0.01
  1.00000000000000e-03       0.001     0.001    0.001        0.001      0.001
  1.00000000000000e-04      100e-6    100e-6   100e-6       100e-6      1e-04
  1.00000000000000e-05       10e-6     10e-6    10e-6        10e-6      1e-05
  1.00000000000000e-06        1e-6      1e-6     1e-6         1e-6      1e-06
  9.99000000000000e-01       0.999         1        1        0.999      0.999
  9.99000000000000e+00        9.99        10       10         9.99       9.99
  9.99000000000000e+01        99.9       100      100         99.9       99.9
  9.99000000000000e+02         999       999      999          999        999
  9.99000000000000e+03        9990      9990     9990         9990       9990
  9.99000000000000e+04     99.9e+3    100e+3   100e+3      99.9e+3      99900
  9.99000000000000e+05      999e+3    999e+3   999e+3       999e+3     999000
  9.99000000000000e-02      0.0999       0.1      0.1       0.0999     0.0999
  9.99000000000000e-03     0.00999      0.01     0.01      0.00999    0.00999
  9.99000000000000e-04      999e-6    999e-6   999e-6       999e-6   0.000999
  9.99000000000000e-05     99.9e-6    100e-6   100e-6      99.9e-6   9.99e-05
  9.99000000000000e-06     9.99e-6     10e-6    10e-6      9.99e-6   9.99e-06
  9.99000000000000e-07      999e-9    999e-9   999e-9       999e-9   9.99e-07
 1.23450000000000e+300  1.234e+300  1.2e+300   1e+300  1.2345e+300  1.23e+300
 1.23450000000000e-300  1.234e-300  1.2e-300   1e-300  1.2345e-300  1.23e-300
 -1.23450000000000e+00      -1.234      -1.2       -1      -1.2345      -1.23
 -1.60000000000000e+00        -1.6      -1.6       -2         -1.6       -1.6
 -1.23456000000000e+00      -1.235      -1.2       -1     -1.23456      -1.23
 -1.23450000000000e+01      -12.35       -12      -12      -12.345      -12.3
 -1.24560000000000e+02      -124.6      -125     -125      -124.56       -125
 -1.23000000000000e+02        -123      -123     -123         -123       -123
 -1.23456789012345e+02      -123.5      -123     -123    -123.4568       -123
 -1.23400000000000e+03       -1234     -1234    -1234        -1234      -1234
 -9.99900000000000e+03       -9999     -9999    -9999        -9999      -9999
 -1.23450000000000e+04   -12.35e+3    -12e+3   -12e+3   -12.345e+3     -12345
 -1.23456000000000e+05   -123.5e+3   -123e+3  -123e+3  -123.456e+3    -123456
 -1.23400000000000e+06   -1.234e+6   -1.2e+6    -1e+6    -1.234e+6   -1234000
 -1.23400000000000e+07   -12.34e+6    -12e+6   -12e+6    -12.34e+6  -12340000
 -1.23000000000000e-01      -0.123     -0.12     -0.1       -0.123     -0.123
 -1.23000000000000e-02     -0.0123    -0.012    -0.01      -0.0123    -0.0123
 -1.00000000000000e+00          -1        -1       -1           -1         -1
 -1.00000000000000e+01         -10       -10      -10          -10        -10
 -1.00000000000000e+02        -100      -100     -100         -100       -100
 -1.00000000000000e+03       -1000     -1000    -1000        -1000      -1000
 -1.00000000000000e+04      -10e+3    -10e+3   -10e+3       -10e+3     -10000
 -1.00000000000000e+05     -100e+3   -100e+3  -100e+3      -100e+3     -1e+05
 -1.00000000000000e+06    -1000e+3  -1000e+3 -1000e+3     -1000e+3     -1e+06
 -1.00000000000000e-01        -0.1      -0.1     -0.1         -0.1       -0.1
 -1.00000000000000e-02       -0.01     -0.01    -0.01        -0.01      -0.01
 -1.00000000000000e-03      -0.001    -0.001   -0.001       -0.001     -0.001
 -1.00000000000000e-04     -100e-6   -100e-6  -100e-6      -100e-6     -1e-04
 -1.00000000000000e-05      -10e-6    -10e-6   -10e-6       -10e-6     -1e-05
 -1.00000000000000e-06       -1e-6     -1e-6    -1e-6        -1e-6     -1e-06
 -9.99000000000000e-01      -0.999        -1       -1       -0.999     -0.999
 -9.99000000000000e+00       -9.99       -10      -10        -9.99      -9.99
 -9.99000000000000e+01       -99.9      -100     -100        -99.9      -99.9
 -9.99000000000000e+02        -999      -999     -999         -999       -999
 -9.99000000000000e+03       -9990     -9990    -9990        -9990      -9990
 -9.99000000000000e+04    -99.9e+3   -100e+3  -100e+3     -99.9e+3     -99900
 -9.99000000000000e+05     -999e+3   -999e+3  -999e+3      -999e+3    -999000
 -9.99000000000000e-02     -0.0999      -0.1     -0.1      -0.0999    -0.0999
 -9.99000000000000e-03    -0.00999     -0.01    -0.01     -0.00999   -0.00999
 -9.99000000000000e-04     -999e-6   -999e-6  -999e-6      -999e-6  -0.000999
 -9.99000000000000e-05    -99.9e-6   -100e-6  -100e-6     -99.9e-6  -9.99e-05
 -9.99000000000000e-06    -9.99e-6    -10e-6   -10e-6     -9.99e-6  -9.99e-06
 -9.99000000000000e-07     -999e-9   -999e-9  -999e-9      -999e-9  -9.99e-07
-1.23450000000000e+300 -1.234e+300 -1.2e+300  -1e+300 -1.2345e+300 -1.23e+300
-1.23450000000000e-300 -1.234e-300 -1.2e-300  -1e-300 -1.2345e-300 -1.23e-300
> 
> cat("\n--- formatf ---\n")

--- formatf ---
> s4  <- rpart.plot:::formatf(x, digits=4)
> s2  <- rpart.plot:::formatf(x, digits=2)
> s1  <- rpart.plot:::formatf(x, digits=1)
> s0  <- rpart.plot:::formatf(x, digits=0)
> tab <- data.frame("digits=4"=s4, "digits=2"=s2, "digits=1"=s1, "digits=0"=s0,
+                   check.names=F)
> row.names(tab) <- format(x, digits=15)
> print(tab)
                            digits=4     digits=2    digits=1  digits=0
                   NA             NA           NA          NA        NA
                  Inf            Inf          Inf         Inf       Inf
                 -Inf           -Inf         -Inf        -Inf      -Inf
 0.00000000000000e+00         0.0000         0.00         0.0         0
 1.23450000000000e+00         1.2345         1.23         1.2         1
 1.60000000000000e+00         1.6000         1.60         1.6         2
 1.23456000000000e+00         1.2346         1.23         1.2         1
 1.23450000000000e+01        12.3450        12.35        12.3        12
 1.24560000000000e+02       124.5600       124.56       124.6       125
 1.23000000000000e+02       123.0000       123.00       123.0       123
 1.23456789012345e+02       123.4568       123.46       123.5       123
 1.23400000000000e+03      1234.0000      1234.00      1234.0      1234
 9.99900000000000e+03      9999.0000      9999.00      9999.0      9999
 1.23450000000000e+04     12345.0000     12345.00     12345.0     12345
 1.23456000000000e+05    123456.0000    123456.00    123456.0    123456
 1.23400000000000e+06   1234000.0000   1234000.00   1234000.0   1234000
 1.23400000000000e+07  12340000.0000  12340000.00  12340000.0  12340000
 1.23000000000000e-01         0.1230         0.12         0.1         0
 1.23000000000000e-02         0.0123         0.01         0.0         0
 1.00000000000000e+00         1.0000         1.00         1.0         1
 1.00000000000000e+01        10.0000        10.00        10.0        10
 1.00000000000000e+02       100.0000       100.00       100.0       100
 1.00000000000000e+03      1000.0000      1000.00      1000.0      1000
 1.00000000000000e+04     10000.0000     10000.00     10000.0     10000
 1.00000000000000e+05    100000.0000    100000.00    100000.0    100000
 1.00000000000000e+06   1000000.0000   1000000.00   1000000.0   1000000
 1.00000000000000e-01         0.1000         0.10         0.1         0
 1.00000000000000e-02         0.0100         0.01         0.0         0
 1.00000000000000e-03         0.0010         0.00         0.0         0
 1.00000000000000e-04         0.0001         0.00         0.0         0
 1.00000000000000e-05         0.0000         0.00         0.0         0
 1.00000000000000e-06         0.0000         0.00         0.0         0
 9.99000000000000e-01         0.9990         1.00         1.0         1
 9.99000000000000e+00         9.9900         9.99        10.0        10
 9.99000000000000e+01        99.9000        99.90        99.9       100
 9.99000000000000e+02       999.0000       999.00       999.0       999
 9.99000000000000e+03      9990.0000      9990.00      9990.0      9990
 9.99000000000000e+04     99900.0000     99900.00     99900.0     99900
 9.99000000000000e+05    999000.0000    999000.00    999000.0    999000
 9.99000000000000e-02         0.0999         0.10         0.1         0
 9.99000000000000e-03         0.0100         0.01         0.0         0
 9.99000000000000e-04         0.0010         0.00         0.0         0
 9.99000000000000e-05         0.0001         0.00         0.0         0
 9.99000000000000e-06         0.0000         0.00         0.0         0
 9.99000000000000e-07         0.0000         0.00         0.0         0
-1.23450000000000e+00        -1.2345        -1.23        -1.2        -1
-1.60000000000000e+00        -1.6000        -1.60        -1.6        -2
-1.23456000000000e+00        -1.2346        -1.23        -1.2        -1
-1.23450000000000e+01       -12.3450       -12.35       -12.3       -12
-1.24560000000000e+02      -124.5600      -124.56      -124.6      -125
-1.23000000000000e+02      -123.0000      -123.00      -123.0      -123
-1.23456789012345e+02      -123.4568      -123.46      -123.5      -123
-1.23400000000000e+03     -1234.0000     -1234.00     -1234.0     -1234
-9.99900000000000e+03     -9999.0000     -9999.00     -9999.0     -9999
-1.23450000000000e+04    -12345.0000    -12345.00    -12345.0    -12345
-1.23456000000000e+05   -123456.0000   -123456.00   -123456.0   -123456
-1.23400000000000e+06  -1234000.0000  -1234000.00  -1234000.0  -1234000
-1.23400000000000e+07 -12340000.0000 -12340000.00 -12340000.0 -12340000
-1.23000000000000e-01        -0.1230        -0.12        -0.1        -0
-1.23000000000000e-02        -0.0123        -0.01        -0.0        -0
-1.00000000000000e+00        -1.0000        -1.00        -1.0        -1
-1.00000000000000e+01       -10.0000       -10.00       -10.0       -10
-1.00000000000000e+02      -100.0000      -100.00      -100.0      -100
-1.00000000000000e+03     -1000.0000     -1000.00     -1000.0     -1000
-1.00000000000000e+04    -10000.0000    -10000.00    -10000.0    -10000
-1.00000000000000e+05   -100000.0000   -100000.00   -100000.0   -100000
-1.00000000000000e+06  -1000000.0000  -1000000.00  -1000000.0  -1000000
-1.00000000000000e-01        -0.1000        -0.10        -0.1        -0
-1.00000000000000e-02        -0.0100        -0.01        -0.0        -0
-1.00000000000000e-03        -0.0010        -0.00        -0.0        -0
-1.00000000000000e-04        -0.0001        -0.00        -0.0        -0
-1.00000000000000e-05        -0.0000        -0.00        -0.0        -0
-1.00000000000000e-06        -0.0000        -0.00        -0.0        -0
-9.99000000000000e-01        -0.9990        -1.00        -1.0        -1
-9.99000000000000e+00        -9.9900        -9.99       -10.0       -10
-9.99000000000000e+01       -99.9000       -99.90       -99.9      -100
-9.99000000000000e+02      -999.0000      -999.00      -999.0      -999
-9.99000000000000e+03     -9990.0000     -9990.00     -9990.0     -9990
-9.99000000000000e+04    -99900.0000    -99900.00    -99900.0    -99900
-9.99000000000000e+05   -999000.0000   -999000.00   -999000.0   -999000
-9.99000000000000e-02        -0.0999        -0.10        -0.1        -0
-9.99000000000000e-03        -0.0100        -0.01        -0.0        -0
-9.99000000000000e-04        -0.0010        -0.00        -0.0        -0
-9.99000000000000e-05        -0.0001        -0.00        -0.0        -0
-9.99000000000000e-06        -0.0000        -0.00        -0.0        -0
-9.99000000000000e-07        -0.0000        -0.00        -0.0        -0
> 
> cat("\n--- formatf strip.leading.zeros ---\n")

--- formatf strip.leading.zeros ---
> s4  <- rpart.plot:::formatf(x, digits=4, strip.leading.zeros=TRUE)
> s2  <- rpart.plot:::formatf(x, digits=2, strip.leading.zeros=TRUE)
> s1  <- rpart.plot:::formatf(x, digits=1, strip.leading.zeros=TRUE)
> s0  <- rpart.plot:::formatf(x, digits=0, strip.leading.zeros=TRUE)
> tab <- data.frame("digits=4"=s4, "digits=2"=s2, "digits=1"=s1, "digits=0"=s0,
+                   check.names=F)
> row.names(tab) <- format(x, digits=15)
> print(tab)
                            digits=4     digits=2    digits=1  digits=0
                   NA             NA           NA          NA        NA
                  Inf            Inf          Inf         Inf       Inf
                 -Inf           -Inf         -Inf        -Inf      -Inf
 0.00000000000000e+00          .0000          .00          .0         0
 1.23450000000000e+00         1.2345         1.23         1.2         1
 1.60000000000000e+00         1.6000         1.60         1.6         2
 1.23456000000000e+00         1.2346         1.23         1.2         1
 1.23450000000000e+01        12.3450        12.35        12.3        12
 1.24560000000000e+02       124.5600       124.56       124.6       125
 1.23000000000000e+02       123.0000       123.00       123.0       123
 1.23456789012345e+02       123.4568       123.46       123.5       123
 1.23400000000000e+03      1234.0000      1234.00      1234.0      1234
 9.99900000000000e+03      9999.0000      9999.00      9999.0      9999
 1.23450000000000e+04     12345.0000     12345.00     12345.0     12345
 1.23456000000000e+05    123456.0000    123456.00    123456.0    123456
 1.23400000000000e+06   1234000.0000   1234000.00   1234000.0   1234000
 1.23400000000000e+07  12340000.0000  12340000.00  12340000.0  12340000
 1.23000000000000e-01          .1230          .12          .1         0
 1.23000000000000e-02          .0123          .01          .0         0
 1.00000000000000e+00         1.0000         1.00         1.0         1
 1.00000000000000e+01        10.0000        10.00        10.0        10
 1.00000000000000e+02       100.0000       100.00       100.0       100
 1.00000000000000e+03      1000.0000      1000.00      1000.0      1000
 1.00000000000000e+04     10000.0000     10000.00     10000.0     10000
 1.00000000000000e+05    100000.0000    100000.00    100000.0    100000
 1.00000000000000e+06   1000000.0000   1000000.00   1000000.0   1000000
 1.00000000000000e-01          .1000          .10          .1         0
 1.00000000000000e-02          .0100          .01          .0         0
 1.00000000000000e-03          .0010          .00          .0         0
 1.00000000000000e-04          .0001          .00          .0         0
 1.00000000000000e-05          .0000          .00          .0         0
 1.00000000000000e-06          .0000          .00          .0         0
 9.99000000000000e-01          .9990         1.00         1.0         1
 9.99000000000000e+00         9.9900         9.99        10.0        10
 9.99000000000000e+01        99.9000        99.90        99.9       100
 9.99000000000000e+02       999.0000       999.00       999.0       999
 9.99000000000000e+03      9990.0000      9990.00      9990.0      9990
 9.99000000000000e+04     99900.0000     99900.00     99900.0     99900
 9.99000000000000e+05    999000.0000    999000.00    999000.0    999000
 9.99000000000000e-02          .0999          .10          .1         0
 9.99000000000000e-03          .0100          .01          .0         0
 9.99000000000000e-04          .0010          .00          .0         0
 9.99000000000000e-05          .0001          .00          .0         0
 9.99000000000000e-06          .0000          .00          .0         0
 9.99000000000000e-07          .0000          .00          .0         0
-1.23450000000000e+00        -1.2345        -1.23        -1.2        -1
-1.60000000000000e+00        -1.6000        -1.60        -1.6        -2
-1.23456000000000e+00        -1.2346        -1.23        -1.2        -1
-1.23450000000000e+01       -12.3450       -12.35       -12.3       -12
-1.24560000000000e+02      -124.5600      -124.56      -124.6      -125
-1.23000000000000e+02      -123.0000      -123.00      -123.0      -123
-1.23456789012345e+02      -123.4568      -123.46      -123.5      -123
-1.23400000000000e+03     -1234.0000     -1234.00     -1234.0     -1234
-9.99900000000000e+03     -9999.0000     -9999.00     -9999.0     -9999
-1.23450000000000e+04    -12345.0000    -12345.00    -12345.0    -12345
-1.23456000000000e+05   -123456.0000   -123456.00   -123456.0   -123456
-1.23400000000000e+06  -1234000.0000  -1234000.00  -1234000.0  -1234000
-1.23400000000000e+07 -12340000.0000 -12340000.00 -12340000.0 -12340000
-1.23000000000000e-01        -0.1230        -0.12        -0.1        -0
-1.23000000000000e-02        -0.0123        -0.01        -0.0        -0
-1.00000000000000e+00        -1.0000        -1.00        -1.0        -1
-1.00000000000000e+01       -10.0000       -10.00       -10.0       -10
-1.00000000000000e+02      -100.0000      -100.00      -100.0      -100
-1.00000000000000e+03     -1000.0000     -1000.00     -1000.0     -1000
-1.00000000000000e+04    -10000.0000    -10000.00    -10000.0    -10000
-1.00000000000000e+05   -100000.0000   -100000.00   -100000.0   -100000
-1.00000000000000e+06  -1000000.0000  -1000000.00  -1000000.0  -1000000
-1.00000000000000e-01        -0.1000        -0.10        -0.1        -0
-1.00000000000000e-02        -0.0100        -0.01        -0.0        -0
-1.00000000000000e-03        -0.0010        -0.00        -0.0        -0
-1.00000000000000e-04        -0.0001        -0.00        -0.0        -0
-1.00000000000000e-05        -0.0000        -0.00        -0.0        -0
-1.00000000000000e-06        -0.0000        -0.00        -0.0        -0
-9.99000000000000e-01        -0.9990        -1.00        -1.0        -1
-9.99000000000000e+00        -9.9900        -9.99       -10.0       -10
-9.99000000000000e+01       -99.9000       -99.90       -99.9      -100
-9.99000000000000e+02      -999.0000      -999.00      -999.0      -999
-9.99000000000000e+03     -9990.0000     -9990.00     -9990.0     -9990
-9.99000000000000e+04    -99900.0000    -99900.00    -99900.0    -99900
-9.99000000000000e+05   -999000.0000   -999000.00   -999000.0   -999000
-9.99000000000000e-02        -0.0999        -0.10        -0.1        -0
-9.99000000000000e-03        -0.0100        -0.01        -0.0        -0
-9.99000000000000e-04        -0.0010        -0.00        -0.0        -0
-9.99000000000000e-05        -0.0001        -0.00        -0.0        -0
-9.99000000000000e-06        -0.0000        -0.00        -0.0        -0
-9.99000000000000e-07        -0.0000        -0.00        -0.0        -0
> 
> # examples from the vignette
> 
> fit <- rpart(survived~., data=ititanic)
> cols <- ifelse(fit$frame$yval > .5, "palegreen", "pink")
> par(mfrow=c(2,2))
> prp(fit, box.col=cols, main="Page 4", prefix="probability\n", trace=1)
cex 1   xlim c(0, 1)   ylim c(-0.05, 1.05)
> 
> fit <- rpart(survived~., data=ititanic)
> cp <- sort(unique(fit$frame$complexity))[4:5] # just do 2, for a quicker test
> for(i in 1:length(cp)) {
+     col <- ifelse(fit$frame$complexity >= cp[i], 1, "gray")
+     lwd <- ifelse(fit$frame$complexity >= cp[i], 2, 1)
+     prp(fit, type=1, col=col, branch.col=col, lwd=lwd,
+            sub=sprint("movie %g", i), col.s=2, trace=1)
+ }
cex 1   xlim c(0, 1)   ylim c(0, 1)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> # return the given node and all its ancestors (a vector of node numbers)
> path.to.root <- function(node, ancestors=NULL)
+ {
+     if(node == 1)   # root?
+         c(1, ancestors)
+     else            # recurse, %/% 2 gives the parent of node
+         c(node, path.to.root(node %/% 2, ancestors))
+ }
> fit.oz <- rpart(O3~., data=ozone1)
> node <- 22 # 22 is our chosen node, arbitrary for this example
> path <- path.to.root(node)
> nodes <- as.numeric(row.names(fit.oz$frame))
> cols <- ifelse(nodes %in% path, 1, "slategray4")
> lwds <- ifelse(nodes %in% path, 2, 1)
> lty  <- ifelse(nodes %in% path, 1, 2)
> prp(fit.oz, type=4, clip.right.labs=F, nn=TRUE, trace=3, # some niceties
+    main=paste("Path to node", node), col.m=3, lwd=lwds, digits=4,
+    col=cols, branch.col=cols, split.col=cols, nn.col=cols)
initial scale 0.849
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.849   xlim c(0, 1)   ylim c(0, 1)
> 
> my.labs <- function(x, labs, digits, varlen)
+ {
+     sprint("ozone %.3g\ndev %.1f", x$frame$yval, x$frame$dev)
+ }
> data(ozone1)
> fit <- rpart(O3~., data=ozone1)
> par(mfrow=c(2,2))
> prp(fit, node.fun=my.labs, main="Page 5", trace=1)
cex 0.75   xlim c(0, 1)   ylim c(-0.1, 1.1)
> 
> my.labs2 <- function(x, labs, digits, varlen)
+ {
+     sprint("%s\n%.2g",
+             ifelse(x$frame$yval > .5, "survived", "died"),
+             x$frame$yval)
+ }
> fit2 <- rpart(survived~., data=ititanic)
> prp(fit2, node.fun=my.labs2, main="my.labs2", trace=1)
cex 1   xlim c(0, 1)   ylim c(-0.05, 1.05)
> 
> my.labs3 <- function(x, labs, digits, varlen) # use passed in labs
+ {
+     sprint("%s\n\ndev %.1f", labs, x$frame$dev)
+ }
> prp(fit2, node.fun=my.labs3, main="my.labs3\nextra=100", trace=1, extra=100, under=T)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> # commented out for rpart.plot version 1.4-0 (user mode no longer supported)
> # fit.user <- rpart(survived~., data=ptitanic, cp=.02)
> # fit.user$method <- "user"
> # fit.user$functions$text <- function (yval, dev, wt, ylevel, digits, n, use.n)
> # {
> #     nclass <- (ncol(yval) - 1L)/2
> #     group <- yval[, 1L]
> #     counts <- yval[, 1L + (1L:nclass)]
> #     if (!is.null(ylevel))
> #         group <- ylevel[group]
> #     temp1 <- format(counts)
> #     if (nclass > 1)
> #         temp1 <- apply(matrix(temp1, ncol = nclass), 1, paste, collapse = "/")
> #     cat("use.n=", use.n, "\n")
> #     if (use.n)
> #         out <- paste(group, "!\n", temp1, sep = "")
> #     else
> #         out <- format(group)
> #     return(out)
> # }
> # prp(fit.user, node.fun=my.labs3, main="method=user\nmy.labs3 extra=100", trace=1, extra=100, under=T, prefix="result: ")
> 
> a20 <- rpart(survived~., data=ptitanic, control=list(cp=.02))
> par(mfrow=c(3,3))
> 
> boxes.include.gap <- FALSE
> 
> prp(a20, type=4,
+     main="Page 6",
+     cex.main=.9,
+     under=F,
+     extra=0,
+     split.cex=1,
+     faclen=0, trace=1,
+     boxes.include.gap=boxes.include.gap)
cex 0.931   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a20, type=4,
+     main="(2) extra=1\nprefix=0 suffix=0 split.suffix=0\nsplit.cex=1\n",
+     cex.main=.9,
+     under=F,
+     extra=1,
+     split.cex=1,
+     faclen=1, trace=1,
+     branch=1,
+     boxes.include.gap=boxes.include.gap)
cex 0.688   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a20, type=4,
+     main="(3) extra=1\nprefix=1 suffix=0 split.suffix=0\nsplit.cex=1\n",
+     cex.main=.9,
+     under=F,
+     extra=1,
+     prefix="prefix ",
+     suffix="",
+     split.suffix="",
+     split.cex=1,
+     faclen=0, trace=1,
+     split.border.col=1,
+     boxes.include.gap=boxes.include.gap)
cex 0.688   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a20, type=4,
+     main="(4) extra=4\nprefix=1 suffix=1 split.suffix=1\nsplit.cex=1\n",
+     cex.main=.9,
+     under=F,
+     extra=4,
+     prefix="prefix ",
+     suffix="\nsuffix",
+     split.suffix="\nsplit.suffix",
+     split.cex=1,
+     faclen=0, trace=1,
+     boxes.include.gap=boxes.include.gap)
cex 0.438   xlim c(0, 1)   ylim c(-0.1, 1.1)
> 
> prp(a20, type=4,
+     main="(5) extra=5\nprefix=0 suffix=0 split.suffix=0\nsplit.cex=1.4\n",
+     cex.main=.9,
+     under=F,
+     extra=5,
+     split.cex=1.4,
+     faclen=0, trace=1,
+     split.border.col=1,
+     boxes.include.gap=boxes.include.gap)
cex 0.762   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a20, type=4,
+     main="(6) extra=101\nprefix=0 suffix=0 split.suffix=0\nsplit.cex=.7\n",
+     cex.main=.9,
+     under=F,
+     extra=101,
+     split.cex=.7,
+     faclen=0, trace=1,
+     branch=1,
+     boxes.include.gap=boxes.include.gap)
cex 0.65   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a20, type=4,
+     main="(7) extra=1\nprefix=1 suffix=1 split.suffix=1\nsplit.cex=1.4\n",
+     cex.main=.9,
+     under=F,
+     extra=1,
+     prefix="prefix ",
+     suffix="\nsuffix",
+     split.suffix="\nsplit.suffix",
+     split.cex=1.4,
+     faclen=1, trace=1,
+     split.border.col=1,
+     boxes.include.gap=boxes.include.gap)
cex 0.4   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a20, type=4,
+     main="(8) extra=0\nprefix=1 suffix=1 split.suffix=1\nsplit.cex=.7\n",
+     cex.main=.9,
+     under=F,
+     extra=0,
+     prefix="prefix ",
+     suffix="\nsuffix",
+     split.suffix="\nsplit.suffix",
+     split.cex=.7,
+     faclen=0, trace=1,
+     boxes.include.gap=boxes.include.gap)
cex 0.625   xlim c(0, 1)   ylim c(-0.05, 1.05)
> 
> # TODO split.yshift indexing is confusing
> prp(a20, type=4, trace=2, nn=T, split.border.col=1,
+     main="(9) manual yshift and split.yshift\n",
+     prefix=c("up ", "", "up ", "", "", "", ""),
+     yshift=c(2, 0, 2, 0, 0, 0, 0),
+     branch=1,
+     split.prefix=c("", "", "down ", "", "", "", ""),
+     split.yshift=c(0, -3, 0, 0, 0, 0, 0))
initial scale 0.688
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.688   xlim c(0, 1)   ylim c(0, 1)
> 
> 
> a21 <- rpart(survived~., data=ptitanic, control=list(cp=.02))
> par(mfrow=c(3,3))
> 
> prp(a21, type=1,
+     main="Page 7",
+     cex.main=.9,
+     under=F,
+     extra=0,
+     split.cex=1,
+     faclen=0, trace=1,
+     boxes.include.gap=boxes.include.gap)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a21, type=1,
+     main="(2) extra=1\nprefix=0 suffix=0 split.suffix=0\nsplit.cex=1\n",
+     cex.main=.9,
+     under=F,
+     extra=1,
+     split.cex=1,
+     faclen=1, trace=1,
+     branch=1,
+     boxes.include.gap=boxes.include.gap)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a21, type=1,
+     main="(3) extra=1\nprefix=1 suffix=0 split.suffix=0\nsplit.cex=1\n",
+     cex.main=.9,
+     under=F,
+     extra=1,
+     prefix="prefix ",
+     suffix="",
+     split.suffix="",
+     split.cex=1,
+     faclen=0, trace=1,
+     boxes.include.gap=boxes.include.gap)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a21, type=1,
+     main="(4) extra=1\nprefix=1 suffix=1 split.suffix=1\nsplit.cex=1\n",
+     cex.main=.9,
+     under=F,
+     extra=1,
+     prefix="prefix ",
+     suffix="\nsuffix",
+     split.suffix="\nsplit.suffix",
+     split.cex=1,
+     faclen=1, trace=1,
+     boxes.include.gap=boxes.include.gap)
cex 0.931   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a21, type=1,
+     main="(5) extra=0\nprefix=0 suffix=0 split.suffix=0\nsplit.cex=1.4\n",
+     cex.main=.9,
+     under=F,
+     extra=0,
+     split.cex=1.4,
+     faclen=0, trace=1,
+     branch=1,
+     boxes.include.gap=boxes.include.gap)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a21, type=1,
+     main="(6) extra=1\nprefix=0 suffix=0 split.suffix=0\nsplit.cex=.7\n",
+     cex.main=.9,
+     under=F,
+     extra=1,
+     split.cex=.7,
+     faclen=1, trace=1,
+     split.border.col=1,
+     boxes.include.gap=boxes.include.gap)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a21, type=1,
+     main="(7) extra=1\nprefix=1 suffix=1 split.suffix=1\nsplit.cex=1.4\n",
+     cex.main=.9,
+     under=F,
+     extra=1,
+     prefix="prefix ",
+     suffix="\nsuffix",
+     split.suffix="\nsplit.suffix",
+     split.cex=1.4,
+     faclen=0, trace=1,
+     branch=1,
+     split.border.col=1,
+     boxes.include.gap=boxes.include.gap)
cex 0.688   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a21, type=1,
+     main="(8) extra=0\nprefix=1 suffix=1 split.suffix=1\nsplit.cex=.7\n",
+     cex.main=.9,
+     under=F,
+     extra=0,
+     prefix="prefix ",
+     suffix="\nsuffix",
+     split.suffix="\nsplit.suffix",
+     split.cex=.7,
+     faclen=1, trace=1,
+     split.border.col=1,
+     boxes.include.gap=boxes.include.gap)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a21, type=1, trace=2, nn=0, ni=0,
+     main="(9) manual yshift and split.yshift\n",
+     split.border.col=1,
+     cex.main=.9,
+     prefix=c("up\n", "", "up\n", "up\n", "", "", ""),
+     yshift=c(3, 0, 3, 3, 0, 0, 0),
+     split.prefix=c("", "", "down\n", "", "", "", ""),
+     split.yshift=c(0, -1, 0, 0, 0, 0, 0))
initial scale 1.06
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
clipped scale 1.06 to max.auto.cex 1
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> 
> par(mfrow=c(3,3))
> a8 <- rpart(survived~., data=ptitanic, control=list(cp=.02))
> prp(a8, type=2, main="Page 8")
> prp(a8, type=2, extra=4, main="extra=4")
> prp(a8, type=2, extra=104, main="extra=104")
> 
> prp(a8, type=2, extra=0,   under=T, main="extra=0,   under=T")
> prp(a8, type=2, extra=4,   under=T, main="extra=4,   under=T")
> prp(a8, type=2, extra=104, under=T, main="extra=104, under=T")
> 
> prp(a8, type=2, extra=104, under=T, under.cex=.6, main="extra=104, under=T\nunder.cex=.6")
> prp(a8, type=2, extra=104, under=T, under.cex=1, main="extra=104, under=T\nunder.cex=1.2")
> prp(a8, type=2, extra=104, under=T, split.border.col=1, border.col=0, main="extra=104, under=T\nsplit.border=1, border=0")
> 
> par(mfrow=c(2,2))
> fit3 <- rpart(survived~., data=ititanic, control=list(cp=.002))
> prp(fit3, trace=3, nn=0, faclen=0, prefix="prob ", main="Page 9")
initial scale 0.65
    node shifter: cex improvement 1     shift.amount 1.5  <new best
    node shifter: cex improvement 0.538 shift.amount 2.0  
shifter: cex improvement 1 best.shift.amount 1.5 best.split.yshift.amount 0 (won't be used)
cex 0.65   xlim c(0, 1)   ylim c(0, 1)
> prp(fit3, extra=100, trace=3, nn=TRUE, faclen=0, fallen.leaves=TRUE, main="fallen leaves")
initial scale 0.45
    node shifter: cex improvement 0.778 shift.amount 1.5  
    node shifter: cex improvement 0.556 shift.amount 2.0  
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.45   xlim c(0, 1)   ylim c(0, 1)
> prp(fit3, type=4, trace=3, nn=TRUE, clip.right.labs=0, split.border.col=1, main="type=4 ")
initial scale 0.45
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.45   xlim c(0, 1)   ylim c(0, 1)
> # use prefix below to force shifting of fallen leaves to test shifter
> prp(fit3, type=4, branch=.5, extra=1, under=TRUE, trace=3, nn=FALSE, fallen.leaves=1, prefix="probability ", main="type=4, fallen leaves")
initial scale 0.25
    node shifter: cex improvement 1.35  shift.amount 1.5  <new best
    node shifter: cex improvement 1.4   shift.amount 2.0  <new best
shifter: cex improvement 1.4 best.shift.amount 2 best.split.yshift.amount 0 (will be used)
ycompress increased cex by 1.40
cex 0.35   xlim c(0, 1)   ylim c(0, 1)
> 
> par(mfrow=c(2,2))
> fit7 <- rpart(survived ~ ., data=ptitanic, cp=.01)
> # this was wrong until I added check that a shift doesn't move nodes above the nodes for the level above
> prp(fit7, extra=1, branch=1, trace=3, nn=1, main="Page 10")
initial scale 1.03
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
clipped scale 1.03 to max.auto.cex 1
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> par(mfrow=c(2,2))
> prp(fit2, prefix=ifelse(fit2$frame$yval > .5, "survived\n", "died\n"), main="Page 11",
+     fam.main="NewCenturySchoolbook", cex.main=1.3, trace=1,
+     border.col=0, split.border.col="steelblue3")
cex 1   xlim c(0, 1)   ylim c(-0.05, 1.05)
> # test long names and big and small numbers
> ptitanic1 <- ptitanic
> ptitanic1$sibsp1234567890 <- 1e3 * ptitanic1$sibsp
> ptitanic1$sibsp <- NULL
> ptitanic1$age <- 1e-5 * ptitanic1$age
> ptitanic1$parch <- 1e7 * ptitanic1$parch
> fit2 <- rpart(survived~., data=ptitanic1)
> prp(fit2, faclen=0, digits=4, trace=1,
+     border.col=NA, split.border.col="steelblue3", split.round=1)
cex 0.948   xlim c(0, 1)   ylim c(0, 1)
> 
> # test small tree, also tests xcompact and ycompact
> fit.small <- rpart(survived~., data=ptitanic1, , control=list(cp=.1))
> prp(fit.small, extra=100, faclen=0, main="small tree", trace=1)
cex 1   xlim c(-0.65, 1.65)   ylim c(-1.05, 2.05)
> 
> # test negative digits
> prp(fit2, faclen=0, digits=-4,
+     border.col=NA, split.border.col="steelblue3", split.round=1)
> 
> par(mfrow=c(2,3))
> fit4 <- rpart(survived~., data=ititanic, method="class", control=list(cp=.02))
> prp(fit4, trace=2, cex=.8, tweak=1.1, main="Page 12",
+        xflip=TRUE, yflip=TRUE, type=1, extra=100,  yesno=FALSE)
initial scale 1.33
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.8 (before applying tweak 1.1)   xlim c(0, 1)   ylim c(0, 1)
Warning: cex and tweak both specified, applying both
> # TODO wanna include family below, but postscript giving me grief
> fit4.strange.method <- fit4
> fit4.strange.method$method <- "unknown.class.method"
> options(warn=2) # treat warnings as errors
> expect.err(try(prp(fit4.strange.method, main="left=FALSE, fonts, user method", left=FALSE, font=c(1,2,3), split.cex=c(1, 1.2), branch=.5, trace=1, extra=1)),
+            "Unrecognized rpart object: treating as a class response model")
Error : (converted from warning) Unrecognized rpart object: treating as a class response model
Got error as expected from try(prp(fit4.strange.method, main = "left=FALSE, fonts, user method",     left = FALSE, font = c(1, 2, 3), split.cex = c(1, 1.2), branch = 0.5,     trace = 1, extra = 1))
> options(warn=1) # print warnings as they occur
> prp(fit4.strange.method, main="left=FALSE, fonts, user method", left=FALSE, font=c(1,2,3), split.cex=c(1, 1.2), branch=.5, trace=1, extra=1)
Warning: Unrecognized rpart object: treating as a class response model
cex 1   xlim c(-0.2, 1.2)   ylim c(-0.15, 1.15)
> prp(fit4, main="unknown.class.method\nuniform=FALSE", uniform=FALSE, trace=1)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> prp(fit4, main="unknown.class.method\ntype=1\nbox.palette=\"auto\"", type=1, box.palette="auto")
> data(ozone1)
> fit.oz1 <- rpart(O3~., data=ozone1)
> fit.oz1$method <- "unknown.anova.method"
> options(warn=2) # treat warnings as errors
> expect.err(try(prp(fit.oz1, main="unknown.anova.method\ndigits=7", digits=7, trace=1)),
+            "Unrecognized rpart object: treating as a numeric response model")
Error : (converted from warning) Unrecognized rpart object: treating as a numeric response model
Got error as expected from try(prp(fit.oz1, main = "unknown.anova.method\ndigits=7", digits = 7,     trace = 1))
> options(warn=1) # print warnings as they occur
> obj <- prp(fit.oz1, main="unknown.anova.method\ndigits=7", digits=7, trace=1)
Warning: Unrecognized rpart object: treating as a numeric response model
cex 1   xlim c(0, 1)   ylim c(0, 1)
> obj <- prp(fit.oz1, main="unknown.anova.method\ntype=1\nbox.palette=\"auto\"", type=1, box.palette="auto")
Warning: Unrecognized rpart object: treating as a numeric response model
> cat("obj returned by prp:\n")
obj returned by prp:
> print(obj)
$obj
n= 330 

node), split, n, deviance, yval
      * denotes terminal node

 1) root 330 21115.4100 11.775760  
   2) temp< 67.5 214  4114.3040  7.425234  
     4) ibh>=3573.5 108   689.6296  5.148148 *
     5) ibh< 3573.5 106  2294.1230  9.745283  
      10) dpg< -9.5 35   362.6857  6.457143 *
      11) dpg>=-9.5 71  1366.4790 11.366200  
        22) ibt< 159 40   287.9000  9.050000 *
        23) ibt>=159 31   587.0968 14.354840 *
   3) temp>=67.5 116  5478.4400 19.801720  
     6) ibt< 226.5 55  1276.8360 15.945450  
      12) humidity< 59.5 10   167.6000 10.800000 *
      13) humidity>=59.5 45   785.6444 17.088890 *
     7) ibt>=226.5 61  2646.2620 23.278690  
      14) doy>=306.5 8   398.0000 16.000000 *
      15) doy< 306.5 53  1760.4530 24.377360  
        30) vis>=55 36  1149.8890 22.944440 *
        31) vis< 55 17   380.1176 27.411760 *

$snipped.nodes
NULL

$xlim
[1] 0 1

$ylim
[1] -0.05  1.05

$x
 [1] 0.39948603 0.12197472 0.04154716 0.20240228 0.12269930 0.28210527
 [7] 0.20964801 0.35456253 0.67699734 0.51396851 0.44151124 0.58642577
[13] 0.81104328 0.73134029 0.89074626 0.81828900 0.96320352

$y
 [1] 0.95717280 0.72093869 0.48470457 0.48470457 0.24847046 0.24847046
 [7] 0.01223634 0.01223634 0.72093869 0.48470457 0.24847046 0.24847046
[13] 0.48470457 0.24847046 0.24847046 0.01223634 0.01223634

$branch.x
      [,1]      [,2]       [,3]      [,4]      [,5]      [,6]      [,7]
x 0.399486 0.1219747 0.04154716 0.2024023 0.1226993 0.2821053 0.2096480
        NA 0.3439838 0.10588921 0.1380602 0.1864617 0.2183429 0.2676138
        NA 0.3994860 0.12197472 0.1219747 0.2024023 0.2024023 0.2821053
       [,8]      [,9]     [,10]     [,11]     [,12]     [,13]     [,14]
x 0.3545625 0.6769973 0.5139685 0.4415112 0.5864258 0.8110433 0.7313403
  0.2965967 0.4549883 0.6327984 0.4994771 0.5284600 0.6922134 0.7951027
  0.2821053 0.3994860 0.6769973 0.5139685 0.5139685 0.6769973 0.8110433
      [,15]     [,16]     [,17]
x 0.8907463 0.8182890 0.9632035
  0.8269839 0.8762548 0.9052377
  0.8110433 0.8907463 0.8907463

$branch.y
       [,1]      [,2]      [,3]      [,4]      [,5]      [,6]      [,7]
y 0.9619019 0.7256678 0.5274375 0.4894337 0.2912034 0.2531996 0.0549693
         NA 0.9087421 0.6725080 0.6725080 0.4362739 0.4362739 0.2000398
         NA 0.9087421 0.6725080 0.6725080 0.4362739 0.4362739 0.2000398
       [,8]      [,9]     [,10]     [,11]     [,12]     [,13]     [,14]
y 0.0549693 0.7256678 0.4894337 0.2912034 0.2912034 0.4894337 0.2912034
  0.2000398 0.9087421 0.6725080 0.4362739 0.4362739 0.6725080 0.4362739
  0.2000398 0.9087421 0.6725080 0.4362739 0.4362739 0.6725080 0.4362739
      [,15]     [,16]     [,17]
y 0.2531996 0.0549693 0.0549693
  0.4362739 0.2000398 0.2000398
  0.4362739 0.2000398 0.2000398

$labs
 [1] "12"  "7.4" "5.1" "9.7" "6.5" "11"  "9.1" "14"  "20"  "16"  "11"  "17" 
[13] "23"  "16"  "24"  "23"  "27" 

$cex
[1] 1

$boxes
$boxes$x1
 [1] 0.3634229927 0.0807571710 0.0003296112 0.1611847308 0.0814817436
 [6] 0.2460422297 0.1684304569 0.3184994908 0.6409343027 0.4779054653
[11] 0.4054482042 0.5503627264 0.7749802358 0.6952772485 0.8546832230
[16] 0.7822259619 0.9271404841

$boxes$y1
 [1]  0.880253481  0.644019366  0.470460254  0.407785251  0.234226138
 [6]  0.171551135 -0.002007977 -0.002007977  0.644019366  0.407785251
[11]  0.234226138  0.234226138  0.407785251  0.234226138  0.171551135
[16] -0.002007977 -0.002007977

$boxes$x2
 [1] 0.43554907 0.16319228 0.08276472 0.24361984 0.16391685 0.31816831
 [7] 0.25086556 0.39062557 0.71306038 0.55003155 0.47757429 0.62248881
[13] 0.84710632 0.76740333 0.92680930 0.85435204 0.99926657

$boxes$y2
 [1] 0.9372308 0.7009966 0.5274375 0.4647625 0.2912034 0.2285284 0.0549693
 [8] 0.0549693 0.7009966 0.4647625 0.2912034 0.2912034 0.4647625 0.2912034
[15] 0.2285284 0.0549693 0.0549693


$split.labs
[1] ""

$split.cex
 [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1

$split.box
$split.box$x1
 [1] 0.297990360 0.005516133          NA 0.095232938          NA 0.191938398
 [7]          NA          NA 0.586830471 0.379506207          NA          NA
[13] 0.700110026          NA 0.796945275          NA          NA

$split.box$y1
 [1] 0.9429285 0.7066944        NA 0.4704603        NA 0.2342261        NA
 [8]        NA 0.7066944 0.4704603        NA        NA 0.4704603        NA
[15] 0.2342261        NA        NA

$split.box$x2
 [1] 0.5009817 0.2384333        NA 0.3095716        NA 0.3722721        NA
 [8]        NA 0.7671642 0.6484308        NA        NA 0.9219765        NA
[15] 0.9845473        NA        NA

$split.box$y2
 [1] 0.9999058 0.7636716        NA 0.5274375        NA 0.2912034        NA
 [8]        NA 0.7636716 0.5274375        NA        NA 0.5274375        NA
[15] 0.2912034        NA        NA


> 
> # test extra and faclen etc. on anova model
> a1 <- rpart(survived~., data=ititanic, control=list(cp=.03))
> par(mfrow=c(3, 3))
> plot(a1, unif=TRUE, branch=.3, main="Page 13")
> text(a1, fancy=T, fwidth=.35, fheight=0.3, use.n=TRUE, all=T, digits=3, xpd=NA, pretty=0)
> prp(a1, extra=0, faclen=-3, varlen=2,             type=1, main="extra=0", trace=1)
cex 1   xlim c(-0.2, 1.2)   ylim c(-0.1, 1.1)
> prp(a1, extra=1, faclen=1,  varlen=-2,              type=4, main="extra=1", trace=1)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> prp(a1, extra=100, faclen=3,             digits=3,  type=4, clip.right.labs=FALSE, facsep=" or ", main="extra=100", trace=1)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> # plot(1, 1, type="n", axes=FALSE, xlab="", ylab="") # blank
> # test xflip and left (note: left=FALSE cannot be used with type=4)
> prp(a1, main="\n\nxflip",                xflip=TRUE,             extra=101, faclen=0, trace=1)
cex 1   xlim c(0, 1)   ylim c(-0.15, 1.15)
> prp(a1, main="type=4",                                type=4, extra=101, faclen=0, trace=1)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> prp(a1, main="xflip type=4",              xflip=TRUE, type=4, extra=101, faclen=0, trace=1)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> prp(a1, main="xflip type=4 clip.right=FALSE",   xflip=TRUE, type=4, extra=101, faclen=0, clip.right=FALSE, trace=1)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> # test extra and faclen etc. on class model
> a2 <- rpart(survived~., data=ptitanic, control=list(cp=.02))
> par(mfrow=c(3, 2))
> plot(a2, unif=TRUE, branch=.3, main="Page 14")
> text(a2, use.n=TRUE, all=T, digits=3, xpd=NA, pretty=0)
> prp(a2, extra=0, eq=" eq ", lt=" lt ", ge=" ge ", facsep="|", xsep="/",
+     type=4, main="extra=0", trace=3, split.border.col=1)
initial scale 0.931
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.931   xlim c(0, 1)   ylim c(0, 1)
> prp(a2, extra=1, type=1,  xsep=", ", main="extra=1", trace=1)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> prp(a2, extra=100, type=3, clip.right.labs=FALSE, main="extra=100", trace=3, split.border.col=1, ycompress.cex=1)
initial scale 0.931
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.931   xlim c(0, 1)   ylim c(0, 1)
> prp(a2, extra=4, type=0, main="extra=4", faclen=0, trace=1, under=TRUE, col=2)
cex 1   xlim c(-0.2, 1.2)   ylim c(0, 1)
> prp(a2, extra=104, type=0, main="extra=104", faclen=0, trace=1)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> old.par <- par(mfrow=c(8,4), mar = c(4, 3, 2, 1), mgp = c(1.5, .5, 0))
> 
> a4 <- rpart(survived~., data=ptitanic, cp=.03)
> plot(a4, unif=T, branch=.3); text(a4, use.n=1, cex=1, xpd=NA, pretty=0); title("Page 15", cex.main=.9)
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=0, cex.main=.9, main="extra=0\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=1, cex.main=.9, main="extra=1\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=4, cex.main=.9, main="extra=4\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=5, cex.main=.9, main="extra=5\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=6, cex.main=.9, main="extra=6\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, extra=7, under=F, cex.main=.9, main="extra=7\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=8, cex.main=.9, main="extra=8\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=9, cex.main=.9, main="extra=9\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=100, cex.main=.9, main="extra=100\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=101, cex.main=.9, main="extra=101\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=104, cex.main=.9, main="extra=104\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=105, cex.main=.9, main="extra=105\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=106, cex.main=.9, main="extra=106\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=107, cex.main=.9, main="extra=107\nunder=F")
> prp(a4, type=1, yesno=T, faclen=-1, under=F, extra=109, cex.main=.9, main="extra=109\n under=F")
> 
> plot(0, 0, type="n", axes=FALSE, xlab="", ylab="")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=0, cex.main=.9, main="extra=0\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=1, cex.main=.9, main="extra=1\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=4, cex.main=.9, main="extra=4\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=5, cex.main=.9, main="extra=5\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=6, cex.main=.9, main="extra=6\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, extra=7, under=T, cex.main=.9, main="extra=7\nunder=T (ignored)")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=8, cex.main=.9, main="extra=8\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=9, cex.main=.9, main="extra=9\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=100, cex.main=.9, main="extra=100\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=101, cex.main=.9, main="extra=101\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=104, cex.main=.9, main="extra=104\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=105, cex.main=.9, main="extra=105\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=106, cex.main=.9, main="extra=106\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=107, cex.main=.9, main="extra=107\nunder=T")
> prp(a4, type=1, yesno=T, faclen=-1, under=T, extra=109, cex.main=.9, main="extra=109\n under=T")
> 
> par(old.par)
> 
> # May 2018: extra=9,10,11
> old.par <- par(no.readonly=TRUE)
> par(mfrow=c(2, 3))
> prp(a4, extra=9, main="extra=9")
> prp(a4, extra=10, main="extra=10")
> prp(a4, extra=11, main="extra=11")
> prp(a4, extra=109, main="extra=109")
> prp(a4, extra=110, main="extra=110")
> prp(a4, extra=111, main="extra=111")
> expect.err(try(prp(a4, extra=12, main="extra=12")), 'extra=12 is illegal')

The 'extra' argument:
    0  No extra information
    1  Number of observations in the node
    2  Class models: Classification rate (ncorrect/nobservations)
       Poisson and exp models: number of events
    3  Class models: Misclassification rate
    4  Class models: Probability per class
    5  Class models: Like 4 but don't display the fitted class
    6  Class models: Probability of second class only
    7  Class models: Like 6 but don't display the fitted class
    8  Class models: Probability of the fitted class
    9  Class models: Probability relative to all observations
    10 Class models: like 9 but display the probability of the second class only
    11 Class models: Like 10 but don't display the fitted class

Error : extra=12 is illegal
Got error as expected from try(prp(a4, extra = 12, main = "extra=12"))
> expect.err(try(prp(a4, extra=99, main="extra=99")), 'extra=99 is illegal')

The 'extra' argument:
    0  No extra information
    1  Number of observations in the node
    2  Class models: Classification rate (ncorrect/nobservations)
       Poisson and exp models: number of events
    3  Class models: Misclassification rate
    4  Class models: Probability per class
    5  Class models: Like 4 but don't display the fitted class
    6  Class models: Probability of second class only
    7  Class models: Like 6 but don't display the fitted class
    8  Class models: Probability of the fitted class
    9  Class models: Probability relative to all observations
    10 Class models: like 9 but display the probability of the second class only
    11 Class models: Like 10 but don't display the fitted class

Error : extra=99 is illegal
Got error as expected from try(prp(a4, extra = 99, main = "extra=99"))
> expect.err(try(prp(a4, extra=-1, main="extra=-1")), 'extra=-1 is illegal')

The 'extra' argument:
    0  No extra information
    1  Number of observations in the node
    2  Class models: Classification rate (ncorrect/nobservations)
       Poisson and exp models: number of events
    3  Class models: Misclassification rate
    4  Class models: Probability per class
    5  Class models: Like 4 but don't display the fitted class
    6  Class models: Probability of second class only
    7  Class models: Like 6 but don't display the fitted class
    8  Class models: Probability of the fitted class
    9  Class models: Probability relative to all observations
    10 Class models: like 9 but display the probability of the second class only
    11 Class models: Like 10 but don't display the fitted class

Error : extra=-1 is illegal
Got error as expected from try(prp(a4, extra = -1, main = "extra=-1"))
> expect.err(try(prp(a4, extra=1.23, main="extra=1.23")), 'extra=1.23 is illegal')

The 'extra' argument:
    0  No extra information
    1  Number of observations in the node
    2  Class models: Classification rate (ncorrect/nobservations)
       Poisson and exp models: number of events
    3  Class models: Misclassification rate
    4  Class models: Probability per class
    5  Class models: Like 4 but don't display the fitted class
    6  Class models: Probability of second class only
    7  Class models: Like 6 but don't display the fitted class
    8  Class models: Probability of the fitted class
    9  Class models: Probability relative to all observations
    10 Class models: like 9 but display the probability of the second class only
    11 Class models: Like 10 but don't display the fitted class

Error : extra=1.23 is illegal
Got error as expected from try(prp(a4, extra = 1.23, main = "extra=1.23"))
> par(old.par)
> 
> par(mfrow=c(3,3))
> prp(a4, type=1,          extra=2,   main="Page 17")
> prp(a4, type=1, under=T, extra=3,   main="extra=3 (misclassification rate)\nunder=T")
> prp(a4, type=1,          extra=102, main="extra=102 (classification rate)\n")
> prp(a4, type=1, under=T, extra=103, main="extra=103 (misclassification rate)\nunder=T")
> 
> # poisson
> set.seed(8)
> ozone2 <- ozone1
> ozone2$O3a <- round(runif(330, 1, 10))
> y <- cbind(ozone2$O3, ozone2$O3a)
> a5 <- rpart(y~.-O3-O3a, data=ozone2, control=list(cp=.04))
> par(mfrow=c(2, 3))
> plot(a5, unif=TRUE, branch=.3, main="Page 18"); text(a5, use.n=TRUE, all=T, digits=3, xpd=NA, cex=1.1)
> prp(a5, extra=0, digits=3, type=4, trace=1, main="extra=0\ntype=4")
cex 1   xlim c(-0.2, 1.2)   ylim c(-0.45, 1.45)
> prp(a5, extra=1, type=4, clip.right=FALSE, under=TRUE, main="extra=1: nbr of events, nbr of obs\ntype=4", trace=1, under.cex=1)
cex 1   xlim c(0, 1)   ylim c(-0.3, 1.3)
> prp(a5, extra=2, trace=1, type=0, under=T, main="extra=2: nbr of events", under.cex=1)
cex 1   xlim c(-0.2, 1.2)   ylim c(-0.65, 1.65)
> prp(a5, extra=102, type=4, under=TRUE, xsep="/", main="extra=102\ntype=4", trace=1, under.cex=1)
cex 1   xlim c(0, 1)   ylim c(-0.3, 1.3)
> 
> # prefix, suffix, etc.
> a7 <- rpart(survived~., data=ptitanic, control=list(cp=.02))
> par(mfrow=c(2, 2))
> # test many parameters, and their vectorization
> prp(a7, main="Page 19", Margin=.03,
+     extra=4, under=T, prefix="res:", suffix=" (probs)", split.suffix="\n\nabc", faclen=0, trace=3,
+     nn=1,
+     under.col=c(2,3), under.font=c(3,2), under.ygap=c(.2,-.2), under.cex=c(1.1, .8),
+     adj=c(0,.5), split.adj=c(.5,1), yshift=c(-.5,.5),
+     shadow.col=c(1,2), split.shadow.col=c("pink","blue"),
+     space=c(.8,.6), yspace=c(.5,.1), border.col=c("gray", "green3", "pink"),
+     lty=c(1,2),
+     shadow.offset=c(.4,1,2),
+     split.shadow.offset=c(.4,.4,1),
+     nn.font=c(1,3), nn.adj=c(1,0), nn.col=c(1,2), nn.border.col=c(0,1,2))
initial scale 1.06
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
clipped scale 1.06 to max.auto.cex 1
cex 1   xlim c(0, 1)   ylim c(0, 1)
> 
> my.split.labs <- function(x, labs, digits, varlen, faclen)
+ {
+     sprint("my.split.lab\n%s", labs)
+ }
> prp(a7, type=4, extra=4, under=T,
+     faclen=0, trace=3,
+     split.fun=my.split.labs,
+     split.prefix="L[", split.suffix="]L",
+     right.split.prefix="R[", right.split.suffix="]R",
+     round=9, leaf.round=0,
+     ycompress.cex=.8) # force ycompress for testing with type=4
initial scale 0.849
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.849   xlim c(0, 1)   ylim c(0, 1)
> 
> prp(a7, type=4, extra=1, under=F, prefix="response:",
+     suffix="\n\n (probs)", split.suffix="\n\nabc", faclen=0, trace=3)
initial scale 0.738
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.738   xlim c(0, 1)   ylim c(0, 1)
> par(mfrow=c(1, 1))
> 
> data(iris)
> a.iris <- rpart(Species~., data=iris)
> par(mfrow=c(2, 2))
> old.bg <- par(bg="gray")
> prp(a.iris, main="Page 20",
+     type=4, extra=1, under=TRUE,
+     col=c("orange", "green", "wheat")[a.iris$frame$yval], under.col="red",
+     border.col=c(3,4), nn.col=c(2,3),
+     split.border.col=5,
+     shadow.col="black",
+     split.shadow.col="lightgray",
+     branch.col=c("orange4", "white"),
+     branch.lwd=c(3,2), branch.lty=1:3)
> rpart.plot(a.iris, main="rpart.plot\ndefault")
> rpart.plot(a.iris, box.palette=0, main="rpart.plot\nbox.palette=0")
> par(bg=old.bg)
> par(mfrow=c(1, 1))
> 
> par(mfrow=c(2, 3))
> a <- rpart(survived~., data=ptitanic, control=list(cp=.01))
> prp(a, uniform=T, branch=.4, compress=T, extra=104, trace=2, main="Page 21")
initial scale 0.931
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.931   xlim c(0, 1)   ylim c(0, 1)
> prp(a, uniform=T, branch=.4, compress=T, extra=104, mar=c(1,2,3,4), trace=2, main="test mar=c(1,2,3,4)")
initial scale 0.816
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.816   xlim c(0, 1)   ylim c(0, 1)
> prp(a, uniform=T, branch=.4, compress=T, extra=104, mar=c(5,2,3,4), trace=2, main="test mar=c(5,2,3,4)")
initial scale 0.816
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.816   xlim c(0, 1)   ylim c(0, 1)
> prp(a, uniform=T, branch=.4, compress=T, extra=104, xpd=T, trace=2, prefix="123456789", cex=1, main="test xpd=T, par=1")
initial scale 0.562
    node shifter: cex improvement 0.778 shift.amount 1.5  
    node shifter: skipping invalid      shift.amount 2.0 
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> prp(a, uniform=T, branch=.4, compress=T, extra=104, xpd=F, trace=2, prefix="123456789", cex=1, main="test xpd=F, par=1")
initial scale 0.562
    node shifter: cex improvement 0.778 shift.amount 1.5  
    node shifter: skipping invalid      shift.amount 2.0 
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 1   xlim c(0, 1)   ylim c(0, 1)
> par(mfrow=c(1, 1))
> 
> # shadows (also test different values for yesno)
> 
> a <- rpart(pclass ~ ., data=ptitanic, control=rpart.control(cp=.01))
> par(mfrow=c(2,3))
> prp(a, type=0, faclen=0, extra=1, under=F, shadow.col="darkgray", nn=T, yesno=0, split.shadow.col="darkgray", main="Page 22")
> prp(a, type=1, faclen=0, extra=1, under=F, shadow.col="darkgray", nn=T, yesno=1, main="type=1\nyesno=1")
> prp(a, type=1, faclen=0, extra=2, under=T, shadow.col="darkgray", nn=T, yesno=2, main="type=1\nyesno=2")
> prp(a, type=2, faclen=0, extra=3, under=F, shadow.col="darkgray", nn=T, yesno=0, split.shadow.col="darkgray", main="type=2\nyesno=0")
> prp(a, type=3, faclen=0, extra=4, under=T, shadow.col="darkgray", nn=T, yesno=1, split.shadow.col="darkgray", main="type=3\nyesno=1")
> prp(a, type=4, faclen=0, extra=101, under=T, shadow.col="darkgray", nn=T, yesno=2, split.shadow.col="darkgray", main="type=4\nyesno=2")
> par(mfrow=c(1,1))
> 
> # misc.
> 
> # test that do.par correctly restores eveything, also test do.par=FALSE
> a <- rpart(pclass ~ ., data=ptitanic, cp=.005)
> par(mfrow=c(3,3))
> old.par <- par(no.readonly=TRUE)
> prp(a, trace=2, main="Page 23") # trace=2 so can see the grid
initial scale 1.06
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
clipped scale 1.06 to max.auto.cex 1
cex 1   xlim c(0, 1)   ylim c(0, 1)
>     # set par settings that can legally change to NULL for comparison
>     old.par$usr <- old.par$fig <- old.par$mfg <- old.par$xaxp <- old.par$yaxp <- NULL
>     par <- par(no.readonly=TRUE)
>     par$usr <- par$fig <- par$mfg <- par$xaxp <- par$yaxp <- NULL
>     stopifnot(isTRUE(all.equal(old.par, par)))
> prp(a, trace=2, main="do.par=FALSE", do.par=FALSE)
initial scale 0.816
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.816   xlim c(0, 1)   ylim c(0, 1)
>     par <- par(no.readonly=TRUE)
>     par$usr <- par$fig <- par$mfg <- par$xaxp <- par$yaxp <- NULL
>     stopifnot(isTRUE(all.equal(old.par, par)))
> par(mfrow=c(1,1))
> 
> # different branch types (also test different values for yesno)
> a <- rpart(pclass ~ ., data=ptitanic, cp=.02)
> par(mfrow=c(2,3))
> prp(a, branch.type=5, yesno=0, main="Page 24")
> prp(a, branch.type=1, yesno=1, main="branch.type=1\ndev  yesno=1")
> prp(a, branch.type=2, yesno=2, main="branch.type=2\nsqrt(dev)\nuniform=FALSE  yesno=2", uniform=FALSE)
> prp(a, branch.type=6, yesno=0, fallen.leaves=T, main="branch.type=6\ncomplexity\nfallen.leaves  yesno=0")
> prp(a, branch.type=7, yesno=1, fallen.leaves=T, main="branch.type=7\nabs(yval)\nfallen.leaves  yesno=1")
> prp(a, branch.type=8, yesno=2, main="branch.type=8\nyval - min(yval)  yesno=2")
> 
> par(mfrow=c(2,3))
> # continuous response
> a.age <- rpart(age~., data=ptitanic, cp=.04)
> prp(a.age, branch.type=7, branch.col="pink", main="Page 25")
> 
> # test different types with branch.type
> # prp(a, type=1, branch.type=5, branch.col="slategray3", main="type=1\nbranch.type=5") # already tested
> prp(a, type=2, branch.type=5, branch.col="slategray3", main="type=2\nbranch.type=5\n")
> # prp(a, type=3, branch.type=5, branch.col="slategray3", main="type=1\nbranch.type=5") # not yet supported
> # prp(a, type=4, branch.type=5, branch.col="slategray3", main="type=1\nbranch.type=5") # not yet supported
> prp(a, type=2, branch.type=3, branch=0, branch.col="slategray3", main="type=2\nbranch.type=3\nbranch=0")
> prp(a, type=2, branch.type=4, branch=1, main="type=2\nbranch.type=4\nbranch=1",
+     branch.col=c("slategray","slateblue2","slateblue")[a$frame$yval])
> 
> branch.fun1 <- function(x)
+ {
+     width <- x$frame$wt
+ }
> root <- rpart(survived ~ ., data=ptitanic, cp=.5)
> prp(a, branch.type=branch.fun1, branch.col="slategray3", main="branch.fun1")
> 
> par(mfrow=c(2,3))
> prp(root, branch.type=5, main="Page 26")
> prp(a, branch=0, branch.type=5, branch.tweak=1.5, branch.col="slategray3",
+     branch.fill=2, main="branch.type=5\nbranch args")
> 
> par(mfrow=c(4,4))
> set.seed(1924)
> root <- rpart(survived ~ ., data=ptitanic, cp=.5)
> temp <- prp(root, main="Page 27")
> print(temp)
$obj
n= 1309 

node), split, n, loss, yval, (yprob)
      * denotes terminal node

1) root 1309 500 died (0.6180290 0.3819710) *

$snipped.nodes
NULL

$xlim
[1] 0 1

$ylim
[1] 0 1

$x
[1] 0.5

$y
[1] 0.5

$branch.x
  [,1]
x  0.5
    NA
    NA

$branch.y
  [,1]
y  0.5
    NA
    NA

$labs
[1] "died"

$cex
[1] 1

$boxes
$boxes$x1
[1] 0.4308005

$boxes$y1
[1] 0.4675309

$boxes$x2
[1] 0.5691995

$boxes$y2
[1] 0.5974073


$split.labs
[1] ""

$split.cex
[1] 1

$split.box
$split.box$x1
[1] NA

$split.box$y1
[1] NA

$split.box$x2
[1] NA

$split.box$y2
[1] NA


> prp(root, type=1, main="type=1")
> prp(root, type=2, extra=1, main="type=2, extra=1")
> prp(root, type=3, extra=2, under=T, main="type=3, extra=4, under=T")
> prp(root, type=4, extra=3, main="type=4, extra=4",
+     prefix="l[", suffix="]r",
+     split.prefix="L[", split.suffix="]L",
+     right.split.prefix="R[", right.split.suffix="]R",
+     round=9, leaf.round=0)
> prp(root, branch.type=5, main="branch.type=5")
> par(mfrow=c(1,1))
> 
> source("vignette.R", echo=TRUE)

> library(rpart.plot)

> library(earth)

> data(ptitanic)

> data(ozone1)

> par(mfrow = c(3, 3))

> par(mgp = c(1.5, 0.5, 0))

> a <- rpart(O3 ~ ., data = ozone1, cp = 0.024)

> y <- a$frame$yval

> cols <- c("lightcoral", "khaki2", "palegreen2")

> cols <- ifelse(y > 20, cols[1], ifelse(y < 15, cols[3], 
+     cols[2]))

> prp(a, main = "[front] An Example\nmanual palette=\nc(\"lightcoral\", \"khaki2\", \"palegreen2\")", 
+     box.col = cols, type = 4, fallen = T, bra .... [TRUNCATED] 

> prp(a, main = "[front] An Example\nbox.palette=\nc(\"palegreen3\", \"khaki2\", \"lightcoral\")", 
+     type = 4, fallen = T, branch = 0.3, round =  .... [TRUNCATED] 

> prp(a, main = "[front] An Example\nbox.palette=\"GnYlRd\"", 
+     type = 4, fallen = T, branch = 0.3, round = 0, leaf.round = 9, 
+     clip.right. .... [TRUNCATED] 

> binary.model <- rpart(survived ~ ., data = ptitanic, 
+     cp = 0.02)

> rpart.plot(binary.model, tweak = 0.9, cex.main = 0.9, 
+     main = "\ntitanic survived\n(binary response)")

> anova.model <- rpart(Mileage ~ ., data = cu.summary)

> rpart.plot(anova.model, tweak = 0.9, cex.main = 0.9, 
+     main = "\n\n\nmiles per gallon\n(continuous response)\n")

> multi.class.model <- rpart(Reliability ~ ., data = cu.summary)

> rpart.plot(multi.class.model, tweak = 1, cex.main = 0.9, 
+     legend.cex = 1.3, legend.y = 1.15, main = "\nvehicle reliability\n(multi class respo ..." ... [TRUNCATED] 

> tree <- rpart(survived ~ ., data = ptitanic, cp = 0.02)

> plot(tree, uniform = TRUE, compress = TRUE, branch = 0.2)

> text(tree, use.n = TRUE, cex = 0.6, xpd = NA)

> title("compare to the plotting functions\nin the rpart package", 
+     cex.sub = 0.8)

> a <- rpart(survived ~ ., data = ptitanic, control = list(cp = 0.02))

> prp(a, faclen = 0, type = 0, main = "[type] type = 0\n(default)\n")

> prp(a, faclen = 0, type = 1, main = "type = 1\nlabel all nodes\n(like text.rpart all=TRUE)")

> prp(a, faclen = 0, type = 2, main = "type = 2\nsplit labels below node labels\n")

> prp(a, faclen = 0, type = 3, main = "type = 3\nleft and right split labels\n")

> prp(a, faclen = 0, type = 4, main = "type = 4\nlike type=3 but with interior labels\n(like text.rpart fancy=TRUE)")

> a <- rpart(Volume ~ ., data = trees, cp = 0.5)

> prp(a, clip.right.labs = F, split.cex = 0.8, tweak = 1.3, 
+     type = 4, extra = 0, yesno = F, faclen = 0, under = T, cex.main = 1.3, 
+     main  .... [TRUNCATED] 

> prp(a, clip.right.labs = F, split.cex = 0.8, tweak = 1.3, 
+     type = 4, extra = 1, yesno = F, faclen = 0, under = T, cex.main = 1.3, 
+     main  .... [TRUNCATED] 

> prp(a, clip.right.labs = F, split.cex = 0.8, tweak = 1.3, 
+     type = 4, extra = 100, yesno = F, faclen = 0, under = T, 
+     cex.main = 1.3, mai .... [TRUNCATED] 

> prp(a, clip.right.labs = F, split.cex = 0.8, tweak = 1.3, 
+     type = 4, extra = 101, yesno = F, faclen = 0, under = T, 
+     cex.main = 1.3, mai .... [TRUNCATED] 

> a <- rpart(survived ~ ., data = ptitanic, cp = 0.03)

> prp(a, under.cex = 1, type = 4, faclen = 0, under = T, 
+     extra = 0, cex.main = 1, main = "[class-extra] extra = 0\ndefault\n")

> prp(a, under.cex = 1, type = 4, faclen = 0, under = T, 
+     extra = 1, cex.main = 1, main = "extra = 1\nnbr of obs per class\n")

> prp(a, under.cex = 1, type = 4, faclen = 0, under = T, 
+     extra = 2, cex.main = 1, main = "extra = 2\nclass rate\n")

> prp(a, under.cex = 1, type = 4, faclen = 0, under = T, 
+     extra = 3, cex.main = 1, main = "extra = 3\nmisclass rate\n")

> prp(a, under.cex = 1, type = 4, faclen = 0, under = T, 
+     extra = 4, cex.main = 1, main = "extra = 4\nprob per class\n(leaf probs sum to 1)")

> prp(a, under.cex = 1, type = 4, faclen = 0, under = T, 
+     extra = 5, cex.main = 1, main = "extra = 5\nprob per class,\nfitted class not displaye ..." ... [TRUNCATED] 

> prp(a, under.cex = 1, type = 4, faclen = 0, under = T, 
+     extra = 6, cex.main = 1, main = "extra = 6\nprob of 2nd class\n(useful for binary resp ..." ... [TRUNCATED] 

> prp(a, under.cex = 1, type = 4, faclen = 0, under = T, 
+     extra = 7, cex.main = 1, main = "extra = 7\nprob of 2nd class,\nfitted class not displ ..." ... [TRUNCATED] 

> prp(a, under.cex = 1, type = 4, faclen = 0, under = T, 
+     extra = 8, cex.main = 1, main = "extra = 8\nprob of fitted class\n")

> prp(a, under.cex = 1, type = 4, faclen = 0, under = T, 
+     extra = 9, cex.main = 1, main = "extra = 9\noverall prob\n(sum over all leaves is 1)")

> prp(a, under.cex = 1, type = 4, faclen = 0, under = T, 
+     extra = 100, cex.main = 1, main = "extra = 100\npercent of obs\n")

> prp(a, under.cex = 1, type = 4, faclen = 0, under = T, 
+     extra = 106, cex.main = 1, main = "extra = 106\nprob of 2nd class and\npercent of obs" .... [TRUNCATED] 

> tree <- rpart(survived ~ ., data = ptitanic, cp = 0.02)

> prp(tree, extra = 7, prefix = "fraction\n", tweak = 1.2, 
+     main = "[fraction]")

> tree <- rpart(survived ~ ., data = ptitanic, cp = 0.02)

> my.node.fun <- function(x, labs, digits, varlen) {
+     paste("dev", x$frame$dev)
+ }

> prp(tree, node.fun = my.node.fun, tweak = 1.2, main = "[dev]")

> tree <- rpart(survived ~ ., data = ptitanic, cp = 0.02)

> my.node.fun2 <- function(x, labs, digits, varlen) {
+     paste(labs, "\ndev", x$frame$dev)
+ }

> prp(tree, extra = 6, node.fun = my.node.fun2, tweak = 1.2, 
+     main = "[standard-plus-dev]")

> tree <- rpart(survived ~ ., data = ptitanic, cp = 0.02)

> my.node.fun3 <- function(x, labs, digits, varlen) {
+     paste(labs, "\n\ndev", x$frame$dev)
+ }

> prp(tree, extra = 6, node.fun = my.node.fun3, tweak = 1.2, 
+     main = "[double-newline-dev]")

> tree <- rpart(survived ~ ., data = ptitanic, cp = 0.02)

> prp(tree, extra = 6, tweak = 1.2, main = "prefix-col", 
+     box.col = ifelse(tree$frame$yval == 2, "palegreen3", "pink"))

> old.par <- par(no.readonly = TRUE)

> par(mfrow = c(4, 5))

> data(ptitanic)

> tree1 <- rpart(survived ~ ., data = ptitanic, cp = 0.012)

> par(mfrow = c(4, 3), mar = c(0, 0, 2, 0))

> for (iframe in 1:nrow(tree1$frame)) {
+     cols <- ifelse(1:nrow(tree1$frame) <= iframe, "black", "gray")
+     dev.hold()
+     prp(tree1, compres .... [TRUNCATED] 

> par(old.par)

> tree <- rpart(survived ~ ., data = ptitanic, cp = 0.02)

> path.to.root <- function(node) {
+     if (node == 1) 
+         node
+     else c(node, path.to.root(node%/%2))
+ }

> node <- 11

> nodes <- as.numeric(row.names(tree$frame))

> cols <- ifelse(nodes %in% path.to.root(node), "sienna", 
+     "gray")

> prp(tree, nn = TRUE, col = cols, branch.col = cols, 
+     split.col = cols, nn.col = cols, tweak = 1.2, main = "[path-to-root]")

> old.bg <- par(bg = "gray50")

> iris.tree <- rpart(Species ~ ., data = iris)

> prp(iris.tree, type = 0, extra = 8, main = "[gray-background]", 
+     under = TRUE, yesno = FALSE, varlen = 0, faclen = 0, tweak = 1.4, 
+     col  .... [TRUNCATED] 

> par(bg = old.bg)

> tree <- rpart(survived ~ ., data = ptitanic, cp = 0.012)

> new.tree <- prp(tree, main = "[snip-part1]")$obj

> prp(new.tree, main = "[snip-part2]")

> par(mfrow = c(2, 2))

> heat.tree <- function(tree, low.is.green = FALSE, 
+     ...) {
+     y <- tree$frame$yval
+     if (low.is.green) 
+         y <- -y
+     max <- m .... [TRUNCATED] 

> data(ptitanic)

> tree <- rpart(age ~ ., data = ptitanic)

> heat.tree(tree, type = 4, varlen = 0, faclen = 0, 
+     fallen.leaves = TRUE)

> heat.tree(tree, low.is.green = TRUE)

> par(mfrow = c(3, 3))

> a <- rpart(survived ~ ., data = ptitanic, cp = 0.01)

> prp(a, compress = FALSE, ycompress = FALSE, main = "[compress]\ncompress=FALSE\nycompress=FALSE", 
+     cex.main = 0.9, trace = 1)
cex 0.688   xlim c(0, 1)   ylim c(0, 1)

> text(0.2, -0.12, "calculated cex:\n0.44", cex = 1, 
+     xpd = NA, font = 3, col = rgb(0.1, 0.2, 0.4))

> prp(a, compress = TRUE, ycompress = FALSE, main = "\ncompress=TRUE (default)\nycompress=FALSE", 
+     cex.main = 0.9, trace = 1)
cex 0.931   xlim c(0, 1)   ylim c(0, 1)

> text(0.2, 0.15, "calculated cex:\n0.69", cex = 1, 
+     xpd = NA, font = 3, col = rgb(0.1, 0.2, 0.4))

> prp(a, compress = TRUE, ycompress = TRUE, main = "\ncompress=TRUE (default)\nycompress=TRUE (default)", 
+     cex.main = 0.9, trace = 1)
cex 0.931   xlim c(0, 1)   ylim c(0, 1)

> text(0.2, 0.2, "calculated cex:\n0.82", cex = 1, xpd = NA, 
+     font = 3, col = rgb(0.1, 0.2, 0.4))

> plot(1, 1, type = "n", xlab = "", ylab = "", xaxt = "n", 
+     yaxt = "n", bty = "n")

> plot(1, 1, type = "n", xlab = "", ylab = "", xaxt = "n", 
+     yaxt = "n", bty = "n")

> plot(1, 1, type = "n", xlab = "", ylab = "", xaxt = "n", 
+     yaxt = "n", bty = "n")

> a <- rpart(survived ~ ., data = ptitanic, cp = 0.1)

> prp(a, ycompact = FALSE, xcompact = FALSE, faclen = 0, 
+     trace = 1, extra = 6, main = "[compact] xcompact=FALSE\nycompact=FALSE", 
+     cex.ma .... [TRUNCATED] 
cex 1 (before applying tweak 1.2)   xlim c(0, 1)   ylim c(0, 1)

> rect(-0.05, -0.1, 1.05, 1.2, xpd = NA)

> prp(a, faclen = 0, trace = 1, extra = 6, main = "\ndefault:\nxcompact=TRUE\nycompact=TRUE", 
+     cex.main = 1, split.border.col = 0, tweak = 1.2)
cex 1 (before applying tweak 1.2)   xlim c(-0.65, 1.65)   ylim c(-0.75, 1.75)

> rect(-0.76, -1.96, 1.76, 3.35, xpd = NA)

> fit <- rpart(Kyphosis ~ Age + Number + Start, data = kyphosis)

> oldpar <- par(mfrow = c(1, 2), xpd = NA)

> plot(fit)

> text(fit, use.n = TRUE)

> prp(fit, extra = 1, uniform = F, branch = 1, yesno = F, 
+     border.col = 0, xsep = "/")

> par(oldpar)

> a9 <- rpart(Price/1000 ~ Mileage + Type + Country, 
+     cu.summary)

> split.fun <- function(x, labs, digits, varlen, faclen) {
+     gsub(" = ", ":\n", labs)
+ }

> prp(a9, extra = 100, under = T, yesno = F, split.fun = split.fun, 
+     main = "a9 (split.fun example)")

> tree <- rpart(survived ~ ., data = ptitanic, cp = 0.02)

> print(as.numeric(row.names(tree$frame)))
[1]  1  2  4  5 10 11  3

> node <- 2

> print(node%/%2)
[1] 1

> print(inode <- match(node, nodes))
[1] 2

> print(is.leaf <- tree$frame$var == "<leaf>")
[1] FALSE FALSE  TRUE FALSE  TRUE  TRUE  TRUE

> print(nodes[is.leaf])
[1]  4 10 11  3

> print(is.left <- nodes%%2 == 0)
[1] FALSE  TRUE  TRUE FALSE  TRUE FALSE FALSE

> print(ifelse(is.left, nodes + 1, nodes - 1))
[1]  0  3  5  4 11 10  2

> get.children <- function(node) if (is.leaf[match(node, 
+     nodes)]) {
+     node
+ } else c(node, get.children(2 * node), get.children(2 * node + .... [TRUNCATED] 

> print(get.children(2))
[1]  2  4  5 10 11

> tree.split.label12 <- rpart(Price/1000 ~ Mileage + 
+     Type + Country, cu.summary)

> split.fun <- function(x, labs, digits, varlen, faclen) {
+     gsub(" = ", ":\n", labs)
+ }

> prp(tree.split.label12, extra = 1, branch = 1, split.border.col = 1, 
+     branch.col = "gray", split.yspace = 1.5, main = "split-label12")

> prp(tree.split.label12, extra = 1, branch = 1, split.border.col = 1, 
+     branch.col = "gray", , split.yspace = 1.5, split.fun = split.fun)

> prp(tree.split.label12, extra = 100, under = T, yesno = F, 
+     split.fun = split.fun, tweak = 0.8)

> tree.split.label13 <- rpart(Price/1000 ~ Mileage + 
+     Type + Country, cu.summary)

> split.fun <- function(x, labs, digits, varlen, faclen) {
+     labs <- gsub(",", " ", labs)
+     for (i in 1:length(labs)) {
+         labs[i] <- p .... [TRUNCATED] 

> prp(tree, cex = 1.05)

> prp(tree.split.label13, split.fun = split.fun, main = "split-label13")

> old.par <- par(mfrow = c(3, 3), mar = c(5, 4, 2, 2))

> binary.model <- rpart(survived ~ ., data = ptitanic, 
+     cp = 0.02)

> rpart.plot(binary.model, tweak = 1.15, cex.main = 1.1, 
+     main = "rpart.plot (default)\n")

> rpart.plot(binary.model, tweak = 1, cex.main = 1.1, 
+     extra = 104, box.palette = "GnBu", nn = TRUE, branch.lty = 3, 
+     shadow.col = "gray", .... [TRUNCATED] 

> library(rattle, quietly = TRUE)
Rattle: A free graphical interface for data science with R.
Version 5.1.0 Copyright (c) 2006-2017 Togaware Pty Ltd.
Type 'rattle()' to shake, rattle, and roll your data.

> fancyRpartPlot(binary.model, tweak = 0.8, cex.main = 0.9, 
+     main = "\nfancyRpartPlot", sub = "")

> par(old.par)

> kyphosis1 <- kyphosis

> kyphosis1$Age <- kyphosis1$Age/12

> tree <- rpart(Kyphosis ~ ., data = kyphosis1)

> old.par <- par(no.readonly = TRUE)

> par(mfrow = c(3, 3))

> par(mar = c(0.5, 0.5, 2, 0.5))

> par(mgp = c(1.6, 0.6, 0))

> prp(tree, extra = 7)

> par(mar = c(0.5, 1, 2, 0.5))

> set.seed(2016)

> plotmo(tree, degree1 = NA, do.par = F, theta = 220 - 
+     80, expand = 0.5, type = "prob", nresponse = "present", main = "", 
+     ticktype = "d" .... [TRUNCATED] 

> par(mar = c(4, 4, 4, 0.5))

> set.seed(2016)

> plotmo(tree, degree1 = NA, do.par = F, main = "", 
+     type2 = "image", pt.col = ifelse(kyphosis1$Kyphosis == "present", 
+         "red", "lightb ..." ... [TRUNCATED] 

> par(old.par)

> data(ozone1)

> old.par <- par(mfrow = c(3, 3), mar = c(0.5, 0.5, 
+     2.5, 0.5), cex = 0.6, mgp = c(1.6, 0.6, 0))

> a1 <- rpart(O3 ~ ., data = ozone1)

> prp(a1, type = 1, cex = 1, main = "ozone level         \n", 
+     Mar = -0.07)

> col.persp <- rgb(220, 255, 255, maxColorValue = 255)

> set.seed(2016)

> plotmo(a1, do.par = F, degree1 = NA, degree2 = "temp", 
+     expand = 1, swapxy = T, border = 1, ngrid2 = 20, col.persp = col.persp)

> a <- lm(O3 ~ ., data = ozone1)

> set.seed(2016)

> plotmo(a, degree1 = NA, all2 = T, swapxy = T, do.par = F, 
+     degree2 = 18, main = "linear model", clip = F, col.persp = col.persp)
Warning: too many predictors to plot all pairs,
         so plotting degree2 plots for just the first 7 predictors.
         Call plotmo with all2=2 to plot degree2 plots for up to 20 predictors.

> a <- earth(O3 ~ ., data = ozone1, degree = 2)

> set.seed(2016)

> plotmo(a, degree1 = NA, all2 = T, swapxy = T, do.par = F, 
+     degree2 = 18, main = "MARS", col.persp = col.persp)
Warning: too many predictors to plot all pairs,
         so plotting degree2 plots for just the first 7 predictors.
         Call plotmo with all2=2 to plot degree2 plots for up to 20 predictors.

> library(randomForest)
randomForest 4.6-14
Type rfNews() to see new features/changes/bug fixes.

Attaching package: 'randomForest'

The following object is masked from 'package:rattle':

    importance


> set.seed(552)

> a <- randomForest(O3 ~ ., data = ozone1)

> set.seed(2016)

> plotmo(a, degree1 = NA, swapxy = T, do.par = F, degree2 = 5, 
+     main = "random forest", col.persp = col.persp)

> par(old.par)
> par(mfrow=c(1,1))
> 
> set.seed(1924)
> # use.prp <- FALSE
> # source("rpart.report.with.prp.R", echo=TRUE)
> use.prp <- TRUE
> source("rpart.report.with.prp.R", echo=TRUE)

> cat("### Section 3\n")
### Section 3

> stagec <- read.table("data.stagec", col.names = c("pgtime", 
+     "pgstat", "age", "eet", "g2", "grade", "gleason", "ploidy"))

> progstat <- factor(stagec$pgstat, levels = 0:1, labels = c("No", 
+     "Prog"))

> cfit <- rpart(progstat ~ age + eet + g2 + grade + 
+     gleason + ploidy, data = stagec, method = "class")

> print(cfit)
n= 146 

node), split, n, loss, yval, (yprob)
      * denotes terminal node

 1) root 146 54 No (0.6301370 0.3698630)  
   2) grade< 2.5 61  9 No (0.8524590 0.1475410) *
   3) grade>=2.5 85 40 Prog (0.4705882 0.5294118)  
     6) g2< 13.2 35 14 No (0.6000000 0.4000000)  
      12) g2>=11.845 7  1 No (0.8571429 0.1428571) *
      13) g2< 11.845 28 13 No (0.5357143 0.4642857)  
        26) g2< 11.005 21  8 No (0.6190476 0.3809524) *
        27) g2>=11.005 7  2 Prog (0.2857143 0.7142857) *
     7) g2>=13.2 50 19 Prog (0.3800000 0.6200000)  
      14) g2>=17.91 25  9 No (0.6400000 0.3600000) *
      15) g2< 17.91 25  3 Prog (0.1200000 0.8800000) *

> par(mfrow = c(2, 3))

> if (use.prp) {
+     prp(cfit, main = "Section 3", uniform = F, branch = 1)
+ } else {
+     plot(cfit, main = "Section 3")
+     text(cfit)
+ }

> cat("### Section 4\n")
### Section 4

> n <- 200

> temp <- c(1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 0, 0, 1, 0, 
+     1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 0, 
+     1, 0, 1, 1, 0, 1, 0, 1, 1 .... [TRUNCATED] 

> lights <- matrix(temp, 10, 7, byrow = T)

> set.seed(1)

> temp1 <- matrix(rbinom(n * 7, 1, 0.9), n, 7)

> y <- rep(0:9, length = 200)

> temp1 <- ifelse(lights[y + 1, ] == 1, temp1, 1 - temp1)

> temp2 <- matrix(rbinom(n * 17, 1, 0.5), n, 17)

> x <- cbind(temp1, temp2)

> temp3 <- rpart.control(xval = 10, minbucket = 2, minsplit = 4, 
+     cp = 0)

> dfit <- rpart(y ~ x, method = "class", control = temp3)

> printcp(dfit)

Classification tree:
rpart(formula = y ~ x, method = "class", control = temp3)

Variables actually used in tree construction:
 [1] x1  x11 x12 x13 x16 x18 x19 x2  x21 x3  x4  x5  x6  x7  x8 

Root node error: 180/200 = 0.9

n= 200 

          CP nsplit rel error  xerror      xstd
1  0.1111111      0   1.00000 1.10000 0.0078174
2  0.1000000      1   0.88889 1.05000 0.0179118
3  0.0888889      2   0.78889 0.94444 0.0280542
4  0.0833333      3   0.70000 0.77778 0.0360041
5  0.0777778      5   0.53333 0.77778 0.0360041
6  0.0666667      6   0.45556 0.63333 0.0388968
7  0.0500000      7   0.38889 0.46667 0.0387776
8  0.0222222      8   0.33889 0.40000 0.0377124
9  0.0166667      9   0.31667 0.39444 0.0375956
10 0.0111111     10   0.30000 0.37222 0.0370831
11 0.0083333     15   0.24444 0.37778 0.0372181
12 0.0055556     22   0.18333 0.37778 0.0372181
13 0.0037037     31   0.13333 0.41111 0.0379327
14 0.0000000     34   0.12222 0.42222 0.0381356

> fit9 <- prune(dfit, cp = 0.02)

> if (use.prp) {
+     prp(fit9, branch = 0.3, compress = T, main = "Section 4", 
+         trace = 1)
+ } else {
+     plot(fit9, branch = 0.3, compr .... [TRUNCATED] 
Variable name 'x1' in splits is not in terms$dataClasses:
           y            x 
   "numeric" "nmatrix.24" 
cex 1   xlim c(0, 1)   ylim c(0, 1)

> cat("### Section 5\n")
### Section 5

> printcp(cfit)

Classification tree:
rpart(formula = progstat ~ age + eet + g2 + grade + gleason + 
    ploidy, data = stagec, method = "class")

Variables actually used in tree construction:
[1] g2    grade

Root node error: 54/146 = 0.36986

n= 146 

        CP nsplit rel error  xerror    xstd
1 0.117284      0   1.00000 1.00000 0.10802
2 0.027778      3   0.64815 0.87037 0.10454
3 0.010000      5   0.59259 0.85185 0.10395

> summary(cfit, cp = 0.06)
Call:
rpart(formula = progstat ~ age + eet + g2 + grade + gleason + 
    ploidy, data = stagec, method = "class")
  n= 146 

          CP nsplit rel error    xerror      xstd
1 0.11728395      0 1.0000000 1.0000000 0.1080241
2 0.02777778      3 0.6481481 0.8703704 0.1045433
3 0.01000000      5 0.5925926 0.8518519 0.1039462

Variable importance
     g2   grade gleason  ploidy     age     eet 
     31      31      21      10       5       2 

Node number 1: 146 observations,    complexity param=0.117284
  predicted class=No    expected loss=0.369863  P(node) =1
    class counts:    92    54
   probabilities: 0.630 0.370 
  left son=2 (61 obs) right son=3 (85 obs)
  Primary splits:
      grade   < 2.5    to the left,  improve=10.357590, (0 missing)
      gleason < 5.5    to the left,  improve= 8.399574, (3 missing)
      ploidy  < 1.5    to the left,  improve= 7.656533, (0 missing)
      g2      < 13.2   to the left,  improve= 7.186766, (7 missing)
      age     < 58.5   to the right, improve= 1.388128, (0 missing)
  Surrogate splits:
      gleason < 5.5    to the left,  agree=0.863, adj=0.672, (0 split)
      ploidy  < 1.5    to the left,  agree=0.644, adj=0.148, (0 split)
      g2      < 9.945  to the left,  agree=0.630, adj=0.115, (0 split)
      age     < 66.5   to the right, agree=0.589, adj=0.016, (0 split)

Node number 2: 61 observations
  predicted class=No    expected loss=0.147541  P(node) =0.4178082
    class counts:    52     9
   probabilities: 0.852 0.148 

Node number 3: 85 observations,    complexity param=0.117284
  predicted class=Prog  expected loss=0.4705882  P(node) =0.5821918
    class counts:    40    45
   probabilities: 0.471 0.529 
  left son=6 (35 obs) right son=7 (50 obs)
  Primary splits:
      g2      < 13.2   to the left,  improve=2.1781360, (6 missing)
      ploidy  < 1.5    to the left,  improve=1.9834830, (0 missing)
      age     < 56.5   to the right, improve=1.6596080, (0 missing)
      gleason < 8.5    to the left,  improve=1.6386550, (0 missing)
      eet     < 1.5    to the right, improve=0.1086108, (1 missing)
  Surrogate splits:
      ploidy  < 1.5    to the left,  agree=0.924, adj=0.829, (6 split)
      age     < 68.5   to the right, agree=0.608, adj=0.114, (0 split)
      gleason < 6.5    to the left,  agree=0.582, adj=0.057, (0 split)

Node number 6: 35 observations
  predicted class=No    expected loss=0.4  P(node) =0.239726
    class counts:    21    14
   probabilities: 0.600 0.400 

Node number 7: 50 observations,    complexity param=0.117284
  predicted class=Prog  expected loss=0.38  P(node) =0.3424658
    class counts:    19    31
   probabilities: 0.380 0.620 
  left son=14 (25 obs) right son=15 (25 obs)
  Primary splits:
      g2      < 17.91  to the right, improve=5.24148300, (6 missing)
      age     < 61.5   to the right, improve=1.12666700, (0 missing)
      gleason < 7.5    to the left,  improve=0.25269950, (0 missing)
      eet     < 1.5    to the right, improve=0.06310024, (1 missing)
  Surrogate splits:
      age     < 61.5   to the right, agree=0.614, adj=0.190, (6 split)
      eet     < 1.5    to the right, agree=0.591, adj=0.143, (0 split)
      grade   < 3.5    to the right, agree=0.545, adj=0.048, (0 split)
      gleason < 6.5    to the right, agree=0.545, adj=0.048, (0 split)

Node number 14: 25 observations
  predicted class=No    expected loss=0.36  P(node) =0.1712329
    class counts:    16     9
   probabilities: 0.640 0.360 

Node number 15: 25 observations
  predicted class=Prog  expected loss=0.12  P(node) =0.1712329
    class counts:     3    22
   probabilities: 0.120 0.880 


> cat("### Section 6\n")
### Section 6

> fit1 <- rpart(Reliability ~ Price + Country + Mileage + 
+     Type, data = cu.summary, parms = list(split = "gini"))

> fit2 <- rpart(Reliability ~ Price + Country + Mileage + 
+     Type, data = cu.summary, parms = list(split = "information"))

> par(mfrow = c(1, 2))

> if (use.prp) {
+     prp(fit1, extra = T, main = "Section 6\ngini", uniform = F, 
+         branch = 1, xsep = "/", under = T)
+     prp(fit2, extra .... [TRUNCATED] 

> par(mfrow = c(1, 1))

> lmat <- matrix(c(0, 4, 3, 0), nrow = 2, ncol = 2, 
+     byrow = F)

> fit1 <- rpart(Kyphosis ~ Age + Number + Start, data = kyphosis)

> fit2 <- rpart(Kyphosis ~ Age + Number + Start, data = kyphosis, 
+     parms = list(prior = c(0.65, 0.35)))

> fit3 <- rpart(Kyphosis ~ Age + Number + Start, data = kyphosis, 
+     parms = list(loss = lmat))

> par(mfrow = c(1, 3))

> if (use.prp) {
+     prp(fit1, main = "Section 6a", extra = T, type = 1, uniform = F, 
+         branch = 1)
+     prp(fit2, extra = T, type = 4, un .... [TRUNCATED] 

> par(mfrow = c(1, 1))

> cat("### Section 7\n")
### Section 7

> data(car.test.frame)

> cars <- car.test.frame

> fit3 <- rpart(Price ~ ., data = cars)

> fit3
n= 60 

node), split, n, deviance, yval
      * denotes terminal node

 1) root 60 983551500 12615.670  
   2) Weight< 2980 36 283686500 10442.580  
     4) Type=Small 13  21804710  7682.385 *
     5) Type=Compact,Medium,Sporty 23 106857900 12002.700  
      10) Country=Japan/USA,Korea,USA 15  21272980 11261.200 *
      11) Country=France,Germany,Japan 8  61874100 13393.000 *
   3) Weight>=2980 24 274858800 15875.290  
     6) Country=USA 14  47843040 14185.710 *
     7) Country=Japan,Sweden 10 131098800 18240.700 *

> printcp(fit3)

Regression tree:
rpart(formula = Price ~ ., data = cars)

Variables actually used in tree construction:
[1] Country Type    Weight 

Root node error: 983551497/60 = 16392525

n= 60 

        CP nsplit rel error  xerror    xstd
1 0.432114      0   1.00000 1.08415 0.22382
2 0.157616      1   0.56789 0.89295 0.17252
3 0.097521      2   0.41027 0.75347 0.17287
4 0.024107      3   0.31275 0.67654 0.15105
5 0.010000      4   0.28864 0.66649 0.14773

> print(fit3, cp = 0.1)
n= 60 

node), split, n, deviance, yval
      * denotes terminal node

1) root 60 983551500 12615.670  
  2) Weight< 2980 36 283686500 10442.580  
    4) Type=Small 13  21804710  7682.385 *
    5) Type=Compact,Medium,Sporty 23 106857900 12002.700 *
  3) Weight>=2980 24 274858800 15875.290 *

> summary(fit3, cp = 0.1)
Call:
rpart(formula = Price ~ ., data = cars)
  n= 60 

          CP nsplit rel error    xerror      xstd
1 0.43211383      0 1.0000000 1.0841527 0.2238160
2 0.15761648      1 0.5678862 0.8929462 0.1725168
3 0.09752105      2 0.4102697 0.7534675 0.1728720
4 0.02410734      3 0.3127486 0.6765415 0.1510521
5 0.01000000      4 0.2886413 0.6664934 0.1477282

Variable importance
     Weight       Disp.        Type          HP     Mileage     Country 
         23          21          18          16          14           8 
Reliability 
          1 

Node number 1: 60 observations,    complexity param=0.4321138
  mean=12615.67, MSE=1.639252e+07 
  left son=2 (36 obs) right son=3 (24 obs)
  Primary splits:
      Weight  < 2980   to the left,  improve=0.4321138, (0 missing)
      HP      < 104.5  to the left,  improve=0.4141712, (0 missing)
      Type    splits as  RRRLRR,     improve=0.4106497, (0 missing)
      Disp.   < 115    to the left,  improve=0.4083029, (0 missing)
      Mileage < 24.5   to the right, improve=0.3628025, (0 missing)
  Surrogate splits:
      Disp.   < 158    to the left,  agree=0.917, adj=0.792, (0 split)
      HP      < 132.5  to the left,  agree=0.867, adj=0.667, (0 split)
      Mileage < 22.5   to the right, agree=0.850, adj=0.625, (0 split)
      Type    splits as  LRRLLR,     agree=0.850, adj=0.625, (0 split)
      Country splits as  LLLLLLRR,   agree=0.650, adj=0.125, (0 split)

Node number 2: 36 observations,    complexity param=0.1576165
  mean=10442.58, MSE=7880181 
  left son=4 (13 obs) right son=5 (23 obs)
  Primary splits:
      Type    splits as  R-RLR-,     improve=0.5464621, (0 missing)
      Weight  < 2462.5 to the left,  improve=0.5308886, (0 missing)
      Disp.   < 115    to the left,  improve=0.4550460, (0 missing)
      Mileage < 31     to the right, improve=0.4382905, (0 missing)
      HP      < 105.5  to the left,  improve=0.4144004, (0 missing)
  Surrogate splits:
      Weight  < 2462.5 to the left,  agree=0.944, adj=0.846, (0 split)
      Disp.   < 115    to the left,  agree=0.917, adj=0.769, (0 split)
      HP      < 91     to the left,  agree=0.861, adj=0.615, (0 split)
      Mileage < 27.5   to the right, agree=0.833, adj=0.538, (0 split)
      Country splits as  RRRRLL-R,   agree=0.694, adj=0.154, (0 split)

Node number 3: 24 observations
  mean=15875.29, MSE=1.145245e+07 

Node number 4: 13 observations
  mean=7682.385, MSE=1677286 

Node number 5: 23 observations
  mean=12002.7, MSE=4645995 


> par(mfrow = c(1, 2))

> if (use.prp) {
+     prp(fit3, extra = T, main = "Section 7", uniform = F, under = T)
+ } else {
+     plot(fit3)
+     text(fit3, use.n = T, main = .... [TRUNCATED] 

> prp(fit3, extra = T, main = "Section 7 (negative digits)", 
+     uniform = F, under = T, digits = -6)

> par(mfrow = c(1, 1))

> cfit2 <- rpart(pgstat ~ age + eet + g2 + grade + gleason + 
+     ploidy, data = stagec)

> printcp(cfit2)

Regression tree:
rpart(formula = pgstat ~ age + eet + g2 + grade + gleason + ploidy, 
    data = stagec)

Variables actually used in tree construction:
[1] g2      gleason grade  

Root node error: 34.027/146 = 0.23306

n= 146 

        CP nsplit rel error  xerror     xstd
1 0.152195      0   1.00000 1.01206 0.045309
2 0.064308      1   0.84781 0.91485 0.066783
3 0.029446      3   0.71919 0.91640 0.082375
4 0.019350      4   0.68974 0.93745 0.084810
5 0.017213      5   0.67039 0.97689 0.089218
6 0.010000      8   0.61875 0.97910 0.090020

> print(cfit2, cp = 0.03)
n= 146 

node), split, n, deviance, yval
      * denotes terminal node

 1) root 146 34.027400 0.3698630  
   2) grade< 2.5 61  7.672131 0.1475410 *
   3) grade>=2.5 85 21.176470 0.5294118  
     6) g2< 13.2 35  8.400000 0.4000000 *
     7) g2>=13.2 50 11.780000 0.6200000  
      14) g2>=17.91 25  5.760000 0.3600000 *
      15) g2< 17.91 25  2.640000 0.8800000 *

> cat("### Section 8\n")
### Section 8

> cat("### Section 9\n")
### Section 9

> fit <- rpart(progstat ~ age + eet + g2 + grade + gleason + 
+     ploidy, stagec, control = rpart.control(cp = 0.025))

> if (use.prp) {
+     prp(fit, main = "Section 9", uniform = F, branch = 1)
+     prp(fit, uniform = T, extra = T, type = 1, main = "Section 9a")
+   .... [TRUNCATED] 

> cat("### Section 10\n")
### Section 10

> fit <- rpart(pgtime ~ age + eet + g2 + grade + gleason + 
+     ploidy, stagec)

> fit$cptable
          CP nsplit rel error   xerror      xstd
1 0.07572983      0 1.0000000 1.010926 0.1320113
2 0.02825076      2 0.8485403 1.083596 0.1514971
3 0.02576114      3 0.8202896 1.184928 0.1606846
4 0.02340241      5 0.7687673 1.184633 0.1583264
5 0.01789441      7 0.7219625 1.233281 0.1641593
6 0.01295145      8 0.7040681 1.246396 0.1710559
7 0.01000000      9 0.6911166 1.236969 0.1717074

> temp <- xpred.rpart(fit)

> err <- (stagec$pgtime - temp)^2

> sum.err <- apply(err, 2, sum)

> sum.err/(fit$frame)$dev[1]
0.53786491 0.04625392 0.02697724 0.02455346 0.02046393 0.01522362 0.01138044 
  1.018269   1.026593   1.114942   1.116595   1.090400   1.079545   1.126400 
> 
> # clip.left.labs and clip.right.labs
> par(mfrow=c(3,3))
> prp(tree, type=4, clip.left.labs=F, clip.right.labs=F, main="clip.left.labs=F, clip.right.labs=F")
> # prp(tree, type=4, clip.left.labs=F, clip.right.labs=T, main="clip.left.labs=F, clip.right.labs=T") #default
> prp(tree, type=3, clip.left.labs=T, clip.right.labs=F, main="clip.left.labs=T, clip.right.labs=F")
> prp(tree, type=3, clip.left.labs=T, clip.right.labs=T, main="clip.left.labs=T, clip.right.labs=T")
> 
> prp(tree, type=3, xflip=T, clip.left.labs=F, clip.right.labs=F, main="clip.left.labs=F, clip.right.labs=F\n                 xflip=T")
> prp(tree, type=3, xflip=T, clip.left.labs=F, clip.right.labs=T, main="clip.left.labs=F, clip.right.labs=T\n                 xflip=T")
> prp(tree, type=4, xflip=T, clip.left.labs=T, clip.right.labs=F, main="clip.left.labs=T, clip.right.labs=F\n                 xflip=T")
> prp(tree, type=4, xflip=T, clip.left.labs=T, clip.right.labs=T, main="clip.left.labs=T, clip.right.labs=T\n                 xflip=T")
> 
> prp(tree, type=4,          clip.left.labs=c(T, F, T), clip.right.labs=c(T, F, F), main="clip.labs vectorization")
> prp(tree, type=4, xflip=T, clip.left.labs=c(T, F, T), clip.right.labs=F,          main="xflip=T\nclip.labs vectorization")
> par(mfrow=c(1,1))
> 
> # TODO mvpart is no longer on CRAN
> #
> # # mvpart, must be last because it changes plot.rpart, text.rpart, etc.
> # library(mvpart)
> # data(spider)
> # par(mfrow=c(3,3))
> # a <- mvpart(data.matrix(spider[,1:12])~twigs+water,spider, legend=FALSE, all=TRUE)
> # prp(a, fallen=T, branch=1, under=T, type=0, extra=0, main="mvpart page 1\nnresp=12, extra=0")
> # prp(a, fallen=T, under=T, type=1, extra=2, main="nresp=12, extra=2, under=T", under.cex=1)
> # a <- mvpart(data.matrix(spider[,1:3])~twigs+water,spider, legend=FALSE, all=TRUE)
> # prp(a, under=T, type=1, extra=101, main="extra=101")
> # prp(a, under=T, type=2, extra=102, main="extra=102")
> # prp(a, under=T, type=4, extra=3,   main="extra=3, under=F")
> # prp(a, under=T, type=1, extra=4,   main="extra=4")
> # prp(a, under=T, type=1, extra=105, main="extra=105")
> #
> # prp(a, under=F, type=4, extra=106, main="mvpart page 2\nextra=106, under=F")
> # prp(a, under=T, type=4, extra=107, main="extra=107")
> # prp(a, under=T, type=1, extra=8,   main="extra=8")
> # prp(a, under=F, type=2, extra=109, main="extra=109, under=F")
> # prp(a, under=T, type=3, extra=110, main="extra=110")
> # prp(a, under=T, type=4, extra=111, main="extra=111")
> # par(mfrow=c(1,1))
> 
> # # TODO this seems to not work with the new version of rpart (4.0.2)
> # library(rpart.plot)
> # library(rpartOrdinal)
> # library(rpartScore)
> # data(lowbwt)
> # lowbwt <- lowbwt[1:80,]
> # lowbwt$Category.s <-
> #     ifelse(lowbwt$bwt <= 2500, 3,
> #     ifelse(lowbwt$bwt <= 3000, 2,
> #     ifelse(lowbwt$bwt <= 3500, 1,
> #                                0)))
> # # Gives error
> # a <- rpartScore(Category.s ~ age + lwt + race + smoke +
> #                 ptl + ht + ui + ftv, data = lowbwt)
> # prp(a, extra=100, main="rpartScore\nextra=100", under=TRUE)
> 
> # Cannot install rpartOrdinal: package 'rpartOrdinal' is not available (for R version 3.2.0)
> # library(rpartOrdinal)
> # data(lowbwt)
> # lowbwt$Category <- factor(
> #     ifelse(lowbwt$bwt<=2500,3,
> #     ifelse(lowbwt$bwt<=3000,2,
> #     ifelse(lowbwt$bwt<=3500,1,
> #                             0))),ordered=TRUE)
> # a <- rpart(Category~age+lwt+race+smoke+ptl+ht+ui+ftv,data=lowbwt,method=ordinal)
> # prp(a, main="rpartOrdinal\ntype=1, extra=0", type=1, extra=0, faclen=0)
> 
> # TODO mvpart is no longer on CRAN
> #
> # #--- appendix mvpart.R  ---
> #
> # library(mvpart)
> # library(rpart.plot)
> # data(spider)
> # set.seed(1)
> # response <- data.matrix(spider[,1:3, drop=F])
> # tree1 <- mvpart(response~herbs+reft+moss+sand+twigs+water, data=spider,
> #             legend=F, method="mrt", plot.add=F, xv="min")
> #
> # old.par <- par(par(mfrow=c(4,4)), mar = c(3, 3, 3, 1), mgp = c(1.5, .5, 0))
> # prp1 <- function(tree1, extra, main, type=1, under=T, col=1, yesno=F, tweak=1,
> #                  col.main="skyblue4", cex.main=1, ...)
> # {
> #     prp(tree1, type=type, extra=extra, main=main,
> #         under=under, col=col, yesno=yesno, tweak=tweak,
> #         col.main=col.main, cex.main=cex.main, ...)
> # }
> # prp1(tree1, extra=0, main="extra = 0\ndev", tweak=.8)
> # prp1(tree1, extra=1, type=3, main="extra = 1 (type=3)\ndev,  n")
> # prp1(tree1, extra=2, main="extra = 2\ndev,  frac", tweak=1.2)
> # prp1(tree1, extra=3, main="extra = 3\ndev,  frac / sum(frac)")
> # prp1(tree1, extra=4, main="extra = 4\nsqrt(dev)")
> # prp1(tree1, extra=5, main="extra = 5\nsqrt(dev),  n")
> # prp1(tree1, extra=6, main="extra = 6\nsqrt(dev),  frac", tweak=1.2)
> # prp1(tree1, extra=7, main="extra = 7\nsqrt(dev),  frac / sum(frac)", tweak=1.1)
> # prp1(tree1, extra=8, main="extra = 8\npredom species",   tweak=.8)
> # prp1(tree1, extra=9, main="extra = 9\npredom species,  n", tweak=1)
> # prp1(tree1, extra=10, main="extra = 10\npredom species,  frac", tweak=1.2)
> # prp1(tree1, extra=11, main="extra = 11\npredom spec,  frac / sum(frac)", tweak=1.15)
> # par(old.par)
> 
> par(mfrow=c(2,2))
> source("webpage-figs.R", echo=TRUE)

> tree <- rpart(survived ~ ., data = ptitanic, cp = 0.012)

> prp(tree, type = 4, extra = 6, faclen = 0, main = "rpart.plot", 
+     cex.main = 3, col.main = "slategray4", col = 1, max.auto.cex = 1.6)

> tree <- rpart(survived ~ ., data = ptitanic, cp = 0.012)

> prp(tree, branch.type = 5, yesno = FALSE, faclen = 0, 
+     main = "rpart.plot:\nbranch width shows number of observations", 
+     cex.main = 2, c .... [TRUNCATED] 

> library(earth)

> data(ozone1)

> path.to.root <- function(node, ancestors = NULL) {
+     if (node == 1) 
+         c(1, ancestors)
+     else c(node, path.to.root(node%/%2, ancesto .... [TRUNCATED] 

> fit.oz <- rpart(O3 ~ ., data = ozone1)

> node <- 22

> path <- path.to.root(node)

> nodes <- as.numeric(row.names(fit.oz$frame))

> cols <- ifelse(nodes %in% path, 1, "slategray4")

> lwds <- ifelse(nodes %in% path, 2, 1)

> lty <- ifelse(nodes %in% path, 1, 2)

> nn.box.cols <- ifelse(nodes %in% path, 1, "slategray4")

> prp(fit.oz, type = 2, clip.right.labs = F, nn = TRUE, 
+     tweak = 1.4, nn.cex = 1.2, nn.border = 0, nn.col = "white", 
+     main = paste("rpart. ..." ... [TRUNCATED] 

> old.bg <- par(bg = "gray20")

> iris.tree <- rpart(Species ~ ., data = iris)

> prp(iris.tree, type = 0, extra = 104, main = "Fisher's Iris Data", 
+     under = TRUE, yesno = FALSE, fallen.leaves = TRUE, branch = 0.2, 
+     lt .... [TRUNCATED] 

> par(bg = old.bg)
> 
> # test rpart.plot version 1.5.3 (deal with situation where user has
> # a variable named text in the current environment).
> # Also test use of FUN argument.
> 
> cat("\ntest rpart.plot version 1.5.3\n")

test rpart.plot version 1.5.3
> par(mfrow=c(3,3))
> a100 <- rpart(survived ~ ., data=ptitanic, cp=.02)
> title("a100a", cex=.6)
> prp(a100)
> title("a100b", cex=.6)
> text <- "this is not the text function"
> prp(a100) # graph should be identical to the one on its left
> title("a100c", cex=.6)
> expect.err(try(prp(a100, FUN=function(xbad, y1, labels, ...) text(xbad, y1, labels, ...))),
+            "the FUN argument to the prp function needs the following arguments")
Error : the FUN argument to the prp function needs the following arguments:
    x ...
You have:
    xbad y1 labels ...
Got error as expected from try(prp(a100, FUN = function(xbad, y1, labels, ...) text(xbad,     y1, labels, ...)))
> title("a100d", cex=.6)
> # user specified FUN only has to match up to the dots
> prp(a100, FUN=function(x, y1, labels, ...) text(x, y1, labels, ...))
> 
> my.text <- function(x, y, labels, ...) text(x, y, labels, ...)
> prp(a100, FUN=my.text)
> title("a100e", cex=.6)
> my.bad.text <- function(xbad, y, labels, ...) text(xbad, y, labels, ...)
> expect.err(try(prp(a100, FUN=my.bad.text)),
+            "the FUN argument to the prp function needs the following arguments")
Error : the FUN argument to the prp function needs the following arguments:
    x ...
You have:
    xbad y labels ...
Got error as expected from try(prp(a100, FUN = my.bad.text))
> title("a100f", cex=.6)
> # define the function text in the global environment and use that
> text <- function(x, y, labels, ...) graphics::text(x, y, paste0("my-", labels), ...)
> # TODO boxes below aren't sized correctly for the user generated text
> prp(a100, FUN=text)
> title("a100g", cex=.6)
> remove(text)
> 
> source("test.palette.R", echo=TRUE)

> library(rpart.plot)

> library(rattle, quietly = TRUE)

> data(ptitanic)

> library(earth)

> data(ozone1)

> options(warn = 1)

> cat0 <- function(...) cat(..., sep = "")

> expect.err <- function(object, expected.msg = "") {
+     if (class(object)[1] == "try-error") {
+         msg <- attr(object, "condition")$message[ .... [TRUNCATED] 

> par(mfrow = c(1, 1))

> show.prp.palettes()

> cat("== start test.palette.R ==\n")
== start test.palette.R ==

> describe.col <- function(col, show.hex = TRUE, check.palette.index = TRUE) {
+     rpart.plot:::describe.col(col, show.hex, check.palette.index)
+ }

> stopifnot(identical(describe.col(1), "#000000 (black)"))

> stopifnot(identical(describe.col(2), "#FF0000 (red)"))

> stopifnot(identical(describe.col(rgb(0, 1, 0)), "#00FF00 (green)"))

> stopifnot(identical(describe.col(rgb(0, 1, 1)), "#00FFFF (cyan)"))

> stopifnot(identical(describe.col(rgb(0.1, 0.2, 0.3)), 
+     "#1A334D (near darkslategray #2F4F4F)"))

> stopifnot(identical(describe.col(col2rgb(3)), "#00CD00 (green3)"))

> stopifnot(identical(describe.col(col2rgb("green3")), 
+     "#00CD00 (green3)"))

> stopifnot(identical(describe.col(col2rgb("#00CD01")), 
+     "#00CD01 (near green3 #00CD00)"))

> stopifnot(identical(describe.col("salmon2"), "#EE8262 (salmon2)"))

> stopifnot(identical(describe.col("#EE8262"), "#EE8262 (salmon2)"))

> stopifnot(identical(describe.col("#EE8260"), "#EE8260 (near salmon2 #EE8262)"))

> stopifnot(identical(describe.col("#EE9260"), "#EE9260 (near salmon2 #EE8262)"))

> stopifnot(identical(describe.col(0), "#FFFFFF (white)"))

> stopifnot(identical(describe.col(0), "#FFFFFF (white)"))

> stopifnot(identical(describe.col(0), "#FFFFFF (white)"))

> stopifnot(identical(describe.col(NA), "#FFFFFF (white)"))

> stopifnot(identical(describe.col(col2rgb(NA)), "#FFFFFF (white)"))

> stopifnot(identical(describe.col(col2rgb("NA")), "#FFFFFF (white)"))

> stopifnot(identical(describe.col(matrix(c(1, 2, 3), 
+     nrow = 3)), "#010203 (near gray1 #030303)"))

> expect.err(try(describe.col(1.23)), "non-integer col is illegal")
Error : non-integer col is illegal
Got error as expected from try(describe.col(1.23))

> expect.err(try(describe.col(c(1, 2))), "only one color is allowed")
Error : only one color is allowed
Got error as expected from try(describe.col(c(1, 2)))

> expect.err(try(describe.col(c("red", "pink"))), "only one color is allowed")
Error : only one color is allowed
Got error as expected from try(describe.col(c("red", "pink")))

> expect.err(try(describe.col(-1)), "col -1 is illegal (col must be greater than or equal to 0)")
Error : col -1 is illegal (col must be greater than or equal to 0)
Got error as expected from try(describe.col(-1))

> expect.err(try(describe.col(9)), "illegal col 9 (only 8 colors in the current palette)")
Error : illegal col 9 (only 8 colors in the current palette)
Got error as expected from try(describe.col(9))

> expect.err(try(describe.col("nonesuch")), "invalid color name 'nonesuch'")
Error in col2rgb(col) : invalid color name 'nonesuch'
Got error as expected from try(describe.col("nonesuch"))

> expect.err(try(describe.col(FALSE)), "invalid color name 'FALSE'")
Error in col2rgb(col) : invalid color name 'FALSE'
Got error as expected from try(describe.col(FALSE))

> expect.err(try(describe.col(col2rgb(FALSE))), "invalid color name 'FALSE'")
Error in col2rgb(FALSE) : invalid color name 'FALSE'
Got error as expected from try(describe.col(col2rgb(FALSE)))

> data(ptitanic)

> mod.survived <- rpart(survived ~ ., data = ptitanic, 
+     control = list(cp = 0.02))

> par(mfrow = c(4, 2), mar = c(3, 3, 3, 1), mgp = c(1.5, 
+     0.5, 0))

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "test.palette.R\ntwo class, box.palette=\"auto\"")

> library(rattle, quietly = TRUE)

> fancyRpartPlot(mod.survived, main = "fancyRpartPlot", 
+     sub = "")

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Blues", box.palette = "Blues", trace = 1)
box.palette "Blues" (not diverging): #F7FBFF (near ghostwhite) to #6BAED6 (near skyblue3)
cex 0.964   xlim c(0, 1)   ylim c(0, 1)

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-Blues", box.palette = "-Blues", 
+     trace = 2)
handle.box.palette for class response invokes handle.anova.palette
box.palette "-Blues" (not diverging): #6BAED6 (near skyblue3) to #F7FBFF (near ghostwhite)
initial scale 0.964
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.964   xlim c(0, 1)   ylim c(0, 1)

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Browns", box.palette = "Browns", trace = 1)
box.palette "Browns" (not diverging): #FFFFFF (white) to #D98657 (near lightsalmon3)
cex 0.964   xlim c(0, 1)   ylim c(0, 1)

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-Browns", box.palette = "-Browns", 
+     trace = 2 .... [TRUNCATED] 
handle.box.palette for class response invokes handle.anova.palette
box.palette "-Browns" (not diverging): #D98657 (near lightsalmon3) to #FFFFFF (white)
initial scale 0.964
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.964   xlim c(0, 1)   ylim c(0, 1)

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Grays", box.palette = "Grays")

> rpart.plot.version1(mod.survived, type = 2, extra = "au", 
+     fallen.leaves = TRUE, main = "-Grays", box.pal = "-Grays")

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Greys", box.pa = "Greys")

> rpart.plot.version1(mod.survived, type = 2, extra = "AU", 
+     fallen.leaves = TRUE, main = "-Greys", box.p = "-Greys")

> rpart.plot(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "Greens", box.palette = "Greens")

> prp(mod.survived, type = 2, extra = "AUTO", fallen.leaves = TRUE, 
+     main = "-Greens", box.palette = "-Greens")

> rpart.plot(mod.survived, type = 2, extra = "AUTO", 
+     fallen.leaves = TRUE, main = "Oranges", box.palette = "Oranges")

> rpart.plot.version1(mod.survived, type = 2, extra = "Auto", 
+     fallen.leaves = TRUE, main = "-Oranges", box.palette = "-Oranges")

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Reds", box.palette = "Reds")

> rpart.plot.version1(mod.survived, type = 2, extra = "aUTO", 
+     fallen.leaves = TRUE, main = "-Reds", box.palette = "-Reds")

> rpart.plot(mod.survived, type = 2, extra = "Auto", 
+     fallen.leaves = TRUE, main = "Purples", box.palette = "Purples")

> prp(mod.survived, type = 2, extra = "autO", fallen.leaves = TRUE, 
+     main = "-Purples", box.palette = "-Purples")

> par(mfrow = c(4, 3), mar = c(3, 3, 3, 1), mgp = c(1.5, 
+     0.5, 0))

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Blues", box.palette = "Blues", trace = 1)
box.palette "Blues" (not diverging): #F7FBFF (near ghostwhite) to #6BAED6 (near skyblue3)
cex 0.688   xlim c(0, 1)   ylim c(0, 1)

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Bu", box.palette = "Bu", trace = 1)
box.palette "Bu" (not diverging): #F7FBFF (near ghostwhite) to #6BAED6 (near skyblue3)
cex 0.688   xlim c(0, 1)   ylim c(0, 1)

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-Bu", box.palette = "-Bu", 
+     trace = 2)
handle.box.palette for class response invokes handle.anova.palette
box.palette "-Bu" (not diverging): #6BAED6 (near skyblue3) to #F7FBFF (near ghostwhite)
initial scale 0.688
    node shifter: skipping invalid      shift.amount 1.5 
    node shifter: skipping invalid      shift.amount 2.0 
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.688   xlim c(0, 1)   ylim c(0, 1)

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Browns", box.palette = "Browns", trace = 1)
box.palette "Browns" (not diverging): #FFFFFF (white) to #D98657 (near lightsalmon3)
cex 0.688   xlim c(0, 1)   ylim c(0, 1)

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Br", box.palette = "Br", trace = 1)
box.palette "Br" (not diverging): #FFFFFF (white) to #D98657 (near lightsalmon3)
cex 0.688   xlim c(0, 1)   ylim c(0, 1)

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-Br", box.palette = "-Br", 
+     trace = 2)
handle.box.palette for class response invokes handle.anova.palette
box.palette "-Br" (not diverging): #D98657 (near lightsalmon3) to #FFFFFF (white)
initial scale 0.688
    node shifter: skipping invalid      shift.amount 1.5 
    node shifter: skipping invalid      shift.amount 2.0 
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
cex 0.688   xlim c(0, 1)   ylim c(0, 1)

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Grays", box.palette = "Grays")

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Gy", box.palette = "Gy")

> rpart.plot.version1(mod.survived, type = 2, extra = "au", 
+     fallen.leaves = TRUE, main = "-Gy", box.pal = "-Gy")

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Greys", box.pa = "Greys")

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Gy", box.pa = "Gy")

> rpart.plot.version1(mod.survived, type = 2, extra = "AU", 
+     fallen.leaves = TRUE, main = "-Gy", box.p = "-Gy")

> rpart.plot(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "Greens", box.palette = "Greens")

> rpart.plot(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "Gn", box.palette = "Gn")

> prp(mod.survived, type = 2, extra = "AUTO", fallen.leaves = TRUE, 
+     main = "-Gn", box.palette = "-Gn")

> rpart.plot(mod.survived, type = 2, extra = "AUTO", 
+     fallen.leaves = TRUE, main = "Oranges", box.palette = "Oranges")

> rpart.plot(mod.survived, type = 2, extra = "AUTO", 
+     fallen.leaves = TRUE, main = "Or", box.palette = "Or")

> rpart.plot.version1(mod.survived, type = 2, extra = "Auto", 
+     fallen.leaves = TRUE, main = "-Or", box.palette = "-Or")

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Reds", box.palette = "Reds")

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "Re", box.palette = "Re")

> rpart.plot.version1(mod.survived, type = 2, extra = "aUTO", 
+     fallen.leaves = TRUE, main = "-Re", box.palette = "-Re")

> rpart.plot(mod.survived, type = 2, extra = "Auto", 
+     fallen.leaves = TRUE, main = "Purples", box.palette = "Purples")

> rpart.plot(mod.survived, type = 2, extra = "Auto", 
+     fallen.leaves = TRUE, main = "Pu", box.palette = "Pu")

> prp(mod.survived, type = 2, extra = "autO", fallen.leaves = TRUE, 
+     main = "-Pu", box.palette = "-Pu")

> par(mfrow = c(4, 2), mar = c(3, 3, 3, 1), mgp = c(1.5, 
+     0.5, 0))

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "RdYlGn", box.palette = "RdYlGn")

> rpart.plot.version1(mod.survived, type = 2, extra = "aU", 
+     fallen.leaves = TRUE, main = "-RdYlGn", box.palette = "-RdYlGn")

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "BuGn", box.palette = "BuGn")

> rpart.plot.version1(mod.survived, type = 2, extra = "Au", 
+     fallen.leaves = TRUE, main = "-BuGn", box.palette = "-BuGn")

> rpart.plot(mod.survived, type = 2, extra = "aut", 
+     fallen.leaves = TRUE, main = "BuRd", box.palette = "BuRd")

> rpart.plot.version1(mod.survived, type = 2, extra = "AUT", 
+     fallen.leaves = TRUE, main = "-BuRd", box.palette = "-BuRd")

> rpart.plot(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "RdGn", box.palette = "RdGn")

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-RdGn", box.palette = "-RdGn")

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "BuGn", box.palette = "BuGn")

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "GnBu", box.palette = "GnBu")

> rpart.plot(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "BuRd", box.palette = "BuRd")

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "RdGy", box.palette = "RdGy")

> rpart.plot(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "RdGn", box.palette = "RdGn")

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "GyRd", box.palette = "GyRd")

> rpart.plot(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "BuBu", box.palette = "BuBu")

> rpart.plot(mod.survived, box.palette = 0, main = "mod.survived\nbox.palette=0")

> rpart.plot(mod.survived, box.palette = NA, main = "mod.survived\nbox.palette=NA")

> par(mfrow = c(2, 2))

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "test list palette for binomial response\nlist(Blues, Greens)", 
+     box.pa .... [TRUNCATED] 

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "list(Blues, Purples)", box.palette = list("Blues",  .... [TRUNCATED] 

> rpart.plot(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "BuGn", box.palette = "BuGn")

> par(mfrow = c(2, 2))

> box.palette = gray(seq(0.95, 0.6, length.out = 100))

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = paste(length(box.palette), " grays\n(custom palette) ..." ... [TRUNCATED] 

> box.palette = gray(seq(0.9, 0.6, length.out = 3))

> rpart.plot(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = paste(length(box.palette), " grays"), 
+     box.palette = bo .... [TRUNCATED] 

> box.palette = gray(seq(0.9, 0.6, length.out = 2))

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = paste(length(box.palette), " grays"), 
+     box.pal .... [TRUNCATED] 

> rpart.plot(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "single pink", box.palette = "pink")

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "wheat", box.palette = "wheat")

> box.palette = c("pink", "palegreen")

> rpart.plot(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "pink palegreen", box.palette = box.palette)

> box.palette = c("pink", "wheat", "palegreen")

> rpart.plot.version1(mod.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "pink wheat palegreen", box.palette = box.palette)

> itit <- ptitanic

> itit$survived <- as.integer(itit$survived == "survived")

> mod.continuous.survived <- rpart(survived ~ ., data = itit, 
+     control = list(cp = 0.02))

> par(mfrow = c(4, 2), mar = c(3, 3, 3, 1), mgp = c(1.5, 
+     0.5, 0))

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     main = "continuous (survived)")

> fancyRpartPlot(mod.continuous.survived, main = "fancyRpartPlot", 
+     sub = "")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "-Greens", box.palette = "-Greens")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "Greens", box.palette = "Greens")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "Blues", box.palette = "Blues")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-Blues", box.palette = "-Blues")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "Oranges", box.palette = "Oranges")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-Oranges", box.palette = "-Oranges")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "Purples", box.palette = "Purples")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-Purples", box.palette = "-Purples")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "Reds", box.palette = "Reds")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-Reds", box.palette = "-Reds")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "Grays", box.palette = "Grays")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-Grays", box.palette = "-Grays")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "Greys", box.palette = "Greys")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-Greys", box.palette = "-Greys")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "RdYlGn", box.palette = "RdYlGn")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-RdYlGn", box.palette = "-RdYlGn")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "BuGn", box.palette = "BuGn")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-BuGn", box.palette = "-BuGn")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "BuRd", box.palette = "BuRd")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-BuRd", box.palette = "-BuRd")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "RdGn", box.palette = "RdGn")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-RdGn", box.palette = "-RdGn")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "GnBu", box.palette = "GnBu")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-BuGn", box.palette = "-BuGn")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "BuRd", box.palette = "BuRd")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-RdBu", box.palette = "-RdBu")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "RdGn", box.palette = "RdGn")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-GnRd", box.palette = "-GnRd")

> rpart.plot.version1(mod.continuous.survived, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, main = "GnYlRd", box.palette = "GnYlRd")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "-RdYlGn", box.palette = "-RdYlGn")

> rpart.plot(mod.continuous.survived, box.palette = 0, 
+     main = "box.palette=0")

> rpart.plot(mod.continuous.survived, box.palette = NA, 
+     main = "box.palette=NA")

> par(mfrow = c(2, 2), mar = c(3, 3, 3, 1), mgp = c(1.5, 
+     0.5, 0))

> mod.age <- rpart(age ~ ., data = ptitanic)

> rpart.plot.version1(mod.age, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = "auto", main = "age\nbox.palette=\"auto\"")

> fancyRpartPlot(mod.age, main = "fancyRpartPlot", sub = "")

> rpart.plot(mod.age, type = 2, extra = "auto", fallen.leaves = TRUE, 
+     box.palette = "Greens", yesno = 2, main = "Greens yesno=2")

> rpart.plot.version1(mod.age, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = "RdYlGn", main = "RdYlGn")

> rpart.plot(mod.age, type = 2, extra = "auto", fallen.leaves = TRUE, 
+     box.palette = "Reds", main = "Reds")

> rpart.plot.version1(mod.age, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = "BuGn", main = "BuGn")

> rpart.plot(mod.age, type = 2, extra = "auto", fallen.leaves = TRUE, 
+     box.palette = "auto")

> expect.err(try(rpart.plot.version1(mod.age, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, box.palette = "notacolor")), 
+     "box.palette: ..." ... [TRUNCATED] 
Error in col2rgb(pal_i) : invalid color name 'notacolor'
Error : box.palette: "notacolor" is neither a color nor a palette.
Try something like box.palette="blue" or box.palette="Blues".
The predefined palettes are (with an optional "-" prefix):
  Grays Greys Greens Blues Browns Oranges Reds Purples
  Gy Gn Bu Bn Or Rd Pu (alternative names for the above palettes)
  BuGn BuBn GnRd etc.  (two-color diverging palettes: any combination of two palettes)
  RdYlGn GnYlRd BlGnYl YlGnBl (three color palettes)

Got error as expected from try(rpart.plot.version1(mod.age, type = 2, extra = "auto", fallen.leaves = TRUE,     box.palette = "notacolor"))

> expect.err(try(rpart.plot(mod.age, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = "#1234XX")), "box.palette: \"#1234XX\" is ne ..." ... [TRUNCATED] 
Error in col2rgb(pal_i) : invalid hex digit in 'color' or 'lty'
Error : box.palette: "#1234XX" is neither a color nor a palette.
Try something like box.palette="blue" or box.palette="Blues".
The predefined palettes are (with an optional "-" prefix):
  Grays Greys Greens Blues Browns Oranges Reds Purples
  Gy Gn Bu Bn Or Rd Pu (alternative names for the above palettes)
  BuGn BuBn GnRd etc.  (two-color diverging palettes: any combination of two palettes)
  RdYlGn GnYlRd BlGnYl YlGnBl (three color palettes)

Got error as expected from try(rpart.plot(mod.age, type = 2, extra = "auto", fallen.leaves = TRUE,     box.palette = "#1234XX"))

> expect.err(try(rpart.plot.version1(mod.age, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, box.palette = "#1234XX")), 
+     "box.palette: \ ..." ... [TRUNCATED] 
Error in col2rgb(pal_i) : invalid hex digit in 'color' or 'lty'
Error : box.palette: "#1234XX" is neither a color nor a palette.
Try something like box.palette="blue" or box.palette="Blues".
The predefined palettes are (with an optional "-" prefix):
  Grays Greys Greens Blues Browns Oranges Reds Purples
  Gy Gn Bu Bn Or Rd Pu (alternative names for the above palettes)
  BuGn BuBn GnRd etc.  (two-color diverging palettes: any combination of two palettes)
  RdYlGn GnYlRd BlGnYl YlGnBl (three color palettes)

Got error as expected from try(rpart.plot.version1(mod.age, type = 2, extra = "auto", fallen.leaves = TRUE,     box.palette = "#1234XX"))

> expect.err(try(rpart.plot.version1(mod.age, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, box.palette = "B")), 
+     "box.palette=\"B\" is ..." ... [TRUNCATED] 
Error : box.palette="B" is ambiguous
Try something like box.palette="blue" or box.palette="Blues".
The predefined palettes are (with an optional "-" prefix):
  Grays Greys Greens Blues Browns Oranges Reds Purples
  Gy Gn Bu Bn Or Rd Pu (alternative names for the above palettes)
  BuGn BuBn GnRd etc.  (two-color diverging palettes: any combination of two palettes)
  RdYlGn GnYlRd BlGnYl YlGnBl (three color palettes)

Got error as expected from try(rpart.plot.version1(mod.age, type = 2, extra = "auto", fallen.leaves = TRUE,     box.palette = "B"))

> expect.err(try(rpart.plot.version1(mod.age, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, box.palette = "-B")), 
+     "box.palette=\"B\" i ..." ... [TRUNCATED] 
Error : box.palette="B" is ambiguous
Try something like box.palette="blue" or box.palette="Blues".
The predefined palettes are (with an optional "-" prefix):
  Grays Greys Greens Blues Browns Oranges Reds Purples
  Gy Gn Bu Bn Or Rd Pu (alternative names for the above palettes)
  BuGn BuBn GnRd etc.  (two-color diverging palettes: any combination of two palettes)
  RdYlGn GnYlRd BlGnYl YlGnBl (three color palettes)

Got error as expected from try(rpart.plot.version1(mod.age, type = 2, extra = "auto", fallen.leaves = TRUE,     box.palette = "-B"))

> expect.err(try(rpart.plot.version1(mod.age, type = 2, 
+     extra = "auto", fallen.leaves = TRUE, box.palette = rpart.plot)), 
+     "box.palette:  ..." ... [TRUNCATED] 
Error in try(!is.null(object) && !anyNA(object) && !is.zero(object) &&  : 
  anyNA() applied to non-(list or vector) of type 'closure'

Error : box.palette: illegal value
Got error as expected from try(rpart.plot.version1(mod.age, type = 2, extra = "auto", fallen.leaves = TRUE,     box.palette = rpart.plot))

> expect.err(try(rpart.plot(mod.age, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = c(0, 1, 2), main = "box.palette=c(0,1,2)")), .... [TRUNCATED] 
Error in col2rgb(pal_i) : numerical color values must be positive
Error : box.palette: 0 is neither a color nor a palette.
Try something like box.palette="blue" or box.palette="Blues".
The predefined palettes are (with an optional "-" prefix):
  Grays Greys Greens Blues Browns Oranges Reds Purples
  Gy Gn Bu Bn Or Rd Pu (alternative names for the above palettes)
  BuGn BuBn GnRd etc.  (two-color diverging palettes: any combination of two palettes)
  RdYlGn GnYlRd BlGnYl YlGnBl (three color palettes)

Got error as expected from try(rpart.plot(mod.age, type = 2, extra = "auto", fallen.leaves = TRUE,     box.palette = c(0, 1, 2), main = "box.palette=c(0,1,2)"))

> rpart.plot(mod.age, type = 2, extra = "auto", fallen.leaves = TRUE, 
+     box.palette = c(2, 3, 4), main = "box.palette=c(2,3,4)")

> mod.class <- rpart(pclass ~ ., data = ptitanic, control = list(cp = 0.02))

> par(mfrow = c(2, 2), mar = c(3, 3, 3, 1), mgp = c(1.5, 
+     0.5, 0))

> rpart.plot.version1(mod.class, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = "auto", main = "multiclass\n(2 of 3 classes pred ..." ... [TRUNCATED] 
multiclass auto box.palette: list(Blues, Greens)
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0   legend.y 1.03572

> fancyRpartPlot(mod.class, main = "fancyRpartPlot", 
+     sub = "")

> rpart.plot(mod.class, type = 2, extra = "auto", fallen.leaves = TRUE, 
+     box.palette = list("Blues", "Reds", "Greens"), main = "list(Blues, Reds ..." ... [TRUNCATED] 
handle.box.palette for class response invokes handle.multiclass.palette
box.col 1st: #6BAED6 (near skyblue3 #6CA6CD)
box.col 3rd: #FB6A4A (near tomato #FF6347)
initial scale 1.01
shifter: cex improvement 1 best.shift.amount 0 best.split.yshift.amount 0 (won't be used)
clipped scale 1.01 to max.auto.cex 1
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0   legend.y 1.03572

> rpart.plot(mod.class, type = 2, extra = "auto", fallen.leaves = TRUE, 
+     box.palette = list("Blues", "Reds"), main = "list(Blues, Reds)")

> data(iris)

> mod.species <- rpart(Species ~ ., data = iris, cp = 1e-10)

> rpart.plot(mod.species, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "multiclass\n(3 of 4 classes predicted)")

> rpart.plot(mod.species, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = "auto", main = "multiclass, tweak=1.1", 
+     tweak =  .... [TRUNCATED] 

> rpart.plot(mod.species, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = list("Reds", "Grays"), 
+     main = "list(Reds, Grays) ..." ... [TRUNCATED] 
Warning: All boxes will be white (the box.palette argument will be ignored) because
the number of classes predicted by the model 3 is greater than length(box.palette) 2.
To make this warning go away use box.palette=0 or trace=-1.

> rpart.plot(mod.species, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = 0, main = "box.palette=0")

> rpart.plot(mod.species, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.col = 2:4, main = "mod.species\nbox.col=2:4")

> rpart.plot(mod.species, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, trace = 1, box.palette = list("Reds", 
+         "Blues", "Grays"), m .... [TRUNCATED] 
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0.8   legend.y 1.03572

> rpart.plot(mod.species, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = "Blues", main = "box.palette=\"Blues\"")

> rpart.plot(mod.species, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = "lightpink", main = "box.palette=\"lightpink\"")

> par(mfrow = c(2, 2))

> prp(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "mod.continuous.survived\nc(\"Red\", \"Yellow\", \"Green\ .... [TRUNCATED] 

> prp(mod.continuous.survived, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "mod.continuous.survived\nc(\"Green\", \"Yellow\", \"Red\ .... [TRUNCATED] 

> expect.err(try(rpart.plot(mod.species, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = c("Blues", "Reds"), main = "box.palette= ..." ... [TRUNCATED] 
Error : The rpart model has a multiclass response (not a continuous or binary response).
Therefore box.palette must be "auto", or a list of palettes, or a single color or palette.
e.g. box.palette=list("Reds", "Oranges", "Grays", "Blues", "Greens")
Got error as expected from try(rpart.plot(mod.species, type = 2, extra = "auto", fallen.leaves = TRUE,     box.palette = c("Blues", "Reds"), main = "box.palette=c(\"Blues\", \"Reds\")"))

> par(mfrow = c(1, 2))

> mod.country <- rpart(Country ~ ., cu.summary)

> rv <- rpart.plot(mod.country, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "multiclass\n(4 of 10 classes predicted)")

> fancyRpartPlot(mod.country, main = "fancyRpartPlot", 
+     sub = "")

> rv <- rpart.plot(mod.country, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "multiclass\nbox.palette=\"auto\"", 
+     box.palette = .... [TRUNCATED] 

> rpart.plot(mod.country, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "box.palette=\nlist(\"Greens\", \"Reds\", \"Grays\", \"Purples .... [TRUNCATED] 

> rv <- rpart.plot(mod.country, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "multiclass, trace=-1", box.palette = "auto", 
+     tra .... [TRUNCATED] 

> rv <- rpart.plot(mod.country, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "multiclass, box.palette=0", 
+     box.palette = 0)

> rv <- rpart.plot(mod.country, type = 2, extra = "auto", 
+     fallen.leaves = FALSE, box.palette = "auto", main = "multiclass, fallen.leaves=FALSE" .... [TRUNCATED] 

> expect.err(try(rpart.plot(mod.country, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, box.palette = c("lightblue2", "pink"))), 
+     "The r ..." ... [TRUNCATED] 
Error : The rpart model has a multiclass response (not a continuous or binary response).
Therefore box.palette must be "auto", or a list of palettes, or a single color or palette.
e.g. box.palette=list("Reds", "Oranges", "Grays", "Blues", "Greens")
Got error as expected from try(rpart.plot(mod.country, type = 2, extra = "auto", fallen.leaves = TRUE,     box.palette = c("lightblue2", "pink")))

> library(earth)

> data(ozone1)

> ozone2 <- ozone1

> set.seed(8)

> ozone2$O3a <- round(runif(330, 1, 10))

> y <- cbind(ozone2$O3, ozone2$O3a)

> mod.poisson <- rpart(y ~ . - O3 - O3a, data = ozone2, 
+     control = list(cp = 0.04))

> par(mfrow = c(2, 2))

> rpart.plot(mod.poisson, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "poisson\ndefault args", box.palette = "auto")

> fancyRpartPlot(mod.poisson, main = "fancyRpartPlot", 
+     sub = "")

> rpart.plot(mod.poisson, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "poisson\nbox.palette=RdYlGn", 
+     box.palette = "RdYlGn")

> rpart.plot(mod.poisson, type = 2, extra = "auto", 
+     fallen.leaves = TRUE, main = "poisson\nbox.palette=BuGn", 
+     box.palette = "BuGn")

> par(mfrow = c(2, 2))

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     main = "auto\nmod.continuous.survived", box.palette = "auto")

> rpart.plot(mod.continuous.survived, type = 2, extra = "auto", 
+     main = "-auto\nmod.continuous.survived", box.palette = "-auto")

> rpart.plot(mod.age, type = 2, extra = "a", main = "auto\nmod.age", 
+     box.palette = "auto")

> rpart.plot(mod.age, type = 2, extra = "a", main = "-auto\nmod.age", 
+     box.palette = "-auto")

> par(mfrow = c(2, 2))

> rpart.plot(mod.class, type = 2, extra = "au", main = "auto\nmod.class", 
+     box.palette = "auto")

> rpart.plot(mod.class, type = 2, extra = "au", main = "-auto\nmod.class", 
+     box.palette = "-auto")

> rpart.plot(mod.poisson, type = 2, extra = "AUTO", 
+     main = "auto\nmod.poisson", box.palette = "auto")

> rpart.plot(mod.poisson, type = 2, extra = "AUTO", 
+     main = "-auto\nmod.poisson", box.palette = "-auto")

> par(mfrow = c(2, 2))

> rpart.plot(mod.species, type = 2, extra = "A", main = "auto\nmod.species", 
+     box.palette = "auto")

> rpart.plot(mod.species, type = 2, extra = "A", main = "-auto\nmod.species", 
+     box.palette = "-auto")

> rpart.plot(mod.country, type = 2, extra = "axxx", 
+     main = "auto\nmod.country", box.palette = "auto")

> rpart.plot(mod.country, type = 2, extra = "axxx", 
+     main = "-auto\nmod.country", box.palette = "-auto")

> par(mfrow = c(2, 2))

> multi.class.model <- rpart(Reliability ~ ., data = cu.summary)

> rpart.plot(multi.class.model, legend.x = NULL, main = "legend.x=NULL (default)")

> rpart.plot(multi.class.model, legend.x = NA, main = "legend.x=NA (no legend)")

> rpart.plot(multi.class.model, fallen.leaves = TRUE, 
+     legend.x = 0.8, main = "legend.x=.8")

> rpart.plot(multi.class.model, legend.x = -0.1, legend.cex = 1.4, 
+     main = "legend.x=-.1, legend.cex=1.4")

> par(mfrow = c(2, 2))

> rpart.plot(multi.class.model, legend.y = NULL, main = "legend.y=NULL (default)")

> rpart.plot(multi.class.model, fallen.leaves = FALSE, 
+     legend.y = NA, main = "legend.y=NA (no legend)")

> rpart.plot(multi.class.model, fallen.leaves = FALSE, 
+     legend.y = 0.16, main = "legend.y=.16")

> rpart.plot(multi.class.model, legend.x = 0, legend.y = 1.1, 
+     legend.cex = 0.8, main = "legend.x=0 legend.y=1.1 legend.cex=.8")

> cat("palette handling for node.fun, pal.thresh, and pal.node.fun\n")
palette handling for node.fun, pal.thresh, and pal.node.fun

> get.class.stats <- rpart.plot:::get.class.stats

> internal.node.labs <- rpart.plot:::internal.node.labs

> paste.trunc <- rpart.plot:::paste.trunc

> is.try.err <- rpart.plot:::is.try.err

> plot1 <- function(object, node.fun = NULL, pal.node.fun = FALSE, 
+     optional.msg = "", ...) {
+     rpart.plot(object, node.fun = node.fun, pal. .... [TRUNCATED] 

> plot2 <- function(object, node.fun = NULL, optional.msg = "", 
+     ...) {
+     try <- try(plot1(object, node.fun = node.fun, pal.node.fun = FALSE .... [TRUNCATED] 

> data(ptitanic)

> ptitanic.numeric.survived <- ptitanic

> ptitanic.numeric.survived$survived <- as.numeric(ptitanic$survived)

> anova.mod <- rpart(survived ~ ., data = ptitanic.numeric.survived, 
+     cp = 0.02)

> old.par <- par(no.readonly = TRUE)

> par(mfrow = c(3, 2))

> par(mar = c(0, 0, 4, 0))

> rpart.plot(anova.mod, main = "no node.fun")

> title("node.fun (anova model)\n\n")

> plot(c(0, 1), c(0, 1), col = 0, bty = "n", xlab = "", 
+     xaxt = "n", ylab = "", yaxt = "n")

> plot2(anova.mod, node.fun = function(x, labs, digits, 
+     varlen) paste(labs))

> plot2(anova.mod, node.fun = function(x, labs, digits, 
+     varlen) paste("surv=\n", labs))

> plot2(anova.mod, extra = 0, node.fun = function(x, 
+     labs, digits, varlen) paste("surv=\n", -10 * as.numeric(labs)))

> plot2(anova.mod, extra = 0, node.fun = function(x, 
+     labs, digits, varlen) paste("surv=\n", -1e+08 * as.numeric(labs)))

> plot2(anova.mod, box.palette = "Gy")

> par(mfrow = c(4, 2))

> par(mar = c(0, 0, 3, 0))

> plot2(anova.mod, box.palette = "RdGy")

> plot2(anova.mod, node.fun = function(x, labs, digits, 
+     varlen) c(1, 2, 3, 4, "nonesuch", 6, 7, 8, 9))

node labs generated by node.fun:
[1] "1"        "2"        "3"        "4"        "nonesuch" "6"        "7"       
[8] "8"        "9"       

Error : Cannot convert node labs to numeric
To make this error go away, change node.fun or use pal.node.fun=FALSE

> plot2(anova.mod, node.fun = function(x, labs, digits, 
+     varlen) 1:nrow(x$frame))

> plot2(anova.mod, node.fun = function(x, labs, digits, 
+     varlen) paste("prefix", 1:nrow(x$frame), "suffix"))

> par(mfrow = c(3, 2))

> par(oma = c(0, 0, 3, 0))

> par(mar = c(0, 0, 3, 0))

> rpart.plot(anova.mod, extra = 0, box.palette = "RdGn", 
+     main = "pal.thresh=default", trace = 0)

> title("pal.thresh (anova model)\n\n\n\n", xpd = NA)

> rpart.plot(anova.mod, extra = 0, box.palette = "RdGn", 
+     main = "pal.thresh=1.2", pal.thresh = 1.2)

> rpart.plot(anova.mod, extra = 0, box.palette = "RdGn", 
+     main = "pal.thresh=100", pal.thresh = 100)

> rpart.plot(anova.mod, extra = 0, box.palette = "RdGn", 
+     main = "pal.thresh=-100", pal.thresh = -100)

> par(mfrow = c(3, 2))

> par(mar = c(0, 0, 4, 0))

> plot2(anova.mod, node.fun = function(x, labs, digits, 
+     varlen) paste(x$frame$yval * x$frame$n), optional.msg = "box.palette=default\n")

> plot2(anova.mod, node.fun = function(x, labs, digits, 
+     varlen) paste(x$frame$yval * x$frame$n), pal.thresh = 80, 
+     box.palette = "OrGy",  .... [TRUNCATED] 

> rpart.plot(anova.mod, box.palette = "BuGn", pal.thresh = 1.8, 
+     main = "box.palette=\"BuGn\", pal.thresh=1.8")

> rpart.plot(anova.mod, box.palette = c("lightblue", 
+     "lightgreen"), pal.thresh = 1.8, main = "box.palette=c(\"lightblue\", \"lightgreen\"), pal ..." ... [TRUNCATED] 

> paste.c <- rpart.plot:::paste.c

> test.expand.palette <- function(box.palette) {
+     cat(paste0("\nbox.palette=", paste.c(box.palette)), "\n")
+     rpart.plot(anova.mod, trace = 1 .... [TRUNCATED] 

> par(mfrow = c(3, 2))

> test.expand.palette("auto")

box.palette=auto 
box.palette (not diverging): #F7FBFF (near ghostwhite) to #6BAED6 (near skyblue3)
cex 1   xlim c(0, 1)   ylim c(0, 1)

> test.expand.palette("Reds")

box.palette=Reds 
box.palette "Reds" (not diverging): #FFF5F0 (near seashell) to #FB6A4A (near tomato)
cex 1   xlim c(0, 1)   ylim c(0, 1)

> test.expand.palette(c("-Reds", "Blues"))

box.palette=c(-Reds,Blues) 
box.palette (diverging pal.thresh 1.49074): #FB6A4A (near tomato) to #6BAED6 (near skyblue3)
cex 1   xlim c(0, 1)   ylim c(0, 1)

> test.expand.palette(c("tan", "tan2", "tan4"))

box.palette=c(tan,tan2,tan4) 
box.palette (not diverging): #D2B48C (tan) to #8B5A2B (tan4)
cex 1   xlim c(0, 1)   ylim c(0, 1)

> test.expand.palette(c("tan2", "tan", "Blues"))

box.palette=c(tan2,tan,Blues) 
box.palette (not diverging): #EE9A49 (tan2) to #6BAED6 (near skyblue3)
cex 1   xlim c(0, 1)   ylim c(0, 1)

> test.expand.palette(c("auto", "-Reds"))

box.palette=c(auto,-Reds) 
box.palette (diverging pal.thresh 1.49074): #F7FBFF (near ghostwhite) to #FFF5F0 (near seashell)
cex 1   xlim c(0, 1)   ylim c(0, 1)

> expect.err(try(test.expand.palette("")), "box.palette: \"\" is neither a color nor a palette")

box.palette= 
Error in col2rgb(pal_i) : invalid color name ''
Error : box.palette: "" is neither a color nor a palette.
Try something like box.palette="blue" or box.palette="Blues".
The predefined palettes are (with an optional "-" prefix):
  Grays Greys Greens Blues Browns Oranges Reds Purples
  Gy Gn Bu Bn Or Rd Pu (alternative names for the above palettes)
  BuGn BuBn GnRd etc.  (two-color diverging palettes: any combination of two palettes)
  RdYlGn GnYlRd BlGnYl YlGnBl (three color palettes)

Got error as expected from try(test.expand.palette(""))

> expect.err(try(test.expand.palette("nonesuch")), "box.palette: \"nonesuch\" is neither a color nor a palette")

box.palette=nonesuch 
Error in col2rgb(pal_i) : invalid color name 'nonesuch'
Error : box.palette: "nonesuch" is neither a color nor a palette.
Try something like box.palette="blue" or box.palette="Blues".
The predefined palettes are (with an optional "-" prefix):
  Grays Greys Greens Blues Browns Oranges Reds Purples
  Gy Gn Bu Bn Or Rd Pu (alternative names for the above palettes)
  BuGn BuBn GnRd etc.  (two-color diverging palettes: any combination of two palettes)
  RdYlGn GnYlRd BlGnYl YlGnBl (three color palettes)

Got error as expected from try(test.expand.palette("nonesuch"))

> expect.err(try(test.expand.palette("Nonesuch")), "box.palette=\"Nonesuch\" is not allowed")

box.palette=Nonesuch 
Error : box.palette="Nonesuch" is not allowed
Try something like box.palette="blue" or box.palette="Blues".
The predefined palettes are (with an optional "-" prefix):
  Grays Greys Greens Blues Browns Oranges Reds Purples
  Gy Gn Bu Bn Or Rd Pu (alternative names for the above palettes)
  BuGn BuBn GnRd etc.  (two-color diverging palettes: any combination of two palettes)
  RdYlGn GnYlRd BlGnYl YlGnBl (three color palettes)

Got error as expected from try(test.expand.palette("Nonesuch"))

> expect.err(try(test.expand.palette(c("tan1", "huh?"))), 
+     "box.palette: \"huh?\" is neither a color nor a palette")

box.palette=c(tan1,huh?) 
Error in col2rgb(pal_i) : invalid color name 'huh?'
Error : box.palette: "huh?" is neither a color nor a palette.
Try something like box.palette="blue" or box.palette="Blues".
The predefined palettes are (with an optional "-" prefix):
  Grays Greys Greens Blues Browns Oranges Reds Purples
  Gy Gn Bu Bn Or Rd Pu (alternative names for the above palettes)
  BuGn BuBn GnRd etc.  (two-color diverging palettes: any combination of two palettes)
  RdYlGn GnYlRd BlGnYl YlGnBl (three color palettes)

Got error as expected from try(test.expand.palette(c("tan1", "huh?")))

> cat("\n")


> binom.mod <- rpart(survived ~ ., data = ptitanic, 
+     cp = 0.02)

> par(mfrow = c(3, 2))

> par(mar = c(0, 0, 4, 0))

> rpart.plot(binom.mod, main = "no node.fun")

> title("node.fun (binomial model)\n\n")

> plot(c(0, 1), c(0, 1), col = 0, bty = "n", xlab = "", 
+     xaxt = "n", ylab = "", yaxt = "n")

> plot2(binom.mod, node.fun = function(x, labs, digits, 
+     varlen) paste(labs))

> plot2(binom.mod, node.fun = function(x, labs, digits, 
+     varlen) round(get.class.stats(x)$prob.per.lev[, 2], 3))

> par(mfrow = c(4, 2))

> par(mar = c(0, 0, 4, 0))

> plot2(binom.mod, node.fun = function(x, labs, digits, 
+     varlen) letters[1:nrow(x$frame)])

node labs generated by node.fun:
[1] "a" "b" "c" "d" "e" "f" "g"

Error : Cannot convert node labs to numeric
To make this error go away, change node.fun or use pal.node.fun=FALSE

> plot2(binom.mod, node.fun = function(x, labs, digits, 
+     varlen) c(1, 2, 3, 4, "nonesuch", 6, 7))

node labs generated by node.fun:
[1] "1"        "2"        "3"        "4"        "nonesuch" "6"        "7"       

Error : Cannot convert node labs to numeric
To make this error go away, change node.fun or use pal.node.fun=FALSE

> plot2(binom.mod, node.fun = function(x, labs, digits, 
+     varlen) 1:nrow(x$frame))

> plot2(binom.mod, node.fun = function(x, labs, digits, 
+     varlen) paste("prefix", 1:nrow(x$frame), "suffix"))

> par(mfrow = c(4, 2))

> par(oma = c(0, 0, 3, 0))

> par(mar = c(0, 0, 3, 0))

> rpart.plot(binom.mod)

> title("pal.thresh (binom mod)\n\n\n\n", xpd = NA)

> rpart.plot(binom.mod, main = "pal.thresh=.5", pal.thresh = 0.5, 
+     trace = 0)

> rpart.plot(binom.mod, main = "pal.thresh=0", pal.thresh = 0, 
+     trace = 0)

> rpart.plot(binom.mod, main = "pal.thresh=1", pal.thresh = 1, 
+     trace = 0)

> rpart.plot(binom.mod, main = "pal.thresh=-10", pal.thresh = -10, 
+     trace = 0)

> rpart.plot(binom.mod, main = "pal.thresh=10", pal.thresh = 10, 
+     trace = 0)

> rpart.plot(binom.mod, main = "pal.thresh=.2", pal.thresh = 0.2, 
+     trace = 0)

> par(mfrow = c(4, 2))

> par(mar = c(0, 0, 3, 0))

> rpart.plot(binom.mod)

> title("pal.thresh with node.fun (binom mod)\n\n")

> plot(c(0, 1), c(0, 1), col = 0, bty = "n", xlab = "", 
+     xaxt = "n", ylab = "", yaxt = "n")

> plot2(binom.mod, node.fun = function(x, labs, digits, 
+     varlen) round(2 * (get.class.stats(x)$prob.per.lev[, 2] - 
+     0.5), 2))

> plot2(binom.mod, node.fun = function(x, labs, digits, 
+     varlen) round(2 * (get.class.stats(x)$prob.per.lev[, 2] - 
+     0.5), 2), pal.thresh = .... [TRUNCATED] 

> mod.survived <- rpart(survived ~ ., data = ptitanic, 
+     control = list(cp = 0.02))

> rpart.plot(mod.survived, type = 2, fallen.leaves = TRUE, 
+     main = "test list palette for binomial response\nlist(Blues, Greens)", 
+     box.pa .... [TRUNCATED] 

> library(earth)

> data(ozone1)

> ozone2 <- ozone1

> set.seed(8)

> ozone2$O3a <- round(runif(330, 1, 10))

> y <- cbind(ozone2$O3, ozone2$O3a)

> mod.poisson <- rpart(y ~ . - O3 - O3a, data = ozone2, 
+     control = list(cp = 0.04))

> par(mfrow = c(2, 2))

> rpart.plot(mod.poisson, extra = "auto", fallen.leaves = TRUE, 
+     box.palette = "BnGn", main = "mod.poisson\nbox.palette=\"BnGn\"")

> rpart.plot(mod.poisson, extra = 0, fallen.leaves = TRUE, 
+     main = "box.palette=\"BnGn\"\npal.thresh=.35", box.palette = "BnGn", 
+     pal.thre .... [TRUNCATED] 

> rpart.plot(mod.poisson, extra = 0, fallen.leaves = TRUE, 
+     main = "box.palette=\"BnGn\"\npal.thresh=.7\nnode.fun", box.palette = "BnGn", 
+     .... [TRUNCATED] 

> rpart.plot(mod.poisson, extra = 0, fallen.leaves = TRUE, 
+     main = "box.palette=\"BnGn\"\npal.thresh=-1\nnode.fun\npal.node.fun=TRUE", 
+     bo .... [TRUNCATED] 

> mod.multiclass <- rpart(pclass ~ ., data = ptitanic, 
+     control = list(cp = 0.02))

> par(mfrow = c(5, 2))

> plot2(mod.multiclass, optional.msg = "mod.multiclass\n", 
+     trace = 1, node.fun = function(x, labs, digits, varlen) substring(labs, 
+         1 .... [TRUNCATED] 
multiclass auto box.palette: list(Blues, Greens)
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0   legend.y 1.22008
multiclass auto box.palette: list(Blues, Greens)
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0   legend.y 1.22008

> plot2(mod.multiclass, box.palette = list("Bu", "Or", 
+     "Gy"), trace = 1, optional.msg = "box.palette=list(\"Bu\",\"Or\",\"Gy\")\n", 
+     node .... [TRUNCATED] 
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0   legend.y 1.22008
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0   legend.y 1.22008

> plot2(mod.multiclass, box.palette = "BuOr", trace = 1, 
+     optional.msg = "box.palette=\"BuOr\"\n", node.fun = function(x, 
+         labs, digit .... [TRUNCATED] 
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0   legend.y 1.22008
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0   legend.y 1.22008

> plot2(mod.multiclass, box.palette = "BuOr", trace = 1, 
+     optional.msg = "box.palette=\"BuOr\"\n", node.fun = function(x, 
+         labs, digit .... [TRUNCATED] 
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0   legend.y 1.22008
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0   legend.y 1.22008

> plot2(mod.multiclass, box.palette = "OrGn", pal.thresh = 20, 
+     trace = 1, optional.msg = "box.palette=\"BuOr\" pal.thresh=20\n", 
+     node.fu .... [TRUNCATED] 
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0   legend.y 1.22008
cex 1   xlim c(0, 1)   ylim c(0, 1)
legend.x 0   legend.y 1.22008

> expect.err(try(rpart.plot(mod.multiclass, type = 2, 
+     extra = "auto", trace = 2, fallen.leaves = TRUE, box.palette = c("blues", 
+         "red ..." ... [TRUNCATED] 
handle.box.palette for class response invokes handle.multiclass.palette
Error : The rpart model has a multiclass response (not a continuous or binary response).
Therefore box.palette must be "auto", or a list of palettes, or a single color or palette.
e.g. box.palette=list("Reds", "Oranges", "Grays", "Blues", "Greens")
Got error as expected from try(rpart.plot(mod.multiclass, type = 2, extra = "auto", trace = 2,     fallen.leaves = TRUE, box.palette = c("blues", "reds"), main = "box.palette=c(\"blues\", \"reds\")"))

> par(old.par)

> cat("== done test.palette.R ==\n")
== done test.palette.R ==
> 
> source("test.na.R", echo=TRUE)

> library(rpart.plot)

> data(ptitanic)

> library(earth)

> data(ozone1)

> sessionInfo()
R version 3.5.3 (2019-03-11)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1

Matrix products: default

locale:
[1] LC_COLLATE=English_United States.1252 
[2] LC_CTYPE=English_United States.1252   
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] randomForest_4.6-14 rattle_5.1.0        earth_4.6.3        
[4] plotmo_3.4.1        TeachingDemos_2.10  plotrix_3.7-2      
[7] rpart.plot_3.0.4    rpart_4.1-13       

loaded via a namespace (and not attached):
[1] compiler_3.5.0     magrittr_1.5       tools_3.5.0        RColorBrewer_1.1-2
[5] stringi_1.2.2      RGtk2_2.20.34     

> ititanic <- ptitanic

> ititanic$survived <- as.integer(ititanic$survived == 
+     "survived")

> options(warn = 1)

> cat0 <- function(...) cat(..., sep = "")

> expect.err <- function(object, expected.msg = "") {
+     if (class(object)[1] == "try-error") {
+         msg <- attr(object, "condition")$message[ .... [TRUNCATED] 

> par(mfrow = c(2, 2))

> a.age <- rpart(age ~ ., data = ptitanic, cp = 0.02)

> a.age$frame$yval[6] <- NA

> rpart.plot(a.age, nn = 1, main = "age with na")
Warning: NA in fitted values (fitted[6] is NA)

> a <- rpart(survived ~ ., data = ptitanic, control = list(cp = 0.02))

> a$frame$yval[3] <- a$frame$yval2[3, 1] <- a$frame$yval2[3, 
+     5] <- NA

> a$frame$yval[4] <- a$frame$yval2[4, 1] <- a$frame$yval2[4, 
+     5] <- NA

> expect.err(try(rpart.plot(a, nn = 1, type = 1, fallen.leaves = FALSE, 
+     main = "survived with na")), "Diverging palettes like box.palette=\"BuG .... [TRUNCATED] 
Error : Diverging palettes like box.palette="BuGn" cannot be used for this model
       because there are NAs in the fitted values.
       Try something like box.palette="Blues"
Got error as expected from try(rpart.plot(a, nn = 1, type = 1, fallen.leaves = FALSE, main = "survived with na"))

> rpart.plot(a, nn = 1, type = 1, fallen.leaves = FALSE, 
+     box.palette = "Blues", main = "survived with na")
Warning: NA in fitted values (fitted[3] is NA)

> a.pclass <- rpart(pclass ~ ., data = ptitanic, control = rpart.control(cp = 0.01))

> a.pclass$frame$yval[3] <- a.pclass$frame$yval2[3, 
+     1] <- NA

> rpart.plot(a.pclass, nn = 1, main = "pclass with na")
> 
> source("test.imports.R", echo=TRUE)

> library(rpart.plot)

> data(ptitanic)

> library(earth)

> data(ozone1)

> sessionInfo()
R version 3.5.3 (2019-03-11)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1

Matrix products: default

locale:
[1] LC_COLLATE=English_United States.1252 
[2] LC_CTYPE=English_United States.1252   
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] randomForest_4.6-14 rattle_5.1.0        earth_4.6.3        
[4] plotmo_3.4.1        TeachingDemos_2.10  plotrix_3.7-2      
[7] rpart.plot_3.0.4    rpart_4.1-13       

loaded via a namespace (and not attached):
[1] compiler_3.5.0     magrittr_1.5       tools_3.5.0        RColorBrewer_1.1-2
[5] stringi_1.2.2      RGtk2_2.20.34     

> ititanic <- ptitanic

> ititanic$survived <- as.integer(ititanic$survived == 
+     "survived")

> options(warn = 1)

> library(DStree)
Loading required package: pec
Loading required package: prodlim
Loading required package: Ecdat
Loading required package: Ecfun

Attaching package: 'Ecfun'

The following object is masked from 'package:base':

    sign


Attaching package: 'Ecdat'

The following object is masked from 'package:datasets':

    Orange


> par(mfrow = c(3, 3))

> example(plot.DStree)

plt.DS> data(cost)

plt.DS> # Discretize observed days to years
plt.DS> d.cost<-dis.cost(cost)

plt.DS> # Grow tree
plt.DS> fit <- DStree(time~prevStroke+age+sex+alcohol+smoke,status="status",data=d.cost)

plt.DS> #Plot tree and survival probabilities
plt.DS> plot(fit)

plt.DS> #survival probabilities are in the first plot
plt.DS> 
plt.DS> #Plot tree and hazard probabilities for terminal leaves 4 and 15
plt.DS> plot(fit,prob="haz",select=c("2","7"))

> plot(fit, prob = "surv", box.palette = "auto", main = "DStree\nbox.palette=\"auto\"")
Warning: NA in fitted values (fitted[5] is NA)

> plot(fit, prob = "surv", type = 1, nn = TRUE, yesno = 2, 
+     box.palette = "Oranges", main = "DStree\ntype=1, nn=TRUE, yesno=2\nbox.palette=\"Ora .... [TRUNCATED] 
Warning: NA in fitted values (fitted[5] is NA)
> 
> source("test.type5.R", echo=TRUE)

> library(rpart.plot)

> library(rattle, quietly = TRUE)

> data(ptitanic)

> library(earth)

> data(ozone1)

> options(warn = 1)

> cat0 <- function(...) cat(..., sep = "")

> expect.err <- function(object, expected.msg = "") {
+     if (class(object)[1] == "try-error") {
+         msg <- attr(object, "condition")$message[ .... [TRUNCATED] 

> cat("== start test.type5.R ==\n")
== start test.type5.R ==

> anova.model <- rpart(Mileage ~ ., data = cu.summary)

> data(iris)

> multi.class.model <- rpart(Species ~ ., data = iris, 
+     cp = 0.001, minsplit = 10)

> data(ptitanic)

> ptit <- ptitanic

> binary.model <- rpart(survived ~ ., data = ptit, cp = 0.02)

> old.par <- par(mfrow = c(2, 3), mar = c(0, 0, 6, 0))

> expect.err(try(rpart.plot(anova.model, type = -1)), 
+     "type must be 0...5, you have type=-1")
Error : type must be 0...5, you have type=-1
Got error as expected from try(rpart.plot(anova.model, type = -1))

> expect.err(try(rpart.plot(anova.model, type = 6)), 
+     "type must be 0...5, you have type=6")
Error : type must be 0...5, you have type=6
Got error as expected from try(rpart.plot(anova.model, type = 6))

> expect.err(try(rpart.plot(anova.model, type = 1.23)), 
+     "floor")
Error in prp(x, type = type, extra = extra, under = under, fallen.leaves = fallen.leaves,  : 
  is.numeric(type) && length(type) == 1 && floor(type) == type is not TRUE
Got error as expected from try(rpart.plot(anova.model, type = 1.23))

> expect.err(try(rpart.plot(anova.model, type = "x")), 
+     "is.numeric")
Error in prp(x, type = type, extra = extra, under = under, fallen.leaves = fallen.leaves,  : 
  is.numeric(type) && length(type) == 1 && floor(type) == type is not TRUE
Got error as expected from try(rpart.plot(anova.model, type = "x"))

> rpart.plot(anova.model, type = 5, main = "*** rpart.plot type=5 ***\nanova.model\nmileage")

> rpart.plot(multi.class.model, type = 5, main = "multi.class.model\nspecies")

> rpart.plot(binary.model, type = 5, main = "binary model\nptitanic")

> rpart.plot(anova.model, type = 5, under = TRUE, varlen = -2, 
+     faclen = 4, box.palette = "BnBu", main = "varlen=3, faclen=3\nbox.palette=\"BnBu .... [TRUNCATED] 

> par(old.par)

> old.par <- par(mfrow = c(2, 3), mar = c(0, 0, 6, 0))

> par(old.par)

> old.par <- par(mfrow = c(2, 3), mar = c(0, 0, 6, 0))

> expect.err(try(prp(anova.model, type = -1)), "type must be 0...5, you have type=-1")
Error : type must be 0...5, you have type=-1
Got error as expected from try(prp(anova.model, type = -1))

> expect.err(try(prp(anova.model, type = 6)), "type must be 0...5, you have type=6")
Error : type must be 0...5, you have type=6
Got error as expected from try(prp(anova.model, type = 6))

> expect.err(try(prp(anova.model, type = 1.23)), "floor")
Error in prp(anova.model, type = 1.23) : 
  is.numeric(type) && length(type) == 1 && floor(type) == type is not TRUE
Got error as expected from try(prp(anova.model, type = 1.23))

> expect.err(try(prp(anova.model, type = "x")), "is.numeric")
Error in prp(anova.model, type = "x") : 
  is.numeric(type) && length(type) == 1 && floor(type) == type is not TRUE
Got error as expected from try(prp(anova.model, type = "x"))

> prp(anova.model, type = 5, main = "*** prp type=5 ***\nanova.model\nmileage")

> prp(multi.class.model, type = 5, main = "multi.class.model\nspecies")

> prp(binary.model, type = 5, main = "binary model\nptitanic")

> prp(multi.class.model, type = 5, varlen = -5, fallen.leaves = TRUE, 
+     clip.left.labs = FALSE, clip.right.labs = FALSE, box.palette = list("Blue ..." ... [TRUNCATED] 

> prp(multi.class.model, main = "assorted arguments", 
+     type = 5, extra = 104, under = TRUE, nn = TRUE, clip.left.labs = FALSE, 
+     clip.right .... [TRUNCATED] 

> prp(anova.model, type = 5, under = TRUE, varlen = -2, 
+     faclen = 4, box.palette = "RdYlGn", main = "varlen=-2, faclen=4\nbox.palette=\"RdYlGn\" ..." ... [TRUNCATED] 

> par(old.par)

> cat("== done test.type5.R ==\n")
== done test.type5.R ==
> 
> source("test.rpart.rules.R", echo=TRUE)

> library(rpart.plot)

> library(rattle, quietly = TRUE)

> library(earth)

> data(ozone1)

> options(warn = 1)

> printf <- function(format, ...) cat(sprint(format, 
+     ...), sep = "")

> cat0 <- function(...) cat(..., sep = "")

> expect.err <- function(object, expected.msg = "") {
+     if (class(object)[1] == "try-error") {
+         msg <- attr(object, "condition")$message[ .... [TRUNCATED] 

> cat0("== start test.rpart.rules.R ==\n")
== start test.rpart.rules.R ==

> old.par <- par(no.readonly = TRUE)

> par(mfrow = c(2, 2), mar = c(3, 3, 3, 1), mgp = c(1.5, 
+     0.5, 0))

> example(rpart.rules)

rprt.r> data(ptitanic)

rprt.r> model <- rpart(survived ~ ., data=ptitanic, cp=.02)

rprt.r> rpart.plot(model,
rprt.r+            # for consistent formatting, following args set to rpart.rules defaults
rprt.r+            digits=-2, roundint=TRUE)

rprt.r> rpart.rules(model)
 survived                                             
     0.89 when sex is   male & age <  9.5 & sibsp <  3
     0.73 when sex is female                          
     0.17 when sex is   male & age >= 9.5             
     0.05 when sex is   male & age <  9.5 & sibsp >= 3

> cat0("\n=== rpart(Species ~ ., data=iris) ===\n\n")

=== rpart(Species ~ ., data=iris) ===


> data(iris)

> mod3 <- rpart(Species ~ ., data = iris)

> print(rpart.rules(mod3))
    Species   set ver vir                                               
  virginica [ .00 .02 .98] when Petal.Length >= 2.5 & Petal.Width >= 1.8
 versicolor [ .00 .91 .09] when Petal.Length >= 2.5 & Petal.Width <  1.8
     setosa [1.00 .00 .00] when Petal.Length <  2.5                     

> rpart.plot(mod3, roundint = TRUE, main = "rpart(Species ~ ., data=iris)")

> par(old.par)

> data(trees)

> trees1 <- trees

> mod <- rpart(formula = Volume ~ Girth, data = trees1, 
+     cp = 0.001)

> rules <- rpart.rules(mod, roundint = TRUE)

> print(rules)
 Volume                       
     56 when Girth >=       16
     31 when Girth    12 to 16
     18 when Girth <  12      

> trees1 <- "bad data"

> expect.err(try(rpart.rules(mod, roundint = TRUE)), 
+     "Cannot retrieve the data used to build the model")
Error : Cannot retrieve the data used to build the model.
Cannot use roundint=TRUE for this model unless you rebuild the rpart model with model=TRUE.
Got error as expected from try(rpart.rules(mod, roundint = TRUE))

> trees1 <- trees

> mod.model.eq.TRUE <- rpart(formula = Volume ~ Girth, 
+     data = trees1, cp = 0.001, model = TRUE)

> rules <- rpart.rules(mod.model.eq.TRUE, roundint = TRUE)

> print(rules)
 Volume                       
     56 when Girth >=       16
     31 when Girth    12 to 16
     18 when Girth <  12      

> trees1 <- "bad data"

> print(rpart.rules(mod.model.eq.TRUE, roundint = TRUE))
 Volume                       
     56 when Girth >=       16
     31 when Girth    12 to 16
     18 when Girth <  12      

> par(old.par)

> cat0("\n=== test digits, varlen, faclen, trace ===\n\n")

=== test digits, varlen, faclen, trace ===


> mileage <- rpart(Mileage ~ ., data = cu.summary)

> cat0("mileage default\n")
mileage default

> print(rpart.rules(mileage))
 Mileage                                                           
      32 when Price <  9447                                        
      25 when Price    9447 to 11485 & Type is Compact,Small,Sporty
      24 when Price >=         11485 & Type is Compact,Small,Sporty
      22 when Price >=          9447 & Type is               Medium
      19 when Price >=          9447 & Type is            Large,Van

> cat0("mileage digits=0\n")
mileage digits=0

> print(rpart.rules(mileage, digits = 0, trace = 1))
Will apply roundint to the following variables: Mileage Price 

iframe   4 node   8 path c("root", "Price >= 9447", "Type = Large,Medium,Van", "Type = Large,Van")
iframe   5 node   9 path c("root", "Price >= 9447", "Type = Large,Medium,Van", "Type = Medium")
iframe   7 node  10 path c("root", "Price >= 9447", "Type = Compact,Small,Sporty", "Price >= 11.485e+3")
iframe   8 node  11 path c("root", "Price >= 9447", "Type = Compact,Small,Sporty", "Price < 11.485e+3")
iframe   9 node   3 path c("root", "Price < 9447")

raw rules:
  lab      fit           iclass    cover Price=    Price<   Price>=                Type= Type< Type>= Reliability= Reliability< Reliability>= Country= Country< Country>=
1         19.3             19.3 16.66667                       9447            Large,Van                                                                                 
2     21.76923 21.7692307692308 21.66667                       9447               Medium                                                                                 
3     23.85714 23.8571428571429 23.33333                  11.485e+3 Compact,Small,Sporty                                                                                 
4     25.45455 25.4545454545455 18.33333        11.485e+3      9447 Compact,Small,Sporty                                                                                 
5     32.08333 32.0833333333333 20.00000             9447                                                                                                                

processed rules:
   Mileage                                                           
1 32.08333 when Price <  9447                                        
2 25.45455 when Price    9447 to 11485 & Type is Compact,Small,Sporty
3 23.85714 when Price >=         11485 & Type is Compact,Small,Sporty
4 21.76923 when Price >=          9447 & Type is               Medium
5     19.3 when Price >=          9447 & Type is            Large,Van

  Mileage                                                           
 32.08333 when Price <  9447                                        
 25.45455 when Price    9447 to 11485 & Type is Compact,Small,Sporty
 23.85714 when Price >=         11485 & Type is Compact,Small,Sporty
 21.76923 when Price >=          9447 & Type is               Medium
     19.3 when Price >=          9447 & Type is            Large,Van

> cat0("mileage digits=2\n")
mileage digits=2

> print(rpart.rules(mileage, digits = 2))
 Mileage                                                           
      32 when Price <  9447                                        
      25 when Price    9447 to 11000 & Type is Compact,Small,Sporty
      24 when Price >=         11000 & Type is Compact,Small,Sporty
      22 when Price >=          9447 & Type is               Medium
      19 when Price >=          9447 & Type is            Large,Van

> cat0("mileage digits=3\n")
mileage digits=3

> print(rpart.rules(mileage, digits = 3))
 Mileage                                                           
    32.1 when Price <  9447                                        
    25.5 when Price    9447 to 11500 & Type is Compact,Small,Sporty
    23.9 when Price >=         11500 & Type is Compact,Small,Sporty
    21.8 when Price >=          9447 & Type is               Medium
    19.3 when Price >=          9447 & Type is            Large,Van

> cat0("mileage digits=10\n")
mileage digits=10

> print(rpart.rules(mileage, digits = 10))
     Mileage                                                           
 32.08333333 when Price <  9447                                        
 25.45454545 when Price    9447 to 11485 & Type is Compact,Small,Sporty
 23.85714286 when Price >=         11485 & Type is Compact,Small,Sporty
 21.76923077 when Price >=          9447 & Type is               Medium
        19.3 when Price >=          9447 & Type is            Large,Van

> cat0("mileage digits=-10\n")
mileage digits=-10

> print(rpart.rules(mileage, digits = -10))
     Mileage                                                           
 32.08333333 when Price <  9447                                        
 25.45454545 when Price    9447 to 11485 & Type is Compact,Small,Sporty
 23.85714286 when Price >=         11485 & Type is Compact,Small,Sporty
 21.76923077 when Price >=          9447 & Type is               Medium
        19.3 when Price >=          9447 & Type is            Large,Van

> cat0("mileage faclen=1\n")
mileage faclen=1

> print(rpart.rules(mileage, faclen = 1))
 Mileage                                          
      32 when Price <  9447                       
      25 when Price    9447 to 11485 & Type is ade
      24 when Price >=         11485 & Type is ade
      22 when Price >=          9447 & Type is   c
      19 when Price >=          9447 & Type is  bf

> cat0("mileage faclen=2\n")
mileage faclen=2

> print(rpart.rules(mileage, faclen = 2))
 Mileage                                               
      32 when Price <  9447                            
      25 when Price    9447 to 11485 & Type is Cm,Sm,Sp
      24 when Price >=         11485 & Type is Cm,Sm,Sp
      22 when Price >=          9447 & Type is       Md
      19 when Price >=          9447 & Type is    Lr,Vn

> cat0("mileage faclen=-1\n")
mileage faclen=-1

> print(rpart.rules(mileage, faclen = -1))
 Mileage                                               
      32 when Price <  9447                            
      25 when Price    9447 to 11485 & Type is Co,Sm,Sp
      24 when Price >=         11485 & Type is Co,Sm,Sp
      22 when Price >=          9447 & Type is       Me
      19 when Price >=          9447 & Type is    La,Va

> cat0("mileage faclen=-2\n")
mileage faclen=-2

> print(rpart.rules(mileage, faclen = -2, trace = TRUE))
Will apply roundint to the following variables: Mileage Price 

iframe   4 node   8 path c("root", "Price >= 9447", "Type = La,Me,Va", "Type = La,Va")
iframe   5 node   9 path c("root", "Price >= 9447", "Type = La,Me,Va", "Type = Me")
iframe   7 node  10 path c("root", "Price >= 9447", "Type = Co,Sm,Sp", "Price >= 11485")
iframe   8 node  11 path c("root", "Price >= 9447", "Type = Co,Sm,Sp", "Price < 11485")
iframe   9 node   3 path c("root", "Price < 9447")

raw rules:
  lab fit           iclass cover Price= Price< Price>=    Type= Type< Type>= Reliability= Reliability< Reliability>= Country= Country< Country>=
1      19             19.3    17                  9447    La,Va                                                                                 
2      22 21.7692307692308    22                  9447       Me                                                                                 
3      24 23.8571428571429    23                 11485 Co,Sm,Sp                                                                                 
4      25 25.4545454545455    18         11485    9447 Co,Sm,Sp                                                                                 
5      32 32.0833333333333    20          9447                                                                                                  

processed rules:
  Mileage                                               
1      32 when Price <  9447                            
2      25 when Price    9447 to 11485 & Type is Co,Sm,Sp
3      24 when Price >=         11485 & Type is Co,Sm,Sp
4      22 when Price >=          9447 & Type is       Me
5      19 when Price >=          9447 & Type is    La,Va

 Mileage                                               
      32 when Price <  9447                            
      25 when Price    9447 to 11485 & Type is Co,Sm,Sp
      24 when Price >=         11485 & Type is Co,Sm,Sp
      22 when Price >=          9447 & Type is       Me
      19 when Price >=          9447 & Type is    La,Va

> cat0("mileage faclen=-4\n")
mileage faclen=-4

> print(rpart.rules(mileage, faclen = -4))
 Mileage                                                     
      32 when Price <  9447                                  
      25 when Price    9447 to 11485 & Type is Comp,Smal,Spor
      24 when Price >=         11485 & Type is Comp,Smal,Spor
      22 when Price >=          9447 & Type is           Medi
      19 when Price >=          9447 & Type is       Larg,Van

> cu.summary2 <- cu.summary

> cu.summary2$Mileage <- -cu.summary2$Mileage

> cu.summary2$Price <- -cu.summary2$Price

> mileage2 <- rpart(Mileage ~ ., data = cu.summary2)

> cat0("mileage2 (negative response and predictor values)\n")
mileage2 (negative response and predictor values)

> print(rpart.rules(mileage2))
 Mileage                                                             
     -32 when Price >=           -9446                               
     -25 when Price    -11484 to -9446 & Type is Compact,Small,Sporty
     -24 when Price <  -11484          & Type is Compact,Small,Sporty
     -22 when Price <   -9446          & Type is               Medium
     -19 when Price <   -9446          & Type is            Large,Van

> cat0("mileage2 varlen=2, faclen=-3, digits=3\n")
mileage2 varlen=2, faclen=-3, digits=3

> print(rpart.rules(mileage2, varlen = 2, faclen = -3, 
+     digits = 3))
 Mileage                                               
   -32.1 when Pr >=           -9446                    
   -25.5 when Pr    -11500 to -9446 & Ty is Com,Sma,Spo
   -23.9 when Pr <  -11500          & Ty is Com,Sma,Spo
   -21.8 when Pr <   -9446          & Ty is         Med
   -19.3 when Pr <   -9446          & Ty is     Lar,Van

> data(ptitanic)

> age <- rpart(age ~ ., data = ptitanic)

> cat0("age varlen=0\n")
age varlen=0

> print(rpart.rules(age, varlen = 0))
 age                                                                                             
 9.6 when pclass is 2nd,3rd & parch    1 to 3 & sibsp >= 2                                       
 7.1 when pclass is 2nd,3rd & parch    1 to 3 & sibsp <  2 & survived is survived & sex is   male
  41 when pclass is     1st & parch <  2                                                         
  37 when pclass is 2nd,3rd & parch >=      3                                                    
  32 when pclass is     2nd & parch <  1                                                         
  28 when pclass is     1st & parch >=      2                                                    
  27 when pclass is     3rd & parch <  1                                                         
  26 when pclass is 2nd,3rd & parch    1 to 3 & sibsp <  2 & survived is     died                
  21 when pclass is 2nd,3rd & parch    1 to 3 & sibsp <  2 & survived is survived & sex is female

> cat0("age varlen=1\n")
age varlen=1

> print(rpart.rules(age, varlen = 1))
 age                                                                            
 9.6 when pc is 2nd,3rd & pr    1 to 3 & sb >= 2                                
 7.1 when pc is 2nd,3rd & pr    1 to 3 & sb <  2 & sr is survived & sx is   male
  41 when pc is     1st & pr <  2                                               
  37 when pc is 2nd,3rd & pr >=      3                                          
  32 when pc is     2nd & pr <  1                                               
  28 when pc is     1st & pr >=      2                                          
  27 when pc is     3rd & pr <  1                                               
  26 when pc is 2nd,3rd & pr    1 to 3 & sb <  2 & sr is     died               
  21 when pc is 2nd,3rd & pr    1 to 3 & sb <  2 & sr is survived & sx is female

> cat0("age varlen=2\n")
age varlen=2

> print(rpart.rules(age, varlen = 2))
 age                                                                            
 9.6 when pc is 2nd,3rd & pr    1 to 3 & sb >= 2                                
 7.1 when pc is 2nd,3rd & pr    1 to 3 & sb <  2 & sr is survived & sx is   male
  41 when pc is     1st & pr <  2                                               
  37 when pc is 2nd,3rd & pr >=      3                                          
  32 when pc is     2nd & pr <  1                                               
  28 when pc is     1st & pr >=      2                                          
  27 when pc is     3rd & pr <  1                                               
  26 when pc is 2nd,3rd & pr    1 to 3 & sb <  2 & sr is     died               
  21 when pc is 2nd,3rd & pr    1 to 3 & sb <  2 & sr is survived & sx is female

> cat0("age varlen=3\n")
age varlen=3

> print(rpart.rules(age, varlen = 3))
 age                                                                                 
 9.6 when pcl is 2nd,3rd & prc    1 to 3 & sbs >= 2                                  
 7.1 when pcl is 2nd,3rd & prc    1 to 3 & sbs <  2 & srv is survived & sex is   male
  41 when pcl is     1st & prc <  2                                                  
  37 when pcl is 2nd,3rd & prc >=      3                                             
  32 when pcl is     2nd & prc <  1                                                  
  28 when pcl is     1st & prc >=      2                                             
  27 when pcl is     3rd & prc <  1                                                  
  26 when pcl is 2nd,3rd & prc    1 to 3 & sbs <  2 & srv is     died                
  21 when pcl is 2nd,3rd & prc    1 to 3 & sbs <  2 & srv is survived & sex is female

> cat0("age varlen=-1\n")
age varlen=-1

> print(rpart.rules(age, varlen = -1))
 age                                                                            
 9.6 when pc is 2nd,3rd & pa    1 to 3 & si >= 2                                
 7.1 when pc is 2nd,3rd & pa    1 to 3 & si <  2 & su is survived & se is   male
  41 when pc is     1st & pa <  2                                               
  37 when pc is 2nd,3rd & pa >=      3                                          
  32 when pc is     2nd & pa <  1                                               
  28 when pc is     1st & pa >=      2                                          
  27 when pc is     3rd & pa <  1                                               
  26 when pc is 2nd,3rd & pa    1 to 3 & si <  2 & su is     died               
  21 when pc is 2nd,3rd & pa    1 to 3 & si <  2 & su is survived & se is female

> cat0("age varlen=-2\n")
age varlen=-2

> print(rpart.rules(age, varlen = -2))
 age                                                                            
 9.6 when pc is 2nd,3rd & pa    1 to 3 & si >= 2                                
 7.1 when pc is 2nd,3rd & pa    1 to 3 & si <  2 & su is survived & se is   male
  41 when pc is     1st & pa <  2                                               
  37 when pc is 2nd,3rd & pa >=      3                                          
  32 when pc is     2nd & pa <  1                                               
  28 when pc is     1st & pa >=      2                                          
  27 when pc is     3rd & pa <  1                                               
  26 when pc is 2nd,3rd & pa    1 to 3 & si <  2 & su is     died               
  21 when pc is 2nd,3rd & pa    1 to 3 & si <  2 & su is survived & se is female

> cat0("age varlen=-3\n")
age varlen=-3

> print(rpart.rules(age, varlen = -3))
 age                                                                                 
 9.6 when pcl is 2nd,3rd & par    1 to 3 & sib >= 2                                  
 7.1 when pcl is 2nd,3rd & par    1 to 3 & sib <  2 & sur is survived & sex is   male
  41 when pcl is     1st & par <  2                                                  
  37 when pcl is 2nd,3rd & par >=      3                                             
  32 when pcl is     2nd & par <  1                                                  
  28 when pcl is     1st & par >=      2                                             
  27 when pcl is     3rd & par <  1                                                  
  26 when pcl is 2nd,3rd & par    1 to 3 & sib <  2 & sur is     died                
  21 when pcl is 2nd,3rd & par    1 to 3 & sib <  2 & sur is survived & sex is female

> cat0("age varlen=-3, faclen=1\n")
age varlen=-3, faclen=1

> print(rpart.rules(age, varlen = -3, faclen = 1))
 age                                                                
 9.6 when pcl is bc & par    1 to 3 & sib >= 2                      
 7.1 when pcl is bc & par    1 to 3 & sib <  2 & sur is b & sex is b
  41 when pcl is  a & par <  2                                      
  37 when pcl is bc & par >=      3                                 
  32 when pcl is  b & par <  1                                      
  28 when pcl is  a & par >=      2                                 
  27 when pcl is  c & par <  1                                      
  26 when pcl is bc & par    1 to 3 & sib <  2 & sur is a           
  21 when pcl is bc & par    1 to 3 & sib <  2 & sur is b & sex is a

> cat0("age varlen=-3, faclen=2\n")
age varlen=-3, faclen=2

> print(rpart.rules(age, varlen = -3, faclen = 2))
 age                                                                     
 9.6 when pcl is 2n,3r & par    1 to 3 & sib >= 2                        
 7.1 when pcl is 2n,3r & par    1 to 3 & sib <  2 & sur is sr & sex is ml
  41 when pcl is    1s & par <  2                                        
  37 when pcl is 2n,3r & par >=      3                                   
  32 when pcl is    2n & par <  1                                        
  28 when pcl is    1s & par >=      2                                   
  27 when pcl is    3r & par <  1                                        
  26 when pcl is 2n,3r & par    1 to 3 & sib <  2 & sur is dd            
  21 when pcl is 2n,3r & par    1 to 3 & sib <  2 & sur is sr & sex is fm

> cat0("age varlen=-3, faclen=2, digits=1\n")
age varlen=-3, faclen=2, digits=1

> print(rpart.rules(age, varlen = -3, faclen = 2, digits = 1))
 age                                                                     
 9.6 when pcl is 2n,3r & par    1 to 3 & sib >= 2                        
 7.1 when pcl is 2n,3r & par    1 to 3 & sib <  2 & sur is sr & sex is ml
  41 when pcl is    1s & par <  2                                        
  37 when pcl is 2n,3r & par >=      3                                   
  32 when pcl is    2n & par <  1                                        
  28 when pcl is    1s & par >=      2                                   
  27 when pcl is    3r & par <  1                                        
  26 when pcl is 2n,3r & par    1 to 3 & sib <  2 & sur is dd            
  21 when pcl is 2n,3r & par    1 to 3 & sib <  2 & sur is sr & sex is fm

> cat0("\n=== test various types of predictor with roundint and cover ===\n")

=== test various types of predictor with roundint and cover ===

> old.par <- par(no.readonly = TRUE)

> par(mfrow = c(4, 5), mar = c(3, 3, 3, 1), mgp = c(1.5, 
+     0.5, 0))

> data <- "nonesuch"

> build.models <- function(roundint, use.prp) {
+     form <- Volume ~ . - Height
+     main <- paste0("roundint=", roundint, "\ncontinuous predictors ..." ... [TRUNCATED] 

> for (use.prp in c(FALSE, TRUE)) for (roundint in c(FALSE, 
+     TRUE)) ret <- build.models(roundint, use.prp = use.prp)
roundint=FALSE
continuous predictors
 Volume                           
   55.9 when Girth >=         16.2
   30.5 when Girth    12.5 to 16.2
   17.9 when Girth <  12.5        
 Volume                                        cover
   55.9 when fac16 is   big                      23%
   30.5 when fac16 is small & logical12 is 1     29%
   17.9 when fac16 is small & logical12 is 0     48%
 Volume                                       
   55.9 when numeric16 >= 0.5                 
   30.5 when numeric16 <  0.5 & logical12 is 1
   17.9 when numeric16 <  0.5 & logical12 is 0
roundint=FALSE
discrete Girth
 Volume                            cover
   55.9 when Girth >=        2.5     23%
   30.5 when Girth    1.5 to 2.5     29%
   17.9 when Girth <  1.5            48%
roundint=FALSE
model without data arg
 Volume                         
    559 when Girth >=        162
    305 when Girth    125 to 162
    179 when Girth <  125       
roundint=TRUE
continuous predictors
 Volume                           
   55.9 when Girth >=         16.2
   30.5 when Girth    12.5 to 16.2
   17.9 when Girth <  12.5        
 Volume                                        cover
   55.9 when fac16 is   big                      23%
   30.5 when fac16 is small & logical12 is 1     29%
   17.9 when fac16 is small & logical12 is 0     48%
 Volume                                     
   55.9 when numeric16 >= 1                 
   30.5 when numeric16 <  1 & logical12 is 1
   17.9 when numeric16 <  1 & logical12 is 0
roundint=TRUE
discrete Girth
 Volume                        cover
   55.9 when Girth >=      3     23%
   30.5 when Girth    2 to 3     29%
   17.9 when Girth <  2          48%
roundint=TRUE
model without data arg
 Volume                         
    559 when Girth >=        162
    305 when Girth    125 to 162
    179 when Girth <  125       
roundint=FALSE
continuous predictors
roundint=FALSE
discrete Girth
roundint=FALSE
model without data arg
roundint=TRUE
continuous predictors
roundint=TRUE
discrete Girth
roundint=TRUE
model without data arg

> par(old.par)

> mod <- ret$mod

> mod.without.data.arg <- ret$mod.without.data.arg

> print(rpart.rules(mod, roundint = FALSE))
 Volume                                       
     56 when numeric16 >= 0.5                 
     31 when numeric16 <  0.5 & logical12 is 1
     18 when numeric16 <  0.5 & logical12 is 0

> expect.err(try(rpart.rules(mod, roundint = TRUE)), 
+     "Cannot retrieve the data used to build the model")
Error in eval(data, envir = env) : object 'trees.internal' not found
Error : Cannot retrieve the data used to build the model.
Cannot use roundint=TRUE for this model unless you rebuild the rpart model with model=TRUE.
Got error as expected from try(rpart.rules(mod, roundint = TRUE))

> print(rpart.rules(mod.without.data.arg, roundint = FALSE))
 Volume                         
    559 when Girth >=        162
    305 when Girth    125 to 162
    179 when Girth <  125       

> print(rpart.rules(mod.without.data.arg, roundint = TRUE))
 Volume                         
    559 when Girth >=        162
    305 when Girth    125 to 162
    179 when Girth <  125       

> cat0("\n=== oz.vis55 ===\n")

=== oz.vis55 ===

> library(earth)

> data(ozone1)

> oz <- ozone1

> oz$vis55 <- oz$vis >= 55

> oz$vis <- NULL

> oz.vis55 <- rpart(O3 ~ ., data = oz)

> print(rpart.rules(oz.vis55))
  O3                                                                                                  
 9.1 when temp <  68 & ibt <  159 & ibh <  3574              & dpg >= -9                              
 6.5 when temp <  68              & ibh <  3574              & dpg <  -9                              
 5.1 when temp <  68              & ibh >= 3574                                                       
  27 when temp >= 68 & ibt >= 227               & doy <  307                              & vis55 is 0
  23 when temp >= 68 & ibt >= 227               & doy <  307                              & vis55 is 1
  17 when temp >= 68 & ibt <  227                                        & humidity >= 60             
  16 when temp >= 68 & ibt >= 227               & doy >= 307                                          
  14 when temp <  68 & ibt >= 159 & ibh <  3574              & dpg >= -9                              
  11 when temp >= 68 & ibt <  227                                        & humidity <  60             

> cat0("\n=== Country ===\n")

=== Country ===

> Country <- rpart(Country ~ ., data = cu.summary)

> print(rpart.rules(Country, cover = TRUE))
   Country  Bra Eng Fra Ger Jap Jap Kor Mex Swe USA                                                                                                    cover
 Japan/USA [.06 .00 .00 .00 .29 .47 .00 .06 .00 .12] when Reliability is       better,Much better & Price     7038 to 13202                              15%
     Japan [.00 .00 .00 .11 .89 .00 .00 .00 .00 .00] when Reliability is       better,Much better & Price >=          13202                               8%
     Japan [.00 .00 .00 .00 .71 .14 .14 .00 .00 .00] when Reliability is       better,Much better & Price <   7038                                        6%
   Germany [.00 .00 .00 .50 .10 .00 .00 .00 .30 .10] when Reliability is Much worse,worse,average & Price >=          16669 & Type is Compact,Sporty      9%
       USA [.00 .00 .02 .04 .17 .00 .07 .04 .00 .67] when Reliability is Much worse,worse,average & Price <  16669                                       46%
       USA [.00 .05 .05 .15 .15 .00 .00 .00 .10 .50] when Reliability is Much worse,worse,average & Price >=          16669 & Type is   Large,Medium     17%

> expect.err(try(rpart.rules(Country, nonesuch = "nonesuch")), 
+     "unused argument (nonesuch = \"nonesuch\")")
Error in rpart.rules(Country, nonesuch = "nonesuch") : 
  unused argument (nonesuch = "nonesuch")
Got error as expected from try(rpart.rules(Country, nonesuch = "nonesuch"))

> expect.err(try(print(rpart.rules(Country), nonesuch2 = "nonesuch2")), 
+     "unused argument (nonesuch2 = \"nonesuch2\")")
Error in stop.if.dot.arg.used(...) : 
  unused argument (nonesuch2 = "nonesuch2")
Got error as expected from try(print(rpart.rules(Country), nonesuch2 = "nonesuch2"))

> expect.err(try(rpart.rules(99)), "the object passed to rpart.rules is not an rpart object")
Error : the object passed to rpart.rules is not an rpart object
Got error as expected from try(rpart.rules(99))

> cat0("\n=== style argument ===\n")

=== style argument ===

> Mileage <- rpart(Mileage ~ ., data = cu.summary)

> rules <- rpart.rules(Mileage)

> cat0("\nMileage style=0\n")

Mileage style=0

> print(rules, style = 0)
 Mileage                                                           
      32 when Price <  9447                                        
      25 when Price    9447 to 11485 & Type is Compact,Small,Sporty
      24 when Price >=         11485 & Type is Compact,Small,Sporty
      22 when Price >=          9447 & Type is               Medium
      19 when Price >=          9447 & Type is            Large,Van

> cat0("\nMileage style=1\n")

Mileage style=1

> print(rules, style = 1)
 Mileage                                                           
      32 when Price <  9447                                        
                                                                   
      25 when Price    9447 to 11485 & Type is Compact,Small,Sporty
                                                                   
      24 when Price >=         11485 & Type is Compact,Small,Sporty
                                                                   
      22 when Price >=          9447 & Type is               Medium
                                                                   
      19 when Price >=          9447 & Type is            Large,Van

> cat0("\nMileage style=2\n")

Mileage style=2

> print(rules, style = 2)
Mileage
     32 when Price < 9447

     25 when Price 9447 to 11485
             Type is Compact,Small,Sporty

     24 when Price >= 11485
             Type is Compact,Small,Sporty

     22 when Price >= 9447
             Type is Medium

     19 when Price >= 9447
             Type is Large,Van

> data(ptitanic)

> survived <- rpart(survived ~ ., data = ptitanic)

> cat0("\nsurvived style=1\n")

survived style=1

> print(rpart.rules(survived, style = 1, varlen = -3, 
+     faclen = 2, digits = -2))
 survived                                                                          
     0.93 when sex is fm                                  & pcl is 1s,2n           
                                                                                   
     0.89 when sex is ml & age <   9.5         & sib <  3                          
                                                                                   
     0.73 when sex is fm & age <  17.0         & sib <  3 & pcl is    3r           
                                                                                   
     0.62 when sex is fm & age    22.0 to 28.0 & sib <  3 & pcl is    3r & par <  4
                                                                                   
     0.39 when sex is fm & age >=         28.0 & sib <  3 & pcl is    3r & par <  4
                                                                                   
     0.39 when sex is fm & age    17.0 to 22.0 & sib <  3 & pcl is    3r & par <  4
                                                                                   
     0.17 when sex is ml & age >=          9.5                                     
                                                                                   
     0.14 when sex is fm                       & sib >= 3 & pcl is    3r           
                                                                                   
     0.11 when sex is fm & age >=         17.0 & sib <  3 & pcl is    3r & par >= 4
                                                                                   
     0.05 when sex is ml & age <   9.5         & sib >= 3                          

> cat0("\nsurvived style=2\n")

survived style=2

> print(rpart.rules(survived, style = 2, varlen = -3, 
+     faclen = 2, digits = -2))
survived
    0.93 when sex is fm
              pcl is 1s,2n

    0.89 when sex is ml
              age < 9.5
              sib < 3

    0.73 when sex is fm
              age < 17.0
              sib < 3
              pcl is 3r

    0.62 when sex is fm
              age 22.0 to 28.0
              sib < 3
              pcl is 3r
              par < 4

    0.39 when sex is fm
              age >= 28.0
              sib < 3
              pcl is 3r
              par < 4

    0.39 when sex is fm
              age 17.0 to 22.0
              sib < 3
              pcl is 3r
              par < 4

    0.17 when sex is ml
              age >= 9.5

    0.14 when sex is fm
              sib >= 3
              pcl is 3r

    0.11 when sex is fm
              age >= 17.0
              sib < 3
              pcl is 3r
              par >= 4

    0.05 when sex is ml
              age < 9.5
              sib >= 3

> Species <- rpart(Species ~ ., data = iris)

> cat0("\nSpecies style=1\n")

Species style=1

> print(rpart.rules(Species, style = 1))
    Species   set ver vir                                               
  virginica [ .00 .02 .98] when Petal.Length >= 2.5 & Petal.Width >= 1.8
                                                                        
 versicolor [ .00 .91 .09] when Petal.Length >= 2.5 & Petal.Width <  1.8
                                                                        
     setosa [1.00 .00 .00] when Petal.Length <  2.5                     

> cat0("\nSpecies style=2\n")

Species style=2

> print(rpart.rules(Species, style = 2))
Species      set ver vir 
virginica  [ .00 .02 .98] when Petal.Length >= 2.5
                               Petal.Width >= 1.8

versicolor [ .00 .91 .09] when Petal.Length >= 2.5
                               Petal.Width < 1.8

setosa     [1.00 .00 .00] when Petal.Length < 2.5

> Reliability <- rpart(Reliability ~ ., data = cu.summary)

> cat0("\nReliability style=1\n")

Reliability style=1

> print(rpart.rules(Reliability, style = 1))
 Reliability  Muc wor ave bet Muc                                                                            
 Much better [.00 .00 .11 .11 .78] when Country is                 Japan,Japan/USA                           
                                                                                                             
     average [.26 .15 .59 .00 .00] when Country is Germany,Korea,Mexico,Sweden,USA & Type is Large,Medium,Van
                                                                                                             
     average [.00 .25 .50 .25 .00] when Country is           Germany,Mexico,Sweden & Type is    Compact,Small
                                                                                                             
       worse [.29 .43 .07 .21 .00] when Country is                       Korea,USA & Type is    Compact,Small
                                                                                                             
  Much worse [.78 .00 .22 .00 .00] when Country is Germany,Korea,Mexico,Sweden,USA & Type is           Sporty

> cat0("\nReliability style=2\n")

Reliability style=2

> print(rpart.rules(Reliability, style = 2))
Reliability  Muc wor ave bet Muc 
Much better [.00 .00 .11 .11 .78] when Country is Japan,Japan/USA

average     [.26 .15 .59 .00 .00] when Country is Germany,Korea,Mexico,Sweden,USA
                                       Type is Large,Medium,Van

average     [.00 .25 .50 .25 .00] when Country is Germany,Mexico,Sweden
                                       Type is Compact,Small

worse       [.29 .43 .07 .21 .00] when Country is Korea,USA
                                       Type is Compact,Small

Much worse  [.78 .00 .22 .00 .00] when Country is Germany,Korea,Mexico,Sweden,USA
                                       Type is Sporty

> cat0("\n=== null model ===\n")

=== null model ===

> data(ptitanic)

> null.model <- rpart(survived ~ sibsp, data = ptitanic)

> print(rpart.rules(null.model))
 survived     
     0.38 when

> print(rpart.rules(null.model, style = 1))
 survived     
     0.38 when

> print(rpart.rules(null.model, style = 2))
survived
    0.38 when

> cat("\n=== varorder ===\n")

=== varorder ===

> data(ptitanic)

> survived <- rpart(survived ~ ., data = ptitanic)

> cat("varorder=NULL (default)\n")
varorder=NULL (default)

> print(rpart.rules(survived))
 survived                                                                                       
     0.93 when sex is female                                    & pclass is 1st,2nd             
     0.89 when sex is   male & age <   9.5         & sibsp <  3                                 
     0.73 when sex is female & age <  17.0         & sibsp <  3 & pclass is     3rd             
     0.62 when sex is female & age    22.0 to 28.0 & sibsp <  3 & pclass is     3rd & parch <  4
     0.39 when sex is female & age >=         28.0 & sibsp <  3 & pclass is     3rd & parch <  4
     0.39 when sex is female & age    17.0 to 22.0 & sibsp <  3 & pclass is     3rd & parch <  4
     0.17 when sex is   male & age >=          9.5                                              
     0.14 when sex is female                       & sibsp >= 3 & pclass is     3rd             
     0.11 when sex is female & age >=         17.0 & sibsp <  3 & pclass is     3rd & parch >= 4
     0.05 when sex is   male & age <   9.5         & sibsp >= 3                                 

> cat("varorder=\"pclass\"\n")
varorder="pclass"

> print(rpart.rules(survived, varorder = "pclass"))
 survived                                                                                       
     0.93 when pclass is 1st,2nd & sex is female                                                
     0.89 when                   & sex is   male & age <   9.5         & sibsp <  3             
     0.73 when pclass is     3rd & sex is female & age <  17.0         & sibsp <  3             
     0.62 when pclass is     3rd & sex is female & age    22.0 to 28.0 & sibsp <  3 & parch <  4
     0.39 when pclass is     3rd & sex is female & age >=         28.0 & sibsp <  3 & parch <  4
     0.39 when pclass is     3rd & sex is female & age    17.0 to 22.0 & sibsp <  3 & parch <  4
     0.17 when                   & sex is   male & age >=          9.5                          
     0.14 when pclass is     3rd & sex is female                       & sibsp >= 3             
     0.11 when pclass is     3rd & sex is female & age >=         17.0 & sibsp <  3 & parch >= 4
     0.05 when                   & sex is   male & age <   9.5         & sibsp >= 3             

> cat("varorder=c('pclass', 'sibsp')\n")
varorder=c('pclass', 'sibsp')

> print(rpart.rules(survived, varorder = c("pclass", 
+     "sibsp")))
 survived                                                                                       
     0.93 when pclass is 1st,2nd              & sex is female                                   
     0.89 when                   & sibsp <  3 & sex is   male & age <   9.5                     
     0.73 when pclass is     3rd & sibsp <  3 & sex is female & age <  17.0                     
     0.62 when pclass is     3rd & sibsp <  3 & sex is female & age    22.0 to 28.0 & parch <  4
     0.39 when pclass is     3rd & sibsp <  3 & sex is female & age >=         28.0 & parch <  4
     0.39 when pclass is     3rd & sibsp <  3 & sex is female & age    17.0 to 22.0 & parch <  4
     0.17 when                                & sex is   male & age >=          9.5             
     0.14 when pclass is     3rd & sibsp >= 3 & sex is female                                   
     0.11 when pclass is     3rd & sibsp <  3 & sex is female & age >=         17.0 & parch >= 4
     0.05 when                   & sibsp >= 3 & sex is   male & age <   9.5                     

> cat("varorder=c('pclass', 'sex', 'sibsp')\n")
varorder=c('pclass', 'sex', 'sibsp')

> print(rpart.rules(survived, varorder = c("pclass", 
+     "sex", "sibsp")))
 survived                                                                                       
     0.93 when pclass is 1st,2nd & sex is female                                                
     0.89 when                   & sex is   male & sibsp <  3 & age <   9.5                     
     0.73 when pclass is     3rd & sex is female & sibsp <  3 & age <  17.0                     
     0.62 when pclass is     3rd & sex is female & sibsp <  3 & age    22.0 to 28.0 & parch <  4
     0.39 when pclass is     3rd & sex is female & sibsp <  3 & age >=         28.0 & parch <  4
     0.39 when pclass is     3rd & sex is female & sibsp <  3 & age    17.0 to 22.0 & parch <  4
     0.17 when                   & sex is   male              & age >=          9.5             
     0.14 when pclass is     3rd & sex is female & sibsp >= 3                                   
     0.11 when pclass is     3rd & sex is female & sibsp <  3 & age >=         17.0 & parch >= 4
     0.05 when                   & sex is   male & sibsp >= 3 & age <   9.5                     

> cat("varorder=\"si\" (partial matching)\n")
varorder="si" (partial matching)

> print(rpart.rules(survived, varorder = "si"))
 survived                                                                                       
     0.93 when            & sex is female                       & pclass is 1st,2nd             
     0.89 when sibsp <  3 & sex is   male & age <   9.5                                         
     0.73 when sibsp <  3 & sex is female & age <  17.0         & pclass is     3rd             
     0.62 when sibsp <  3 & sex is female & age    22.0 to 28.0 & pclass is     3rd & parch <  4
     0.39 when sibsp <  3 & sex is female & age >=         28.0 & pclass is     3rd & parch <  4
     0.39 when sibsp <  3 & sex is female & age    17.0 to 22.0 & pclass is     3rd & parch <  4
     0.17 when            & sex is   male & age >=          9.5                                 
     0.14 when sibsp >= 3 & sex is female                       & pclass is     3rd             
     0.11 when sibsp <  3 & sex is female & age >=         17.0 & pclass is     3rd & parch >= 4
     0.05 when sibsp >= 3 & sex is   male & age <   9.5                                         

> stopifnot(identical(rpart.rules(survived, varorder = c("pclass", 
+     "sex", "sibsp")), rpart.rules(survived, varorder = c("pc", 
+     "se", "sib ..." ... [TRUNCATED] 

> cat("varorder error handling\n")
varorder error handling

> expect.err(try(rpart.rules(survived, varorder = "nonesuch")), 
+     "varorder=\"nonesuch\" does not uniquely match a variable in c(\"sex\", \"pclas .... [TRUNCATED] 
Error : varorder="nonesuch" does not uniquely match a variable in c("sex", "pclass", "parch", "age", "sibsp")
Got error as expected from try(rpart.rules(survived, varorder = "nonesuch"))

> expect.err(try(rpart.rules(survived, varorder = "p")), 
+     "varorder=\"p\" does not uniquely match a variable in c(\"sex\", \"pclass\",")
Error : varorder="p" does not uniquely match a variable in c("sex", "pclass", "parch", "age", "sibsp")
Got error as expected from try(rpart.rules(survived, varorder = "p"))

> expect.err(try(rpart.rules(survived, varorder = "")), 
+     "varorder=\"\" does not uniquely match a variable in c(\"sex\", \"pclass\",")
Error : varorder="" does not uniquely match a variable in c("sex", "pclass", "parch", "age", "sibsp")
Got error as expected from try(rpart.rules(survived, varorder = ""))

> expect.err(try(rpart.rules(survived, varorder = c("pclass", 
+     ""))), "varorder=\"\" does not uniquely match a variable in c(\"sex\", \"pclass\" ..." ... [TRUNCATED] 
Error : varorder="" does not uniquely match a variable in c("sex", "pclass", "parch", "age", "sibsp")
Got error as expected from try(rpart.rules(survived, varorder = c("pclass", "")))

> expect.err(try(rpart.rules(survived, varorder = 99)), 
+     "varorder=\"99\" does not uniquely match a variable in c(\"sex\", \"pclass\",")
Error : varorder="99" does not uniquely match a variable in c("sex", "pclass", "parch", "age", "sibsp")
Got error as expected from try(rpart.rules(survived, varorder = 99))

> cat0("\n== done test.rpart.rules.R ==\n")

== done test.rpart.rules.R ==
> 
> if(!interactive()) {
+     dev.off()         # finish postscript plot
+     q(runLast=FALSE)  # needed else R prints the time on exit (R2.5 and higher) which messes up the diffs
+ }
