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. Natural language support but running in an English locale 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(6 + ,4 + ,15 + ,10 + ,4 + ,4 + ,1 + ,11 + ,9 + ,9 + ,19 + ,7 + ,7 + ,1 + ,9 + ,9 + ,12 + ,15 + ,4 + ,4 + ,1 + ,14 + ,6 + ,16 + ,12 + ,5 + ,4 + ,1 + ,12 + ,8 + ,16 + ,14 + ,5 + ,6 + ,1 + ,18 + ,11 + ,15 + ,13 + ,4 + ,4 + ,1 + ,15 + ,10 + ,16 + ,11 + ,4 + ,5 + ,1 + ,12 + ,13 + ,13 + ,18 + ,5 + ,5 + ,1 + ,15 + ,10 + ,18 + ,12 + ,5 + ,4 + ,1 + ,13 + ,6 + ,17 + ,15 + ,3 + ,4 + ,1 + ,10 + ,8 + ,14 + ,15 + ,7 + ,7 + ,1 + ,13 + ,5 + ,13 + ,9 + ,4 + ,5 + ,1 + ,17 + ,9 + ,15 + ,11 + ,6 + ,5 + ,1 + ,15 + ,11 + ,15 + ,16 + ,5 + ,4 + ,1 + ,13 + ,11 + ,13 + ,17 + ,7 + ,7 + ,1 + ,17 + ,9 + ,13 + ,11 + ,5 + ,5 + ,1 + ,21 + ,7 + ,16 + ,13 + ,5 + ,5 + ,1 + ,12 + ,6 + ,14 + ,9 + ,4 + ,4 + ,1 + ,15 + ,6 + ,18 + ,11 + ,4 + ,4 + ,1 + ,16 + ,10 + ,16 + ,12 + ,7 + ,7 + ,1 + ,11 + ,4 + ,17 + ,13 + ,5 + ,8 + ,1 + ,9 + ,9 + ,15 + ,13 + ,2 + ,2 + ,1 + ,14 + ,10 + ,11 + ,13 + ,4 + ,3 + ,1 + ,14 + ,13 + ,11 + ,14 + ,5 + ,7 + ,1 + ,12 + ,8 + ,15 + ,9 + ,4 + ,5 + ,1 + ,15 + ,10 + ,15 + ,9 + ,4 + ,4 + ,1 + ,11 + ,5 + ,12 + ,15 + ,4 + ,4 + ,1 + ,11 + ,8 + ,17 + ,10 + ,4 + ,4 + ,1 + ,13 + ,9 + ,14 + ,15 + ,5 + ,6 + ,1 + ,12 + ,7 + ,17 + ,13 + ,4 + ,6 + ,1 + ,24 + ,20 + ,10 + ,24 + ,4 + ,4 + ,1 + ,11 + ,8 + ,15 + ,13 + ,4 + ,4 + ,1 + ,12 + ,7 + ,7 + ,22 + ,2 + ,4 + ,1 + ,13 + ,6 + ,9 + ,9 + ,5 + ,5 + ,1 + ,11 + ,10 + ,14 + ,12 + ,5 + ,7 + ,1 + ,14 + ,11 + ,11 + ,16 + ,7 + ,8 + ,1 + ,16 + ,12 + ,15 + ,10 + ,7 + ,7 + ,1 + ,12 + ,7 + ,16 + ,13 + ,4 + ,4 + ,1 + ,21 + ,12 + ,17 + ,11 + ,4 + ,4 + ,1 + ,6 + ,6 + ,15 + ,13 + ,4 + ,2 + ,1 + ,14 + ,9 + ,15 + ,10 + ,2 + ,4 + ,1 + ,16 + ,5 + ,16 + ,11 + ,5 + ,4 + ,1 + ,18 + ,11 + ,16 + ,9 + ,4 + ,4 + ,1 + ,13 + ,10 + ,12 + ,14 + ,2 + ,4 + ,1 + ,11 + ,7 + ,15 + ,11 + ,4 + ,5 + ,1 + ,16 + ,8 + ,17 + ,10 + ,4 + ,5 + ,1 + ,11 + ,9 + ,19 + ,11 + ,5 + ,5 + ,1 + ,11 + ,8 + ,15 + ,12 + ,1 + ,1 + ,1 + ,20 + ,13 + ,14 + ,14 + ,4 + ,5 + ,1 + ,10 + ,7 + ,16 + ,21 + ,5 + ,7 + ,1 + ,12 + ,7 + ,15 + ,13 + ,5 + ,7 + ,1 + ,14 + ,9 + ,12 + ,12 + ,7 + ,7 + ,1 + ,12 + ,9 + ,18 + ,12 + ,4 + ,4 + ,1 + ,12 + ,8 + ,13 + ,11 + ,4 + ,4 + ,1 + ,12 + ,7 + ,14 + ,14 + ,4 + ,4 + ,1 + ,13 + ,10 + ,15 + ,12 + ,2 + ,2 + ,1 + ,12 + ,7 + ,11 + ,12 + ,5 + ,4 + ,1 + ,9 + ,7 + ,15 + ,11 + ,4 + ,4 + ,1 + ,14 + ,10 + ,14 + ,15 + ,4 + ,4 + ,1 + ,12 + ,8 + ,16 + ,11 + ,4 + ,4 + ,1 + ,18 + ,5 + ,14 + ,22 + ,5 + ,7 + ,1 + ,17 + ,8 + ,18 + ,10 + ,3 + ,4 + ,1 + ,15 + ,9 + ,14 + ,11 + ,5 + ,5 + ,1 + ,8 + ,11 + ,13 + ,15 + ,4 + ,4 + ,1 + ,12 + ,8 + ,14 + ,11 + ,4 + ,4 + ,1 + ,10 + ,4 + ,17 + ,10 + ,5 + ,5 + ,1 + ,18 + ,16 + ,12 + ,14 + ,4 + ,7 + ,1 + ,15 + ,9 + ,16 + ,14 + ,6 + ,7 + ,1 + ,16 + ,10 + ,15 + ,11 + ,7 + ,8 + ,1 + ,17 + ,11 + ,16 + ,10 + ,5 + ,5 + ,1 + ,7 + ,8 + ,14 + ,12 + ,4 + ,4 + ,1 + ,12 + ,8 + ,17 + ,10 + ,5 + ,7 + ,1 + ,15 + ,6 + ,14 + ,12 + ,4 + ,1 + ,1 + ,13 + ,8 + ,16 + ,15 + ,4 + ,4 + ,1 + ,16 + ,14 + ,12 + ,11 + ,3 + ,4 + ,1 + ,18 + ,12 + ,13 + ,17 + ,2 + ,7 + ,1 + ,11 + ,11 + ,19 + ,8 + ,1 + ,1 + ,1 + ,13 + ,8 + ,11 + ,17 + ,4 + ,4 + ,1 + ,11 + ,8 + ,15 + ,13 + ,4 + ,2 + ,1 + ,13 + ,7 + ,12 + ,16 + ,4 + ,4 + ,1 + ,14 + ,9 + ,14 + ,13 + ,1 + ,1 + ,1 + ,18 + ,12 + ,11 + ,15 + ,4 + ,3 + ,1 + ,15 + ,6 + ,15 + ,14 + ,4 + ,4 + ,1 + ,9 + ,4 + ,12 + ,18 + ,5 + ,5 + ,1 + ,11 + ,6 + ,14 + ,14 + ,4 + ,4 + ,1 + ,17 + ,7 + ,13 + ,10 + ,6 + ,6 + ,1 + ,5 + ,4 + ,9 + ,20 + ,4 + ,4 + ,2 + ,20 + ,10 + ,12 + ,16 + ,4 + ,5 + ,2 + ,12 + ,6 + ,15 + ,10 + ,7 + ,7 + ,2 + ,11 + ,5 + ,17 + ,8 + ,7 + ,7 + ,2 + ,12 + ,8 + ,14 + ,14 + ,4 + ,4 + ,2 + ,13 + ,8 + ,11 + ,23 + ,5 + ,4 + ,2 + ,9 + ,11 + ,13 + ,9 + ,4 + ,2 + ,2 + ,9 + ,5 + ,10 + ,11 + ,3 + ,5 + ,2 + ,12 + ,7 + ,12 + ,10 + ,5 + ,7 + ,2 + ,12 + ,7 + ,15 + ,12 + ,5 + ,4 + ,2 + ,11 + ,8 + ,13 + ,10 + ,4 + ,4 + ,2 + ,17 + ,7 + ,13 + ,12 + ,7 + ,4 + ,2 + ,12 + ,7 + ,12 + ,14 + ,4 + ,4 + ,2 + ,8 + ,5 + ,9 + ,20 + ,4 + ,1 + ,2 + ,15 + ,4 + ,16 + ,8 + ,1 + ,1 + ,2 + ,9 + ,8 + ,17 + ,10 + ,5 + ,5 + ,2 + ,13 + ,6 + ,13 + ,11 + ,4 + ,4 + ,2 + ,9 + ,6 + ,10 + ,15 + ,4 + ,4 + ,2 + ,15 + ,9 + ,13 + ,12 + ,5 + ,5 + ,2 + ,14 + ,6 + ,16 + ,9 + ,4 + ,4 + ,2 + ,9 + ,6 + ,15 + ,13 + ,4 + ,5 + ,2 + ,8 + ,9 + ,16 + ,8 + ,4 + ,4 + ,2 + ,11 + ,8 + ,11 + ,11 + ,6 + ,3 + ,2 + ,16 + ,7 + ,15 + ,12 + ,6 + ,6 + ,2 + ,18 + ,10 + ,17 + ,11 + ,2 + ,2 + ,2 + ,12 + ,5 + ,14 + ,15 + ,1 + ,1 + ,2 + ,14 + ,8 + ,18 + ,7 + ,4 + ,3 + ,2 + ,16 + ,9 + ,14 + ,14 + ,4 + ,4 + ,2 + ,24 + ,20 + ,14 + ,10 + ,2 + ,2 + ,2 + ,11 + ,8 + ,12 + ,11 + ,4 + ,4 + ,2 + ,9 + ,6 + ,11 + ,13 + ,4 + ,4 + ,2 + ,17 + ,8 + ,14 + ,14 + ,3 + ,3 + ,2 + ,11 + ,10 + ,16 + ,14 + ,4 + ,3 + ,2 + ,11 + ,8 + ,17 + ,11 + ,4 + ,3 + ,2 + ,10 + ,6 + ,14 + ,13 + ,4 + ,4 + ,2 + ,12 + ,8 + ,14 + ,13 + ,4 + ,4 + ,2 + ,10 + ,8 + ,12 + ,12 + ,4 + ,4 + ,2 + ,10 + ,8 + ,12 + ,12 + ,5 + ,4 + ,2 + ,13 + ,8 + ,11 + ,18 + ,3 + ,4 + ,2 + ,14 + ,9 + ,15 + ,13 + ,7 + ,7 + ,2 + ,8 + ,7 + ,14 + ,14 + ,4 + ,4 + ,2 + ,11 + ,12 + ,10 + ,15 + ,4 + ,4 + ,2 + ,10 + ,8 + ,13 + ,11 + ,4 + ,4 + ,2 + ,7 + ,4 + ,15 + ,10 + ,4 + ,4 + ,2 + ,9 + ,6 + ,15 + ,12 + ,5 + ,6 + ,2 + ,11 + ,10 + ,16 + ,10 + ,4 + ,4 + ,2 + ,7 + ,5 + ,8 + ,20 + ,4 + ,4 + ,2 + ,15 + ,8 + ,9 + ,19 + ,5 + ,4 + ,2 + ,11 + ,8 + ,15 + ,11 + ,5 + ,8 + ,2 + ,13 + ,9 + ,11 + ,13 + ,4 + ,1 + ,2 + ,12 + ,6 + ,15 + ,9 + ,4 + ,4 + ,2 + ,11 + ,5 + ,16 + ,10 + ,7 + ,7 + ,2 + ,8 + ,4 + ,16 + ,12 + ,4 + ,3 + ,2 + ,12 + ,9 + ,15 + ,14 + ,2 + ,2 + ,2 + ,9 + ,5 + ,13 + ,11 + ,3 + ,5 + ,2 + ,12 + ,9 + ,15 + ,8 + ,5 + ,4 + ,2) + ,dim=c(7 + ,142) + ,dimnames=list(c('PE' + ,'PC' + ,'Ha' + ,'De' + ,'DM' + ,'DV' + ,'Geslacht') + ,1:142)) > y <- array(NA,dim=c(7,142),dimnames=list(c('PE','PC','Ha','De','DM','DV','Geslacht'),1:142)) > 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 = '3' > par2 = 'none' > par1 = '3' > #'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(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.numeric Loading required package: sandwich Loading required package: strucchange Loading required package: vcd Loading required package: MASS Loading required package: colorspace > library(Hmisc) 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] "Ha" > x[,par1] [1] 15 9 12 16 16 15 16 13 18 17 14 13 15 15 13 13 16 14 18 16 17 15 11 11 15 [26] 15 12 17 14 17 10 15 7 9 14 11 15 16 17 15 15 16 16 12 15 17 19 15 14 16 [51] 15 12 18 13 14 15 11 15 14 16 14 18 14 13 14 17 12 16 15 16 14 17 14 16 12 [76] 13 19 11 15 12 14 11 15 12 14 13 9 12 15 17 14 11 13 10 12 15 13 13 12 9 [101] 16 17 13 10 13 16 15 16 11 15 17 14 18 14 14 12 11 14 16 17 14 14 12 12 11 [126] 15 14 10 13 15 15 16 8 9 15 11 15 16 16 15 13 15 > 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]) 7 8 9 10 11 12 13 14 15 16 17 18 19 1 1 5 4 11 14 15 22 30 20 12 5 2 > colnames(x) [1] "PE" "PC" "Ha" "De" "DM" "DV" "Geslacht" > colnames(x)[par1] [1] "Ha" > x[,par1] [1] 15 9 12 16 16 15 16 13 18 17 14 13 15 15 13 13 16 14 18 16 17 15 11 11 15 [26] 15 12 17 14 17 10 15 7 9 14 11 15 16 17 15 15 16 16 12 15 17 19 15 14 16 [51] 15 12 18 13 14 15 11 15 14 16 14 18 14 13 14 17 12 16 15 16 14 17 14 16 12 [76] 13 19 11 15 12 14 11 15 12 14 13 9 12 15 17 14 11 13 10 12 15 13 13 12 9 [101] 16 17 13 10 13 16 15 16 11 15 17 14 18 14 14 12 11 14 16 17 14 14 12 12 11 [126] 15 14 10 13 15 15 16 8 9 15 11 15 16 16 15 13 15 > if (par2 == 'none') { + m <- ctree(as.formula(paste(colnames(x)[par1],' ~ .',sep='')),data = x) + } > > #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") > > 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/www/html/freestat/rcomp/tmp/1akmn1292355192.tab") + } + } > m Conditional inference tree with 2 terminal nodes Response: Ha Inputs: PE, PC, De, DM, DV, Geslacht Number of observations: 142 1) De <= 14; criterion = 1, statistic = 41.425 2)* weights = 110 1) De > 14 3)* weights = 32 > postscript(file="/var/www/html/freestat/rcomp/tmp/2lb3q1292355192.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/www/html/freestat/rcomp/tmp/3lb3q1292355192.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 15 14.65455 0.3454545 2 9 11.93750 -2.9375000 3 12 11.93750 0.0625000 4 16 14.65455 1.3454545 5 16 14.65455 1.3454545 6 15 14.65455 0.3454545 7 16 14.65455 1.3454545 8 13 11.93750 1.0625000 9 18 14.65455 3.3454545 10 17 11.93750 5.0625000 11 14 11.93750 2.0625000 12 13 14.65455 -1.6545455 13 15 14.65455 0.3454545 14 15 11.93750 3.0625000 15 13 11.93750 1.0625000 16 13 14.65455 -1.6545455 17 16 14.65455 1.3454545 18 14 14.65455 -0.6545455 19 18 14.65455 3.3454545 20 16 14.65455 1.3454545 21 17 14.65455 2.3454545 22 15 14.65455 0.3454545 23 11 14.65455 -3.6545455 24 11 14.65455 -3.6545455 25 15 14.65455 0.3454545 26 15 14.65455 0.3454545 27 12 11.93750 0.0625000 28 17 14.65455 2.3454545 29 14 11.93750 2.0625000 30 17 14.65455 2.3454545 31 10 11.93750 -1.9375000 32 15 14.65455 0.3454545 33 7 11.93750 -4.9375000 34 9 14.65455 -5.6545455 35 14 14.65455 -0.6545455 36 11 11.93750 -0.9375000 37 15 14.65455 0.3454545 38 16 14.65455 1.3454545 39 17 14.65455 2.3454545 40 15 14.65455 0.3454545 41 15 14.65455 0.3454545 42 16 14.65455 1.3454545 43 16 14.65455 1.3454545 44 12 14.65455 -2.6545455 45 15 14.65455 0.3454545 46 17 14.65455 2.3454545 47 19 14.65455 4.3454545 48 15 14.65455 0.3454545 49 14 14.65455 -0.6545455 50 16 11.93750 4.0625000 51 15 14.65455 0.3454545 52 12 14.65455 -2.6545455 53 18 14.65455 3.3454545 54 13 14.65455 -1.6545455 55 14 14.65455 -0.6545455 56 15 14.65455 0.3454545 57 11 14.65455 -3.6545455 58 15 14.65455 0.3454545 59 14 11.93750 2.0625000 60 16 14.65455 1.3454545 61 14 11.93750 2.0625000 62 18 14.65455 3.3454545 63 14 14.65455 -0.6545455 64 13 11.93750 1.0625000 65 14 14.65455 -0.6545455 66 17 14.65455 2.3454545 67 12 14.65455 -2.6545455 68 16 14.65455 1.3454545 69 15 14.65455 0.3454545 70 16 14.65455 1.3454545 71 14 14.65455 -0.6545455 72 17 14.65455 2.3454545 73 14 14.65455 -0.6545455 74 16 11.93750 4.0625000 75 12 14.65455 -2.6545455 76 13 11.93750 1.0625000 77 19 14.65455 4.3454545 78 11 11.93750 -0.9375000 79 15 14.65455 0.3454545 80 12 11.93750 0.0625000 81 14 14.65455 -0.6545455 82 11 11.93750 -0.9375000 83 15 14.65455 0.3454545 84 12 11.93750 0.0625000 85 14 14.65455 -0.6545455 86 13 14.65455 -1.6545455 87 9 11.93750 -2.9375000 88 12 11.93750 0.0625000 89 15 14.65455 0.3454545 90 17 14.65455 2.3454545 91 14 14.65455 -0.6545455 92 11 11.93750 -0.9375000 93 13 14.65455 -1.6545455 94 10 14.65455 -4.6545455 95 12 14.65455 -2.6545455 96 15 14.65455 0.3454545 97 13 14.65455 -1.6545455 98 13 14.65455 -1.6545455 99 12 14.65455 -2.6545455 100 9 11.93750 -2.9375000 101 16 14.65455 1.3454545 102 17 14.65455 2.3454545 103 13 14.65455 -1.6545455 104 10 11.93750 -1.9375000 105 13 14.65455 -1.6545455 106 16 14.65455 1.3454545 107 15 14.65455 0.3454545 108 16 14.65455 1.3454545 109 11 14.65455 -3.6545455 110 15 14.65455 0.3454545 111 17 14.65455 2.3454545 112 14 11.93750 2.0625000 113 18 14.65455 3.3454545 114 14 14.65455 -0.6545455 115 14 14.65455 -0.6545455 116 12 14.65455 -2.6545455 117 11 14.65455 -3.6545455 118 14 14.65455 -0.6545455 119 16 14.65455 1.3454545 120 17 14.65455 2.3454545 121 14 14.65455 -0.6545455 122 14 14.65455 -0.6545455 123 12 14.65455 -2.6545455 124 12 14.65455 -2.6545455 125 11 11.93750 -0.9375000 126 15 14.65455 0.3454545 127 14 14.65455 -0.6545455 128 10 11.93750 -1.9375000 129 13 14.65455 -1.6545455 130 15 14.65455 0.3454545 131 15 14.65455 0.3454545 132 16 14.65455 1.3454545 133 8 11.93750 -3.9375000 134 9 11.93750 -2.9375000 135 15 14.65455 0.3454545 136 11 14.65455 -3.6545455 137 15 14.65455 0.3454545 138 16 14.65455 1.3454545 139 16 14.65455 1.3454545 140 15 14.65455 0.3454545 141 13 14.65455 -1.6545455 142 15 14.65455 0.3454545 > if (par2 != 'none') { + print(cbind(as.factor(x[,par1]),predict(m))) + myt <- table(as.factor(x[,par1]),predict(m)) + print(myt) + } > postscript(file="/var/www/html/freestat/rcomp/tmp/4e33b1292355192.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/www/html/freestat/rcomp/tmp/5sci11292355192.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/www/html/freestat/rcomp/tmp/6k3z41292355192.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/www/html/freestat/rcomp/tmp/7o4gs1292355192.tab") + } > > try(system("convert tmp/2lb3q1292355192.ps tmp/2lb3q1292355192.png",intern=TRUE)) character(0) > try(system("convert tmp/3lb3q1292355192.ps tmp/3lb3q1292355192.png",intern=TRUE)) character(0) > try(system("convert tmp/4e33b1292355192.ps tmp/4e33b1292355192.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 4.236 0.746 4.484