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(61.2
+ ,2.08
+ ,83.9
+ ,10554.27
+ ,62
+ ,2.09
+ ,85.6
+ ,10532.54
+ ,65.1
+ ,2.07
+ ,87.5
+ ,10324.31
+ ,63.2
+ ,2.04
+ ,88.5
+ ,10695.25
+ ,66.3
+ ,2.35
+ ,91
+ ,10827.81
+ ,61.9
+ ,2.33
+ ,90.6
+ ,10872.48
+ ,62.1
+ ,2.37
+ ,91.2
+ ,10971.19
+ ,66.3
+ ,2.59
+ ,93.2
+ ,11145.65
+ ,72
+ ,2.62
+ ,90.1
+ ,11234.68
+ ,65.3
+ ,2.6
+ ,95
+ ,11333.88
+ ,67.6
+ ,2.83
+ ,95.4
+ ,10997.97
+ ,70.5
+ ,2.78
+ ,93.7
+ ,11036.89
+ ,74.2
+ ,3.01
+ ,93.9
+ ,11257.35
+ ,77.8
+ ,3.06
+ ,92.5
+ ,11533.59
+ ,78.5
+ ,3.33
+ ,89.2
+ ,11963.12
+ ,77.8
+ ,3.32
+ ,93.3
+ ,12185.15
+ ,81.4
+ ,3.6
+ ,93
+ ,12377.62
+ ,84.5
+ ,3.57
+ ,96.1
+ ,12512.89
+ ,88
+ ,3.57
+ ,96.7
+ ,12631.48
+ ,93.9
+ ,3.83
+ ,97.6
+ ,12268.53
+ ,98.9
+ ,3.84
+ ,102.6
+ ,12754.8
+ ,96.7
+ ,3.8
+ ,107.6
+ ,13407.75
+ ,98.9
+ ,4.07
+ ,103.5
+ ,13480.21
+ ,102.2
+ ,4.05
+ ,100.8
+ ,13673.28
+ ,105.4
+ ,4.272
+ ,94.5
+ ,13239.71
+ ,105.1
+ ,3.858
+ ,100.1
+ ,13557.69
+ ,116.6
+ ,4.067
+ ,97.4
+ ,13901.28
+ ,112
+ ,3.964
+ ,103
+ ,13200.58
+ ,108.8
+ ,3.782
+ ,100.2
+ ,13406.97
+ ,106.9
+ ,4.114
+ ,100.2
+ ,12538.12
+ ,109.5
+ ,4.009
+ ,99
+ ,12419.57
+ ,106.7
+ ,4.025
+ ,102.4
+ ,12193.88
+ ,118.9
+ ,4.082
+ ,99
+ ,12656.63
+ ,117.5
+ ,4.044
+ ,103.7
+ ,12812.48
+ ,113.7
+ ,3.916
+ ,103.4
+ ,12056.67
+ ,119.6
+ ,4.289
+ ,95.3
+ ,11322.38
+ ,120.6
+ ,4.296
+ ,93.6
+ ,11530.75
+ ,117.5
+ ,4.193
+ ,102.4
+ ,11114.08
+ ,120.3
+ ,3.48
+ ,110.5
+ ,9181.73
+ ,119.8
+ ,2.934
+ ,109.1
+ ,8614.55
+ ,108
+ ,2.221
+ ,100.9
+ ,8595.56
+ ,98.8
+ ,1.211
+ ,108.1
+ ,8396.2
+ ,94.6
+ ,1.28
+ ,105
+ ,7690.5
+ ,84.6
+ ,0.96
+ ,111.5
+ ,7235.47
+ ,84.4
+ ,0.5
+ ,109.5
+ ,7992.12
+ ,79.1
+ ,0.687
+ ,110.5
+ ,8398.37
+ ,73.3
+ ,0.344
+ ,114
+ ,8593
+ ,74.3
+ ,0.346
+ ,108.2
+ ,8679.75
+ ,67.8
+ ,0.334
+ ,110.3
+ ,9374.63
+ ,64.8
+ ,0.34
+ ,111.8
+ ,9634.97
+ ,66.5
+ ,0.328
+ ,107.5
+ ,9857.34
+ ,57.7
+ ,0.344
+ ,114.1
+ ,10238.83
+ ,53.8
+ ,0.341
+ ,113.8
+ ,10433.44
+ ,51.8
+ ,0.32
+ ,114.5
+ ,10471.24
+ ,50.9
+ ,0.314
+ ,114.8
+ ,10214.51
+ ,49
+ ,0.325
+ ,117.8
+ ,10677.52
+ ,48.1
+ ,0.339
+ ,116.7
+ ,11052.15
+ ,42.6
+ ,0.329
+ ,122.8
+ ,10500.19
+ ,40.9
+ ,0.48
+ ,122.3
+ ,10159.27
+ ,43.3
+ ,0.399
+ ,115
+ ,10222.24
+ ,43.7
+ ,0.37
+ ,118.5
+ ,10350.4)
+ ,dim=c(4
+ ,61)
+ ,dimnames=list(c('2JAAR'
+ ,'Eonia'
+ ,'deposits'
+ ,'DowJones')
+ ,1:61))
>  y <- array(NA,dim=c(4,61),dimnames=list(c('2JAAR','Eonia','deposits','DowJones'),1:61))
>  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 = '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] "X2JAAR"
> x[,par1]
 [1]  61.2  62.0  65.1  63.2  66.3  61.9  62.1  66.3  72.0  65.3  67.6  70.5
[13]  74.2  77.8  78.5  77.8  81.4  84.5  88.0  93.9  98.9  96.7  98.9 102.2
[25] 105.4 105.1 116.6 112.0 108.8 106.9 109.5 106.7 118.9 117.5 113.7 119.6
[37] 120.6 117.5 120.3 119.8 108.0  98.8  94.6  84.6  84.4  79.1  73.3  74.3
[49]  67.8  64.8  66.5  57.7  53.8  51.8  50.9  49.0  48.1  42.6  40.9  43.3
[61]  43.7
> 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])

 40.9  42.6  43.3  43.7  48.1    49  50.9  51.8  53.8  57.7  61.2  61.9    62 
    1     1     1     1     1     1     1     1     1     1     1     1     1 
 62.1  63.2  64.8  65.1  65.3  66.3  66.5  67.6  67.8  70.5    72  73.3  74.2 
    1     1     1     1     1     2     1     1     1     1     1     1     1 
 74.3  77.8  78.5  79.1  81.4  84.4  84.5  84.6    88  93.9  94.6  96.7  98.8 
    1     2     1     1     1     1     1     1     1     1     1     1     1 
 98.9 102.2 105.1 105.4 106.7 106.9   108 108.8 109.5   112 113.7 116.6 117.5 
    2     1     1     1     1     1     1     1     1     1     1     1     2 
118.9 119.6 119.8 120.3 120.6 
    1     1     1     1     1 
> colnames(x)
[1] "X2JAAR"   "Eonia"    "deposits" "DowJones"
> colnames(x)[par1]
[1] "X2JAAR"
> x[,par1]
 [1]  61.2  62.0  65.1  63.2  66.3  61.9  62.1  66.3  72.0  65.3  67.6  70.5
[13]  74.2  77.8  78.5  77.8  81.4  84.5  88.0  93.9  98.9  96.7  98.9 102.2
[25] 105.4 105.1 116.6 112.0 108.8 106.9 109.5 106.7 118.9 117.5 113.7 119.6
[37] 120.6 117.5 120.3 119.8 108.0  98.8  94.6  84.6  84.4  79.1  73.3  74.3
[49]  67.8  64.8  66.5  57.7  53.8  51.8  50.9  49.0  48.1  42.6  40.9  43.3
[61]  43.7
> 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/1d2wf1293377591.tab") 
+ }
+ }
> m

	 Conditional inference tree with 5 terminal nodes

Response:  X2JAAR 
Inputs:  Eonia, deposits, DowJones 
Number of observations:  61 

1) Eonia <= 2.83; criterion = 1, statistic = 36.201
  2) DowJones <= 8679.75; criterion = 0.999, statistic = 14.133
    3)*  weights = 8 
  2) DowJones > 8679.75
    4) deposits <= 111.8; criterion = 1, statistic = 14.298
      5)*  weights = 15 
    4) deposits > 111.8
      6)*  weights = 10 
1) Eonia > 2.83
  7) Eonia <= 3.84; criterion = 0.995, statistic = 9.971
    8)*  weights = 13 
  7) Eonia > 3.84
    9)*  weights = 15 
> postscript(file="/var/www/html/freestat/rcomp/tmp/2d2wf1293377591.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/3d2wf1293377591.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     61.2  65.50667  -4.3066667
2     62.0  65.50667  -3.5066667
3     65.1  65.50667  -0.4066667
4     63.2  65.50667  -2.3066667
5     66.3  65.50667   0.7933333
6     61.9  65.50667  -3.6066667
7     62.1  65.50667  -3.4066667
8     66.3  65.50667   0.7933333
9     72.0  65.50667   6.4933333
10    65.3  65.50667  -0.2066667
11    67.6  65.50667   2.0933333
12    70.5  65.50667   4.9933333
13    74.2  92.35385 -18.1538462
14    77.8  92.35385 -14.5538462
15    78.5  92.35385 -13.8538462
16    77.8  92.35385 -14.5538462
17    81.4  92.35385 -10.9538462
18    84.5  92.35385  -7.8538462
19    88.0  92.35385  -4.3538462
20    93.9  92.35385   1.5461538
21    98.9  92.35385   6.5461538
22    96.7  92.35385   4.3461538
23    98.9 111.40667 -12.5066667
24   102.2 111.40667  -9.2066667
25   105.4 111.40667  -6.0066667
26   105.1 111.40667  -6.3066667
27   116.6 111.40667   5.1933333
28   112.0 111.40667   0.5933333
29   108.8  92.35385  16.4461538
30   106.9 111.40667  -4.5066667
31   109.5 111.40667  -1.9066667
32   106.7 111.40667  -4.7066667
33   118.9 111.40667   7.4933333
34   117.5 111.40667   6.0933333
35   113.7 111.40667   2.2933333
36   119.6 111.40667   8.1933333
37   120.6 111.40667   9.1933333
38   117.5 111.40667   6.0933333
39   120.3  92.35385  27.9461538
40   119.8  92.35385  27.4461538
41   108.0  87.13750  20.8625000
42    98.8  87.13750  11.6625000
43    94.6  87.13750   7.4625000
44    84.6  87.13750  -2.5375000
45    84.4  87.13750  -2.7375000
46    79.1  87.13750  -8.0375000
47    73.3  87.13750 -13.8375000
48    74.3  87.13750 -12.8375000
49    67.8  65.50667   2.2933333
50    64.8  65.50667  -0.7066667
51    66.5  65.50667   0.9933333
52    57.7  48.18000   9.5200000
53    53.8  48.18000   5.6200000
54    51.8  48.18000   3.6200000
55    50.9  48.18000   2.7200000
56    49.0  48.18000   0.8200000
57    48.1  48.18000  -0.0800000
58    42.6  48.18000  -5.5800000
59    40.9  48.18000  -7.2800000
60    43.3  48.18000  -4.8800000
61    43.7  48.18000  -4.4800000
> 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/4ocw01293377591.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/52lt81293377591.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/6vvst1293377591.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/7gd9z1293377591.tab") 
+ }
> try(system("convert tmp/2d2wf1293377591.ps tmp/2d2wf1293377591.png",intern=TRUE))
character(0)
> try(system("convert tmp/3d2wf1293377591.ps tmp/3d2wf1293377591.png",intern=TRUE))
character(0)
> try(system("convert tmp/4ocw01293377591.ps tmp/4ocw01293377591.png",intern=TRUE))
character(0)
> 
> 
> proc.time()
   user  system elapsed 
  3.822   0.754   3.987