Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
112285 1418 30 145 0 84786 869 28 101 0 83123 1530 38 98 0 101193 2172 30 132 0 38361 901 22 60 0 68504 463 26 38 0 119182 3201 25 144 0 22807 371 18 5 0 17140 1192 11 28 1 116174 1583 26 84 0 57635 1439 25 79 0 66198 1764 38 127 0 71701 1495 44 78 0 57793 1373 30 60 0 80444 2187 40 131 0 53855 1491 34 84 0 97668 4041 47 133 0 133824 1706 30 150 0 101481 2152 31 91 0 99645 1036 23 132 0 114789 1882 36 136 0 99052 1929 36 124 0 67654 2242 30 118 0 65553 1220 25 70 0 97500 1289 39 107 0 69112 2515 34 119 0 82753 2147 31 89 0 85323 2352 31 112 0 72654 1638 33 108 0 30727 1222 25 52 0 77873 1812 33 112 0 117478 1677 35 116 0 74007 1579 42 123 0 90183 1731 43 125 0 61542 807 30 27 0 101494 2452 33 162 0 27570 829 13 32 1 55813 1940 32 64 0 79215 2662 36 92 0 1423 186 0 0 1 55461 1499 28 83 0 31081 865 14 41 0 22996 1793 17 47 1 83122 2527 32 120 0 70106 2747 30 105 0 60578 1324 35 79 0 39992 2702 20 65 1 79892 1383 28 70 0 49810 1179 28 55 0 71570 2099 39 39 0 100708 4308 34 67 0 33032 918 26 21 0 82875 1831 39 127 0 139077 3373 39 152 0 71595 1713 33 113 0 72260 1438 28 99 0 5950 496 4 7 0 115762 2253 39 141 0 32551 744 18 21 0 31701 1161 14 35 0 80670 2352 29 109 0 143558 2144 44 133 0 117105 4691 21 123 1 23789 1112 16 26 1 120733 2694 28 230 0 105195 1973 35 166 0 73107 1769 28 68 0 132068 3148 38 147 0 149193 2474 23 179 0 46821 2084 36 61 0 87011 1954 32 101 0 95260 1226 29 108 0 55183 1389 25 90 0 106671 1496 27 114 0 73511 2269 36 103 0 92945 1833 28 142 0 78664 1268 23 79 0 70054 1943 40 88 0 22618 893 23 25 0 74011 1762 40 83 0 83737 1403 28 113 0 69094 1425 34 118 0 93133 1857 33 110 0 95536 1840 28 129 0 225920 1502 34 51 0 62133 1441 30 93 0 61370 1420 33 76 0 43836 1416 22 49 0 106117 2970 38 118 0 38692 1317 26 38 0 84651 1644 35 141 0 56622 870 8 58 0 15986 1654 24 27 0 95364 1054 29 91 0 26706 937 20 48 1 89691 3004 29 63 0 67267 2008 45 56 0 126846 2547 37 144 0 41140 1885 33 73 0 102860 1626 33 168 0 51715 1468 25 64 0 55801 2445 32 97 0 111813 1964 29 117 0 120293 1381 28 100 0 138599 1369 28 149 0 161647 1659 31 187 0 115929 2888 52 127 0 24266 1290 21 37 1 162901 2845 24 245 0 109825 1982 41 87 0 129838 1904 33 177 0 37510 1391 32 49 0 43750 602 19 49 0 40652 1743 20 73 0 87771 1559 31 177 0 85872 2014 31 94 0 89275 2143 32 117 0 44418 2146 18 60 1 192565 874 23 55 0 35232 1590 17 39 1 40909 1590 20 64 1 13294 1210 12 26 1 32387 2072 17 64 1 140867 1281 30 58 0 120662 1401 31 95 0 21233 834 10 25 1 44332 1105 13 26 1 61056 1272 22 76 1 101338 1944 42 129 0 1168 391 1 11 0 13497 761 9 2 1 65567 1605 32 101 0 25162 530 11 28 0 32334 1988 25 36 1 40735 1386 36 89 0 91413 2395 31 193 0 855 387 0 4 0 97068 1742 24 84 0 44339 620 13 23 1 14116 449 8 39 0 10288 800 13 14 1 65622 1684 19 78 1 16563 1050 18 14 1 76643 2699 33 101 0 110681 1606 40 82 0 29011 1502 22 24 1 92696 1204 38 36 0 94785 1138 24 75 0 8773 568 8 16 0 83209 1459 35 55 0 93815 2158 43 131 0 86687 1111 43 131 0 34553 1421 14 39 1 105547 2833 41 144 0 103487 1955 38 139 0 213688 2922 45 211 0 71220 1002 31 78 0 23517 1060 13 50 1 56926 956 28 39 0 91721 2186 31 90 0 115168 3604 40 166 0 111194 1035 30 12 0 51009 1417 16 57 1 135777 3261 37 133 0 51513 1587 30 69 0 74163 1424 35 119 0 51633 1701 32 119 0 75345 1249 27 65 0 33416 946 20 61 1 83305 1926 18 49 1 98952 3352 31 101 0 102372 1641 31 196 0 37238 2035 21 15 0 103772 2312 39 136 0 123969 1369 41 89 0 27142 1577 13 40 1 135400 2201 32 123 0 21399 961 18 21 1 130115 1900 39 163 0 24874 1254 14 29 1 34988 1335 7 35 1 45549 1597 17 13 1 6023 207 0 5 0 64466 1645 30 96 0 54990 2429 37 151 0 1644 151 0 6 0 6179 474 5 13 0 3926 141 1 3 0 32755 1639 16 56 1 34777 872 32 23 0 73224 1318 24 57 0 27114 1018 17 14 1 20760 1383 11 43 1 37636 1314 24 20 1 65461 1335 22 72 1 30080 1403 12 87 1 24094 910 19 21 1 69008 616 13 56 1 54968 1407 17 59 1 46090 771 15 82 1 27507 766 16 43 1 10672 473 24 25 1 34029 1376 15 38 1 46300 1232 17 25 1 24760 1521 18 38 1 18779 572 20 12 1 21280 1059 16 29 1 40662 1544 16 47 1 28987 1230 18 45 1 22827 1206 22 40 1 18513 1205 8 30 1 30594 1255 17 41 1 24006 613 18 25 1 27913 721 16 23 1 42744 1109 23 14 1 12934 740 22 16 1 22574 1126 13 26 1 41385 728 13 21 1 18653 689 16 27 1 18472 592 16 9 1 30976 995 20 33 1 63339 1613 22 42 1 25568 2048 17 68 1 33747 705 18 32 1 4154 301 17 6 1 19474 1803 12 67 1 35130 799 7 33 1 39067 861 17 77 1 13310 1186 14 46 1 65892 1451 23 30 1 4143 628 17 0 1 28579 1161 14 36 1 51776 1463 15 46 1 21152 742 17 18 1 38084 979 21 48 1 27717 675 18 29 1 32928 1241 18 28 1 11342 676 17 34 1 19499 1049 17 33 1 16380 620 16 34 1 36874 1081 15 33 1 48259 1688 21 80 1 16734 736 16 32 1 28207 617 14 30 1 30143 812 15 41 1 41369 1051 17 41 1 45833 1656 15 51 1 29156 705 15 18 1 35944 945 10 34 1 36278 554 6 31 1 45588 1597 22 39 1 45097 982 21 54 1 3895 222 1 14 1 28394 1212 18 24 1 18632 1143 17 24 1 2325 435 4 8 1 25139 532 10 26 1 27975 882 16 19 1 14483 608 16 11 1 13127 459 9 14 1 5839 578 16 1 1 24069 826 17 39 1 3738 509 7 5 1 18625 717 15 37 1 36341 637 14 32 1 24548 857 14 38 1 21792 830 18 47 1 26263 652 12 47 1 23686 707 16 37 1 49303 954 21 51 1 25659 1461 19 45 1 28904 672 16 21 1 2781 778 1 1 1 29236 1141 16 42 1 19546 680 10 26 1 22818 1090 19 21 1 32689 616 12 4 1 5752 285 2 10 1 22197 1145 14 43 1 20055 733 17 34 1 25272 888 19 31 1 82206 849 14 19 1 32073 1182 11 34 1 5444 528 4 6 1 20154 642 16 11 1 36944 947 20 24 1 8019 819 12 16 1 30884 757 15 72 1 19540 894 16 21 1
Names of X columns:
totsize pageviews compendiums_reviewed totblogs course_cid
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
2 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation