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(1 + ,15 + ,10 + ,77 + ,5 + ,4 + ,15 + ,11 + ,12 + ,13 + ,6 + ,0 + ,12 + ,20 + ,63 + ,6 + ,4 + ,9 + ,12 + ,7 + ,11 + ,4 + ,0 + ,15 + ,16 + ,73 + ,4 + ,10 + ,12 + ,12 + ,13 + ,14 + ,6 + ,0 + ,12 + ,10 + ,76 + ,6 + ,6 + ,15 + ,11 + ,11 + ,12 + ,5 + ,0 + ,14 + ,8 + ,90 + ,3 + ,5 + ,17 + ,11 + ,16 + ,12 + ,5 + ,0 + ,8 + ,14 + ,67 + ,10 + ,8 + ,14 + ,10 + ,10 + ,6 + ,4 + ,1 + ,11 + ,19 + ,69 + ,8 + ,9 + ,9 + ,11 + ,15 + ,10 + ,5 + ,1 + ,15 + ,15 + ,70 + ,3 + ,6 + ,12 + ,9 + ,5 + ,11 + ,3 + ,0 + ,4 + ,23 + ,54 + ,4 + ,8 + ,11 + ,10 + ,4 + ,10 + ,2 + ,0 + ,13 + ,9 + ,54 + ,3 + ,11 + ,13 + ,12 + ,7 + ,12 + ,5 + ,1 + ,19 + ,12 + ,76 + ,5 + ,6 + ,16 + ,12 + ,15 + ,15 + ,6 + ,1 + ,10 + ,14 + ,75 + ,5 + ,8 + ,16 + ,12 + ,5 + ,13 + ,6 + ,1 + ,15 + ,13 + ,76 + ,6 + ,11 + ,15 + ,13 + ,16 + ,18 + ,8 + ,0 + ,6 + ,11 + ,80 + ,5 + ,5 + ,10 + ,9 + ,15 + ,11 + ,6 + ,1 + ,7 + ,11 + ,89 + ,3 + ,10 + ,16 + ,12 + ,13 + ,12 + ,3 + ,0 + ,14 + ,10 + ,73 + ,4 + ,7 + ,12 + ,12 + ,13 + ,13 + ,6 + ,0 + ,16 + ,12 + ,74 + ,8 + ,7 + ,15 + ,12 + ,15 + ,14 + ,6 + ,1 + ,16 + ,18 + ,78 + ,8 + ,13 + ,13 + ,12 + ,15 + ,16 + ,7 + ,1 + ,14 + ,12 + ,76 + ,8 + ,10 + ,18 + ,13 + ,10 + ,16 + ,8 + ,0 + ,15 + ,10 + ,69 + ,5 + ,8 + ,13 + ,11 + ,17 + ,16 + ,6 + ,1 + ,14 + ,15 + ,74 + ,8 + ,6 + ,17 + ,12 + ,14 + ,15 + ,7 + ,1 + ,12 + ,15 + ,82 + ,2 + ,8 + ,14 + ,12 + ,9 + ,13 + ,4 + ,0 + ,9 + ,12 + ,77 + ,0 + ,7 + ,13 + ,15 + ,6 + ,8 + ,4 + ,1 + ,12 + ,9 + ,84 + ,5 + ,5 + ,13 + ,11 + ,11 + ,14 + ,2 + ,1 + ,14 + ,11 + ,75 + ,2 + ,9 + ,15 + ,12 + ,13 + ,15 + ,6 + ,1 + ,12 + ,15 + ,54 + ,7 + ,9 + ,13 + ,10 + ,12 + ,13 + ,6 + ,1 + ,14 + ,16 + ,79 + ,5 + ,11 + ,15 + ,11 + ,10 + ,16 + ,6 + ,1 + ,10 + ,17 + ,79 + ,2 + ,11 + ,13 + ,13 + ,4 + ,13 + ,6 + ,1 + ,14 + ,12 + ,69 + ,12 + ,11 + ,14 + ,6 + ,13 + ,12 + ,6 + ,1 + ,16 + ,11 + ,88 + ,7 + ,9 + ,13 + ,12 + ,15 + ,15 + ,7 + ,1 + ,10 + ,13 + ,57 + ,0 + ,7 + ,16 + ,12 + ,8 + ,11 + ,4 + ,1 + ,8 + ,9 + ,69 + ,2 + ,6 + ,14 + ,10 + ,10 + ,14 + ,3 + ,1 + ,12 + ,11 + ,86 + ,3 + ,6 + ,18 + ,12 + ,8 + ,13 + ,5 + ,1 + ,11 + ,9 + ,65 + ,0 + ,6 + ,15 + ,12 + ,7 + ,13 + ,6 + ,0 + ,8 + ,20 + ,66 + ,9 + ,5 + ,9 + ,11 + ,9 + ,12 + ,4 + ,0 + ,13 + ,8 + ,54 + ,2 + ,4 + ,16 + ,9 + ,14 + ,14 + ,6 + ,1 + ,11 + ,12 + ,85 + ,3 + ,10 + ,16 + ,10 + ,5 + ,13 + ,3 + ,0 + ,12 + ,10 + ,79 + ,1 + ,8 + ,17 + ,12 + ,7 + ,12 + ,3 + ,0 + ,16 + ,11 + ,84 + ,10 + ,6 + ,13 + ,12 + ,16 + ,14 + ,6 + ,1 + ,16 + ,13 + ,70 + ,1 + ,5 + ,17 + ,11 + ,14 + ,15 + ,6 + ,1 + ,13 + ,13 + ,54 + ,4 + ,9 + ,15 + ,12 + ,16 + ,16 + ,6 + ,1 + ,14 + ,13 + ,70 + ,6 + ,10 + ,14 + ,11 + ,15 + ,15 + ,8 + ,0 + ,5 + ,15 + ,54 + ,6 + ,6 + ,10 + ,14 + ,4 + ,5 + ,2 + ,0 + ,14 + ,12 + ,69 + ,4 + ,9 + ,13 + ,10 + ,12 + ,15 + ,6 + ,1 + ,13 + ,13 + ,68 + ,4 + ,10 + ,11 + ,10 + ,8 + ,8 + ,4 + ,1 + ,16 + ,13 + ,68 + ,7 + ,6 + ,11 + ,11 + ,17 + ,16 + ,7 + ,0 + ,14 + ,9 + ,71 + ,7 + ,6 + ,16 + ,11 + ,15 + ,16 + ,6 + ,0 + ,15 + ,9 + ,71 + ,7 + ,6 + ,16 + ,11 + ,16 + ,14 + ,6 + ,1 + ,15 + ,14 + ,66 + ,0 + ,13 + ,11 + ,10 + ,12 + ,16 + ,6 + ,1 + ,11 + ,9 + ,67 + ,3 + ,8 + ,15 + ,10 + ,12 + ,14 + ,5 + ,1 + ,15 + ,9 + ,71 + ,8 + ,10 + ,15 + ,12 + ,13 + ,13 + ,6 + ,1 + ,16 + ,15 + ,54 + ,8 + ,5 + ,12 + ,11 + ,14 + ,14 + ,6 + ,1 + ,13 + ,10 + ,76 + ,10 + ,8 + ,17 + ,8 + ,14 + ,14 + ,5 + ,0 + ,11 + ,13 + ,77 + ,11 + ,6 + ,15 + ,12 + ,15 + ,12 + ,6 + ,0 + ,12 + ,8 + ,71 + ,6 + ,9 + ,16 + ,10 + ,14 + ,13 + ,7 + ,1 + ,12 + ,15 + ,69 + ,2 + ,9 + ,14 + ,7 + ,11 + ,15 + ,5 + ,1 + ,10 + ,13 + ,73 + ,6 + ,7 + ,17 + ,11 + ,13 + ,15 + ,6 + ,1 + ,8 + ,24 + ,46 + ,1 + ,20 + ,10 + ,7 + ,4 + ,13 + ,6 + ,0 + ,9 + ,11 + ,66 + ,5 + ,8 + ,11 + ,11 + ,8 + ,10 + ,4 + ,1 + ,12 + ,13 + ,77 + ,4 + ,8 + ,15 + ,8 + ,13 + ,13 + ,5 + ,0 + ,14 + ,12 + ,77 + ,6 + ,7 + ,15 + ,11 + ,15 + ,14 + ,6 + ,1 + ,12 + ,22 + ,70 + ,6 + ,7 + ,7 + ,12 + ,15 + ,13 + ,6 + ,0 + ,11 + ,11 + ,86 + ,4 + ,10 + ,17 + ,8 + ,8 + ,13 + ,4 + ,0 + ,14 + ,15 + ,38 + ,1 + ,5 + ,14 + ,14 + ,17 + ,18 + ,6 + ,0 + ,7 + ,7 + ,66 + ,6 + ,8 + ,18 + ,14 + ,12 + ,12 + ,4 + ,0 + ,16 + ,14 + ,75 + ,7 + ,9 + ,14 + ,11 + ,13 + ,14 + ,7 + ,1 + ,16 + ,19 + ,80 + ,7 + ,9 + ,12 + ,12 + ,14 + ,16 + ,8 + ,0 + ,11 + ,10 + ,64 + ,2 + ,20 + ,14 + ,14 + ,7 + ,13 + ,6 + ,1 + ,16 + ,9 + ,80 + ,7 + ,6 + ,9 + ,9 + ,16 + ,16 + ,6 + ,1 + ,13 + ,12 + ,86 + ,8 + ,10 + ,14 + ,13 + ,11 + ,15 + ,6 + ,1 + ,11 + ,16 + ,54 + ,5 + ,11 + ,11 + ,8 + ,10 + ,14 + ,5 + ,1 + ,13 + ,13 + ,74 + ,4 + ,7 + ,16 + ,11 + ,14 + ,13 + ,6 + ,1 + ,14 + ,11 + ,88 + ,2 + ,12 + ,17 + ,9 + ,19 + ,12 + ,6 + ,1 + ,15 + ,12 + ,85 + ,0 + ,12 + ,16 + ,12 + ,14 + ,16 + ,4 + ,0 + ,10 + ,11 + ,63 + ,7 + ,8 + ,12 + ,7 + ,8 + ,9 + ,5 + ,1 + ,15 + ,13 + ,81 + ,0 + ,6 + ,15 + ,11 + ,15 + ,15 + ,8 + ,0 + ,11 + ,13 + ,81 + ,5 + ,6 + ,15 + ,12 + ,8 + ,16 + ,6 + ,1 + ,11 + ,10 + ,74 + ,3 + ,9 + ,15 + ,11 + ,8 + ,12 + ,6 + ,1 + ,6 + ,11 + ,80 + ,3 + ,5 + ,16 + ,12 + ,6 + ,11 + ,2 + ,1 + ,11 + ,9 + ,80 + ,3 + ,11 + ,16 + ,9 + ,7 + ,13 + ,2 + ,0 + ,12 + ,13 + ,60 + ,3 + ,6 + ,11 + ,11 + ,16 + ,13 + ,4 + ,0 + ,13 + ,15 + ,65 + ,7 + ,6 + ,15 + ,13 + ,15 + ,14 + ,6 + ,1 + ,12 + ,14 + ,62 + ,6 + ,10 + ,12 + ,12 + ,10 + ,15 + ,6 + ,0 + ,8 + ,14 + ,63 + ,3 + ,8 + ,14 + ,12 + ,8 + ,14 + ,5 + ,1 + ,9 + ,11 + ,89 + ,0 + ,7 + ,15 + ,11 + ,9 + ,12 + ,4 + ,1 + ,10 + ,10 + ,76 + ,2 + ,8 + ,17 + ,12 + ,8 + ,16 + ,4 + ,1 + ,16 + ,11 + ,81 + ,0 + ,9 + ,19 + ,12 + ,14 + ,14 + ,6 + ,1 + ,15 + ,12 + ,72 + ,9 + ,8 + ,15 + ,11 + ,14 + ,13 + ,5 + ,0 + ,14 + ,14 + ,84 + ,10 + ,10 + ,16 + ,11 + ,14 + ,12 + ,6 + ,1 + ,12 + ,14 + ,76 + ,3 + ,13 + ,14 + ,8 + ,15 + ,13 + ,7 + ,1 + ,12 + ,21 + ,76 + ,7 + ,7 + ,16 + ,9 + ,7 + ,12 + ,6 + ,1 + ,10 + ,14 + ,78 + ,3 + ,7 + ,15 + ,11 + ,7 + ,9 + ,4 + ,1 + ,12 + ,13 + ,72 + ,6 + ,7 + ,15 + ,12 + ,12 + ,13 + ,4 + ,0 + ,8 + ,11 + ,81 + ,5 + ,8 + ,17 + ,13 + ,7 + ,10 + ,3 + ,1 + ,16 + ,12 + ,72 + ,0 + ,9 + ,12 + ,12 + ,12 + ,15 + ,8 + ,1 + ,11 + ,12 + ,78 + ,0 + ,9 + ,18 + ,6 + ,6 + ,9 + ,4 + ,1 + ,12 + ,11 + ,79 + ,4 + ,8 + ,13 + ,12 + ,10 + ,13 + ,4 + ,1 + ,9 + ,14 + ,52 + ,0 + ,7 + ,14 + ,11 + ,12 + ,13 + ,5 + ,0 + ,14 + ,13 + ,67 + ,0 + ,6 + ,14 + ,13 + ,13 + ,13 + ,5 + ,0 + ,15 + ,13 + ,74 + ,7 + ,8 + ,14 + ,11 + ,14 + ,15 + ,7 + ,0 + ,8 + ,12 + ,73 + ,3 + ,8 + ,12 + ,12 + ,8 + ,13 + ,4 + ,1 + ,12 + ,14 + ,69 + ,9 + ,4 + ,14 + ,10 + ,14 + ,14 + ,5 + ,0 + ,10 + ,12 + ,67 + ,4 + ,8 + ,12 + ,10 + ,10 + ,11 + ,5 + ,1 + ,16 + ,12 + ,76 + ,4 + ,10 + ,15 + ,11 + ,14 + ,15 + ,8 + ,1 + ,17 + ,12 + ,77 + ,15 + ,7 + ,11 + ,11 + ,15 + ,14 + ,5 + ,0 + ,8 + ,18 + ,63 + ,7 + ,8 + ,11 + ,11 + ,10 + ,15 + ,2 + ,1 + ,9 + ,11 + ,84 + ,8 + ,7 + ,15 + ,9 + ,6 + ,12 + ,5 + ,1 + ,8 + ,15 + ,90 + ,2 + ,10 + ,14 + ,7 + ,9 + ,15 + ,4 + ,0 + ,11 + ,13 + ,75 + ,8 + ,9 + ,15 + ,11 + ,11 + ,14 + ,5 + ,1 + ,16 + ,11 + ,76 + ,7 + ,8 + ,16 + ,12 + ,16 + ,16 + ,7 + ,0 + ,13 + ,11 + ,75 + ,3 + ,8 + ,12 + ,12 + ,14 + ,14 + ,6 + ,1 + ,5 + ,22 + ,53 + ,3 + ,5 + ,14 + ,15 + ,8 + ,12 + ,3 + ,1 + ,15 + ,10 + ,87 + ,6 + ,8 + ,18 + ,11 + ,16 + ,11 + ,5 + ,1 + ,15 + ,11 + ,78 + ,8 + ,9 + ,14 + ,10 + ,16 + ,13 + ,6 + ,1 + ,12 + ,15 + ,54 + ,5 + ,11 + ,13 + ,13 + ,14 + ,12 + ,5 + ,0 + ,12 + ,14 + ,58 + ,6 + ,7 + ,14 + ,13 + ,12 + ,12 + ,6 + ,1 + ,16 + ,11 + ,80 + ,10 + ,8 + ,14 + ,11 + ,16 + ,16 + ,7 + ,1 + ,12 + ,10 + ,74 + ,0 + ,4 + ,17 + ,12 + ,15 + ,13 + ,6 + ,1 + ,10 + ,14 + ,56 + ,5 + ,16 + ,12 + ,12 + ,11 + ,12 + ,6 + ,1 + ,12 + ,14 + ,82 + ,0 + ,9 + ,16 + ,12 + ,6 + ,14 + ,5 + ,1 + ,4 + ,11 + ,64 + ,0 + ,16 + ,15 + ,8 + ,6 + ,4 + ,4 + ,0 + ,11 + ,15 + ,67 + ,5 + ,12 + ,10 + ,5 + ,16 + ,14 + ,6 + ,0 + ,16 + ,11 + ,75 + ,10 + ,8 + ,13 + ,11 + ,16 + ,15 + ,6 + ,0 + ,7 + ,10 + ,69 + ,0 + ,4 + ,15 + ,12 + ,8 + ,12 + ,3 + ,1 + ,9 + ,10 + ,72 + ,5 + ,11 + ,16 + ,12 + ,11 + ,11 + ,4 + ,0 + ,14 + ,16 + ,71 + ,6 + ,11 + ,15 + ,11 + ,12 + ,12 + ,4 + ,1 + ,11 + ,12 + ,54 + ,1 + ,8 + ,14 + ,12 + ,13 + ,11 + ,4 + ,1 + ,10 + ,14 + ,68 + ,5 + ,8 + ,11 + ,10 + ,11 + ,12 + ,5 + ,0 + ,6 + ,15 + ,54 + ,3 + ,12 + ,13 + ,7 + ,9 + ,11 + ,4 + ,1 + ,14 + ,10 + ,71 + ,3 + ,8 + ,17 + ,12 + ,15 + ,13 + ,6 + ,1 + ,11 + ,12 + ,53 + ,6 + ,6 + ,14 + ,12 + ,11 + ,12 + ,6 + ,1 + ,11 + ,15 + ,54 + ,2 + ,8 + ,16 + ,9 + ,12 + ,12 + ,4 + ,0 + ,9 + ,12 + ,71 + ,5 + ,6 + ,15 + ,11 + ,15 + ,15 + ,7 + ,1 + ,16 + ,11 + ,69 + ,6 + ,14 + ,12 + ,12 + ,8 + ,14 + ,4 + ,0 + ,7 + ,10 + ,30 + ,2 + ,10 + ,16 + ,12 + ,7 + ,12 + ,4 + ,0 + ,8 + ,20 + ,53 + ,3 + ,5 + ,8 + ,11 + ,10 + ,12 + ,4 + ,0 + ,10 + ,19 + ,68 + ,7 + ,8 + ,9 + ,11 + ,9 + ,12 + ,4 + ,1 + ,14 + ,17 + ,69 + ,6 + ,12 + ,13 + ,12 + ,13 + ,13 + ,5 + ,1 + ,9 + ,8 + ,54 + ,3 + ,11 + ,19 + ,12 + ,11 + ,11 + ,4 + ,1 + ,13 + ,17 + ,66 + ,6 + ,8 + ,11 + ,11 + ,12 + ,13 + ,7 + ,0 + ,13 + ,11 + ,79 + ,9 + ,8 + ,15 + ,12 + ,5 + ,12 + ,3 + ,0 + ,12 + ,13 + ,67 + ,2 + ,9 + ,11 + ,12 + ,12 + ,14 + ,5 + ,0 + ,11 + ,9 + ,74 + ,5 + ,6 + ,15 + ,8 + ,14 + ,15 + ,5 + ,0 + ,10 + ,10 + ,86 + ,10 + ,5 + ,16 + ,15 + ,15 + ,15 + ,6 + ,1 + ,12 + ,13 + ,63 + ,9 + ,8 + ,15 + ,11 + ,14 + ,13 + ,5 + ,1 + ,14 + ,16 + ,69 + ,8 + ,7 + ,12 + ,11 + ,13 + ,16 + ,6 + ,0 + ,11 + ,12 + ,73 + ,8 + ,4 + ,16 + ,6 + ,14 + ,17 + ,6 + ,0 + ,13 + ,14 + ,69 + ,5 + ,9 + ,15 + ,13 + ,14 + ,13 + ,3 + ,0 + ,14 + ,11 + ,71 + ,9 + ,5 + ,13 + ,12 + ,15 + ,14 + ,6 + ,1 + ,13 + ,13 + ,77 + ,9 + ,9 + ,14 + ,12 + ,13 + ,13 + ,5 + ,1 + ,16 + ,15 + ,74 + ,14 + ,12 + ,11 + ,12 + ,14 + ,16 + ,8 + ,1 + ,13 + ,14 + ,82 + ,5 + ,6 + ,15 + ,12 + ,11 + ,13 + ,6 + ,1 + ,12 + ,14 + ,54 + ,12 + ,4 + ,16 + ,12 + ,14 + ,14 + ,4 + ,1 + ,9 + ,14 + ,54 + ,6 + ,6 + ,14 + ,10 + ,11 + ,13 + ,3 + ,1 + ,14 + ,10 + ,80 + ,6 + ,7 + ,13 + ,12 + ,8 + ,14 + ,4 + ,0 + ,15 + ,8 + ,76 + ,8 + ,9 + ,15 + ,12 + ,12 + ,16 + ,7) + ,dim=c(11 + ,156) + ,dimnames=list(c('Gender' + ,'Popularity' + ,'Depression' + ,'Belonging' + ,'WeightedPopularity' + ,'ParentalCriticism' + ,'Happiness' + ,'FindingFriends' + ,'KnowingPeople' + ,'Liked' + ,'Celebrity') + ,1:156)) > y <- array(NA,dim=c(11,156),dimnames=list(c('Gender','Popularity','Depression','Belonging','WeightedPopularity','ParentalCriticism','Happiness','FindingFriends','KnowingPeople','Liked','Celebrity'),1:156)) > 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 = '2' > #'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] "Popularity" > x[,par1] [1] 15 12 15 12 14 8 11 15 4 13 19 10 15 6 7 14 16 16 14 15 14 12 9 12 14 [26] 12 14 10 14 16 10 8 12 11 8 13 11 12 16 16 13 14 5 14 13 16 14 15 15 11 [51] 15 16 13 11 12 12 10 8 9 12 14 12 11 14 7 16 16 11 16 13 11 13 14 15 10 [76] 15 11 11 6 11 12 13 12 8 9 10 16 15 14 12 12 10 12 8 16 11 12 9 14 15 [101] 8 12 10 16 17 8 9 8 11 16 13 5 15 15 12 12 16 12 10 12 4 11 16 7 9 [126] 14 11 10 6 14 11 11 9 16 7 8 10 14 9 13 13 12 11 10 12 14 11 13 14 13 [151] 16 13 12 9 14 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]) 4 5 6 7 8 9 10 11 12 13 14 15 16 17 19 2 2 3 4 10 9 12 19 25 14 21 15 18 1 1 > colnames(x) [1] "Gender" "Popularity" "Depression" [4] "Belonging" "WeightedPopularity" "ParentalCriticism" [7] "Happiness" "FindingFriends" "KnowingPeople" [10] "Liked" "Celebrity" > colnames(x)[par1] [1] "Popularity" > x[,par1] [1] 15 12 15 12 14 8 11 15 4 13 19 10 15 6 7 14 16 16 14 15 14 12 9 12 14 [26] 12 14 10 14 16 10 8 12 11 8 13 11 12 16 16 13 14 5 14 13 16 14 15 15 11 [51] 15 16 13 11 12 12 10 8 9 12 14 12 11 14 7 16 16 11 16 13 11 13 14 15 10 [76] 15 11 11 6 11 12 13 12 8 9 10 16 15 14 12 12 10 12 8 16 11 12 9 14 15 [101] 8 12 10 16 17 8 9 8 11 16 13 5 15 15 12 12 16 12 10 12 4 11 16 7 9 [126] 14 11 10 6 14 11 11 9 16 7 8 10 14 9 13 13 12 11 10 12 14 11 13 14 13 [151] 16 13 12 9 14 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/1to651291927082.tab") + } + } > m Conditional inference tree with 5 terminal nodes Response: Popularity Inputs: Gender, Depression, Belonging, WeightedPopularity, ParentalCriticism, Happiness, FindingFriends, KnowingPeople, Liked, Celebrity Number of observations: 156 1) Celebrity <= 4; criterion = 1, statistic = 55.809 2) Liked <= 12; criterion = 0.964, statistic = 8.463 3)* weights = 31 2) Liked > 12 4)* weights = 19 1) Celebrity > 4 5) KnowingPeople <= 11; criterion = 1, statistic = 28.43 6)* weights = 27 5) KnowingPeople > 11 7) Liked <= 13; criterion = 0.987, statistic = 10.379 8)* weights = 29 7) Liked > 13 9)* weights = 50 > postscript(file="/var/www/html/freestat/rcomp/tmp/2to651291927082.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/3to651291927082.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 12.793103 2.20689655 2 12 8.935484 3.06451613 3 15 14.320000 0.68000000 4 12 11.148148 0.85185185 5 14 12.793103 1.20689655 6 8 8.935484 -0.93548387 7 11 12.793103 -1.79310345 8 15 8.935484 6.06451613 9 4 8.935484 -4.93548387 10 13 11.148148 1.85185185 11 19 14.320000 4.68000000 12 10 11.148148 -1.14814815 13 15 14.320000 0.68000000 14 6 12.793103 -6.79310345 15 7 8.935484 -1.93548387 16 14 12.793103 1.20689655 17 16 14.320000 1.68000000 18 16 14.320000 1.68000000 19 14 11.148148 2.85185185 20 15 14.320000 0.68000000 21 14 14.320000 -0.32000000 22 12 11.263158 0.73684211 23 9 8.935484 0.06451613 24 12 11.263158 0.73684211 25 14 14.320000 -0.32000000 26 12 12.793103 -0.79310345 27 14 11.148148 2.85185185 28 10 11.148148 -1.14814815 29 14 12.793103 1.20689655 30 16 14.320000 1.68000000 31 10 8.935484 1.06451613 32 8 11.263158 -3.26315789 33 12 11.148148 0.85185185 34 11 11.148148 -0.14814815 35 8 8.935484 -0.93548387 36 13 14.320000 -1.32000000 37 11 11.263158 -0.26315789 38 12 8.935484 3.06451613 39 16 14.320000 1.68000000 40 16 14.320000 1.68000000 41 13 14.320000 -1.32000000 42 14 14.320000 -0.32000000 43 5 8.935484 -3.93548387 44 14 14.320000 -0.32000000 45 13 8.935484 4.06451613 46 16 14.320000 1.68000000 47 14 14.320000 -0.32000000 48 15 14.320000 0.68000000 49 15 14.320000 0.68000000 50 11 14.320000 -3.32000000 51 15 12.793103 2.20689655 52 16 14.320000 1.68000000 53 13 14.320000 -1.32000000 54 11 12.793103 -1.79310345 55 12 12.793103 -0.79310345 56 12 11.148148 0.85185185 57 10 14.320000 -4.32000000 58 8 11.148148 -3.14814815 59 9 8.935484 0.06451613 60 12 12.793103 -0.79310345 61 14 14.320000 -0.32000000 62 12 12.793103 -0.79310345 63 11 11.263158 -0.26315789 64 14 14.320000 -0.32000000 65 7 8.935484 -1.93548387 66 16 14.320000 1.68000000 67 16 14.320000 1.68000000 68 11 11.148148 -0.14814815 69 16 14.320000 1.68000000 70 13 11.148148 1.85185185 71 11 11.148148 -0.14814815 72 13 12.793103 0.20689655 73 14 12.793103 1.20689655 74 15 11.263158 3.73684211 75 10 11.148148 -1.14814815 76 15 14.320000 0.68000000 77 11 11.148148 -0.14814815 78 11 11.148148 -0.14814815 79 6 8.935484 -2.93548387 80 11 11.263158 -0.26315789 81 12 11.263158 0.73684211 82 13 14.320000 -1.32000000 83 12 11.148148 0.85185185 84 8 11.148148 -3.14814815 85 9 8.935484 0.06451613 86 10 11.263158 -1.26315789 87 16 14.320000 1.68000000 88 15 12.793103 2.20689655 89 14 12.793103 1.20689655 90 12 12.793103 -0.79310345 91 12 11.148148 0.85185185 92 10 8.935484 1.06451613 93 12 11.263158 0.73684211 94 8 8.935484 -0.93548387 95 16 14.320000 1.68000000 96 11 8.935484 2.06451613 97 12 11.263158 0.73684211 98 9 12.793103 -3.79310345 99 14 12.793103 1.20689655 100 15 14.320000 0.68000000 101 8 11.263158 -3.26315789 102 12 14.320000 -2.32000000 103 10 11.148148 -1.14814815 104 16 14.320000 1.68000000 105 17 14.320000 2.68000000 106 8 11.263158 -3.26315789 107 9 11.148148 -2.14814815 108 8 11.263158 -3.26315789 109 11 11.148148 -0.14814815 110 16 14.320000 1.68000000 111 13 14.320000 -1.32000000 112 5 8.935484 -3.93548387 113 15 12.793103 2.20689655 114 15 12.793103 2.20689655 115 12 12.793103 -0.79310345 116 12 12.793103 -0.79310345 117 16 14.320000 1.68000000 118 12 12.793103 -0.79310345 119 10 11.148148 -1.14814815 120 12 11.148148 0.85185185 121 4 8.935484 -4.93548387 122 11 14.320000 -3.32000000 123 16 14.320000 1.68000000 124 7 8.935484 -1.93548387 125 9 8.935484 0.06451613 126 14 8.935484 5.06451613 127 11 8.935484 2.06451613 128 10 11.148148 -1.14814815 129 6 8.935484 -2.93548387 130 14 12.793103 1.20689655 131 11 11.148148 -0.14814815 132 11 8.935484 2.06451613 133 9 14.320000 -5.32000000 134 16 11.263158 4.73684211 135 7 8.935484 -1.93548387 136 8 8.935484 -0.93548387 137 10 8.935484 1.06451613 138 14 12.793103 1.20689655 139 9 8.935484 0.06451613 140 13 12.793103 0.20689655 141 13 8.935484 4.06451613 142 12 14.320000 -2.32000000 143 11 14.320000 -3.32000000 144 10 14.320000 -4.32000000 145 12 12.793103 -0.79310345 146 14 14.320000 -0.32000000 147 11 14.320000 -3.32000000 148 13 11.263158 1.73684211 149 14 14.320000 -0.32000000 150 13 12.793103 0.20689655 151 16 14.320000 1.68000000 152 13 11.148148 1.85185185 153 12 11.263158 0.73684211 154 9 11.263158 -2.26315789 155 14 11.263158 2.73684211 156 15 14.320000 0.68000000 > 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/4lxoq1291927082.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/5iq401291927082.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/6ahl21291927082.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/7wh1q1291927082.tab") + } > try(system("convert tmp/2to651291927082.ps tmp/2to651291927082.png",intern=TRUE)) character(0) > try(system("convert tmp/3to651291927082.ps tmp/3to651291927082.png",intern=TRUE)) character(0) > try(system("convert tmp/4lxoq1291927082.ps tmp/4lxoq1291927082.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 5.190 0.761 5.340