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(12 + ,18 + ,9 + ,51 + ,15 + ,15 + ,11 + ,9 + ,42 + ,14 + ,12 + ,16 + ,8 + ,46 + ,10 + ,15 + ,15 + ,15 + ,47 + ,18 + ,9 + ,19 + ,11 + ,33 + ,11 + ,11 + ,18 + ,8 + ,47 + ,12 + ,11 + ,14 + ,9 + ,32 + ,15 + ,15 + ,18 + ,6 + ,53 + ,17 + ,11 + ,14 + ,11 + ,33 + ,7 + ,10 + ,12 + ,16 + ,37 + ,18 + ,11 + ,16 + ,7 + ,49 + ,18 + ,11 + ,9 + ,15 + ,43 + ,11 + ,14 + ,17 + ,10 + ,43 + ,12 + ,13 + ,17 + ,6 + ,46 + ,11 + ,16 + ,12 + ,12 + ,42 + ,16 + ,13 + ,11 + ,14 + ,40 + ,14 + ,14 + ,17 + ,9 + ,42 + ,13 + ,9 + ,16 + ,14 + ,44 + ,17 + ,12 + ,12 + ,14 + ,46 + ,13 + ,13 + ,16 + ,8 + ,45 + ,12 + ,16 + ,14 + ,10 + ,49 + ,12 + ,15 + ,12 + ,9 + ,43 + ,9 + ,5 + ,14 + ,11 + ,37 + ,18 + ,11 + ,15 + ,9 + ,45 + ,14 + ,17 + ,11 + ,10 + ,45 + ,12 + ,9 + ,14 + ,8 + ,31 + ,12 + ,13 + ,15 + ,14 + ,33 + ,9 + ,10 + ,16 + ,10 + ,44 + ,12 + ,12 + ,15 + ,14 + ,38 + ,11 + ,11 + ,16 + ,15 + ,33 + ,13 + ,16 + ,9 + ,11 + ,47 + ,13 + ,15 + ,15 + ,8 + ,48 + ,6 + ,14 + ,17 + ,10 + ,54 + ,21 + ,16 + ,17 + ,10 + ,43 + ,11 + ,9 + ,15 + ,9 + ,54 + ,9 + ,14 + ,13 + ,13 + ,44 + ,18 + ,15 + ,15 + ,10 + ,45 + ,15 + ,15 + ,15 + ,11 + ,44 + ,11 + ,13 + ,14 + ,10 + ,47 + ,14 + ,12 + ,7 + ,16 + ,43 + ,12 + ,12 + ,13 + ,6 + ,33 + ,8 + ,12 + ,15 + ,11 + ,46 + ,11 + ,14 + ,13 + ,14 + ,47 + ,17 + ,6 + ,16 + ,9 + ,47 + ,16 + ,14 + ,12 + ,11 + ,43 + ,13 + ,12 + ,14 + ,12 + ,44 + ,13 + ,16 + ,15 + ,9 + ,47 + ,13 + ,14 + ,15 + ,14 + ,47 + ,15 + ,10 + ,17 + ,8 + ,46 + ,12 + ,16 + ,16 + ,10 + ,47 + ,12 + ,15 + ,14 + ,8 + ,46 + ,15 + ,10 + ,16 + ,11 + ,36 + ,21 + ,8 + ,10 + ,14 + ,30 + ,24 + ,13 + ,15 + ,10 + ,49 + ,15 + ,16 + ,13 + ,9 + ,55 + ,17 + ,11 + ,16 + ,8 + ,52 + ,16 + ,14 + ,18 + ,8 + ,47 + ,15 + ,9 + ,14 + ,16 + ,33 + ,11 + ,14 + ,14 + ,13 + ,44 + ,15 + ,8 + ,14 + ,13 + ,42 + ,12 + ,8 + ,14 + ,8 + ,55 + ,14 + ,11 + ,15 + ,9 + ,42 + ,12 + ,12 + ,14 + ,11 + ,46 + ,20 + ,14 + ,15 + ,9 + ,46 + ,17 + ,16 + ,12 + ,14 + ,33 + ,11 + ,16 + ,19 + ,7 + ,53 + ,11 + ,12 + ,15 + ,11 + ,44 + ,12 + ,12 + ,16 + ,9 + ,53 + ,15 + ,12 + ,17 + ,8 + ,44 + ,10 + ,11 + ,11 + ,14 + ,35 + ,14 + ,4 + ,15 + ,12 + ,40 + ,16 + ,16 + ,11 + ,12 + ,44 + ,18 + ,15 + ,15 + ,6 + ,46 + ,6 + ,10 + ,17 + ,16 + ,45 + ,16 + ,13 + ,14 + ,8 + ,53 + ,11 + ,12 + ,14 + ,12 + ,48 + ,10 + ,7 + ,16 + ,12 + ,55 + ,15 + ,19 + ,16 + ,9 + ,47 + ,14 + ,12 + ,14 + ,11 + ,43 + ,7 + ,12 + ,13 + ,13 + ,47 + ,12 + ,10 + ,13 + ,11 + ,47 + ,13 + ,16 + ,12 + ,12 + ,44 + ,14 + ,13 + ,11 + ,10 + ,42 + ,13 + ,16 + ,13 + ,13 + ,51 + ,12 + ,9 + ,15 + ,9 + ,54 + ,11 + ,12 + ,13 + ,8 + ,51 + ,13 + ,13 + ,15 + ,9 + ,42 + ,12 + ,10 + ,12 + ,14 + ,41 + ,10 + ,12 + ,17 + ,14 + ,49 + ,9 + ,11 + ,10 + ,14 + ,42 + ,11 + ,7 + ,18 + ,14 + ,41 + ,14 + ,11 + ,14 + ,8 + ,41 + ,24 + ,14 + ,16 + ,11 + ,43 + ,11 + ,6 + ,13 + ,13 + ,33 + ,14 + ,15 + ,14 + ,9 + ,42 + ,12 + ,12 + ,9 + ,16 + ,37 + ,5 + ,15 + ,13 + ,14 + ,42 + ,11 + ,9 + ,15 + ,12 + ,43 + ,10 + ,13 + ,16 + ,4 + ,33 + ,15 + ,12 + ,16 + ,13 + ,44 + ,8 + ,11 + ,17 + ,14 + ,52 + ,18 + ,16 + ,13 + ,10 + ,45 + ,10 + ,10 + ,12 + ,8 + ,36 + ,11 + ,14 + ,12 + ,9 + ,43 + ,12 + ,8 + ,8 + ,15 + ,32 + ,7 + ,16 + ,14 + ,9 + ,45 + ,16 + ,9 + ,13 + ,8 + ,45 + ,17 + ,6 + ,10 + ,11 + ,49 + ,9 + ,12 + ,11 + ,9 + ,44 + ,13 + ,8 + ,12 + ,12 + ,41 + ,10 + ,14 + ,14 + ,13 + ,44 + ,10 + ,8 + ,11 + ,9 + ,37 + ,13 + ,7 + ,15 + ,7 + ,40 + ,7 + ,16 + ,13 + ,10 + ,50 + ,13 + ,11 + ,15 + ,11 + ,47 + ,9 + ,13 + ,13 + ,8 + ,33 + ,9 + ,5 + ,10 + ,14 + ,33 + ,9 + ,11 + ,15 + ,16 + ,45 + ,14 + ,11 + ,16 + ,11 + ,43 + ,8 + ,7 + ,16 + ,9 + ,0 + ,11 + ,13 + ,15 + ,12 + ,46 + ,11 + ,12 + ,14 + ,20 + ,36 + ,8 + ,9 + ,11 + ,11 + ,42 + ,11 + ,10 + ,9 + ,10 + ,41 + ,15 + ,12 + ,15 + ,7 + ,46 + ,12 + ,8 + ,17 + ,8 + ,48 + ,11 + ,11 + ,15 + ,14 + ,45 + ,12 + ,14 + ,14 + ,16 + ,11 + ,12 + ,4 + ,11 + ,12 + ,33 + ,13 + ,15 + ,15 + ,8 + ,47 + ,12 + ,14 + ,13 + ,11 + ,42 + ,9 + ,14 + ,17 + ,10 + ,55 + ,11 + ,8 + ,9 + ,14 + ,40 + ,8 + ,16 + ,15 + ,10 + ,46 + ,12 + ,15 + ,12 + ,13 + ,45 + ,20 + ,14 + ,15 + ,11 + ,46 + ,16 + ,12 + ,11 + ,16 + ,38 + ,9 + ,8 + ,14 + ,10 + ,40 + ,12 + ,8 + ,14 + ,11 + ,42 + ,17 + ,10 + ,16 + ,9 + ,53 + ,11 + ,14 + ,16 + ,11 + ,43 + ,11 + ,14 + ,13 + ,14 + ,41 + ,15 + ,14 + ,16 + ,14 + ,51 + ,11) + ,dim=c(5 + ,143) + ,dimnames=list(c('popularity' + ,'hapiness' + ,'doubsaboutactions' + ,'belonging' + ,'parentalexpectations') + ,1:143)) > y <- array(NA,dim=c(5,143),dimnames=list(c('popularity','hapiness','doubsaboutactions','belonging','parentalexpectations'),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 = '' > par2 = 'none' > par1 = '4' > #'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] "belonging" > x[,par1] [1] 51 42 46 47 33 47 32 53 33 37 49 43 43 46 42 40 42 44 46 45 49 43 37 45 45 [26] 31 33 44 38 33 47 48 54 43 54 44 45 44 47 43 33 46 47 47 43 44 47 47 46 47 [51] 46 36 30 49 55 52 47 33 44 42 55 42 46 46 33 53 44 53 44 35 40 44 46 45 53 [76] 48 55 47 43 47 47 44 42 51 54 51 42 41 49 42 41 41 43 33 42 37 42 43 33 44 [101] 52 45 36 43 32 45 45 49 44 41 44 37 40 50 47 33 33 45 43 0 46 36 42 41 46 [126] 48 45 11 33 47 42 55 40 46 45 46 38 40 42 53 43 41 51 > 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]) 0 11 30 31 32 33 35 36 37 38 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 1 1 1 1 2 12 1 3 4 2 5 6 13 12 13 11 13 15 3 5 1 4 2 5 3 4 > colnames(x) [1] "popularity" "hapiness" "doubsaboutactions" [4] "belonging" "parentalexpectations" > colnames(x)[par1] [1] "belonging" > x[,par1] [1] 51 42 46 47 33 47 32 53 33 37 49 43 43 46 42 40 42 44 46 45 49 43 37 45 45 [26] 31 33 44 38 33 47 48 54 43 54 44 45 44 47 43 33 46 47 47 43 44 47 47 46 47 [51] 46 36 30 49 55 52 47 33 44 42 55 42 46 46 33 53 44 53 44 35 40 44 46 45 53 [76] 48 55 47 43 47 47 44 42 51 54 51 42 41 49 42 41 41 43 33 42 37 42 43 33 44 [101] 52 45 36 43 32 45 45 49 44 41 44 37 40 50 47 33 33 45 43 0 46 36 42 41 46 [126] 48 45 11 33 47 42 55 40 46 45 46 38 40 42 53 43 41 51 > 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/1x2jl1292440643.tab") + } + } > m Conditional inference tree with 5 terminal nodes Response: belonging Inputs: popularity, hapiness, doubsaboutactions, parentalexpectations Number of observations: 143 1) popularity <= 8; criterion = 0.997, statistic = 11.612 2)* weights = 21 1) popularity > 8 3) doubsaboutactions <= 15; criterion = 0.995, statistic = 10.269 4) hapiness <= 14; criterion = 0.974, statistic = 7.384 5) popularity <= 11; criterion = 0.969, statistic = 7.055 6)* weights = 13 5) popularity > 11 7)* weights = 40 4) hapiness > 14 8)* weights = 60 3) doubsaboutactions > 15 9)* weights = 9 > postscript(file="/var/www/html/freestat/rcomp/tmp/2x2jl1292440643.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/3x2jl1292440643.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 51 45.78333 5.2166667 2 42 44.37500 -2.3750000 3 46 45.78333 0.2166667 4 47 45.78333 1.2166667 5 33 45.78333 -12.7833333 6 47 45.78333 1.2166667 7 32 39.15385 -7.1538462 8 53 45.78333 7.2166667 9 33 39.15385 -6.1538462 10 37 36.11111 0.8888889 11 49 45.78333 3.2166667 12 43 39.15385 3.8461538 13 43 45.78333 -2.7833333 14 46 45.78333 0.2166667 15 42 44.37500 -2.3750000 16 40 44.37500 -4.3750000 17 42 45.78333 -3.7833333 18 44 45.78333 -1.7833333 19 46 44.37500 1.6250000 20 45 45.78333 -0.7833333 21 49 44.37500 4.6250000 22 43 44.37500 -1.3750000 23 37 38.80952 -1.8095238 24 45 45.78333 -0.7833333 25 45 44.37500 0.6250000 26 31 39.15385 -8.1538462 27 33 45.78333 -12.7833333 28 44 45.78333 -1.7833333 29 38 45.78333 -7.7833333 30 33 45.78333 -12.7833333 31 47 44.37500 2.6250000 32 48 45.78333 2.2166667 33 54 45.78333 8.2166667 34 43 45.78333 -2.7833333 35 54 45.78333 8.2166667 36 44 44.37500 -0.3750000 37 45 45.78333 -0.7833333 38 44 45.78333 -1.7833333 39 47 44.37500 2.6250000 40 43 36.11111 6.8888889 41 33 44.37500 -11.3750000 42 46 45.78333 0.2166667 43 47 44.37500 2.6250000 44 47 38.80952 8.1904762 45 43 44.37500 -1.3750000 46 44 44.37500 -0.3750000 47 47 45.78333 1.2166667 48 47 45.78333 1.2166667 49 46 45.78333 0.2166667 50 47 45.78333 1.2166667 51 46 44.37500 1.6250000 52 36 45.78333 -9.7833333 53 30 38.80952 -8.8095238 54 49 45.78333 3.2166667 55 55 44.37500 10.6250000 56 52 45.78333 6.2166667 57 47 45.78333 1.2166667 58 33 36.11111 -3.1111111 59 44 44.37500 -0.3750000 60 42 38.80952 3.1904762 61 55 38.80952 16.1904762 62 42 45.78333 -3.7833333 63 46 44.37500 1.6250000 64 46 45.78333 0.2166667 65 33 44.37500 -11.3750000 66 53 45.78333 7.2166667 67 44 45.78333 -1.7833333 68 53 45.78333 7.2166667 69 44 45.78333 -1.7833333 70 35 39.15385 -4.1538462 71 40 38.80952 1.1904762 72 44 44.37500 -0.3750000 73 46 45.78333 0.2166667 74 45 36.11111 8.8888889 75 53 44.37500 8.6250000 76 48 44.37500 3.6250000 77 55 38.80952 16.1904762 78 47 45.78333 1.2166667 79 43 44.37500 -1.3750000 80 47 44.37500 2.6250000 81 47 39.15385 7.8461538 82 44 44.37500 -0.3750000 83 42 44.37500 -2.3750000 84 51 44.37500 6.6250000 85 54 45.78333 8.2166667 86 51 44.37500 6.6250000 87 42 45.78333 -3.7833333 88 41 39.15385 1.8461538 89 49 45.78333 3.2166667 90 42 39.15385 2.8461538 91 41 38.80952 2.1904762 92 41 39.15385 1.8461538 93 43 45.78333 -2.7833333 94 33 38.80952 -5.8095238 95 42 44.37500 -2.3750000 96 37 36.11111 0.8888889 97 42 44.37500 -2.3750000 98 43 45.78333 -2.7833333 99 33 45.78333 -12.7833333 100 44 45.78333 -1.7833333 101 52 45.78333 6.2166667 102 45 44.37500 0.6250000 103 36 39.15385 -3.1538462 104 43 44.37500 -1.3750000 105 32 38.80952 -6.8095238 106 45 44.37500 0.6250000 107 45 39.15385 5.8461538 108 49 38.80952 10.1904762 109 44 44.37500 -0.3750000 110 41 38.80952 2.1904762 111 44 44.37500 -0.3750000 112 37 38.80952 -1.8095238 113 40 38.80952 1.1904762 114 50 44.37500 5.6250000 115 47 45.78333 1.2166667 116 33 44.37500 -11.3750000 117 33 38.80952 -5.8095238 118 45 36.11111 8.8888889 119 43 45.78333 -2.7833333 120 0 38.80952 -38.8095238 121 46 45.78333 0.2166667 122 36 36.11111 -0.1111111 123 42 39.15385 2.8461538 124 41 39.15385 1.8461538 125 46 45.78333 0.2166667 126 48 38.80952 9.1904762 127 45 45.78333 -0.7833333 128 11 36.11111 -25.1111111 129 33 38.80952 -5.8095238 130 47 45.78333 1.2166667 131 42 44.37500 -2.3750000 132 55 45.78333 9.2166667 133 40 38.80952 1.1904762 134 46 45.78333 0.2166667 135 45 44.37500 0.6250000 136 46 45.78333 0.2166667 137 38 36.11111 1.8888889 138 40 38.80952 1.1904762 139 42 38.80952 3.1904762 140 53 45.78333 7.2166667 141 43 45.78333 -2.7833333 142 41 44.37500 -3.3750000 143 51 45.78333 5.2166667 > 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/48bio1292440643.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/54lyf1292440643.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/6plel1292440643.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/7iveo1292440643.tab") + } > > try(system("convert tmp/2x2jl1292440643.ps tmp/2x2jl1292440643.png",intern=TRUE)) character(0) > try(system("convert tmp/3x2jl1292440643.ps tmp/3x2jl1292440643.png",intern=TRUE)) character(0) > try(system("convert tmp/48bio1292440643.ps tmp/48bio1292440643.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 4.393 0.782 4.555