FreeStatistics.org

Free Statistics

of Irreproducible Research!

Description of Statistical Computation

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 computationSat, 07 Dec 2013 16:17:00 -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/07/t1386451362ph1s1xn1fdhzcts.htm/, Retrieved Tue, 16 Apr 2024 10:44:12 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=231416, Retrieved Tue, 16 Apr 2024 10:44:12 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact69

Tree of Dependent Computations

Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [Recursive Partitioning (Regression Trees)] [WS 10 - Regressio...] [2013-12-07 21:17:00] [e5eda3cc50f4d89e40bb52bce43bc7fc] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
1 1 41 38 13 12 14
1 1 39 32 16 11 18
1 1 30 35 19 15 11
1 0 31 33 15 6 12
1 1 34 37 14 13 16
1 1 35 29 13 10 18
1 1 39 31 19 12 14
1 1 34 36 15 14 14
1 1 36 35 14 12 15
1 1 37 38 15 9 15
1 0 38 31 16 10 17
1 1 36 34 16 12 19
1 0 38 35 16 12 10
1 1 39 38 16 11 16
1 1 33 37 17 15 18
1 0 32 33 15 12 14
1 0 36 32 15 10 14
1 1 38 38 20 12 17
1 0 39 38 18 11 14
1 1 32 32 16 12 16
1 0 32 33 16 11 18
1 1 31 31 16 12 11
1 1 39 38 19 13 14
1 1 37 39 16 11 12
1 0 39 32 17 12 17
1 1 41 32 17 13 9
1 0 36 35 16 10 16
1 1 33 37 15 14 14
1 1 33 33 16 12 15
1 0 34 33 14 10 11
1 1 31 31 15 12 16
1 0 27 32 12 8 13
1 1 37 31 14 10 17
1 1 34 37 16 12 15
1 0 34 30 14 12 14
1 0 32 33 10 7 16
1 0 29 31 10 9 9
1 0 36 33 14 12 15
1 1 29 31 16 10 17
1 0 35 33 16 10 13
1 0 37 32 16 10 15
1 1 34 33 14 12 16
1 0 38 32 20 15 16
1 0 35 33 14 10 12
1 1 38 28 14 10 15
1 1 37 35 11 12 11
1 1 38 39 14 13 15
1 1 33 34 15 11 15
1 1 36 38 16 11 17
1 0 38 32 14 12 13
1 1 32 38 16 14 16
1 0 32 30 14 10 14
1 0 32 33 12 12 11
1 1 34 38 16 13 12
1 0 32 32 9 5 12
1 1 37 35 14 6 15
1 1 39 34 16 12 16
1 1 29 34 16 12 15
1 0 37 36 15 11 12
1 1 35 34 16 10 12
1 0 30 28 12 7 8
1 0 38 34 16 12 13
1 1 34 35 16 14 11
1 1 31 35 14 11 14
1 1 34 31 16 12 15
1 0 35 37 17 13 10
1 1 36 35 18 14 11
1 0 30 27 18 11 12
1 1 39 40 12 12 15
1 0 35 37 16 12 15
1 0 38 36 10 8 14
1 1 31 38 14 11 16
1 1 34 39 18 14 15
1 0 38 41 18 14 15
1 0 34 27 16 12 13
1 1 39 30 17 9 12
1 1 37 37 16 13 17
1 1 34 31 16 11 13
1 0 28 31 13 12 15
1 0 37 27 16 12 13
1 0 33 36 16 12 15
1 1 35 37 16 12 15
1 0 37 33 15 12 16
1 1 32 34 15 11 15
1 1 33 31 16 10 14
1 0 38 39 14 9 15
1 1 33 34 16 12 14
1 1 29 32 16 12 13
1 1 33 33 15 12 7
1 1 31 36 12 9 17
1 1 36 32 17 15 13
1 1 35 41 16 12 15
1 1 32 28 15 12 14
1 1 29 30 13 12 13
1 1 39 36 16 10 16
1 1 37 35 16 13 12
1 1 35 31 16 9 14
1 0 37 34 16 12 17
1 0 32 36 14 10 15
1 1 38 36 16 14 17
1 0 37 35 16 11 12
1 1 36 37 20 15 16
1 0 32 28 15 11 11
1 1 33 39 16 11 15
1 0 40 32 13 12 9
1 1 38 35 17 12 16
1 0 41 39 16 12 15
1 0 36 35 16 11 10
1 1 43 42 12 7 10
1 1 30 34 16 12 15
1 1 31 33 16 14 11
1 1 32 41 17 11 13
1 1 37 34 12 10 18
1 0 37 32 18 13 16
1 1 33 40 14 13 14
1 1 34 40 14 8 14
1 1 33 35 13 11 14
1 1 38 36 16 12 14
1 0 33 37 13 11 12
1 1 31 27 16 13 14
1 1 38 39 13 12 15
1 1 37 38 16 14 15
1 1 36 31 15 13 15
1 1 31 33 16 15 13
1 0 39 32 15 10 17
1 1 44 39 17 11 17
1 1 33 36 15 9 19
1 1 35 33 12 11 15
1 0 32 33 16 10 13
1 0 28 32 10 11 9
1 1 40 37 16 8 15
1 0 27 30 12 11 15
1 0 37 38 14 12 15
1 1 32 29 15 12 16
1 0 28 22 13 9 11
1 0 34 35 15 11 14
1 1 30 35 11 10 11
1 1 35 34 12 8 15
1 0 31 35 11 9 13
1 1 32 34 16 8 15
1 0 30 37 15 9 16
1 1 30 35 17 15 14
1 0 31 23 16 11 15
1 1 40 31 10 8 16
1 1 32 27 18 13 16
1 0 36 36 13 12 11
1 0 32 31 16 12 12
1 0 35 32 13 9 9
1 1 38 39 10 7 16
1 1 42 37 15 13 13
1 0 34 38 16 9 16
1 1 35 39 16 6 12
1 1 38 34 14 8 9
1 1 33 31 10 8 13
1 1 32 37 13 6 14
1 1 33 36 15 9 19
1 1 34 32 16 11 13
1 1 32 38 12 8 12
0 0 27 26 13 10 10
0 0 31 26 12 8 14
0 0 38 33 17 14 16
0 1 34 39 15 10 10
0 0 24 30 10 8 11
0 0 30 33 14 11 14
0 1 26 25 11 12 12
0 1 34 38 13 12 9
0 0 27 37 16 12 9
0 0 37 31 12 5 11
0 1 36 37 16 12 16
0 0 41 35 12 10 9
0 1 29 25 9 7 13
0 1 36 28 12 12 16
0 0 32 35 15 11 13
0 1 37 33 12 8 9
0 0 30 30 12 9 12
0 1 31 31 14 10 16
0 1 38 37 12 9 11
0 1 36 36 16 12 14
0 0 35 30 11 6 13
0 0 31 36 19 15 15
0 0 38 32 15 12 14
0 1 22 28 8 12 16
0 1 32 36 16 12 13
0 0 36 34 17 11 14
0 1 39 31 12 7 15
0 0 28 28 11 7 13
0 0 32 36 11 5 11
0 1 32 36 14 12 11
0 1 38 40 16 12 14
0 1 32 33 12 3 15
0 1 35 37 16 11 11
0 1 32 32 13 10 15
0 0 37 38 15 12 12
0 1 34 31 16 9 14
0 1 33 37 16 12 14
0 0 33 33 14 9 8
0 0 30 30 16 12 9
0 0 24 30 14 10 15
0 0 34 31 11 9 17
0 0 34 32 12 12 13
0 1 33 34 15 8 15
0 1 34 36 15 11 15
0 1 35 37 16 11 14
0 0 35 36 16 12 16
0 0 36 33 11 10 13
0 0 34 33 15 10 16
0 1 34 33 12 12 9
0 0 41 44 12 12 16
0 0 32 39 15 11 11
0 0 30 32 15 8 10
0 1 35 35 16 12 11
0 0 28 25 14 10 15
0 1 33 35 17 11 17
0 1 39 34 14 10 14
0 0 36 35 13 8 8
0 1 36 39 15 12 15
0 0 35 33 13 12 11
0 0 38 36 14 10 16
0 1 33 32 15 12 10
0 0 31 32 12 9 15
0 1 32 36 8 6 16
0 0 31 32 14 10 19
0 0 33 34 14 9 12
0 0 34 33 11 9 8
0 0 34 35 12 9 11
0 1 34 30 13 6 14
0 0 33 38 10 10 9
0 0 32 34 16 6 15
0 1 41 33 18 14 13
0 1 34 32 13 10 16
0 0 36 31 11 10 11
0 0 37 30 4 6 12
0 0 36 27 13 12 13
0 1 29 31 16 12 10
0 0 37 30 10 7 11
0 0 27 32 12 8 12
0 0 35 35 12 11 8
0 0 28 28 10 3 12
0 0 35 33 13 6 12
0 0 29 35 12 8 11
0 0 32 35 14 9 13
0 1 36 32 10 9 14
0 1 19 21 12 8 10
0 1 21 20 12 9 12
0 0 31 34 11 7 15
0 0 33 32 10 7 13
0 1 36 34 12 6 13
0 1 33 32 16 9 13
0 0 37 33 12 10 12
0 0 34 33 14 11 12
0 0 35 37 16 12 9
0 1 31 32 14 8 9
0 1 37 34 13 11 15
0 1 35 30 4 3 10
0 1 27 30 15 11 14
0 0 34 38 11 12 15
0 0 40 36 11 7 7
0 0 29 32 14 9 14
0 0 38 34 15 12 8
0 1 34 33 14 8 10
0 0 21 27 13 11 13
0 0 36 32 11 8 13
0 1 38 34 15 10 13
0 0 30 29 11 8 8
0 0 35 35 13 7 12
0 1 30 27 13 8 13
0 1 36 33 16 10 12
0 0 34 38 13 8 10
0 1 35 36 16 12 13
0 0 34 33 16 14 12
0 0 32 39 12 7 9
0 1 33 29 7 6 15
0 0 33 32 16 11 13
0 1 26 34 5 4 13
0 0 35 38 16 9 13
0 0 21 17 4 5 15
0 0 38 35 12 9 15
0 0 35 32 15 11 14
0 1 33 34 14 12 15
0 0 37 36 11 9 11
0 0 38 31 16 12 15
0 1 34 35 15 10 14
0 0 27 29 12 9 13
0 1 16 22 6 6 12
0 0 40 41 16 10 16
0 0 36 36 10 9 16
0 1 42 42 15 13 9
0 1 30 33 14 12 14

Tables (Output of Computation)





Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time13 seconds
R Server'Sir Maurice George Kendall' @ kendall.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 & 'Sir Maurice George Kendall' @ kendall.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=231416&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]'Sir Maurice George Kendall' @ kendall.wessa.net[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=231416&T=0

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

As an alternative you can also use a QR Code:  
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'Sir Maurice George Kendall' @ kendall.wessa.net






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C16229
C224173

\begin{tabular}{lllllllll}
\hline
Confusion Matrix (predicted in columns / actuals in rows) \tabularnewline
 & C1 & C2 \tabularnewline
C1 & 62 & 29 \tabularnewline
C2 & 24 & 173 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=231416&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]62[/C][C]29[/C][/ROW]
[ROW][C]C2[/C][C]24[/C][C]173[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=231416&T=1

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

As an alternative you can also use a QR Code:  
QR Code


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

Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C16229
C224173


Figures (Output of Computation)

Input Parameters & R Code

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