Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
1330 35 27 37.13 1030 50 28 36.21 895 40 28 32.52 1067 43 27 32.23 1321 46 26 31.91 901 30 23 30.69 1125 57 33 30.67 732 34 30 30.29 1078 27 23 29.56 1033 51 33 29.35 1135 61 46 28.89 865 41 28 28.77 870 58 25 27.69 1554 42 31 27.34 1077 39 22 27.04 1095 32 32 25.67 665 49 38 25.2 603 16 26 25.03 726 43 24 25.01 862 41 31 24.87 840 56 44 24.81 670 16 34 23.99 777 45 29 23.87 863 26 26 23.15 641 44 28 22.9 611 31 35 22.71 1010 43 51 22.5 801 42 20 22.33 589 30 13 22.14 611 53 29 21.79 706 31 35 21.78 601 30 40 21.19 631 33 28 20.46 723 34 38 20.42 623 55 25 20.41 569 80 22 20.31 640 41 28 20.08 1058 38 26 20.08 552 59 32 19.76 818 37 31 19.73 613 18 35 19.71 696 37 30 19.59 479 41 49 19.32 822 25 28 19.28 633 54 20 19.2 653 47 28 18.95 773 14 33 18.63 368 43 25 18.48 936 25 28 18.11 817 55 30 18.01 573 33 27 17.9 410 33 26 17.9 497 31 27 17.89 465 25 14 17.76 652 34 27 17.67 375 19 29 17.58 968 18 28 17.41 681 39 27 17.24 611 75 28 16.99 567 51 23 16.95 523 33 20 16.88 490 45 28 16.85 400 35 28 16.84 557 38 24 16.78 571 50 29 16.76 583 32 9 16.7 598 43 23 16.69 709 42 16 16.69 496 37 39 16.68 413 13 19 16.53 637 20 16 16.51 822 10 34 16.2 405 42 23 16.02 744 25 18 15.84 873 20 35 15.71 592 26 40 15.4 432 41 17 15.33 754 37 28 14.95 725 35 19 14.93 644 14 22 14.78 431 19 27 14.76 635 16 32 14.46 485 11 29 14.38 489 19 18 14.06 471 40 31 14.06 363 17 24 14.03 601 19 27 13.79 577 18 33 13.77 676 15 13 13.6 1058 18 2 13.46 462 42 11 13.38 387 27 53 13.35 549 31 24 13.33 529 31 5 13.22 433 33 9 13.16 553 36 23 13.13 300 12 34 12.98 474 12 13 12.96 371 4 29 12.94 462 17 30 12.87 520 20 24 12.64 450 59 28 12.39 466 18 22 12.38 427 11 8 12.29 377 41 35 12.2 459 37 25 12.18 303 13 35 12.15 549 14 33 11.92 424 33 32 11.8 581 17 28 11.72 384 14 26 11.53 442 11 25 11.37 386 23 22 10.89 362 10 35 10.83 343 22 19 10.82 458 3 29 10.78 474 8 19 10.39 526 16 21 10.13 243 16 35 10.08 320 13 26 10.05 478 10 25 9.92 606 18 30 9.9 293 16 31 9.67 378 10 32 9.64 372 18 10 9.61 314 11 12 9.49 359 34 9 9.49 434 12 32 9.3 447 15 17 9.25 563 7 21 8.8 352 7 17 8.71 393 14 25 8.47 307 55 16 8.43 474 28 24 8.05 231 22 15 7.93 394 24 8 7.71 397 13 34 7.31 343 11 24 7.24 287 10 27 7.11 281 13 17 6.9 376 8 7 6.48 227 2 23 6.34 209 14 3 6.2 413 1 13 5.94 336 12 0 5.46 224 0 21 5.44 171 1 11 5.09 417 11 12 4.99 307 4 0 4.72 147 0 0 4.71 206 4 0 4.08 214 2 2 3.93 166 0 7 2.97 76 0 8 2.4 151 7 0 2 29 0 0 0.27 8 0 0 0.13 4 0 0 0.06 5 0 0 0.03 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0
Names of X columns:
PAGES BLOGS LPRM HRS
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