R version 2.8.0 (2008-10-20)
Copyright (C) 2008 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(209
+ ,NA
+ ,207.578503057629
+ ,208.791000220112
+ ,223
+ ,175
+ ,209
+ ,215.531763346576
+ ,198.426779339075
+ ,201
+ ,247.5
+ ,205.6
+ ,285.751097248607
+ ,203.378258089298
+ ,241
+ ,177
+ ,209.79
+ ,118.186987745813
+ ,206.916502799148
+ ,199
+ ,188.775
+ ,206.511
+ ,214.853226812988
+ ,198.493885113137
+ ,198
+ ,194.825
+ ,204.7374
+ ,138.401727102421
+ ,196.263512901256
+ ,254
+ ,182.275
+ ,203.74616
+ ,216.486643563448
+ ,193.640749579656
+ ,232
+ ,145.25
+ ,201.599044
+ ,97.6257034058337
+ ,183.618255052768
+ ,176
+ ,286.3
+ ,195.9641396
+ ,245.459409265308
+ ,194.973766357325
+ ,284
+ ,257.75
+ ,204.99772564
+ ,280.672235749570
+ ,219.947196737977
+ ,229
+ ,335
+ ,210.272953076
+ ,262.276026647169
+ ,245.338121076719
+ ,229
+ ,234.15
+ ,222.7456577684
+ ,233.243533537997
+ ,257.514432415318
+ ,292
+ ,276.275
+ ,223.88609199156
+ ,250.184476503336
+ ,258.505048267576
+ ,252
+ ,327.052
+ ,229.124982792404
+ ,267.134675437714
+ ,255.53357353954
+ ,192
+ ,375.325
+ ,238.917684513164
+ ,374.008804029831
+ ,315.322448001021
+ ,NA
+ ,199.75
+ ,252.558416061847
+ ,220.89450878188
+ ,293.272867505843
+ ,246
+ ,215.875
+ ,247.277574455663
+ ,288.373712865628
+ ,268.44574756024
+ ,276
+ ,225
+ ,244.137317010096
+ ,194.992809298708
+ ,254.391240106182
+ ,279
+ ,228.1
+ ,242.223585309087
+ ,263.427632470548
+ ,239.544311419872
+ ,294
+ ,128.5
+ ,240.811226778178
+ ,144.169115657069
+ ,213.489073070484
+ ,195
+ ,242.5
+ ,229.58010410036
+ ,268.90584331271
+ ,254.053084952268
+ ,214
+ ,327.275
+ ,230.872093690324
+ ,279.572485861439
+ ,243.25421812959
+ ,233
+ ,346.8
+ ,240.512384321292
+ ,286.95899170416
+ ,305.330568389782
+ ,314
+ ,221.175
+ ,251.141145889163
+ ,253.216947852348
+ ,267.255114086196
+ ,308
+ ,245.275
+ ,248.144531300246
+ ,258.137771298881
+ ,270.024693610743
+ ,248
+ ,230.725
+ ,247.857578170222
+ ,260.877650429826
+ ,298.681762847649
+ ,260
+ ,335.3
+ ,246.144320353200
+ ,334.877745498272
+ ,287.508494249009
+ ,298
+ ,97.25
+ ,255.059888317880
+ ,181.434595292499
+ ,214.89352137417
+ ,211
+ ,254.5
+ ,239.278899486092
+ ,225.904002981947
+ ,186.707631098946
+ ,132
+ ,71.25
+ ,240.801009537482
+ ,169.425310278149
+ ,207.601739355676
+ ,113
+ ,273.575
+ ,223.845908583734
+ ,191.077796826959
+ ,173.554668621071
+ ,176
+ ,98.325
+ ,228.818817725361
+ ,114.816648313125
+ ,154.336231589396
+ ,59
+ ,184.55
+ ,215.769435952825
+ ,239.251961739029
+ ,166.278743842984
+ ,154
+ ,203.025
+ ,212.647492357542
+ ,239.601909862737
+ ,228.807116636272
+ ,220
+ ,121.655
+ ,211.685243121788
+ ,216.235737726035
+ ,209.003839800871
+ ,258
+ ,135
+ ,202.682218809609
+ ,126.133353910805
+ ,135.659535200178
+ ,133
+ ,98.75
+ ,195.913996928648
+ ,145.984252152785
+ ,139.943125963237
+ ,136
+ ,69.1
+ ,186.197597235784
+ ,136.179714477329
+ ,92.208844377748
+ ,96
+ ,256.525
+ ,174.487837512205
+ ,196.708490866528
+ ,147.122521391435
+ ,151
+ ,97.775
+ ,182.691553760985
+ ,64.9287086805014
+ ,84.4553816480669
+ ,138
+ ,202.7
+ ,174.199898384886
+ ,152.116753990838
+ ,184.750081665235
+ ,102
+ ,81.9
+ ,177.049908546398
+ ,103.646395070923
+ ,71.8893513924464
+ ,150
+ ,165.25
+ ,167.534917691758
+ ,153.209605600343
+ ,199.790371621642
+ ,125
+ ,75.825
+ ,167.306425922582
+ ,51.2266305836655
+ ,107.963672206709
+ ,107
+ ,300
+ ,158.158283330324
+ ,190.651450747171
+ ,136.157711472038
+ ,140
+ ,238.5
+ ,172.342454997291
+ ,250.866635894662
+ ,164.294723220295
+ ,247
+ ,194.5
+ ,178.958209497562
+ ,236.328106963891
+ ,142.880720140488
+ ,209
+ ,140.75
+ ,180.512388547806
+ ,165.487705941164
+ ,196.613502921185
+ ,159
+ ,211.75
+ ,176.536149693025
+ ,173.069538773582
+ ,152.099346335145
+ ,192
+ ,274.8
+ ,180.057534723723
+ ,194.613497545848
+ ,175.013624568627
+ ,197)
+ ,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.53248907      0 1.0000000 1.0316179 0.16798698
2 0.11258169      1 0.4675109 0.5721250 0.10795925
3 0.02045597      2 0.3549292 0.5292971 0.08090459
4 0.01000000      3 0.3344733 0.5300819 0.08152768
> postscript(file="/var/www/html/freestat/rcomp/tmp/1ezsu1274870453.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/freestat/rcomp/tmp/2ezsu1274870453.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  209.000 210.8171  -1.8170833
2  175.000 210.8171 -35.8170833
3  247.500 294.4070 -46.9070000
4  177.000 128.8941  48.1058824
5  188.775 210.8171 -22.0420833
6  194.825 128.8941  65.9308824
7  182.275 244.5525 -62.2775000
8  145.250 128.8941  16.3558824
9  286.300 244.5525  41.7475000
10 257.750 294.4070 -36.6570000
11 335.000 294.4070  40.5930000
12 234.150 210.8171  23.3329167
13 276.275 210.8171  65.4579167
14 327.052 294.4070  32.6450000
15 375.325 294.4070  80.9180000
16 199.750 210.8171 -11.0670833
17 215.875 294.4070 -78.5320000
18 225.000 210.8171  14.1829167
19 228.100 294.4070 -66.3070000
20 128.500 128.8941  -0.3941176
21 242.500 294.4070 -51.9070000
22 327.275 294.4070  32.8680000
23 346.800 294.4070  52.3930000
24 221.175 210.8171  10.3579167
25 245.275 210.8171  34.4579167
26 230.725 210.8171  19.9079167
27 335.300 294.4070  40.8930000
28  97.250 128.8941 -31.6441176
29 254.500 244.5525   9.9475000
30  71.250 128.8941 -57.6441176
31 273.575 244.5525  29.0225000
32  98.325 128.8941 -30.5691176
33 184.550 244.5525 -60.0025000
34 203.025 210.8171  -7.7920833
35 121.655 210.8171 -89.1620833
36 135.000 128.8941   6.1058824
37  98.750 128.8941 -30.1441176
38  69.100 128.8941 -59.7941176
39 256.525 244.5525  11.9725000
40  97.775 128.8941 -31.1191176
41 202.700 128.8941  73.8058824
42  81.900 128.8941 -46.9941176
43 165.250 128.8941  36.3558824
44  75.825 128.8941 -53.0691176
45 300.000 244.5525  55.4475000
46 238.500 244.5525  -6.0525000
47 194.500 244.5525 -50.0525000
48 140.750 128.8941  11.8558824
49 211.750 128.8941  82.8558824
50 274.800 244.5525  30.2475000
> myr <- residuals(m)
> myp <- predict(m)
> postscript(file="/var/www/html/freestat/rcomp/tmp/3ezsu1274870453.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/freestat/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/www/html/freestat/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/freestat/rcomp/tmp/4sr831274870453.tab") 
> 
> try(system("convert tmp/1ezsu1274870453.ps tmp/1ezsu1274870453.png",intern=TRUE))
character(0)
> try(system("convert tmp/2ezsu1274870453.ps tmp/2ezsu1274870453.png",intern=TRUE))
character(0)
> try(system("convert tmp/3ezsu1274870453.ps tmp/3ezsu1274870453.png",intern=TRUE))
character(0)
> 
> 
> proc.time()
   user  system elapsed 
  1.559   0.683   1.743