Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
97 197426 39 178377 490 146 187326 173 250931 2563 116 184923 165 226168 1538 113 183500 181 211381 898 75 176225 139 214738 1212 228 169707 166 210012 790 138 169265 116 163073 738 153 167949 114 164263 845 248 165986 155 189944 1369 161 165933 127 147581 1830 155 165904 107 127667 711 142 160902 126 106330 992 145 160141 161 175721 1272 159 156349 185 169216 852 153 154771 63 18284 575 130 154451 121 134969 1101 177 151911 150 191889 1410 181 151715 160 197765 1352 140 150491 132 194679 1208 196 150047 147 75767 739 140 149959 176 195894 926 175 149695 88 191179 865 155 147172 82 178303 677 147 146975 75 135599 971 177 146760 128 195791 1574 159 144551 165 81716 1051 132 144408 88 115466 763 94 144244 62 88229 724 140 143592 93 113963 652 130 140824 96 186099 504 176 140358 121 117495 893 153 140015 146 145758 1034 179 139165 143 184531 1111 197 136588 135 134163 692 163 135356 76 91502 740 170 134238 152 191469 1716 145 134047 163 231257 884 129 131072 154 114268 925 57 128692 48 100187 723 144 127654 168 105590 732 92 126817 143 94333 637 144 126372 156 165278 1266 95 125818 103 111669 527 126 125386 128 134218 811 97 125081 121 135213 1390 144 124089 96 130332 1613 137 123534 76 100922 459 155 120192 161 197680 1118 163 119442 141 189723 1293 227 118906 103 102509 636 187 117440 137 157384 1031 148 116066 55 24469 524 208 114948 176 165354 1775 136 114799 66 153242 669 134 114360 101 79367 2089 149 113344 155 230054 1230 160 112431 123 140303 847 187 112302 145 198299 906 146 112098 134 106194 1154 102 110529 164 232241 1251 143 110459 75 113854 510 115 109432 148 116938 698 151 108535 85 118845 1586 144 108146 140 100125 1001 118 105079 70 99776 710 98 104978 117 139292 906 142 104767 103 124527 1030 151 104581 116 116136 1092 171 104128 50 122975 511 156 103925 152 164808 1319 171 103297 139 101345 1186 142 103129 114 158376 1201 148 103037 110 150773 1443 96 102812 120 136323 703 151 102153 98 80716 862 173 102070 94 86480 1031 151 101629 112 188355 1348 77 101382 81 127097 866 135 101047 169 135848 1079 71 100350 62 75882 695 133 100087 102 129711 1229 139 100046 133 128602 1288 201 96125 107 106314 764 141 95893 90 81180 919 158 95676 99 160792 691 126 93879 152 170492 1099 119 93487 84 133252 766 65 93473 57 121850 1150 128 92622 126 134097 1566 147 92280 118 147341 668 90 92059 101 91313 910 169 89626 85 134904 894 150 89506 118 160501 1351 156 89256 129 104864 1187 179 88977 85 111563 784 149 86652 50 114198 758 94 84601 85 105406 816 154 83515 158 96785 1370 103 83248 146 106020 785 148 83243 150 153990 763 84 82317 77 111848 569 144 81897 131 89770 781 203 81625 132 94853 743 160 81351 107 102204 900 152 79756 80 122531 575 147 79089 114 169351 981 111 79011 97 80238 784 89 76173 8 47552 179 87 72128 163 145707 542 121 71571 102 75881 746 146 71154 137 80906 767 100 70168 79 104470 695 127 69867 83 100826 1186 153 69652 56 33750 456 87 69446 87 113713 724 129 68946 164 174586 1145 113 68788 57 72591 785 124 67150 110 114651 905 92 66485 104 110896 661 112 66089 65 61394 507 102 65594 48 92795 632 115 64593 60 72558 790 148 64520 68 54518 488 135 59938 149 82390 1128 97 59900 104 96252 1257 59 57224 86 80684 800 101 56750 89 115750 846 27 56622 49 55792 437 112 55918 74 83963 795 89 52789 37 15673 309 40 48029 120 88634 833 130 45724 87 74151 641 73 43929 83 100792 415 64 43750 13 19630 214 99 38692 30 68580 657 78 37238 41 10901 716 110 37110 67 64057 665
Names of X columns:
FbackMess CompendiumCharacters BloggedComputations CompendiumSeconds CourseViews
Endogenous Variable (Column Number)
Categorization
none
quantiles
hclust
equal
Number of categories (only if categorization<>none)
Cross-Validation? (only if categorization<>none)
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