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 11:22:12 -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/t1324657356ljrxu9wi93sncwz.htm/, Retrieved Mon, 29 Apr 2024 21:07:53 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=160556, Retrieved Mon, 29 Apr 2024 21:07:53 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact90
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 18:59:57] [b98453cac15ba1066b407e146608df68]
- R PD  [Recursive Partitioning (Regression Trees)] [Recursive Patterning] [2011-12-09 14:04:03] [74b1e5a3104ff0b2404b2865a63336ad]
-   PD    [Recursive Partitioning (Regression Trees)] [paper3-4] [2011-12-23 16:01:31] [f7a862281046b7153543b12c78921b36]
-   P         [Recursive Partitioning (Regression Trees)] [paper3-5] [2011-12-23 16:22:12] [47995d3a8fac585eeb070a274b466f8c] [Current]
-   P           [Recursive Partitioning (Regression Trees)] [paper3-6] [2011-12-23 16:41:03] [f7a862281046b7153543b12c78921b36]
- RMPD          [ARIMA Backward Selection] [paper2-11] [2011-12-23 18:16:30] [f7a862281046b7153543b12c78921b36]
- RMPD          [ARIMA Forecasting] [paper2-12] [2011-12-23 18:21:13] [f7a862281046b7153543b12c78921b36]
Feedback Forum

Post a new message
Dataseries X:
112285	210907	56	30	79
84786	120982	56	28	58
83123	176508	54	38	60
101193	179321	89	30	108
38361	123185	40	22	49
68504	52746	25	26	0
119182	385534	92	25	121
22807	33170	18	18	1
17140	101645	63	11	20
116174	149061	44	26	43
57635	165446	33	25	69
66198	237213	84	38	78
71701	173326	88	44	86
57793	133131	55	30	44
80444	258873	60	40	104
53855	180083	66	34	63
97668	324799	154	47	158
133824	230964	53	30	102
101481	236785	119	31	77
99645	135473	41	23	82
114789	202925	61	36	115
99052	215147	58	36	101
67654	344297	75	30	80
65553	153935	33	25	50
97500	132943	40	39	83
69112	174724	92	34	123
82753	174415	100	31	73
85323	225548	112	31	81
72654	223632	73	33	105
30727	124817	40	25	47
77873	221698	45	33	105
117478	210767	60	35	94
74007	170266	62	42	44
90183	260561	75	43	114
61542	84853	31	30	38
101494	294424	77	33	107
27570	101011	34	13	30
55813	215641	46	32	71
79215	325107	99	36	84
1423	7176	17	0	0
55461	167542	66	28	59
31081	106408	30	14	33
22996	96560	76	17	42
83122	265769	146	32	96
70106	269651	67	30	106
60578	149112	56	35	56
39992	175824	107	20	57
79892	152871	58	28	59
49810	111665	34	28	39
71570	116408	61	39	34
100708	362301	119	34	76
33032	78800	42	26	20
82875	183167	66	39	91
139077	277965	89	39	115
71595	150629	44	33	85
72260	168809	66	28	76
5950	24188	24	4	8
115762	329267	259	39	79
32551	65029	17	18	21
31701	101097	64	14	30
80670	218946	41	29	76
143558	244052	68	44	101
117105	341570	168	21	94
23789	103597	43	16	27
120733	233328	132	28	92
105195	256462	105	35	123
73107	206161	71	28	75
132068	311473	112	38	128
149193	235800	94	23	105
46821	177939	82	36	55
87011	207176	70	32	56
95260	196553	57	29	41
55183	174184	53	25	72
106671	143246	103	27	67
73511	187559	121	36	75
92945	187681	62	28	114
78664	119016	52	23	118
70054	182192	52	40	77
22618	73566	32	23	22
74011	194979	62	40	66
83737	167488	45	28	69
69094	143756	46	34	105
93133	275541	63	33	116
95536	243199	75	28	88
225920	182999	88	34	73
62133	135649	46	30	99
61370	152299	53	33	62
43836	120221	37	22	53
106117	346485	90	38	118
38692	145790	63	26	30
84651	193339	78	35	100
56622	80953	25	8	49
15986	122774	45	24	24
95364	130585	46	29	67
26706	112611	41	20	46
89691	286468	144	29	57
67267	241066	82	45	75
126846	148446	91	37	135
41140	204713	71	33	68
102860	182079	63	33	124
51715	140344	53	25	33
55801	220516	62	32	98
111813	243060	63	29	58
120293	162765	32	28	68
138599	182613	39	28	81
161647	232138	62	31	131
115929	265318	117	52	110
24266	85574	34	21	37
162901	310839	92	24	130
109825	225060	93	41	93
129838	232317	54	33	118
37510	144966	144	32	39
43750	43287	14	19	13
40652	155754	61	20	74
87771	164709	109	31	81
85872	201940	38	31	109
89275	235454	73	32	151
44418	220801	75	18	51
192565	99466	50	23	28
35232	92661	61	17	40
40909	133328	55	20	56
13294	61361	77	12	27
32387	125930	75	17	37
140867	100750	72	30	83
120662	224549	50	31	54
21233	82316	32	10	27
44332	102010	53	13	28
61056	101523	42	22	59
101338	243511	71	42	133
1168	22938	10	1	12
13497	41566	35	9	0
65567	152474	65	32	106
25162	61857	25	11	23
32334	99923	66	25	44
40735	132487	41	36	71
91413	317394	86	31	116
855	21054	16	0	4
97068	209641	42	24	62
44339	22648	19	13	12
14116	31414	19	8	18
10288	46698	45	13	14
65622	131698	65	19	60
16563	91735	35	18	7
76643	244749	95	33	98
110681	184510	49	40	64
29011	79863	37	22	29
92696	128423	64	38	32
94785	97839	38	24	25
8773	38214	34	8	16
83209	151101	32	35	48
93815	272458	65	43	100
86687	172494	52	43	46
34553	108043	62	14	45
105547	328107	65	41	129
103487	250579	83	38	130
213688	351067	95	45	136
71220	158015	29	31	59
23517	98866	18	13	25
56926	85439	33	28	32
91721	229242	247	31	63
115168	351619	139	40	95
111194	84207	29	30	14
51009	120445	118	16	36
135777	324598	110	37	113
51513	131069	67	30	47
74163	204271	42	35	92
51633	165543	65	32	70
75345	141722	94	27	19
33416	116048	64	20	50
83305	250047	81	18	41
98952	299775	95	31	91
102372	195838	67	31	111
37238	173260	63	21	41
103772	254488	83	39	120
123969	104389	45	41	135
27142	136084	30	13	27
135400	199476	70	32	87
21399	92499	32	18	25
130115	224330	83	39	131
24874	135781	31	14	45
34988	74408	67	7	29
45549	81240	66	17	58
6023	14688	10	0	4
64466	181633	70	30	47
54990	271856	103	37	109
1644	7199	5	0	7
6179	46660	20	5	12
3926	17547	5	1	0
32755	133368	36	16	37
34777	95227	34	32	37
73224	152601	48	24	46
27114	98146	40	17	15
20760	79619	43	11	42
37636	59194	31	24	7
65461	139942	42	22	54
30080	118612	46	12	54
24094	72880	33	19	14
69008	65475	18	13	16
54968	99643	55	17	33
46090	71965	35	15	32
27507	77272	59	16	21
10672	49289	19	24	15
34029	135131	66	15	38
46300	108446	60	17	22
24760	89746	36	18	28
18779	44296	25	20	10
21280	77648	47	16	31
40662	181528	54	16	32
28987	134019	53	18	32
22827	124064	40	22	43
18513	92630	40	8	27
30594	121848	39	17	37
24006	52915	14	18	20
27913	81872	45	16	32
42744	58981	36	23	0
12934	53515	28	22	5
22574	60812	44	13	26
41385	56375	30	13	10
18653	65490	22	16	27
18472	80949	17	16	11
30976	76302	31	20	29
63339	104011	55	22	25
25568	98104	54	17	55
33747	67989	21	18	23
4154	30989	14	17	5
19474	135458	81	12	43
35130	73504	35	7	23
39067	63123	43	17	34
13310	61254	46	14	36
65892	74914	30	23	35
4143	31774	23	17	0
28579	81437	38	14	37
51776	87186	54	15	28
21152	50090	20	17	16
38084	65745	53	21	26
27717	56653	45	18	38
32928	158399	39	18	23
11342	46455	20	17	22
19499	73624	24	17	30
16380	38395	31	16	16
36874	91899	35	15	18
48259	139526	151	21	28
16734	52164	52	16	32
28207	51567	30	14	21
30143	70551	31	15	23
41369	84856	29	17	29
45833	102538	57	15	50
29156	86678	40	15	12
35944	85709	44	10	21
36278	34662	25	6	18
45588	150580	77	22	27
45097	99611	35	21	41
3895	19349	11	1	13
28394	99373	63	18	12
18632	86230	44	17	21
2325	30837	19	4	8
25139	31706	13	10	26
27975	89806	42	16	27
14483	62088	38	16	13
13127	40151	29	9	16
5839	27634	20	16	2
24069	76990	27	17	42
3738	37460	20	7	5
18625	54157	19	15	37
36341	49862	37	14	17
24548	84337	26	14	38
21792	64175	42	18	37
26263	59382	49	12	29
23686	119308	30	16	32
49303	76702	49	21	35
25659	103425	67	19	17
28904	70344	28	16	20
2781	43410	19	1	7
29236	104838	49	16	46
19546	62215	27	10	24
22818	69304	30	19	40
32689	53117	22	12	3
5752	19764	12	2	10
22197	86680	31	14	37
20055	84105	20	17	17
25272	77945	20	19	28
82206	89113	39	14	19
32073	91005	29	11	29
5444	40248	16	4	8
20154	64187	27	16	10
36944	50857	21	20	15
8019	56613	19	12	15
30884	62792	35	15	28
19540	72535	14	16	17




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

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=160556&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'Herman Ole Andreas Wold' @ wold.wessa.net







Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C11387
C219125

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

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



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