R version 2.9.0 (2009-04-17)
Copyright (C) 2009 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.

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(101.82
+ ,107.34
+ ,93.63
+ ,99.85
+ ,101.76
+ ,101.68
+ ,107.34
+ ,93.63
+ ,99.91
+ ,102.37
+ ,101.68
+ ,107.34
+ ,93.63
+ ,99.87
+ ,102.38
+ ,102.45
+ ,107.34
+ ,96.13
+ ,99.86
+ ,102.86
+ ,102.45
+ ,107.34
+ ,96.13
+ ,100.10
+ ,102.87
+ ,102.45
+ ,107.34
+ ,96.13
+ ,100.10
+ ,102.92
+ ,102.45
+ ,107.34
+ ,96.13
+ ,100.12
+ ,102.95
+ ,102.45
+ ,107.34
+ ,96.13
+ ,99.95
+ ,103.02
+ ,102.45
+ ,112.60
+ ,96.13
+ ,99.94
+ ,104.08
+ ,102.52
+ ,112.60
+ ,96.13
+ ,100.18
+ ,104.16
+ ,102.52
+ ,112.60
+ ,96.13
+ ,100.31
+ ,104.24
+ ,102.85
+ ,112.60
+ ,96.13
+ ,100.65
+ ,104.33
+ ,102.85
+ ,112.61
+ ,96.13
+ ,100.65
+ ,104.73
+ ,102.85
+ ,112.61
+ ,96.13
+ ,100.69
+ ,104.86
+ ,103.25
+ ,112.61
+ ,96.13
+ ,101.26
+ ,105.03
+ ,103.25
+ ,112.61
+ ,98.73
+ ,101.26
+ ,105.62
+ ,103.25
+ ,112.61
+ ,98.73
+ ,101.38
+ ,105.63
+ ,103.25
+ ,112.61
+ ,98.73
+ ,101.38
+ ,105.63
+ ,104.45
+ ,112.61
+ ,98.73
+ ,101.38
+ ,105.94
+ ,104.45
+ ,112.61
+ ,98.73
+ ,101.44
+ ,106.61
+ ,104.45
+ ,118.65
+ ,98.73
+ ,101.40
+ ,107.69
+ ,104.80
+ ,118.65
+ ,98.73
+ ,101.40
+ ,107.78
+ ,104.80
+ ,118.65
+ ,98.73
+ ,100.58
+ ,107.93
+ ,105.29
+ ,118.65
+ ,98.73
+ ,100.58
+ ,108.48
+ ,105.29
+ ,114.29
+ ,98.73
+ ,100.58
+ ,108.14
+ ,105.29
+ ,114.29
+ ,98.73
+ ,100.59
+ ,108.48
+ ,105.29
+ ,114.29
+ ,98.73
+ ,100.81
+ ,108.48
+ ,106.04
+ ,114.29
+ ,101.67
+ ,100.75
+ ,108.89
+ ,105.94
+ ,114.29
+ ,101.67
+ ,100.75
+ ,108.93
+ ,105.94
+ ,114.29
+ ,101.67
+ ,100.96
+ ,109.21
+ ,105.94
+ ,114.29
+ ,101.67
+ ,101.31
+ ,109.47
+ ,106.28
+ ,114.29
+ ,101.67
+ ,101.64
+ ,109.80
+ ,106.48
+ ,123.33
+ ,101.67
+ ,101.46
+ ,111.73
+ ,107.19
+ ,123.33
+ ,101.67
+ ,101.73
+ ,111.85
+ ,108.14
+ ,123.33
+ ,101.67
+ ,101.73
+ ,112.12
+ ,108.22
+ ,123.33
+ ,101.67
+ ,101.64
+ ,112.15
+ ,108.22
+ ,123.33
+ ,101.67
+ ,101.77
+ ,112.17
+ ,108.61
+ ,123.33
+ ,101.67
+ ,101.74
+ ,112.67
+ ,108.61
+ ,123.33
+ ,101.67
+ ,101.89
+ ,112.80
+ ,108.61
+ ,123.33
+ ,107.94
+ ,101.89
+ ,113.44
+ ,108.61
+ ,123.33
+ ,107.94
+ ,101.93
+ ,113.53
+ ,109.06
+ ,123.33
+ ,107.94
+ ,101.93
+ ,114.53
+ ,109.06
+ ,123.33
+ ,107.94
+ ,102.32
+ ,114.51
+ ,112.93
+ ,123.33
+ ,107.94
+ ,102.41
+ ,115.05
+ ,115.84
+ ,129.03
+ ,107.94
+ ,103.58
+ ,116.67
+ ,118.57
+ ,128.76
+ ,107.94
+ ,104.12
+ ,117.07
+ ,118.57
+ ,128.76
+ ,107.94
+ ,104.10
+ ,116.92
+ ,118.86
+ ,128.76
+ ,107.94
+ ,104.15
+ ,117.00
+ ,118.98
+ ,128.76
+ ,107.94
+ ,104.15
+ ,117.02
+ ,119.27
+ ,128.76
+ ,107.94
+ ,104.16
+ ,117.35
+ ,119.39
+ ,128.76
+ ,107.94
+ ,102.94
+ ,117.36
+ ,119.49
+ ,128.76
+ ,110.30
+ ,103.07
+ ,117.82
+ ,119.59
+ ,128.76
+ ,110.30
+ ,103.04
+ ,117.88
+ ,120.12
+ ,128.76
+ ,110.30
+ ,103.06
+ ,118.24
+ ,120.14
+ ,128.76
+ ,110.30
+ ,103.05
+ ,118.50
+ ,120.14
+ ,128.76
+ ,110.30
+ ,102.95
+ ,118.80
+ ,120.14
+ ,132.63
+ ,110.30
+ ,102.95
+ ,119.76
+ ,120.14
+ ,132.63
+ ,110.30
+ ,103.05
+ ,120.09)
+ ,dim=c(5
+ ,58)
+ ,dimnames=list(c('bios'
+ ,'schouwburg'
+ ,'eedagsacttractie'
+ ,'huurDVD'
+ ,'vrijetijdsbesteding')
+ ,1:58))
>  y <- array(NA,dim=c(5,58),dimnames=list(c('bios','schouwburg','eedagsacttractie','huurDVD','vrijetijdsbesteding'),1:58))
>  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 = '5'
> #'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] "vrijetijdsbesteding"
> x[,par1]
 [1] 101.76 102.37 102.38 102.86 102.87 102.92 102.95 103.02 104.08 104.16
[11] 104.24 104.33 104.73 104.86 105.03 105.62 105.63 105.63 105.94 106.61
[21] 107.69 107.78 107.93 108.48 108.14 108.48 108.48 108.89 108.93 109.21
[31] 109.47 109.80 111.73 111.85 112.12 112.15 112.17 112.67 112.80 113.44
[41] 113.53 114.53 114.51 115.05 116.67 117.07 116.92 117.00 117.02 117.35
[51] 117.36 117.82 117.88 118.24 118.50 118.80 119.76 120.09
> 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])

101.76 102.37 102.38 102.86 102.87 102.92 102.95 103.02 104.08 104.16 104.24 
     1      1      1      1      1      1      1      1      1      1      1 
104.33 104.73 104.86 105.03 105.62 105.63 105.94 106.61 107.69 107.78 107.93 
     1      1      1      1      1      2      1      1      1      1      1 
108.14 108.48 108.89 108.93 109.21 109.47  109.8 111.73 111.85 112.12 112.15 
     1      3      1      1      1      1      1      1      1      1      1 
112.17 112.67  112.8 113.44 113.53 114.51 114.53 115.05 116.67 116.92    117 
     1      1      1      1      1      1      1      1      1      1      1 
117.02 117.07 117.35 117.36 117.82 117.88 118.24  118.5  118.8 119.76 120.09 
     1      1      1      1      1      1      1      1      1      1      1 
> colnames(x)
[1] "bios"                "schouwburg"          "eedagsacttractie"   
[4] "huurDVD"             "vrijetijdsbesteding"
> colnames(x)[par1]
[1] "vrijetijdsbesteding"
> x[,par1]
 [1] 101.76 102.37 102.38 102.86 102.87 102.92 102.95 103.02 104.08 104.16
[11] 104.24 104.33 104.73 104.86 105.03 105.62 105.63 105.63 105.94 106.61
[21] 107.69 107.78 107.93 108.48 108.14 108.48 108.48 108.89 108.93 109.21
[31] 109.47 109.80 111.73 111.85 112.12 112.15 112.17 112.67 112.80 113.44
[41] 113.53 114.53 114.51 115.05 116.67 117.07 116.92 117.00 117.02 117.35
[51] 117.36 117.82 117.88 118.24 118.50 118.80 119.76 120.09
> if (par2 == 'none') {
+ m <- ctree(as.formula(paste(colnames(x)[par1],' ~ .',sep='')),data = x)
+ }
> 
> #Note: the /var/www/html/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
> load(file="/var/www/html/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/rcomp/tmp/1jizd1291973204.tab") 
+ }
+ }
> m

	 Conditional inference tree with 4 terminal nodes

Response:  vrijetijdsbesteding 
Inputs:  bios, schouwburg, eedagsacttractie, huurDVD 
Number of observations:  58 

1) schouwburg <= 118.65; criterion = 1, statistic = 54.118
  2) bios <= 103.25; criterion = 1, statistic = 29.654
    3)*  weights = 18 
  2) bios > 103.25
    4)*  weights = 14 
1) schouwburg > 118.65
  5) bios <= 112.93; criterion = 1, statistic = 23.082
    6)*  weights = 12 
  5) bios > 112.93
    7)*  weights = 14 
> postscript(file="/var/www/html/rcomp/tmp/2jizd1291973204.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/rcomp/tmp/3t9yy1291973204.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   101.76  103.8578 -2.09777778
2   102.37  103.8578 -1.48777778
3   102.38  103.8578 -1.47777778
4   102.86  103.8578 -0.99777778
5   102.87  103.8578 -0.98777778
6   102.92  103.8578 -0.93777778
7   102.95  103.8578 -0.90777778
8   103.02  103.8578 -0.83777778
9   104.08  103.8578  0.22222222
10  104.16  103.8578  0.30222222
11  104.24  103.8578  0.38222222
12  104.33  103.8578  0.47222222
13  104.73  103.8578  0.87222222
14  104.86  103.8578  1.00222222
15  105.03  103.8578  1.17222222
16  105.62  103.8578  1.76222222
17  105.63  103.8578  1.77222222
18  105.63  103.8578  1.77222222
19  105.94  108.2736 -2.33357143
20  106.61  108.2736 -1.66357143
21  107.69  108.2736 -0.58357143
22  107.78  108.2736 -0.49357143
23  107.93  108.2736 -0.34357143
24  108.48  108.2736  0.20642857
25  108.14  108.2736 -0.13357143
26  108.48  108.2736  0.20642857
27  108.48  108.2736  0.20642857
28  108.89  108.2736  0.61642857
29  108.93  108.2736  0.65642857
30  109.21  108.2736  0.93642857
31  109.47  108.2736  1.19642857
32  109.80  108.2736  1.52642857
33  111.73  113.0458 -1.31583333
34  111.85  113.0458 -1.19583333
35  112.12  113.0458 -0.92583333
36  112.15  113.0458 -0.89583333
37  112.17  113.0458 -0.87583333
38  112.67  113.0458 -0.37583333
39  112.80  113.0458 -0.24583333
40  113.44  113.0458  0.39416667
41  113.53  113.0458  0.48416667
42  114.53  113.0458  1.48416667
43  114.51  113.0458  1.46416667
44  115.05  113.0458  2.00416667
45  116.67  117.8914 -1.22142857
46  117.07  117.8914 -0.82142857
47  116.92  117.8914 -0.97142857
48  117.00  117.8914 -0.89142857
49  117.02  117.8914 -0.87142857
50  117.35  117.8914 -0.54142857
51  117.36  117.8914 -0.53142857
52  117.82  117.8914 -0.07142857
53  117.88  117.8914 -0.01142857
54  118.24  117.8914  0.34857143
55  118.50  117.8914  0.60857143
56  118.80  117.8914  0.90857143
57  119.76  117.8914  1.86857143
58  120.09  117.8914  2.19857143
> 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/rcomp/tmp/4mjxj1291973204.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/rcomp/tmp/571dp1291973204.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/rcomp/tmp/6tkuv1291973204.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/rcomp/tmp/7rw0m1291973204.tab") 
+ }
> 
> try(system("convert tmp/2jizd1291973204.ps tmp/2jizd1291973204.png",intern=TRUE))
character(0)
> try(system("convert tmp/3t9yy1291973204.ps tmp/3t9yy1291973204.png",intern=TRUE))
character(0)
> try(system("convert tmp/4mjxj1291973204.ps tmp/4mjxj1291973204.png",intern=TRUE))
character(0)
> 
> 
> proc.time()
   user  system elapsed 
  2.266   0.578   4.959