Repository of Reproducible Computations

Free Statistics

of Irreproducible Research!

Author's title

Author

*The author of this computation has been verified*

R Software Module

rwasp_regression_trees1.wasp

Title produced by software

Recursive Partitioning (Regression Trees)

Date of computation

Mon, 10 Dec 2012 09:14:55 -0500

Cite this page as follows

Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?v=date/2012/Dec/10/t1355148908inw01s62639vfiy.htm/, Retrieved Thu, 25 Apr 2024 13:26:56 +0000

Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=198159, Retrieved Thu, 25 Apr 2024 13:26:56 +0000

QR Codes:

Paste this QR Code to cite your computation.

Original text written by user:

IsPrivate?

No (this computation is public)

User-defined keywords

Estimated Impact

109

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)] [WS 10] [2012-12-06 13:30:23] [64c86865dff7d646747b84f713e71815]
-   P     [Recursive Partitioning (Regression Trees)] [WS 10] [2012-12-06 13:36:03] [64c86865dff7d646747b84f713e71815]
-   PD        [Recursive Partitioning (Regression Trees)] [] [2012-12-10 14:14:55] [adc16c0a0ff821bb11848bb68604cf2f] [Current]

Feedback Forum

Post a new message

Dataseries X:

Download CSV

Histogram

Boxplots

��1	6200	133	39	143	417	�4	120	186
��2	7321	153	38	�90	140	�8	�45	133
��3	5926	144	44	145	�80	�3	�43	127
��4	4643	�87	45	135	126	�4	�41	121
��5	3247	136	38	140	�93	�3	�42	108
��6	5108	166	53	167	158	�3	�46	104
��7	4446	118	50	187	�79	�3	�35	�93
��8	3643	�89	40	104	�94	�4	�47	�90
��9	2941	�90	38	130	�84	�4	�30	�85
�10	3279	110	36	�97	111	�3	�39	�85
�11	3172	137	36	124	109	�3	�45	�80
�12	3026	�61	33	111	119	�5	�36	�78
�13	2476	�98	40	144	�93	�2	�42	�78
�14	3145	126	47	127	�87	�3	�33	�73
�15	3107	107	45	170	125	�4	�31	�73
�16	3329	�61	39	�98	�86	�3	�34	�72
�17	3040	131	41	127	136	�5	�27	�72
�18	3307	114	36	122	�83	�4	�30	�72
�19	3177	132	40	127	�80	�3	�35	�70
�20	2638	114	45	133	184	�6	�39	�68
�21	2136	�82	50	158	�68	�3	�29	�67
�22	2854	101	42	135	111	�4	�33	�66
�23	2180	150	39	133	101	�3	�32	�64
�24	2481	108	44	�96	�62	�4	�28	�63
�25	1768	�80	36	126	�43	�5	�19	�62
�26	2153	�91	46	135	111	�6	�29	�60
�27	2633	104	36	137	�93	�3	�23	�60
�28	2132	�81	39	107	�70	�3	�24	�60
�29	2543	�84	32	115	�84	�4	�32	�59
�30	2379	�48	38	102	�33	�3	�22	�59
�31	1899	102	40	135	�68	�4	�22	�59
�32	1673	100	45	147	103	�3	�31	�59
�33	1907	112	45	143	�91	�3	�22	�58
�34	1837	�77	39	�94	�85	�5	�21	�56
�35	1988	�86	26	�68	�74	�3	�29	�54
�36	2163	�59	38	�93	�51	�4	�25	�53
�37	2242	�94	40	125	�82	�3	�20	�53
�38	2354	�94	38	�87	155	�6	�33	�53
�39	2721	�95	37	125	�86	�4	�20	�53
�40	1593	�86	42	129	�80	�2	�33	�52
*�41	1685	�52	36	110	�69	�5	�21	�51
�42	1840	�68	34	�93	�47	�3	�20	�51
�43	2007	104	41	135	�98	�6	�28	�50
�44	2147	100	31	�72	�52	�5	�16	�50
�45	1703	�87	38	�39	�50	�3	�23	�50
�46	1597	�28	37	�78	�40	�4	�18	�49
�47	1982	�63	37	119	�78	�4	�18	�49
�48	3238	�57	38	136	103	�6	�19	�49
�49	1624	�73	36	108	132	�4	�27	�49
�50	1430	�77	36	126	�63	�3	�22	�49
�51	1697	�95	34	�96	�54	�4	�17	�48
�52	1820	�86	32	102	�60	�4	�25	�48
�53	2216	�80	42	103	�45	�3	�26	�48
�54	1446	�74	34	�73	�61	�4	�24	�48
�55	1713	100	36	137	155	�4	�41	�48
�56	1648	�86	41	111	�58	�3	�15	�47
�57	1874	�26	40	�86	�69	�5	�20	�47
�58	1392	�78	28	�85	103	�3	�29	�47
�59	1775	�70	54	164	�77	�6	�11	�46
�60	1381	�46	34	�69	�79	�4	�14	�46
�61	1624	�70	33	�56	�73	�5	�20	�45
�62	2464	�76	32	112	�47	�4	�15	�45
�63	1590	�54	38	�87	�37	�3	�11	�44
�64	1566	�87	31	100	125	�5	�37	�43
�65	2504	�78	29	�95	�65	�5	�21	�43
�66	1411	�54	33	118	�52	�3	�19	�42
�67	1817	�81	31	101	�45	�6	�10	�41
�68	1436	�61	33	�98	�45	�5	�20	�41
�69	1885	�56	36	125	�60	10	�10	�41
�70	1530	�77	36	135	�75	�6	�18	�40
�71	2092	�96	43	159	�79	�3	�17	�40
�72	2267	�90	38	139	�94	�3	�21	�40
�73	2676	�37	35	�97	�81	14	�11	�40
�74	1214	�69	38	123	�67	�4	�21	�40
�75	1590	�82	39	101	�78	�4	�19	�40
�76	1607	�25	32	�58	�66	17	��8	�40
�77	1497	�54	34	�90	�60	�3	�23	�39
�78	1845	�52	30	�75	�53	�5	�14	�39
�79	1412	�67	29	�45	�47	�3	�22	�39
�80	1425	�77	39	139	109	�7	�21	�39
�81	1854	�91	33	�59	�61	�4	�21	�38
�82	1486	�18	39	�35	�65	22	�12	�38
�83	1779	�29	35	127	�92	�6	�11	�37
�84	3048	105	37	138	122	15	�17	�36
�85	1401	�57	18	�59	�32	�4	�13	�36
�86	2621	�82	37	141	�73	�4	�21	�36
�87	1935	�77	39	131	102	�9	�16	�36
�88	1405	��9	43	137	198	40	��7	�36
�89	1346	�95	36	�80	�65	�4	�20	�36
�90	1436	�64	35	119	�37	�4	�12	�35
�91	�933	�64	32	122	�89	�3	�25	�34
�92	1391	�67	35	103	�85	�3	�23	�34
�93	1974	�34	20	�48	�39	�6	�12	�34
�94	1451	�81	41	144	�44	�4	�11	�33
�95	1203	�41	26	�38	�46	�3	�30	�32
�96	1224	�73	30	120	�34	�4	�12	�32
�97	1298	�86	36	�75	�73	�3	�21	�32
�98	1745	�25	24	�82	�62	�9	��9	�32
�99	1290	�36	41	�93	�73	12	��7	�32
100	1793	103	33	107	�55	�7	�12	�31
101	�962	�48	19	�29	�69	�4	�21	�31
102	1021	�52	25	�59	�69	�4	�20	�30
103	1085	�44	35	�71	�50	�3	�10	�30
104	1544	�87	34	�97	�57	�3	�16	�29
105	1414	�96	30	�68	�46	�3	�15	�28
106	1209	�57	21	�73	�26	�3	�11	�28
107	1400	��2	35	�81	121	61	��7	�28
108	1655	�85	33	114	�58	�4	�16	�28
109	1132	�38	32	113	122	�9	��8	�27
110	1455	�27	35	�98	�60	12	�11	�27
111	1351	�68	33	105	�85	�6	�12	�27
112	1961	�85	32	�72	�45	�5	�15	�27
113	1247	�13	32	�77	102	51	��9	�27
114	1098	�43	31	�51	�37	�3	�12	�27
115	1387	�45	33	�82	�48	�3	�12	�27
116	1203	�55	34	�73	�71	�6	�11	�26
117	1071	�10	32	�97	�38	10	��5	�26
118	1445	�52	34	�94	�63	11	��9	�26
119	2065	�29	10	�14	�80	11	�12	�25
120	1383	��3	35	�92	�53	27	�10	�25
121	1337	�37	30	�55	�62	�8	��8	�25
122	�748	�29	16	�46	�22	�3	�14	�24
123	2122	�69	36	�31	�66	11	��9	�24
124	�928	�27	14	��8	�16	�8	�10	�24
125	�980	�39	32	109	�66	�9	��9	�24
126	1050	�42	22	�67	�66	�8	��9	�24
127	1318	�62	32	�54	�50	�5	�15	�24
128	1013	�27	36	120	�22	�4	�10	�24
129	1870	�52	29	�27	�61	�4	�14	�24
130	�836	�40	22	168	�31	�3	�12	�23
131	1218	�43	31	�49	�41	10	��5	�23
132	�990	�38	42	113	�48	�6	��8	�22
133	1113	�60	40	�32	�57	�5	�18	�22
134	1370	�18	37	�70	�65	11	��9	�19
135	�976	�35	46	�89	�34	�4	�12	�19
136	�975	�24	33	�34	�50	�8	��7	�18
137	1228	�46	12	�44	�22	�4	��7	�18
138	1656	�34	17	�35	�15	�5	��6	�18
139	�782	�59	11	�25	�47	�5	�10	�17
140	�749	�26	�8	�12	��0	0	��0	�17
141	�769	��2	�3	��0	��0	0	��1	�17
142	�729	�33	32	�75	�71	�6	��7	�16
143	�951	�29	38	118	134	11	�10	�16
144	�567	�24	�1	��2	�91	�8	�16	�15
145	�945	�23	36	110	124	25	��5	�15
146	1154	�16	28	�56	�53	27	��6	�15
147	�665	�52	22	�54	�39	�3	��8	�14
148	�585	�48	10	�11	�46	�5	�11	�14
149	�480	�28	�8	�16	�37	�3	�25	�13
150	�442	�19	10	��9	�11	�4	��6	�12
151	�692	��9	33	�28	�35	35	��3	�11
152	�595	�14	12	�14	�18	�9	��4	�10
153	�635	��9	21	�40	�30	10	��4	�10
154	�379	��8	�6	��0	��8	�3	��7	�10
155	�393	�22	�3	��9	��7	�4	��5	�10
156	�776	�13	29	�54	�76	76	��1	�10
157	�805	�31	29	�78	�55	28	��8	�10
158	�547	�18	17	�50	�62	21	��3	��9
159	�206	��6	�0	��0	��0	0	��0	��6
160	�158	��3	�0	��0	��2	0	��2	��4
161	�387	�11	19	��1	��9	�5	��2	��4
162	��44	��0	�0	��0	��0	0	��0	��2
163	��67	��0	�0	��0	��0	0	��0	��1
164	�166	��0	�8	�19	��0	0	��0	��1
165	��40	��0	�0	��0	��0	0	��0	��1
166	���6	��0	�0	��0	��0	0	��0	��0
167	��37	��0	�0	��0	��0	0	��0	��0
168	��20	��0	�0	��0	��0	0	��0	��0

Summary of computational transaction
Raw Input	view raw input (R code)
Raw Output	view raw output of R engine
Computing time	0 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 & 0 seconds \tabularnewline
R Server & 'Gertrude Mary Cox' @ cox.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=198159&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]0 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=198159&T=0

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

As an alternative you can also use a QR Code:

The GUIDs for individual cells are displayed in the table below:

Summary of computational transaction
Raw Input	view raw input (R code)
Raw Output	view raw output of R engine
Computing time	0 seconds
R Server	'Gertrude Mary Cox' @ cox.wessa.net

Parameters (Session):

par1 = 7 ; par2 = none ; par4 = no ;

Parameters (R input):

par1 = 7 ; par2 = none ; par3 = ; 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')
}

Free Statistics

Description of Statistical Computation

Tree of Dependent Computations

Dataset

Tables (Output of Computation)

Figures (Output of Computation)

Input Parameters & R Code