R version 2.15.2 (2012-10-26) -- "Trick or Treat" Copyright (C) 2012 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: i686-pc-linux-gnu (32-bit) 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(2.7 + ,8.4 + ,4.3 + ,1.5 + ,2.2 + ,2.1 + ,2.5 + ,7.5 + ,3.1 + ,1.7 + ,2.3 + ,2.2 + ,2.2 + ,4.0 + ,5.7 + ,1.6 + ,2.1 + ,2.2 + ,2.9 + ,8.5 + ,6.7 + ,1.7 + ,2.8 + ,2.7 + ,3.1 + ,7.6 + ,9.5 + ,1.8 + ,3.1 + ,3.1 + ,3.0 + ,5.5 + ,9.0 + ,1.7 + ,2.9 + ,3.2 + ,2.8 + ,3.3 + ,6.9 + ,2.2 + ,2.6 + ,3.1 + ,2.5 + ,1.4 + ,7.5 + ,2.7 + ,2.7 + ,3.1 + ,1.9 + ,-4.4 + ,7.0 + ,3.0 + ,2.3 + ,2.8 + ,1.9 + ,-6.5 + ,9.3 + ,2.8 + ,2.3 + ,3.0 + ,1.8 + ,-8.5 + ,7.2 + ,2.7 + ,2.1 + ,2.8 + ,2.0 + ,-6.7 + ,6.6 + ,2.7 + ,2.2 + ,2.7 + ,2.6 + ,-3.3 + ,10.4 + ,2.5 + ,2.9 + ,3.2 + ,2.5 + ,-5.1 + ,8.7 + ,2.0 + ,2.6 + ,3.1 + ,2.5 + ,-3.5 + ,7.9 + ,1.8 + ,2.7 + ,3.0 + ,1.6 + ,-3.6 + ,4.1 + ,1.4 + ,1.8 + ,2.0 + ,1.4 + ,-6.3 + ,2.2 + ,1.5 + ,1.3 + ,1.7 + ,0.8 + ,-8.0 + ,-0.5 + ,1.6 + ,0.9 + ,1.2 + ,1.1 + ,-5.3 + ,1.7 + ,1.3 + ,1.3 + ,1.4 + ,1.3 + ,-4.0 + ,0.4 + ,1.1 + ,1.3 + ,1.3 + ,1.2 + ,-4.0 + ,2.6 + ,0.8 + ,1.3 + ,1.3 + ,1.3 + ,0.1 + ,0.7 + ,1.1 + ,1.3 + ,1.1 + ,1.1 + ,-0.9 + ,0.7 + ,1.3 + ,1.1 + ,0.9 + ,1.3 + ,1.1 + ,0.5 + ,1.5 + ,1.4 + ,1.2 + ,1.2 + ,3.1 + ,-2.3 + ,1.8 + ,1.2 + ,0.9 + ,1.6 + ,5.7 + ,0.3 + ,2.7 + ,1.7 + ,1.3 + ,1.7 + ,6.2 + ,-0.2 + ,3.0 + ,1.8 + ,1.4 + ,1.5 + ,-2.2 + ,0.6 + ,3.2 + ,1.5 + ,1.5 + ,0.9 + ,-4.2 + ,-0.6 + ,3.2 + ,1.0 + ,1.1 + ,1.5 + ,-1.6 + ,2.7 + ,3.3 + ,1.6 + ,1.6 + ,1.4 + ,-1.9 + ,2.3 + ,3.2 + ,1.5 + ,1.5 + ,1.6 + ,0.2 + ,4.3 + ,2.9 + ,1.8 + ,1.6 + ,1.7 + ,-1.2 + ,5.4 + ,2.7 + ,1.8 + ,1.7 + ,1.4 + ,-2.4 + ,2.6 + ,2.6 + ,1.6 + ,1.6 + ,1.8 + ,0.8 + ,2.9 + ,2.3 + ,1.9 + ,1.7 + ,1.7 + ,-0.1 + ,2.9 + ,2.2 + ,1.7 + ,1.6 + ,1.4 + ,-1.5 + ,2.9 + ,2.1 + ,1.6 + ,1.6 + ,1.2 + ,-4.4 + ,1.4 + ,2.4 + ,1.3 + ,1.3 + ,1.0 + ,-4.2 + ,1.1 + ,2.5 + ,1.1 + ,1.1 + ,1.7 + ,3.5 + ,1.9 + ,2.4 + ,1.9 + ,1.6 + ,2.4 + ,10.0 + ,2.8 + ,2.3 + ,2.6 + ,1.9 + ,2.0 + ,8.6 + ,1.4 + ,2.1 + ,2.3 + ,1.6 + ,2.1 + ,9.5 + ,0.7 + ,2.3 + ,2.4 + ,1.7 + ,2.0 + ,9.9 + ,-0.8 + ,2.2 + ,2.2 + ,1.6 + ,1.8 + ,10.4 + ,-3.1 + ,2.1 + ,2.0 + ,1.4 + ,2.7 + ,16.0 + ,0.1 + ,2.0 + ,2.9 + ,2.1 + ,2.3 + ,12.7 + ,1.0 + ,2.1 + ,2.6 + ,1.9 + ,1.9 + ,10.2 + ,1.9 + ,2.1 + ,2.3 + ,1.7 + ,2.0 + ,8.9 + ,-0.5 + ,2.5 + ,2.3 + ,1.8 + ,2.3 + ,12.6 + ,1.5 + ,2.2 + ,2.6 + ,2.0 + ,2.8 + ,13.6 + ,3.9 + ,2.3 + ,3.1 + ,2.5 + ,2.4 + ,14.8 + ,1.9 + ,2.3 + ,2.8 + ,2.1 + ,2.3 + ,9.5 + ,2.6 + ,2.2 + ,2.5 + ,2.1 + ,2.7 + ,13.7 + ,1.7 + ,2.2 + ,2.9 + ,2.3 + ,2.7 + ,17.0 + ,1.4 + ,1.6 + ,3.1 + ,2.4 + ,2.9 + ,14.7 + ,2.8 + ,1.8 + ,3.1 + ,2.4 + ,3.0 + ,17.4 + ,0.5 + ,1.7 + ,3.2 + ,2.3 + ,2.2 + ,9.0 + ,1.0 + ,1.9 + ,2.5 + ,1.7 + ,2.3 + ,9.1 + ,1.5 + ,1.8 + ,2.6 + ,2.0 + ,2.8 + ,12.2 + ,1.8 + ,1.9 + ,2.9 + ,2.3 + ,2.8 + ,15.9 + ,2.7 + ,1.5 + ,2.6 + ,2.0 + ,2.8 + ,12.9 + ,3.0 + ,1.0 + ,2.4 + ,2.0 + ,2.2 + ,10.9 + ,-0.3 + ,0.8 + ,1.7 + ,1.3 + ,2.6 + ,10.6 + ,1.1 + ,1.1 + ,2.0 + ,1.7 + ,2.8 + ,13.2 + ,1.7 + ,1.5 + ,2.2 + ,1.9 + ,2.5 + ,9.6 + ,1.6 + ,1.7 + ,1.9 + ,1.7 + ,2.4 + ,6.4 + ,3.0 + ,2.3 + ,1.6 + ,1.6 + ,2.3 + ,5.8 + ,3.3 + ,2.4 + ,1.6 + ,1.7 + ,1.9 + ,-1.0 + ,6.7 + ,3.0 + ,1.2 + ,1.8 + ,1.7 + ,-0.2 + ,5.6 + ,3.0 + ,1.2 + ,1.9 + ,2.0 + ,2.7 + ,6.0 + ,3.2 + ,1.5 + ,1.9 + ,2.1 + ,3.6 + ,4.8 + ,3.2 + ,1.6 + ,1.9 + ,1.7 + ,-0.9 + ,5.9 + ,3.2 + ,1.7 + ,2.0 + ,1.8 + ,0.3 + ,4.3 + ,3.5 + ,1.8 + ,2.1 + ,1.8 + ,-1.1 + ,3.7 + ,4.0 + ,1.8 + ,1.9 + ,1.8 + ,-2.5 + ,5.6 + ,4.3 + ,1.8 + ,1.9 + ,1.3 + ,-3.4 + ,1.7 + ,4.1 + ,1.3 + ,1.3 + ,1.3 + ,-3.5 + ,3.2 + ,4.0 + ,1.3 + ,1.3 + ,1.3 + ,-3.9 + ,3.6 + ,4.1 + ,1.4 + ,1.4 + ,1.2 + ,-4.6 + ,1.7 + ,4.2 + ,1.1 + ,1.2 + ,1.4 + ,-0.1 + ,0.5 + ,4.5 + ,1.5 + ,1.3 + ,2.2 + ,4.3 + ,2.1 + ,5.6 + ,2.2 + ,1.8 + ,2.9 + ,10.2 + ,1.5 + ,6.5 + ,2.9 + ,2.2 + ,3.1 + ,8.7 + ,2.7 + ,7.6 + ,3.1 + ,2.6 + ,3.5 + ,13.3 + ,1.4 + ,8.5 + ,3.5 + ,2.8 + ,3.6 + ,15.0 + ,1.2 + ,8.7 + ,3.6 + ,3.1 + ,4.4 + ,20.7 + ,2.3 + ,8.3 + ,4.4 + ,3.9 + ,4.1 + ,20.7 + ,1.6 + ,8.3 + ,4.2 + ,3.7 + ,5.1 + ,26.4 + ,4.7 + ,8.5 + ,5.2 + ,4.6 + ,5.8 + ,31.2 + ,3.5 + ,8.7 + ,5.8 + ,5.1 + ,5.9 + ,31.4 + ,4.4 + ,8.7 + ,5.9 + ,5.2 + ,5.4 + ,26.6 + ,3.9 + ,8.5 + ,5.4 + ,4.9 + ,5.5 + ,26.6 + ,3.5 + ,7.9 + ,5.5 + ,5.1 + ,4.8 + ,19.2 + ,3.0 + ,7.0 + ,4.7 + ,4.8 + ,3.2 + ,6.5 + ,1.6 + ,5.8 + ,3.1 + ,3.9 + ,2.7 + ,3.1 + ,2.2 + ,4.5 + ,2.6 + ,3.5 + ,2.1 + ,-0.2 + ,4.1 + ,3.7 + ,2.3 + ,3.3 + ,1.9 + ,-4.0 + ,4.3 + ,3.1 + ,1.9 + ,2.8 + ,0.6 + ,-12.6 + ,3.5 + ,2.7 + ,0.6 + ,1.6 + ,0.7 + ,-13.0 + ,1.8 + ,2.3 + ,0.6 + ,1.5 + ,-0.2 + ,-17.6 + ,0.6 + ,1.8 + ,-0.4 + ,0.7 + ,-1.0 + ,-21.7 + ,-0.4 + ,1.5 + ,-1.1 + ,-0.1 + ,-1.7 + ,-23.2 + ,-2.5 + ,1.2 + ,-1.7 + ,-0.7 + ,-0.7 + ,-16.8 + ,-1.6 + ,1.0 + ,-0.8 + ,-0.2 + ,-1.0 + ,-19.8 + ,-1.9 + ,0.9 + ,-1.2 + ,-0.6 + ,-0.9 + ,-17.2 + ,-1.6 + ,0.6 + ,-1.0 + ,-0.6 + ,0.0 + ,-10.4 + ,-0.7 + ,0.6 + ,-0.1 + ,-0.3 + ,0.3 + ,-6.8 + ,-1.1 + ,0.7 + ,0.3 + ,-0.3 + ,0.8 + ,-2.9 + ,0.3 + ,0.5 + ,0.6 + ,-0.1 + ,0.8 + ,-1.9 + ,1.3 + ,0.5 + ,0.7 + ,0.1 + ,1.9 + ,7.0 + ,3.3 + ,0.5 + ,1.7 + ,0.9 + ,2.1 + ,9.8 + ,2.4 + ,0.5 + ,1.8 + ,1.1 + ,2.5 + ,12.5 + ,2.0 + ,0.8 + ,2.3 + ,1.6 + ,2.7 + ,13.7 + ,3.9 + ,0.8 + ,2.5 + ,2.0 + ,2.4 + ,13.7 + ,4.2 + ,1.1 + ,2.6 + ,2.2 + ,2.4 + ,9.7 + ,4.9 + ,1.2 + ,2.3 + ,2.1 + ,2.9 + ,14.0 + ,5.8 + ,1.5 + ,2.9 + ,2.6 + ,3.1 + ,15.3 + ,4.8 + ,1.7 + ,3.0 + ,2.5 + ,3.0 + ,13.4 + ,4.4 + ,1.8 + ,2.9 + ,2.5 + ,3.4 + ,17.1 + ,5.3 + ,1.8 + ,3.1 + ,2.6 + ,3.7 + ,15.7 + ,2.1 + ,2.1 + ,3.2 + ,2.7 + ,3.5 + ,18.3 + ,2.0 + ,2.2 + ,3.4 + ,2.8 + ,3.5 + ,18.1 + ,-0.9 + ,2.5 + ,3.5 + ,2.9 + ,3.3 + ,16.3 + ,0.1 + ,2.7 + ,3.4 + ,2.9 + ,3.1 + ,15.8 + ,-0.5 + ,3.0 + ,3.3 + ,2.9 + ,3.4 + ,17.3 + ,-0.1 + ,3.4 + ,3.7 + ,3.3 + ,4.0 + ,18.0 + ,0.7 + ,3.4 + ,3.8 + ,3.3 + ,3.4 + ,17.6 + ,-0.4 + ,3.5 + ,3.6 + ,3.1 + ,3.4 + ,18.4 + ,-1.5 + ,3.5 + ,3.6 + ,3.0 + ,3.4 + ,17.4 + ,-0.3 + ,3.4 + ,3.6 + ,3.1 + ,3.7 + ,17.9 + ,1.0 + ,3.6 + ,3.8 + ,3.4 + ,3.2 + ,13.5 + ,0.4 + ,3.8 + ,3.5 + ,3.2 + ,3.3 + ,13.7 + ,0.3 + ,3.5 + ,3.6 + ,3.4 + ,3.3 + ,12.6 + ,1.8 + ,3.5 + ,3.7 + ,3.4 + ,3.1 + ,10.4 + ,3.0 + ,3.5 + ,3.4 + ,3.1 + ,2.9 + ,8.8 + ,2.2 + ,3.2 + ,3.2 + ,3.0 + ,2.6 + ,5.4 + ,3.4 + ,2.9 + ,2.8 + ,2.7 + ,2.2 + ,2.1 + ,3.4 + ,2.5 + ,2.3 + ,2.2 + ,2.0 + ,2.8 + ,3.1 + ,2.3 + ,2.3 + ,2.2 + ,2.6 + ,5.6 + ,4.5 + ,2.7 + ,2.9 + ,2.6 + ,2.6 + ,4.8 + ,4.6 + ,3.0 + ,2.8 + ,2.4 + ,2.6 + ,4.5 + ,5.7 + ,3.3 + ,2.8 + ,2.5 + ,2.2 + ,1.5 + ,4.3 + ,3.2 + ,2.3 + ,2.2) + ,dim=c(6 + ,143) + ,dimnames=list(c('HICP' + ,'Energiedragers' + ,'Niet-bewerkte_levensmiddelen' + ,'Bewerkte_levensmiddelen' + ,'Algemene_index' + ,'Gezondheidsindex') + ,1:143)) > y <- array(NA,dim=c(6,143),dimnames=list(c('HICP','Energiedragers','Niet-bewerkte_levensmiddelen','Bewerkte_levensmiddelen','Algemene_index','Gezondheidsindex'),1:143)) > for (i in 1:dim(x)[1]) + { + for (j in 1:dim(x)[2]) + { + y[i,j] <- as.numeric(x[i,j]) + } + } > par4 = 'no' > par3 = '0' > par2 = 'none' > par1 = '1' > library(party) Loading required package: survival Loading required package: splines Loading required package: grid Loading required package: modeltools Loading required package: stats4 Loading required package: coin Loading required package: mvtnorm Loading required package: zoo Attaching package: 'zoo' The following object(s) are masked from 'package:base': as.Date, as.Date.numeric Loading required package: sandwich Loading required package: strucchange Loading required package: vcd Loading required package: MASS Loading required package: colorspace > library(Hmisc) Hmisc library by Frank E Harrell Jr Type library(help='Hmisc'), ?Overview, or ?Hmisc.Overview') to see overall documentation. NOTE:Hmisc no longer redefines [.factor to drop unused levels when subsetting. To get the old behavior of Hmisc type dropUnusedLevels(). Attaching package: 'Hmisc' The following object(s) are masked from 'package:survival': untangle.specials The following object(s) are masked from 'package:base': format.pval, round.POSIXt, trunc.POSIXt, units > par1 <- as.numeric(par1) > par3 <- as.numeric(par3) > x <- data.frame(t(y)) > is.data.frame(x) [1] TRUE > x <- x[!is.na(x[,par1]),] > k <- length(x[1,]) > n <- length(x[,1]) > colnames(x)[par1] [1] "HICP" > x[,par1] [1] 2.7 2.5 2.2 2.9 3.1 3.0 2.8 2.5 1.9 1.9 1.8 2.0 2.6 2.5 2.5 [16] 1.6 1.4 0.8 1.1 1.3 1.2 1.3 1.1 1.3 1.2 1.6 1.7 1.5 0.9 1.5 [31] 1.4 1.6 1.7 1.4 1.8 1.7 1.4 1.2 1.0 1.7 2.4 2.0 2.1 2.0 1.8 [46] 2.7 2.3 1.9 2.0 2.3 2.8 2.4 2.3 2.7 2.7 2.9 3.0 2.2 2.3 2.8 [61] 2.8 2.8 2.2 2.6 2.8 2.5 2.4 2.3 1.9 1.7 2.0 2.1 1.7 1.8 1.8 [76] 1.8 1.3 1.3 1.3 1.2 1.4 2.2 2.9 3.1 3.5 3.6 4.4 4.1 5.1 5.8 [91] 5.9 5.4 5.5 4.8 3.2 2.7 2.1 1.9 0.6 0.7 -0.2 -1.0 -1.7 -0.7 -1.0 [106] -0.9 0.0 0.3 0.8 0.8 1.9 2.1 2.5 2.7 2.4 2.4 2.9 3.1 3.0 3.4 [121] 3.7 3.5 3.5 3.3 3.1 3.4 4.0 3.4 3.4 3.4 3.7 3.2 3.3 3.3 3.1 [136] 2.9 2.6 2.2 2.0 2.6 2.6 2.6 2.2 > if (par2 == 'kmeans') { + cl <- kmeans(x[,par1], par3) + print(cl) + clm <- matrix(cbind(cl$centers,1:par3),ncol=2) + clm <- clm[sort.list(clm[,1]),] + for (i in 1:par3) { + cl$cluster[cl$cluster==clm[i,2]] <- paste('C',i,sep='') + } + cl$cluster <- as.factor(cl$cluster) + print(cl$cluster) + x[,par1] <- cl$cluster + } > if (par2 == 'quantiles') { + x[,par1] <- cut2(x[,par1],g=par3) + } > if (par2 == 'hclust') { + hc <- hclust(dist(x[,par1])^2, 'cen') + print(hc) + memb <- cutree(hc, k = par3) + dum <- c(mean(x[memb==1,par1])) + for (i in 2:par3) { + dum <- c(dum, mean(x[memb==i,par1])) + } + hcm <- matrix(cbind(dum,1:par3),ncol=2) + hcm <- hcm[sort.list(hcm[,1]),] + for (i in 1:par3) { + memb[memb==hcm[i,2]] <- paste('C',i,sep='') + } + memb <- as.factor(memb) + print(memb) + x[,par1] <- memb + } > if (par2=='equal') { + ed <- cut(as.numeric(x[,par1]),par3,labels=paste('C',1:par3,sep='')) + x[,par1] <- as.factor(ed) + } > table(x[,par1]) -1.7 -1 -0.9 -0.7 -0.2 0 0.3 0.6 0.7 0.8 0.9 1 1.1 1.2 1.3 1.4 1 2 1 1 1 1 1 1 1 3 1 1 2 4 6 5 1.5 1.6 1.7 1.8 1.9 2 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 3 2 3 6 6 6 6 4 6 5 5 6 6 6 6 5 3 3.1 3.2 3.3 3.4 3.5 3.6 3.7 4 4.1 4.4 4.8 5.1 5.4 5.5 5.8 5.9 5 2 3 5 3 1 2 1 1 1 1 1 1 1 1 1 > colnames(x) [1] "HICP" "Energiedragers" [3] "Niet.bewerkte_levensmiddelen" "Bewerkte_levensmiddelen" [5] "Algemene_index" "Gezondheidsindex" > colnames(x)[par1] [1] "HICP" > x[,par1] [1] 2.7 2.5 2.2 2.9 3.1 3.0 2.8 2.5 1.9 1.9 1.8 2.0 2.6 2.5 2.5 [16] 1.6 1.4 0.8 1.1 1.3 1.2 1.3 1.1 1.3 1.2 1.6 1.7 1.5 0.9 1.5 [31] 1.4 1.6 1.7 1.4 1.8 1.7 1.4 1.2 1.0 1.7 2.4 2.0 2.1 2.0 1.8 [46] 2.7 2.3 1.9 2.0 2.3 2.8 2.4 2.3 2.7 2.7 2.9 3.0 2.2 2.3 2.8 [61] 2.8 2.8 2.2 2.6 2.8 2.5 2.4 2.3 1.9 1.7 2.0 2.1 1.7 1.8 1.8 [76] 1.8 1.3 1.3 1.3 1.2 1.4 2.2 2.9 3.1 3.5 3.6 4.4 4.1 5.1 5.8 [91] 5.9 5.4 5.5 4.8 3.2 2.7 2.1 1.9 0.6 0.7 -0.2 -1.0 -1.7 -0.7 -1.0 [106] -0.9 0.0 0.3 0.8 0.8 1.9 2.1 2.5 2.7 2.4 2.4 2.9 3.1 3.0 3.4 [121] 3.7 3.5 3.5 3.3 3.1 3.4 4.0 3.4 3.4 3.4 3.7 3.2 3.3 3.3 3.1 [136] 2.9 2.6 2.2 2.0 2.6 2.6 2.6 2.2 > if (par2 == 'none') { + m <- ctree(as.formula(paste(colnames(x)[par1],' ~ .',sep='')),data = x) + } > > #Note: the /var/wessaorg/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/wessaorg/rcomp/createtable") > > if (par2 != 'none') { + m <- ctree(as.formula(paste('as.factor(',colnames(x)[par1],') ~ .',sep='')),data = x) + if (par4=='yes') { + a<-table.start() + a<-table.row.start(a) + a<-table.element(a,'10-Fold Cross Validation',3+2*par3,TRUE) + a<-table.row.end(a) + a<-table.row.start(a) + a<-table.element(a,'',1,TRUE) + a<-table.element(a,'Prediction (training)',par3+1,TRUE) + a<-table.element(a,'Prediction (testing)',par3+1,TRUE) + a<-table.row.end(a) + a<-table.row.start(a) + a<-table.element(a,'Actual',1,TRUE) + for (jjj in 1:par3) a<-table.element(a,paste('C',jjj,sep=''),1,TRUE) + a<-table.element(a,'CV',1,TRUE) + for (jjj in 1:par3) a<-table.element(a,paste('C',jjj,sep=''),1,TRUE) + a<-table.element(a,'CV',1,TRUE) + a<-table.row.end(a) + for (i in 1:10) { + ind <- sample(2, nrow(x), replace=T, prob=c(0.9,0.1)) + m.ct <- ctree(as.formula(paste('as.factor(',colnames(x)[par1],') ~ .',sep='')),data =x[ind==1,]) + if (i==1) { + m.ct.i.pred <- predict(m.ct, newdata=x[ind==1,]) + m.ct.i.actu <- x[ind==1,par1] + m.ct.x.pred <- predict(m.ct, newdata=x[ind==2,]) + m.ct.x.actu <- x[ind==2,par1] + } else { + m.ct.i.pred <- c(m.ct.i.pred,predict(m.ct, newdata=x[ind==1,])) + m.ct.i.actu <- c(m.ct.i.actu,x[ind==1,par1]) + m.ct.x.pred <- c(m.ct.x.pred,predict(m.ct, newdata=x[ind==2,])) + m.ct.x.actu <- c(m.ct.x.actu,x[ind==2,par1]) + } + } + print(m.ct.i.tab <- table(m.ct.i.actu,m.ct.i.pred)) + numer <- 0 + for (i in 1:par3) { + print(m.ct.i.tab[i,i] / sum(m.ct.i.tab[i,])) + numer <- numer + m.ct.i.tab[i,i] + } + print(m.ct.i.cp <- numer / sum(m.ct.i.tab)) + print(m.ct.x.tab <- table(m.ct.x.actu,m.ct.x.pred)) + numer <- 0 + for (i in 1:par3) { + print(m.ct.x.tab[i,i] / sum(m.ct.x.tab[i,])) + numer <- numer + m.ct.x.tab[i,i] + } + print(m.ct.x.cp <- numer / sum(m.ct.x.tab)) + for (i in 1:par3) { + a<-table.row.start(a) + a<-table.element(a,paste('C',i,sep=''),1,TRUE) + for (jjj in 1:par3) a<-table.element(a,m.ct.i.tab[i,jjj]) + a<-table.element(a,round(m.ct.i.tab[i,i]/sum(m.ct.i.tab[i,]),4)) + for (jjj in 1:par3) a<-table.element(a,m.ct.x.tab[i,jjj]) + a<-table.element(a,round(m.ct.x.tab[i,i]/sum(m.ct.x.tab[i,]),4)) + a<-table.row.end(a) + } + a<-table.row.start(a) + a<-table.element(a,'Overall',1,TRUE) + for (jjj in 1:par3) a<-table.element(a,'-') + a<-table.element(a,round(m.ct.i.cp,4)) + for (jjj in 1:par3) a<-table.element(a,'-') + a<-table.element(a,round(m.ct.x.cp,4)) + a<-table.row.end(a) + a<-table.end(a) + table.save(a,file="/var/wessaorg/rcomp/tmp/1bein1354887407.tab") + } + } > m Conditional inference tree with 10 terminal nodes Response: HICP Inputs: Energiedragers, Niet.bewerkte_levensmiddelen, Bewerkte_levensmiddelen, Algemene_index, Gezondheidsindex Number of observations: 143 1) Algemene_index <= 2.3; criterion = 1, statistic = 136.482 2) Algemene_index <= 0.3; criterion = 1, statistic = 69.988 3)* weights = 8 2) Algemene_index > 0.3 4) Algemene_index <= 1.5; criterion = 1, statistic = 48.063 5) Algemene_index <= 1.1; criterion = 1, statistic = 15.137 6)* weights = 9 5) Algemene_index > 1.1 7)* weights = 17 4) Algemene_index > 1.5 8) Energiedragers <= 0.8; criterion = 1, statistic = 15.999 9)* weights = 18 8) Energiedragers > 0.8 10)* weights = 26 1) Algemene_index > 2.3 11) Algemene_index <= 3.8; criterion = 1, statistic = 60.659 12) Algemene_index <= 2.9; criterion = 1, statistic = 43.325 13) Algemene_index <= 2.8; criterion = 0.99, statistic = 9.553 14)* weights = 21 13) Algemene_index > 2.8 15)* weights = 9 12) Algemene_index > 2.9 16) Algemene_index <= 3.3; criterion = 0.998, statistic = 12.381 17)* weights = 12 16) Algemene_index > 3.3 18)* weights = 15 11) Algemene_index > 3.8 19)* weights = 8 > postscript(file="/var/wessaorg/rcomp/tmp/2df4i1354887407.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > plot(m) > dev.off() null device 1 > postscript(file="/var/wessaorg/rcomp/tmp/3217x1354887407.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > plot(x[,par1] ~ as.factor(where(m)),main='Response by Terminal Node',xlab='Terminal Node',ylab='Response') > dev.off() null device 1 > if (par2 == 'none') { + forec <- predict(m) + result <- as.data.frame(cbind(x[,par1],forec,x[,par1]-forec)) + colnames(result) <- c('Actuals','Forecasts','Residuals') + print(result) + } Actuals Forecasts Residuals 1 2.7 2.1730769 0.52692308 2 2.5 2.1730769 0.32692308 3 2.2 2.1730769 0.02692308 4 2.9 2.5095238 0.39047619 5 3.1 3.0833333 0.01666667 6 3.0 2.8000000 0.20000000 7 2.8 2.5095238 0.29047619 8 2.5 2.5095238 -0.00952381 9 1.9 1.7444444 0.15555556 10 1.9 1.7444444 0.15555556 11 1.8 1.7444444 0.05555556 12 2.0 1.7444444 0.25555556 13 2.6 2.8000000 -0.20000000 14 2.5 2.5095238 -0.00952381 15 2.5 2.5095238 -0.00952381 16 1.6 1.7444444 -0.14444444 17 1.4 1.4000000 0.00000000 18 0.8 0.8777778 -0.07777778 19 1.1 1.4000000 -0.30000000 20 1.3 1.4000000 -0.10000000 21 1.2 1.4000000 -0.20000000 22 1.3 1.4000000 -0.10000000 23 1.1 0.8777778 0.22222222 24 1.3 1.4000000 -0.10000000 25 1.2 1.4000000 -0.20000000 26 1.6 2.1730769 -0.57307692 27 1.7 2.1730769 -0.47307692 28 1.5 1.4000000 0.10000000 29 0.9 0.8777778 0.02222222 30 1.5 1.7444444 -0.24444444 31 1.4 1.4000000 0.00000000 32 1.6 1.7444444 -0.14444444 33 1.7 1.7444444 -0.04444444 34 1.4 1.7444444 -0.34444444 35 1.8 1.7444444 0.05555556 36 1.7 1.7444444 -0.04444444 37 1.4 1.7444444 -0.34444444 38 1.2 1.4000000 -0.20000000 39 1.0 0.8777778 0.12222222 40 1.7 2.1730769 -0.47307692 41 2.4 2.5095238 -0.10952381 42 2.0 2.1730769 -0.17307692 43 2.1 2.5095238 -0.40952381 44 2.0 2.1730769 -0.17307692 45 1.8 2.1730769 -0.37307692 46 2.7 2.8000000 -0.10000000 47 2.3 2.5095238 -0.20952381 48 1.9 2.1730769 -0.27307692 49 2.0 2.1730769 -0.17307692 50 2.3 2.5095238 -0.20952381 51 2.8 3.0833333 -0.28333333 52 2.4 2.5095238 -0.10952381 53 2.3 2.5095238 -0.20952381 54 2.7 2.8000000 -0.10000000 55 2.7 3.0833333 -0.38333333 56 2.9 3.0833333 -0.18333333 57 3.0 3.0833333 -0.08333333 58 2.2 2.5095238 -0.30952381 59 2.3 2.5095238 -0.20952381 60 2.8 2.8000000 0.00000000 61 2.8 2.5095238 0.29047619 62 2.8 2.5095238 0.29047619 63 2.2 2.1730769 0.02692308 64 2.6 2.1730769 0.42692308 65 2.8 2.1730769 0.62692308 66 2.5 2.1730769 0.32692308 67 2.4 2.1730769 0.22692308 68 2.3 2.1730769 0.12692308 69 1.9 1.4000000 0.50000000 70 1.7 1.4000000 0.30000000 71 2.0 1.4000000 0.60000000 72 2.1 2.1730769 -0.07307692 73 1.7 1.7444444 -0.04444444 74 1.8 1.7444444 0.05555556 75 1.8 1.7444444 0.05555556 76 1.8 1.7444444 0.05555556 77 1.3 1.4000000 -0.10000000 78 1.3 1.4000000 -0.10000000 79 1.3 1.4000000 -0.10000000 80 1.2 0.8777778 0.32222222 81 1.4 1.4000000 0.00000000 82 2.2 2.1730769 0.02692308 83 2.9 2.8000000 0.10000000 84 3.1 3.0833333 0.01666667 85 3.5 3.4400000 0.06000000 86 3.6 3.4400000 0.16000000 87 4.4 5.1250000 -0.72500000 88 4.1 5.1250000 -1.02500000 89 5.1 5.1250000 -0.02500000 90 5.8 5.1250000 0.67500000 91 5.9 5.1250000 0.77500000 92 5.4 5.1250000 0.27500000 93 5.5 5.1250000 0.37500000 94 4.8 5.1250000 -0.32500000 95 3.2 3.0833333 0.11666667 96 2.7 2.5095238 0.19047619 97 2.1 1.7444444 0.35555556 98 1.9 1.7444444 0.15555556 99 0.6 0.8777778 -0.27777778 100 0.7 0.8777778 -0.17777778 101 -0.2 -0.6500000 0.45000000 102 -1.0 -0.6500000 -0.35000000 103 -1.7 -0.6500000 -1.05000000 104 -0.7 -0.6500000 -0.05000000 105 -1.0 -0.6500000 -0.35000000 106 -0.9 -0.6500000 -0.25000000 107 0.0 -0.6500000 0.65000000 108 0.3 -0.6500000 0.95000000 109 0.8 0.8777778 -0.07777778 110 0.8 0.8777778 -0.07777778 111 1.9 2.1730769 -0.27307692 112 2.1 2.1730769 -0.07307692 113 2.5 2.1730769 0.32692308 114 2.7 2.5095238 0.19047619 115 2.4 2.5095238 -0.10952381 116 2.4 2.1730769 0.22692308 117 2.9 2.8000000 0.10000000 118 3.1 3.0833333 0.01666667 119 3.0 2.8000000 0.20000000 120 3.4 3.0833333 0.31666667 121 3.7 3.0833333 0.61666667 122 3.5 3.4400000 0.06000000 123 3.5 3.4400000 0.06000000 124 3.3 3.4400000 -0.14000000 125 3.1 3.0833333 0.01666667 126 3.4 3.4400000 -0.04000000 127 4.0 3.4400000 0.56000000 128 3.4 3.4400000 -0.04000000 129 3.4 3.4400000 -0.04000000 130 3.4 3.4400000 -0.04000000 131 3.7 3.4400000 0.26000000 132 3.2 3.4400000 -0.24000000 133 3.3 3.4400000 -0.14000000 134 3.3 3.4400000 -0.14000000 135 3.1 3.4400000 -0.34000000 136 2.9 3.0833333 -0.18333333 137 2.6 2.5095238 0.09047619 138 2.2 2.1730769 0.02692308 139 2.0 2.1730769 -0.17307692 140 2.6 2.8000000 -0.20000000 141 2.6 2.5095238 0.09047619 142 2.6 2.5095238 0.09047619 143 2.2 2.1730769 0.02692308 > if (par2 != 'none') { + print(cbind(as.factor(x[,par1]),predict(m))) + myt <- table(as.factor(x[,par1]),predict(m)) + print(myt) + } > postscript(file="/var/wessaorg/rcomp/tmp/420ss1354887407.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > if(par2=='none') { + op <- par(mfrow=c(2,2)) + plot(density(result$Actuals),main='Kernel Density Plot of Actuals') + plot(density(result$Residuals),main='Kernel Density Plot of Residuals') + plot(result$Forecasts,result$Actuals,main='Actuals versus Predictions',xlab='Predictions',ylab='Actuals') + plot(density(result$Forecasts),main='Kernel Density Plot of Predictions') + par(op) + } > if(par2!='none') { + plot(myt,main='Confusion Matrix',xlab='Actual',ylab='Predicted') + } > dev.off() null device 1 > if (par2 == 'none') { + detcoef <- cor(result$Forecasts,result$Actuals) + a<-table.start() + a<-table.row.start(a) + a<-table.element(a,'Goodness of Fit',2,TRUE) + a<-table.row.end(a) + a<-table.row.start(a) + a<-table.element(a,'Correlation',1,TRUE) + a<-table.element(a,round(detcoef,4)) + a<-table.row.end(a) + a<-table.row.start(a) + a<-table.element(a,'R-squared',1,TRUE) + a<-table.element(a,round(detcoef*detcoef,4)) + a<-table.row.end(a) + a<-table.row.start(a) + a<-table.element(a,'RMSE',1,TRUE) + a<-table.element(a,round(sqrt(mean((result$Residuals)^2)),4)) + a<-table.row.end(a) + a<-table.end(a) + table.save(a,file="/var/wessaorg/rcomp/tmp/5hujh1354887407.tab") + a<-table.start() + a<-table.row.start(a) + a<-table.element(a,'Actuals, Predictions, and Residuals',4,TRUE) + a<-table.row.end(a) + a<-table.row.start(a) + a<-table.element(a,'#',header=TRUE) + a<-table.element(a,'Actuals',header=TRUE) + a<-table.element(a,'Forecasts',header=TRUE) + a<-table.element(a,'Residuals',header=TRUE) + a<-table.row.end(a) + for (i in 1:length(result$Actuals)) { + a<-table.row.start(a) + a<-table.element(a,i,header=TRUE) + a<-table.element(a,result$Actuals[i]) + a<-table.element(a,result$Forecasts[i]) + a<-table.element(a,result$Residuals[i]) + a<-table.row.end(a) + } + a<-table.end(a) + table.save(a,file="/var/wessaorg/rcomp/tmp/634mo1354887407.tab") + } > if (par2 != 'none') { + a<-table.start() + a<-table.row.start(a) + a<-table.element(a,'Confusion Matrix (predicted in columns / actuals in rows)',par3+1,TRUE) + a<-table.row.end(a) + a<-table.row.start(a) + a<-table.element(a,'',1,TRUE) + for (i in 1:par3) { + a<-table.element(a,paste('C',i,sep=''),1,TRUE) + } + a<-table.row.end(a) + for (i in 1:par3) { + a<-table.row.start(a) + a<-table.element(a,paste('C',i,sep=''),1,TRUE) + for (j in 1:par3) { + a<-table.element(a,myt[i,j]) + } + a<-table.row.end(a) + } + a<-table.end(a) + table.save(a,file="/var/wessaorg/rcomp/tmp/7hagw1354887407.tab") + } > > try(system("convert tmp/2df4i1354887407.ps tmp/2df4i1354887407.png",intern=TRUE)) character(0) > try(system("convert tmp/3217x1354887407.ps tmp/3217x1354887407.png",intern=TRUE)) character(0) > try(system("convert tmp/420ss1354887407.ps tmp/420ss1354887407.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 5.411 0.588 5.977