Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
144244 152043 44 29 84 88229 107 197426 121726 28 30 83 178377 59 86652 204039 44 49 146 114198 159 65594 185890 48 31 90 92795 94 101382 252805 81 30 77 127097 97 76173 70849 8 35 89 47552 47 124089 366774 95 39 120 130332 123 66089 102424 42 36 100 61394 49 22618 73566 22 23 67 23824 25 149695 372238 85 44 157 191179 158 56622 80953 49 8 27 55792 58 150047 168994 147 50 179 75767 123 151911 334657 142 47 165 191889 172 25162 61857 23 11 30 24610 28 105079 222373 70 42 106 99776 121 69446 220700 71 43 87 113713 100 136588 263411 135 49 185 134163 186 128692 217478 38 32 45 100187 126 134047 316105 154 48 145 231257 165 31701 101097 30 14 41 45824 35 43750 43287 13 19 64 19630 49 143592 187965 79 35 128 113963 156 100350 199726 48 32 66 75882 72 151715 370483 154 46 161 197765 171 113344 327474 125 41 135 230054 137 279488 396725 137 50 175 258287 246 125081 322896 98 39 92 135213 113 68788 164107 50 37 113 72591 70 103037 425544 86 39 144 150773 137 102153 198094 66 43 151 80716 69 147172 306952 76 40 143 178303 108 146760 401260 103 46 163 195791 182 127654 254506 160 38 131 105590 192 110459 179444 71 34 127 113854 132 131072 232765 135 36 116 114268 199 126817 175699 143 28 89 94333 98 108535 361186 69 37 137 118845 83 82317 179306 66 25 84 111848 71 57224 186856 73 36 59 80684 70 135356 240153 76 48 163 91502 118 96125 208051 101 52 180 106314 155 1168 23623 12 1 0 5841 11 102070 283950 84 40 150 86480 107 118906 189897 103 52 208 102509 123 59900 233632 77 43 97 96252 80 79011 166266 67 41 111 80238 103 103297 358752 139 52 162 101345 148 143372 189252 83 36 139 111542 123 109432 297982 147 45 115 116938 141 167949 305704 113 36 139 164263 194 8773 38214 16 8 21 13983 16 45724 163766 83 45 119 74151 101 149959 285330 145 41 130 195894 204 81351 239314 99 45 154 102204 109 103129 267198 99 41 127 158376 138 154451 246745 116 36 118 134969 151 88977 242585 78 45 171 111563 113 140824 270018 96 38 116 186099 165 84601 233143 65 37 88 105406 122 169707 302218 122 56 208 210012 169 187326 498732 149 33 122 250931 177 156349 301703 185 44 147 169216 194 108146 359644 140 45 143 100125 121 168553 222504 94 35 127 162519 170 144408 207822 74 34 117 115466 124 183500 285198 158 39 104 211381 210 104128 196269 50 53 171 122975 158 33032 78800 20 26 66 56968 21 43929 162874 61 27 64 100792 71 56750 251466 76 37 85 115750 96 126372 341637 130 36 133 165278 178 160141 447353 147 45 138 175721 157 71571 182231 83 37 110 75881 101 125818 176082 103 29 85 111669 162 38692 145943 30 26 99 68580 38 95893 252529 89 36 127 81180 100 67150 282399 110 46 124 114651 142 110529 384053 135 38 102 232241 216 59938 261494 128 36 135 82390 107 81625 237633 117 55 184 94853 93 71154 201783 133 38 134 80906 109 104767 264889 92 42 142 124527 126 125386 236660 121 39 126 134218 239 165933 383703 127 46 161 147581 173 64520 173510 68 42 126 54518 71 165986 367807 151 58 221 189944 193 102812 280343 117 44 92 136323 159 81897 191030 127 38 133 89770 137 37110 155915 57 32 99 64057 66 146975 314255 73 36 132 135599 144 92059 187167 79 38 90 91313 126 144551 179797 165 45 159 81716 164 184923 397681 165 30 106 226168 297 79756 187992 71 40 137 122531 89 140015 323545 145 45 136 145758 170 89506 311281 106 39 137 160501 119 64593 157429 55 39 112 72558 90 70168 215710 79 36 89 104470 109 134238 403932 137 48 167 191469 161 101047 301614 169 40 124 135848 135 92622 324178 123 39 122 134097 123 14116 31961 18 8 9 13155 39 15986 150216 52 27 77 25157 27 89256 175523 99 45 146 104864 133 150491 323485 115 39 137 194679 256 140358 287015 117 51 176 117495 125 114948 369889 168 59 199 165354 142 95671 213060 94 40 137 160791 125 176225 303406 139 28 73 214738 267 93487 195153 75 36 108 133252 87 89626 237323 85 44 148 134904 133 66485 213274 82 33 82 110896 92 79089 296074 92 43 139 169351 149 55918 153613 62 28 89 83963 61 112302 318563 133 48 178 198299 159 104581 207280 86 38 139 116136 115 117440 353021 137 52 187 157384 160 101629 422946 112 43 148 188355 117 112098 218443 134 38 133 106194 145 68946 366745 130 47 115 174586 173 114799 228595 52 37 125 153242 132 119442 369331 132 39 148 189723 185 100087 279012 97 37 120 129711 133 139165 278019 123 45 165 184531 152 83243 270750 117 43 148 153990 125 123534 156923 71 36 130 100922 108 6179 46660 12 5 13 21509 13 1644 7199 7 0 0 4245 6 6023 14688 4 0 0 7953 5 120192 338543 146 42 150 197680 190 83248 195817 146 40 103 106020 130 103925 336047 124 39 143 164808 149 72128 216027 96 30 87 145707 121 112431 271965 123 45 148 140303 147 92280 236370 104 41 135 147341 140 83515 219420 138 41 144 96785 134 48029 185468 89 23 36 88634 82 93879 318651 130 57 122 170492 88 855 21054 4 0 0 6622 4 100046 259692 128 40 125 128602 111 31081 115469 33 17 46 58391 41 104978 219475 92 40 88 139292 205 5950 24188 8 4 7 15049 7 3926 17547 0 1 4 7670 3
Names of X columns:
#karakters #SecRFC #Blogs #Reviews #FBMinPR+120 #seconden #blogs
Endogenous Variable (Column Number)
Categorization
quantiles
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