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 computationMon, 19 Dec 2011 10:36:19 -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/19/t1324309005j88jzwxv3bu6ngl.htm/, Retrieved Mon, 20 May 2024 10:09:03 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=157457, Retrieved Mon, 20 May 2024 10:09:03 +0000
QR Codes:

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

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-19 15:36:19] [05d3841c0e91f0207133db830e88168b] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
67	96	38	116	3	140824
63	67	34	127	4	110459
69	70	42	106	16	105079
103	134	38	133	2	112098
49	59	27	64	1	43929
28	8	35	89	3	76173
113	145	33	122	0	187326
19	1	18	22	0	22807
57	71	34	117	7	144408
43	82	33	82	0	66485
102	92	42	136	0	79089
110	106	55	184	7	81625
65	50	35	106	7	68788
74	113	51	159	4	103297
79	70	42	86	10	69446
174	168	59	199	0	114948
66	111	36	139	4	167949
154	96	39	92	4	125081
52	102	29	85	3	125818
82	135	46	174	8	136588
68	122	45	148	0	112431
102	86	39	144	1	103037
39	50	25	84	5	82317
54	97	52	208	9	118906
110	127	41	144	0	83515
112	86	38	139	0	104581
126	99	41	127	5	103129
84	117	39	136	0	83243
51	57	32	99	0	37110
63	125	41	135	0	113344
73	120	45	165	3	139165
72	44	46	135	5	86652
83	133	48	178	1	112302
35	43	37	137	4	69652
90	117	39	148	3	119442
56	83	42	127	0	69867
118	105	41	141	0	101629
79	79	36	89	2	70168
32	33	17	46	1	31081
180	116	39	143	2	103925
78	121	37	116	10	92622
62	67	38	103	8	79011
72	73	36	108	5	93487
56	68	42	126	6	64520
82	50	45	45	1	93473
146	101	38	122	2	114360
42	20	26	66	2	33032
75	101	52	180	0	96125
113	137	47	165	10	151911
54	99	45	146	3	89256
72	94	40	137	0	95671
24	8	4	7	0	5950
303	85	44	157	8	149695
17	21	18	61	5	32551
64	30	14	41	3	31701
56	96	37	120	1	100087
82	122	56	208	5	169707
171	115	36	127	5	150491
131	139	41	147	0	120192
82	89	36	127	12	95893
136	147	46	161	10	151715
113	135	28	73	12	176225
102	77	42	94	10	59900
86	72	38	129	8	104767
64	47	37	125	2	114799
65	96	30	87	0	72128
125	79	35	128	6	143592
139	85	44	148	9	89626
77	135	36	116	2	131072
66	143	28	89	5	126817
67	99	45	154	13	81351
32	22	23	67	6	22618
80	78	45	171	7	88977
52	77	38	90	2	92059
59	110	38	133	1	81897
76	132	42	137	4	108146
89	112	36	133	3	126372
106	78	41	125	6	249771
60	126	38	134	2	71154
60	73	37	110	0	71571
46	62	28	89	1	55918
111	143	45	138	0	160141
68	30	26	99	5	38692
103	117	44	92	2	102812
25	49	8	27	0	56622
53	26	27	77	0	15986
53	71	35	127	5	123534
175	59	37	137	1	108535
110	114	57	122	0	93879
102	161	41	143	1	144551
88	74	37	85	1	56750
73	151	38	131	3	127654
61	41	31	90	6	65594
72	121	36	135	1	59938
76	66	36	132	4	146975
36	83	36	139	3	143372
50	94	35	127	5	168553
74	154	39	104	0	183500
144	151	58	221	12	165986
105	164	30	106	13	184923
121	116	45	153	8	140358
62	140	41	130	0	149959
175	73	36	59	0	57224
14	13	19	64	4	43750
79	89	23	36	4	48029
130	90	40	88	0	104978
46	128	40	125	0	100046
87	169	40	124	0	101047
64	28	30	83	0	197426
86	116	41	127	0	160902
67	76	40	143	4	147172
85	145	45	115	0	109432
11	12	1	0	0	1168
70	120	36	94	0	83248
25	23	11	30	4	25162
48	83	45	119	0	45724
114	131	38	102	1	110529
16	4	0	0	0	855
52	81	30	77	5	101382
22	18	8	9	0	14116
110	103	39	137	3	89506
63	76	44	150	7	135356
83	55	44	137	13	116066
51	43	29	84	3	144244
34	16	8	21	0	8773
39	66	39	139	2	102153
80	137	47	168	0	117440
57	50	48	155	0	104128
77	134	46	161	4	134238
96	152	48	145	0	134047
121	137	50	175	3	279488
35	71	40	137	0	79756
42	42	36	100	0	66089
319	84	40	150	4	102070
164	103	46	163	4	146760
50	55	39	137	15	154771
127	127	42	149	0	165933
76	55	39	112	4	64593
46	104	41	135	1	92280
87	95	42	114	1	67150
111	35	32	45	0	128692
115	95	39	120	9	124089
83	121	35	111	1	125386
63	41	21	78	3	37238
98	143	45	136	11	140015
57	147	50	179	5	150047
81	97	36	118	2	154451
100	170	44	147	1	156349
0	0	0	0	9	0
10	4	0	0	0	6023
1	0	0	0	0	0
2	0	0	0	0	0
0	0	0	0	1	0
0	0	0	0	0	0
82	61	37	88	2	84601
139	130	47	115	3	68946
0	0	0	0	0	0
4	0	0	0	0	0
5	7	0	0	0	1644
20	12	5	13	0	6179
5	0	1	4	0	3926
42	37	43	76	0	52789
2	0	0	0	0	0
63	48	31	63	2	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'AstonUniversity' @ aston.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 & 'AstonUniversity' @ aston.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=157457&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]'AstonUniversity' @ aston.wessa.net[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=157457&T=0

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






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C15626
C21171

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

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


Figures (Output of Computation)

Input Parameters & R Code

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