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 computationSat, 10 Dec 2011 17:53:06 -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/10/t13235576077guvyl64t8kxn6k.htm/, Retrieved Sun, 05 May 2024 07:08:14 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=153640, Retrieved Sun, 05 May 2024 07:08:14 +0000
QR Codes:

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

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:35:21] [b98453cac15ba1066b407e146608df68]
- R PD    [Recursive Partitioning (Regression Trees)] [] [2011-12-10 22:53:06] [43f1c1fe5c2aaa4d7bd6f731e1a494da] [Current]
-   P       [Recursive Partitioning (Regression Trees)] [] [2011-12-10 23:11:55] [1dc3906a3b5a6ec06dc921f387100c9e]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
252101	3	92	34	131	124252	25695	147	148
134577	4	58	30	117	98956	19967	126	124
198520	14	62	38	146	98073	14338	108	108
189326	2	108	34	132	106816	34117	145	142
137449	1	55	25	80	41449	9713	68	66
65295	3	8	31	117	76173	10024	49	47
439387	0	134	29	112	177551	39981	171	163
33186	0	1	18	67	22807	1271	5	5
178368	5	64	30	116	126938	30207	106	106
186657	0	77	29	107	61680	18035	88	87
261949	0	86	38	140	72117	21609	145	141
191088	7	93	50	190	79738	19836	93	88
138866	7	44	33	109	57793	9028	60	60
296878	3	106	46	159	91677	21750	145	145
192648	9	63	38	146	64631	10038	95	95
333462	0	160	52	201	106385	30276	144	137
243571	4	104	32	124	161961	34972	179	177
263451	3	86	35	131	112669	19954	102	102
155679	3	93	25	96	114029	28113	157	151
227053	7	119	42	163	124550	18830	170	156
240028	0	107	40	151	105416	37144	140	140
388549	1	86	35	128	72875	17916	133	130
156540	5	50	25	89	81964	16186	74	71
148421	9	92	46	184	104880	19195	120	116
177732	0	123	36	136	76302	29124	134	129
191441	0	81	35	134	96740	29813	108	107
249893	5	93	38	146	93071	20270	132	128
236812	0	113	35	130	78912	26105	125	119
142329	0	52	28	105	35224	9155	66	62
259667	0	113	37	142	90694	18113	130	124
231625	3	112	40	155	125369	40546	143	140
176062	4	44	42	154	80849	10096	150	144
286683	1	123	44	169	104434	32338	152	150
87485	4	38	33	125	65702	2871	28	28
322865	2	111	35	135	108179	36592	190	177
247082	0	77	37	139	63583	4914	73	73
346011	0	92	39	145	95066	30190	115	111
191653	2	74	32	124	62486	18153	101	98
114673	1	33	17	55	31081	12558	41	41
284224	2	105	34	131	94584	32894	147	139
284195	10	108	33	125	87408	24138	107	107
155363	6	66	35	128	68966	16628	103	102
177306	5	69	32	107	88766	26369	84	80
144571	5	62	35	130	57139	14171	68	66
140319	1	50	45	73	90586	8500	52	51
405267	2	91	38	138	109249	11940	70	69
78800	2	20	26	82	33032	7935	21	21
201970	0	101	45	173	96056	19456	155	155
302674	9	129	44	169	146648	21347	165	163
164733	3	93	40	145	80613	24095	124	121
194221	0	89	33	134	87026	26204	121	118
24188	0	8	4	12	5950	2694	7	7
346142	8	80	41	151	131106	20366	161	154
65029	5	21	18	67	32551	3597	21	21
101097	3	30	14	52	31701	5296	35	35
246088	1	86	33	121	91072	29463	125	122
273108	5	116	49	186	159803	35838	157	152
282220	5	106	32	120	143950	42590	256	255
275505	0	127	37	135	112368	38665	192	177
214872	12	75	32	123	82124	19442	86	83
335121	9	138	41	158	144068	25515	164	164
267171	11	114	25	90	162627	51318	213	202
189637	9	55	42	165	55062	11807	80	77
229512	8	67	35	135	95329	24130	122	118
209798	2	45	33	125	105612	34053	122	123
201345	0	88	28	110	62853	22641	113	109
163833	6	67	31	121	125976	18898	128	126
204250	8	75	40	151	79146	24539	117	114
197813	2	114	32	123	108461	21664	162	161
132955	5	123	25	92	99971	21577	87	85
216092	13	86	42	162	77826	16643	103	101
73566	6	22	23	88	22618	3007	26	25
213198	7	67	42	163	84892	18798	104	102
181713	2	77	38	133	92059	24648	127	126
148698	0	105	34	132	77993	20286	132	130
300103	4	119	38	144	104155	23999	112	112
251437	3	88	32	124	109840	26813	155	150
197295	6	78	37	140	238712	14718	57	54
158163	2	112	34	132	67486	16963	109	106
155529	0	66	33	122	68007	16673	92	90
132672	1	58	25	97	48194	14646	57	55
377205	0	132	40	155	134796	31772	145	139
145905	5	30	26	99	38692	9648	38	38
223701	2	100	40	106	93587	23096	152	148
80953	0	49	8	28	56622	7905	59	58
130805	0	26	27	101	15986	4527	27	27
135082	5	67	32	120	113402	37432	104	104
305270	1	57	33	127	97967	21082	80	75
271806	0	95	50	178	74844	30437	76	73
150949	1	139	37	141	136051	36288	163	157
225805	1	73	33	122	50548	12369	89	87
197389	2	134	34	127	112215	23774	199	186
156583	6	37	28	102	59591	8108	89	88
222599	1	98	32	124	59938	15049	107	107
261601	4	58	32	124	137639	36021	137	131
178489	3	78	32	124	143372	30391	123	123
200657	3	88	31	111	138599	30910	152	149
259244	0	142	35	129	174110	40656	202	201
313075	11	127	58	223	135062	35070	159	145
346933	12	139	27	102	175681	47250	282	273
246440	8	108	45	174	130307	36236	111	111
252444	0	128	37	141	139141	29601	197	195
159965	0	62	32	122	44244	10443	72	69
43287	4	13	19	71	43750	7409	49	49
172239	4	89	22	81	48029	18213	82	82
185198	0	83	35	131	95216	40856	192	193
227681	0	116	36	139	92288	36471	102	102
260464	0	157	36	137	94588	26077	127	124
106288	0	28	23	91	197426	24797	60	59
109632	0	83	36	142	151244	6816	61	61
268905	4	72	36	133	139206	25527	106	102
266805	0	134	42	155	106271	22139	139	138
23623	0	12	1	0	1168	238	11	11
152474	0	106	32	123	71764	24459	114	114
61857	4	23	11	32	25162	3913	31	28
144889	0	83	40	149	45635	9895	132	101
346600	1	126	34	128	101817	25902	210	208
21054	0	4	0	0	855	338	4	4
224051	5	71	27	99	100174	12937	98	93
31414	0	18	8	25	14116	3988	39	39
261043	2	98	35	132	85008	23370	119	114
206108	7	66	44	167	124254	24015	107	104
154984	12	44	40	151	105793	3870	41	40
112933	2	29	28	103	117129	14648	97	94
38214	0	16	8	27	8773	1888	16	16
158671	2	56	35	131	94747	16768	65	64
302148	0	112	47	178	107549	33400	156	154
177918	0	46	46	177	97392	23770	158	145
350552	3	129	42	163	126893	34762	160	150
275578	0	139	48	187	118850	18793	161	156
368746	3	136	49	182	234853	48186	238	229
172464	0	66	35	135	74783	20140	85	84
94381	0	42	32	118	66089	8728	50	49
244295	4	70	36	140	95684	19060	106	101
382487	4	97	42	158	139537	26880	184	179
114525	14	49	35	132	144253	415	15	15
345884	0	113	42	156	153824	38902	155	154
147989	4	55	34	123	63995	17375	90	90
216638	0	100	36	134	84891	31360	133	133
192862	1	80	36	129	61263	15051	136	133
184818	0	29	32	125	106221	16785	109	97
336707	9	95	33	128	113587	15886	118	116
215836	1	114	35	129	113864	28548	222	221
173260	3	41	21	79	37238	2805	16	15
271773	10	128	40	154	119906	34012	162	157
130908	5	142	49	188	135096	19215	108	105
204009	2	88	33	122	151611	34177	153	150
245514	1	147	39	144	144645	32990	181	177
1	9	0	0	0	0	0	0	0
14688	0	4	0	0	6023	2065	5	5
98	0	0	0	0	0	0	0	0
455	0	0	0	0	0	0	0	0
0	1	0	0	0	0	0	0	0
0	0	0	0	0	0	0	0	0
195765	2	56	33	120	77457	17428	113	111
326038	1	121	42	168	62464	19912	165	165
0	0	0	0	0	0	0	0	0
203	0	0	0	0	0	0	0	0
7199	0	7	0	0	1644	556	6	6
46660	0	12	5	15	6179	2089	13	13
17547	0	0	1	4	3926	2658	3	3
107465	0	37	38	133	42087	1801	33	33
969	0	0	0	0	0	0	0	0
173102	2	47	28	101	87656	16541	67	63

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'George Udny Yule' @ yule.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 & 'George Udny Yule' @ yule.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=153640&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]'George Udny Yule' @ yule.wessa.net[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=153640&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=153640&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'George Udny Yule' @ yule.wessa.net






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C16121
C2973

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

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

Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C16121
C2973


Figures (Output of Computation)

Input Parameters & R Code

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