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 computationSun, 11 Dec 2011 11:18: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/11/t1323620330z6pu1mjgqv4wm90.htm/, Retrieved Sun, 28 Apr 2024 20:12:22 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=153824, Retrieved Sun, 28 Apr 2024 20:12:22 +0000
QR Codes:

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

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-11 16:08:02] [6d8d5ddb787739e9d7807ef3376f0127]
-   P       [Recursive Partitioning (Regression Trees)] [] [2011-12-11 16:18:39] [bb550f50666f8cd9962562839f8255be] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
1655	264530	64	461	85	3
954	135248	59	331	58	4
1740	207253	64	639	57	14
2405	197987	96	1061	132	2
1025	143105	46	310	44	1
577	65295	27	164	42	3
3916	439387	103	1912	94	0
381	33186	19	111	46	0
1817	183696	51	703	71	5
1607	186657	39	556	65	0
1941	276819	99	726	78	0
1752	200779	100	536	55	7
1463	141987	59	560	55	7
2489	313944	69	1005	103	3
1691	196251	76	554	41	10
4301	342434	166	1515	115	0
1917	276692	60	690	46	4
2352	263451	130	940	80	3
1283	157448	49	460	37	3
2108	240201	74	631	50	7
2197	245847	66	719	93	0
2524	396701	94	1081	93	1
1276	157544	37	411	61	5
1470	156189	47	488	57	9
2904	196316	108	1116	150	0
2304	192167	107	847	67	0
2653	249893	122	994	88	5
1709	236812	76	530	54	0
1385	143182	47	524	47	0
2225	282946	55	838	121	0
2007	243048	68	780	44	3
1623	176062	67	551	73	4
1944	287382	81	722	49	1
849	87485	33	280	36	4
2803	343613	88	1108	72	2
2236	247082	52	950	77	0
3308	380797	109	1182	71	0
1668	191653	75	552	63	2
917	114673	31	275	36	1
2951	309038	170	1047	45	2
2982	292891	73	1370	37	10
1422	155568	60	568	65	6
1536	177306	68	571	78	5
1487	146175	51	416	69	5
2369	140319	73	985	82	1
4908	405267	135	1851	780	2
918	78800	42	330	57	2
2085	201970	69	611	72	0
3679	302833	103	1255	112	9
1923	164733	50	812	61	3
1617	194221	69	501	39	0
496	24188	24	218	20	0
2343	346142	289	787	73	8
744	65029	17	255	21	5
1161	101097	64	454	70	3
2722	255082	51	983	124	1
2322	283783	78	609	75	5
3298	295924	164	1006	201	5
2184	280943	121	884	58	0
1863	214872	74	690	67	12
3609	346520	128	1201	65	9
2827	273924	109	1032	138	11
2280	197035	94	919	71	10
2188	231904	81	783	48	8
1303	209798	62	521	54	2
1540	201345	60	409	55	0
1777	180403	121	547	46	6
2418	204441	129	757	84	8
1961	197813	67	736	71	2
1419	136421	61	515	56	5
2293	216092	60	789	55	13
893	73566	32	385	39	6
1958	214064	70	649	52	7
1593	181728	50	667	94	2
1524	150006	53	515	57	0
2037	308343	72	891	83	4
1915	251592	80	773	42	3
1728	202392	103	503	45	6
2002	173286	57	619	52	2
1541	162366	58	565	67	0
1539	132672	42	565	38	1
3391	390163	102	1104	114	0
1356	145905	66	649	45	5
1965	228657	90	551	53	2
870	80953	25	437	31	0
1728	132957	49	739	169	0
1100	135163	50	311	60	5
3380	333962	169	1332	276	1
2241	271806	96	783	84	0
2973	169483	100	1005	67	1
2135	234193	81	737	58	1
1856	207178	69	584	71	2
1568	157117	58	510	80	6
2788	242395	68	1009	89	1
2119	261601	71	838	115	4
1521	178489	35	523	60	3
1505	204221	44	513	69	3
1910	268066	69	706	57	0
3518	335002	134	1153	121	11
3278	361799	102	1281	69	12
2261	247804	107	746	60	8
2128	265849	58	787	81	0
1885	168501	164	597	115	0
602	43287	14	214	43	4
1977	172244	69	662	72	4
1775	189021	121	651	61	0
2283	227681	44	1015	101	0
2402	269329	82	922	50	0
974	106655	57	314	32	0
1447	117891	78	465	78	0
1760	290342	61	572	58	4
2082	266805	78	627	65	0
398	23623	11	156	9	0
1821	174970	69	648	49	0
530	61857	25	192	25	4
1508	144927	44	438	102	0
2709	355619	105	1083	59	1
387	21054	16	146	2	0
1913	230091	46	779	56	5
449	31414	19	200	22	0
3076	280685	107	1117	148	2
1794	209481	58	603	70	7
1456	161691	76	444	91	12
1477	132310	49	581	46	2
568	38214	34	276	52	0
1594	166026	36	546	101	2
2433	316370	74	916	105	0
1223	186273	56	427	58	0
3187	369581	73	1406	130	3
2186	275578	91	743	120	0
3081	368855	109	1075	104	3
1127	172464	31	431	44	0
1045	94381	35	380	48	0
2477	251253	292	806	144	4
3842	382499	154	1367	146	4
1506	118033	43	473	94	14
3810	365575	123	1610	139	0
1730	147989	72	651	67	4
1627	236370	46	528	83	0
1929	193220	77	672	169	1
1595	189020	108	523	69	0
3627	341992	106	1474	99	9
1987	222289	80	698	61	1
2035	173260	63	716	37	3
2538	275969	92	821	54	11
1603	130908	52	556	121	5
2297	208598	77	892	51	2
2268	262412	94	721	52	1
2	1	0	0	0	9
207	14688	10	85	0	0
5	98	1	0	0	0
8	455	2	0	0	0
0	0	0	0	0	1
0	0	0	0	0	0
1785	195812	76	610	51	2
2946	345447	134	973	108	1
0	0	0	0	0	0
4	203	4	0	0	0
151	7199	5	74	0	0
474	46660	20	259	7	0
141	17547	5	69	3	0
976	107465	38	267	80	0
29	969	2	0	0	0
1549	179994	58	518	43	2

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

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






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C18317
C2460

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

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


Figures (Output of Computation)

Input Parameters & R Code

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