Free Statistics

of Irreproducible Research!

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 computationSat, 17 Dec 2011 16:07:56 -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/17/t1324156107wypig4wzjh2fwg3.htm/, Retrieved Fri, 29 Mar 2024 08:13:51 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=156586, Retrieved Fri, 29 Mar 2024 08:13:51 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact95
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [Kendall tau Correlation Matrix] [] [2010-12-05 17:44:33] [b98453cac15ba1066b407e146608df68]
- RMPD  [Kendall tau Correlation Matrix] [] [2011-12-12 16:33:38] [ee8c3a74bf3b349877806e9a50913c60]
- RMPD    [Recursive Partitioning (Regression Trees)] [] [2011-12-17 20:40:55] [ee8c3a74bf3b349877806e9a50913c60]
- R           [Recursive Partitioning (Regression Trees)] [] [2011-12-17 21:07:56] [7dc03dd48c8acabd98b217fada4a6bc0] [Current]
Feedback Forum

Post a new message
Dataseries X:
38	1724	270018	90	476	140824	165	3
34	1209	179444	63	429	110459	135	4
42	1844	222373	59	673	105079	121	16
38	2683	218443	135	1137	112098	148	2
27	1149	162874	48	348	43929	73	1
35	631	70849	46	179	76173	49	3
33	4513	498732	109	2201	187326	185	0
18	381	33186	46	111	22807	5	0
34	1997	207822	75	735	144408	125	7
33	1758	213274	72	595	66485	93	0
44	2079	298841	80	780	79089	154	0
55	2128	237633	61	660	81625	98	7
37	1659	164107	60	633	68788	70	8
52	2934	358752	114	1163	103297	148	4
43	1944	222781	46	622	69446	100	10
59	4764	369889	127	1650	114948	150	0
36	2122	305704	58	746	167949	197	6
39	2956	322896	90	1157	125081	114	4
29	1438	176082	41	507	125818	169	3
49	2320	263411	62	683	136588	200	8
45	2471	271965	99	828	112431	148	0
39	2769	425544	101	1203	103037	140	1
25	1442	179306	62	461	82317	74	5
52	1717	189897	65	601	118906	128	9
41	3220	220665	150	1201	83515	140	1
38	2733	214779	72	990	104581	116	0
41	2824	267198	91	1061	103129	147	5
43	1968	270750	73	617	83243	132	0
32	1495	155915	53	559	37110	70	0
41	2745	330118	140	1031	113344	144	0
46	2290	281588	50	911	139165	155	3
49	1830	204039	83	615	86652	165	6
48	2090	318563	53	779	112302	161	1
37	945	97717	40	310	69652	31	4
39	3092	369331	72	1198	119442	199	4
42	2764	273950	87	1186	69867	78	0
43	3658	422946	74	1317	101629	121	0
36	1842	215710	67	611	70168	112	2
17	934	115469	36	276	31081	41	1
39	3342	343095	45	1185	103925	158	2
39	3246	324178	42	1490	92622	123	10
41	1629	170369	75	646	79011	104	9
36	1735	195153	82	635	93487	94	5
42	1714	173510	85	470	64520	73	6
45	2496	153778	82	1022	93473	52	1
41	5501	455168	848	2068	114360	71	2
26	918	78800	57	330	33032	21	2
52	2228	208051	80	648	96125	155	0
47	3942	334657	116	1342	151911	174	10
45	2081	175523	68	868	89256	136	3
40	1816	213060	48	559	95671	128	0
4	496	24188	20	218	5950	7	0
44	2533	372238	81	833	149695	165	8
18	744	65029	21	255	32551	21	5
14	1161	101097	70	454	31701	35	3
37	3027	279012	125	1108	100087	137	1
56	2433	302218	80	642	169707	174	5
39	3576	323514	220	1079	150491	257	5
42	2606	339837	63	1046	120192	207	0
36	2175	252529	77	822	95893	103	12
46	3937	370483	65	1298	151715	171	10
28	3161	303406	146	1143	176225	279	12
43	2790	250858	72	1124	59900	83	11
42	2610	264889	59	931	104767	130	8
37	1426	228595	58	557	114799	131	2
30	1646	216027	58	436	72128	126	0
35	1867	188780	54	566	143592	158	6
44	2736	237856	89	832	89626	138	9
36	2277	232765	78	834	131072	200	2
28	1675	175699	62	621	126817	104	5
45	2537	239314	64	865	81351	111	13
23	893	73566	39	385	22618	26	6
45	2190	242585	58	716	88977	115	7
38	1694	187167	94	705	92059	127	2
38	1948	191920	61	683	81897	140	1
45	2314	359644	95	982	108146	121	4
36	2645	341637	48	1056	126372	183	3
41	1804	206059	50	522	249771	68	6
38	2250	201783	58	690	71154	112	2
37	1787	182231	67	644	71571	103	0
28	1678	153613	41	622	55918	63	1
45	4009	454794	114	1226	160141	166	0
26	1369	145943	45	653	38692	38	5
44	2306	280343	57	656	102812	163	2
8	870	80953	31	437	56622	59	0
27	1966	150216	175	822	15986	27	0
36	1338	156923	68	390	123534	108	6
37	3731	365448	278	1467	108535	88	1
57	2617	318651	91	907	93879	92	0
45	3085	179797	72	1044	144551	170	1
37	2312	251466	58	786	56750	98	1
38	2136	254506	71	655	127654	205	3
31	1808	185890	86	590	65594	96	9
36	2992	263577	89	1072	59938	107	1
36	2474	314255	134	947	146975	150	4
36	1624	189252	64	555	143372	123	3
35	1606	222504	72	552	168553	176	5
39	2091	285198	61	771	183500	213	0
65	3930	376927	130	1291	165986	208	12
30	3705	397681	73	1415	184923	307	13
51	2676	287015	83	846	140358	125	8
41	2296	285330	85	838	149959	208	0
36	1997	186856	116	640	57224	73	0
19	602	43287	43	214	43750	49	4
23	2146	185468	85	716	48029	82	4
40	2157	222268	72	755	104978	206	0
40	2549	259692	110	1140	100046	112	0
40	2649	301614	55	1030	101047	139	0
30	1110	121726	44	356	197426	60	0
41	3102	154165	79	906	160902	70	0
40	1861	306952	58	606	147172	112	4
45	2295	297982	70	684	109432	142	0
1	398	23623	9	156	1168	11	0
40	2205	195817	54	779	83248	130	0
11	530	61857	25	192	25162	31	4
45	1596	163766	107	457	45724	132	0
38	2949	384053	63	1162	110529	219	1
0	387	21054	2	146	855	4	0
30	2137	252805	67	866	101382	102	5
8	492	31961	22	200	14116	39	0
39	3397	311281	153	1211	89506	125	3
48	2089	240153	79	696	135356	121	7
48	1638	174892	112	485	116066	42	13
29	1685	152043	47	670	144244	111	3
8	568	38214	52	276	8773	16	0
43	1917	199336	113	662	102153	70	2
52	2759	353021	115	1010	117440	162	0
53	1288	196269	64	445	104128	173	0
48	3554	403932	134	1564	134238	171	4
48	2387	316105	120	820	134047	172	0
50	3328	396725	111	1151	279488	254	3
40	1250	187992	49	473	79756	90	0
36	1121	102424	55	401	66089	50	0
40	2867	284271	149	949	102070	113	4
46	4024	401260	155	1429	146760	187	4
40	1721	137843	104	534	154771	16	15
46	4061	383703	146	1698	165933	175	0
39	1830	157429	76	689	64593	90	4
41	1627	236370	83	528	92280	140	1
46	2535	282399	192	897	67150	145	1
32	1808	217478	69	610	128692	141	0
39	3873	366774	117	1548	124089	125	9
39	2181	236660	67	759	125386	241	1
21	2035	173260	37	716	37238	16	3
45	2960	323545	56	955	140015	175	11
50	1915	168994	122	720	150047	132	5
36	2604	246745	52	1011	154451	154	2
44	2633	301703	64	818	156349	198	1
0	2	1	0	0	0	0	9
0	207	14688	0	85	6023	5	0
0	5	98	0	0	0	0	0
0	8	455	0	0	0	0	0
0	0	0	0	0	0	0	1
0	0	0	0	0	0	0	0
37	2030	233143	58	699	84601	125	2
47	3179	372078	118	1052	68946	174	3
0	0	0	0	0	0	0	0
0	4	203	0	0	0	0	0
0	151	7199	0	74	1644	6	0
5	474	46660	7	259	6179	13	0
1	141	17547	3	69	3926	3	0
43	1047	116678	89	285	52789	35	0
0	29	969	0	0	0	0	0
32	1767	201582	48	582	100350	80	2




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

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







10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2CVC1C2CV
C13694560.447333620.3474
C2356140.946110610.8592
Overall--0.6669--0.5663

\begin{tabular}{lllllllll}
\hline
10-Fold Cross Validation \tabularnewline
 & Prediction (training) & Prediction (testing) \tabularnewline
Actual & C1 & C2 & CV & C1 & C2 & CV \tabularnewline
C1 & 369 & 456 & 0.4473 & 33 & 62 & 0.3474 \tabularnewline
C2 & 35 & 614 & 0.9461 & 10 & 61 & 0.8592 \tabularnewline
Overall & - & - & 0.6669 & - & - & 0.5663 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=156586&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]369[/C][C]456[/C][C]0.4473[/C][C]33[/C][C]62[/C][C]0.3474[/C][/ROW]
[ROW][C]C2[/C][C]35[/C][C]614[/C][C]0.9461[/C][C]10[/C][C]61[/C][C]0.8592[/C][/ROW]
[ROW][C]Overall[/C][C]-[/C][C]-[/C][C]0.6669[/C][C]-[/C][C]-[/C][C]0.5663[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=156586&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=156586&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
C13694560.447333620.3474
C2356140.946110610.8592
Overall--0.6669--0.5663







Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C12963
C2072

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

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



Parameters (Session):
Parameters (R input):
par1 = 1 ; 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')
}