Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
56 79 30 115 94 146283 144 145 26 89 108 30 116 103 96933 135 132 0 44 43 26 100 93 95757 84 84 27 84 78 38 140 123 143983 130 127 23 88 86 44 166 148 75851 82 78 0 55 44 30 99 90 59238 60 60 27 60 104 40 139 124 93163 131 131 0 154 158 47 181 168 151511 140 133 17 53 102 30 116 115 136368 151 150 25 119 77 31 116 71 112642 91 91 27 75 80 30 108 108 127766 119 118 26 92 123 34 129 120 85646 123 119 23 100 73 31 118 114 98579 90 89 27 73 105 33 125 120 131741 113 108 20 77 107 33 127 124 171975 175 162 24 99 84 36 136 126 159676 96 92 0 30 33 14 46 37 58391 41 41 23 76 42 17 54 38 31580 47 47 20 146 96 32 124 120 136815 126 120 25 67 106 30 115 93 120642 105 105 0 56 56 35 128 95 69107 80 79 26 58 59 28 97 90 108016 73 70 20 119 76 34 125 110 79336 68 67 28 66 91 39 149 138 93176 127 127 26 89 115 39 149 133 161632 154 152 0 41 76 29 108 96 102996 112 109 30 68 101 44 166 164 160604 137 133 12 168 94 21 80 78 158051 135 123 35 132 92 28 107 102 162647 230 230 0 71 75 28 107 99 60622 71 68 0 112 128 38 146 129 179566 147 147 0 70 56 32 123 114 96144 105 101 0 57 41 29 111 99 129847 107 108 25 103 67 27 105 104 71180 116 114 18 52 77 40 155 138 86767 89 88 0 62 66 40 155 151 93487 84 83 0 45 69 28 104 72 82981 113 113 20 46 105 34 132 120 73815 120 118 24 63 116 33 127 115 94552 110 110 0 53 62 33 122 98 67808 78 76 30 78 100 35 87 71 106175 145 141 27 46 67 29 109 107 76669 91 91 13 41 46 20 78 73 57283 48 48 18 91 135 37 141 129 72413 150 144 0 63 124 33 124 118 96971 181 168 31 63 58 29 112 104 120336 121 117 29 32 68 28 108 107 93913 99 100 29 34 37 21 78 36 32036 40 37 23 93 93 41 158 139 102255 87 87 28 55 56 20 78 56 63506 66 64 25 72 83 30 119 93 68370 58 58 23 42 59 22 88 87 50517 77 76 26 71 133 42 155 110 103950 130 129 23 65 106 32 123 83 84396 101 101 32 41 71 36 136 98 55515 120 89 18 86 116 31 117 82 209056 195 193 0 95 98 33 124 115 142775 106 101 33 49 64 40 151 140 68847 83 82 0 64 32 38 145 120 20112 37 36 28 38 25 24 87 66 61023 77 75 26 52 46 43 165 139 112494 144 131 24 247 63 31 120 119 78876 95 90 22 139 95 40 150 141 170745 169 166 0 110 113 37 136 133 122037 134 133 30 67 111 31 116 98 112283 197 196 19 83 120 39 150 117 120691 140 136 21 70 87 32 118 105 122422 125 123 0 32 25 18 71 55 25899 21 21 29 83 131 39 144 132 139296 167 163 25 70 47 30 110 73 89455 96 96 29 103 109 37 147 86 147866 151 151 0 34 37 32 111 48 14336 23 23 0 40 15 17 68 48 30059 21 14 27 46 54 12 48 43 41907 90 87 27 18 16 13 51 46 35885 60 56 25 60 22 17 68 65 55764 26 25 14 39 37 17 64 52 35619 41 41 27 31 29 20 76 68 40557 35 33 25 54 55 17 66 47 44197 68 68 23 14 5 17 68 41 4103 6 6 0 23 0 17 66 47 4694 0 0 25 77 27 22 83 71 62991 41 39 22 19 37 15 55 30 24261 38 37 20 49 29 12 41 24 21425 47 47 23 20 17 17 66 63 27184 34 34 24
Names of X columns:
login blog review fdb fdb120 sec hyp blog num
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