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(14 + ,11 + ,11 + ,26 + ,9 + ,2 + ,1 + ,1 + ,18 + ,12 + ,8 + ,20 + ,9 + ,1 + ,1 + ,1 + ,11 + ,15 + ,12 + ,21 + ,9 + ,4 + ,1 + ,1 + ,12 + ,10 + ,10 + ,31 + ,14 + ,1 + ,1 + ,2 + ,16 + ,12 + ,7 + ,21 + ,8 + ,5 + ,2 + ,1 + ,18 + ,11 + ,6 + ,18 + ,8 + ,1 + ,1 + ,1 + ,14 + ,5 + ,8 + ,26 + ,11 + ,1 + ,1 + ,1 + ,14 + ,16 + ,16 + ,22 + ,10 + ,1 + ,1 + ,1 + ,15 + ,11 + ,8 + ,22 + ,9 + ,1 + ,1 + ,1 + ,15 + ,15 + ,16 + ,29 + ,15 + ,1 + ,1 + ,1 + ,17 + ,12 + ,7 + ,15 + ,14 + ,2 + ,1 + ,2 + ,19 + ,9 + ,11 + ,16 + ,11 + ,1 + ,1 + ,1 + ,10 + ,11 + ,16 + ,24 + ,14 + ,3 + ,2 + ,2 + ,18 + ,15 + ,16 + ,17 + ,6 + ,1 + ,1 + ,1 + ,14 + ,12 + ,12 + ,19 + ,20 + ,1 + ,1 + ,2 + ,14 + ,16 + ,13 + ,22 + ,9 + ,1 + ,1 + ,2 + ,17 + ,14 + ,19 + ,31 + ,10 + ,1 + ,1 + ,1 + ,14 + ,11 + ,7 + ,28 + ,8 + ,1 + ,1 + ,2 + ,16 + ,10 + ,8 + ,38 + ,11 + ,2 + ,1 + ,1 + ,18 + ,7 + ,12 + ,26 + ,14 + ,4 + ,2 + ,2 + ,14 + ,11 + ,13 + ,25 + ,11 + ,1 + ,1 + ,1 + ,12 + ,10 + ,11 + ,25 + ,16 + ,2 + ,1 + ,1 + ,17 + ,11 + ,8 + ,29 + ,14 + ,1 + ,1 + ,2 + ,9 + ,16 + ,16 + ,28 + ,11 + ,2 + ,4 + ,1 + ,16 + ,14 + ,15 + ,15 + ,11 + ,3 + ,1 + ,2 + ,14 + ,12 + ,11 + ,18 + ,12 + ,1 + ,1 + ,1 + ,11 + ,12 + ,12 + ,21 + ,9 + ,1 + ,2 + ,2 + ,16 + ,11 + ,7 + ,25 + ,7 + ,1 + ,2 + ,1 + ,13 + ,6 + ,9 + ,23 + ,13 + ,1 + ,1 + ,2 + ,17 + ,14 + ,15 + ,23 + ,10 + ,1 + ,1 + ,1 + ,15 + ,9 + ,6 + ,19 + ,9 + ,2 + ,1 + ,1 + ,14 + ,15 + ,14 + ,18 + ,9 + ,1 + ,1 + ,2 + ,16 + ,12 + ,14 + ,18 + ,13 + ,1 + ,1 + ,2 + ,9 + ,12 + ,7 + ,26 + ,16 + ,1 + ,1 + ,2 + ,15 + ,9 + ,15 + ,18 + ,12 + ,1 + ,1 + ,2 + ,17 + ,13 + ,14 + ,18 + ,6 + ,1 + ,1 + ,1 + ,13 + ,15 + ,17 + ,28 + ,14 + ,1 + ,1 + ,2 + ,15 + ,11 + ,14 + ,17 + ,14 + ,1 + ,1 + ,2 + ,16 + ,10 + ,5 + ,29 + ,10 + ,2 + ,2 + ,1 + ,16 + ,13 + ,14 + ,12 + ,4 + ,1 + ,1 + ,2 + ,12 + ,16 + ,8 + ,28 + ,12 + ,1 + ,1 + ,1 + ,11 + ,13 + ,8 + ,20 + ,14 + ,1 + ,1 + ,1 + ,15 + ,14 + ,13 + ,17 + ,9 + ,2 + ,1 + ,1 + ,17 + ,14 + ,14 + ,17 + ,9 + ,1 + ,1 + ,1 + ,13 + ,16 + ,16 + ,20 + ,10 + ,1 + ,1 + ,2 + ,16 + ,9 + ,11 + ,31 + ,14 + ,1 + ,1 + ,1 + ,14 + ,8 + ,10 + ,21 + ,10 + ,1 + ,1 + ,2 + ,11 + ,8 + ,10 + ,19 + ,9 + ,1 + ,1 + ,2 + ,12 + ,12 + ,10 + ,23 + ,14 + ,1 + ,1 + ,1 + ,12 + ,10 + ,8 + ,15 + ,8 + ,4 + ,1 + ,2 + ,15 + ,16 + ,14 + ,24 + ,9 + ,2 + ,1 + ,1 + ,16 + ,13 + ,14 + ,28 + ,8 + ,1 + ,1 + ,1 + ,15 + ,11 + ,12 + ,16 + ,9 + ,1 + ,1 + ,1 + ,12 + ,14 + ,13 + ,19 + ,9 + ,4 + ,3 + ,2 + ,12 + ,15 + ,5 + ,21 + ,9 + ,2 + ,2 + ,1 + ,8 + ,8 + ,10 + ,21 + ,15 + ,1 + ,1 + ,2 + ,13 + ,9 + ,6 + ,20 + ,8 + ,1 + ,1 + ,2 + ,11 + ,17 + ,15 + ,16 + ,10 + ,1 + ,1 + ,1 + ,14 + ,9 + ,12 + ,25 + ,8 + ,1 + ,1 + ,1 + ,15 + ,13 + ,16 + ,30 + ,14 + ,1 + ,1 + ,1 + ,10 + ,6 + ,15 + ,29 + ,11 + ,1 + ,1 + ,2 + ,11 + ,13 + ,12 + ,22 + ,10 + ,2 + ,1 + ,1 + ,12 + ,8 + ,8 + ,19 + ,12 + ,1 + ,1 + ,2 + ,15 + ,12 + ,14 + ,33 + ,14 + ,1 + ,1 + ,1 + ,15 + ,13 + ,14 + ,17 + ,9 + ,2 + ,1 + ,2 + ,14 + ,14 + ,13 + ,9 + ,13 + ,1 + ,1 + ,2 + ,16 + ,11 + ,12 + ,14 + ,15 + ,2 + ,2 + ,1 + ,15 + ,15 + ,15 + ,15 + ,8 + ,2 + ,1 + ,1 + ,15 + ,7 + ,8 + ,12 + ,7 + ,4 + ,1 + ,2 + ,13 + ,16 + ,16 + ,21 + ,10 + ,1 + ,1 + ,2 + ,17 + ,16 + ,14 + ,20 + ,10 + ,1 + ,1 + ,1 + ,13 + ,14 + ,13 + ,29 + ,13 + ,3 + ,2 + ,1 + ,15 + ,11 + ,15 + ,33 + ,11 + ,1 + ,1 + ,2 + ,13 + ,13 + ,7 + ,21 + ,8 + ,1 + ,1 + ,2 + ,15 + ,13 + ,5 + ,15 + ,12 + ,1 + ,1 + ,2 + ,16 + ,7 + ,7 + ,19 + ,9 + ,1 + ,1 + ,2 + ,15 + ,15 + ,13 + ,23 + ,10 + ,1 + ,1 + ,1 + ,16 + ,11 + ,14 + ,20 + ,11 + ,1 + ,1 + ,2 + ,15 + ,15 + ,14 + ,20 + ,11 + ,1 + ,1 + ,1 + ,14 + ,13 + ,13 + ,18 + ,10 + ,1 + ,1 + ,1 + ,15 + ,11 + ,11 + ,31 + ,16 + ,4 + ,1 + ,2 + ,7 + ,12 + ,15 + ,18 + ,16 + ,1 + ,1 + ,1 + ,17 + ,10 + ,13 + ,13 + ,8 + ,1 + ,1 + ,1 + ,13 + ,12 + ,14 + ,9 + ,6 + ,2 + ,1 + ,1 + ,15 + ,12 + ,13 + ,20 + ,11 + ,1 + ,1 + ,1 + ,14 + ,12 + ,9 + ,18 + ,12 + ,1 + ,1 + ,1 + ,13 + ,14 + ,8 + ,23 + ,14 + ,1 + ,2 + ,1 + ,16 + ,6 + ,6 + ,17 + ,9 + ,1 + ,1 + ,1 + ,12 + ,14 + ,13 + ,17 + ,11 + ,1 + ,1 + ,1 + ,14 + ,15 + ,16 + ,16 + ,8 + ,1 + ,1 + ,1 + ,17 + ,8 + ,7 + ,31 + ,8 + ,1 + ,1 + ,2 + ,15 + ,12 + ,11 + ,15 + ,7 + ,1 + ,1 + ,2 + ,17 + ,10 + ,8 + ,28 + ,16 + ,1 + ,1 + ,1 + ,12 + ,15 + ,13 + ,26 + ,13 + ,1 + ,1 + ,2 + ,16 + ,11 + ,5 + ,20 + ,8 + ,1 + ,2 + ,1 + ,11 + ,9 + ,8 + ,19 + ,11 + ,1 + ,2 + ,2 + ,15 + ,14 + ,10 + ,25 + ,14 + ,5 + ,1 + ,1 + ,9 + ,10 + ,9 + ,18 + ,10 + ,1 + ,1 + ,2 + ,16 + ,16 + ,16 + ,20 + ,10 + ,1 + ,1 + ,1 + ,10 + ,5 + ,4 + ,33 + ,14 + ,1 + ,1 + ,2 + ,10 + ,8 + ,4 + ,24 + ,14 + ,3 + ,3 + ,1 + ,15 + ,13 + ,11 + ,22 + ,10 + ,1 + ,1 + ,1 + ,11 + ,16 + ,14 + ,32 + ,12 + ,1 + ,1 + ,1 + ,13 + ,16 + ,15 + ,31 + ,9 + ,1 + ,1 + ,1 + ,14 + ,14 + ,17 + ,13 + ,16 + ,1 + ,1 + ,2 + ,18 + ,14 + ,10 + ,18 + ,8 + ,1 + ,1 + ,1 + ,16 + ,10 + ,15 + ,17 + ,9 + ,1 + ,1 + ,2 + ,14 + ,9 + ,11 + ,29 + ,16 + ,1 + ,1 + ,1 + ,14 + ,14 + ,15 + ,22 + ,13 + ,2 + ,1 + ,1 + ,14 + ,8 + ,10 + ,18 + ,13 + ,4 + ,1 + ,1 + ,14 + ,8 + ,9 + ,22 + ,8 + ,4 + ,3 + ,1 + ,12 + ,16 + ,14 + ,25 + ,14 + ,1 + ,1 + ,1 + ,14 + ,12 + ,15 + ,20 + ,11 + ,1 + ,1 + ,1 + ,15 + ,9 + ,9 + ,20 + ,9 + ,1 + ,1 + ,1 + ,15 + ,15 + ,12 + ,17 + ,8 + ,4 + ,3 + ,1 + ,13 + ,12 + ,10 + ,26 + ,13 + ,2 + ,3 + ,1 + ,17 + ,14 + ,16 + ,10 + ,10 + ,1 + ,1 + ,2 + ,17 + ,12 + ,15 + ,15 + ,8 + ,1 + ,2 + ,1 + ,19 + ,16 + ,14 + ,20 + ,7 + ,1 + ,1 + ,1 + ,15 + ,12 + ,12 + ,14 + ,11 + ,1 + ,1 + ,1 + ,13 + ,14 + ,15 + ,16 + ,11 + ,1 + ,1 + ,2 + ,9 + ,8 + ,9 + ,23 + ,14 + ,1 + ,2 + ,2 + ,15 + ,15 + ,12 + ,11 + ,6 + ,2 + ,2 + ,1 + ,15 + ,16 + ,15 + ,19 + ,10 + ,4 + ,1 + ,2 + ,16 + ,12 + ,6 + ,30 + ,9 + ,4 + ,1 + ,1 + ,11 + ,4 + ,4 + ,21 + ,12 + ,1 + ,1 + ,2 + ,14 + ,8 + ,8 + ,20 + ,11 + ,1 + ,1 + ,2 + ,11 + ,11 + ,10 + ,22 + ,14 + ,1 + ,1 + ,1 + ,15 + ,4 + ,6 + ,30 + ,12 + ,2 + ,3 + ,1 + ,13 + ,14 + ,12 + ,25 + ,14 + ,1 + ,1 + ,2 + ,16 + ,14 + ,14 + ,23 + ,14 + ,1 + ,1 + ,2 + ,14 + ,13 + ,11 + ,23 + ,8 + ,3 + ,1 + ,1 + ,15 + ,14 + ,15 + ,21 + ,11 + ,2 + ,1 + ,2 + ,16 + ,7 + ,13 + ,30 + ,12 + ,2 + ,1 + ,1 + ,16 + ,19 + ,15 + ,22 + ,9 + ,1 + ,1 + ,1 + ,11 + ,12 + ,16 + ,32 + ,16 + ,1 + ,1 + ,2 + ,13 + ,10 + ,4 + ,22 + ,11 + ,2 + ,2 + ,1 + ,16 + ,14 + ,15 + ,15 + ,11 + ,3 + ,1 + ,2 + ,12 + ,16 + ,12 + ,21 + ,12 + ,1 + ,1 + ,1 + ,9 + ,11 + ,15 + ,27 + ,15 + ,1 + ,1 + ,1 + ,13 + ,16 + ,15 + ,22 + ,13 + ,1 + ,2 + ,1 + ,13 + ,12 + ,14 + ,9 + ,6 + ,2 + ,1 + ,1 + ,14 + ,12 + ,14 + ,29 + ,11 + ,2 + ,1 + ,1 + ,19 + ,16 + ,14 + ,20 + ,7 + ,1 + ,1 + ,1 + ,13 + ,12 + ,11 + ,16 + ,8 + ,1 + ,1 + ,1) + ,dim=c(8 + ,145) + ,dimnames=list(c('Happiness' + ,'Popularity' + ,'KnowingPeople' + ,'CMistakes' + ,'DAction' + ,'Tobacco' + ,'Drugs' + ,'Gender') + ,1:145)) > y <- array(NA,dim=c(8,145),dimnames=list(c('Happiness','Popularity','KnowingPeople','CMistakes','DAction','Tobacco','Drugs','Gender'),1:145)) > 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 = '' > par2 = 'none' > 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(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] "Happiness" > x[,par1] [1] 14 18 11 12 16 18 14 14 15 15 17 19 10 18 14 14 17 14 16 18 14 12 17 9 16 [26] 14 11 16 13 17 15 14 16 9 15 17 13 15 16 16 12 11 15 17 13 16 14 11 12 12 [51] 15 16 15 12 12 8 13 11 14 15 10 11 12 15 15 14 16 15 15 13 17 13 15 13 15 [76] 16 15 16 15 14 15 7 17 13 15 14 13 16 12 14 17 15 17 12 16 11 15 9 16 10 [101] 10 15 11 13 14 18 16 14 14 14 14 12 14 15 15 13 17 17 19 15 13 9 15 15 16 [126] 11 14 11 15 13 16 14 15 16 16 11 13 16 12 9 13 13 14 19 13 > 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 12 17 24 29 21 12 5 3 > colnames(x) [1] "Happiness" "Popularity" "KnowingPeople" "CMistakes" [5] "DAction" "Tobacco" "Drugs" "Gender" > colnames(x)[par1] [1] "Happiness" > x[,par1] [1] 14 18 11 12 16 18 14 14 15 15 17 19 10 18 14 14 17 14 16 18 14 12 17 9 16 [26] 14 11 16 13 17 15 14 16 9 15 17 13 15 16 16 12 11 15 17 13 16 14 11 12 12 [51] 15 16 15 12 12 8 13 11 14 15 10 11 12 15 15 14 16 15 15 13 17 13 15 13 15 [76] 16 15 16 15 14 15 7 17 13 15 14 13 16 12 14 17 15 17 12 16 11 15 9 16 10 [101] 10 15 11 13 14 18 16 14 14 14 14 12 14 15 15 13 17 17 19 15 13 9 15 15 16 [126] 11 14 11 15 13 16 14 15 16 16 11 13 16 12 9 13 13 14 19 13 > 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/1w8e31292707857.tab") + } + } > m Conditional inference tree with 2 terminal nodes Response: Happiness Inputs: Popularity, KnowingPeople, CMistakes, DAction, Tobacco, Drugs, Gender Number of observations: 145 1) DAction <= 11; criterion = 1, statistic = 18.241 2)* weights = 91 1) DAction > 11 3)* weights = 54 > postscript(file="/var/www/html/freestat/rcomp/tmp/2w8e31292707857.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/3w8e31292707857.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 14 14.65934 -0.6593407 2 18 14.65934 3.3406593 3 11 14.65934 -3.6593407 4 12 13.14815 -1.1481481 5 16 14.65934 1.3406593 6 18 14.65934 3.3406593 7 14 14.65934 -0.6593407 8 14 14.65934 -0.6593407 9 15 14.65934 0.3406593 10 15 13.14815 1.8518519 11 17 13.14815 3.8518519 12 19 14.65934 4.3406593 13 10 13.14815 -3.1481481 14 18 14.65934 3.3406593 15 14 13.14815 0.8518519 16 14 14.65934 -0.6593407 17 17 14.65934 2.3406593 18 14 14.65934 -0.6593407 19 16 14.65934 1.3406593 20 18 13.14815 4.8518519 21 14 14.65934 -0.6593407 22 12 13.14815 -1.1481481 23 17 13.14815 3.8518519 24 9 14.65934 -5.6593407 25 16 14.65934 1.3406593 26 14 13.14815 0.8518519 27 11 14.65934 -3.6593407 28 16 14.65934 1.3406593 29 13 13.14815 -0.1481481 30 17 14.65934 2.3406593 31 15 14.65934 0.3406593 32 14 14.65934 -0.6593407 33 16 13.14815 2.8518519 34 9 13.14815 -4.1481481 35 15 13.14815 1.8518519 36 17 14.65934 2.3406593 37 13 13.14815 -0.1481481 38 15 13.14815 1.8518519 39 16 14.65934 1.3406593 40 16 14.65934 1.3406593 41 12 13.14815 -1.1481481 42 11 13.14815 -2.1481481 43 15 14.65934 0.3406593 44 17 14.65934 2.3406593 45 13 14.65934 -1.6593407 46 16 13.14815 2.8518519 47 14 14.65934 -0.6593407 48 11 14.65934 -3.6593407 49 12 13.14815 -1.1481481 50 12 14.65934 -2.6593407 51 15 14.65934 0.3406593 52 16 14.65934 1.3406593 53 15 14.65934 0.3406593 54 12 14.65934 -2.6593407 55 12 14.65934 -2.6593407 56 8 13.14815 -5.1481481 57 13 14.65934 -1.6593407 58 11 14.65934 -3.6593407 59 14 14.65934 -0.6593407 60 15 13.14815 1.8518519 61 10 14.65934 -4.6593407 62 11 14.65934 -3.6593407 63 12 13.14815 -1.1481481 64 15 13.14815 1.8518519 65 15 14.65934 0.3406593 66 14 13.14815 0.8518519 67 16 13.14815 2.8518519 68 15 14.65934 0.3406593 69 15 14.65934 0.3406593 70 13 14.65934 -1.6593407 71 17 14.65934 2.3406593 72 13 13.14815 -0.1481481 73 15 14.65934 0.3406593 74 13 14.65934 -1.6593407 75 15 13.14815 1.8518519 76 16 14.65934 1.3406593 77 15 14.65934 0.3406593 78 16 14.65934 1.3406593 79 15 14.65934 0.3406593 80 14 14.65934 -0.6593407 81 15 13.14815 1.8518519 82 7 13.14815 -6.1481481 83 17 14.65934 2.3406593 84 13 14.65934 -1.6593407 85 15 14.65934 0.3406593 86 14 13.14815 0.8518519 87 13 13.14815 -0.1481481 88 16 14.65934 1.3406593 89 12 14.65934 -2.6593407 90 14 14.65934 -0.6593407 91 17 14.65934 2.3406593 92 15 14.65934 0.3406593 93 17 13.14815 3.8518519 94 12 13.14815 -1.1481481 95 16 14.65934 1.3406593 96 11 14.65934 -3.6593407 97 15 13.14815 1.8518519 98 9 14.65934 -5.6593407 99 16 14.65934 1.3406593 100 10 13.14815 -3.1481481 101 10 13.14815 -3.1481481 102 15 14.65934 0.3406593 103 11 13.14815 -2.1481481 104 13 14.65934 -1.6593407 105 14 13.14815 0.8518519 106 18 14.65934 3.3406593 107 16 14.65934 1.3406593 108 14 13.14815 0.8518519 109 14 13.14815 0.8518519 110 14 13.14815 0.8518519 111 14 14.65934 -0.6593407 112 12 13.14815 -1.1481481 113 14 14.65934 -0.6593407 114 15 14.65934 0.3406593 115 15 14.65934 0.3406593 116 13 13.14815 -0.1481481 117 17 14.65934 2.3406593 118 17 14.65934 2.3406593 119 19 14.65934 4.3406593 120 15 14.65934 0.3406593 121 13 14.65934 -1.6593407 122 9 13.14815 -4.1481481 123 15 14.65934 0.3406593 124 15 14.65934 0.3406593 125 16 14.65934 1.3406593 126 11 13.14815 -2.1481481 127 14 14.65934 -0.6593407 128 11 13.14815 -2.1481481 129 15 13.14815 1.8518519 130 13 13.14815 -0.1481481 131 16 13.14815 2.8518519 132 14 14.65934 -0.6593407 133 15 14.65934 0.3406593 134 16 13.14815 2.8518519 135 16 14.65934 1.3406593 136 11 13.14815 -2.1481481 137 13 14.65934 -1.6593407 138 16 14.65934 1.3406593 139 12 13.14815 -1.1481481 140 9 13.14815 -4.1481481 141 13 13.14815 -0.1481481 142 13 14.65934 -1.6593407 143 14 14.65934 -0.6593407 144 19 14.65934 4.3406593 145 13 14.65934 -1.6593407 > 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/47hd61292707857.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/53qtx1292707857.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/6wis01292707857.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/7hi861292707857.tab") + } > > try(system("convert tmp/2w8e31292707857.ps tmp/2w8e31292707857.png",intern=TRUE)) character(0) > try(system("convert tmp/3w8e31292707857.ps tmp/3w8e31292707857.png",intern=TRUE)) character(0) > try(system("convert tmp/47hd61292707857.ps tmp/47hd61292707857.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 4.561 0.743 5.753