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, 16 Dec 2011 09:51:38 -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/16/t1324047107x4woa1tb9mcv22c.htm/, Retrieved Sun, 05 May 2024 16:20:26 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=156023, Retrieved Sun, 05 May 2024 16:20:26 +0000
QR Codes:

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

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)] [] [2011-12-16 13:10:07] [8845143a6d3c316a3d9f23c370a4d275]
-   PD    [Recursive Partitioning (Regression Trees)] [] [2011-12-16 13:21:46] [8845143a6d3c316a3d9f23c370a4d275]
-   P         [Recursive Partitioning (Regression Trees)] [] [2011-12-16 14:51:38] [cd8b9934e81fda54a97eda68755efa21] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
1418	210907	79	94	112285	24188
869	120982	58	103	84786	18273
1530	176508	60	93	83123	14130
2172	179321	108	103	101193	32287
901	123185	49	51	38361	8654
463	52746	0	70	68504	9245
3201	385534	121	91	119182	33251
371	33170	1	22	22807	1271
1583	149061	43	93	116174	27101
1439	165446	69	60	57635	16373
1764	237213	78	123	66198	19716
1495	173326	86	148	71701	17753
1373	133131	44	90	57793	9028
2187	258873	104	124	80444	18653
1491	180083	63	70	53855	8828
4041	324799	158	168	97668	29498
1706	230964	102	115	133824	27563
2152	236785	77	71	101481	18293
1036	135473	82	66	99645	22530
1882	202925	115	134	114789	15977
1929	215147	101	117	99052	35082
2242	344297	80	108	67654	16116
1220	153935	50	84	65553	15849
1289	132943	83	156	97500	16026
2515	174724	123	120	69112	26569
2147	174415	73	114	82753	24785
2352	225548	81	94	85323	17569
1638	223632	105	120	72654	23825
1222	124817	47	81	30727	7869
1812	221698	105	110	77873	14975
1677	210767	94	133	117478	37791
1579	170266	44	122	74007	9605
1731	260561	114	158	90183	27295
807	84853	38	109	61542	2746
2452	294424	107	124	101494	34461
1940	215641	71	92	55813	4787
2662	325107	84	126	79215	24919
1499	167542	59	70	55461	16329
865	106408	33	37	31081	12558
2527	265769	96	120	83122	28522
2747	269651	106	93	70106	22265
1324	149112	56	95	60578	14459
1383	152871	59	90	79892	22240
1179	111665	39	80	49810	11802
2099	116408	34	31	71570	7623
4308	362301	76	110	100708	11912
918	78800	20	66	33032	7935
1831	183167	91	138	82875	18220
3373	277965	115	133	139077	19199
1713	150629	85	113	71595	19918
1438	168809	76	100	72260	21884
496	24188	8	7	5950	2694
2253	329267	79	140	115762	15808
744	65029	21	61	32551	3597
1161	101097	30	41	31701	5296
2352	218946	76	96	80670	25239
2144	244052	101	164	143558	29801
2694	233328	92	102	120733	34861
1973	256462	123	124	105195	35940
1769	206161	75	99	73107	16688
3148	311473	128	129	132068	24683
2474	235800	105	62	149193	46230
2084	177939	55	73	46821	10387
1954	207176	56	114	87011	21436
1226	196553	41	99	95260	30546
1389	174184	72	70	55183	19746
1496	143246	67	104	106671	15977
2269	187559	75	116	73511	22583
1833	187681	114	91	92945	17274
1268	119016	118	74	78664	16469
1943	182192	77	138	70054	14251
893	73566	22	67	22618	3007
1762	194979	66	151	74011	16851
1403	167488	69	72	83737	21113
1425	143756	105	120	69094	17401
1857	275541	116	115	93133	23958
1840	243199	88	105	95536	23567
1502	182999	73	104	225920	13065
1441	135649	99	108	62133	15358
1420	152299	62	98	61370	14587
1416	120221	53	69	43836	12770
2970	346485	118	111	106117	24021
1317	145790	30	99	38692	9648
1644	193339	100	71	84651	20537
870	80953	49	27	56622	7905
1654	122774	24	69	15986	4527
1054	130585	67	107	95364	30495
3004	286468	57	107	89691	17719
2008	241066	75	93	67267	27056
2547	148446	135	129	126846	33473
1885	204713	68	69	41140	9758
1626	182079	124	118	102860	21115
1468	140344	33	73	51715	7236
2445	220516	98	119	55801	13790
1964	243060	58	104	111813	32902
1381	162765	68	107	120293	25131
1369	182613	81	99	138599	30910
1659	232138	131	90	161647	35947
2888	265318	110	197	115929	29848
2845	310839	130	85	162901	42705
1982	225060	93	139	109825	31808
1904	232317	118	106	129838	26675
1391	144966	39	50	37510	8435
602	43287	13	64	43750	7409
1743	155754	74	31	40652	14993
1559	164709	81	63	87771	36867
2014	201940	109	92	85872	33835
2143	235454	151	106	89275	24164
874	99466	28	69	192565	22609
1281	100750	83	93	140867	6440
1401	224549	54	114	120662	21916
1944	243511	133	110	101338	20556
391	22938	12	0	1168	238
1605	152474	106	83	65567	22392
530	61857	23	30	25162	3913
1386	132487	71	98	40735	8388
2395	317394	116	82	91413	22120
387	21054	4	0	855	338
1742	209641	62	60	97068	11727
449	31414	18	9	14116	3988
2699	244749	98	115	76643	20923
1606	184510	64	140	110681	20237
1204	128423	32	120	92696	3769
1138	97839	25	66	94785	12252
568	38214	16	21	8773	1888
1459	151101	48	124	83209	14497
2158	272458	100	152	93815	28864
1111	172494	46	139	86687	21721
2833	328107	129	144	105547	33644
1955	250579	130	120	103487	15923
2922	351067	136	160	213688	42935
1002	158015	59	114	71220	18864
956	85439	32	78	56926	7785
2186	229242	63	119	91721	17939
3604	351619	95	141	115168	23436
1035	84207	14	101	111194	325
3261	324598	113	133	135777	34538
1587	131069	47	83	51513	12198
1424	204271	92	116	74163	26924
1701	165543	70	90	51633	12716
1249	141722	19	36	75345	8172
3352	299775	91	97	98952	14300
1641	195838	111	98	102372	25515
2035	173260	41	78	37238	2805
2312	254488	120	117	103772	29402
1369	104389	135	148	123969	16440
2201	199476	87	105	135400	28732
1900	224330	131	132	130115	28608
207	14688	4	0	6023	2065
1645	181633	47	73	64466	14817
2429	271856	109	86	54990	16714
151	7199	7	0	1644	556
474	46660	12	13	6179	2089
141	17547	0	4	3926	2658
872	95227	37	48	34777	1669
1318	152601	46	46	73224	16267

Tables (Output of Computation)





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

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






Confusion Matrix (predicted in columns / actuals in rows)
C1C2C3
C137115
C272321
C351037

\begin{tabular}{lllllllll}
\hline
Confusion Matrix (predicted in columns / actuals in rows) \tabularnewline
 & C1 & C2 & C3 \tabularnewline
C1 & 37 & 11 & 5 \tabularnewline
C2 & 7 & 23 & 21 \tabularnewline
C3 & 5 & 10 & 37 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=156023&T=1

[TABLE]
[ROW][C]Confusion Matrix (predicted in columns / actuals in rows)[/C][/ROW]
[ROW][C][/C][C]C1[/C][C]C2[/C][C]C3[/C][/ROW]
[ROW][C]C1[/C][C]37[/C][C]11[/C][C]5[/C][/ROW]
[ROW][C]C2[/C][C]7[/C][C]23[/C][C]21[/C][/ROW]
[ROW][C]C3[/C][C]5[/C][C]10[/C][C]37[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=156023&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=156023&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)
C1C2C3
C137115
C272321
C351037


Figures (Output of Computation)

Input Parameters & R Code

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