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 computationFri, 23 Dec 2011 16:33:37 -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/23/t1324676073cbmjqm86kllgr73.htm/, Retrieved Mon, 29 Apr 2024 19:55:03 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=160722, Retrieved Mon, 29 Apr 2024 19:55:03 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact78
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-     [ARIMA Backward Selection] [] [2011-12-23 17:00:01] [a2638725f7f7c6bd63902ba17eba666b]
- RM D    [Recursive Partitioning (Regression Trees)] [] [2011-12-23 21:33:37] [1e640daebbc6b5a89eef23229b5a56d5] [Current]
Feedback Forum

Post a new message
Dataseries X:
1418	210907	56	79	30
869	120982	56	58	28
1530	176508	54	60	38
2172	179321	89	108	30
901	123185	40	49	22
463	52746	25	0	26
3201	385534	92	121	25
371	33170	18	1	18
1192	101645	63	20	11
1583	149061	44	43	26
1439	165446	33	69	25
1764	237213	84	78	38
1495	173326	88	86	44
1373	133131	55	44	30
2187	258873	60	104	40
1491	180083	66	63	34
4041	324799	154	158	47
1706	230964	53	102	30
2152	236785	119	77	31
1036	135473	41	82	23
1882	202925	61	115	36
1929	215147	58	101	36
2242	344297	75	80	30
1220	153935	33	50	25
1289	132943	40	83	39
2515	174724	92	123	34
2147	174415	100	73	31
2352	225548	112	81	31
1638	223632	73	105	33
1222	124817	40	47	25
1812	221698	45	105	33
1677	210767	60	94	35
1579	170266	62	44	42
1731	260561	75	114	43
807	84853	31	38	30
2452	294424	77	107	33
829	101011	34	30	13
1940	215641	46	71	32
2662	325107	99	84	36
186	7176	17	0	0
1499	167542	66	59	28
865	106408	30	33	14
1793	96560	76	42	17
2527	265769	146	96	32
2747	269651	67	106	30
1324	149112	56	56	35
2702	175824	107	57	20
1383	152871	58	59	28
1179	111665	34	39	28
2099	116408	61	34	39
4308	362301	119	76	34
918	78800	42	20	26
1831	183167	66	91	39
3373	277965	89	115	39
1713	150629	44	85	33
1438	168809	66	76	28
496	24188	24	8	4
2253	329267	259	79	39
744	65029	17	21	18
1161	101097	64	30	14
2352	218946	41	76	29
2144	244052	68	101	44
4691	341570	168	94	21
1112	103597	43	27	16
2694	233328	132	92	28
1973	256462	105	123	35
1769	206161	71	75	28
3148	311473	112	128	38
2474	235800	94	105	23
2084	177939	82	55	36
1954	207176	70	56	32
1226	196553	57	41	29
1389	174184	53	72	25
1496	143246	103	67	27
2269	187559	121	75	36
1833	187681	62	114	28
1268	119016	52	118	23
1943	182192	52	77	40
893	73566	32	22	23
1762	194979	62	66	40
1403	167488	45	69	28
1425	143756	46	105	34
1857	275541	63	116	33
1840	243199	75	88	28
1502	182999	88	73	34
1441	135649	46	99	30
1420	152299	53	62	33
1416	120221	37	53	22
2970	346485	90	118	38
1317	145790	63	30	26
1644	193339	78	100	35
870	80953	25	49	8
1654	122774	45	24	24
1054	130585	46	67	29
937	112611	41	46	20
3004	286468	144	57	29
2008	241066	82	75	45
2547	148446	91	135	37
1885	204713	71	68	33
1626	182079	63	124	33
1468	140344	53	33	25
2445	220516	62	98	32
1964	243060	63	58	29
1381	162765	32	68	28
1369	182613	39	81	28
1659	232138	62	131	31
2888	265318	117	110	52
1290	85574	34	37	21
2845	310839	92	130	24
1982	225060	93	93	41
1904	232317	54	118	33
1391	144966	144	39	32
602	43287	14	13	19
1743	155754	61	74	20
1559	164709	109	81	31
2014	201940	38	109	31
2143	235454	73	151	32
2146	220801	75	51	18
874	99466	50	28	23
1590	92661	61	40	17
1590	133328	55	56	20
1210	61361	77	27	12
2072	125930	75	37	17
1281	100750	72	83	30
1401	224549	50	54	31
834	82316	32	27	10
1105	102010	53	28	13
1272	101523	42	59	22
1944	243511	71	133	42
391	22938	10	12	1
761	41566	35	0	9
1605	152474	65	106	32
530	61857	25	23	11
1988	99923	66	44	25
1386	132487	41	71	36
2395	317394	86	116	31
387	21054	16	4	0
1742	209641	42	62	24
620	22648	19	12	13
449	31414	19	18	8
800	46698	45	14	13
1684	131698	65	60	19
1050	91735	35	7	18
2699	244749	95	98	33
1606	184510	49	64	40
1502	79863	37	29	22
1204	128423	64	32	38
1138	97839	38	25	24
568	38214	34	16	8
1459	151101	32	48	35
2158	272458	65	100	43
1111	172494	52	46	43
1421	108043	62	45	14
2833	328107	65	129	41
1955	250579	83	130	38
2922	351067	95	136	45
1002	158015	29	59	31
1060	98866	18	25	13
956	85439	33	32	28
2186	229242	247	63	31
3604	351619	139	95	40
1035	84207	29	14	30
1417	120445	118	36	16
3261	324598	110	113	37
1587	131069	67	47	30
1424	204271	42	92	35
1701	165543	65	70	32
1249	141722	94	19	27
946	116048	64	50	20
1926	250047	81	41	18
3352	299775	95	91	31
1641	195838	67	111	31
2035	173260	63	41	21
2312	254488	83	120	39
1369	104389	45	135	41
1577	136084	30	27	13
2201	199476	70	87	32
961	92499	32	25	18
1900	224330	83	131	39
1254	135781	31	45	14
1335	74408	67	29	7
1597	81240	66	58	17
207	14688	10	4	0
1645	181633	70	47	30
2429	271856	103	109	37
151	7199	5	7	0
474	46660	20	12	5
141	17547	5	0	1
1639	133368	36	37	16
872	95227	34	37	32
1318	152601	48	46	24
1018	98146	40	15	17
1383	79619	43	42	11
1314	59194	31	7	24
1335	139942	42	54	22
1403	118612	46	54	12
910	72880	33	14	19
616	65475	18	16	13
1407	99643	55	33	17
771	71965	35	32	15
766	77272	59	21	16
473	49289	19	15	24
1376	135131	66	38	15
1232	108446	60	22	17
1521	89746	36	28	18
572	44296	25	10	20
1059	77648	47	31	16
1544	181528	54	32	16
1230	134019	53	32	18
1206	124064	40	43	22
1205	92630	40	27	8
1255	121848	39	37	17
613	52915	14	20	18
721	81872	45	32	16
1109	58981	36	0	23
740	53515	28	5	22
1126	60812	44	26	13
728	56375	30	10	13
689	65490	22	27	16
592	80949	17	11	16
995	76302	31	29	20
1613	104011	55	25	22
2048	98104	54	55	17
705	67989	21	23	18
301	30989	14	5	17
1803	135458	81	43	12
799	73504	35	23	7
861	63123	43	34	17
1186	61254	46	36	14
1451	74914	30	35	23
628	31774	23	0	17
1161	81437	38	37	14
1463	87186	54	28	15
742	50090	20	16	17
979	65745	53	26	21
675	56653	45	38	18
1241	158399	39	23	18
676	46455	20	22	17
1049	73624	24	30	17
620	38395	31	16	16
1081	91899	35	18	15
1688	139526	151	28	21
736	52164	52	32	16
617	51567	30	21	14
812	70551	31	23	15
1051	84856	29	29	17
1656	102538	57	50	15
705	86678	40	12	15
945	85709	44	21	10
554	34662	25	18	6
1597	150580	77	27	22
982	99611	35	41	21
222	19349	11	13	1
1212	99373	63	12	18
1143	86230	44	21	17
435	30837	19	8	4
532	31706	13	26	10
882	89806	42	27	16
608	62088	38	13	16
459	40151	29	16	9
578	27634	20	2	16
826	76990	27	42	17
509	37460	20	5	7
717	54157	19	37	15
637	49862	37	17	14
857	84337	26	38	14
830	64175	42	37	18
652	59382	49	29	12
707	119308	30	32	16
954	76702	49	35	21
1461	103425	67	17	19
672	70344	28	20	16
778	43410	19	7	1
1141	104838	49	46	16
680	62215	27	24	10
1090	69304	30	40	19
616	53117	22	3	12
285	19764	12	10	2
1145	86680	31	37	14
733	84105	20	17	17
888	77945	20	28	19
849	89113	39	19	14
1182	91005	29	29	11
528	40248	16	8	4
642	64187	27	10	16
947	50857	21	15	20
819	56613	19	15	12
757	62792	35	28	15
894	72535	14	17	16




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time5 seconds
R Server'Gwilym Jenkins' @ jenkins.wessa.net
R Framework error message
The field 'Names of X columns' contains a hard return which cannot be interpreted.
Please, resubmit your request without hard returns in the 'Names of X columns'.

\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 & 'Gwilym Jenkins' @ jenkins.wessa.net \tabularnewline
R Framework error message & 
The field 'Names of X columns' contains a hard return which cannot be interpreted.
Please, resubmit your request without hard returns in the 'Names of X columns'.
\tabularnewline \hline \end{tabular} %Source: https://freestatistics.org/blog/index.php?pk=160722&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]'Gwilym Jenkins' @ jenkins.wessa.net[/C][/ROW]
[ROW][C]R Framework error message[/C][C]
The field 'Names of X columns' contains a hard return which cannot be interpreted.
Please, resubmit your request without hard returns in the 'Names of X columns'.
[/C][/ROW] [/TABLE] Source: https://freestatistics.org/blog/index.php?pk=160722&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=160722&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'Gwilym Jenkins' @ jenkins.wessa.net
R Framework error message
The field 'Names of X columns' contains a hard return which cannot be interpreted.
Please, resubmit your request without hard returns in the 'Names of X columns'.







10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2CVC1C2CV
C111381410.8898147240.8596
C29911850.922991470.9423
Overall--0.9064--0.8991

\begin{tabular}{lllllllll}
\hline
10-Fold Cross Validation \tabularnewline
 & Prediction (training) & Prediction (testing) \tabularnewline
Actual & C1 & C2 & CV & C1 & C2 & CV \tabularnewline
C1 & 1138 & 141 & 0.8898 & 147 & 24 & 0.8596 \tabularnewline
C2 & 99 & 1185 & 0.9229 & 9 & 147 & 0.9423 \tabularnewline
Overall & - & - & 0.9064 & - & - & 0.8991 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=160722&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]1138[/C][C]141[/C][C]0.8898[/C][C]147[/C][C]24[/C][C]0.8596[/C][/ROW]
[ROW][C]C2[/C][C]99[/C][C]1185[/C][C]0.9229[/C][C]9[/C][C]147[/C][C]0.9423[/C][/ROW]
[ROW][C]Overall[/C][C]-[/C][C]-[/C][C]0.9064[/C][C]-[/C][C]-[/C][C]0.8991[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=160722&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=160722&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
C111381410.8898147240.8596
C29911850.922991470.9423
Overall--0.9064--0.8991







Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C112025
C23141

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

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



Parameters (Session):
par1 = FALSE ; par2 = 1 ; par3 = 1 ; par4 = 1 ; par5 = 12 ; par6 = 3 ; par7 = 1 ; par8 = 1 ; par9 = 1 ;
Parameters (R input):
par1 = 2 ; 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')
}