Free Statistics

of Irreproducible Research!

Author's title

Author*The author of this computation has been verified*
R Software Modulerwasp_regression_trees1.wasp
Title produced by softwareRecursive Partitioning (Regression Trees)
Date of computationWed, 11 Dec 2013 11:58:24 -0500
Cite this page as followsStatistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2013/Dec/11/t13867811171blqthh98ogrd3l.htm/, Retrieved Thu, 28 Mar 2024 12:21:34 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=232111, Retrieved Thu, 28 Mar 2024 12:21:34 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact78
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [Recursive Partitioning (Regression Trees)] [] [2013-12-11 16:58:24] [02b53344bfc7e15f5310bf5039e578c4] [Current]
Feedback Forum

Post a new message
Dataseries X:
1 -4.813031 0.266482
1 -4.075192 0.33559
1 -4.443179 0.311173
1 -4.117501 0.334147
1 -3.747787 0.234513
1 -4.242867 0.299111
1 -5.634322 0.257682
1 -6.167603 0.183721
1 -5.498678 0.327769
1 -5.011879 0.325996
1 -5.24977 0.391002
1 -4.960234 0.363566
1 -6.547148 0.152813
1 -5.660217 0.254989
1 -6.105098 0.203653
1 -5.340115 0.210185
1 -5.44004 0.239764
1 -2.93107 0.434326
1 -3.949079 0.35787
1 -4.554466 0.340176
1 -4.095442 0.262564
1 -5.18696 0.237622
1 -4.330956 0.262384
1 -5.248776 0.210279
1 -5.557447 0.22089
1 -5.571843 0.236853
1 -6.18359 0.226278
1 -6.27169 0.196102
1 -7.120925 0.279789
1 -6.635729 0.209866
0 -7.3483 0.177551
0 -7.682587 0.173319
0 -7.067931 0.175181
0 -7.695734 0.17854
0 -7.964984 0.163519
0 -7.777685 0.170183
1 -6.149653 0.218037
1 -6.006414 0.196371
1 -6.452058 0.212294
1 -6.006647 0.266892
1 -6.647379 0.201095
1 -7.044105 0.063412
0 -7.31055 0.098648
0 -6.793547 0.158266
0 -7.057869 0.091608
0 -6.99582 0.102083
0 -7.156076 0.127642
0 -7.31951 0.200873
0 -6.439398 0.266392
0 -6.482096 0.264967
0 -6.650471 0.254498
0 -6.689151 0.291954
0 -7.072419 0.220434
0 -6.836811 0.269866
1 -4.649573 0.205558
1 -4.333543 0.221727
1 -4.438453 0.238298
1 -4.60826 0.290024
1 -4.476755 0.262633
1 -4.609161 0.221711
0 -7.040508 0.066994
0 -7.293801 0.086372
0 -6.966321 0.095882
0 -7.24562 0.018689
0 -7.496264 0.056844
0 -7.314237 0.006274
1 -5.409423 0.22685
1 -5.324574 0.20566
1 -5.86975 0.151814
1 -6.261141 0.120956
1 -5.720868 0.15883
1 -5.207985 0.224852
1 -5.79182 0.329066
1 -5.389129 0.306636
1 -5.31336 0.201861
1 -5.477592 0.315074
1 -5.775966 0.341169
1 -5.391029 0.250572
1 -5.115212 0.249494
1 -4.913885 0.265699
1 -4.441519 0.155097
1 -5.132032 0.210458
1 -5.022288 0.146948
1 -6.025367 0.078202
1 -5.288912 0.343073
1 -5.657899 0.315903
1 -6.366916 0.335753
1 -5.515071 0.299549
1 -5.783272 0.299793
1 -4.379411 0.375531
1 -4.508984 0.389232
1 -6.411497 0.207156
1 -5.952058 0.08784
1 -6.152551 0.17352
1 -6.251425 0.188056
1 -6.247076 0.180528
1 -6.41744 0.194627
1 -4.020042 0.265315
1 -5.159169 0.202146
1 -3.760348 0.242861
1 -3.700544 0.260481
1 -4.20273 0.310163
1 -3.269487 0.270641
1 -6.878393 0.089267
1 -7.111576 0.14478
1 -6.997403 0.210279
1 -6.981201 0.18455
1 -6.600023 0.249172
1 -6.739151 0.160686
1 -5.845099 0.278679
1 -5.25832 0.256454
1 -6.471427 0.184378
1 -4.876336 0.212054
1 -5.96304 0.250283
1 -6.729713 0.181701
1 -4.673241 0.261549
1 -6.051233 0.27328
1 -4.597834 0.372114
1 -4.913137 0.393056
1 -5.517173 0.389295
1 -6.186128 0.279933
1 -4.711007 0.281618
1 -5.418787 0.160267
1 -5.44514 0.142466
1 -5.944191 0.143359
1 -5.594275 0.12795
1 -5.540351 0.087165
1 -5.825257 0.115697
1 -6.890021 0.152941
1 -5.892061 0.195976
1 -6.135296 0.20363
1 -6.112667 0.217013
1 -5.436135 0.254909
1 -6.448134 0.178713
1 -5.301321 0.320385
1 -5.333619 0.322044
1 -4.378916 0.300067
1 -4.654894 0.304107
1 -5.634576 0.306014
1 -5.866357 0.23307
1 -4.796845 0.397749
1 -5.410336 0.288917
1 -5.585259 0.310746
1 -5.898673 0.213353
1 -6.132663 0.220617
1 -5.456811 0.345238
1 -3.297668 0.414758
1 -4.276605 0.355736
1 -3.377325 0.335357
1 -4.892495 0.262281
1 -4.484303 0.340256
1 -2.434031 0.450493
1 -2.839756 0.356224
1 -4.865194 0.246404
1 -4.239028 0.175691
1 -3.583722 0.207914
1 -5.4351 0.230532
1 -3.444478 0.303214
1 -5.070096 0.280091
1 -5.498456 0.234196
1 -5.185987 0.259229
1 -5.283009 0.226528
1 -5.529833 0.24275
1 -5.617124 0.184896
1 -2.929379 0.396746
0 -6.816086 0.17227
0 -7.018057 0.176316
0 -7.517934 0.160414
0 -5.736781 0.164529
0 -7.169701 0.073298
0 -7.3045 0.171088
0 -6.323531 0.218885
0 -6.085567 0.192375
0 -5.943501 0.19215
0 -6.012559 0.229298
0 -5.966779 0.197938
0 -6.016891 0.109256
1 -6.486822 0.197919
1 -6.311987 0.182459
1 -5.711205 0.240875
1 -6.261446 0.183218
1 -5.704053 0.216204
1 -6.27717 0.109397
0 -5.61907 0.191576
0 -5.198864 0.206768
0 -5.592584 0.133917
0 -6.431119 0.15331
0 -6.359018 0.116636
0 -6.710219 0.149694
0 -6.934474 0.15989
0 -6.538586 0.121952
0 -6.195325 0.129303
0 -6.787197 0.158453
0 -6.744577 0.207454
0 -5.724056 0.190667





Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time6 seconds
R Server'Herman Ole Andreas Wold' @ wold.wessa.net
R Framework error message
Warning: there are blank lines in the 'Data X' field.
Please, use NA for missing data - blank lines are simply
 deleted and are NOT treated as missing values.

\begin{tabular}{lllllllll}
\hline
Summary of computational transaction \tabularnewline
Raw Input & view raw input (R code)  \tabularnewline
Raw Output & view raw output of R engine  \tabularnewline
Computing time & 6 seconds \tabularnewline
R Server & 'Herman Ole Andreas Wold' @ wold.wessa.net \tabularnewline
R Framework error message & 
Warning: there are blank lines in the 'Data X' field.
Please, use NA for missing data - blank lines are simply
 deleted and are NOT treated as missing values.
\tabularnewline \hline \end{tabular} %Source: https://freestatistics.org/blog/index.php?pk=232111&T=0

[TABLE]
[ROW][C]Summary of computational transaction[/C][/ROW]
[ROW][C]Raw Input[/C][C]view raw input (R code) [/C][/ROW]
[ROW][C]Raw Output[/C][C]view raw output of R engine [/C][/ROW]
[ROW][C]Computing time[/C][C]6 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'Herman Ole Andreas Wold' @ wold.wessa.net[/C][/ROW]
[ROW][C]R Framework error message[/C][C]
Warning: there are blank lines in the 'Data X' field.
Please, use NA for missing data - blank lines are simply
 deleted and are NOT treated as missing values.
[/C][/ROW] [/TABLE] Source: https://freestatistics.org/blog/index.php?pk=232111&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=232111&T=0

As an alternative you can also use a QR Code:  

The GUIDs for individual cells are displayed in the table below:

Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time6 seconds
R Server'Herman Ole Andreas Wold' @ wold.wessa.net
R Framework error message
Warning: there are blank lines in the 'Data X' field.
Please, use NA for missing data - blank lines are simply
 deleted and are NOT treated as missing values.







10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2CVC1C2CV
C12781550.64232150.6809
C28112220.937891580.9461
Overall--0.8641--0.8879

\begin{tabular}{lllllllll}
\hline
10-Fold Cross Validation \tabularnewline
 & Prediction (training) & Prediction (testing) \tabularnewline
Actual & C1 & C2 & CV & C1 & C2 & CV \tabularnewline
C1 & 278 & 155 & 0.642 & 32 & 15 & 0.6809 \tabularnewline
C2 & 81 & 1222 & 0.9378 & 9 & 158 & 0.9461 \tabularnewline
Overall & - & - & 0.8641 & - & - & 0.8879 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=232111&T=1

[TABLE]
[ROW][C]10-Fold Cross Validation[/C][/ROW]
[ROW][C][/C][C]Prediction (training)[/C][C]Prediction (testing)[/C][/ROW]
[ROW][C]Actual[/C][C]C1[/C][C]C2[/C][C]CV[/C][C]C1[/C][C]C2[/C][C]CV[/C][/ROW]
[ROW][C]C1[/C][C]278[/C][C]155[/C][C]0.642[/C][C]32[/C][C]15[/C][C]0.6809[/C][/ROW]
[ROW][C]C2[/C][C]81[/C][C]1222[/C][C]0.9378[/C][C]9[/C][C]158[/C][C]0.9461[/C][/ROW]
[ROW][C]Overall[/C][C]-[/C][C]-[/C][C]0.8641[/C][C]-[/C][C]-[/C][C]0.8879[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=232111&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=232111&T=1

As an alternative you can also use a QR Code:  

The GUIDs for individual cells are displayed in the table below:

10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2CVC1C2CV
C12781550.64232150.6809
C28112220.937891580.9461
Overall--0.8641--0.8879







Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C13117
C29138

\begin{tabular}{lllllllll}
\hline
Confusion Matrix (predicted in columns / actuals in rows) \tabularnewline
 & C1 & C2 \tabularnewline
C1 & 31 & 17 \tabularnewline
C2 & 9 & 138 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=232111&T=2

[TABLE]
[ROW][C]Confusion Matrix (predicted in columns / actuals in rows)[/C][/ROW]
[ROW][C][/C][C]C1[/C][C]C2[/C][/ROW]
[ROW][C]C1[/C][C]31[/C][C]17[/C][/ROW]
[ROW][C]C2[/C][C]9[/C][C]138[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=232111&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=232111&T=2

As an alternative you can also use a QR Code:  

The GUIDs for individual cells are displayed in the table below:

Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C13117
C29138



Parameters (Session):
par1 = 1 ; par2 = equal ; par3 = 2 ; par4 = yes ;
Parameters (R input):
par1 = 1 ; par2 = equal ; par3 = 2 ; par4 = yes ;
R code (references can be found in the software module):
par4 <- 'no'
par3 <- '3'
par2 <- 'none'
par1 <- '1'
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')
}