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 computationSat, 17 Dec 2011 10:21:03 -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/t13241352972vy87c6c1kxe25l.htm/, Retrieved Wed, 24 Apr 2024 04:02:54 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=156386, Retrieved Wed, 24 Apr 2024 04:02:54 +0000
QR Codes:

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

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 20:06:20] [b98453cac15ba1066b407e146608df68]
- R PD  [Recursive Partitioning (Regression Trees)] [] [2011-12-17 14:36:40] [8fcdd1f5b88bf5ac5d2a0b8a91219b89]
-    D    [Recursive Partitioning (Regression Trees)] [] [2011-12-17 14:38:48] [8fcdd1f5b88bf5ac5d2a0b8a91219b89]
-   P         [Recursive Partitioning (Regression Trees)] [] [2011-12-17 15:21:03] [888ed98a09d01be7e0be9dfdea403736] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
17140	101645	88	20	11
27570	101011	41	30	13
1423	7176	1	0	0
22996	96560	129	42	17
39992	175824	107	57	20
117105	341570	190	94	21
23789	103597	66	27	16
26706	112611	36	46	20
24266	85574	71	37	21
44418	220801	105	51	18
35232	92661	133	40	17
40909	133328	79	56	20
13294	61361	51	27	12
32387	125930	207	37	17
21233	82316	34	27	10
44332	102010	66	28	13
61056	101523	76	59	22
13497	41566	42	0	9
32334	99923	115	44	25
44339	22648	44	12	13
10288	46698	35	14	13
65622	131698	74	60	19
16563	91735	103	7	18
29011	79863	134	29	22
34553	108043	29	45	14
23517	98866	140	25	13
51009	120445	72	36	16
33416	116048	45	50	20
83305	250047	58	41	18
27142	136084	69	27	13
21399	92499	57	25	18
24874	135781	98	45	14
34988	74408	61	29	7
45549	81240	89	58	17
32755	133368	54	37	16
20760	79619	123	42	11
37636	59194	247	7	24
65461	139942	46	54	22
30080	118612	72	54	12
24094	72880	41	14	19
69008	65475	24	16	13
54968	99643	45	33	17
46090	71965	33	32	15
27507	77272	27	21	16
10672	49289	36	15	24
34029	135131	87	38	15
46300	108446	90	22	17
24760	89746	114	28	18
18779	44296	31	10	20
21280	77648	45	31	16
40662	181528	69	32	16
28987	134019	51	32	18
22827	124064	34	43	22
18513	92630	60	27	8
30594	121848	45	37	17
24006	52915	54	20	18
27913	81872	25	32	16
42744	58981	38	0	23
12934	53515	52	5	22
22574	60812	67	26	13
41385	56375	74	10	13
18653	65490	38	27	16
18472	80949	30	11	16
30976	76302	26	29	20
63339	104011	67	25	22
25568	98104	132	55	17
33747	67989	42	23	18
4154	30989	35	5	17
19474	135458	118	43	12
35130	73504	68	23	7
39067	63123	43	34	17
13310	61254	76	36	14
65892	74914	64	35	23
4143	31774	48	0	17
28579	81437	64	37	14
51776	87186	56	28	15
21152	50090	71	16	17
38084	65745	75	26	21
27717	56653	39	38	18
32928	158399	42	23	18
11342	46455	39	22	17
19499	73624	93	30	17
16380	38395	38	16	16
36874	91899	60	18	15
48259	139526	71	28	21
16734	52164	52	32	16
28207	51567	27	21	14
30143	70551	59	23	15
41369	84856	40	29	17
45833	102538	79	50	15
29156	86678	44	12	15
35944	85709	65	21	10
36278	34662	10	18	6
45588	150580	124	27	22
45097	99611	81	41	21
3895	19349	15	13	1
28394	99373	92	12	18
18632	86230	42	21	17
2325	30837	10	8	4
25139	31706	24	26	10
27975	89806	64	27	16
14483	62088	45	13	16
13127	40151	22	16	9
5839	27634	56	2	16
24069	76990	94	42	17
3738	37460	19	5	7
18625	54157	35	37	15
36341	49862	32	17	14
24548	84337	35	38	14
21792	64175	48	37	18
26263	59382	49	29	12
23686	119308	48	32	16
49303	76702	62	35	21
25659	103425	96	17	19
28904	70344	45	20	16
2781	43410	63	7	1
29236	104838	71	46	16
19546	62215	26	24	10
22818	69304	48	40	19
32689	53117	29	3	12
5752	19764	19	10	2
22197	86680	45	37	14
20055	84105	45	17	17
25272	77945	67	28	19
82206	89113	30	19	14
32073	91005	36	29	11
5444	40248	34	8	4
20154	64187	36	10	16
36944	50857	34	15	20
8019	56613	37	15	12
30884	62792	46	28	15
19540	72535	44	17	16
27114	98146	37	15	17

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

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

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

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


Figures (Output of Computation)

Input Parameters & R Code

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