Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
10102 3.4 8863 8626 8366 12008 8463 4.8 10102 8863 8626 9169 9114 6.5 8463 10102 8863 8788 8563 8.5 9114 8463 10102 8417 8872 15.1 8563 9114 8463 8247 8301 15.7 8872 8563 9114 8197 8301 18.7 8301 8872 8563 8236 8278 19.2 8301 8301 8872 8253 7736 12.9 8278 8301 8301 7733 7973 14.4 7736 8278 8301 8366 8268 6.2 7973 7736 8278 8626 9476 3.3 8268 7973 7736 8863 11100 4.6 9476 8268 7973 10102 8962 7.1 11100 9476 8268 8463 9173 7.8 8962 11100 9476 9114 8738 9.9 9173 8962 11100 8563 8459 13.6 8738 9173 8962 8872 8078 17.1 8459 8738 9173 8301 8411 17.8 8078 8459 8738 8301 8291 18.6 8411 8078 8459 8278 7810 14.7 8291 8411 8078 7736 8616 10.5 7810 8291 8411 7973 8312 8.6 8616 7810 8291 8268 9692 4.4 8312 8616 7810 9476 9911 2.3 9692 8312 8616 11100 8915 2.8 9911 9692 8312 8962 9452 8.8 8915 9911 9692 9173 9112 10.7 9452 8915 9911 8738 8472 13.9 9112 9452 8915 8459 8230 19.3 8472 9112 9452 8078 8384 19.5 8230 8472 9112 8411 8625 20.4 8384 8230 8472 8291 8221 15.3 8625 8384 8230 7810 8649 7.9 8221 8625 8384 8616 8625 8.3 8649 8221 8625 8312 10443 4.5 8625 8649 8221 9692 10357 3.2 10443 8625 8649 9911 8586 5 10357 10443 8625 8915 8892 6.6 8586 10357 10443 9452 8329 11.1 8892 8586 10357 9112 8101 12.8 8329 8892 8586 8472 7922 16.3 8101 8329 8892 8230 8120 17.4 7922 8101 8329 8384 7838 18.9 8120 7922 8101 8625 7735 15.8 7838 8120 7922 8221 8406 11.7 7735 7838 8120 8649 8209 6.4 8406 7735 7838 8625 9451 2.9 8209 8406 7735 10443 10041 4.7 9451 8209 8406 10357 9411 2.4 10041 9451 8209 8586 10405 7.2 9411 10041 9451 8892 8467 10.7 10405 9411 10041 8329 8464 13.4 8467 10405 9411 8101 8102 18.3 8464 8467 10405 7922 7627 18.4 8102 8464 8467 8120 7513 16.8 7627 8102 8464 7838 7510 16.6 7513 7627 8102 7735 8291 14.1 7510 7513 7627 8406 8064 6.1 8291 7510 7513 8209 9383 3.5 8064 8291 7510 9451 9706 1.7 9383 8064 8291 10041 8579 2.3 9706 9383 8064 9411 9474 4.5 8579 9706 9383 10405 8318 9.3 9474 8579 9706 8467 8213 14.2 8318 9474 8579 8464 8059 17.3 8213 8318 9474 8102 9111 23 8059 8213 8318 7627 7708 16.3 9111 8059 8213 7513 7680 18.4 7708 9111 8059 7510 8014 14.2 7680 7708 9111 8291 8007 9.1 8014 7680 7708 8064 8718 5.9 8007 8014 7680 9383 9486 7.2 8718 8007 8014 9706 9113 6.8 9486 8718 8007 8579 9025 8 9113 9486 8718 9474 8476 14.3 9025 9113 9486 8318 7952 14.6 8476 9025 9113 8213 7759 17.5 7952 8476 9025 8059 7835 17.2 7759 7952 8476 9111 7600 17.2 7835 7759 7952 7708 7651 14.1 7600 7835 7759 7680 8319 10.4 7651 7600 7835 8014 8812 6.8 8319 7651 7600 8007 8630 4.1 8812 8319 7651 8718
Names of X columns:
S T S1 S2 S3 S12
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
2 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation