R version 2.9.0 (2009-04-17)
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(387
+ ,NA
+ ,342.645625588810
+ ,386.613000262070
+ ,465
+ ,295.5
+ ,387
+ ,360.224691610665
+ ,374.123316633082
+ ,299
+ ,343.35
+ ,377.85
+ ,334.57221331123
+ ,336.048165995784
+ ,516
+ ,264.025
+ ,374.4
+ ,338.051132668702
+ ,338.086548077006
+ ,320
+ ,322.5
+ ,363.3625
+ ,308.712193932653
+ ,307.542001780858
+ ,365
+ ,392.5
+ ,359.27625
+ ,314.176745205712
+ ,313.784027977660
+ ,354
+ ,315.75
+ ,362.598625
+ ,345.218771733043
+ ,345.706762345858
+ ,408
+ ,274.4
+ ,357.9137625
+ ,333.539349111146
+ ,333.558139957923
+ ,265
+ ,361.875
+ ,349.56238625
+ ,310.100521795569
+ ,309.612466337202
+ ,335
+ ,411.276
+ ,350.793647625
+ ,330.620413749521
+ ,330.768423422594
+ ,388
+ ,518.775
+ ,356.8418828625
+ ,362.586818293621
+ ,363.353572983656
+ ,397
+ ,392.55
+ ,373.03519457625
+ ,424.489221258347
+ ,426.254986865821
+ ,444
+ ,467
+ ,374.986675118625
+ ,411.830679983883
+ ,412.614239712998
+ ,402
+ ,382.852
+ ,384.188007606763
+ ,433.696057002919
+ ,434.624717051376
+ ,400
+ ,449.25
+ ,384.054406846086
+ ,413.544920914575
+ ,413.671773960281
+ ,NA
+ ,564.252
+ ,390.573966161478
+ ,427.695992841313
+ ,428.070647900106
+ ,496
+ ,417
+ ,407.94176954533
+ ,481.817533216771
+ ,483.184602478810
+ ,475
+ ,450.8
+ ,408.847592590797
+ ,456.128258800945
+ ,456.399032969728
+ ,486
+ ,538.675
+ ,413.042833331717
+ ,454.016498360475
+ ,454.133048676047
+ ,459
+ ,394
+ ,425.606049998546
+ ,487.569387097804
+ ,488.348019556919
+ ,424
+ ,532
+ ,422.445444998691
+ ,450.484827677171
+ ,450.164435084369
+ ,513
+ ,461.4
+ ,433.400900498822
+ ,482.791913845528
+ ,483.284104365518
+ ,454
+ ,523
+ ,436.20081044894
+ ,474.313609939397
+ ,474.427389078871
+ ,506
+ ,405.9
+ ,444.880729404046
+ ,493.609593178994
+ ,494.085209133688
+ ,450
+ ,386.25
+ ,440.982656463641
+ ,458.847458672266
+ ,458.395775524229
+ ,493
+ ,384.5
+ ,435.509390817277
+ ,430.074749419565
+ ,429.19766065875
+ ,480
+ ,382
+ ,430.408451735549
+ ,412.012009506951
+ ,411.108071619878
+ ,475
+ ,381.75
+ ,425.567606561994
+ ,400.117284272407
+ ,399.327744740213
+ ,393
+ ,151.5
+ ,421.185845905795
+ ,392.837738406794
+ ,392.213856140806
+ ,254
+ ,287.775
+ ,394.217261315216
+ ,297.187825780639
+ ,294.794557918947
+ ,319
+ ,247.6
+ ,383.573035183694
+ ,293.457219993799
+ ,291.953672823028
+ ,280
+ ,290.35
+ ,369.975731665325
+ ,275.282527901956
+ ,274.003299091931
+ ,184
+ ,266.55
+ ,362.013158498792
+ ,281.254252006065
+ ,280.618971975236
+ ,321
+ ,318.025
+ ,352.466842648913
+ ,275.426483713804
+ ,274.925118706862
+ ,296
+ ,213.3
+ ,349.022658384022
+ ,292.309646652501
+ ,292.368070501736
+ ,310
+ ,148.75
+ ,335.450392545619
+ ,260.99558094183
+ ,260.368433823036
+ ,196
+ ,273
+ ,316.780353291058
+ ,216.509044850814
+ ,215.195340483111
+ ,222
+ ,282.25
+ ,312.402317961952
+ ,238.898228406847
+ ,238.589462676036
+ ,180
+ ,191.25
+ ,309.387086165757
+ ,256.079930665467
+ ,256.259317558014
+ ,255
+ ,142.25
+ ,297.573377549181
+ ,230.385742741739
+ ,229.94939840372
+ ,125
+ ,259.25
+ ,282.041039794263
+ ,195.45471144866
+ ,194.456577242768
+ ,237
+ ,272.75
+ ,279.761935814837
+ ,220.738837405002
+ ,220.679121618065
+ ,238
+ ,173.75
+ ,279.060742233353
+ ,241.352535000074
+ ,241.752725402618
+ ,231
+ ,204.75
+ ,268.529668010018
+ ,214.559474748700
+ ,214.231344240327
+ ,111
+ ,185.525
+ ,262.151701209016
+ ,210.671664210590
+ ,210.394149668727
+ ,201
+ ,267.175
+ ,254.489031088114
+ ,200.705231896851
+ ,200.329356777518
+ ,224
+ ,190.25
+ ,255.757627979303
+ ,227.049340171498
+ ,227.382455241916
+ ,180
+ ,127.25
+ ,249.206865181373
+ ,212.464577360093
+ ,212.35458028317
+ ,106
+ ,183.5
+ ,237.011178663235
+ ,178.691297918695
+ ,177.911907893752
+ ,199
+ ,254.125
+ ,231.660060796912
+ ,180.597141310443
+ ,180.173464499248
+ ,212)
+ ,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)
> 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.70973649      0 1.0000000 1.0879611 0.16692012
2 0.05498284      1 0.2902635 0.3473271 0.05569073
3 0.02941661      2 0.2352807 0.3657427 0.05677972
4 0.01000000      3 0.2058641 0.3453169 0.05712776
> postscript(file="/var/www/html/rcomp/tmp/15lg51274868975.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/html/rcomp/tmp/25lg51274868975.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  387.000 362.0359  24.9641429
2  295.500 270.8969  24.6031250
3  343.350 362.0359 -18.6858571
4  264.025 270.8969  -6.8718750
5  322.500 362.0359 -39.5358571
6  392.500 362.0359  30.4641429
7  315.750 362.0359 -46.2858571
8  274.400 270.8969   3.5031250
9  361.875 362.0359  -0.1608571
10 411.276 362.0359  49.2401429
11 518.775 446.2197  72.5553333
12 392.550 446.2197 -53.6696667
13 467.000 446.2197  20.7803333
14 382.852 446.2197 -63.3676667
15 449.250 446.2197   3.0303333
16 564.252 446.2197 118.0323333
17 417.000 446.2197 -29.2196667
18 450.800 446.2197   4.5803333
19 538.675 446.2197  92.4553333
20 394.000 446.2197 -52.2196667
21 532.000 446.2197  85.7803333
22 461.400 446.2197  15.1803333
23 523.000 446.2197  76.7803333
24 405.900 446.2197 -40.3196667
25 386.250 446.2197 -59.9696667
26 384.500 446.2197 -61.7196667
27 382.000 446.2197 -64.2196667
28 381.750 446.2197 -64.4696667
29 151.500 211.6279 -60.1279412
30 287.775 270.8969  16.8781250
31 247.600 270.8969 -23.2968750
32 290.350 211.6279  78.7220588
33 266.550 270.8969  -4.3468750
34 318.025 270.8969  47.1281250
35 213.300 270.8969 -57.5968750
36 148.750 211.6279 -62.8779412
37 273.000 211.6279  61.3720588
38 282.250 211.6279  70.6220588
39 191.250 211.6279 -20.3779412
40 142.250 211.6279 -69.3779412
41 259.250 211.6279  47.6220588
42 272.750 211.6279  61.1220588
43 173.750 211.6279 -37.8779412
44 204.750 211.6279  -6.8779412
45 185.525 211.6279 -26.1029412
46 267.175 211.6279  55.5470588
47 190.250 211.6279 -21.3779412
48 127.250 211.6279 -84.3779412
49 183.500 211.6279 -28.1279412
50 254.125 211.6279  42.4970588
> myr <- residuals(m)
> myp <- predict(m)
> postscript(file="/var/www/html/rcomp/tmp/3fcx81274868975.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/html/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/www/html/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/html/rcomp/tmp/4c4dh1274868975.tab") 
> 
> try(system("convert tmp/15lg51274868975.ps tmp/15lg51274868975.png",intern=TRUE))
character(0)
> try(system("convert tmp/25lg51274868975.ps tmp/25lg51274868975.png",intern=TRUE))
character(0)
> try(system("convert tmp/3fcx81274868975.ps tmp/3fcx81274868975.png",intern=TRUE))
character(0)
> 
> 
> proc.time()
   user  system elapsed 
  1.099   0.476   6.330