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 computationTue, 03 Dec 2013 04:08:08 -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/03/t1386061720f1e3e37hjg4qnha.htm/, Retrieved Sat, 27 Apr 2024 04:28:46 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=230183, Retrieved Sat, 27 Apr 2024 04:28:46 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact94
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [Recursive Partitioning (Regression Trees)] [sf] [2013-12-03 09:08:08] [e931f330ae8eb739e69629b6955c783c] [Current]
Feedback Forum

Post a new message
Dataseries X:
41 38 13 12 14 12 53 32
39 32 16 11 18 11 83 51
30 35 19 15 11 14 66 42
31 33 15 6 12 12 67 41
34 37 14 13 16 21 76 46
35 29 13 10 18 12 78 47
39 31 19 12 14 22 53 37
34 36 15 14 14 11 80 49
36 35 14 12 15 10 74 45
37 38 15 9 15 13 76 47
38 31 16 10 17 10 79 49
36 34 16 12 19 8 54 33
38 35 16 12 10 15 67 42
39 38 16 11 16 14 54 33
33 37 17 15 18 10 87 53
32 33 15 12 14 14 58 36
36 32 15 10 14 14 75 45
38 38 20 12 17 11 88 54
39 38 18 11 14 10 64 41
32 32 16 12 16 13 57 36
32 33 16 11 18 9.5 66 41
31 31 16 12 11 14 68 44
39 38 19 13 14 12 54 33
37 39 16 11 12 14 56 37
39 32 17 12 17 11 86 52
41 32 17 13 9 9 80 47
36 35 16 10 16 11 76 43
33 37 15 14 14 15 69 44
33 33 16 12 15 14 78 45
34 33 14 10 11 13 67 44
31 31 15 12 16 9 80 49
27 32 12 8 13 15 54 33
37 31 14 10 17 10 71 43
34 37 16 12 15 11 84 54
34 30 14 12 14 13 74 42
32 33 10 7 16 8 71 44
29 31 10 9 9 20 63 37
36 33 14 12 15 12 71 43
29 31 16 10 17 10 76 46
35 33 16 10 13 10 69 42
37 32 16 10 15 9 74 45
34 33 14 12 16 14 75 44
38 32 20 15 16 8 54 33
35 33 14 10 12 14 52 31
38 28 14 10 15 11 69 42
37 35 11 12 11 13 68 40
38 39 14 13 15 9 65 43
33 34 15 11 15 11 75 46
36 38 16 11 17 15 74 42
38 32 14 12 13 11 75 45
32 38 16 14 16 10 72 44
32 30 14 10 14 14 67 40
32 33 12 12 11 18 63 37
34 38 16 13 12 14 62 46
32 32 9 5 12 11 63 36
37 35 14 6 15 14.5 76 47
39 34 16 12 16 13 74 45
29 34 16 12 15 9 67 42
37 36 15 11 12 10 73 43
35 34 16 10 12 15 70 43
30 28 12 7 8 20 53 32
38 34 16 12 13 12 77 45
34 35 16 14 11 12 80 48
31 35 14 11 14 14 52 31
34 31 16 12 15 13 54 33
35 37 17 13 10 11 80 49
36 35 18 14 11 17 66 42
30 27 18 11 12 12 73 41
39 40 12 12 15 13 63 38
35 37 16 12 15 14 69 42
38 36 10 8 14 13 67 44
31 38 14 11 16 15 54 33
34 39 18 14 15 13 81 48
38 41 18 14 15 10 69 40
34 27 16 12 13 11 84 50
39 30 17 9 12 19 80 49
37 37 16 13 17 13 70 43
34 31 16 11 13 17 69 44
28 31 13 12 15 13 77 47
37 27 16 12 13 9 54 33
33 36 16 12 15 11 79 46
35 37 16 12 15 9 71 45
37 33 15 12 16 12 73 43
32 34 15 11 15 12 72 44
33 31 16 10 14 13 77 47
38 39 14 9 15 13 75 45
33 34 16 12 14 12 69 42
29 32 16 12 13 15 54 33
33 33 15 12 7 22 70 43
31 36 12 9 17 13 73 46
36 32 17 15 13 15 54 33
35 41 16 12 15 13 77 46
32 28 15 12 14 15 82 48
29 30 13 12 13 12.5 80 47
39 36 16 10 16 11 80 47
37 35 16 13 12 16 69 43
35 31 16 9 14 11 78 46
37 34 16 12 17 11 81 48
32 36 14 10 15 10 76 46
38 36 16 14 17 10 76 45
37 35 16 11 12 16 73 45
36 37 20 15 16 12 85 52
32 28 15 11 11 11 66 42
33 39 16 11 15 16 79 47
40 32 13 12 9 19 68 41
38 35 17 12 16 11 76 47
41 39 16 12 15 16 71 43
36 35 16 11 10 15 54 33
43 42 12 7 10 24 46 30
30 34 16 12 15 14 85 52
31 33 16 14 11 15 74 44
32 41 17 11 13 11 88 55
32 33 13 11 14 15 38 11
37 34 12 10 18 12 76 47
37 32 18 13 16 10 86 53
33 40 14 13 14 14 54 33
34 40 14 8 14 13 67 44
33 35 13 11 14 9 69 42
38 36 16 12 14 15 90 55
33 37 13 11 12 15 54 33
31 27 16 13 14 14 76 46
38 39 13 12 15 11 89 54
37 38 16 14 15 8 76 47
36 31 15 13 15 11 73 45
31 33 16 15 13 11 79 47
39 32 15 10 17 8 90 55
44 39 17 11 17 10 74 44
33 36 15 9 19 11 81 53
35 33 12 11 15 13 72 44
32 33 16 10 13 11 71 42
28 32 10 11 9 20 66 40
40 37 16 8 15 10 77 46
27 30 12 11 15 15 65 40
37 38 14 12 15 12 74 46
32 29 15 12 16 14 85 53
28 22 13 9 11 23 54 33
34 35 15 11 14 14 63 42
30 35 11 10 11 16 54 35
35 34 12 8 15 11 64 40
31 35 11 9 13 12 69 41
32 34 16 8 15 10 54 33
30 37 15 9 16 14 84 51
30 35 17 15 14 12 86 53
31 23 16 11 15 12 77 46
40 31 10 8 16 11 89 55
32 27 18 13 16 12 76 47
36 36 13 12 11 13 60 38
32 31 16 12 12 11 75 46
35 32 13 9 9 19 73 46
38 39 10 7 16 12 85 53
42 37 15 13 13 17 79 47
34 38 16 9 16 9 71 41
35 39 16 6 12 12 72 44
38 34 14 8 9 19 69 43
33 31 10 8 13 18 78 51
36 32 17 15 13 15 54 33
32 37 13 6 14 14 69 43
33 36 15 9 19 11 81 53
34 32 16 11 13 9 84 51
32 38 12 8 12 18 84 50
34 36 13 8 13 16 69 46
27 26 13 10 10 24 66 43
31 26 12 8 14 14 81 47
38 33 17 14 16 20 82 50
34 39 15 10 10 18 72 43
24 30 10 8 11 23 54 33
30 33 14 11 14 12 78 48
26 25 11 12 12 14 74 44
34 38 13 12 9 16 82 50
27 37 16 12 9 18 73 41
37 31 12 5 11 20 55 34
36 37 16 12 16 12 72 44
41 35 12 10 9 12 78 47
29 25 9 7 13 17 59 35
36 28 12 12 16 13 72 44
32 35 15 11 13 9 78 44
37 33 12 8 9 16 68 43
30 30 12 9 12 18 69 41
31 31 14 10 16 10 67 41
38 37 12 9 11 14 74 42
36 36 16 12 14 11 54 33
35 30 11 6 13 9 67 41
31 36 19 15 15 11 70 44
38 32 15 12 14 10 80 48
22 28 8 12 16 11 89 55
32 36 16 12 13 19 76 44
36 34 17 11 14 14 74 43
39 31 12 7 15 12 87 52
28 28 11 7 13 14 54 30
32 36 11 5 11 21 61 39
32 36 14 12 11 13 38 11
38 40 16 12 14 10 75 44
32 33 12 3 15 15 69 42
35 37 16 11 11 16 62 41
32 32 13 10 15 14 72 44
37 38 15 12 12 12 70 44
34 31 16 9 14 19 79 48
33 37 16 12 14 15 87 53
33 33 14 9 8 19 62 37
26 32 16 12 13 13 77 44
30 30 16 12 9 17 69 44
24 30 14 10 15 12 69 40
34 31 11 9 17 11 75 42
34 32 12 12 13 14 54 35
33 34 15 8 15 11 72 43
34 36 15 11 15 13 74 45
35 37 16 11 14 12 85 55
35 36 16 12 16 15 52 31
36 33 11 10 13 14 70 44
34 33 15 10 16 12 84 50
34 33 12 12 9 17 64 40
41 44 12 12 16 11 84 53
32 39 15 11 11 18 87 54
30 32 15 8 10 13 79 49
35 35 16 12 11 17 67 40
28 25 14 10 15 13 65 41
33 35 17 11 17 11 85 52
39 34 14 10 14 12 83 52
36 35 13 8 8 22 61 36
36 39 15 12 15 14 82 52
35 33 13 12 11 12 76 46
38 36 14 10 16 12 58 31
33 32 15 12 10 17 72 44
31 32 12 9 15 9 72 44
34 36 13 9 9 21 38 11
32 36 8 6 16 10 78 46
31 32 14 10 19 11 54 33
33 34 14 9 12 12 63 34
34 33 11 9 8 23 66 42
34 35 12 9 11 13 70 43
34 30 13 6 14 12 71 43
33 38 10 10 9 16 67 44
32 34 16 6 15 9 58 36
41 33 18 14 13 17 72 46
34 32 13 10 16 9 72 44
36 31 11 10 11 14 70 43
37 30 4 6 12 17 76 50
36 27 13 12 13 13 50 33
29 31 16 12 10 11 72 43
37 30 10 7 11 12 72 44
27 32 12 8 12 10 88 53
35 35 12 11 8 19 53 34
28 28 10 3 12 16 58 35
35 33 13 6 12 16 66 40
37 31 15 10 15 14 82 53
29 35 12 8 11 20 69 42
32 35 14 9 13 15 68 43
36 32 10 9 14 23 44 29
19 21 12 8 10 20 56 36
21 20 12 9 12 16 53 30
31 34 11 7 15 14 70 42
33 32 10 7 13 17 78 47
36 34 12 6 13 11 71 44
33 32 16 9 13 13 72 45
37 33 12 10 12 17 68 44
34 33 14 11 12 15 67 43
35 37 16 12 9 21 75 43
31 32 14 8 9 18 62 40
37 34 13 11 15 15 67 41
35 30 4 3 10 8 83 52
27 30 15 11 14 12 64 38
34 38 11 12 15 12 68 41
40 36 11 7 7 22 62 39
29 32 14 9 14 12 72 43
 




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time13 seconds
R Server'Gwilym Jenkins' @ jenkins.wessa.net

\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 & 13 seconds \tabularnewline
R Server & 'Gwilym Jenkins' @ jenkins.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=230183&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]13 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'Gwilym Jenkins' @ jenkins.wessa.net[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=230183&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=230183&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 time13 seconds
R Server'Gwilym Jenkins' @ jenkins.wessa.net







Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C19062
C23676

\begin{tabular}{lllllllll}
\hline
Confusion Matrix (predicted in columns / actuals in rows) \tabularnewline
 & C1 & C2 \tabularnewline
C1 & 90 & 62 \tabularnewline
C2 & 36 & 76 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=230183&T=1

[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]90[/C][C]62[/C][/ROW]
[ROW][C]C2[/C][C]36[/C][C]76[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=230183&T=1

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

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
C19062
C23676



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