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 computationFri, 23 Dec 2011 09:37: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/23/t1324651092uufmdv15wmxx9g7.htm/, Retrieved Mon, 29 Apr 2024 18:32:13 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=160456, Retrieved Mon, 29 Apr 2024 18:32:13 +0000
QR Codes:

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

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 18:59:57] [b98453cac15ba1066b407e146608df68]
- R PD  [Recursive Partitioning (Regression Trees)] [WS 10 Recursive p...] [2011-12-09 12:55:25] [60c0c94f647e2c90e494ab0f2a2f1926]
-   PD    [Recursive Partitioning (Regression Trees)] [WS 10 Recursive p...] [2011-12-09 13:55:20] [60c0c94f647e2c90e494ab0f2a2f1926]
-   PD      [Recursive Partitioning (Regression Trees)] [] [2011-12-23 14:13:57] [60c0c94f647e2c90e494ab0f2a2f1926]
-   P           [Recursive Partitioning (Regression Trees)] [] [2011-12-23 14:37:55] [7e9b6bd31a62815918579b1facd0f368] [Current]
-   P             [Recursive Partitioning (Regression Trees)] [] [2011-12-23 14:57:43] [60c0c94f647e2c90e494ab0f2a2f1926]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
279055	73	96	130	140824
212408	75	75	143	110459
233939	83	70	118	105079
222117	106	134	146	112098
189911	56	83	73	43929
70849	28	8	89	76173
605767	135	173	146	187326
33186	19	1	22	22807
227332	62	88	132	144408
258874	48	98	92	66485
369815	121	114	147	79089
264989	131	125	203	81625
212638	87	57	113	68788
368577	85	139	171	103297
269455	88	87	87	69446
398124	191	176	208	114948
335567	77	114	153	167949
428322	172	121	97	125081
182016	58	103	95	125818
267365	89	135	197	136588
279428	73	123	160	112431
508849	111	99	148	103037
206722	47	74	84	82317
200004	58	103	227	118906
257139	133	158	154	83515
270941	138	116	151	104581
324969	134	114	142	103129
329962	92	150	148	83243
190867	60	64	110	37110
393860	79	150	149	113344
327660	89	143	179	139165
269239	83	50	149	86652
396136	106	145	187	112302
130446	49	56	153	69652
430118	104	141	163	119442
273950	56	83	127	69867
428077	128	112	151	101629
254312	93	79	100	70168
120351	35	33	46	31081
395658	212	152	156	103925
345875	86	126	128	92622
216827	82	97	111	79011
224524	83	84	119	93487
182485	69	68	148	64520
157164	85	50	65	93473
459455	157	101	134	114360
78800	42	20	66	33032
255072	85	107	201	96125
368086	123	150	177	151911
230299	70	129	156	89256
244782	81	99	158	95676
24188	24	8	7	5950
400109	334	88	175	149695
65029	17	21	61	32551
101097	64	30	41	31701
309810	67	102	133	100087
375638	91	166	228	169707
367127	204	132	140	150491
381998	155	161	155	120192
280106	90	90	141	95893
400971	153	160	181	151715
315924	122	139	75	176225
291391	124	104	97	59900
295075	93	103	142	104767
280018	81	66	136	114799
267432	71	163	87	72128
217181	141	93	140	143592
258166	159	85	169	89626
260919	87	150	129	131072
182961	73	143	92	126817
256967	74	107	160	81351
73566	32	22	67	22618
272362	93	85	179	88977
229056	62	101	90	92059
229851	70	131	144	81897
371391	91	140	144	108146
398210	104	156	144	126372
220419	111	81	134	249771
231884	72	137	146	71154
217714	72	102	121	71571
206169	54	74	112	55918
483074	131	161	145	160141
146100	72	30	99	38692
295224	109	120	96	102812
80953	25	49	27	56622
217384	63	121	77	15986
179344	62	76	137	123534
415550	222	85	151	108535
389059	129	151	126	93879
180679	106	165	159	144551
299505	104	89	101	56750
292260	84	168	144	127654
199481	68	48	102	65594
282361	78	149	135	59938
329281	89	75	147	146975
234577	48	107	155	165904
297995	67	116	138	169265
342490	90	181	113	183500
416463	163	155	248	165986
415683	119	165	116	184923
297080	142	121	176	140358
331792	71	176	140	149959
229772	202	86	59	57224
43287	14	13	64	43750
238089	87	120	40	48029
263322	160	117	98	104978
302082	61	133	139	100046
321797	95	169	135	101047
193926	96	39	97	197426
175138	105	125	142	160902
354041	78	82	155	147172
303273	91	148	115	109432
23668	13	12	0	1168
196743	79	146	103	83248
61857	25	23	30	25162
217543	54	87	130	45724
440711	128	164	102	110529
21054	16	4	0	855
252805	52	81	77	101382
31961	22	18	9	14116
360436	125	118	150	89506
251948	77	76	163	135356
187320	97	55	148	116066
180842	58	62	94	144244
38214	34	16	21	8773
280392	56	98	151	102153
358276	84	137	187	117440
211775	67	50	171	104128
447335	90	152	170	134238
348017	99	163	145	134047
441946	133	142	198	279488
215177	43	80	152	79756
130177	47	59	112	66089
318037	365	94	173	102070
466139	198	128	177	146760
162279	62	63	153	154771
416643	140	127	161	165933
178322	86	60	115	64593
292443	54	118	147	92280
283913	100	110	124	67150
244802	126	45	57	128692
387072	125	96	144	124089
246963	92	128	126	125386
173260	63	41	78	37238
346748	108	146	153	140015
178402	60	147	196	150047
268750	96	121	130	154451
314070	112	185	159	156349
1	0	0	0	0
14688	10	4	0	6023
98	1	0	0	0
455	2	0	0	0
0	0	0	0	0
0	0	0	0	0
291650	94	85	94	84601
415421	168	164	129	68946
0	0	0	0	0
203	4	0	0	0
7199	5	7	0	1644
46660	20	12	13	6179
17547	5	0	4	3926
121550	46	37	89	52789
969	2	0	0	0
242774	75	62	71	100350

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

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

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

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


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