Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
18 89 48 63 1760 20 56 52 56 1609 0 18 0 0 192 26 92 49 60 2182 31 131 76 116 3367 36 257 125 138 6727 23 55 46 71 1619 30 56 68 107 1507 30 42 52 50 1682 26 92 67 79 2812 24 74 50 58 1943 30 66 71 91 2017 21 96 41 40 1702 25 110 79 91 3034 18 55 49 61 1379 19 79 54 65 1517 33 53 75 131 1637 15 54 1 45 1169 34 84 54 110 2384 18 24 13 41 726 15 55 17 37 993 30 96 89 84 2683 25 70 37 67 1713 34 50 44 69 2027 21 81 50 58 1818 21 28 39 60 1393 25 154 59 88 2000 31 85 79 75 1346 31 115 60 98 2676 20 43 52 67 2106 28 43 50 84 1591 20 43 54 58 1519 17 101 53 35 2171 25 121 76 74 3003 24 52 60 89 2364 0 1 0 0 1 27 60 53 75 2017 14 50 44 39 1564 32 47 36 93 2072 31 63 83 123 2106 21 69 100 73 2270 34 56 37 118 1643 23 29 25 76 957 24 77 59 65 2025 26 46 55 97 1236 22 91 41 67 1178 35 31 23 63 744 21 92 63 84 1976 31 85 54 112 2224 26 56 67 75 2561 22 28 12 39 658 21 65 84 63 1779 27 71 64 93 2355 30 77 56 76 2017 33 59 54 117 1758 11 54 35 30 1675 26 62 52 65 1760 26 23 25 78 875 23 65 67 87 1169 38 93 36 85 2789 29 56 50 107 1606 19 76 48 60 2020 19 58 46 53 1300 26 35 53 67 1235 26 32 27 90 1215 29 38 38 89 1230 36 67 68 135 2226 25 65 93 71 2897 24 38 56 75 1071 21 15 5 42 340 19 110 53 42 2704 12 64 36 8 1247 30 64 72 86 1422 21 68 46 41 1535 34 66 73 118 2593 32 42 12 91 1397 28 58 76 102 2162 28 94 71 89 2513 21 26 17 46 917 31 71 34 60 1234 26 66 54 69 917 29 59 39 95 1924 23 27 26 17 853 25 34 40 61 1398 22 44 35 55 986 26 47 32 55 1608 33 220 55 124 2577 24 108 58 73 1201 24 56 39 73 1189 21 50 39 67 1431 28 40 48 66 1698 27 74 72 75 2185 25 56 39 83 1228 15 58 27 55 1266 13 36 22 27 830 36 111 48 115 2238 24 68 95 76 1787 1 12 13 0 223 24 100 32 83 2254 31 75 41 90 1952 4 28 22 4 665 20 22 41 56 804 23 49 55 63 1211 23 57 28 52 1143 12 38 30 24 710 16 22 2 17 596 29 44 79 105 1353 10 32 18 20 971 0 0 0 0 0 25 31 46 51 1030 21 66 25 76 1130 23 44 50 59 1284 21 61 59 70 1438 21 57 36 38 849 0 5 0 0 78 0 0 0 0 0 23 39 35 81 925 29 78 68 64 1518 28 95 26 67 1946 23 37 36 89 914 1 19 7 3 778 29 71 67 87 1713 17 40 30 48 895 29 52 55 62 1756 12 40 3 32 701 2 12 10 4 285 21 55 46 70 1774 25 29 34 90 1071 29 46 49 91 1582 2 9 1 1 256 0 9 0 0 98 18 55 33 39 1358 1 3 0 0 41 21 58 48 45 1771 0 3 5 0 42 4 16 8 7 528 0 0 0 0 0 25 45 35 75 1026 26 38 21 52 1296 0 4 0 0 81 4 13 0 1 257 17 23 15 49 914 21 50 50 69 1178 22 19 17 56 1080
Names of X columns:
TNORC TNOLI NOBC NOSFBM TNOPV
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