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 computationTue, 13 Dec 2011 19:35:12 -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/13/t132382292620ktzcsamnb5u3j.htm/, Retrieved Thu, 02 May 2024 17:44:21 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=154786, Retrieved Thu, 02 May 2024 17:44:21 +0000
QR Codes:

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

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)] [] [2011-12-13 16:53:18] [a1957df0bc37aec4aa3c994e6a08412c]
-   PD    [Recursive Partitioning (Regression Trees)] [] [2011-12-13 22:12:59] [a1957df0bc37aec4aa3c994e6a08412c]
-   PD        [Recursive Partitioning (Regression Trees)] [] [2011-12-14 00:35:12] [fdaf10f0fcbe7b8f79ecbd42ec74e6ad] [Current]
-   P           [Recursive Partitioning (Regression Trees)] [] [2011-12-14 00:44:01] [a1957df0bc37aec4aa3c994e6a08412c]
-   P             [Recursive Partitioning (Regression Trees)] [] [2011-12-14 00:54:43] [a1957df0bc37aec4aa3c994e6a08412c]
Feedback Forum

Post a new message

Dataset

Dataseries X:
Download CSV
Histogram
Boxplots 
2981.85	2819.19	11394.84	10539.51	10407	44.23
3080.58	2892.56	11545.71	10723.78	10463	45.85
3106.22	2866.08	11809.38	10682.06	10556	53.38
3119.31	2817.41	11395.64	10283.19	10646	53.26
3061.26	2934.75	11082.38	10377.18	10702	51.8
3097.31	3036.54	11402.75	10486.64	11353	55.3
3161.69	3139.5	11716.87	10545.38	11346	57.81
3257.16	3114.31	12204.98	10554.27	11451	63.96
3277.01	3261.3	12986.62	10532.54	11964	63.77
3295.32	3201.79	13392.79	10324.31	12574	59.15
3363.99	3264.53	14368.05	10695.25	13031	56.12
3494.17	3349.1	15650.83	10827.81	13812	57.42
3667.03	3446.17	16102.64	10872.48	14544	63.52
3813.06	3469.48	16187.64	10971.19	14931	61.71
3917.96	3507.13	16311.54	11145.65	14886	63.01
3895.51	3536.2	17232.97	11234.68	16005	68.18
3801.06	3359.05	16397.83	11333.88	17064	72.03
3570.12	3378.85	14990.31	10997.97	15168	69.75
3701.61	3449.15	15147.55	11036.89	16050	74.41
3862.27	3522.89	15786.78	11257.35	15839	74.33
3970.1	3551.04	15934.09	11533.59	15137	64.24
4138.52	3669.15	16519.44	11963.12	14954	60.03
4199.75	3602	16101.07	12185.15	15648	59.44
4290.89	3697.22	16775.08	12377.62	15305	62.5
4443.91	3760.9	17286.32	12512.89	15579	55.04
4502.64	3665.08	17741.23	12631.48	16348	58.34
4356.98	3708.8	17128.37	12268.53	15928	61.92
4591.27	3858.21	17460.53	12754.8	16171	67.65
4696.96	3933.16	17611.14	13407.75	15937	67.68
4621.4	3946.98	18001.37	13480.21	15713	70.3
4562.84	3794.29	17974.77	13673.28	15594	75.26
4202.52	3765.56	16460.95	13239.71	15683	71.44
4296.49	3820.33	16235.39	13557.69	16438	76.36
4435.23	3885.12	16903.36	13901.28	17032	81.71
4105.18	3752.67	15543.76	13200.58	17696	92.6
4116.68	3683.79	15532.18	13406.97	17745	90.6
3844.49	3240.75	13731.31	12538.12	19394	92.23
3720.98	3188.82	13547.84	12419.57	20148	94.09
3674.4	3017.98	12602.93	12193.88	20108	102.79
3857.62	3237.2	13357.7	12656.63	18584	109.65
3801.06	3182.53	13995.33	12812.48	18441	124.05
3504.37	2906.42	14084.6	12056.67	18391	132.69
3032.6	2881.35	13168.91	11322.38	19178	135.81
3047.03	2915.64	12989.35	11530.75	18079	116.07
2962.34	2635.13	12123.53	11114.08	18483	101.42
2197.82	2331.43	9117.03	9181.73	19644	75.73
2014.45	2159.04	8531.45	8614.55	19195	55.48
1862.83	NA	8460.94	8595.56	19650	43.8
1905.41	1983.48	8331.49	8396.2	20830	45.29
1810.99	1770.41	7694.78	7690.5	23595	44.01
1670.07	1815.99	7764.58	7235.47	22937	47.48
1864.44	2026.97	8767.96	7992.12	21814	51.07
2052.02	2124.81	9304.43	8398.37	21928	57.84
2029.6	2098.28	9810.31	8593	21777	69.04
2070.83	2291.39	9691.12	8679.75	21383	65.61
2293.41	2401.57	10430.35	9374.63	21467	72.87
2443.27	2453.89	10302.87	9634.97	22052	68.41
2513.17	2409.53	10066.24	9857.34	22680	73.25
2466.92	2432.45	9633.83	10238.83	24320	77.43
2502.66	2585.34	10169.02	10433.44	24977	75.28
2539.91	2478.51	10661.62	10471.24	25204	77.33
2482.6	2470.18	10175.13	10214.51	25739	74.31
2626.15	2629.16	10671.49	10677.52	26434	79.7
2656.32	2541.22	11139.77	11052.15	27525	85.47
2446.66	2397.18	10103.98	10500.19	30695	77.98
2467.38	2359.66	9786.05	10159.27	32436	75.69
2462.32	2476.2	9456.84	10222.24	30160	75.2
2504.58	2449.57	9268.24	10350.4	30236	77.21
2579.39	2482.18	9346.72	10598.07	31293	77.85
2649.24	2542.76	9455.09	11044.49	31077	83.53
2636.87	2477.63	9797.18	11198.31	32226	85.99
2613.94	2586.46	10254.46	11465.26	33865	91.77
2634.01	2654.47	10449.53	11802.37	32810	96.59
2711.94	2713.48	10622.27	12190	32242	103.57
2646.43	2582.9	9852.45	12081.48	32700	114.46
2717.79	2661.37	9644.62	12434.93	32819	122.54
2701.54	2631.87	9650.78	12579.99	33947	115.08
2572.98	2561.37	9541.53	12097.31	34148	113.93
2488.92	2510.85	9996.68	12512.33	35261	116.29
2204.91	2238.24	9072.94	11326.62	39506	110.12
2123.99	2159.7	8695.42	11175.45	41591	110.86
2149.1	2318	8733.56	11515.93	39148	108.53

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

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






Confusion Matrix (predicted in columns / actuals in rows)
C1C2
C1452
C2035

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

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


Figures (Output of Computation)

Input Parameters & R Code

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