R version 2.10.1 (2009-12-14)
Copyright (C) 2009 The R Foundation for Statistical Computing
ISBN 3-900051-07-0

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> x <- array(list(797
+ ,NA
+ ,782.711417226421
+ ,796.20300065502
+ ,648
+ ,642.25
+ ,797
+ ,765.0294568744
+ ,762.952337247724
+ ,592
+ ,726.275
+ ,781.525
+ ,649.806107458521
+ ,704.410416896747
+ ,617
+ ,652.75
+ ,776
+ ,723.56791155541
+ ,665.581080920744
+ ,702
+ ,678.75
+ ,763.675
+ ,615.796974930425
+ ,704.818827828887
+ ,688
+ ,602.25
+ ,755.1825
+ ,711.777300846748
+ ,631.816961296255
+ ,663
+ ,689.775
+ ,739.88925
+ ,719.287764661505
+ ,654.598278915382
+ ,693
+ ,393
+ ,734.877825
+ ,514.492157182367
+ ,606.863336282914
+ ,419
+ ,580.525
+ ,700.6900425
+ ,568.698163436724
+ ,509.418190174305
+ ,581
+ ,462.25
+ ,688.67353825
+ ,527.978998668824
+ ,465.80488389292
+ ,585
+ ,725.65
+ ,666.031184425
+ ,478.336938109688
+ ,584.551182892532
+ ,458
+ ,501
+ ,671.9930659825
+ ,534.996332111507
+ ,584.24363832272
+ ,476
+ ,675
+ ,654.89375938425
+ ,664.412824861296
+ ,643.519082911609
+ ,568
+ ,691
+ ,656.904383445825
+ ,643.611465200888
+ ,520.449547068052
+ ,558
+ ,769.025
+ ,660.313945101243
+ ,671.176086172387
+ ,758.07019155421
+ ,NA
+ ,688.25
+ ,671.185050591118
+ ,762.860278704985
+ ,708.310127515555
+ ,579
+ ,518.8
+ ,672.891545532007
+ ,651.92127364904
+ ,727.053151603044
+ ,631
+ ,386.275
+ ,657.482390978806
+ ,583.381473899396
+ ,508.80532190237
+ ,553
+ ,491.35
+ ,630.361651880925
+ ,517.422882856391
+ ,434.2318942773
+ ,555
+ ,269.5
+ ,616.460486692833
+ ,315.503881065959
+ ,331.248437042921
+ ,368
+ ,379
+ ,581.76443802355
+ ,433.056689590744
+ ,389.269640545343
+ ,461
+ ,375.25
+ ,561.487994221195
+ ,337.054612518579
+ ,299.1481893675
+ ,397
+ ,337.5
+ ,542.864194799075
+ ,374.635041228908
+ ,502.876183618978
+ ,376
+ ,296
+ ,522.327775319168
+ ,192.619299478441
+ ,267.453582131041
+ ,316
+ ,375
+ ,499.694997787251
+ ,437.296999705657
+ ,340.713876999818
+ ,386
+ ,399.525
+ ,487.225498008526
+ ,355.350992000882
+ ,407.070535873498
+ ,457
+ ,336
+ ,478.455448207673
+ ,380.223837962091
+ ,417.641465716004
+ ,370
+ ,483.5
+ ,464.209903386906
+ ,352.694153942505
+ ,332.898922218684
+ ,382
+ ,370.25
+ ,466.138913048215
+ ,414.089307855428
+ ,337.338283908306
+ ,399
+ ,625.5
+ ,456.550021743394
+ ,420.44880902639
+ ,355.134629732789
+ ,478
+ ,736.75
+ ,473.445019569055
+ ,691.91012962691
+ ,571.23916170188
+ ,600
+ ,496.05
+ ,499.775517612149
+ ,549.483513444763
+ ,681.062633873284
+ ,525
+ ,740.5
+ ,499.402965850934
+ ,660.802183052332
+ ,549.057121163136
+ ,714
+ ,690.525
+ ,523.512669265841
+ ,677.0269500232
+ ,693.072231556067
+ ,687
+ ,568.75
+ ,540.213902339257
+ ,693.8791043314
+ ,712.003500002354
+ ,650
+ ,341.1
+ ,543.067512105331
+ ,438.052398315464
+ ,548.996333351918
+ ,445
+ ,519.75
+ ,522.870760894798
+ ,514.637616791392
+ ,427.493775297068
+ ,497
+ ,408.75
+ ,522.558684805318
+ ,489.25763684781
+ ,468.264830665661
+ ,473
+ ,278.35
+ ,511.177816324786
+ ,409.515986555195
+ ,446.239032991459
+ ,399
+ ,217
+ ,487.895034692308
+ ,309.061396860208
+ ,330.312869791279
+ ,317
+ ,266
+ ,460.805531223077
+ ,183.457445377064
+ ,205.218731892318
+ ,296
+ ,319.025
+ ,441.324978100769
+ ,295.874273558410
+ ,337.419117389042
+ ,301
+ ,454.75
+ ,429.094980290692
+ ,414.708291820007
+ ,419.036160167183
+ ,298
+ ,378.3
+ ,431.660482261623
+ ,268.246080312969
+ ,291.687302641049
+ ,196
+ ,509.575
+ ,426.324434035461
+ ,516.741113232939
+ ,515.635322954833
+ ,620
+ ,453.75
+ ,434.649490631915
+ ,460.081976315332
+ ,469.396122015109
+ ,600
+ ,252
+ ,436.559541568723
+ ,460.282975001957
+ ,413.361749776128
+ ,533
+ ,187.525
+ ,418.103587411851
+ ,134.694665694760
+ ,166.430760748899
+ ,187
+ ,401.5
+ ,395.045728670666
+ ,336.955099542137
+ ,248.202334497077
+ ,484
+ ,403.75
+ ,395.691155803599
+ ,361.429105851861
+ ,333.451042483504
+ ,322)
+ ,dim=c(5
+ ,50)
+ ,dimnames=list(c('Actuals'
+ ,'Croston'
+ ,'ETS'
+ ,'Arima'
+ ,'Kaneka')
+ ,1:50))
>  y <- array(NA,dim=c(5,50),dimnames=list(c('Actuals','Croston','ETS','Arima','Kaneka'),1:50))
>  for (i in 1:dim(x)[1])
+  {
+  	for (j in 1:dim(x)[2])
+  	{
+  		y[i,j] <- as.numeric(x[i,j])
+  	}
+  }
> par2 = 'No'
> par1 = '1'
> #'GNU S' R Code compiled by R2WASP v. 1.0.44 ()
> #Author: Dr. Ian E. Holliday
> #To cite this work: Ian E. Holliday, 2009, YOUR SOFTWARE TITLE (vNUMBER) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_YOURPAGE.wasp/
> #Source of accompanying publication: 
> #Technical description: 
> library(rpart)
Warning message:
package 'rpart' was built under R version 2.8.1 and help may not work correctly 
> library(partykit)
Loading required package: grid
Loading required package: mvtnorm
> par1 <- as.numeric(par1)
> autoprune <- function ( tree, method='Minimum CV'){
+ xerr <- tree$cptable[,'xerror']
+ cpmin.id <- which.min(xerr)
+ if (method == 'Minimum CV Error plus 1 SD'){
+ xstd <- tree$cptable[,'xstd']
+ errt <- xerr[cpmin.id] + xstd[cpmin.id]
+ cpSE1.min <- which.min( errt < xerr )
+ mycp <- (tree$cptable[,'CP'])[cpSE1.min]
+ }
+ if (method == 'Minimum CV') {
+ mycp <- (tree$cptable[,'CP'])[cpmin.id]
+ }
+ return (mycp)
+ }
> conf.multi.mat <- function(true, new)
+ {
+ if ( all( is.na(match( levels(true),levels(new) ) )) )
+ stop ( 'conflict of vector levels')
+ multi.t <- list()
+ for (mylev in levels(true) ) {
+ true.tmp <- true
+ new.tmp <- new
+ left.lev <- levels (true.tmp)[- match(mylev,levels(true) ) ]
+ levels(true.tmp) <- list ( mylev = mylev, all = left.lev )
+ levels(new.tmp)  <- list ( mylev = mylev, all = left.lev )
+ curr.t <- conf.mat ( true.tmp , new.tmp )
+ multi.t[[mylev]] <- curr.t
+ multi.t[[mylev]]$precision <-
+ round( curr.t$conf[1,1] / sum( curr.t$conf[1,] ), 2 )
+ }
+ return (multi.t)
+ }
> x <- t(y)
> k <- length(x[1,])
> n <- length(x[,1])
> x1 <- cbind(x[,par1], x[,1:k!=par1])
> mycolnames <- c(colnames(x)[par1], colnames(x)[1:k!=par1])
> colnames(x1) <- mycolnames #colnames(x)[par1]
> m <- rpart(as.data.frame(x1))
> par2
[1] "No"
> if (par2 != 'No') {
+ mincp <- autoprune(m,method=par2)
+ print(mincp)
+ m <- prune(m,cp=mincp)
+ }
> m$cptable
         CP nsplit rel error    xerror      xstd
1 0.6161065      0 1.0000000 1.0692771 0.1434270
2 0.1184688      1 0.3838935 0.5744920 0.1243276
3 0.0100000      2 0.2654247 0.4846494 0.1248337
> postscript(file="/var/www/rcomp/tmp/1ezsu1274870737.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
> plot(as.party(m),tp_args=list(id=FALSE))
> dev.off()
null device 
          1 
> postscript(file="/var/www/rcomp/tmp/2ezsu1274870737.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
> plotcp(m)
> dev.off()
null device 
          1 
> cbind(y=m$y,pred=predict(m),res=residuals(m))
         y     pred           res
1  797.000 679.2281  117.77187500
2  642.250 679.2281  -36.97812500
3  726.275 679.2281   47.04687500
4  652.750 679.2281  -26.47812500
5  678.750 679.2281   -0.47812500
6  602.250 679.2281  -76.97812500
7  689.775 679.2281   10.54687500
8  393.000 341.1224   51.87763158
9  580.525 479.5283  100.99666667
10 462.250 479.5283  -17.27833333
11 725.650 479.5283  246.12166667
12 501.000 479.5283   21.47166667
13 675.000 679.2281   -4.22812500
14 691.000 679.2281   11.77187500
15 769.025 679.2281   89.79687500
16 688.250 679.2281    9.02187500
17 518.800 679.2281 -160.42812500
18 386.275 479.5283  -93.25333333
19 491.350 479.5283   11.82166667
20 269.500 341.1224  -71.62236842
21 379.000 479.5283 -100.52833333
22 375.250 341.1224   34.12763158
23 337.500 341.1224   -3.62236842
24 296.000 341.1224  -45.12236842
25 375.000 341.1224   33.87763158
26 399.525 341.1224   58.40263158
27 336.000 341.1224   -5.12236842
28 483.500 341.1224  142.37763158
29 370.250 341.1224   29.12763158
30 625.500 479.5283  145.97166667
31 736.750 679.2281   57.52187500
32 496.050 479.5283   16.52166667
33 740.500 679.2281   61.27187500
34 690.525 679.2281   11.29687500
35 568.750 679.2281 -110.47812500
36 341.100 341.1224   -0.02236842
37 519.750 479.5283   40.22166667
38 408.750 479.5283  -70.77833333
39 278.350 341.1224  -62.77236842
40 217.000 341.1224 -124.12236842
41 266.000 341.1224  -75.12236842
42 319.025 341.1224  -22.09736842
43 454.750 341.1224  113.62763158
44 378.300 341.1224   37.17763158
45 509.575 479.5283   30.04666667
46 453.750 479.5283  -25.77833333
47 252.000 479.5283 -227.52833333
48 187.525 341.1224 -153.59736842
49 401.500 479.5283  -78.02833333
50 403.750 341.1224   62.62763158
> myr <- residuals(m)
> myp <- predict(m)
> postscript(file="/var/www/rcomp/tmp/3ezsu1274870737.ps",horizontal=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) 
> op <- par(mfrow=c(2,2))
> plot(myr,ylab='residuals')
> plot(density(myr),main='Residual Kernel Density')
> plot(myp,myr,xlab='predicted',ylab='residuals',main='Predicted vs Residuals')
> plot(density(myp),main='Prediction Kernel Density')
> par(op)
> dev.off()
null device 
          1 
> 
> #Note: the /var/www/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/www/rcomp/createtable")
> 
> a<-table.start()
> a<-table.row.start(a)
> a<-table.element(a,'Model Performance',6,TRUE)
> a<-table.row.end(a)
> a<-table.row.start(a)
> a<-table.element(a,'#',header=TRUE)
> a<-table.element(a,'Complexity',header=TRUE)
> a<-table.element(a,'split',header=TRUE)
> a<-table.element(a,'relative error',header=TRUE)
> a<-table.element(a,'CV error',header=TRUE)
> a<-table.element(a,'CV S.D.',header=TRUE)
> a<-table.row.end(a)
> for (i in 1:length(m$cptable[,1])) {
+ a<-table.row.start(a)
+ a<-table.element(a,i,header=TRUE)
+ a<-table.element(a,round(m$cptable[i,'CP'],3))
+ a<-table.element(a,m$cptable[i,'nsplit'])
+ a<-table.element(a,round(m$cptable[i,'rel error'],3))
+ a<-table.element(a,round(m$cptable[i,'xerror'],3))
+ a<-table.element(a,round(m$cptable[i,'xstd'],3))
+ a<-table.row.end(a)
+ }
> a<-table.end(a)
> table.save(a,file="/var/www/rcomp/tmp/4sr831274870737.tab") 
> 
> try(system("convert tmp/1ezsu1274870737.ps tmp/1ezsu1274870737.png",intern=TRUE))
character(0)
> try(system("convert tmp/2ezsu1274870737.ps tmp/2ezsu1274870737.png",intern=TRUE))
character(0)
> try(system("convert tmp/3ezsu1274870737.ps tmp/3ezsu1274870737.png",intern=TRUE))
character(0)
> 
> 
> proc.time()
   user  system elapsed 
  1.160   0.750   1.592