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 computationThu, 22 Dec 2011 10:06: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/22/t13245664196nklnjo87ns8vl1.htm/, Retrieved Fri, 03 May 2024 11:51:53 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=159560, Retrieved Fri, 03 May 2024 11:51:53 +0000
QR Codes:

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

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)] [1] [2011-12-14 12:59:49] [6bdab4f5b22620afa7d9dc512ad4e377]
- R PD      [Recursive Partitioning (Regression Trees)] [recursive 3] [2011-12-22 15:06:38] [5363b79245edacd2d961915f77b3b63a] [Current]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
1826	161442	592	48	93
1728	189695	524	53	60
192	7215	72	0	18
2295	129098	645	51	95
3509	245678	1185	79	137
6861	515038	1945	136	263
1801	183078	585	62	57
1681	185559	470	83	59
1897	154581	612	55	44
2974	298001	992	67	96
1946	121844	634	50	75
2363	203796	741	88	71
1850	104738	674	47	101
3189	220490	1081	79	120
1486	170952	419	56	61
1567	154647	469	54	88
1759	142025	432	81	58
1247	79030	361	6	61
2779	167047	877	74	87
727	27997	221	13	25
1117	84588	377	31	61
2809	241227	847	99	101
1760	195820	642	38	72
2279	142530	693	59	56
1937	157178	611	54	87
1800	204256	654	63	33
2146	212298	690	66	166
1453	201403	365	90	95
2741	354924	907	60	118
2112	192399	882	52	44
1684	182286	490	61	44
1617	181590	548	60	46
2233	134868	726	53	106
3122	235002	935	76	125
2511	228872	824	70	54
1	0	0	0	1
2137	230360	997	54	64
1669	100129	539	44	51
2137	145864	515	42	49
2176	252386	806	83	67
2390	242379	753	105	71
1783	156399	665	42	60
1049	103623	387	25	33
2161	195891	804	64	78
1364	139654	419	71	51
1228	167934	330	44	96
745	81293	212	23	32
2410	246211	783	78	104
2289	233155	740	59	89
2639	160344	938	68	59
658	48188	205	12	28
1917	161922	492	99	69
2583	311044	824	80	75
2026	235223	680	56	79
1911	195583	691	67	59
1751	155574	540	44	57
1852	208834	487	53	67
1044	101687	328	26	25
1177	151985	421	67	66
2878	201027	965	36	99
1830	172600	538	56	63
2191	144556	811	51	82
1331	129561	362	46	61
1307	122204	460	57	38
1256	160930	416	27	35
1378	109798	437	45	42
2311	192811	499	72	71
2897	138708	887	93	65
1103	114408	267	59	38
340	31970	101	5	15
2900	245432	1058	56	113
1367	142907	426	40	74
1441	113612	480	72	68
1681	119537	474	53	72
2655	162215	673	81	68
1499	100098	413	27	44
2302	174768	677	94	60
2540	158459	820	71	97
1053	90743	330	25	33
1234	84971	395	34	71
927	80545	217	54	68
2176	287191	818	49	64
984	67006	301	26	29
1551	134091	513	48	40
1204	95803	392	54	47
1858	173833	572	38	58
2716	241469	669	63	237
1207	115367	284	58	114
1392	115603	443	44	63
1525	155537	614	45	53
1829	153133	672	49	41
2383	179228	701	75	82
1233	151517	415	39	57
1366	133686	505	28	59
953	61350	388	24	41
2319	245196	730	52	117
1857	195576	563	96	70
223	19349	67	13	12
2505	245422	869	43	108
2055	157961	849	42	83
747	66802	292	28	30
1062	91762	338	54	24
1422	151077	435	73	57
1319	136847	334	39	64
823	85338	223	36	40
596	27676	194	2	22
1644	162934	407	96	49
1130	122417	268	29	37
0	0	0	0	0
1082	91529	332	46	32
1135	107205	371	25	67
1367	144664	465	51	45
1506	146445	447	60	63
910	84940	301	36	61
78	3616	14	0	5
0	0	0	0	0
1130	183088	388	40	44
1635	153780	589	74	90
2122	176586	591	30	101
970	128944	299	41	39
778	43410	292	7	19
1752	175774	530	70	73
1050	108656	297	32	43
2180	140243	614	81	56
731	60493	174	3	40
285	19764	75	10	12
1834	164062	565	46	56
1167	138469	382	35	34
1646	155367	544	54	54
256	11796	79	1	9
98	10674	33	0	9
1409	144927	480	39	58
41	6836	11	0	3
1824	162563	626	48	63
42	5118	6	5	3
528	40248	183	8	16
0	0	0	0	0
1114	127476	342	38	50
1305	88837	269	21	38
81	7131	27	0	4
261	9056	99	0	14
1062	87305	291	18	26
1279	142829	324	53	53
1148	100681	414	17	20

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

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






10-Fold Cross Validation
Prediction (training)Prediction (testing)
ActualC1C2CVC1C2CV
C14761660.741459190.7564
C2435990.9336720.9231
Overall--0.8372--0.8397

\begin{tabular}{lllllllll}
\hline
10-Fold Cross Validation \tabularnewline
 & Prediction (training) & Prediction (testing) \tabularnewline
Actual & C1 & C2 & CV & C1 & C2 & CV \tabularnewline
C1 & 476 & 166 & 0.7414 & 59 & 19 & 0.7564 \tabularnewline
C2 & 43 & 599 & 0.933 & 6 & 72 & 0.9231 \tabularnewline
Overall & - & - & 0.8372 & - & - & 0.8397 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=159560&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]476[/C][C]166[/C][C]0.7414[/C][C]59[/C][C]19[/C][C]0.7564[/C][/ROW]
[ROW][C]C2[/C][C]43[/C][C]599[/C][C]0.933[/C][C]6[/C][C]72[/C][C]0.9231[/C][/ROW]
[ROW][C]Overall[/C][C]-[/C][C]-[/C][C]0.8372[/C][C]-[/C][C]-[/C][C]0.8397[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=159560&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=159560&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
C14761660.741459190.7564
C2435990.9336720.9231
Overall--0.8372--0.8397






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C15220
C2468

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

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


Figures (Output of Computation)

Input Parameters & R Code

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