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 computationFri, 16 Dec 2011 08:40:45 -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/16/t1324042898g74i6euecvst8l8.htm/, Retrieved Sun, 05 May 2024 09:11:02 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=155920, Retrieved Sun, 05 May 2024 09:11:02 +0000
QR Codes:

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

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:35:21] [b98453cac15ba1066b407e146608df68]
- R PD    [Recursive Partitioning (Regression Trees)] [] [2011-12-16 13:40:45] [5f7ae77ad4c15dc18491c39fdf8bddde] [Current]
-   PD      [Recursive Partitioning (Regression Trees)] [] [2011-12-18 18:58:07] [aefb5c2d4042694c5b6b82f93ac1885a]
-   P         [Recursive Partitioning (Regression Trees)] [] [2011-12-21 16:11:24] [74be16979710d4c4e7c6647856088456]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
269998	38	144	116	140824	186099	165
176565	34	133	127	110459	113854	132
222373	42	162	106	105079	99776	121
218443	38	148	133	112098	106194	145
157206	27	88	64	43929	100792	71
70849	35	129	89	76173	47552	47
482608	33	128	122	187326	250931	177
33186	18	67	22	22807	6853	5
207822	34	132	117	144408	115466	124
211698	33	120	82	66485	110896	92
292874	42	155	136	79089	169351	149
235891	55	210	184	81625	94853	93
156623	35	115	106	68788	72591	70
344166	52	179	162	103297	101345	148
211787	42	158	86	69446	113713	100
369753	59	223	199	114948	165354	142
292100	36	140	139	167949	164263	194
315018	39	144	92	125081	135213	113
172883	29	111	85	125818	111669	162
256016	46	179	174	136588	134163	186
269240	45	171	148	112431	140303	147
425544	39	144	144	103037	150773	137
161962	25	89	84	82317	111848	71
189897	52	208	208	118906	102509	123
207445	41	153	144	83515	96785	134
203723	38	146	139	104581	116136	115
267198	41	158	127	103129	158376	138
263212	39	142	136	83243	153990	125
155915	32	117	99	37110	64057	66
326805	41	158	135	113344	230054	137
271661	45	175	165	139165	184531	152
197192	47	174	139	86652	114198	159
318563	48	185	178	112302	198299	159
97717	37	141	137	69652	33750	31
346931	39	151	148	119442	189723	185
273950	42	159	127	69867	100826	78
411809	41	151	141	101629	188355	117
208192	36	139	89	70168	104470	109
115469	17	55	46	31081	58391	41
328339	39	151	143	103925	164808	149
324178	39	145	122	92622	134097	123
157897	38	138	103	79011	80238	103
192883	36	115	108	93487	133252	87
173450	42	157	126	64520	54518	71
153778	45	73	45	93473	121850	51
445562	38	138	122	114360	79367	70
78800	26	82	66	33032	56968	21
208051	52	201	180	96125	106314	155
323152	47	181	165	151911	191889	172
175523	45	164	146	89256	104864	133
213050	40	158	137	95671	160791	125
24188	4	12	7	5950	15049	7
372225	44	163	157	149695	191179	158
65029	18	67	61	32551	25109	21
101097	14	52	41	31701	45824	35
269593	37	134	120	100087	129711	133
302218	56	210	208	169707	210012	169
315889	36	134	127	150491	194679	256
322546	41	150	147	120192	197680	190
246873	36	139	127	95893	81180	100
360665	46	178	161	151715	197765	171
296186	28	101	73	176225	214738	267
232391	42	165	94	59900	96252	80
254550	42	163	142	104767	124527	126
228595	37	139	125	114799	153242	132
216027	30	116	87	72128	145707	121
187959	35	137	128	143592	113963	156
227699	44	167	148	89626	134904	133
229698	36	135	116	131072	114268	199
166791	28	102	89	126817	94333	98
239277	45	173	154	81351	102204	109
73566	23	88	67	22618	23824	25
242498	45	175	171	88977	111563	113
187167	38	133	90	92059	91313	126
178281	38	148	133	81897	89770	137
349060	42	157	137	108146	100125	121
323126	36	140	133	126372	165278	178
206059	41	154	125	249771	181712	63
184970	38	148	134	71154	80906	109
168990	37	134	110	71571	75881	101
153613	28	109	89	55918	83963	61
429481	45	175	138	160141	175721	157
145919	26	99	99	38692	68580	38
280343	44	122	92	102812	136323	159
80953	8	28	27	56622	55792	58
148106	27	101	77	15986	25157	27
146777	35	129	127	123534	100922	108
336054	37	143	137	108535	118845	83
307486	57	206	122	93879	170492	88
178495	41	155	143	144551	81716	164
251466	37	138	85	56750	115750	96
230961	38	141	131	127654	105590	192
175244	31	114	90	65594	92795	94
261494	36	140	135	59938	82390	107
301883	36	140	132	146975	135599	144
189252	36	140	139	143372	111542	123
222504	35	127	127	168553	162519	170
278170	39	141	104	183500	211381	210
367723	58	223	221	165986	189944	193
392346	30	114	106	184923	226168	297
284676	51	198	176	140358	117495	125
273642	41	155	130	149959	195894	204
186856	36	138	59	57224	80684	70
43287	19	71	64	43750	19630	49
185302	23	84	36	48029	88634	82
203088	40	151	88	104978	139292	205
259692	40	155	125	100046	128602	111
301456	40	150	124	101047	135848	135
119969	30	112	83	197426	178377	59
153028	41	161	127	160902	106330	70
306952	40	149	143	147172	178303	108
297807	45	164	115	109432	116938	141
23623	1	0	0	1168	5841	11
175532	36	139	94	83248	106020	130
61857	11	32	30	25162	24610	28
163766	45	169	119	45724	74151	101
384053	38	140	102	110529	232241	216
21054	0	0	0	855	6622	4
252805	30	111	77	101382	127097	97
31961	8	25	9	14116	13155	39
294609	39	146	137	89506	160501	119
235069	46	175	157	135356	91502	118
174862	48	181	146	116066	24469	41
152043	29	107	84	144244	88229	107
38214	8	27	21	8773	13983	16
189451	39	147	139	102153	80716	69
344802	47	178	168	117440	157384	160
190943	50	193	163	104128	122975	158
396160	48	187	167	134238	191469	161
314212	48	187	145	134047	231257	165
396712	50	186	175	279488	258287	246
187992	40	151	137	79756	122531	89
102424	36	131	100	66089	61394	49
283392	40	155	150	102070	86480	107
401260	46	172	163	146760	195791	182
135936	39	148	137	154771	18284	16
373146	42	156	149	165933	147581	173
157429	39	143	112	64593	72558	90
236370	41	151	135	92280	147341	140
258959	42	145	114	67150	114651	142
214338	32	125	45	128692	100187	126
363154	39	145	120	124089	130332	123
232339	36	133	115	125386	134218	239
173260	21	79	78	37238	10901	15
317676	45	174	136	140015	145758	170
168994	50	192	179	150047	75767	123
233293	36	132	118	154451	134969	151
301585	44	159	147	156349	169216	194
216803	37	133	88	84601	105406	122
365230	47	185	115	68946	174586	173
46660	5	15	13	6179	21509	13
116678	43	152	76	52789	15673	35
195592	31	113	63	100350	75882	72

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

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






Confusion Matrix (predicted in columns / actuals in rows)
C1C2C3
C136141
C23485
C301531

\begin{tabular}{lllllllll}
\hline
Confusion Matrix (predicted in columns / actuals in rows) \tabularnewline
 & C1 & C2 & C3 \tabularnewline
C1 & 36 & 14 & 1 \tabularnewline
C2 & 3 & 48 & 5 \tabularnewline
C3 & 0 & 15 & 31 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=155920&T=1

[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]36[/C][C]14[/C][C]1[/C][/ROW]
[ROW][C]C2[/C][C]3[/C][C]48[/C][C]5[/C][/ROW]
[ROW][C]C3[/C][C]0[/C][C]15[/C][C]31[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=155920&T=1

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


Figures (Output of Computation)

Input Parameters & R Code

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