Wessa.net

Send output to:

Data X:
140824 186099 38 165 110459 113854 34 135 105079 99776 42 121 112098 106194 38 148 43929 100792 27 73 76173 47552 35 49 187326 250931 33 185 22807 6853 18 5 144408 115466 34 125 66485 110896 33 93 79089 169351 46 154 81625 94853 55 98 68788 72591 37 70 103297 101345 55 148 69446 113713 44 100 114948 165354 59 150 167949 164263 36 197 125081 135213 39 114 125818 111669 29 169 136588 134163 51 200 112431 140303 49 148 103037 150773 39 140 82317 111848 25 74 118906 102509 52 128 83515 96785 45 140 104581 116136 38 116 103129 158376 41 147 83243 153990 43 132 37110 64057 32 70 113344 230054 41 144 139165 184531 47 155 86652 114198 50 165 112302 198299 48 161 69652 33750 37 31 119442 189723 43 199 69867 100826 42 78 101629 188355 44 121 70168 104470 36 112 31081 58391 17 41 103925 164808 42 158 92622 134097 39 123 79011 80238 41 104 93487 133252 36 94 64520 54518 47 73 93473 121850 45 52 114360 79367 41 71 33032 56968 26 21 96125 106314 52 155 151911 191889 47 174 89256 104864 45 136 95671 160791 40 128 5950 15049 4 7 149695 191179 44 165 32551 25109 18 21 31701 45824 14 35 100087 129711 37 137 169707 210012 61 174 150491 194679 39 257 120192 197680 42 207 95893 81180 36 103 151715 197765 49 171 176225 214738 28 279 59900 96252 43 83 104767 124527 42 130 114799 153242 37 131 72128 145707 30 126 143592 113963 35 158 89626 134904 44 138 131072 114268 36 200 126817 94333 28 104 81351 102204 45 111 22618 23824 23 26 88977 111563 45 115 92059 91313 38 127 81897 89770 38 140 108146 100125 46 121 126372 165278 36 183 249771 181712 41 68 71154 80906 38 112 71571 75881 37 103 55918 83963 28 63 160141 175721 45 166 38692 68580 26 38 102812 136323 44 163 56622 55792 8 59 15986 25157 27 27 123534 100922 38 108 108535 118845 37 88 93879 170492 57 92 144551 81716 45 170 56750 115750 37 98 127654 105590 40 205 65594 92795 31 96 59938 82390 36 107 146975 135599 40 150 143372 111542 36 123 168553 162519 35 176 183500 211381 39 213 165986 189944 65 208 184923 226168 30 307 140358 117495 51 125 149959 195894 41 208 57224 80684 36 73 43750 19630 19 49 48029 88634 23 82 104978 139292 44 206 100046 128602 40 112 101047 135848 40 139 197426 178377 30 60 160902 106330 41 70 147172 178303 40 112 109432 116938 45 142 1168 5841 1 11 83248 106020 40 130 25162 24610 11 31 45724 74151 45 132 110529 232241 38 219 855 6622 0 4 101382 127097 30 102 14116 13155 8 39 89506 160501 39 125 135356 91502 48 121 116066 24469 48 42 144244 88229 29 111 8773 13983 8 16 102153 80716 43 70 117440 157384 52 162 104128 122975 53 173 134238 191469 48 171 134047 231257 48 172 279488 258287 50 254 79756 122531 40 90 66089 61394 36 50 102070 86480 40 113 146760 195791 46 187 154771 18284 42 16 165933 147581 46 175 64593 72558 39 90 92280 147341 41 140 67150 114651 46 145 128692 100187 32 141 124089 130332 39 125 125386 134218 39 241 37238 10901 21 16 140015 145758 45 175 150047 75767 50 132 154451 134969 36 154 156349 169216 44 198 0 0 0 0 6023 7953 0 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 84601 105406 37 125 68946 174586 52 174 0 0 0 0 0 0 0 0 1644 4245 0 6 6179 21509 5 13 3926 7670 1 3 52789 15673 43 35 0 0 0 0 100350 75882 34 80
Names of X columns:
Grootte Tijd Review Hyperlinks
Endogenous Variable (Column Number)


Categorization


Number of categories (only if categorization<>none)


Cross-Validation? (only if categorization<>none)


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+2par3,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(detcoefdetcoef,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') }

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