Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
21454 -11.5 0.012095933 8.02 8.3 23899 -11 0.017384968 8.03 8.2 24939 -14.9 0.017547503 8.45 8 23580 -16.2 0.014844804 7.74 7.9 24562 -14.4 0.010364842 7.26 7.6 24696 -17.3 0.016214531 7.9 7.6 23785 -15.7 0.014814047 7.34 8.3 23812 -12.6 0.017823834 6.91 8.4 21917 -9.4 0.017980779 7.22 8.4 19713 -8.1 0.015828678 7.47 8.4 19282 -5.4 0.018533858 7.16 8.4 18788 -4.6 0.017385905 8.09 8.6 21453 -4.9 0.015866474 7.91 8.9 24482 -4 0.012585695 7.74 8.8 27474 -3.1 0.011326531 8.01 8.3 27264 -1.3 0.019230769 7.56 7.5 27349 0 0.026056627 7.56 7.2 30632 -0.4 0.022604071 8.06 7.4 29429 3 0.024091466 8.06 8.8 30084 0.4 0.022602321 7.87 9.3 26290 1.2 0.020302507 7.97 9.3 24379 0.6 0.028617986 7.89 8.7 23335 -1.3 0.025515909 7.83 8.2 21346 -3.2 0.022785068 8.17 8.3 21106 -1.8 0.022515213 8.84 8.5 24514 -3.6 0.025666936 8.44 8.6 28353 -4.2 0.03067299 8.38 8.5 30805 -6.9 0.027599358 7.71 8.2 31348 -8 0.025194961 6.58 8.1 34556 -7.5 0.028705741 6.65 7.9 33855 -8.2 0.031399522 6.59 8.6 34787 -7.6 0.031063321 6.38 8.7 32529 -3.7 0.031638643 6.78 8.7 29998 -1.7 0.024653465 6.46 8.5 29257 -0.7 0.025674068 6.61 8.4 28155 0.2 0.028841372 6.46 8.5 30466 0.6 0.026383654 6.58 8.7 35704 2.2 0.023940887 6.48 8.7 39327 3.3 0.017033774 6.67 8.6 39351 5.3 0.019630823 6.7 8.5 42234 5.5 0.021942657 6.58 8.3 43630 6.3 0.018667963 6.47 8 43722 7.7 0.016043298 7.25 8.2 43121 6.5 0.016415604 7.24 8.1 37985 5.5 0.012248047 6.97 8.1 37135 6.9 0.012175089 6.83 8 34646 5.7 0.014883541 7.42 7.9 33026 6.9 0.016433059 7.34 7.9 35087 6.1 0.016621569 7.11 8 38846 4.8 0.017704224 7.16 8 42013 3.7 0.018192319 7.51 7.9 43908 5.8 0.017816092 7.07 8 42868 6.8 0.01278748 6.85 7.7 44423 8.5 0.012885368 7.05 7.2 44167 7.2 0.013697327 7.62 7.5 43636 5 0.011210336 7.66 7.3 44382 4.7 0.015053354 7.2 7 42142 2.3 0.022434368 7.38 7 43452 2.4 0.029425769 7.57 7 36912 0.1 0.030908226 7.31 7.2 42413 1.9 0.03460076 8.33 7.3 45344 1.7 0.036399735 7.38 7.1 44873 2 0.043864625 7.41 6.8 47510 -1.9 0.041501976 7.81 6.4 49554 0.5 0.052105908 7.24 6.1 47369 -1.3 0.058047493 7.88 6.5 45998 -3.3 0.059116074 8.52 7.7 48140 -2.8 0.053927095 7.66 7.9 48441 -8 0.05462737 8.5 7.5 44928 -13.9 0.047245565 8.82 6.9 40454 -21.9 0.031359852 8.61 6.6 38661 -28.8 0.026291513 8.2 6.9 37246 -27.6 0.023153252 7.31 7.7 36843 -31.4 0.019339537 7.43 8 36424 -31.8 0.006158305 7.33 8 37594 -29.4 0.005963676 7.53 7.7 38144 -27.6 -0.003671861 7.61 7.3 38737 -23.6 -0.011043819 7.17 7.4 34560 -22.8 -0.016833525 6.81 8.1 36080 -18.2 -0.007755393 6.9 8.3 33508 -17.8 -0.011925952 7.33 8.1 35462 -14.2 -0.00971826 7.36 7.9 33374 -8.8 -0.001166024 6.33 7.9 32110 -7.9 0.002606742 6.95 8.3 35533 -7 0.006196121 7.25 8.6 35532 -7 0.00698049 6.46 8.7 37903 -3.6 0.016561656 6.51 8.5 36763 -2.4 0.01796461 6.31 8.3 40399 -4.9 0.022741573 5.93 8 44164 -7.7 0.024585735 5.86 8.1 44496 -6.5 0.025682617 5.85 8.9 43110 -5.1 0.02317851 5.82 8.9 43880 -3.4 0.029093857 6.17 8.7 43930 -2.8 0.030071126 5.7 8.3
Names of X columns:
Vacatures Ondernemersvertrouwen Inflatie Rente Werkloosheidsgraad
Endogenous Variable (Column Number)
Categorization
none
none
quantiles
hclust
equal
Number of categories (only if categorization<>none)
Cross-Validation? (only if categorization<>none)
no
no
yes
Chart options
R Code
library(party) library(Hmisc) par1 <- as.numeric(par1) par3 <- as.numeric(par3) x <- data.frame(t(y)) is.data.frame(x) x <- x[!is.na(x[,par1]),] k <- length(x[1,]) n <- length(x[,1]) colnames(x)[par1] x[,par1] 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]) colnames(x) colnames(x)[par1] x[,par1] if (par2 == 'none') { m <- ctree(as.formula(paste(colnames(x)[par1],' ~ .',sep='')),data = x) } load(file='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='mytable3.tab') } } m bitmap(file='test1.png') plot(m) dev.off() bitmap(file='test1a.png') plot(x[,par1] ~ as.factor(where(m)),main='Response by Terminal Node',xlab='Terminal Node',ylab='Response') dev.off() 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) } if (par2 != 'none') { print(cbind(as.factor(x[,par1]),predict(m))) myt <- table(as.factor(x[,par1]),predict(m)) print(myt) } bitmap(file='test2.png') 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() 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='mytable1.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='mytable.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='mytable2.tab') }
Compute
Summary of computational transaction
Raw Input
view raw input (R code)
Raw Output
view raw output of R engine
Computing time
2 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation