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

Sun, 12 Dec 2010 19:31:48 +0000

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/2010/Dec/12/t129218220683rs8k0xe58ngha.htm/, Retrieved Tue, 07 May 2024 13:21:15 +0000

Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=108636, Retrieved Tue, 07 May 2024 13:21:15 +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

122

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]
-   PD  [Recursive Partitioning (Regression Trees)] [Popularity Tree n...] [2010-12-12 19:14:56] [6bc4f9343b7ea3ef5a59412d1f72bb2b]
-           [Recursive Partitioning (Regression Trees)] [Popularity Tree c...] [2010-12-12 19:31:48] [b6992a7b26e556359948e164e4227eba] [Current]

Feedback Forum

Post a new message

Dataseries X:

Download CSV

Histogram

Boxplots

15	10	77	46	15	12	13	6	11	6	4	15	16	0
9	20	63	37	12	7	11	4	26	5	4	23	24	1
12	16	73	45	15	13	14	6	26	20	10	26	22	1
15	10	76	46	12	11	12	5	15	12	6	19	21	1
17	8	90	55	14	16	12	5	10	11	5	19	23	1
14	14	67	40	8	10	6	4	21	12	8	16	23	1
9	19	69	43	11	15	10	5	27	11	9	23	21	0
11	23	54	33	4	4	10	2	21	13	8	19	22	1
13	9	54	33	13	7	12	5	21	9	11	24	20	1
16	12	76	47	19	15	15	6	22	14	6	19	12	0
16	14	75	44	10	5	13	6	29	12	8	25	23	0
15	13	76	47	15	16	18	8	29	18	11	23	23	0
10	11	80	49	6	15	11	6	29	9	5	31	30	1
16	11	89	55	7	13	12	3	30	15	10	29	22	0
12	10	73	43	14	13	13	6	19	12	7	18	21	1
15	12	74	46	16	15	14	6	19	12	7	17	21	1
13	18	78	51	16	15	16	7	22	12	13	22	15	0
18	12	76	47	14	10	16	8	18	15	10	21	22	0
13	10	69	42	15	17	16	6	28	11	8	24	24	1
17	15	74	42	14	14	15	7	17	13	6	22	23	0
14	15	82	48	12	9	13	4	18	10	8	16	15	0
13	12	77	45	9	6	8	4	20	17	7	22	24	1
13	9	84	51	12	11	14	2	16	13	5	21	24	0
15	11	75	46	14	13	15	6	17	17	9	25	21	0
15	16	79	47	14	10	16	6	25	15	11	22	21	0
13	17	79	47	10	4	13	6	22	13	11	24	18	0
13	11	88	55	16	15	15	7	31	17	9	25	19	0
16	13	57	36	10	8	11	4	38	21	7	29	29	0
14	9	69	42	8	10	14	3	18	12	6	19	20	0
18	11	86	51	12	8	13	5	20	15	6	25	24	0
9	20	66	40	8	9	12	4	23	8	5	19	27	1
16	8	54	33	13	14	14	6	12	15	4	27	28	1
16	12	85	52	11	5	13	3	20	16	10	25	24	0
17	10	79	49	12	7	12	3	15	9	8	23	29	1
13	11	84	50	16	16	14	6	21	13	6	24	24	1
17	13	70	43	16	14	15	6	20	11	4	25	25	0
15	13	54	33	13	16	16	6	30	9	9	23	14	0
14	13	70	44	14	15	15	8	22	15	10	22	22	0
10	15	54	33	5	4	5	2	33	9	6	32	24	1
13	12	69	41	14	12	15	6	25	15	9	22	24	1
11	13	68	40	13	8	8	4	20	14	10	18	24	0
11	14	66	42	15	12	16	6	21	14	13	19	21	0
15	9	67	42	11	12	14	5	16	12	8	16	21	0
15	9	71	45	15	13	13	6	23	15	10	23	21	0
12	15	54	33	16	14	14	6	25	11	5	17	15	0
17	10	76	46	13	14	14	5	18	11	8	17	26	0
15	13	77	47	11	15	12	6	33	9	6	28	22	1
16	8	71	44	12	14	13	7	18	8	9	24	24	1
14	15	69	44	12	11	15	5	18	13	9	21	13	0
17	13	73	46	10	13	15	6	13	12	7	14	19	0
10	24	46	30	8	4	13	6	24	24	20	21	10	0
11	11	66	42	9	8	10	4	19	11	8	20	28	1
15	13	77	46	12	13	13	5	20	11	8	25	25	0
15	12	77	46	14	15	14	6	21	16	7	20	24	1
7	22	70	43	12	15	13	6	18	12	7	17	22	0
17	11	86	52	11	8	13	4	29	18	10	26	30	1
14	15	38	11	14	17	18	6	13	12	5	17	22	1
18	7	66	41	7	12	12	4	26	14	8	17	24	1
14	14	75	45	16	13	14	7	22	16	9	24	23	1
14	10	64	41	11	7	13	6	28	24	20	30	20	1
9	9	80	47	16	16	16	6	28	13	6	25	22	0
14	12	86	53	13	11	15	6	23	11	10	15	22	0
11	16	54	35	11	10	14	5	22	14	11	25	19	0
16	13	74	45	13	14	13	6	28	12	7	20	22	0
17	11	88	54	14	19	12	6	31	21	12	32	26	0
12	11	63	36	10	8	9	5	15	11	8	14	12	1
15	13	81	48	15	15	15	8	15	6	6	20	25	0
15	10	74	45	11	8	12	6	22	14	9	25	23	0
16	11	80	47	6	6	11	2	17	16	5	25	23	0
16	9	80	49	11	7	13	2	25	18	11	35	17	0
11	13	60	38	12	16	13	4	32	9	6	29	26	1
12	14	62	46	12	10	15	6	23	13	10	25	27	0
14	14	63	42	8	8	14	5	20	17	8	21	23	1
15	11	89	54	9	9	12	4	20	11	7	21	20	0
17	10	76	45	10	8	16	4	28	16	8	24	24	0
19	11	81	53	16	14	14	6	20	11	9	26	22	0
15	12	72	44	15	14	13	5	20	11	8	24	26	0
16	14	84	51	14	14	12	6	23	11	10	20	29	1
14	14	76	46	12	15	13	7	20	20	13	24	20	0
16	21	76	46	12	7	12	6	21	10	7	18	17	0
15	13	72	44	12	12	13	4	14	12	7	17	16	0
17	11	81	48	8	7	10	3	31	11	8	22	24	1
12	12	72	44	16	12	15	8	21	14	9	22	24	0
18	12	78	47	11	6	9	4	18	12	9	22	19	0
13	11	79	47	12	10	13	4	26	12	8	24	29	0
14	14	52	31	9	12	13	5	25	12	7	32	25	0
14	13	67	44	14	13	13	5	9	10	6	19	25	1
14	13	74	42	15	14	15	7	18	12	8	21	24	1
12	12	73	41	8	8	13	4	19	10	8	23	29	1
14	14	69	43	12	14	14	5	29	7	4	26	22	0
12	12	67	41	10	10	11	5	31	10	8	18	23	1
15	12	76	47	16	14	15	8	24	13	10	19	15	0
11	18	63	37	8	10	15	2	19	13	8	27	21	1
15	11	84	54	9	6	12	5	19	9	7	21	23	0
14	15	90	55	8	9	15	4	22	14	10	20	20	0
15	13	75	45	11	11	14	5	31	14	9	21	25	1
16	11	76	47	16	16	16	7	20	12	8	20	28	0
14	22	53	37	5	8	12	3	26	18	5	29	18	0
18	10	87	53	15	16	11	5	17	17	8	30	25	0
14	11	78	46	15	16	13	6	16	15	9	23	24	0
13	15	54	33	12	14	12	5	9	8	11	29	23	0
14	14	58	36	12	12	12	6	19	8	7	19	25	1
14	11	80	49	16	16	16	7	22	12	8	26	27	0
17	10	74	44	12	15	13	6	15	10	4	22	24	0
12	14	56	37	10	11	12	6	25	18	16	26	24	0
16	14	82	53	12	6	14	5	30	15	9	27	26	0
10	15	67	42	11	16	14	6	24	11	12	24	26	1
13	11	75	45	16	16	15	6	20	10	8	26	23	1
15	10	69	40	7	8	12	3	12	7	4	22	28	1
16	10	72	44	9	11	11	4	31	17	11	23	20	0
14	12	54	33	11	13	11	4	25	7	8	25	23	0
13	15	54	33	6	9	11	4	23	14	12	19	24	1
17	10	71	43	14	15	13	6	23	12	8	20	21	0
14	12	53	32	11	11	12	6	26	15	6	25	25	0
16	15	54	33	11	12	12	4	14	13	8	14	16	0
12	11	69	42	16	8	14	4	28	16	14	27	22	0
16	10	30	0	7	7	12	4	19	11	10	21	27	1
8	20	53	32	8	10	12	4	21	7	5	21	24	1
9	19	68	41	10	9	12	4	18	15	8	14	17	1
13	17	69	44	14	13	13	5	29	18	12	21	21	0
19	8	54	33	9	11	11	4	16	11	11	23	21	0
11	17	66	42	13	12	13	7	22	13	8	18	19	0
15	11	79	46	13	5	12	3	15	11	8	20	25	1
11	13	67	44	12	12	14	5	21	13	9	19	24	1
15	9	74	45	11	14	15	5	17	12	6	15	21	1
16	10	86	53	10	15	15	6	17	11	5	23	26	1
15	13	63	38	12	14	13	5	33	11	8	26	25	0
12	16	69	43	14	13	16	6	17	13	7	21	25	0
16	12	73	43	11	14	17	6	20	8	4	13	13	1
15	14	69	42	13	14	13	3	17	12	9	24	25	1
13	11	71	42	14	15	14	6	16	9	5	17	23	1
14	13	77	47	13	13	13	5	18	14	9	21	26	0
11	15	74	44	16	14	16	8	32	18	12	28	22	0
15	14	82	49	13	11	13	6	22	15	6	22	20	0
14	14	54	33	9	11	13	3	29	11	6	27	24	0
13	10	80	47	14	8	14	4	23	17	7	25	21	0
15	8	76	47	15	12	16	7	17	12	9	21	24	0

Summary of computational transaction
Raw Input	view raw input (R code)
Raw Output	view raw output of R engine
Computing time	9 seconds
R Server	'George Udny Yule' @ 72.249.76.132

\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 & 9 seconds \tabularnewline
R Server & 'George Udny Yule' @ 72.249.76.132 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=108636&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]9 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'George Udny Yule' @ 72.249.76.132[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=108636&T=0

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=108636&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	9 seconds
R Server	'George Udny Yule' @ 72.249.76.132

10-Fold Cross Validation
	Prediction (training)					Prediction (testing)
Actual	C1	C2	C3	C4	CV	C1	C2	C3	C4	CV
C1	284	20	11	29	0.8256	31	1	1	3	0.8611
C2	159	71	36	81	0.2046	22	12	4	15	0.2264
C3	48	31	43	148	0.1593	8	5	1	16	0.0333
C4	9	12	36	202	0.7799	1	0	8	22	0.7097
Overall	-	-	-	-	0.4918	-	-	-	-	0.44

\begin{tabular}{lllllllll}
\hline
10-Fold Cross Validation \tabularnewline
 & Prediction (training) & Prediction (testing) \tabularnewline
Actual & C1 & C2 & C3 & C4 & CV & C1 & C2 & C3 & C4 & CV \tabularnewline
C1 & 284 & 20 & 11 & 29 & 0.8256 & 31 & 1 & 1 & 3 & 0.8611 \tabularnewline
C2 & 159 & 71 & 36 & 81 & 0.2046 & 22 & 12 & 4 & 15 & 0.2264 \tabularnewline
C3 & 48 & 31 & 43 & 148 & 0.1593 & 8 & 5 & 1 & 16 & 0.0333 \tabularnewline
C4 & 9 & 12 & 36 & 202 & 0.7799 & 1 & 0 & 8 & 22 & 0.7097 \tabularnewline
Overall & - & - & - & - & 0.4918 & - & - & - & - & 0.44 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=108636&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]C3[/C][C]C4[/C][C]CV[/C][C]C1[/C][C]C2[/C][C]C3[/C][C]C4[/C][C]CV[/C][/ROW]
[ROW][C]C1[/C][C]284[/C][C]20[/C][C]11[/C][C]29[/C][C]0.8256[/C][C]31[/C][C]1[/C][C]1[/C][C]3[/C][C]0.8611[/C][/ROW]
[ROW][C]C2[/C][C]159[/C][C]71[/C][C]36[/C][C]81[/C][C]0.2046[/C][C]22[/C][C]12[/C][C]4[/C][C]15[/C][C]0.2264[/C][/ROW]
[ROW][C]C3[/C][C]48[/C][C]31[/C][C]43[/C][C]148[/C][C]0.1593[/C][C]8[/C][C]5[/C][C]1[/C][C]16[/C][C]0.0333[/C][/ROW]
[ROW][C]C4[/C][C]9[/C][C]12[/C][C]36[/C][C]202[/C][C]0.7799[/C][C]1[/C][C]0[/C][C]8[/C][C]22[/C][C]0.7097[/C][/ROW]
[ROW][C]Overall[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]0.4918[/C][C]-[/C][C]-[/C][C]-[/C][C]-[/C][C]0.44[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=108636&T=1

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

As an alternative you can also use a QR Code:

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

10-Fold Cross Validation
	Prediction (training)					Prediction (testing)
Actual	C1	C2	C3	C4	CV	C1	C2	C3	C4	CV
C1	284	20	11	29	0.8256	31	1	1	3	0.8611
C2	159	71	36	81	0.2046	22	12	4	15	0.2264
C3	48	31	43	148	0.1593	8	5	1	16	0.0333
C4	9	12	36	202	0.7799	1	0	8	22	0.7097
Overall	-	-	-	-	0.4918	-	-	-	-	0.44

Confusion Matrix (predicted in columns / actuals in rows)
	C1	C2	C3	C4
C1	32	2	0	4
C2	18	12	0	10
C3	5	5	0	20
C4	1	2	0	26

\begin{tabular}{lllllllll}
\hline
Confusion Matrix (predicted in columns / actuals in rows) \tabularnewline
 & C1 & C2 & C3 & C4 \tabularnewline
C1 & 32 & 2 & 0 & 4 \tabularnewline
C2 & 18 & 12 & 0 & 10 \tabularnewline
C3 & 5 & 5 & 0 & 20 \tabularnewline
C4 & 1 & 2 & 0 & 26 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=108636&T=2

[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][C]C4[/C][/ROW]
[ROW][C]C1[/C][C]32[/C][C]2[/C][C]0[/C][C]4[/C][/ROW]
[ROW][C]C2[/C][C]18[/C][C]12[/C][C]0[/C][C]10[/C][/ROW]
[ROW][C]C3[/C][C]5[/C][C]5[/C][C]0[/C][C]20[/C][/ROW]
[ROW][C]C4[/C][C]1[/C][C]2[/C][C]0[/C][C]26[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=108636&T=2

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

As an alternative you can also use a QR Code:

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

Confusion Matrix (predicted in columns / actuals in rows)
	C1	C2	C3	C4
C1	32	2	0	4
C2	18	12	0	10
C3	5	5	0	20
C4	1	2	0	26

Figure 1

PNG link

Postscript link

PDF link

Figure 2

PNG link

Postscript link

PDF link

Figure 3

PNG link

Postscript link

PDF link

Parameters (Session):

par1 = 2 ; par2 = quantiles ; par3 = 4 ; par4 = no ;

Parameters (R input):

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

Free Statistics

Description of Statistical Computation

Tree of Dependent Computations

Dataset

Tables (Output of Computation)

Figures (Output of Computation)

Input Parameters & R Code