Free Statistics

of Irreproducible Research!

Author's title

Author*Unverified author*
R Software Modulerwasp_regression_trees1.wasp
Title produced by softwareRecursive Partitioning (Regression Trees)
Date of computationSun, 09 Dec 2012 13:37:41 -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/2012/Dec/09/t1355078273dyol2g5eej8df87.htm/, Retrieved Thu, 28 Mar 2024 21:33:12 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=198031, Retrieved Thu, 28 Mar 2024 21:33:12 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact92
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]
- R PD  [Recursive Partitioning (Regression Trees)] [Regression Trees ...] [2011-12-08 21:54:15] [bc54fcbdb4f9c071218969745a8ec94b]
-           [Recursive Partitioning (Regression Trees)] [] [2012-12-09 18:37:41] [d41d8cd98f00b204e9800998ecf8427e] [Current]
Feedback Forum

Post a new message
Dataseries X:
112285	1418	210907	56	79	144
84786	869	120982	56	58	103
119182	3201	385534	92	121	150
116174	1583	149061	44	43	84
133824	1706	230964	53	102	151
99645	1036	135473	41	82	138
99052	1929	215147	58	101	124
65553	1220	153935	33	50	73
85323	2352	225548	112	81	116
117478	1677	210767	60	94	119
74007	1579	170266	62	44	129
101494	2452	294424	77	107	175
31081	865	106408	30	33	41
22996	1793	96560	76	42	47
60578	1324	149112	56	56	80
79892	1383	152871	58	59	73
82875	1831	183167	66	91	127
23789	1112	103597	43	27	26
149193	2474	235800	94	105	190
106671	1496	143246	103	67	116
92945	1833	187681	62	114	143
83737	1403	167488	45	69	113
69094	1425	143756	46	105	120
95536	1840	243199	75	88	134
95364	1054	130585	46	67	91
102860	1626	182079	63	124	181
115929	2888	265318	117	110	138
162901	2845	310839	92	130	254
109825	1982	225060	93	93	87
37510	1391	144966	144	39	51
192565	874	99466	50	28	56
44332	1105	102010	53	28	26
32334	1988	99923	66	44	36
91413	2395	317394	86	116	195
44339	620	22648	19	12	24
14116	449	31414	19	18	39
92696	1204	128423	64	32	37
94785	1138	97839	38	25	77
105547	2833	328107	65	129	153
71220	1002	158015	29	59	79
51009	1417	120445	118	36	63
135777	3261	324598	110	113	134
51513	1587	131069	67	47	69
74163	1424	204271	42	92	119
33416	946	116048	64	50	63
102372	1641	195838	67	111	197
103772	2312	254488	83	120	140
130115	1900	224330	83	131	167
24874	1254	135781	31	45	32
45549	1597	81240	66	58	13
4143	628	31774	23	0	0
28207	617	51567	30	21	30
45833	1656	102538	57	50	51
28394	1212	99373	63	12	25
18632	1143	86230	44	21	25
2325	435	30837	19	8	8
21792	830	64175	42	37	46
26263	652	59382	49	29	47
23686	707	119308	30	32	37
49303	954	76702	49	35	51
20055	733	84105	20	17	34
83123	1530	176508	54	60	98
57635	1439	165446	33	69	80
66198	1764	237213	84	78	130
57793	1373	133131	55	44	60
97668	4041	324799	154	158	140
101481	2152	236785	119	77	91
67654	2242	344297	75	80	119
69112	2515	174724	92	123	123
82753	2147	174415	100	73	90
72654	1638	223632	73	105	113
30727	1222	124817	40	47	56
79215	2662	325107	99	84	96
1423	186	7176	17	0	0
83122	2527	265769	146	96	126
39992	2702	175824	107	57	70
49810	1179	111665	34	39	57
100708	4308	362301	119	76	68
72260	1438	168809	66	76	102
5950	496	24188	24	8	7
115762	2253	329267	259	79	148
143558	2144	244052	68	101	137
117105	4691	341570	168	94	135
105195	1973	256462	105	123	181
95260	1226	196553	57	41	107
55183	1389	174184	53	72	94
73511	2269	187559	121	75	106
22618	893	73566	32	22	26
225920	1502	182999	88	73	54
61370	1420	152299	53	62	78
106117	2970	346485	90	118	121
84651	1644	193339	78	100	145
15986	1654	122774	45	24	27
26706	937	112611	41	46	48
89691	3004	286468	144	57	68
126846	2547	148446	91	135	150
51715	1468	140344	53	33	65
55801	2445	220516	62	98	97
111813	1964	243060	63	58	121
120293	1381	162765	32	68	99
161647	1659	232138	62	131	188
24266	1290	85574	34	37	40
129838	1904	232317	54	118	178
87771	1559	164709	109	81	176
44418	2146	220801	75	51	66
35232	1590	92661	61	40	39
40909	1590	133328	55	56	66
13294	1210	61361	77	27	27
140867	1281	100750	72	83	58
61056	1272	101523	42	59	77
101338	1944	243511	71	133	130
1168	391	22938	10	12	11
65567	1605	152474	65	106	101
40735	1386	132487	41	71	120
855	387	21054	16	4	4
97068	1742	209641	42	62	89
10288	800	46698	45	14	14
65622	1684	131698	65	60	78
76643	2699	244749	95	98	106
93815	2158	272458	65	100	132
34553	1421	108043	62	45	40
213688	2922	351067	95	136	220
91721	2186	229242	247	63	95
111194	1035	84207	29	14	12
83305	1926	250047	81	41	55
98952	3352	299775	95	91	103
37238	2035	173260	63	41	16
21399	961	92499	32	25	21
34988	1335	74408	67	29	36
64466	1645	181633	70	47	96
28579	1161	81437	38	37	36
38084	979	65745	53	26	50
27717	675	56653	45	38	30
32928	1241	158399	39	23	30
19499	1049	73624	24	30	33
36874	1081	91899	35	18	37
48259	1688	139526	151	28	83
29156	705	86678	40	12	19
45588	1597	150580	77	27	41
45097	982	99611	35	41	54
25139	532	31706	13	26	26
27975	882	89806	42	27	20
5752	285	19764	12	10	10
20154	642	64187	27	10	12
19540	894	72535	14	17	27
101193	2172	179321	89	108	135
38361	901	123185	40	49	61
68504	463	52746	25	0	39
22807	371	33170	18	1	5
17140	1192	101645	63	20	28
71701	1495	173326	88	86	82
80444	2187	258873	60	104	131
53855	1491	180083	66	63	84
114789	1882	202925	61	115	150
97500	1289	132943	40	83	110
77873	1812	221698	45	105	115
90183	1731	260561	75	114	127
61542	807	84853	31	38	27
27570	829	101011	34	30	35
55813	1940	215641	46	71	64
55461	1499	167542	66	59	84
70106	2747	269651	67	106	105
71570	2099	116408	61	34	40
33032	918	78800	42	20	21
139077	3373	277965	89	115	154
71595	1713	150629	44	85	116
32551	744	65029	17	21	21
120733	2694	233328	132	92	230
73107	1769	206161	71	75	71
132068	3148	311473	112	128	147
46821	2084	177939	82	55	64
87011	1954	207176	70	56	105
78664	1268	119016	52	118	81
70054	1943	182192	52	77	89
74011	1762	194979	62	66	84
93133	1857	275541	63	116	110
62133	1441	135649	46	99	96
43836	1416	120221	37	53	51
38692	1317	145790	63	30	38
56622	870	80953	25	49	59
67267	2008	241066	82	75	58
41140	1885	204713	71	68	74
138599	1369	182613	39	81	152
43750	602	43287	14	13	49
40652	1743	155754	61	74	73
85872	2014	201940	38	109	94
89275	2143	235454	73	151	120
32387	2072	125930	75	37	65
120662	1401	224549	50	54	98
21233	834	82316	32	27	25
13497	761	41566	35	0	2
25162	530	61857	25	23	31
16563	1050	91735	35	7	15
110681	1606	184510	49	64	83
29011	1502	79863	37	29	24
8773	568	38214	34	16	16
83209	1459	151101	32	48	56
86687	1111	172494	52	46	144
103487	1955	250579	83	130	143
23517	1060	98866	18	25	50
56926	956	85439	33	32	39
115168	3604	351619	139	95	169
51633	1701	165543	65	70	119
75345	1249	141722	94	19	75
123969	1369	104389	45	135	89
27142	1577	136084	30	27	40
135400	2201	199476	70	87	125
6023	207	14688	10	4	5
51776	1463	87186	54	28	47
21152	742	50090	20	16	20
11342	676	46455	20	22	34
16380	620	38395	31	16	34
16734	736	52164	52	32	32
30143	812	70551	31	23	43
41369	1051	84856	29	29	41
35944	945	85709	44	21	37
36278	554	34662	25	18	33
3895	222	19349	11	13	14
14483	608	62088	38	13	11
13127	459	40151	29	16	14
5839	578	27634	20	2	3
24069	826	76990	27	42	40
3738	509	37460	20	5	5
18625	717	54157	19	37	38
36341	637	49862	37	17	32
24548	857	84337	26	38	41
25659	1461	103425	67	17	49
28904	672	70344	28	20	21
2781	778	43410	19	7	1
29236	1141	104838	49	46	44
19546	680	62215	27	24	26
22818	1090	69304	30	40	21
32689	616	53117	22	3	4
22197	1145	86680	31	37	43
25272	888	77945	20	28	32
82206	849	89113	39	19	20
32073	1182	91005	29	29	34
5444	528	40248	16	8	6
36944	947	50857	21	15	24
8019	819	56613	19	15	16
30884	757	62792	35	28	72




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

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

As an alternative you can also use a 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 time5 seconds
R Server'Herman Ole Andreas Wold' @ wold.wessa.net







10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2CVC1C2CV
C19621230.8866107180.856
C23610460.966741140.9661
Overall--0.9266--0.9095

\begin{tabular}{lllllllll}
\hline
10-Fold Cross Validation \tabularnewline
 & Prediction (training) & Prediction (testing) \tabularnewline
Actual & C1 & C2 & CV & C1 & C2 & CV \tabularnewline
C1 & 962 & 123 & 0.8866 & 107 & 18 & 0.856 \tabularnewline
C2 & 36 & 1046 & 0.9667 & 4 & 114 & 0.9661 \tabularnewline
Overall & - & - & 0.9266 & - & - & 0.9095 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=198031&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]CV[/C][C]C1[/C][C]C2[/C][C]CV[/C][/ROW]
[ROW][C]C1[/C][C]962[/C][C]123[/C][C]0.8866[/C][C]107[/C][C]18[/C][C]0.856[/C][/ROW]
[ROW][C]C2[/C][C]36[/C][C]1046[/C][C]0.9667[/C][C]4[/C][C]114[/C][C]0.9661[/C][/ROW]
[ROW][C]Overall[/C][C]-[/C][C]-[/C][C]0.9266[/C][C]-[/C][C]-[/C][C]0.9095[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=198031&T=1

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

As an alternative you can also use a QR Code:  

The GUIDs for individual cells are displayed in the table below:

10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2CVC1C2CV
C19621230.8866107180.856
C23610460.966741140.9661
Overall--0.9266--0.9095







Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C110714
C24116

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

[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]107[/C][C]14[/C][/ROW]
[ROW][C]C2[/C][C]4[/C][C]116[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=198031&T=2

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

As an alternative you can also use a QR Code:  

The GUIDs for individual cells are displayed in the table below:

Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C110714
C24116



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