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(283.25 + ,NA + ,266.188606019126 + ,282.966750204949 + ,213 + ,286.75 + ,283.25 + ,270.891611334875 + ,283.840363485213 + ,297 + ,230.25 + ,283.6 + ,275.263005974429 + ,281.694091305162 + ,199 + ,200.5 + ,278.265 + ,262.855086280826 + ,260.877303843805 + ,250 + ,297.95 + ,270.4885 + ,245.666789558327 + ,240.477467725152 + ,302 + ,329.5 + ,273.23465 + ,260.078754776835 + ,260.301637689324 + ,276 + ,289.75 + ,278.861185 + ,279.214851491821 + ,283.473863134466 + ,251 + ,223.775 + ,279.9500665 + ,282.118884977697 + ,285.501477042126 + ,265 + ,281.78 + ,274.33255985 + ,266.036283432995 + ,265.016411510642 + ,271 + ,265.8 + ,275.077303865 + ,270.376068493188 + ,270.574646930639 + ,278 + ,256.75 + ,274.1495734785 + ,269.114666612848 + ,268.990967395394 + ,255 + ,89.275 + ,272.40961613065 + ,265.706323023052 + ,264.927551074807 + ,205 + ,225.5 + ,254.096154517585 + ,217.072697249434 + ,206.724868986268 + ,207 + ,124.25 + ,251.236539065827 + ,219.395699090770 + ,212.945092462218 + ,221 + ,230 + ,238.537885159244 + ,193.168608321036 + ,183.557737684414 + ,NA + ,286.525 + ,237.684096643320 + ,203.321250657694 + ,198.945546067943 + ,186 + ,227 + ,242.568186978988 + ,226.256520535747 + ,227.963047580939 + ,191 + ,218.3 + ,241.011368281089 + ,226.461462047352 + ,227.643960820815 + ,221 + ,334.525 + ,238.74023145298 + ,224.211739695473 + ,224.548070833112 + ,339 + ,128.95 + ,248.318708307682 + ,254.619797219461 + ,260.986363812137 + ,181 + ,195.5 + ,236.381837476914 + ,219.978681434033 + ,217.239187431134 + ,265 + ,106.056 + ,232.293653729222 + ,213.231086891884 + ,210.036412890030 + ,214 + ,173.525 + ,219.669888356300 + ,183.688072766927 + ,175.584926903992 + ,244 + ,114.75 + ,215.05539952067 + ,180.886602658401 + ,174.902418000307 + ,113 + ,131.05 + ,205.024859568603 + ,162.655923839499 + ,154.972316858305 + ,208 + ,141.25 + ,197.627373611743 + ,153.943691533454 + ,147.046214989471 + ,238 + ,160.25 + ,191.989636250569 + ,150.444651605929 + ,145.125774315763 + ,174 + ,145.5 + ,188.815672625512 + ,153.147514318775 + ,150.13683381711 + ,148 + ,297.5 + ,184.484105362961 + ,151.039462624184 + ,148.600527064262 + ,156 + ,179.25 + ,195.785694826665 + ,191.411585007509 + ,197.934895247504 + ,165 + ,137 + ,194.132125343998 + ,188.059221243893 + ,191.744090918481 + ,166 + ,158.6 + ,188.418912809598 + ,173.984650948099 + ,173.605912966515 + ,94 + ,55.6 + ,185.437021528638 + ,169.743843000579 + ,168.634053626825 + ,113 + ,15.25 + ,172.453319375775 + ,138.279878157287 + ,131.182855791850 + ,162 + ,67.75 + ,156.732987438197 + ,104.366461022770 + ,92.7712074566496 + ,98 + ,93 + ,147.834688694377 + ,94.2730647254302 + ,84.481013833961 + ,56 + ,126.75 + ,142.351219824940 + ,93.922142041287 + ,87.3035812463404 + ,56 + ,160 + ,140.791097842446 + ,102.971202783778 + ,100.373232251632 + ,154 + ,150.525 + ,142.711988058201 + ,118.691297915473 + ,120.129171311937 + ,105 + ,239.25 + ,143.493289252381 + ,127.466317722843 + ,130.200120349172 + ,101 + ,165.05 + ,153.068960327143 + ,158.279699827074 + ,166.331255043692 + ,211 + ,215.81 + ,154.267064294429 + ,160.145945793739 + ,165.906741062477 + ,170 + ,166 + ,160.421357864986 + ,175.489846949862 + ,182.441022220241 + ,149 + ,79.05 + ,160.979222078487 + ,172.873952803060 + ,176.993672894802 + ,123 + ,204.25 + ,152.786299870639 + ,147.011203881603 + ,144.542320823904 + ,96 + ,102 + ,157.932669883575 + ,162.789185605352 + ,164.325067999016 + ,215 + ,87.025 + ,152.339402895217 + ,146.032532346977 + ,143.675110072167 + ,60 + ,72.175 + ,145.807962605696 + ,129.766995157684 + ,124.905417120366 + ,46 + ,176.75 + ,138.444666345126 + ,113.891653454959 + ,107.434423025053 + ,158 + ,188.975 + ,142.275199710613 + ,131.218674815109 + ,130.400523089806 + ,106) + ,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.37113715 0 1.0000000 1.0730195 0.1642249 2 0.08268416 1 0.6288629 0.7745111 0.1540466 3 0.03227093 2 0.5461787 0.8079768 0.1640356 4 0.01000000 4 0.4816368 0.8062985 0.1623343 > postscript(file="/var/www/html/rcomp/tmp/19tse1274868461.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/29tse1274868461.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 283.250 194.5466 88.703385 2 286.750 276.2080 10.542000 3 230.250 194.5466 35.703385 4 200.500 194.5466 5.953385 5 297.950 276.2080 21.742000 6 329.500 276.2080 53.292000 7 289.750 276.2080 13.542000 8 223.775 276.2080 -52.433000 9 281.780 276.2080 5.572000 10 265.800 276.2080 -10.408000 11 256.750 276.2080 -19.458000 12 89.275 194.5466 -105.271615 13 225.500 194.5466 30.953385 14 124.250 194.5466 -70.296615 15 230.000 194.5466 35.453385 16 286.525 194.5466 91.978385 17 227.000 194.5466 32.453385 18 218.300 194.5466 23.753385 19 334.525 276.2080 58.317000 20 128.950 194.5466 -65.596615 21 195.500 276.2080 -80.708000 22 106.056 194.5466 -88.490615 23 173.525 132.2096 41.315385 24 114.750 132.2096 -17.459615 25 131.050 132.2096 -1.159615 26 141.250 132.2096 9.040385 27 160.250 132.2096 28.040385 28 145.500 132.2096 13.290385 29 297.500 132.2096 165.290385 30 179.250 194.5466 -15.296615 31 137.000 132.2096 4.790385 32 158.600 115.6500 42.950000 33 55.600 132.2096 -76.609615 34 15.250 132.2096 -116.959615 35 67.750 115.6500 -47.900000 36 93.000 115.6500 -22.650000 37 126.750 115.6500 11.100000 38 160.000 185.1943 -25.194286 39 150.525 185.1943 -34.669286 40 239.250 185.1943 54.055714 41 165.050 185.1943 -20.144286 42 215.810 185.1943 30.615714 43 166.000 132.2096 33.790385 44 79.050 132.2096 -53.159615 45 204.250 115.6500 88.600000 46 102.000 132.2096 -30.209615 47 87.025 115.6500 -28.625000 48 72.175 115.6500 -43.475000 49 176.750 185.1943 -8.444286 50 188.975 185.1943 3.780714 > myr <- residuals(m) > myp <- predict(m) > postscript(file="/var/www/html/rcomp/tmp/3kkrz1274868461.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/45lq51274868461.tab") > > try(system("convert tmp/19tse1274868461.ps tmp/19tse1274868461.png",intern=TRUE)) character(0) > try(system("convert tmp/29tse1274868461.ps tmp/29tse1274868461.png",intern=TRUE)) character(0) > try(system("convert tmp/3kkrz1274868461.ps tmp/3kkrz1274868461.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 1.136 0.472 1.845