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 computationThu, 15 Dec 2011 10:01:49 -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/15/t1323961319xz02903i91fm46u.htm/, Retrieved Wed, 08 May 2024 18:50:04 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=155462, Retrieved Wed, 08 May 2024 18:50:04 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact81
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:35:21] [b98453cac15ba1066b407e146608df68]
- R PD    [Recursive Partitioning (Regression Trees)] [] [2011-12-15 15:01:49] [8a4496bd93dae12a8bdfa51e6ea7daab] [Current]
Feedback Forum

Post a new message
Dataseries X:
1575	129988	81	20	18	70	18158	5636	22622	30	28
1134	130358	46	38	17	68	30461	9079	73570	42	39
192	7215	18	0	0	0	1423	603	1929	0	0
2044	112976	87	49	22	68	25629	8874	36294	54	54
3283	219904	126	76	30	120	48758	17988	62378	86	80
5877	402036	218	104	31	120	129230	21325	167760	157	144
1322	117604	50	37	19	72	27376	8325	52443	36	36
1225	131822	50	57	25	96	26706	7117	57283	48	48
1463	99729	38	42	30	109	26505	7996	36614	45	42
2671	269088	87	67	26	104	49801	14218	93268	77	71
1810	113066	69	50	20	54	46580	6321	35439	49	49
1915	165392	62	66	30	118	48352	19690	72405	77	74
1452	78240	90	38	15	49	13899	5659	24044	28	27
2415	152673	84	48	22	88	39342	11370	55909	84	83
1254	134368	47	42	17	60	27465	4778	44689	31	31
1375	125769	68	47	19	74	55211	5954	49319	28	28
1504	123467	50	71	28	112	74098	22924	62075	99	98
1016	57396	49	0	12	45	13497	70	2341	2	2
2222	108458	79	50	28	110	38338	14369	40551	41	43
634	22762	21	12	13	39	52505	3706	11621	25	24
849	48633	50	16	14	55	10663	3147	18741	16	16
2189	182081	83	77	27	102	74484	16801	84202	96	95
1520	149502	61	32	25	96	28895	2162	15334	23	22
1791	93773	46	38	30	86	32827	4721	28024	33	33
1751	133428	79	50	21	78	36188	5290	53306	46	45
1180	113933	23	33	17	64	28173	6446	37918	59	59
1750	153851	140	49	22	82	54926	14711	54819	72	66
1101	140711	75	59	28	100	38900	13311	89058	72	70
2398	303863	106	55	26	99	88530	13577	103354	62	56
1826	163810	38	42	17	67	35482	14634	70239	55	55
1410	134521	41	47	23	87	26730	6931	33045	27	27
1433	157640	39	51	20	65	29806	9992	63852	41	37
1893	103274	90	45	16	63	41799	6185	30905	51	48
2525	193500	105	73	20	80	54289	3445	24242	26	26
2033	178768	43	51	21	84	36805	12327	78907	65	64
1	0	1	0	0	0	0	0	0	0	0
1817	181412	55	46	27	105	33146	9898	36005	28	21
1506	92342	47	44	14	51	23333	8022	31972	44	44
1924	115762	42	33	31	104	47686	10765	35853	36	36
1649	178277	50	71	31	124	77783	22717	115301	100	89
1672	145067	58	61	19	75	36042	10090	47689	104	101
1433	114146	50	28	30	120	34541	12385	34223	35	31
866	86039	26	21	23	84	75620	8513	43431	69	65
1683	125481	66	42	21	82	60610	5508	52220	73	71
1024	95535	42	44	22	87	55041	9628	33863	106	102
1029	129221	78	40	21	78	32087	11872	46879	53	53
629	61554	26	15	32	97	16356	4186	23228	43	41
1693	170811	83	46	21	84	40161	10877	42827	49	46
1715	159121	75	43	26	104	55459	17066	65765	38	37
2248	137317	52	57	25	93	36679	9175	38167	51	51
658	48188	28	12	22	82	22346	2102	14812	14	14
1234	95461	56	46	19	73	27377	10807	32615	40	40
2157	249356	65	60	24	87	50273	13662	82188	79	77
1725	191094	68	47	26	95	32104	9224	51763	52	51
1504	161082	51	50	27	105	27016	9001	59325	44	43
1454	111388	47	35	10	37	19715	7204	48976	34	33
1620	172614	58	45	26	96	33629	6572	43384	47	47
733	63205	18	25	23	88	27084	7509	26692	32	31
894	109102	56	47	21	83	32352	12920	53279	31	31
2355	137519	75	28	34	124	51845	5438	20652	40	40
1514	125777	51	48	29	116	26591	11489	38338	42	42
1636	88650	66	32	19	76	29677	6661	36735	34	35
1123	95845	50	28	19	65	54237	7941	42764	40	40
897	83419	29	31	23	86	20284	6173	44331	35	30
855	101723	25	13	22	85	22741	5562	41354	11	11
1229	94982	37	38	29	107	34178	9492	47879	43	41
2012	145568	62	49	31	124	69551	17456	103793	53	53
2393	113325	63	68	21	78	29653	9422	52235	82	82
878	87133	33	36	24	93	38071	10913	49825	41	41
340	31970	15	5	21	78	4157	1283	4105	6	6
2480	194516	103	53	15	59	28321	6198	58687	82	81
1071	98324	56	36	9	33	40195	4501	40745	47	47
1091	80820	56	54	23	92	48158	9560	33187	108	100
1425	89141	60	37	18	52	13310	3394	14063	46	46
2227	118147	55	52	34	133	78474	9871	37407	38	38
1082	56544	32	0	25	92	6386	2419	7190	0	0
1790	118838	52	52	25	103	31588	10630	49562	45	45
2072	118781	80	51	22	86	61254	8536	76324	57	56
816	60138	23	16	21	75	21152	4911	21928	20	18
1121	73422	66	33	26	96	41272	9775	27860	56	54
834	70248	60	48	22	81	34165	11227	28078	38	37
1766	225857	54	35	26	104	37054	6916	49577	42	40
751	51185	24	24	20	76	12368	3424	28145	37	37
1309	97181	32	37	25	90	23168	8637	36241	36	36
732	45100	39	17	19	75	16380	3189	10824	34	34
1327	115801	43	32	22	86	41242	8178	46892	53	49
2246	186310	190	55	25	100	48450	16739	61264	85	82
968	71960	86	39	22	88	20790	6094	22933	36	36
1015	80105	48	31	21	80	34585	7237	20787	33	33
1149	110416	43	26	21	77	35672	7355	43978	57	55
1301	98707	34	37	23	88	52168	9734	51305	50	50
1982	136234	67	66	22	79	53933	11225	55593	71	71
1092	136781	53	35	21	81	34474	6213	51648	32	31
1162	116132	54	24	12	48	43753	4875	30552	45	42
759	49164	33	22	13	46	36456	8159	23470	33	31
1980	189493	93	42	32	120	51183	11893	77530	53	51
1608	169406	50	86	24	90	52742	10754	57299	64	64
223	19349	12	13	1	2	3895	786	9604	14	14
1810	160902	88	21	24	96	37076	9706	34684	38	37
1466	109510	53	32	25	86	24079	7796	41094	39	37
553	43803	25	8	4	15	2325	593	3439	8	8
708	47062	19	38	15	48	29354	5600	25171	38	38
1079	110845	44	45	21	81	30341	7245	23437	24	23
957	92517	52	24	23	84	18992	7360	34086	22	22
585	58660	36	23	12	46	15292	4574	24649	18	18
596	27676	22	2	16	59	5842	522	2342	3	1
981	98550	33	52	24	96	28918	10905	45571	49	48
585	43646	24	5	9	29	3738	999	3255	5	5
0	0	0	0	0	0	0	0	0	0	0
975	75566	28	43	25	91	95352	9016	30002	47	46
751	57359	49	18	17	63	37478	5134	19360	33	33
1071	104330	36	44	18	68	26839	6608	43320	44	41
931	70369	47	45	21	84	26783	8577	35513	56	57
783	65494	56	29	17	54	33392	1543	23536	49	49
78	3616	5	0	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0	0	0	0
874	143931	37	32	20	75	25446	9803	54438	45	45
1327	117946	66	65	26	87	59847	12140	56812	78	78
1843	138702	86	26	27	108	28162	6678	33838	51	46
750	84336	33	24	20	80	33298	6420	32366	25	25
778	43410	19	7	1	3	2781	4	13	1	1
1442	139695	61	62	25	96	37121	7979	55082	62	59
807	79015	34	30	14	55	22698	5141	31334	29	29
1613	106116	47	54	27	99	27615	1311	16612	26	26
685	57586	38	3	12	48	32689	443	5084	4	4
285	19764	12	10	2	8	5752	2416	9927	10	10
1418	112195	43	46	16	60	23164	8396	47413	43	43
954	103651	25	23	23	88	20304	5462	27389	36	36
1283	113402	35	40	28	112	34409	7271	30425	43	41
256	11796	9	1	2	8	0	0	0	0	0
81	7627	9	0	0	0	0	0	0	0	0
1215	121085	50	29	17	52	92538	4423	33510	33	32
41	6836	3	0	1	4	0	0	0	0	0
1634	139563	46	46	17	57	46037	5331	40389	53	53
42	5118	3	5	0	0	0	0	0	0	0
528	40248	16	8	4	14	5444	775	6012	6	6
0	0	0	0	0	0	0	0	0	0	0
890	95079	42	21	25	91	23924	6676	22205	19	18
1203	80763	32	21	26	89	52230	1489	17231	26	26
81	7131	4	0	0	0	0	0	0	0	0
61	4194	11	0	0	0	0	0	0	0	0
849	60378	20	15	15	54	8019	3080	11017	16	16
1035	109173	44	47	20	77	34542	11409	46741	84	84
964	83484	16	17	19	76	21157	6769	39869	28	22




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

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=155462&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 time3 seconds
R Server'Gertrude Mary Cox' @ cox.wessa.net







Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C13339
C2270

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

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

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
C13339
C2270



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