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

 99.85  99.86  99.87  99.91  99.94  99.95  100.1 100.12 100.18 100.31 100.58 
     1      1      1      1      1      1      2      1      1      1      3 
100.59 100.65 100.69 100.75 100.81 100.96 101.26 101.31 101.38  101.4 101.44 
     1      2      1      2      1      1      2      1      3      2      1 
101.46 101.64 101.73 101.74 101.77 101.89 101.93 102.32 102.41 102.94 102.95 
     1      2      2      1      1      2      2      1      1      1      2 
103.04 103.05 103.06 103.07 103.58  104.1 104.12 104.15 104.16 
     1      2      1      1      1      1      1      2      1 
> colnames(x)
[1] "Cultuur"    "Bioscoop"   "Schouwburg" "EendagsA"   "Huur"      
> colnames(x)[par1]
[1] "Huur"
> x[,par1]
 [1]  99.85  99.91  99.87  99.86 100.10 100.10 100.12  99.95  99.94 100.18
[11] 100.31 100.65 100.65 100.69 101.26 101.26 101.38 101.38 101.38 101.44
[21] 101.40 101.40 100.58 100.58 100.58 100.59 100.81 100.75 100.75 100.96
[31] 101.31 101.64 101.46 101.73 101.73 101.64 101.77 101.74 101.89 101.89
[41] 101.93 101.93 102.32 102.41 103.58 104.12 104.10 104.15 104.15 104.16
[51] 102.94 103.07 103.04 103.06 103.05 102.95 102.95 103.05
> 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/1koio1291974688.tab") 
+ }
+ }
> m

	 Conditional inference tree with 4 terminal nodes

Response:  Huur 
Inputs:  Cultuur, Bioscoop, Schouwburg, EendagsA 
Number of observations:  58 

1) Bioscoop <= 108.61; criterion = 1, statistic = 48.485
  2) Cultuur <= 104.86; criterion = 1, statistic = 28.099
    3)*  weights = 14 
  2) Cultuur > 104.86
    4) Schouwburg <= 118.65; criterion = 0.987, statistic = 8.662
      5)*  weights = 18 
    4) Schouwburg > 118.65
      6)*  weights = 9 
1) Bioscoop > 108.61
  7)*  weights = 17 
> postscript(file="/var/www/html/rcomp/tmp/2koio1291974688.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/3vfhr1291974688.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    99.85  100.1557 -0.30571429
2    99.91  100.1557 -0.24571429
3    99.87  100.1557 -0.28571429
4    99.86  100.1557 -0.29571429
5   100.10  100.1557 -0.05571429
6   100.10  100.1557 -0.05571429
7   100.12  100.1557 -0.03571429
8    99.95  100.1557 -0.20571429
9    99.94  100.1557 -0.21571429
10  100.18  100.1557  0.02428571
11  100.31  100.1557  0.15428571
12  100.65  100.1557  0.49428571
13  100.65  100.1557  0.49428571
14  100.69  100.1557  0.53428571
15  101.26  101.0806  0.17944444
16  101.26  101.0806  0.17944444
17  101.38  101.0806  0.29944444
18  101.38  101.0806  0.29944444
19  101.38  101.0806  0.29944444
20  101.44  101.0806  0.35944444
21  101.40  101.0806  0.31944444
22  101.40  101.0806  0.31944444
23  100.58  101.0806 -0.50055556
24  100.58  101.0806 -0.50055556
25  100.58  101.0806 -0.50055556
26  100.59  101.0806 -0.49055556
27  100.81  101.0806 -0.27055556
28  100.75  101.0806 -0.33055556
29  100.75  101.0806 -0.33055556
30  100.96  101.0806 -0.12055556
31  101.31  101.0806  0.22944444
32  101.64  101.0806  0.55944444
33  101.46  101.7533 -0.29333333
34  101.73  101.7533 -0.02333333
35  101.73  101.7533 -0.02333333
36  101.64  101.7533 -0.11333333
37  101.77  101.7533  0.01666667
38  101.74  101.7533 -0.01333333
39  101.89  101.7533  0.13666667
40  101.89  101.7533  0.13666667
41  101.93  101.7533  0.17666667
42  101.93  103.2371 -1.30705882
43  102.32  103.2371 -0.91705882
44  102.41  103.2371 -0.82705882
45  103.58  103.2371  0.34294118
46  104.12  103.2371  0.88294118
47  104.10  103.2371  0.86294118
48  104.15  103.2371  0.91294118
49  104.15  103.2371  0.91294118
50  104.16  103.2371  0.92294118
51  102.94  103.2371 -0.29705882
52  103.07  103.2371 -0.16705882
53  103.04  103.2371 -0.19705882
54  103.06  103.2371 -0.17705882
55  103.05  103.2371 -0.18705882
56  102.95  103.2371 -0.28705882
57  102.95  103.2371 -0.28705882
58  103.05  103.2371 -0.18705882
> 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/4ophu1291974688.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/597fz1291974688.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/6u7w51291974688.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/7gqub1291974688.tab") 
+ }
> 
> try(system("convert tmp/2koio1291974688.ps tmp/2koio1291974688.png",intern=TRUE))
character(0)
> try(system("convert tmp/3vfhr1291974688.ps tmp/3vfhr1291974688.png",intern=TRUE))
character(0)
> try(system("convert tmp/4ophu1291974688.ps tmp/4ophu1291974688.png",intern=TRUE))
character(0)
> 
> 
> proc.time()
   user  system elapsed 
  2.281   0.602   5.036