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 computationThu, 22 Dec 2011 14:03:15 -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/22/t1324580606agd3vcwizyxcywg.htm/, Retrieved Fri, 03 May 2024 12:54:16 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=159865, Retrieved Fri, 03 May 2024 12:54:16 +0000
QR Codes:

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

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-11 15:00:07] [b4c8fd31b0af00c33711722ddf8d2c4c]
-   PD    [Recursive Partitioning (Regression Trees)] [] [2011-12-12 15:10:27] [74be16979710d4c4e7c6647856088456]
-   PD        [Recursive Partitioning (Regression Trees)] [] [2011-12-22 19:03:15] [ce4468323d272130d499477f5e05a6d2] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
140824	32033	165	165	186099
110459	20654	135	132	113854
105079	16346	121	121	99776
112098	35926	148	145	106194
43929	10621	73	71	100792
76173	10024	49	47	47552
187326	43068	185	177	250931
22807	1271	5	5	6853
144408	34416	125	124	115466
66485	20318	93	92	110896
79089	24409	154	149	169351
81625	20648	98	93	94853
68788	12347	70	70	72591
103297	21857	148	148	101345
69446	11034	100	100	113713
114948	33433	150	142	165354
167949	35902	197	194	164263
125081	22355	114	113	135213
125818	31219	169	162	111669
136588	21983	200	186	134163
112431	40085	148	147	140303
103037	18507	140	137	150773
82317	16278	74	71	111848
118906	24662	128	123	102509
83515	31452	140	134	96785
104581	32580	116	115	116136
103129	22883	147	138	158376
83243	27652	132	125	153990
37110	9845	70	66	64057
113344	20190	144	137	230054
139165	46201	155	152	184531
86652	10971	165	159	114198
112302	34811	161	159	198299
69652	3029	31	31	33750
119442	38941	199	185	189723
69867	4958	78	78	100826
101629	32344	121	117	188355
70168	19433	112	109	104470
31081	12558	41	41	58391
103925	36524	158	149	164808
92622	26041	123	123	134097
79011	16637	104	103	80238
93487	28395	94	87	133252
64520	16747	73	71	54518
93473	9105	52	51	121850
114360	11941	71	70	79367
33032	7935	21	21	56968
96125	19499	155	155	106314
151911	22938	174	172	191889
89256	25314	136	133	104864
95671	28524	128	125	160791
5950	2694	7	7	15049
149695	20867	165	158	191179
32551	3597	21	21	25109
31701	5296	35	35	45824
100087	32982	137	133	129711
169707	38975	174	169	210012
150491	42721	257	256	194679
120192	41455	207	190	197680
95893	23923	103	100	81180
151715	26719	171	171	197765
176225	53405	279	267	214738
59900	12526	83	80	96252
104767	26584	130	126	124527
114799	37062	131	132	153242
72128	25696	126	121	145707
143592	24634	158	156	113963
89626	27269	138	133	134904
131072	25270	200	199	114268
126817	24634	104	98	94333
81351	17828	111	109	102204
22618	3007	26	25	23824
88977	20065	115	113	111563
92059	24648	127	126	91313
81897	21588	140	137	89770
108146	25217	121	121	100125
126372	30927	183	178	165278
249771	18487	68	63	181712
71154	18050	112	109	80906
71571	17696	103	101	75881
55918	17326	63	61	83963
160141	39361	166	157	175721
38692	9648	38	38	68580
102812	26759	163	159	136323
56622	7905	59	58	55792
15986	4527	27	27	25157
123534	41517	108	108	100922
108535	21261	88	83	118845
93879	36099	92	88	170492
144551	39039	170	164	81716
56750	13841	98	96	115750
127654	23841	205	192	105590
65594	8589	96	94	92795
59938	15049	107	107	82390
146975	39038	150	144	135599
143372	30391	123	123	111542
168553	39932	176	170	162519
183500	43840	213	210	211381
165986	43146	208	193	189944
184923	50099	307	297	226168
140358	40312	125	125	117495
149959	32616	208	204	195894
57224	11338	73	70	80684
43750	7409	49	49	19630
48029	18213	82	82	88634
104978	45873	206	205	139292
100046	39844	112	111	128602
101047	28317	139	135	135848
197426	24797	60	59	178377
160902	7471	70	70	106330
147172	27259	112	108	178303
109432	23201	142	141	116938
1168	238	11	11	5841
83248	28830	130	130	106020
25162	3913	31	28	24610
45724	9935	132	101	74151
110529	27738	219	216	232241
855	338	4	4	6622
101382	13326	102	97	127097
14116	3988	39	39	13155
89506	24347	125	119	160501
135356	27111	121	118	91502
116066	3938	42	41	24469
144244	17416	111	107	88229
8773	1888	16	16	13983
102153	18700	70	69	80716
117440	36809	162	160	157384
104128	24959	173	158	122975
134238	37343	171	161	191469
134047	21849	172	165	231257
279488	49809	254	246	258287
79756	21654	90	89	122531
66089	8728	50	49	61394
102070	20920	113	107	86480
146760	27195	187	182	195791
154771	1037	16	16	18284
165933	42570	175	173	147581
64593	17672	90	90	72558
92280	34245	140	140	147341
67150	16786	145	142	114651
128692	20954	141	126	100187
124089	16378	125	123	130332
125386	31852	241	239	134218
37238	2805	16	15	10901
140015	38086	175	170	145758
150047	21166	132	123	75767
154451	34672	154	151	134969
156349	36171	198	194	169216
0	0	0	0	0
6023	2065	5	5	7953
0	0	0	0	0
0	0	0	0	0
0	0	0	0	0
0	0	0	0	0
84601	19354	125	122	105406
68946	22124	174	173	174586
0	0	0	0	0
0	0	0	0	0
1644	556	6	6	4245
6179	2089	13	13	21509
3926	2658	3	3	7670
52789	1813	35	35	15673
0	0	0	0	0
100350	17372	80	72	75882

Tables (Output of Computation)





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

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






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C16517
C2874

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

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


Figures (Output of Computation)

Input Parameters & R Code

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