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, 10 Dec 2011 09:06:44 -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/2011/Dec/10/t1323526087e3qbfxeednrgikp.htm/, Retrieved Sun, 05 May 2024 05:30:49 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=153543, Retrieved Sun, 05 May 2024 05:30:49 +0000
QR Codes:

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

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)] [] [2010-12-05 19:50:12] [b98453cac15ba1066b407e146608df68]
-   PD  [Recursive Partitioning (Regression Trees)] [WS 10 Cross Valid...] [2010-12-11 14:44:18] [8081b8996d5947580de3eb171e82db4f]
-         [Recursive Partitioning (Regression Trees)] [Workshop 10, Cros...] [2010-12-11 15:06:30] [3635fb7041b1998c5a1332cf9de22bce]
-   PD      [Recursive Partitioning (Regression Trees)] [Paper Recursive P...] [2010-12-19 20:32:45] [3635fb7041b1998c5a1332cf9de22bce]
-   PD        [Recursive Partitioning (Regression Trees)] [Paper Recursive P...] [2010-12-19 21:18:05] [3635fb7041b1998c5a1332cf9de22bce]
-   PD          [Recursive Partitioning (Regression Trees)] [Paper recursive P...] [2010-12-21 12:10:42] [3635fb7041b1998c5a1332cf9de22bce]
-   P               [Recursive Partitioning (Regression Trees)] [workshop 10 10-fo...] [2011-12-10 14:06:44] [b00485a169f02477e40dc6f9919569a5] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
97.06	21454	631923	130678
97.73	23899	654294	120877
98	24939	671833	137114
97.76	23580	586840	134406
97.48	24562	600969	120262
97.77	24696	625568	130846
97.96	23785	558110	120343
98.22	23812	630577	98881
98.51	21917	628654	115678
98.19	19713	603184	120796
98.37	19282	656255	94261
98.31	18788	600730	89151
98.6	21453	670326	119880
98.96	24482	678423	131468
99.11	27474	641502	155089
99.64	27264	625311	149581
100.02	27349	628177	122788
99.98	30632	589767	143900
100.32	29429	582471	112115
100.44	30084	636248	109600
100.51	26290	599885	117446
101	24379	621694	118456
100.88	23335	637406	101901
100.55	21346	595994	89940
100.82	21106	696308	129143
101.5	24514	674201	126102
102.15	28353	648861	143048
102.39	30805	649605	142258
102.54	31348	672392	131011
102.85	34556	598396	146471
103.47	33855	613177	114073
103.56	34787	638104	114642
103.69	32529	615632	118226
103.49	29998	634465	111338
103.47	29257	638686	108701
103.45	28155	604243	80512
103.48	30466	706669	146865
103.93	35704	677185	137179
103.89	39327	644328	166536
104.4	39351	664825	137070
104.79	42234	605707	127090
104.77	43630	600136	139966
105.13	43722	612166	122243
105.26	43121	599659	109097
104.96	37985	634210	116591
104.75	37135	618234	111964
105.01	34646	613576	109754
105.15	33026	627200	77609
105.2	35087	668973	138445
105.77	38846	651479	127901
105.78	42013	619661	156615
106.26	43908	644260	133264
106.13	42868	579936	143521
106.12	44423	601752	152139
106.57	44167	595376	131523
106.44	43636	588902	113925
106.54	44382	634341	86495
107.1	42142	594305	127877
108.1	43452	606200	107017
108.4	36912	610926	78716
108.84	42413	633685	138278
109.62	45344	639696	144238
110.42	44873	659451	143679
110.67	47510	593248	159932
111.66	49554	606677	136781
112.28	47369	599434	148173
112.87	45998	569578	125673
112.18	48140	629873	105573
112.36	48441	613438	122405
112.16	44928	604172	128045
111.49	40454	658328	94467
111.25	38661	612633	85573
111.36	37246	707372	121501
111.74	36843	739770	125074
111.1	36424	777535	144979
111.33	37594	685030	142120
111.25	38144	730234	124213
111.04	38737	714154	144407
110.97	34560	630872	125170
111.31	36080	719492	109267
111.02	33508	677023	122354
111.07	35462	679272	122589
111.36	33374	718317	104982
111.54	32110	645672	90542

Tables (Output of Computation)





Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time3 seconds
R Server'Herman Ole Andreas Wold' @ wold.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 & 3 seconds \tabularnewline
R Server & 'Herman Ole Andreas Wold' @ wold.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=153543&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]3 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'Herman Ole Andreas Wold' @ wold.wessa.net[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=153543&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=153543&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 time3 seconds
R Server'Herman Ole Andreas Wold' @ wold.wessa.net






10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2C3CVC1C2C3CV
C125000129100.9667
C236451670.181543250.0938
C30292210.88409210.7
Overall---0.6898---0.5761

\begin{tabular}{lllllllll}
\hline
10-Fold Cross Validation \tabularnewline
 & Prediction (training) & Prediction (testing) \tabularnewline
Actual & C1 & C2 & C3 & CV & C1 & C2 & C3 & CV \tabularnewline
C1 & 250 & 0 & 0 & 1 & 29 & 1 & 0 & 0.9667 \tabularnewline
C2 & 36 & 45 & 167 & 0.1815 & 4 & 3 & 25 & 0.0938 \tabularnewline
C3 & 0 & 29 & 221 & 0.884 & 0 & 9 & 21 & 0.7 \tabularnewline
Overall & - & - & - & 0.6898 & - & - & - & 0.5761 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=153543&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]C3[/C][C]CV[/C][C]C1[/C][C]C2[/C][C]C3[/C][C]CV[/C][/ROW]
[ROW][C]C1[/C][C]250[/C][C]0[/C][C]0[/C][C]1[/C][C]29[/C][C]1[/C][C]0[/C][C]0.9667[/C][/ROW]
[ROW][C]C2[/C][C]36[/C][C]45[/C][C]167[/C][C]0.1815[/C][C]4[/C][C]3[/C][C]25[/C][C]0.0938[/C][/ROW]
[ROW][C]C3[/C][C]0[/C][C]29[/C][C]221[/C][C]0.884[/C][C]0[/C][C]9[/C][C]21[/C][C]0.7[/C][/ROW]
[ROW][C]Overall[/C][C]-[/C][C]-[/C][C]-[/C][C]0.6898[/C][C]-[/C][C]-[/C][C]-[/C][C]0.5761[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=153543&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=153543&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:

10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2C3CVC1C2C3CV
C125000129100.9667
C236451670.181543250.0938
C30292210.88409210.7
Overall---0.6898---0.5761






Confusion Matrix (predicted in columns / actuals in rows)
C1C2C3
C12800
C24024
C30028

\begin{tabular}{lllllllll}
\hline
Confusion Matrix (predicted in columns / actuals in rows) \tabularnewline
 & C1 & C2 & C3 \tabularnewline
C1 & 28 & 0 & 0 \tabularnewline
C2 & 4 & 0 & 24 \tabularnewline
C3 & 0 & 0 & 28 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=153543&T=2

[TABLE]
[ROW][C]Confusion Matrix (predicted in columns / actuals in rows)[/C][/ROW]
[ROW][C][/C][C]C1[/C][C]C2[/C][C]C3[/C][/ROW]
[ROW][C]C1[/C][C]28[/C][C]0[/C][C]0[/C][/ROW]
[ROW][C]C2[/C][C]4[/C][C]0[/C][C]24[/C][/ROW]
[ROW][C]C3[/C][C]0[/C][C]0[/C][C]28[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=153543&T=2

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

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)
C1C2C3
C12800
C24024
C30028


Figures (Output of Computation)

Input Parameters & R Code

Parameters (Session):
par1 = 1 ; par2 = quantiles ; par3 = 3 ; par4 = yes ;
Parameters (R input):
par1 = 1 ; par2 = quantiles ; par3 = 3 ; par4 = yes ;
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')
}