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 13:18:18 -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/t1324491602no60l70nnm7b9px.htm/, Retrieved Tue, 07 May 2024 17:29:38 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=158928, Retrieved Tue, 07 May 2024 17:29:38 +0000
QR Codes:

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

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]
-   PD    [Recursive Partitioning (Regression Trees)] [] [2011-12-21 18:18:18] [ff205c8f94ca61ac7cf7eb30cad83105] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
144244	152043	44	29	84	88229	107
197426	121726	28	30	83	178377	59
86652	204039	44	49	146	114198	159
65594	185890	48	31	90	92795	94
101382	252805	81	30	77	127097	97
76173	70849	8	35	89	47552	47
124089	366774	95	39	120	130332	123
66089	102424	42	36	100	61394	49
22618	73566	22	23	67	23824	25
149695	372238	85	44	157	191179	158
56622	80953	49	8	27	55792	58
150047	168994	147	50	179	75767	123
151911	334657	142	47	165	191889	172
25162	61857	23	11	30	24610	28
105079	222373	70	42	106	99776	121
69446	220700	71	43	87	113713	100
136588	263411	135	49	185	134163	186
128692	217478	38	32	45	100187	126
134047	316105	154	48	145	231257	165
31701	101097	30	14	41	45824	35
43750	43287	13	19	64	19630	49
143592	187965	79	35	128	113963	156
100350	199726	48	32	66	75882	72
151715	370483	154	46	161	197765	171
113344	327474	125	41	135	230054	137
279488	396725	137	50	175	258287	246
125081	322896	98	39	92	135213	113
68788	164107	50	37	113	72591	70
103037	425544	86	39	144	150773	137
102153	198094	66	43	151	80716	69
147172	306952	76	40	143	178303	108
146760	401260	103	46	163	195791	182
127654	254506	160	38	131	105590	192
110459	179444	71	34	127	113854	132
131072	232765	135	36	116	114268	199
126817	175699	143	28	89	94333	98
108535	361186	69	37	137	118845	83
82317	179306	66	25	84	111848	71
57224	186856	73	36	59	80684	70
135356	240153	76	48	163	91502	118
96125	208051	101	52	180	106314	155
1168	23623	12	1	0	5841	11
102070	283950	84	40	150	86480	107
118906	189897	103	52	208	102509	123
59900	233632	77	43	97	96252	80
79011	166266	67	41	111	80238	103
103297	358752	139	52	162	101345	148
143372	189252	83	36	139	111542	123
109432	297982	147	45	115	116938	141
167949	305704	113	36	139	164263	194
8773	38214	16	8	21	13983	16
45724	163766	83	45	119	74151	101
149959	285330	145	41	130	195894	204
81351	239314	99	45	154	102204	109
103129	267198	99	41	127	158376	138
154451	246745	116	36	118	134969	151
88977	242585	78	45	171	111563	113
140824	270018	96	38	116	186099	165
84601	233143	65	37	88	105406	122
169707	302218	122	56	208	210012	169
187326	498732	149	33	122	250931	177
156349	301703	185	44	147	169216	194
108146	359644	140	45	143	100125	121
168553	222504	94	35	127	162519	170
144408	207822	74	34	117	115466	124
183500	285198	158	39	104	211381	210
104128	196269	50	53	171	122975	158
33032	78800	20	26	66	56968	21
43929	162874	61	27	64	100792	71
56750	251466	76	37	85	115750	96
126372	341637	130	36	133	165278	178
160141	447353	147	45	138	175721	157
71571	182231	83	37	110	75881	101
125818	176082	103	29	85	111669	162
38692	145943	30	26	99	68580	38
95893	252529	89	36	127	81180	100
67150	282399	110	46	124	114651	142
110529	384053	135	38	102	232241	216
59938	261494	128	36	135	82390	107
81625	237633	117	55	184	94853	93
71154	201783	133	38	134	80906	109
104767	264889	92	42	142	124527	126
125386	236660	121	39	126	134218	239
165933	383703	127	46	161	147581	173
64520	173510	68	42	126	54518	71
165986	367807	151	58	221	189944	193
102812	280343	117	44	92	136323	159
81897	191030	127	38	133	89770	137
37110	155915	57	32	99	64057	66
146975	314255	73	36	132	135599	144
92059	187167	79	38	90	91313	126
144551	179797	165	45	159	81716	164
184923	397681	165	30	106	226168	297
79756	187992	71	40	137	122531	89
140015	323545	145	45	136	145758	170
89506	311281	106	39	137	160501	119
64593	157429	55	39	112	72558	90
70168	215710	79	36	89	104470	109
134238	403932	137	48	167	191469	161
101047	301614	169	40	124	135848	135
92622	324178	123	39	122	134097	123
14116	31961	18	8	9	13155	39
15986	150216	52	27	77	25157	27
89256	175523	99	45	146	104864	133
150491	323485	115	39	137	194679	256
140358	287015	117	51	176	117495	125
114948	369889	168	59	199	165354	142
95671	213060	94	40	137	160791	125
176225	303406	139	28	73	214738	267
93487	195153	75	36	108	133252	87
89626	237323	85	44	148	134904	133
66485	213274	82	33	82	110896	92
79089	296074	92	43	139	169351	149
55918	153613	62	28	89	83963	61
112302	318563	133	48	178	198299	159
104581	207280	86	38	139	116136	115
117440	353021	137	52	187	157384	160
101629	422946	112	43	148	188355	117
112098	218443	134	38	133	106194	145
68946	366745	130	47	115	174586	173
114799	228595	52	37	125	153242	132
119442	369331	132	39	148	189723	185
100087	279012	97	37	120	129711	133
139165	278019	123	45	165	184531	152
83243	270750	117	43	148	153990	125
123534	156923	71	36	130	100922	108
6179	46660	12	5	13	21509	13
1644	7199	7	0	0	4245	6
6023	14688	4	0	0	7953	5
120192	338543	146	42	150	197680	190
83248	195817	146	40	103	106020	130
103925	336047	124	39	143	164808	149
72128	216027	96	30	87	145707	121
112431	271965	123	45	148	140303	147
92280	236370	104	41	135	147341	140
83515	219420	138	41	144	96785	134
48029	185468	89	23	36	88634	82
93879	318651	130	57	122	170492	88
855	21054	4	0	0	6622	4
100046	259692	128	40	125	128602	111
31081	115469	33	17	46	58391	41
104978	219475	92	40	88	139292	205
5950	24188	8	4	7	15049	7
3926	17547	0	1	4	7670	3

Tables (Output of Computation)





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

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






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C1657
C22250

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

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


Figures (Output of Computation)

Input Parameters & R Code

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