Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
4.031636 0.5215052 9.166456 1.303763 3.702076 0.4248284 7.970589 1.416094 3.056176 0.4250311 7.104091 1.052458 3.280707 0.4771938 6.621064 1.312283 2.984728 0.8280212 7.529215 1.309429 3.693712 0.6156186 8.170938 1.492409 3.226317 0.366627 8.15745 1.026556 2.190349 0.4308883 7.378962 1.005406 2.599515 0.2810287 7.921496 1.334886 3.080288 0.4646245 8.15674 1.393873 2.929672 0.2693951 8.856365 1.128092 2.922548 0.5779049 8.817177 1.122787 3.234943 0.5661151 8.734347 1.213104 2.983081 0.5077584 9.345927 1.253528 3.284389 0.7507175 8.99297 1.094796 3.806511 0.6808395 10.78512 0.9129438 3.784579 0.7661091 8.886867 1.19513 2.645654 0.4561473 8.818847 0.9274994 3.092081 0.4977496 8.823744 0.9653326 3.204859 0.4193273 9.165298 1.198078 3.107225 0.6095514 8.652657 0.966362 3.466909 0.457337 8.173054 0.9736851 2.984404 0.5705478 7.563416 0.9948013 3.218072 0.3478996 7.595809 0.8262616 2.82731 0.3874993 8.381467 0.6888877 3.182049 0.5824285 7.216432 0.7813066 2.236319 0.2391033 6.540178 0.6047907 2.033218 0.2367445 6.238914 1.08624 1.644804 0.2626158 5.487288 0.7740255 1.627971 0.4240934 5.759462 1.026032 1.677559 0.365275 5.993215 0.6764351 2.330828 0.3750758 7.474726 0.830525 2.493615 0.4090056 7.348907 0.7916238 2.257172 0.3891676 7.303379 0.7523907 2.655517 0.240261 7.119314 0.6702018 2.298655 0.1589496 6.99378 0.8803359 2.600402 0.4393373 6.958153 0.9142966 3.04523 0.5094681 7.595706 0.9610421 2.790583 0.3743465 8.088153 0.9301944 3.227052 0.4339828 7.555753 0.8679657 2.967479 0.4130557 7.315433 0.9891596 2.938817 0.3288928 7.893427 0.9972879 3.277961 0.5186648 8.858794 0.7987437 3.423985 0.5486504 8.839367 0.9753785 3.072646 0.5469111 8.014733 0.9347208 2.754253 0.4963494 7.873465 0.9732341 2.910431 0.5308929 8.930377 0.8152998 3.174369 0.5957761 10.50055 0.9402092 3.068387 0.5570584 12.61144 0.794493 3.089543 0.5731325 11.41787 0.9313403 2.906654 0.5005416 11.87249 0.9220503 2.931161 0.5431269 11.06082 0.7845167 3.02566 0.5593657 12.04331 0.8220981 2.939551 0.6911693 9.776299 0.8910255 2.691019 0.4403485 9.557194 0.8073056 3.19812 0.5676662 9.20259 0.9514406 3.07639 0.5969114 10.22402 1.147907 2.863873 0.4735537 9.350807 1.172609 3.013802 0.5923935 8.300913 1.281051 3.053364 0.5975556 8.365779 1.165962 2.864753 0.6334127 8.133595 0.9789106 3.057062 0.6057115 7.66047 1.410951 2.959365 0.7046107 8.074839 1.197838 3.252258 0.4805263 7.848597 1.288368 3.602988 0.702686 7.99822 1.102253 3.497704 0.7009017 7.396895 1.197657 3.296867 0.6030854 7.900419 1.299984 3.602417 0.6980919 8.1005 1.198611 3.3001 0.597656 7.899453 1.299252 3.40193 0.8023421 7.599783 1.097604 3.502591 0.6017109 8.100929 1.39977 3.402348 0.5993127 9.002175 1.398396 3.498551 0.6025625 10.2989 1.40188 3.199823 0.7016625 10.10152 1.699717 2.700064 0.4995714 10.69915 1.39761 2.801034 0.4980918 9.69814 1.500135 2.898628 0.497569 9.800951 1.400136 2.800854 0.600183 10.90047 1.400427 2.399942 0.3339542 10.69785 1.341477 2.402724 0.274437 9.297252 1.33858 2.202331 0.3209428 10.39744 1.482977 2.102594 0.5406671 10.90072 1.163253 1.798293 0.4050209 12.90127 1.328468 1.202484 0.2885961 13.09906 1.23455 1.400201 0.3275942 11.69828 1.484741 1.200832 0.3132606 11.09987 1.336579 1.298083 0.2575562 11.30157 1.339292 1.099742 0.2138386 10.70211 1.405225 1.001377 0.1861856 10.09931 1.333491 0.8361743 0.1592713 9.591119 1.14974
Names of X columns:
firearmsuicide firearmhomicide nonfirearmsuicide nonfirearmhomicide
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