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, 23 Dec 2011 10:03:48 -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/23/t13246528724k7q23tjm7qqfi4.htm/, Retrieved Mon, 29 Apr 2024 21:36:08 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=160484, Retrieved Mon, 29 Apr 2024 21:36:08 +0000
QR Codes:

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

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)] [categorization RP] [2011-12-23 15:03:48] [e8e105c2e7d07131df1852088351b05f] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
1801	159261	91	48	19
1717	189672	59	53	20
192	7215	18	0	0
2295	129098	95	51	27
3450	230632	136	76	31
6861	515038	263	136	36
1795	180745	56	62	23
1681	185559	59	83	30
1897	154581	44	55	30
2974	298001	96	67	26
1946	121844	75	50	24
2330	200907	70	87	30
1839	101647	100	46	22
3183	220269	119	79	28
1486	170952	61	56	18
1567	154647	88	54	22
1756	142018	57	81	33
1247	79030	61	6	15
2779	167047	87	74	34
726	27997	24	13	18
1048	73019	59	22	15
2805	241082	100	99	30
1760	195820	72	38	25
2266	142001	54	59	34
1848	145433	86	50	21
1665	183744	32	50	21
2114	206521	164	63	25
1448	201385	94	90	31
2741	354924	118	60	31
2112	192399	44	52	20
1684	182286	44	61	28
1616	181590	45	60	22
2227	133801	105	53	17
3088	233686	123	76	25
2389	219428	53	63	24
1	0	1	0	0
2099	223044	63	54	28
1669	100129	51	44	14
2137	145864	49	42	35
2153	249965	64	83	34
2390	242379	71	105	22
1701	145794	59	37	34
1049	103623	33	25	23
2161	195891	78	64	24
1276	117156	50	55	26
1190	157787	95	41	22
745	81293	32	23	35
2374	243273	103	77	24
2289	233155	89	59	31
2639	160344	59	68	26
658	48188	28	12	22
1917	161922	69	99	21
2557	307432	74	78	27
2026	235223	79	56	30
1911	195583	59	67	33
1716	146061	56	40	11
1852	208834	67	53	26
981	93764	24	26	26
1177	151985	66	67	23
2849	195506	97	36	38
1688	148922	60	50	31
2162	142670	81	51	20
1331	129561	61	46	22
1307	122204	38	57	26
1256	160930	35	27	26
1294	99184	41	38	33
2311	192811	71	72	36
2897	138708	65	93	25
1103	114408	38	59	24
340	31970	15	5	21
2791	225558	112	53	19
1338	139220	72	40	12
1441	113612	68	72	30
1681	119537	72	53	21
2650	162203	67	81	34
1499	100098	44	27	32
2302	174768	60	94	28
2540	158459	97	71	28
1000	80934	30	20	21
1234	84971	71	34	31
927	80545	68	54	26
2176	287191	64	49	29
957	62974	28	26	23
1551	134091	40	48	25
1014	75555	46	35	22
1772	162154	55	32	26
2630	227638	229	55	33
1205	115367	112	58	24
1392	115603	63	44	24
1524	155537	52	45	21
1829	153133	41	49	28
2229	165618	78	72	27
1233	151517	57	39	25
1365	133686	58	28	15
950	61342	40	24	13
2319	245196	117	52	36
1857	195576	70	96	24
223	19349	12	13	1
2390	225371	105	38	24
1985	153213	78	41	31
700	59117	29	24	4
1062	91762	24	54	21
1311	136769	54	68	23
1157	114798	61	28	23
823	85338	40	36	12
596	27676	22	2	16
1545	153535	48	91	29
1130	122417	37	29	26
0	0	0	0	0
1082	91529	32	46	25
1135	107205	67	25	21
1367	144664	45	51	23
1506	146445	63	60	21
870	76656	60	36	21
78	3616	5	0	0
0	0	0	0	0
1130	183088	44	40	23
1582	144677	84	68	33
2034	159104	98	28	30
970	128944	39	41	23
778	43410	19	7	1
1752	175774	73	70	29
957	95401	42	30	18
2098	134837	55	69	33
731	60493	40	3	12
285	19764	12	10	2
1834	164062	56	46	21
1148	132696	33	34	28
1646	155367	54	54	29
256	11796	9	1	2
98	10674	9	0	0
1404	142261	57	39	18
41	6836	3	0	1
1824	162563	63	48	21
42	5118	3	5	0
528	40248	16	8	4
0	0	0	0	0
1073	122641	47	38	25
1305	88837	38	21	26
81	7131	4	0	0
261	9056	14	0	4
934	76611	24	15	17
1180	132697	51	50	21
1148	100681	20	17	22

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

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






10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2CVC1C2CV
C14472660.626944330.5714
C21154490.796122640.7442
Overall--0.7016--0.6626

\begin{tabular}{lllllllll}
\hline
10-Fold Cross Validation \tabularnewline
 & Prediction (training) & Prediction (testing) \tabularnewline
Actual & C1 & C2 & CV & C1 & C2 & CV \tabularnewline
C1 & 447 & 266 & 0.6269 & 44 & 33 & 0.5714 \tabularnewline
C2 & 115 & 449 & 0.7961 & 22 & 64 & 0.7442 \tabularnewline
Overall & - & - & 0.7016 & - & - & 0.6626 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=160484&T=1

[TABLE]
[ROW][C]10-Fold Cross Validation[/C][/ROW]
[ROW][C][/C][C]Prediction (training)[/C][C]Prediction (testing)[/C][/ROW]
[ROW][C]Actual[/C][C]C1[/C][C]C2[/C][C]CV[/C][C]C1[/C][C]C2[/C][C]CV[/C][/ROW]
[ROW][C]C1[/C][C]447[/C][C]266[/C][C]0.6269[/C][C]44[/C][C]33[/C][C]0.5714[/C][/ROW]
[ROW][C]C2[/C][C]115[/C][C]449[/C][C]0.7961[/C][C]22[/C][C]64[/C][C]0.7442[/C][/ROW]
[ROW][C]Overall[/C][C]-[/C][C]-[/C][C]0.7016[/C][C]-[/C][C]-[/C][C]0.6626[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=160484&T=1

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

10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2CVC1C2CV
C14472660.626944330.5714
C21154490.796122640.7442
Overall--0.7016--0.6626






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C14336
C2758

\begin{tabular}{lllllllll}
\hline
Confusion Matrix (predicted in columns / actuals in rows) \tabularnewline
 & C1 & C2 \tabularnewline
C1 & 43 & 36 \tabularnewline
C2 & 7 & 58 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=160484&T=2

[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]43[/C][C]36[/C][/ROW]
[ROW][C]C2[/C][C]7[/C][C]58[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=160484&T=2

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

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
C14336
C2758


Figures (Output of Computation)

Input Parameters & R Code

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