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, 08 Dec 2011 17:03:39 -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/08/t1323381836cl5kj6hm7ydi2q6.htm/, Retrieved Fri, 03 May 2024 10:45:22 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=153162, Retrieved Fri, 03 May 2024 10:45:22 +0000
QR Codes:

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

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...] [2011-12-08 15:12:58] [586787d3e7267c593af3e1f6b16aa21a]
-         [Recursive Partitioning (Regression Trees)] [WS 10 - Recursive...] [2011-12-08 21:02:10] [74be16979710d4c4e7c6647856088456]
-   P         [Recursive Partitioning (Regression Trees)] [WS 10 - Recursive...] [2011-12-08 22:03:39] [a0aae37dd27f4b65e222573f53b5a13b] [Current]
-   P           [Recursive Partitioning (Regression Trees)] [WS 10 - Cross Val...] [2011-12-08 22:17:33] [586787d3e7267c593af3e1f6b16aa21a]
-                 [Recursive Partitioning (Regression Trees)] [] [2011-12-08 22:31:54] [586787d3e7267c593af3e1f6b16aa21a]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
79	30	146283	1	210907
58	28	98364	1	120982
60	38	86146	1	176508
108	30	96933	1	179321
49	22	79234	1	123185
0	26	42551	1	52746
121	25	195663	1	385534
1	18	6853	1	33170
20	11	21529	0	101645
43	26	95757	1	149061
69	25	85584	1	165446
78	38	143983	1	237213
86	44	75851	1	173326
44	30	59238	1	133131
104	40	93163	1	258873
63	34	96037	1	180083
158	47	151511	1	324799
102	30	136368	1	230964
77	31	112642	1	236785
82	23	94728	1	135473
115	36	105499	1	202925
101	36	121527	1	215147
80	30	127766	1	344297
50	25	98958	1	153935
83	39	77900	1	132943
123	34	85646	1	174724
73	31	98579	1	174415
81	31	130767	1	225548
105	33	131741	1	223632
47	25	53907	1	124817
105	33	178812	1	221698
94	35	146761	1	210767
44	42	82036	1	170266
114	43	163253	1	260561
38	30	27032	1	84853
107	33	171975	1	294424
30	13	65990	0	101011
71	32	86572	1	215641
84	36	159676	1	325107
0	0	1929	0	7176
59	28	85371	1	167542
33	14	58391	1	106408
42	17	31580	0	96560
96	32	136815	1	265769
106	30	120642	1	269651
56	35	69107	1	149112
57	20	50495	0	175824
59	28	108016	1	152871
39	28	46341	1	111665
34	39	78348	1	116408
76	34	79336	1	362301
20	26	56968	1	78800
91	39	93176	1	183167
115	39	161632	1	277965
85	33	87850	1	150629
76	28	127969	1	168809
8	4	15049	1	24188
79	39	155135	1	329267
21	18	25109	1	65029
30	14	45824	1	101097
76	29	102996	1	218946
101	44	160604	1	244052
94	21	158051	0	341570
27	16	44547	0	103597
92	28	162647	1	233328
123	35	174141	1	256462
75	28	60622	1	206161
128	38	179566	1	311473
105	23	184301	1	235800
55	36	75661	1	177939
56	32	96144	1	207176
41	29	129847	1	196553
72	25	117286	1	174184
67	27	71180	1	143246
75	36	109377	1	187559
114	28	85298	1	187681
118	23	73631	1	119016
77	40	86767	1	182192
22	23	23824	1	73566
66	40	93487	1	194979
69	28	82981	1	167488
105	34	73815	1	143756
116	33	94552	1	275541
88	28	132190	1	243199
73	34	128754	1	182999
99	30	66363	1	135649
62	33	67808	1	152299
53	22	61724	1	120221
118	38	131722	1	346485
30	26	68580	1	145790
100	35	106175	1	193339
49	8	55792	1	80953
24	24	25157	1	122774
67	29	76669	1	130585
46	20	57283	0	112611
57	29	105805	1	286468
75	45	129484	1	241066
135	37	72413	1	148446
68	33	87831	1	204713
124	33	96971	1	182079
33	25	71299	1	140344
98	32	77494	1	220516
58	29	120336	1	243060
68	28	93913	1	162765
81	28	136048	1	182613
131	31	181248	1	232138
110	52	146123	1	265318
37	21	32036	0	85574
130	24	186646	1	310839
93	41	102255	1	225060
118	33	168237	1	232317
39	32	64219	1	144966
13	19	19630	1	43287
74	20	76825	1	155754
81	31	115338	1	164709
109	31	109427	1	201940
151	32	118168	1	235454
51	18	84845	0	220801
28	23	153197	1	99466
40	17	29877	0	92661
56	20	63506	0	133328
27	12	22445	0	61361
37	17	47695	0	125930
83	30	68370	1	100750
54	31	146304	1	224549
27	10	38233	0	82316
28	13	42071	0	102010
59	22	50517	0	101523
133	42	103950	1	243511
12	1	5841	1	22938
0	9	2341	0	41566
106	32	84396	1	152474
23	11	24610	1	61857
44	25	35753	0	99923
71	36	55515	1	132487
116	31	209056	1	317394
4	0	6622	1	21054
62	24	115814	1	209641
12	13	11609	0	22648
18	8	13155	1	31414
14	13	18274	0	46698
60	19	72875	0	131698
7	18	10112	0	91735
98	33	142775	1	244749
64	40	68847	1	184510
29	22	17659	0	79863
32	38	20112	1	128423
25	24	61023	1	97839
16	8	13983	1	38214
48	35	65176	1	151101
100	43	132432	1	272458
46	43	112494	1	172494
45	14	45109	0	108043
129	41	170875	1	328107
130	38	180759	1	250579
136	45	214921	1	351067
59	31	100226	1	158015
25	13	32043	0	98866
32	28	54454	1	85439
63	31	78876	1	229242
95	40	170745	1	351619
14	30	6940	1	84207
36	16	49025	0	120445
113	37	122037	1	324598
47	30	53782	1	131069
92	35	127748	1	204271
70	32	86839	1	165543
19	27	44830	1	141722
50	20	77395	0	116048
41	18	89324	0	250047
91	31	103300	1	299775
111	31	112283	1	195838
41	21	10901	1	173260
120	39	120691	1	254488
135	41	58106	1	104389
27	13	57140	0	136084
87	32	122422	1	199476
25	18	25899	0	92499
131	39	139296	1	224330
45	14	52678	0	135781
29	7	23853	0	74408
58	17	17306	0	81240
4	0	7953	1	14688
47	30	89455	1	181633
109	37	147866	1	271856
7	0	4245	1	7199
12	5	21509	1	46660
0	1	7670	1	17547
37	16	66675	0	133368
37	32	14336	1	95227
46	24	53608	1	152601
15	17	30059	0	98146
42	11	29668	0	79619
7	24	22097	0	59194
54	22	96841	0	139942
54	12	41907	0	118612
14	19	27080	0	72880
16	13	35885	0	65475
33	17	41247	0	99643
32	15	28313	0	71965
21	16	36845	0	77272
15	24	16548	0	49289
38	15	36134	0	135131
22	17	55764	0	108446
28	18	28910	0	89746
10	20	13339	0	44296
31	16	25319	0	77648
32	16	66956	0	181528
32	18	47487	0	134019
43	22	52785	0	124064
27	8	44683	0	92630
37	17	35619	0	121848
20	18	21920	0	52915
32	16	45608	0	81872
0	23	7721	0	58981
5	22	20634	0	53515
26	13	29788	0	60812
10	13	31931	0	56375
27	16	37754	0	65490
11	16	32505	0	80949
29	20	40557	0	76302
25	22	94238	0	104011
55	17	44197	0	98104
23	18	43228	0	67989
5	17	4103	0	30989
43	12	44144	0	135458
23	7	32868	0	73504
34	17	27640	0	63123
36	14	14063	0	61254
35	23	28990	0	74914
0	17	4694	0	31774
37	14	42648	0	81437
28	15	64329	0	87186
16	17	21928	0	50090
26	21	25836	0	65745
38	18	22779	0	56653
23	18	40820	0	158399
22	17	27530	0	46455
30	17	32378	0	73624
16	16	10824	0	38395
18	15	39613	0	91899
28	21	60865	0	139526
32	16	19787	0	52164
21	14	20107	0	51567
23	15	36605	0	70551
29	17	40961	0	84856
50	15	48231	0	102538
12	15	39725	0	86678
21	10	21455	0	85709
18	6	23430	0	34662
27	22	62991	0	150580
41	21	49363	0	99611
13	1	9604	0	19349
12	18	24552	0	99373
21	17	31493	0	86230
8	4	3439	0	30837
26	10	19555	0	31706
27	16	21228	0	89806
13	16	23177	0	62088
16	9	22094	0	40151
2	16	2342	0	27634
42	17	38798	0	76990
5	7	3255	0	37460
37	15	24261	0	54157
17	14	18511	0	49862
38	14	40798	0	84337
37	18	28893	0	64175
29	12	21425	0	59382
32	16	50276	0	119308
35	21	37643	0	76702
17	19	30377	0	103425
20	16	27126	0	70344
7	1	13	0	43410
46	16	42097	0	104838
24	10	24451	0	62215
40	19	14335	0	69304
3	12	5084	0	53117
10	2	9927	0	19764
37	14	43527	0	86680
17	17	27184	0	84105
28	19	21610	0	77945
19	14	20484	0	89113
29	11	20156	0	91005
8	4	6012	0	40248
10	16	18475	0	64187
15	20	12645	0	50857
15	12	11017	0	56613
28	15	37623	0	62792
17	16	35873	0	72535

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

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






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C112619
C210134

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

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


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