R version 2.10.1 (2009-12-14) 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(1216.67 + ,NA + ,1216.57896906222 + ,1544.42911895378 + ,1122 + ,1186.17 + ,1216.67 + ,1186.32706637457 + ,1366.3834494132 + ,1191.3 + ,1217.475 + ,1213.62 + ,1217.61518741362 + ,1394.74447514204 + ,1849.75 + ,1096.95 + ,1214.0055 + ,1097.13722496335 + ,1435.70978225614 + ,1159.8 + ,1685.6 + ,1202.29995 + ,1685.35698835458 + ,1515.17300887526 + ,1441.8 + ,1758.5 + ,1250.629955 + ,1758.44429928912 + ,1913.84222078324 + ,1577.3 + ,1786.6 + ,1301.4169595 + ,1786.57095582242 + ,1957.10781265414 + ,1537.8 + ,2049.895 + ,1349.93526355 + ,2049.71036034501 + ,2003.16986500382 + ,1732.3 + ,1845.895 + ,1419.931237195 + ,1845.92826649821 + ,2094.36317239399 + ,1932.3 + ,2015.02 + ,1462.5276134755 + ,2014.98176910371 + ,1946.73777811992 + ,1781.5 + ,1609.63 + ,1517.77685212795 + ,1609.54241047328 + ,1915.17835198758 + ,1504 + ,918.725 + ,1526.96216691516 + ,918.654492873966 + ,1514.01237467182 + ,1155.75 + ,1240.96 + ,1466.13845022364 + ,1240.97493327842 + ,1137.92569933516 + ,1243.5 + ,1671.785 + ,1443.62060520128 + ,1671.67364264948 + ,1425.79213659270 + ,1479.5 + ,2451.83 + ,1466.43704468115 + ,2451.42825634976 + ,1747.14542398917 + ,NA + ,1886.14 + ,1564.97634021303 + ,1886.27704742758 + ,2134.15076490796 + ,2076 + ,2110.66 + ,1597.09270619173 + ,2110.72659138529 + ,1997.1087832377 + ,842.5 + ,1856.87 + ,1648.44943557256 + ,1857.08748894488 + ,1923.93219142466 + ,2231.5 + ,1775.765 + ,1669.29149201530 + ,1775.92924079464 + ,1716.64848512266 + ,1909.3 + ,1569.625 + ,1679.93884281377 + ,1569.80044248696 + ,1805.52638387444 + ,1759.75 + ,1835.69 + ,1668.90745853239 + ,1835.63172097274 + ,1484.35743354946 + ,1932.5 + ,2041.46 + ,1685.58571267915 + ,2041.35676313207 + ,1879.55614969438 + ,2071.3 + ,1667.035 + ,1721.17314141124 + ,1666.89228111939 + ,1735.86760859793 + ,1918 + ,948.25 + ,1715.75932727012 + ,948.159567965853 + ,1248.06282806837 + ,1358 + ,1365.66 + ,1639.00839454310 + ,1365.60094114980 + ,1208.49264795729 + ,1475.3 + ,1681.025 + ,1611.67355508879 + ,1680.97488911353 + ,1648.62405416901 + ,1457.5 + ,1661.9 + ,1618.60869957991 + ,1661.97891553469 + ,2137.48151321946 + ,1646.5 + ,2194.88 + ,1622.93782962192 + ,2194.64696222739 + ,1538.92416659111 + ,1904.3 + ,2051.025 + ,1680.13204665973 + ,2051.10610598749 + ,2262.95786264119 + ,1983.5 + ,2365.845 + ,1717.22134199376 + ,2365.8268033643 + ,1895.75731478471 + ,2150 + ,2398.5 + ,1782.08370779438 + ,2398.49010356152 + ,2133.06714654175 + ,2045 + ,2181.85 + ,1843.72533701494 + ,2181.91895239553 + ,2005.89702658791 + ,2455 + ,2626.77 + ,1877.53780331345 + ,2626.61215634528 + ,2019.35823239364 + ,2597 + ,2529.72 + ,1952.46102298210 + ,2529.72574330652 + ,2287.02645105581 + ,2532 + ,1700.3 + ,2010.18692068389 + ,1700.40313375847 + ,1877.51131114692 + ,2515 + ,605.38 + ,1979.19822861550 + ,605.770298247161 + ,1044.00598415714 + ,1445 + ,1200.495 + ,1841.81640575395 + ,1200.41697572286 + ,856.884940781561 + ,1491 + ,1597.02 + ,1777.68426517856 + ,1596.87595983126 + ,1388.94763408102 + ,1462 + ,1174.955 + ,1759.61783866070 + ,1175.24282736234 + ,1582.51626983244 + ,1690 + ,1612.88 + ,1701.15155479463 + ,1612.75933399255 + ,1625.07070253864 + ,1646 + ,1683.55 + ,1692.32439931517 + ,1683.56473508225 + ,1708.99836048230 + ,1422 + ,2260.955 + ,1691.44695938365 + ,2260.72911247337 + ,2015.60437152167 + ,407 + ,2455.335 + ,1748.39776344529 + ,2455.16084014401 + ,2312.82789083737 + ,2135 + ,2365.62 + ,1819.09148710076 + ,2365.56505712385 + ,2274.66272273801 + ,2069 + ,2417.755 + ,1873.74433839068 + ,2417.71252994142 + ,2485.27099441534 + ,2234 + ,2308.785 + ,1928.14540455161 + ,2308.84414672757 + ,2262.79978259441 + ,2500 + ,1629.94 + ,1966.20936409645 + ,1630.02245147924 + ,1758.7604073078 + ,2059 + ,1053.275 + ,1932.58242768681 + ,1053.15585122134 + ,1007.45449610215 + ,1117 + ,1330.235 + ,1844.65168491813 + ,1330.29555655607 + ,1365.70594512373 + ,1634 + ,1543.85 + ,1793.21001642631 + ,1543.91407603040 + ,1566.13002581225 + ,1600) + ,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) Warning message: package 'rpart' was built under R version 2.8.1 and help may not work correctly > 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.65871848 0 1.00000000 1.0205008 0.16694262 2 0.18842112 1 0.34128152 0.4380932 0.08071569 3 0.07854786 2 0.15286040 0.1757050 0.03748352 4 0.01000000 3 0.07431253 0.1736408 0.03760767 > postscript(file="/var/www/rcomp/tmp/1lfed1274871291.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/rcomp/tmp/2lfed1274871291.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 1216.670 1119.631 97.039231 2 1186.170 1119.631 66.539231 3 1217.475 1119.631 97.844231 4 1096.950 1119.631 -22.680769 5 1685.600 1664.688 20.912187 6 1758.500 1664.688 93.812187 7 1786.600 1664.688 121.912187 8 2049.895 2006.308 43.587273 9 1845.895 2006.308 -160.412727 10 2015.020 2006.308 8.712273 11 1609.630 1664.688 -55.057812 12 918.725 1119.631 -200.905769 13 1240.960 1119.631 121.329231 14 1671.785 1664.688 7.097188 15 2451.830 2418.111 33.718500 16 1886.140 2006.308 -120.167727 17 2110.660 2006.308 104.352273 18 1856.870 2006.308 -149.437727 19 1775.765 1664.688 111.077188 20 1569.625 1664.688 -95.062813 21 1835.690 2006.308 -170.617727 22 2041.460 2006.308 35.152273 23 1667.035 1664.688 2.347188 24 948.250 1119.631 -171.380769 25 1365.660 1119.631 246.029231 26 1681.025 1664.688 16.337188 27 1661.900 1664.688 -2.787812 28 2194.880 2006.308 188.572273 29 2051.025 2006.308 44.717273 30 2365.845 2418.111 -52.266500 31 2398.500 2418.111 -19.611500 32 2181.850 2006.308 175.542273 33 2626.770 2418.111 208.658500 34 2529.720 2418.111 111.608500 35 1700.300 1664.688 35.612187 36 605.380 1119.631 -514.250769 37 1200.495 1119.631 80.864231 38 1597.020 1664.688 -67.667813 39 1174.955 1119.631 55.324231 40 1612.880 1664.688 -51.807812 41 1683.550 1664.688 18.862187 42 2260.955 2418.111 -157.156500 43 2455.335 2418.111 37.223500 44 2365.620 2418.111 -52.491500 45 2417.755 2418.111 -0.356500 46 2308.785 2418.111 -109.326500 47 1629.940 1664.688 -34.747813 48 1053.275 1119.631 -66.355769 49 1330.235 1119.631 210.604231 50 1543.850 1664.688 -120.837813 > myr <- residuals(m) > myp <- predict(m) > postscript(file="/var/www/rcomp/tmp/3lfed1274871291.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/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/www/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/rcomp/tmp/4i7c41274871291.tab") > > try(system("convert tmp/1lfed1274871291.ps tmp/1lfed1274871291.png",intern=TRUE)) character(0) > try(system("convert tmp/2lfed1274871291.ps tmp/2lfed1274871291.png",intern=TRUE)) character(0) > try(system("convert tmp/3lfed1274871291.ps tmp/3lfed1274871291.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 1.290 0.770 1.561