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 computationWed, 21 Dec 2011 09:30:40 -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/21/t13244778562m8ikal9z2bu3we.htm/, Retrieved Mon, 29 Apr 2024 12:36:23 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=158744, Retrieved Mon, 29 Apr 2024 12:36:23 +0000
QR Codes:

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

Tree of Dependent Computations

Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [Multiple Regression] [Competence to learn] [2010-11-17 07:43:53] [b98453cac15ba1066b407e146608df68]
- R  D  [Multiple Regression] [Tutorial 2-1] [2011-11-21 19:39:55] [9e469a83342941fcd5c6dffbf184cd3a]
-   PD    [Multiple Regression] [Tutorial2-1] [2011-11-21 20:30:04] [9e469a83342941fcd5c6dffbf184cd3a]
- R PD      [Multiple Regression] [multiple regressi...] [2011-12-19 21:00:38] [2e8e2c135ae7a1d1ed044e87454acf31]
- RMP         [Kendall tau Correlation Matrix] [pearson correlatie] [2011-12-21 13:23:03] [2e8e2c135ae7a1d1ed044e87454acf31]
- RMP           [Recursive Partitioning (Regression Trees)] [Regression trees] [2011-12-21 14:21:32] [2e8e2c135ae7a1d1ed044e87454acf31]
- R P               [Recursive Partitioning (Regression Trees)] [regression trees ] [2011-12-21 14:30:40] [aeb40720a676d7d277b8965d0f8ecacb] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
158147	1760	89	48	18	20465
182462	1609	56	52	20	33629
7215	192	18	0	0	1423
122259	2182	92	49	26	25629
222405	3367	131	76	31	54002
485890	6658	253	124	36	151036
150777	1548	54	42	23	33287
160529	1507	56	68	30	31172
133238	1682	42	52	30	28113
275326	2811	91	67	26	57803
121821	1943	74	50	24	49830
172489	2017	66	71	30	52143
89942	1702	96	41	21	21055
208851	3034	110	79	25	47007
151886	1379	55	49	18	28735
145427	1517	79	54	19	59147
134153	1637	53	75	33	78950
64149	1077	53	0	15	13497
122417	2384	84	54	34	46154
27997	726	24	13	18	53249
65004	993	55	17	15	10726
205417	2446	91	83	27	83700
188103	1713	70	37	25	40400
118698	2027	50	44	34	33797
143682	1818	81	50	21	36205
140172	1393	28	39	21	30165
186377	2000	154	59	25	58534
174870	1346	85	79	31	44663
317699	2522	114	55	30	92556
192335	2106	43	52	20	40078
151621	1515	42	50	28	34711
167466	1519	43	54	20	31076
125909	2165	100	53	17	74608
221896	2959	120	76	25	58092
217447	2364	52	60	24	42009
0	1	1	0	0	0
207163	2009	59	53	27	36022
93107	1564	50	44	14	23333
133763	2072	47	36	32	53349
246427	2106	63	83	31	92596
224097	2270	69	100	21	49598
142057	1643	56	37	34	44093
94332	957	29	25	23	84205
171724	2025	77	59	24	63369
101683	1115	45	44	26	60132
156753	1176	90	41	22	37403
81293	744	31	23	35	24460
201984	1974	91	63	21	46456
219875	2224	85	54	31	66616
156589	2561	56	67	26	41554
48188	658	28	12	22	22346
138146	1716	64	82	21	30874
279590	2355	71	64	27	68701
234829	2017	77	56	30	35728
181731	1686	57	54	33	29010
141014	1675	54	35	11	23110
189220	1760	62	52	26	38844
76419	875	23	25	26	27084
151898	1169	65	67	23	35139
189402	2789	93	36	38	57476
140189	1606	56	50	29	33277
123181	1986	75	48	19	31141
124234	1300	58	46	19	61281
107277	1176	34	53	24	25820
153813	1215	32	27	26	23284
94982	1230	38	38	29	35378
178613	2226	67	68	36	74990
138708	2897	65	93	25	29653
102378	1008	37	48	24	64622
31970	340	15	5	21	4157
211635	2704	110	53	19	29245
111885	1209	63	36	12	50008
99687	1290	63	62	30	52338
102900	1535	68	46	21	13310
156475	2585	65	73	34	92901
74513	1315	41	2	32	10956
159186	2142	57	76	27	34241
155818	2513	94	71	28	75043
60138	817	24	16	21	21152
84971	1234	71	34	31	42249
80478	917	66	54	26	42005
244325	1924	59	39	29	41152
56486	853	27	26	23	14399
110743	1398	34	40	25	28263
75092	986	44	35	22	17215
148286	1608	47	32	26	48140
222914	2576	219	55	33	62897
115019	1201	108	58	24	22883
93083	1189	56	39	24	41622
143258	1383	49	33	21	40715
117794	1563	39	45	28	65897
158586	2185	74	72	27	76542
151465	1228	56	39	25	37477
124626	1266	58	27	15	53216
51801	830	36	22	13	40911
223020	2217	110	47	36	57021
188957	1787	68	95	24	73116
19349	223	12	13	1	3895
188069	2170	99	27	24	46609
150561	1927	74	40	31	29351
53921	665	28	22	4	2325
58280	804	22	41	20	31747
124951	1211	49	55	23	32665
112263	1143	57	28	23	19249
72904	710	38	30	12	15292
27676	596	22	2	16	5842
131274	1353	44	79	29	33994
117451	971	32	18	10	13018
0	0	0	0	0	0
85610	1030	31	46	25	98177
107175	1130	66	25	21	37941
133024	1284	44	50	23	31032
136473	1438	61	59	21	32683
71894	849	57	36	21	34545
3616	78	5	0	0	0
0	0	0	0	0	0
154806	925	39	35	23	27525
137977	1518	78	68	29	66856
149846	1946	95	26	28	28549
113245	914	37	36	23	38610
43410	778	19	7	1	2781
170330	1713	71	67	29	41211
89410	895	40	30	17	22698
112749	1756	52	55	29	41194
60373	701	40	3	12	32689
19764	285	12	10	2	5752
160995	1774	55	46	21	26757
121052	1021	28	26	25	22527
150039	1582	46	49	29	44810
11796	256	9	1	2	0
10674	98	9	0	0	0
134836	1358	55	33	18	100674
6836	41	3	0	1	0
153278	1770	57	48	21	57786
5118	42	3	5	0	0
40248	528	16	8	4	5444
0	0	0	0	0	0
117842	1026	45	35	25	28470
87635	1296	38	21	26	61849
7131	81	4	0	0	0
8812	257	13	0	4	2179
68916	914	23	15	17	8019
132686	1178	50	50	21	39644
94127	1080	19	17	22	23494

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=158744&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=158744&T=0

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






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C11430
C210

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

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


Figures (Output of Computation)

Input Parameters & R Code

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