Free Statistics

of Irreproducible Research!

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 computationMon, 12 Dec 2011 13:37:52 -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/12/t1323715081f9psfdx3zj8lwui.htm/, Retrieved Fri, 03 May 2024 13:00:37 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=154141, Retrieved Fri, 03 May 2024 13:00:37 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact89
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-12 18:34:30] [ee8c3a74bf3b349877806e9a50913c60]
-   P       [Recursive Partitioning (Regression Trees)] [] [2011-12-12 18:37:52] [7dc03dd48c8acabd98b217fada4a6bc0] [Current]
Feedback Forum

Post a new message
Dataseries X:
96560	76	129	17	22996	0	0	78	62	72
112611	41	36	20	26706	3	7	44	56	64
98146	40	37	17	27114	0	1	80	49	66
121848	39	45	17	30594	2	0	73	63	78
31774	23	48	17	4143	1	2	107	67	71
65475	18	24	13	69008	1	0	42	59	71
108446	60	90	17	46300	0	2	76	40	59
76302	31	26	20	30976	2	2	69	34	65
30989	14	35	17	4154	-2	0	62	37	48
150580	77	124	22	45588	-4	0	46	61	72
59382	49	49	12	26263	1	0	133	60	66
341570	168	190	21	117105	0	0	71	57	68
133328	55	79	20	40909	-3	0	46	56	75
101523	42	76	22	61056	0	1	131	67	73
92499	32	57	18	21399	-2	2	47	38	59
118612	46	72	12	30080	-2	0	15	49	72
98104	54	132	17	25568	-3	0	37	32	65
84105	20	45	17	20055	0	1	0	63	69
237213	84	74	38	66198	0	3	79	67	71
133131	55	52	30	57793	4	3	77	43	54
344297	75	86	30	67654	1	5	101	84	84
174415	100	63	31	82753	3	0	105	49	66
294424	77	59	33	101494	4	2	124	58	73
362301	119	715	34	100708	2	0	83	63	69
167488	45	77	28	83737	0	0	106	29	70
152299	53	63	33	61370	2	2	25	58	72
243511	71	65	42	101338	0	2	16	62	63
132487	41	97	36	40735	3	1	22	54	66
172494	52	52	43	86687	3	0	29	53	60
224330	83	52	39	130115	0	0	5	66	66
181633	70	48	30	64466	6	0	27	53	71
210907	56	81	30	112285	2	0	29	26	50
236785	119	75	31	101481	0	5	43	43	52
244052	68	66	44	143558	2	0	158	53	70
143756	46	57	34	69094	4	4	102	54	60
182079	63	63	33	102860	2	0	123	47	76
100750	72	67	30	140867	3	0	105	43	60
152474	65	45	32	65567	0	1	33	57	70
97839	38	42	24	94785	-1	2	96	41	75
149061	44	66	26	116174	0	6	56	37	54
324799	154	108	47	97668	0	5	59	52	65
230964	53	43	30	133824	-1	0	91	52	73
174724	92	135	34	69112	0	1	76	67	42
223632	73	52	33	72654	-1	1	94	70	65
106408	30	32	14	31081	1	2	41	68	75
265769	146	37	32	83122	-2	5	67	43	66
149112	56	65	35	60578	-4	2	100	56	70
152871	58	74	28	79892	2	5	67	74	81
183167	66	66	39	82875	-4	1	135	58	71
218946	41	112	29	80670	2	4	58	63	68
196553	57	50	29	95260	-3	0	56	64	67
143246	103	42	27	106671	2	0	59	53	76
193339	78	47	35	84651	2	1	116	51	71
130585	46	57	29	95364	-4	2	98	54	70
148446	91	63	37	126846	3	8	32	48	65
243060	63	110	29	111813	-1	4	63	50	68
317394	86	53	31	91413	-3	0	113	45	70
244749	95	144	33	76643	0	1	111	61	64
128423	64	89	38	92696	2	10	120	56	70
229242	247	128	31	91721	2	0	25	46	66
324598	110	128	37	135777	2	1	109	51	59
195838	67	50	31	102372	-2	0	37	37	78
254488	83	50	39	103772	0	2	54	42	67
271856	103	91	37	54990	-3	2	55	69	67
95227	34	70	32	34777	3	0	17	56	61




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

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=154141&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 Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time3 seconds
R Server'Gertrude Mary Cox' @ cox.wessa.net







Goodness of Fit
Correlation0.7758
R-squared0.6019
RMSE5.3461

\begin{tabular}{lllllllll}
\hline
Goodness of Fit \tabularnewline
Correlation & 0.7758 \tabularnewline
R-squared & 0.6019 \tabularnewline
RMSE & 5.3461 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=154141&T=1

[TABLE]
[ROW][C]Goodness of Fit[/C][/ROW]
[ROW][C]Correlation[/C][C]0.7758[/C][/ROW]
[ROW][C]R-squared[/C][C]0.6019[/C][/ROW]
[ROW][C]RMSE[/C][C]5.3461[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=154141&T=1

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

As an alternative you can also use a QR Code:  

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

Goodness of Fit
Correlation0.7758
R-squared0.6019
RMSE5.3461







Actuals, Predictions, and Residuals
#ActualsForecastsResiduals
11716.53846153846150.46153846153846
22016.53846153846153.46153846153846
31716.53846153846150.46153846153846
41716.53846153846150.46153846153846
51716.53846153846150.46153846153846
61326.5-13.5
71726.5-9.5
82016.53846153846153.46153846153846
91716.53846153846150.46153846153846
102233.25-11.25
111216.5384615384615-4.53846153846154
122133.25-12.25
132026.5-6.5
142226.5-4.5
151816.53846153846151.46153846153846
161216.5384615384615-4.53846153846154
171716.53846153846150.46153846153846
181716.53846153846150.46153846153846
193833.254.75
203026.53.5
213033.25-3.25
223133.25-2.25
233333.25-0.25
243433.250.75
252833.25-5.25
263333.25-0.25
274233.258.75
283626.59.5
294333.259.75
303933.255.75
313033.25-3.25
323033.25-3.25
333133.25-2.25
344433.2510.75
353433.250.75
363333.25-0.25
373026.53.5
383233.25-1.25
392426.5-2.5
402633.25-7.25
414733.2513.75
423033.25-3.25
433433.250.75
443333.25-0.25
451416.5384615384615-2.53846153846154
463233.25-1.25
473533.251.75
482833.25-5.25
493933.255.75
502933.25-4.25
512933.25-4.25
522726.50.5
533533.251.75
542926.52.5
553733.253.75
562933.25-4.25
573133.25-2.25
583333.25-0.25
593826.511.5
603133.25-2.25
613733.253.75
623133.25-2.25
633933.255.75
643733.253.75
653226.55.5

\begin{tabular}{lllllllll}
\hline
Actuals, Predictions, and Residuals \tabularnewline
# & Actuals & Forecasts & Residuals \tabularnewline
1 & 17 & 16.5384615384615 & 0.46153846153846 \tabularnewline
2 & 20 & 16.5384615384615 & 3.46153846153846 \tabularnewline
3 & 17 & 16.5384615384615 & 0.46153846153846 \tabularnewline
4 & 17 & 16.5384615384615 & 0.46153846153846 \tabularnewline
5 & 17 & 16.5384615384615 & 0.46153846153846 \tabularnewline
6 & 13 & 26.5 & -13.5 \tabularnewline
7 & 17 & 26.5 & -9.5 \tabularnewline
8 & 20 & 16.5384615384615 & 3.46153846153846 \tabularnewline
9 & 17 & 16.5384615384615 & 0.46153846153846 \tabularnewline
10 & 22 & 33.25 & -11.25 \tabularnewline
11 & 12 & 16.5384615384615 & -4.53846153846154 \tabularnewline
12 & 21 & 33.25 & -12.25 \tabularnewline
13 & 20 & 26.5 & -6.5 \tabularnewline
14 & 22 & 26.5 & -4.5 \tabularnewline
15 & 18 & 16.5384615384615 & 1.46153846153846 \tabularnewline
16 & 12 & 16.5384615384615 & -4.53846153846154 \tabularnewline
17 & 17 & 16.5384615384615 & 0.46153846153846 \tabularnewline
18 & 17 & 16.5384615384615 & 0.46153846153846 \tabularnewline
19 & 38 & 33.25 & 4.75 \tabularnewline
20 & 30 & 26.5 & 3.5 \tabularnewline
21 & 30 & 33.25 & -3.25 \tabularnewline
22 & 31 & 33.25 & -2.25 \tabularnewline
23 & 33 & 33.25 & -0.25 \tabularnewline
24 & 34 & 33.25 & 0.75 \tabularnewline
25 & 28 & 33.25 & -5.25 \tabularnewline
26 & 33 & 33.25 & -0.25 \tabularnewline
27 & 42 & 33.25 & 8.75 \tabularnewline
28 & 36 & 26.5 & 9.5 \tabularnewline
29 & 43 & 33.25 & 9.75 \tabularnewline
30 & 39 & 33.25 & 5.75 \tabularnewline
31 & 30 & 33.25 & -3.25 \tabularnewline
32 & 30 & 33.25 & -3.25 \tabularnewline
33 & 31 & 33.25 & -2.25 \tabularnewline
34 & 44 & 33.25 & 10.75 \tabularnewline
35 & 34 & 33.25 & 0.75 \tabularnewline
36 & 33 & 33.25 & -0.25 \tabularnewline
37 & 30 & 26.5 & 3.5 \tabularnewline
38 & 32 & 33.25 & -1.25 \tabularnewline
39 & 24 & 26.5 & -2.5 \tabularnewline
40 & 26 & 33.25 & -7.25 \tabularnewline
41 & 47 & 33.25 & 13.75 \tabularnewline
42 & 30 & 33.25 & -3.25 \tabularnewline
43 & 34 & 33.25 & 0.75 \tabularnewline
44 & 33 & 33.25 & -0.25 \tabularnewline
45 & 14 & 16.5384615384615 & -2.53846153846154 \tabularnewline
46 & 32 & 33.25 & -1.25 \tabularnewline
47 & 35 & 33.25 & 1.75 \tabularnewline
48 & 28 & 33.25 & -5.25 \tabularnewline
49 & 39 & 33.25 & 5.75 \tabularnewline
50 & 29 & 33.25 & -4.25 \tabularnewline
51 & 29 & 33.25 & -4.25 \tabularnewline
52 & 27 & 26.5 & 0.5 \tabularnewline
53 & 35 & 33.25 & 1.75 \tabularnewline
54 & 29 & 26.5 & 2.5 \tabularnewline
55 & 37 & 33.25 & 3.75 \tabularnewline
56 & 29 & 33.25 & -4.25 \tabularnewline
57 & 31 & 33.25 & -2.25 \tabularnewline
58 & 33 & 33.25 & -0.25 \tabularnewline
59 & 38 & 26.5 & 11.5 \tabularnewline
60 & 31 & 33.25 & -2.25 \tabularnewline
61 & 37 & 33.25 & 3.75 \tabularnewline
62 & 31 & 33.25 & -2.25 \tabularnewline
63 & 39 & 33.25 & 5.75 \tabularnewline
64 & 37 & 33.25 & 3.75 \tabularnewline
65 & 32 & 26.5 & 5.5 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=154141&T=2

[TABLE]
[ROW][C]Actuals, Predictions, and Residuals[/C][/ROW]
[ROW][C]#[/C][C]Actuals[/C][C]Forecasts[/C][C]Residuals[/C][/ROW]
[ROW][C]1[/C][C]17[/C][C]16.5384615384615[/C][C]0.46153846153846[/C][/ROW]
[ROW][C]2[/C][C]20[/C][C]16.5384615384615[/C][C]3.46153846153846[/C][/ROW]
[ROW][C]3[/C][C]17[/C][C]16.5384615384615[/C][C]0.46153846153846[/C][/ROW]
[ROW][C]4[/C][C]17[/C][C]16.5384615384615[/C][C]0.46153846153846[/C][/ROW]
[ROW][C]5[/C][C]17[/C][C]16.5384615384615[/C][C]0.46153846153846[/C][/ROW]
[ROW][C]6[/C][C]13[/C][C]26.5[/C][C]-13.5[/C][/ROW]
[ROW][C]7[/C][C]17[/C][C]26.5[/C][C]-9.5[/C][/ROW]
[ROW][C]8[/C][C]20[/C][C]16.5384615384615[/C][C]3.46153846153846[/C][/ROW]
[ROW][C]9[/C][C]17[/C][C]16.5384615384615[/C][C]0.46153846153846[/C][/ROW]
[ROW][C]10[/C][C]22[/C][C]33.25[/C][C]-11.25[/C][/ROW]
[ROW][C]11[/C][C]12[/C][C]16.5384615384615[/C][C]-4.53846153846154[/C][/ROW]
[ROW][C]12[/C][C]21[/C][C]33.25[/C][C]-12.25[/C][/ROW]
[ROW][C]13[/C][C]20[/C][C]26.5[/C][C]-6.5[/C][/ROW]
[ROW][C]14[/C][C]22[/C][C]26.5[/C][C]-4.5[/C][/ROW]
[ROW][C]15[/C][C]18[/C][C]16.5384615384615[/C][C]1.46153846153846[/C][/ROW]
[ROW][C]16[/C][C]12[/C][C]16.5384615384615[/C][C]-4.53846153846154[/C][/ROW]
[ROW][C]17[/C][C]17[/C][C]16.5384615384615[/C][C]0.46153846153846[/C][/ROW]
[ROW][C]18[/C][C]17[/C][C]16.5384615384615[/C][C]0.46153846153846[/C][/ROW]
[ROW][C]19[/C][C]38[/C][C]33.25[/C][C]4.75[/C][/ROW]
[ROW][C]20[/C][C]30[/C][C]26.5[/C][C]3.5[/C][/ROW]
[ROW][C]21[/C][C]30[/C][C]33.25[/C][C]-3.25[/C][/ROW]
[ROW][C]22[/C][C]31[/C][C]33.25[/C][C]-2.25[/C][/ROW]
[ROW][C]23[/C][C]33[/C][C]33.25[/C][C]-0.25[/C][/ROW]
[ROW][C]24[/C][C]34[/C][C]33.25[/C][C]0.75[/C][/ROW]
[ROW][C]25[/C][C]28[/C][C]33.25[/C][C]-5.25[/C][/ROW]
[ROW][C]26[/C][C]33[/C][C]33.25[/C][C]-0.25[/C][/ROW]
[ROW][C]27[/C][C]42[/C][C]33.25[/C][C]8.75[/C][/ROW]
[ROW][C]28[/C][C]36[/C][C]26.5[/C][C]9.5[/C][/ROW]
[ROW][C]29[/C][C]43[/C][C]33.25[/C][C]9.75[/C][/ROW]
[ROW][C]30[/C][C]39[/C][C]33.25[/C][C]5.75[/C][/ROW]
[ROW][C]31[/C][C]30[/C][C]33.25[/C][C]-3.25[/C][/ROW]
[ROW][C]32[/C][C]30[/C][C]33.25[/C][C]-3.25[/C][/ROW]
[ROW][C]33[/C][C]31[/C][C]33.25[/C][C]-2.25[/C][/ROW]
[ROW][C]34[/C][C]44[/C][C]33.25[/C][C]10.75[/C][/ROW]
[ROW][C]35[/C][C]34[/C][C]33.25[/C][C]0.75[/C][/ROW]
[ROW][C]36[/C][C]33[/C][C]33.25[/C][C]-0.25[/C][/ROW]
[ROW][C]37[/C][C]30[/C][C]26.5[/C][C]3.5[/C][/ROW]
[ROW][C]38[/C][C]32[/C][C]33.25[/C][C]-1.25[/C][/ROW]
[ROW][C]39[/C][C]24[/C][C]26.5[/C][C]-2.5[/C][/ROW]
[ROW][C]40[/C][C]26[/C][C]33.25[/C][C]-7.25[/C][/ROW]
[ROW][C]41[/C][C]47[/C][C]33.25[/C][C]13.75[/C][/ROW]
[ROW][C]42[/C][C]30[/C][C]33.25[/C][C]-3.25[/C][/ROW]
[ROW][C]43[/C][C]34[/C][C]33.25[/C][C]0.75[/C][/ROW]
[ROW][C]44[/C][C]33[/C][C]33.25[/C][C]-0.25[/C][/ROW]
[ROW][C]45[/C][C]14[/C][C]16.5384615384615[/C][C]-2.53846153846154[/C][/ROW]
[ROW][C]46[/C][C]32[/C][C]33.25[/C][C]-1.25[/C][/ROW]
[ROW][C]47[/C][C]35[/C][C]33.25[/C][C]1.75[/C][/ROW]
[ROW][C]48[/C][C]28[/C][C]33.25[/C][C]-5.25[/C][/ROW]
[ROW][C]49[/C][C]39[/C][C]33.25[/C][C]5.75[/C][/ROW]
[ROW][C]50[/C][C]29[/C][C]33.25[/C][C]-4.25[/C][/ROW]
[ROW][C]51[/C][C]29[/C][C]33.25[/C][C]-4.25[/C][/ROW]
[ROW][C]52[/C][C]27[/C][C]26.5[/C][C]0.5[/C][/ROW]
[ROW][C]53[/C][C]35[/C][C]33.25[/C][C]1.75[/C][/ROW]
[ROW][C]54[/C][C]29[/C][C]26.5[/C][C]2.5[/C][/ROW]
[ROW][C]55[/C][C]37[/C][C]33.25[/C][C]3.75[/C][/ROW]
[ROW][C]56[/C][C]29[/C][C]33.25[/C][C]-4.25[/C][/ROW]
[ROW][C]57[/C][C]31[/C][C]33.25[/C][C]-2.25[/C][/ROW]
[ROW][C]58[/C][C]33[/C][C]33.25[/C][C]-0.25[/C][/ROW]
[ROW][C]59[/C][C]38[/C][C]26.5[/C][C]11.5[/C][/ROW]
[ROW][C]60[/C][C]31[/C][C]33.25[/C][C]-2.25[/C][/ROW]
[ROW][C]61[/C][C]37[/C][C]33.25[/C][C]3.75[/C][/ROW]
[ROW][C]62[/C][C]31[/C][C]33.25[/C][C]-2.25[/C][/ROW]
[ROW][C]63[/C][C]39[/C][C]33.25[/C][C]5.75[/C][/ROW]
[ROW][C]64[/C][C]37[/C][C]33.25[/C][C]3.75[/C][/ROW]
[ROW][C]65[/C][C]32[/C][C]26.5[/C][C]5.5[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=154141&T=2

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

As an alternative you can also use a QR Code:  

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

Actuals, Predictions, and Residuals
#ActualsForecastsResiduals
11716.53846153846150.46153846153846
22016.53846153846153.46153846153846
31716.53846153846150.46153846153846
41716.53846153846150.46153846153846
51716.53846153846150.46153846153846
61326.5-13.5
71726.5-9.5
82016.53846153846153.46153846153846
91716.53846153846150.46153846153846
102233.25-11.25
111216.5384615384615-4.53846153846154
122133.25-12.25
132026.5-6.5
142226.5-4.5
151816.53846153846151.46153846153846
161216.5384615384615-4.53846153846154
171716.53846153846150.46153846153846
181716.53846153846150.46153846153846
193833.254.75
203026.53.5
213033.25-3.25
223133.25-2.25
233333.25-0.25
243433.250.75
252833.25-5.25
263333.25-0.25
274233.258.75
283626.59.5
294333.259.75
303933.255.75
313033.25-3.25
323033.25-3.25
333133.25-2.25
344433.2510.75
353433.250.75
363333.25-0.25
373026.53.5
383233.25-1.25
392426.5-2.5
402633.25-7.25
414733.2513.75
423033.25-3.25
433433.250.75
443333.25-0.25
451416.5384615384615-2.53846153846154
463233.25-1.25
473533.251.75
482833.25-5.25
493933.255.75
502933.25-4.25
512933.25-4.25
522726.50.5
533533.251.75
542926.52.5
553733.253.75
562933.25-4.25
573133.25-2.25
583333.25-0.25
593826.511.5
603133.25-2.25
613733.253.75
623133.25-2.25
633933.255.75
643733.253.75
653226.55.5



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