Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
23 10 53 7 12 2 4 0 0 21 6 86 4 11 4 3 0 0 21 13 66 6 14 7 5 0 0 21 12 67 5 12 3 3 0 1 24 8 76 4 21 7 6 0 0 22 6 78 3 12 2 5 0 0 21 10 53 5 22 7 6 0 0 22 10 80 6 11 2 6 0 0 21 9 74 5 10 1 5 0 0 20 9 76 6 13 2 5 0 0 22 7 79 7 10 6 3 0 1 21 5 54 6 8 1 5 0 0 21 14 67 7 15 1 7 0 1 23 6 87 6 10 1 5 0 0 22 10 58 4 14 2 5 0 1 23 10 75 6 14 2 3 0 1 22 7 88 4 11 2 5 0 0 24 10 64 5 10 1 6 0 1 23 8 57 3 13 7 5 0 0 21 6 66 3 7 1 2 0 1 23 10 54 4 12 2 5 0 0 23 12 56 5 14 4 4 0 0 21 7 86 3 11 2 6 0 1 20 15 80 7 9 1 3 0 0 32 8 76 7 11 1 5 0 1 22 10 69 4 15 5 4 0 0 21 13 67 4 13 2 5 0 1 21 8 80 5 9 1 2 0 0 21 11 54 6 15 3 2 0 1 22 7 71 5 10 1 5 0 0 21 9 84 4 11 2 2 0 0 21 10 74 6 13 5 2 0 1 21 8 71 5 8 2 2 0 1 22 15 63 5 20 6 5 0 1 21 9 71 6 12 4 5 0 1 21 7 76 2 10 1 1 0 0 21 11 69 6 10 3 5 0 1 21 9 74 7 9 6 2 0 1 23 8 75 5 14 7 6 0 0 21 8 54 5 8 4 1 0 1 23 12 69 5 11 5 3 0 0 23 13 68 6 13 3 2 0 0 21 9 75 4 11 2 5 0 0 21 11 75 6 11 2 3 0 1 20 8 72 5 10 2 4 0 0 21 10 67 5 14 2 3 0 1 21 13 63 3 18 1 6 0 1 22 12 62 4 14 2 4 0 0 21 12 63 4 11 1 5 0 1 21 9 76 2 12 2 2 0 0 22 8 74 3 13 2 5 0 0 20 9 67 6 9 5 5 0 0 22 12 73 5 10 5 3 0 1 22 12 70 6 15 2 5 0 0 21 16 53 2 20 1 7 0 1 23 11 77 3 12 1 4 0 1 22 13 77 6 12 2 2 0 0 24 10 52 3 14 3 3 0 0 23 9 54 6 13 7 6 0 0 21 14 80 6 11 4 7 1 1 22 13 66 4 17 4 4 1 0 22 12 73 7 12 1 4 1 1 21 9 63 6 13 2 4 1 0 21 9 69 3 14 2 5 1 1 21 10 67 7 13 2 2 1 1 21 8 54 2 15 5 3 1 0 20 9 81 4 13 1 3 1 0 22 9 69 6 10 6 4 1 1 22 11 84 4 11 2 3 1 1 22 7 70 1 13 2 4 1 0 23 11 69 4 17 4 6 1 0 21 9 77 7 13 6 2 1 1 23 11 54 4 9 2 4 1 1 22 9 79 4 11 2 5 1 1 21 8 30 4 10 2 2 1 1 21 9 71 6 9 1 1 1 0 20 8 73 2 12 1 2 1 1 24 9 72 3 12 2 5 1 0 24 10 77 4 13 2 4 1 0 21 9 75 4 13 3 4 1 1 20 17 70 4 22 3 6 1 0 21 7 73 6 13 5 1 1 0 21 11 54 2 15 2 4 1 0 21 9 77 4 13 5 5 1 0 21 10 82 3 15 3 2 1 0 22 11 80 7 10 1 3 1 0 22 8 80 4 11 2 3 1 0 21 12 69 5 16 2 6 1 0 22 10 78 6 11 1 5 1 0 21 7 81 5 11 2 4 1 1 23 9 76 4 10 2 4 1 1 21 7 76 5 10 5 5 1 0 22 12 73 4 16 5 5 1 1 22 8 85 5 12 2 6 1 0 22 13 66 7 11 3 6 1 1 20 9 79 7 16 5 5 1 0 21 15 68 4 19 5 7 1 1 21 8 76 6 11 6 5 1 0 22 14 54 4 15 2 5 1 1 25 14 46 1 24 7 7 1 0 22 9 82 3 14 1 5 1 0 22 13 74 6 15 1 6 1 0 21 11 88 7 11 6 6 1 0 22 10 38 6 15 6 4 1 1 21 6 76 6 12 2 5 1 0 24 8 86 6 10 1 1 1 1 23 10 54 4 14 2 6 1 0 23 10 69 1 9 1 5 1 0 22 10 90 3 15 2 2 1 0 22 12 54 7 15 1 1 1 0 25 10 76 2 14 3 5 1 0 23 9 89 7 11 3 6 1 0 22 9 76 4 8 6 5 1 0 21 11 79 5 11 4 5 1 0 21 7 90 6 8 1 4 1 1 22 7 74 6 10 2 2 1 0 22 5 81 5 11 5 3 1 0 21 9 72 5 13 6 3 1 0 0 11 71 4 11 3 5 1 1 21 15 66 2 20 5 3 1 1 22 9 77 2 10 3 2 1 0 21 9 74 4 12 2 2 1 1 24 8 82 4 14 3 3 1 0 21 13 54 6 23 2 6 1 1 23 10 63 5 14 5 5 1 1 23 13 54 5 16 5 6 1 0 22 9 64 6 11 7 2 1 0 21 11 69 5 12 4 5 1 1 21 8 84 7 14 5 5 1 1 21 10 86 5 12 1 1 1 0 21 9 77 3 12 4 4 1 1 22 8 89 5 11 1 2 1 0 20 8 76 1 12 4 2 1 0 21 13 60 5 13 6 7 1 1 23 11 79 7 17 7 6 1 0 32 8 76 7 11 1 5 0 1 22 12 72 6 12 3 5 1 0 24 15 69 4 19 5 5 0 0 21 11 54 2 15 2 4 1 0 22 10 69 6 14 4 3 1 0 22 5 81 5 11 5 3 1 0 23 11 84 1 9 1 3 1 0
Names of X columns:
AGE PStress BelInSprt KunnenRekRel Depressie Slaapgebrek ToekZorgen Pstress_OKT Pstress_M
Endogenous Variable (Column Number)
Categorization
quantiles
none
quantiles
hclust
equal
Number of categories (only if categorization<>none)
Cross-Validation? (only if categorization<>none)
yes
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
1 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation