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(66
+ ,NA
+ ,66.6400081602945
+ ,65.9340000642625
+ ,66
+ ,66
+ ,66
+ ,74.8865290244873
+ ,65.9999544970003
+ ,44
+ ,66
+ ,66
+ ,69.4466779638461
+ ,65.9999741429027
+ ,66
+ ,76
+ ,66
+ ,54.592968576561
+ ,67.2912652912436
+ ,88
+ ,34
+ ,67
+ ,65.359813335731
+ ,65.097618300786
+ ,66
+ ,66
+ ,63.7
+ ,53.5306148746235
+ ,61.2705546832229
+ ,67
+ ,66
+ ,63.93
+ ,60.2131403294856
+ ,62.1803867658173
+ ,66
+ ,66
+ ,64.137
+ ,81.3710894221322
+ ,62.85982112799
+ ,66
+ ,66
+ ,64.3233
+ ,54.1503901382023
+ ,63.3873521146392
+ ,44
+ ,66
+ ,64.49097
+ ,63.170927562093
+ ,63.8082659858302
+ ,66
+ ,44
+ ,64.641873
+ ,53.4785961678077
+ ,62.7780896791892
+ ,44
+ ,44
+ ,62.5776857
+ ,36.0086271515583
+ ,59.9095531527368
+ ,44
+ ,66
+ ,60.71991713
+ ,65.3413647125152
+ ,59.6936234581407
+ ,44
+ ,87.5
+ ,61.247925417
+ ,73.8332331092841
+ ,60.8356206794414
+ ,66
+ ,66
+ ,63.8731328753
+ ,72.6698371634263
+ ,64.5842558764913
+ ,NA
+ ,66
+ ,64.08581958777
+ ,57.2076479997321
+ ,67.8930159267455
+ ,66
+ ,66
+ ,64.277237628993
+ ,65.5773520419694
+ ,54.5864341559968
+ ,66
+ ,65.5
+ ,64.4495138660937
+ ,59.7783847805255
+ ,66.1702603554484
+ ,88
+ ,65.5
+ ,64.5545624794843
+ ,65.1808994846169
+ ,66.0732597482336
+ ,66
+ ,88
+ ,64.6491062315359
+ ,85.3000011788247
+ ,66.1506824734975
+ ,66
+ ,42
+ ,66.9841956083823
+ ,61.5082524102149
+ ,68.9786501509172
+ ,66
+ ,88
+ ,64.4857760475441
+ ,64.5826998014614
+ ,65.4118136535975
+ ,88
+ ,88
+ ,66.8371984427897
+ ,58.7924091111244
+ ,61.8306169774286
+ ,66
+ ,64
+ ,68.9534785985107
+ ,48.658793284746
+ ,65.4303451710531
+ ,66
+ ,88
+ ,68.4581307386596
+ ,79.3842209531546
+ ,71.7459994615169
+ ,88
+ ,88
+ ,70.4123176647937
+ ,89.3860473656974
+ ,81.541820717718
+ ,88
+ ,88
+ ,72.1710858983143
+ ,85.3666565050138
+ ,75.0341722880627
+ ,88
+ ,63
+ ,73.7539773084829
+ ,71.669877609083
+ ,75.7932175260843
+ ,88
+ ,110
+ ,72.6785795776346
+ ,76.728036815868
+ ,78.5471215921968
+ ,68
+ ,85
+ ,76.4107216198711
+ ,77.1575352833932
+ ,79.4125986158928
+ ,88
+ ,88
+ ,77.269649457884
+ ,82.9615773183237
+ ,80.2193112847716
+ ,88
+ ,108
+ ,78.3426845120956
+ ,103.975665764726
+ ,89.1470965719674
+ ,88
+ ,88.023
+ ,81.308416060886
+ ,80.4326749481525
+ ,75.9111663510669
+ ,88
+ ,88
+ ,81.9798744547975
+ ,88.6492400856969
+ ,93.5794162521968
+ ,110
+ ,66
+ ,82.5818870093177
+ ,78.2967726105023
+ ,95.1408210293909
+ ,88
+ ,44.5
+ ,80.923698308386
+ ,60.2928816562315
+ ,82.6263841746852
+ ,66
+ ,88.5
+ ,77.2813284775473
+ ,85.1148847421264
+ ,83.2819192115887
+ ,88
+ ,88
+ ,78.4031956297926
+ ,94.1239817721025
+ ,81.4190987011273
+ ,88
+ ,108
+ ,79.3628760668133
+ ,89.206744989429
+ ,84.9800826115048
+ ,130
+ ,66
+ ,82.226588460132
+ ,78.5725460830362
+ ,79.8950729834965
+ ,110
+ ,85
+ ,80.6039296141188
+ ,82.895184727681
+ ,92.7859883215547
+ ,88
+ ,66
+ ,81.043536652707
+ ,77.4130342232758
+ ,84.1762183576399
+ ,88
+ ,66
+ ,79.5391829874362
+ ,79.566127179505
+ ,82.6180545745621
+ ,88
+ ,110
+ ,78.1852646886926
+ ,97.0528674218656
+ ,84.5153822287424
+ ,66
+ ,83
+ ,81.3667382198233
+ ,75.2019256231291
+ ,86.7568550833349
+ ,110
+ ,66
+ ,81.530064397841
+ ,83.457016080909
+ ,80.6175653648853
+ ,93
+ ,83
+ ,79.9770579580569
+ ,69.9167389332608
+ ,69.9703995656468
+ ,88
+ ,44
+ ,80.2793521622512
+ ,56.7242903583614
+ ,67.2147242043591
+ ,66
+ ,83
+ ,76.6514169460261
+ ,82.13007477616
+ ,77.1762590877615
+ ,88
+ ,105
+ ,77.2862752514235
+ ,90.6613214415051
+ ,78.7550058539266
+ ,88)
+ ,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.39065179      0 1.0000000 1.0280931 0.1910387
2 0.11387610      1 0.6093482 0.8338856 0.1547727
3 0.05150591      2 0.4954721 0.7080825 0.1673292
4 0.01000000      3 0.4439662 0.7647293 0.1771263
> postscript(file="/var/www/html/freestat/rcomp/tmp/1ka3l1274868805.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/2ka3l1274868805.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   66.000 66.52941  -0.5294118
2   66.000 80.21174 -14.2117368
3   66.000 66.52941  -0.5294118
4   76.000 66.52941   9.4705882
5   34.000 53.50000 -19.5000000
6   66.000 66.52941  -0.5294118
7   66.000 66.52941  -0.5294118
8   66.000 80.21174 -14.2117368
9   66.000 66.52941  -0.5294118
10  66.000 66.52941  -0.5294118
11  44.000 66.52941 -22.5294118
12  44.000 66.52941 -22.5294118
13  66.000 66.52941  -0.5294118
14  87.500 80.21174   7.2882632
15  66.000 66.52941  -0.5294118
16  66.000 66.52941  -0.5294118
17  66.000 66.52941  -0.5294118
18  65.500 66.52941  -1.0294118
19  65.500 66.52941  -1.0294118
20  88.000 80.21174   7.7882632
21  42.000 53.50000 -11.5000000
22  88.000 66.52941  21.4705882
23  88.000 66.52941  21.4705882
24  64.000 53.50000  10.5000000
25  88.000 80.21174   7.7882632
26  88.000 99.28571 -11.2857143
27  88.000 80.21174   7.7882632
28  63.000 53.50000   9.5000000
29 110.000 80.21174  29.7882632
30  85.000 80.21174   4.7882632
31  88.000 80.21174   7.7882632
32 108.000 99.28571   8.7142857
33  88.023 80.21174   7.8112632
34  88.000 99.28571 -11.2857143
35  66.000 80.21174 -14.2117368
36  44.500 53.50000  -9.0000000
37  88.500 80.21174   8.2882632
38  88.000 99.28571 -11.2857143
39 108.000 99.28571   8.7142857
40  66.000 80.21174 -14.2117368
41  85.000 80.21174   4.7882632
42  66.000 80.21174 -14.2117368
43  66.000 80.21174 -14.2117368
44 110.000 99.28571  10.7142857
45  83.000 80.21174   2.7882632
46  66.000 80.21174 -14.2117368
47  83.000 53.50000  29.5000000
48  44.000 53.50000  -9.5000000
49  83.000 80.21174   2.7882632
50 105.000 99.28571   5.7142857
> myr <- residuals(m)
> myp <- predict(m)
> postscript(file="/var/www/html/freestat/rcomp/tmp/3ka3l1274868805.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/4gkjc1274868805.tab") 
> 
> try(system("convert tmp/1ka3l1274868805.ps tmp/1ka3l1274868805.png",intern=TRUE))
character(0)
> try(system("convert tmp/2ka3l1274868805.ps tmp/2ka3l1274868805.png",intern=TRUE))
character(0)
> try(system("convert tmp/3ka3l1274868805.ps tmp/3ka3l1274868805.png",intern=TRUE))
character(0)
> 
> 
> proc.time()
   user  system elapsed 
  1.592   0.696   2.009