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 computationWed, 14 Dec 2011 08:17: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/14/t1323868662naf3n1vf757ke49.htm/, Retrieved Wed, 01 May 2024 19:07:45 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=154930, Retrieved Wed, 01 May 2024 19:07:45 +0000
QR Codes:

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

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)] [] [2011-12-14 13:17:28] [bd7a66e2f212a6bc9afe853e3942ee45] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
56	79	30	112285	21
56	58	28	84786	23
54	60	38	83123	22
92	121	25	119182	22
44	43	26	116174	21
33	69	25	57635	22
84	78	38	66198	21
55	44	30	57793	21
154	158	47	97668	21
53	102	30	133824	21
119	77	31	101481	23
41	82	23	99645	21
58	101	36	99052	21
75	80	30	67654	22
33	50	25	65553	22
100	73	31	82753	21
112	81	31	85323	22
73	105	33	72654	23
40	47	25	30727	22
60	94	35	117478	22
62	44	42	74007	21
77	107	33	101494	21
99	84	36	79215	21
17	0	0	1423	20
30	33	14	31081	21
76	42	17	22996	25
146	96	32	83122	21
56	56	35	60578	21
107	57	20	39992	20
58	59	28	79892	24
34	39	28	49810	23
119	76	34	100708	21
66	91	39	82875	24
66	76	28	72260	21
24	8	4	5950	23
259	79	39	115762	23
41	76	29	80670	21
68	101	44	143558	22
168	94	21	117105	20
43	27	16	23789	18
105	123	35	105195	22
94	105	23	149193	21
57	41	29	95260	21
53	72	25	55183	23
103	67	27	106671	22
121	75	36	73511	21
62	114	28	92945	21
32	22	23	22618	21
45	69	28	83737	22
46	105	34	69094	21
75	88	28	95536	21
88	73	34	225920	23
53	62	33	61370	21
78	100	35	84651	22
45	24	24	15986	22
46	67	29	95364	20
41	46	20	26706	21
144	57	29	89691	21
91	135	37	126846	21
63	124	33	102860	21
53	33	25	51715	22
62	98	32	55801	21
63	58	29	111813	24
32	68	28	120293	22
62	131	31	161647	24
117	110	52	115929	21
34	37	21	24266	22
92	130	24	162901	22
93	93	41	109825	21
54	118	33	129838	24
144	39	32	37510	21
109	81	31	87771	22
75	51	18	44418	19
50	28	23	192565	22
61	40	17	35232	23
55	56	20	40909	20
77	27	12	13294	20
72	83	30	140867	23
53	28	13	44332	20
42	59	22	61056	20
71	133	42	101338	23
10	12	1	1168	25
65	106	32	65567	21
66	44	25	32334	22
41	71	36	40735	21
86	116	31	91413	22
16	4	0	855	22
42	62	24	97068	23
19	12	13	44339	21
19	18	8	14116	21
45	14	13	10288	20
65	60	19	65622	19
95	98	33	76643	22
64	32	38	92696	21
38	25	24	94785	21
65	100	43	93815	21
52	46	43	86687	21
62	45	14	34553	21
65	129	41	105547	21
95	136	45	213688	22
29	59	31	71220	22
247	63	31	91721	22
29	14	30	111194	22
118	36	16	51009	18
110	113	37	135777	21
67	47	30	51513	23
42	92	35	74163	21
64	50	20	33416	19
81	41	18	83305	19
95	91	31	98952	23
67	111	31	102372	21
63	41	21	37238	21
83	120	39	103772	21
32	25	18	21399	21
83	131	39	130115	20
31	45	14	24874	19
67	29	7	34988	21
66	58	17	45549	22
70	47	30	64466	21
103	109	37	54990	25
34	37	32	34777	23
40	15	17	27114	19
31	7	24	37636	19
42	54	22	65461	19
46	54	12	30080	19
33	14	19	24094	19
18	16	13	69008	20
35	32	15	46090	19
66	38	15	34029	19
60	22	17	46300	19
54	32	16	40662	19
53	32	18	28987	19
39	37	17	30594	20
45	32	16	27913	19
36	0	23	42744	19
28	5	22	12934	18
30	10	13	41385	19
22	27	16	18653	19
31	29	20	30976	21
55	25	22	63339	18
54	55	17	25568	18
14	5	17	4154	21
81	43	12	19474	20
43	34	17	39067	19
30	35	23	65892	21
23	0	17	4143	21
38	37	14	28579	20
53	26	21	38084	24
45	38	18	27717	22
39	23	18	32928	21
24	30	17	19499	21
35	18	15	36874	19
151	28	21	48259	18
30	21	14	28207	19
57	50	15	45833	19
40	12	15	29156	19
77	27	22	45588	20
35	41	21	45097	18
63	12	18	28394	19
44	21	17	18632	19
19	8	4	2325	20
13	26	10	25139	20
42	27	16	27975	21
42	37	18	21792	20
49	29	12	26263	21
30	32	16	23686	18
49	35	21	49303	19
12	10	2	5752	19
20	17	17	20055	19
27	10	16	20154	19
14	17	16	19540	19

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'George Udny Yule' @ yule.wessa.net
R Framework error message
The field 'Names of X columns' contains a hard return which cannot be interpreted.
Please, resubmit your request without hard returns in the 'Names of X columns'.

\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 & 'George Udny Yule' @ yule.wessa.net \tabularnewline
R Framework error message & 
The field 'Names of X columns' contains a hard return which cannot be interpreted.
Please, resubmit your request without hard returns in the 'Names of X columns'.
 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=154930&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]'George Udny Yule' @ yule.wessa.net[/C][/ROW]
[ROW][C]R Framework error message[/C][C]
The field 'Names of X columns' contains a hard return which cannot be interpreted.
Please, resubmit your request without hard returns in the 'Names of X columns'.
[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=154930&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=154930&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'George Udny Yule' @ yule.wessa.net
R Framework error message
The field 'Names of X columns' contains a hard return which cannot be interpreted.
Please, resubmit your request without hard returns in the 'Names of X columns'.






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C11170
C2540

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

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


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