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 computationThu, 22 Dec 2011 12:01:50 -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/22/t1324573326q3gxcggqvstiqft.htm/, Retrieved Fri, 03 May 2024 05:01:02 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=159730, Retrieved Fri, 03 May 2024 05:01:02 +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)
-     [Recursive Partitioning (Regression Trees)] [] [2010-12-05 18:59:57] [b98453cac15ba1066b407e146608df68]
- R PD  [Recursive Partitioning (Regression Trees)] [WS10 PLC no categ...] [2011-12-11 15:02:15] [9d4f280afcb4ecc352d7c6f913a0a151]
-   PD    [Recursive Partitioning (Regression Trees)] [WS10 PLC no categ...] [2011-12-12 18:04:39] [9d4f280afcb4ecc352d7c6f913a0a151]
-   PD      [Recursive Partitioning (Regression Trees)] [WS10 PLC no categ...] [2011-12-12 18:38:05] [9d4f280afcb4ecc352d7c6f913a0a151]
-   PD        [Recursive Partitioning (Regression Trees)] [Paper Regression ...] [2011-12-18 18:12:02] [9d4f280afcb4ecc352d7c6f913a0a151]
-   P             [Recursive Partitioning (Regression Trees)] [Paper Recursive P...] [2011-12-22 17:01:50] [2a6d487209befbc7c5ce02a41ecac161] [Current]
-   P               [Recursive Partitioning (Regression Trees)] [Paper Recursive P...] [2011-12-22 17:38:42] [9d4f280afcb4ecc352d7c6f913a0a151]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
272545	1747	69	483	96	38
179444	1209	64	429	71	34
222373	1844	69	673	70	42
218443	2683	104	1137	134	38
167843	1229	52	374	66	27
70849	631	28	179	8	35
506574	4627	123	2251	149	33
33186	381	19	111	1	18
216660	2063	59	740	83	34
213274	1758	44	595	82	33
307153	2132	109	800	92	46
239324	2139	116	665	117	55
166215	1702	71	648	50	37
364402	2965	79	1172	139	55
244103	2098	84	674	79	44
384448	4904	178	1692	175	59
325587	2242	68	811	114	36
323652	2978	158	1168	98	39
176082	1438	55	507	103	29
266736	2347	87	689	135	51
278265	2522	70	837	123	49
442703	2889	103	1270	87	39
180393	1447	41	462	66	25
189897	1717	54	601	103	52
234247	3363	122	1242	141	45
238002	2912	126	1031	113	38
267268	2828	127	1062	99	41
270787	1972	86	618	117	43
155915	1495	51	559	57	32
342564	2841	70	1062	127	41
282172	2299	76	913	123	47
216584	1909	76	643	44	50
318669	2101	85	782	133	48
98672	971	37	322	43	37
391593	3332	98	1249	138	43
273950	2764	56	1186	83	42
425120	3682	120	1324	112	44
227636	1918	83	640	79	36
115658	947	33	284	33	17
354670	3468	196	1222	129	42
324178	3247	80	1490	123	39
178083	1692	67	667	71	41
195153	1736	74	635	75	36
181810	1790	63	483	68	49
153778	2496	82	1022	50	45
455168	5501	151	2068	101	41
78800	918	42	330	20	26
208051	2228	76	648	101	52
348077	4051	118	1367	149	47
175523	2081	54	868	99	45
224591	1875	74	588	95	40
24188	496	24	218	8	4
372238	2539	316	833	85	44
65029	744	17	255	21	18
101097	1161	64	454	30	14
279012	3027	58	1108	97	37
317644	2527	85	662	122	61
340471	3706	186	1119	127	39
358958	2668	142	1058	159	42
252529	2175	83	822	89	36
379078	3980	142	1310	154	50
304468	3165	117	1145	139	28
270190	2954	114	1191	101	43
264889	2610	88	931	92	42
228595	1427	67	557	52	37
216027	1646	65	436	96	30
198798	1971	132	596	88	35
238146	2747	146	837	85	44
234891	2309	82	848	135	36
175816	1684	69	625	143	28
239314	2537	68	865	99	45
73566	893	32	385	22	23
242622	2195	84	718	78	45
187167	1695	53	705	79	38
209049	2061	63	732	131	38
360592	2329	86	988	140	46
342846	2695	92	1077	130	36
207650	1809	107	524	78	41
206500	2290	62	697	133	38
182357	1792	65	644	83	37
153613	1678	46	622	62	28
456979	4024	125	1227	151	45
145943	1369	69	653	30	26
280366	2309	105	656	117	44
80953	870	25	437	49	8
150216	1966	54	822	52	27
167878	1459	59	423	73	38
381493	3832	207	1493	81	37
331734	2721	117	932	136	57
179797	3086	105	1044	165	45
264350	2383	93	798	81	37
262793	2210	78	678	161	40
189142	1829	63	597	48	31
275997	3087	74	1099	149	36
328875	2559	82	966	75	40
189252	1624	36	555	83	36
222504	1607	51	552	94	35
287386	2109	79	778	159	39
392647	4027	153	1324	152	65
397681	3706	109	1415	165	30
287748	2715	137	853	117	51
294320	2325	65	848	148	41
186856	2001	181	640	73	36
43287	602	14	214	13	19
185468	2146	80	716	89	23
236654	2328	147	796	97	44
268077	2618	49	1170	129	40
305195	2688	90	1048	169	40
151344	1222	73	404	28	30
154287	3106	92	906	116	41
307000	1869	68	609	76	40
298039	2304	88	688	147	45
23623	398	11	156	12	1
195817	2205	73	779	146	40
61857	530	25	192	23	11
163766	1596	48	457	83	45
415339	3093	119	1200	151	38
21054	387	16	146	4	0
252805	2137	52	866	81	30
31961	492	22	200	18	8
317367	3450	115	1230	111	39
240153	2089	65	696	76	48
175083	1659	89	491	55	48
152043	1685	53	670	44	29
38214	568	34	276	16	8
216299	2060	43	716	73	43
357602	2792	82	1021	137	52
198104	1395	61	481	50	53
410803	3591	81	1582	137	48
316105	2388	98	820	154	48
397297	3334	124	1153	137	50
187992	1250	35	473	71	40
102424	1121	42	401	42	36
286327	2880	335	954	84	40
409878	4110	172	1449	113	46
143860	1759	54	546	63	42
391854	4139	133	1728	127	46
157429	1831	77	689	55	39
258751	1787	48	590	110	41
282399	2535	94	897	110	46
217665	1816	113	613	38	32
367246	3875	118	1548	95	39
244698	2296	91	800	127	39
173260	2035	63	716	41	21
325118	2986	101	959	145	47
168994	1915	57	720	147	50
253330	2648	86	1023	119	36
301703	2633	105	818	185	44
1	2	0	0	0	0
14688	207	10	85	4	0
98	5	1	0	0	0
455	8	2	0	0	0
0	0	0	0	0	0
0	0	0	0	0	0
246435	2117	85	737	69	37
392245	3361	158	1099	141	52
0	0	0	0	0	0
203	4	4	0	0	0
7199	151	5	74	7	0
46660	474	20	259	12	5
17547	141	5	69	0	1
116678	1047	42	285	37	43
969	29	2	0	0	0
206501	1822	68	591	52	34

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'AstonUniversity' @ aston.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 & 'AstonUniversity' @ aston.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=159730&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]'AstonUniversity' @ aston.wessa.net[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=159730&T=0

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






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C1748
C2676

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

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


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')
}