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 computationMon, 12 Dec 2011 13:28:55 -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/12/t1323714573qlunihmvsytt7j9.htm/, Retrieved Fri, 03 May 2024 12:34:28 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=154138, Retrieved Fri, 03 May 2024 12:34:28 +0000
QR Codes:

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

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:50:12] [b98453cac15ba1066b407e146608df68]
- R PD    [Recursive Partitioning (Regression Trees)] [] [2011-12-12 18:28:55] [05d3841c0e91f0207133db830e88168b] [Current]
-   P       [Recursive Partitioning (Regression Trees)] [] [2011-12-13 13:14:56] [e32f7fcc4522d286f7101d32ccf9e2fd]
Feedback Forum

Post a new message

Dataset

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

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=154138&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=154138&T=0

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






10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2CVC1C2CV
C110353620.7409121420.7423
C22039860.8293281130.8014
Overall--0.7815--0.7697

\begin{tabular}{lllllllll}
\hline
10-Fold Cross Validation \tabularnewline
 & Prediction (training) & Prediction (testing) \tabularnewline
Actual & C1 & C2 & CV & C1 & C2 & CV \tabularnewline
C1 & 1035 & 362 & 0.7409 & 121 & 42 & 0.7423 \tabularnewline
C2 & 203 & 986 & 0.8293 & 28 & 113 & 0.8014 \tabularnewline
Overall & - & - & 0.7815 & - & - & 0.7697 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=154138&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]1035[/C][C]362[/C][C]0.7409[/C][C]121[/C][C]42[/C][C]0.7423[/C][/ROW]
[ROW][C]C2[/C][C]203[/C][C]986[/C][C]0.8293[/C][C]28[/C][C]113[/C][C]0.8014[/C][/ROW]
[ROW][C]Overall[/C][C]-[/C][C]-[/C][C]0.7815[/C][C]-[/C][C]-[/C][C]0.7697[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=154138&T=1

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

10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2CVC1C2CV
C110353620.7409121420.7423
C22039860.8293281130.8014
Overall--0.7815--0.7697






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C111343
C220113

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

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

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
C111343
C220113


Figures (Output of Computation)

Input Parameters & R Code

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