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(62 + ,NA + ,49.1485946234278 + ,61.93727661 + ,32 + ,30 + ,62 + ,45.3349835319040 + ,53.69907547 + ,30 + ,31 + ,58.8 + ,41.8176511556289 + ,42.97961039 + ,70 + ,50 + ,56.02 + ,38.5909798541646 + ,40.11452585 + ,30 + ,33 + ,55.418 + ,35.6520298034287 + ,40.9963732 + ,30 + ,12 + ,53.1762 + ,32.9504078576450 + ,37.85777961 + ,10 + ,20 + ,49.05858 + ,30.4539152863161 + ,32.44046133 + ,30 + ,30 + ,46.152722 + ,28.1658962839276 + ,29.7292962 + ,30 + ,21.5 + ,44.5374498 + ,26.0766501187039 + ,28.9511509 + ,38 + ,23 + ,42.23370482 + ,24.156446356987 + ,27.07351868 + ,20 + ,13.5 + ,40.310334338 + ,22.3980495637221 + ,25.66908954 + ,10 + ,0.5 + ,37.6293009042 + ,20.7779239031914 + ,23.07285439 + ,11 + ,12 + ,33.91637081378 + ,19.2763140211818 + ,19.09395794 + ,12 + ,10 + ,31.724733732402 + ,17.9029571235767 + ,17.34376879 + ,10 + ,70.5 + ,29.5522603591618 + ,16.6398256486149 + ,15.69357484 + ,30 + ,30 + ,33.6470343232456 + ,15.5438391587265 + ,22.68102951 + ,31 + ,20.5 + ,33.2823308909211 + ,14.5275375931142 + ,22.97988796 + ,30 + ,12 + ,32.0040978018290 + ,13.5952912424967 + ,21.90195337 + ,12 + ,20 + ,30.0036880216461 + ,12.7363232603913 + ,19.79755753 + ,20 + ,45 + ,29.0033192194815 + ,11.9577990661807 + ,19.11379007 + ,10 + ,11.505 + ,30.6029872975333 + ,11.2759453783387 + ,21.98924725 + ,50 + ,0 + ,28.69318856778 + ,10.6345631046696 + ,19.80301639 + ,10 + ,10 + ,28.69318856778 + ,10.0354091488450 + ,16.32602887 + ,11 + ,5.5 + ,24.3853361009109 + ,9.491781865029 + ,14.72244369 + ,1 + ,27.5 + ,22.6527364586255 + ,8.98941596678817 + ,12.71951926 + ,31 + ,0.5 + ,23.1011419666157 + ,8.55085675842196 + ,14.0475627 + ,1 + ,7 + ,20.994595040843 + ,8.1309880805476 + ,11.44289609 + ,20 + ,0 + ,19.6813007736305 + ,7.74915685785539 + ,10.10225109 + ,0 + ,2.5 + ,19.6813007736305 + ,7.39159969411268 + ,7.976306769 + ,0 + ,0 + ,16.5008829011108 + ,7.06270326550288 + ,6.492577652 + ,0 + ,0 + ,16.5008829011108 + ,6.75629871592574 + ,4.867892606 + ,0 + ,6.025 + ,16.5008829011108 + ,6.47193662930408 + ,3.46884702 + ,1 + ,1 + ,13.2638773777770 + ,6.21434038969776 + ,3.100150102 + ,0 + ,0 + ,12.3268664380437 + ,5.97297356764721 + ,2.085216954 + ,0 + ,0 + ,12.3268664380437 + ,5.74809890698749 + ,1.072369242 + ,0 + ,0 + ,12.3268664380437 + ,5.53896241148096 + ,0.200095795 + ,0 + ,0 + ,12.3268664380437 + ,5.34435520194198 + ,-0.551118036 + ,0 + ,2 + ,12.3268664380437 + ,5.16316210918967 + ,-1.198072087 + ,2 + ,0 + ,8.77286013713574 + ,4.99648594330416 + ,-1.477684042 + ,2 + ,6 + ,8.77286013713574 + ,4.84004626539840 + ,-1.996046968 + ,0 + ,20 + ,8.09773184771271 + ,4.70048199890951 + ,-1.609782119 + ,0 + ,0 + ,8.82386207874147 + ,4.58831288025937 + ,0.665774885 + ,0 + ,0 + ,8.82386207874147 + ,4.4728445018471 + ,-0.150066663 + ,0 + ,0 + ,8.82386207874147 + ,4.36461125530118 + ,-0.852685768 + ,0 + ,7 + ,8.82386207874147 + ,4.26306411947283 + ,-1.457793951 + ,5 + ,35 + ,7.3149510902026 + ,4.17515697240404 + ,-1.007465392 + ,0 + ,0 + ,8.86359100991655 + ,4.12606441076908 + ,3.266180329 + ,0 + ,0 + ,8.86359100991655 + ,4.06097419798148 + ,2.089456367 + ,0 + ,0 + ,8.86359100991655 + ,3.99910621856815 + ,1.076037511 + ,0 + ,1 + ,8.86359100991655 + ,3.94022356081926 + ,0.203260318 + ,0) + ,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.48363196 0 1.0000000 1.0260006 0.2847029 2 0.07713866 1 0.5163680 0.5988222 0.1698674 3 0.02584259 2 0.4392294 0.5424750 0.1590418 4 0.01000000 3 0.4133868 0.5541822 0.1586652 > postscript(file="/var/www/html/rcomp/tmp/1tekq1275565864.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/2tekq1275565864.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 62.000 33.654231 28.3457692 2 30.000 33.654231 -3.6542308 3 31.000 33.654231 -2.6542308 4 50.000 33.654231 16.3457692 5 33.000 33.654231 -0.6542308 6 12.000 16.444444 -4.4444444 7 20.000 33.654231 -13.6542308 8 30.000 33.654231 -3.6542308 9 21.500 33.654231 -12.1542308 10 23.000 16.444444 6.5555556 11 13.500 16.444444 -2.9444444 12 0.500 16.444444 -15.9444444 13 12.000 16.444444 -4.4444444 14 10.000 16.444444 -6.4444444 15 70.500 33.654231 36.8457692 16 30.000 33.654231 -3.6542308 17 20.500 33.654231 -13.1542308 18 12.000 16.444444 -4.4444444 19 20.000 16.444444 3.5555556 20 45.000 16.444444 28.5555556 21 11.505 33.654231 -22.1492308 22 0.000 1.596429 -1.5964286 23 10.000 1.596429 8.4035714 24 5.500 1.596429 3.9035714 25 27.500 33.654231 -6.1542308 26 0.500 1.596429 -1.0964286 27 7.000 1.596429 5.4035714 28 0.000 1.596429 -1.5964286 29 2.500 1.596429 0.9035714 30 0.000 1.596429 -1.5964286 31 0.000 1.596429 -1.5964286 32 6.025 1.596429 4.4285714 33 1.000 1.596429 -0.5964286 34 0.000 1.596429 -1.5964286 35 0.000 1.596429 -1.5964286 36 0.000 1.596429 -1.5964286 37 0.000 1.596429 -1.5964286 38 2.000 10.000000 -8.0000000 39 0.000 10.000000 -10.0000000 40 6.000 10.000000 -4.0000000 41 20.000 10.000000 10.0000000 42 0.000 1.596429 -1.5964286 43 0.000 1.596429 -1.5964286 44 0.000 10.000000 -10.0000000 45 7.000 10.000000 -3.0000000 46 35.000 10.000000 25.0000000 47 0.000 1.596429 -1.5964286 48 0.000 1.596429 -1.5964286 49 0.000 1.596429 -1.5964286 50 1.000 1.596429 -0.5964286 > myr <- residuals(m) > myp <- predict(m) > postscript(file="/var/www/html/rcomp/tmp/34njb1275565864.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/4ifzk1275565864.tab") > > try(system("convert tmp/1tekq1275565864.ps tmp/1tekq1275565864.png",intern=TRUE)) character(0) > try(system("convert tmp/2tekq1275565864.ps tmp/2tekq1275565864.png",intern=TRUE)) character(0) > try(system("convert tmp/34njb1275565864.ps tmp/34njb1275565864.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 1.091 0.499 4.622