Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
210907 1 1 24188 145 120982 1 1 18273 101 176508 1 1 14130 98 179321 1 0 32287 132 123185 1 1 8654 60 52746 1 1 9245 38 385534 1 1 33251 144 33170 1 1 1271 5 101645 1 1 5279 28 149061 1 1 27101 84 165446 1 0 16373 79 237213 1 1 19716 127 173326 1 0 17753 78 133131 1 1 9028 60 258873 1 1 18653 131 180083 1 0 8828 84 324799 1 0 29498 133 230964 1 1 27563 150 236785 1 0 18293 91 135473 1 1 22530 132 202925 1 0 15977 136 215147 1 1 35082 124 344297 1 1 16116 118 153935 1 1 15849 70 132943 1 0 16026 107 174724 1 1 26569 119 174415 1 0 24785 89 225548 1 1 17569 112 223632 1 1 23825 108 124817 1 0 7869 52 221698 1 1 14975 112 210767 1 0 37791 116 170266 1 1 9605 123 260561 1 1 27295 125 84853 1 0 2746 27 294424 1 0 34461 162 101011 1 0 8098 32 215641 1 0 4787 64 325107 1 1 24919 92 7176 1 0 603 0 167542 1 0 16329 83 106408 1 1 12558 41 96560 1 0 7784 47 265769 1 0 28522 120 269651 1 1 22265 105 149112 1 1 14459 79 175824 1 1 14526 65 152871 1 1 22240 70 111665 1 1 11802 55 116408 1 0 7623 39 362301 1 1 11912 67 78800 1 0 7935 21 183167 1 0 18220 127 277965 1 1 19199 152 150629 1 0 19918 113 168809 1 1 21884 99 24188 1 1 2694 7 329267 1 1 15808 141 65029 1 0 3597 21 101097 1 1 5296 35 218946 1 0 25239 109 244052 1 0 29801 133 341570 1 1 18450 123 103597 1 1 7132 26 233328 1 1 34861 230 256462 1 0 35940 166 206161 1 1 16688 68 311473 1 0 24683 147 235800 1 1 46230 179 177939 1 0 10387 61 207176 1 0 21436 101 196553 1 1 30546 108 174184 1 1 19746 90 143246 1 0 15977 114 187559 1 0 22583 103 187681 1 1 17274 142 119016 1 1 16469 79 182192 1 1 14251 88 73566 1 0 3007 25 194979 1 0 16851 83 167488 1 0 21113 113 143756 1 1 17401 118 275541 1 0 23958 110 243199 1 1 23567 129 182999 1 1 13065 51 135649 1 0 15358 93 152299 1 1 14587 76 120221 1 1 12770 49 346485 1 1 24021 118 145790 1 1 9648 38 193339 1 1 20537 141 80953 1 1 7905 58 122774 1 1 4527 27 130585 1 1 30495 91 112611 1 1 7117 48 286468 1 1 17719 63 241066 1 1 27056 56 148446 1 0 33473 144 204713 1 0 9758 73 182079 1 1 21115 168 140344 1 0 7236 64 220516 1 1 13790 97 243060 1 0 32902 117 162765 1 1 25131 100 182613 1 0 30910 149 232138 1 1 35947 187 265318 1 0 29848 127 85574 1 0 6943 37 310839 1 1 42705 245 225060 1 1 31808 87 232317 1 1 26675 177 144966 1 1 8435 49 43287 1 1 7409 49 155754 1 0 14993 73 164709 1 1 36867 177 201940 1 1 33835 94 235454 1 1 24164 117 220801 1 1 12607 60 99466 1 0 22609 55 92661 1 1 5892 39 133328 1 1 17014 64 61361 1 1 5394 26 125930 1 1 9178 64 100750 1 1 6440 58 224549 1 0 21916 95 82316 1 1 4011 25 102010 1 1 5818 26 101523 1 1 18647 76 243511 1 0 20556 129 22938 1 0 238 11 41566 1 1 70 2 152474 1 0 22392 101 61857 1 0 3913 28 99923 1 1 12237 36 132487 1 0 8388 89 317394 1 0 22120 193 21054 1 1 338 4 209641 1 1 11727 84 22648 1 0 3704 23 31414 1 1 3988 39 46698 1 0 3030 14 131698 1 1 13520 78 91735 1 0 1421 14 244749 1 1 20923 101 184510 1 1 20237 82 79863 1 0 3219 24 128423 1 0 3769 36 97839 1 0 12252 75 38214 1 1 1888 16 151101 1 1 14497 55 272458 1 0 28864 131 172494 1 1 21721 131 108043 1 1 4821 39 328107 1 1 33644 144 250579 1 1 15923 139 351067 1 1 42935 211 158015 1 1 18864 78 98866 1 1 4977 50 85439 0 0 7785 39 229242 0 0 17939 90 351619 0 0 23436 166 84207 0 1 325 12 120445 0 0 13539 57 324598 0 0 34538 133 131069 0 1 12198 69 204271 0 1 26924 119 165543 0 0 12716 119 141722 0 0 8172 65 116048 0 1 10855 61 250047 0 0 11932 49 299775 0 1 14300 101 195838 0 1 25515 196 173260 0 0 2805 15 254488 0 1 29402 136 104389 0 0 16440 89 136084 0 1 11221 40 199476 0 1 28732 123 92499 0 1 5250 21 224330 0 0 28608 163 135781 0 0 8092 29 74408 0 0 4473 35 81240 0 1 1572 13 14688 0 1 2065 5 181633 0 0 14817 96 271856 0 1 16714 151 7199 0 0 556 6 46660 0 0 2089 13 17547 0 1 2658 3 133368 0 1 10695 56 95227 0 1 1669 23 152601 0 1 16267 57 98146 0 1 7768 14 79619 0 0 7252 43 59194 0 1 6387 20 139942 0 1 18715 72 118612 0 0 7936 87 72880 0 0 8643 21 65475 0 0 7294 56 99643 0 0 4570 59 71965 0 0 7185 82 77272 0 1 10058 43 49289 0 1 2342 25 135131 0 1 8509 38 108446 0 0 13275 25 89746 0 0 6816 38 44296 0 0 1930 12 77648 0 1 8086 29 181528 0 0 10737 47 134019 0 0 8033 45 124064 0 0 7058 40 92630 0 1 6782 30 121848 0 0 5401 41 52915 0 1 6521 25 81872 0 1 10856 23 58981 0 0 2154 14 53515 0 1 6117 16 60812 0 0 5238 26 56375 0 0 4820 21 65490 0 1 5615 27 80949 0 0 4272 9 76302 0 1 8702 33 104011 0 0 15340 42 98104 0 0 8030 68 67989 0 0 9526 32 30989 0 0 1278 6 135458 0 1 4236 67 73504 0 0 3023 33 63123 0 0 7196 77 61254 0 1 3394 46 74914 0 1 6371 30 31774 0 0 1574 0 81437 0 0 9620 36 87186 0 0 6978 46 50090 0 1 4911 18 65745 0 0 8645 48 56653 0 0 8987 29 158399 0 0 5544 28 46455 0 0 3083 34 73624 0 0 6909 33 38395 0 0 3189 34 91899 0 0 6745 33 139526 0 1 16724 80 52164 0 1 4850 32 51567 0 1 7025 30 70551 0 0 6047 41 84856 0 0 7377 41 102538 0 1 9078 51 86678 0 1 4605 18 85709 0 0 3238 34 34662 0 0 8100 31 150580 0 0 9653 39 99611 0 1 8914 54 19349 0 1 786 14 99373 0 1 6700 24 86230 0 1 5788 24 30837 0 0 593 8 31706 0 0 4506 26 89806 0 0 6382 19 62088 0 0 5621 11 40151 0 1 3997 14 27634 0 0 520 1 76990 0 0 8891 39 37460 0 1 999 5 54157 0 0 7067 37 49862 0 0 4639 32 84337 0 1 5654 38 64175 0 1 6928 47 59382 0 0 1514 47 119308 0 1 9238 37 76702 0 0 8204 51 103425 0 0 5926 45 70344 0 1 5785 21 43410 0 0 4 1 104838 0 1 5930 42 62215 0 0 3710 26 69304 0 0 705 21 53117 0 0 443 4 19764 0 0 2416 10 86680 0 1 7747 43 84105 0 0 5432 34 77945 0 0 4913 31 89113 0 1 2650 19 91005 0 0 2370 34 40248 0 1 775 6 64187 0 0 5576 11 50857 0 0 1352 24 56613 0 1 3080 16 62792 0 1 10205 72
Names of X columns:
time pop gender reviews blogs
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