Free Statistics

of Irreproducible Research!

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, 17 Dec 2011 13:01:28 -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/17/t1324144901ydh2e6trukaypcq.htm/, Retrieved Thu, 28 Mar 2024 23:11:08 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=156531, Retrieved Thu, 28 Mar 2024 23:11:08 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact161
Family? (F = Feedback message, R = changed R code, M = changed R Module, P = changed Parameters, D = changed Data)
-       [Recursive Partitioning (Regression Trees)] [] [2011-12-17 18:01:28] [d21839ec896caba47931721a9c4efa75] [Current]
- RMP     [Kendall tau Correlation Matrix] [] [2011-12-17 18:13:54] [6d29560f77ba0d0db0a9caaa1b5e377d]
- R         [Kendall tau Correlation Matrix] [] [2012-08-18 11:34:53] [74be16979710d4c4e7c6647856088456]
- R       [Recursive Partitioning (Regression Trees)] [] [2012-08-18 12:33:39] [74be16979710d4c4e7c6647856088456]
Feedback Forum

Post a new message
Dataseries X:
24188	115	112285	146283
18273	109	84786	98364
14130	146	83123	86146
32287	116	101193	96933
8654	68	38361	79234
9245	101	68504	42551
33251	96	119182	195663
1271	67	22807	6853
5279	44	17140	21529
27101	100	116174	95757
16373	93	57635	85584
19716	140	66198	143983
17753	166	71701	75851
9028	99	57793	59238
18653	139	80444	93163
8828	130	53855	96037
29498	181	97668	151511
27563	116	133824	136368
18293	116	101481	112642
22530	88	99645	94728
15977	139	114789	105499
35082	135	99052	121527
16116	108	67654	127766
15849	89	65553	98958
16026	156	97500	77900
26569	129	69112	85646
24785	118	82753	98579
17569	118	85323	130767
23825	125	72654	131741
7869	95	30727	53907
14975	126	77873	178812
37791	135	117478	146761
9605	154	74007	82036
27295	165	90183	163253
2746	113	61542	27032
34461	127	101494	171975
8098	52	27570	65990
4787	121	55813	86572
24919	136	79215	159676
603	0	1423	1929
16329	108	55461	85371
12558	46	31081	58391
7784	54	22996	31580
28522	124	83122	136815
22265	115	70106	120642
14459	128	60578	69107
14526	80	39992	50495
22240	97	79892	108016
11802	104	49810	46341
7623	59	71570	78348
11912	125	100708	79336
7935	82	33032	56968
18220	149	82875	93176
19199	149	139077	161632
19918	122	71595	87850
21884	118	72260	127969
2694	12	5950	15049
15808	144	115762	155135
3597	67	32551	25109
5296	52	31701	45824
25239	108	80670	102996
29801	166	143558	160604
18450	80	117105	158051
7132	60	23789	44547
34861	107	120733	162647
35940	127	105195	174141
16688	107	73107	60622
24683	146	132068	179566
46230	84	149193	184301
10387	141	46821	75661
21436	123	87011	96144
30546	111	95260	129847
19746	98	55183	117286
15977	105	106671	71180
22583	135	73511	109377
17274	107	92945	85298
16469	85	78664	73631
14251	155	70054	86767
3007	88	22618	23824
16851	155	74011	93487
21113	104	83737	82981
17401	132	69094	73815
23958	127	93133	94552
23567	108	95536	132190
13065	129	225920	128754
15358	116	62133	66363
14587	122	61370	67808
12770	85	43836	61724
24021	147	106117	131722
9648	99	38692	68580
20537	87	84651	106175
7905	28	56622	55792
4527	90	15986	25157
30495	109	95364	76669
7117	78	26706	57283
17719	111	89691	105805
27056	158	67267	129484
33473	141	126846	72413
9758	122	41140	87831
21115	124	102860	96971
7236	93	51715	71299
13790	124	55801	77494
32902	112	111813	120336
25131	108	120293	93913
30910	99	138599	136048
35947	117	161647	181248
29848	199	115929	146123
6943	78	24266	32036
42705	91	162901	186646
31808	158	109825	102255
26675	126	129838	168237
8435	122	37510	64219
7409	71	43750	19630
14993	75	40652	76825
36867	115	87771	115338
33835	119	85872	109427
24164	124	89275	118168
12607	72	44418	84845
22609	91	192565	153197
5892	45	35232	29877
17014	78	40909	63506
5394	39	13294	22445
9178	68	32387	47695
6440	119	140867	68370
21916	117	120662	146304
4011	39	21233	38233
5818	50	44332	42071
18647	88	61056	50517
20556	155	101338	103950
238	0	1168	5841
70	36	13497	2341
22392	123	65567	84396
3913	32	25162	24610
12237	99	32334	35753
8388	136	40735	55515
22120	117	91413	209056
338	0	855	6622
11727	88	97068	115814
3704	39	44339	11609
3988	25	14116	13155
3030	52	10288	18274
13520	75	65622	72875
1421	71	16563	10112
20923	124	76643	142775
20237	151	110681	68847
3219	71	29011	17659
3769	145	92696	20112
12252	87	94785	61023
1888	27	8773	13983
14497	131	83209	65176
28864	162	93815	132432
21721	165	86687	112494
4821	54	34553	45109
33644	159	105547	170875
15923	147	103487	180759
42935	170	213688	214921
18864	119	71220	100226
4977	49	23517	32043
7785	104	56926	54454
17939	120	91721	78876
23436	150	115168	170745
325	112	111194	6940
13539	59	51009	49025
34538	136	135777	122037
12198	107	51513	53782
26924	130	74163	127748
12716	115	51633	86839
8172	107	75345	44830
10855	75	33416	77395
11932	71	83305	89324
14300	120	98952	103300
25515	116	102372	112283
2805	79	37238	10901
29402	150	103772	120691
16440	156	123969	58106
11221	51	27142	57140
28732	118	135400	122422
5250	71	21399	25899
28608	144	130115	139296
8092	47	24874	52678
4473	28	34988	23853
1572	68	45549	17306
2065	0	6023	7953
14817	110	64466	89455
16714	147	54990	147866
556	0	1644	4245
2089	15	6179	21509
2658	4	3926	7670
10695	64	32755	66675
1669	111	34777	14336
16267	85	73224	53608
7768	68	27114	30059
7252	40	20760	29668
6387	80	37636	22097
18715	88	65461	96841
7936	48	30080	41907
8643	76	24094	27080
7294	51	69008	35885
4570	67	54968	41247
7185	59	46090	28313
10058	61	27507	36845
2342	76	10672	16548
8509	60	34029	36134
13275	68	46300	55764
6816	71	24760	28910
1930	76	18779	13339
8086	62	21280	25319
10737	61	40662	66956
8033	67	28987	47487
7058	88	22827	52785
6782	30	18513	44683
5401	64	30594	35619
6521	68	24006	21920
10856	64	27913	45608
2154	91	42744	7721
6117	88	12934	20634
5238	52	22574	29788
4820	49	41385	31931
5615	62	18653	37754
4272	61	18472	32505
8702	76	30976	40557
15340	88	63339	94238
8030	66	25568	44197
9526	71	33747	43228
1278	68	4154	4103
4236	48	19474	44144
3023	25	35130	32868
7196	68	39067	27640
3394	41	13310	14063
6371	90	65892	28990
1574	66	4143	4694
9620	54	28579	42648
6978	59	51776	64329
4911	60	21152	21928
8645	77	38084	25836
8987	68	27717	22779
5544	72	32928	40820
3083	67	11342	27530
6909	64	19499	32378
3189	63	16380	10824
6745	59	36874	39613
16724	84	48259	60865
4850	64	16734	19787
7025	56	28207	20107
6047	54	30143	36605
7377	67	41369	40961
9078	58	45833	48231
4605	59	29156	39725
3238	40	35944	21455
8100	22	36278	23430
9653	83	45588	62991
8914	81	45097	49363
786	2	3895	9604
6700	72	28394	24552
5788	61	18632	31493
593	15	2325	3439
4506	32	25139	19555
6382	62	27975	21228
5621	58	14483	23177
3997	36	13127	22094
520	59	5839	2342
8891	68	24069	38798
999	21	3738	3255
7067	55	18625	24261
4639	54	36341	18511
5654	55	24548	40798
6928	72	21792	28893
1514	41	26263	21425
9238	61	23686	50276
8204	67	49303	37643
5926	76	25659	30377
5785	64	28904	27126
4	3	2781	13
5930	63	29236	42097
3710	40	19546	24451
705	69	22818	14335
443	48	32689	5084
2416	8	5752	9927
7747	52	22197	43527
5432	66	20055	27184
4913	76	25272	21610
2650	43	82206	20484
2370	39	32073	20156
775	14	5444	6012
5576	61	20154	18475
1352	71	36944	12645
3080	44	8019	11017
10205	60	30884	37623
6095	64	19540	35873




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

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=156531&T=0

As an alternative you can also use a 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'Gertrude Mary Cox' @ cox.wessa.net







Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C113213
C213131

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

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=156531&T=1

As an alternative you can also use a QR Code:  

The GUIDs for individual cells are displayed in the table below:

Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C113213
C213131



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