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 computationTue, 11 Dec 2012 14:10:42 -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/2012/Dec/11/t13552530707kt2mlpesa4qj3e.htm/, Retrieved Fri, 29 Mar 2024 00:41:28 +0000
Statistical Computations at FreeStatistics.org, Office for Research Development and Education, URL https://freestatistics.org/blog/index.php?pk=198636, Retrieved Fri, 29 Mar 2024 00:41:28 +0000
QR Codes:

Original text written by user:
IsPrivate?No (this computation is public)
User-defined keywords
Estimated Impact95
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)] [policexp] [2012-12-11 19:10:42] [eef9f4a55a40721b371cf4577ce601c1] [Current]
Feedback Forum

Post a new message
Dataseries X:
521	18308	185	4.041	79.6	7.2
367	1148	600	0.55	1	8.5
443	18068	372	3.665	32.3	5.7
365	7729	142	2.351	45.1	7.3
614	100484	432	29.76	190.8	7.5
385	16728	290	3.294	31.8	5
286	14630	346	3.287	678.4	6.7
397	4008	328	0.666	340.8	6.2
764	38927	354	12.938	239.6	7.3
427	22322	266	6.478	111.9	5
153	3711	320	1.108	172.5	2.8
231	3136	197	1.007	12.2	6.1
524	50508	266	11.431	205.6	7.1
328	28886	173	5.544	154.6	5.9
240	16996	190	2.777	49.7	4.6
286	13035	239	2.478	30.3	4.4
285	12973	190	3.685	92.8	7.4
569	16309	241	4.22	96.9	7.1
96	5227	189	1.228	39.8	7.5
498	19235	358	4.781	489.2	5.9
481	44487	315	6.016	767.6	9
468	44213	303	9.295	163.6	9.2
177	23619	228	4.375	55	5.1
198	9106	134	2.573	54.9	8.6
458	24917	189	5.117	74.3	6.6
108	3872	196	0.799	5.5	6.9
246	8945	183	1.578	20.5	2.7
291	2373	417	1.202	10.9	5.5
68	7128	233	1.109	123.7	7.2
311	23624	349	7.73	1042	6.6
606	5242	284	1.515	12.5	6.9
512	92629	499	17.99	381	7.2
426	28795	231	6.629	136.1	5.8
47	4487	143	0.639	9.3	4.1
265	48799	249	10.847	264.9	6.4
370	14067	195	3.146	45.8	6.7
312	12693	288	2.842	29.6	6
222	62184	229	11.882	265.1	6.9
280	9153	287	1.003	960.3	8.5
759	14250	224	3.487	115.8	6.2
114	3680	161	0.696	9.2	3.4
419	18063	221	4.877	118.3	6.6
435	65112	237	16.987	64.9	6.6
186	11340	220	1.723	21	4.9
87	4553	185	0.563	60.8	6.4
188	28960	260	6.187	156.3	5.8
303	19201	261	4.867	73.1	6.3
102	7533	118	1.793	74.5	10.5
127	26343	268	4.892	90.1	5.4
251	1641	300	0.454	4.7	5.1
205	145360	237	10.379	889	6.8
453	9066420	240	82.422	609	5.6
320	1038933	185	16.491	1259	3.8
405	2739420	201	60.876	289	8.2
89	61620	193	0.474	475	4.1
74	827530	254	7.523	490	2.8
101	534100	230	5.45	333	6.3
321	328755	197	10.605	300	11.4
315	1413895	248	40.397	210	19.4
229	2909136	258	60.607	650	5.8
302	3604246	206	58.133	512	6.9
216	917504	199	8.192	256	3.5




Summary of computational transaction
Raw Inputview raw input (R code)
Raw Outputview raw output of R engine
Computing time5 seconds
R Server'George Udny Yule' @ yule.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 & 5 seconds \tabularnewline
R Server & 'George Udny Yule' @ yule.wessa.net \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=198636&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]5 seconds[/C][/ROW]
[ROW][C]R Server[/C][C]'George Udny Yule' @ yule.wessa.net[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=198636&T=0

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







Goodness of Fit
Correlation0.3929
R-squared0.1544
RMSE151.8604

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

[TABLE]
[ROW][C]Goodness of Fit[/C][/ROW]
[ROW][C]Correlation[/C][C]0.3929[/C][/ROW]
[ROW][C]R-squared[/C][C]0.1544[/C][/ROW]
[ROW][C]RMSE[/C][C]151.8604[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=198636&T=1

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=198636&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.3929
R-squared0.1544
RMSE151.8604







Actuals, Predictions, and Residuals
#ActualsForecastsResiduals
1521293.4227.6
2367498.428571428571-131.428571428571
3443498.428571428571-55.4285714285714
4365293.471.6
5614498.428571428571115.571428571429
6385293.491.6
7286293.4-7.39999999999998
8397293.4103.6
9764498.428571428571265.571428571429
10427293.4133.6
11153293.4-140.4
12231293.4-62.4
13524293.4230.6
14328293.434.6
15240293.4-53.4
16286293.4-7.39999999999998
17285293.4-8.39999999999998
18569293.4275.6
1996293.4-197.4
20498498.428571428571-0.428571428571445
21481293.4187.6
22468293.4174.6
23177293.4-116.4
24198293.4-95.4
25458293.4164.6
26108293.4-185.4
27246293.4-47.4
28291498.428571428571-207.428571428571
2968293.4-225.4
30311293.417.6
31606293.4312.6
32512498.42857142857113.5714285714286
33426293.4132.6
3447293.4-246.4
35265293.4-28.4
36370293.476.6
37312293.418.6
38222293.4-71.4
39280293.4-13.4
40759293.4465.6
41114293.4-179.4
42419293.4125.6
43435293.4141.6
44186293.4-107.4
4587293.4-206.4
46188293.4-105.4
47303293.49.60000000000002
48102293.4-191.4
49127293.4-166.4
50251293.4-42.4
51205293.4-88.4
52453293.4159.6
53320293.426.6
54405293.4111.6
5589293.4-204.4
5674293.4-219.4
57101293.4-192.4
58321293.427.6
59315293.421.6
60229293.4-64.4
61302293.48.60000000000002
62216293.4-77.4

\begin{tabular}{lllllllll}
\hline
Actuals, Predictions, and Residuals \tabularnewline
# & Actuals & Forecasts & Residuals \tabularnewline
1 & 521 & 293.4 & 227.6 \tabularnewline
2 & 367 & 498.428571428571 & -131.428571428571 \tabularnewline
3 & 443 & 498.428571428571 & -55.4285714285714 \tabularnewline
4 & 365 & 293.4 & 71.6 \tabularnewline
5 & 614 & 498.428571428571 & 115.571428571429 \tabularnewline
6 & 385 & 293.4 & 91.6 \tabularnewline
7 & 286 & 293.4 & -7.39999999999998 \tabularnewline
8 & 397 & 293.4 & 103.6 \tabularnewline
9 & 764 & 498.428571428571 & 265.571428571429 \tabularnewline
10 & 427 & 293.4 & 133.6 \tabularnewline
11 & 153 & 293.4 & -140.4 \tabularnewline
12 & 231 & 293.4 & -62.4 \tabularnewline
13 & 524 & 293.4 & 230.6 \tabularnewline
14 & 328 & 293.4 & 34.6 \tabularnewline
15 & 240 & 293.4 & -53.4 \tabularnewline
16 & 286 & 293.4 & -7.39999999999998 \tabularnewline
17 & 285 & 293.4 & -8.39999999999998 \tabularnewline
18 & 569 & 293.4 & 275.6 \tabularnewline
19 & 96 & 293.4 & -197.4 \tabularnewline
20 & 498 & 498.428571428571 & -0.428571428571445 \tabularnewline
21 & 481 & 293.4 & 187.6 \tabularnewline
22 & 468 & 293.4 & 174.6 \tabularnewline
23 & 177 & 293.4 & -116.4 \tabularnewline
24 & 198 & 293.4 & -95.4 \tabularnewline
25 & 458 & 293.4 & 164.6 \tabularnewline
26 & 108 & 293.4 & -185.4 \tabularnewline
27 & 246 & 293.4 & -47.4 \tabularnewline
28 & 291 & 498.428571428571 & -207.428571428571 \tabularnewline
29 & 68 & 293.4 & -225.4 \tabularnewline
30 & 311 & 293.4 & 17.6 \tabularnewline
31 & 606 & 293.4 & 312.6 \tabularnewline
32 & 512 & 498.428571428571 & 13.5714285714286 \tabularnewline
33 & 426 & 293.4 & 132.6 \tabularnewline
34 & 47 & 293.4 & -246.4 \tabularnewline
35 & 265 & 293.4 & -28.4 \tabularnewline
36 & 370 & 293.4 & 76.6 \tabularnewline
37 & 312 & 293.4 & 18.6 \tabularnewline
38 & 222 & 293.4 & -71.4 \tabularnewline
39 & 280 & 293.4 & -13.4 \tabularnewline
40 & 759 & 293.4 & 465.6 \tabularnewline
41 & 114 & 293.4 & -179.4 \tabularnewline
42 & 419 & 293.4 & 125.6 \tabularnewline
43 & 435 & 293.4 & 141.6 \tabularnewline
44 & 186 & 293.4 & -107.4 \tabularnewline
45 & 87 & 293.4 & -206.4 \tabularnewline
46 & 188 & 293.4 & -105.4 \tabularnewline
47 & 303 & 293.4 & 9.60000000000002 \tabularnewline
48 & 102 & 293.4 & -191.4 \tabularnewline
49 & 127 & 293.4 & -166.4 \tabularnewline
50 & 251 & 293.4 & -42.4 \tabularnewline
51 & 205 & 293.4 & -88.4 \tabularnewline
52 & 453 & 293.4 & 159.6 \tabularnewline
53 & 320 & 293.4 & 26.6 \tabularnewline
54 & 405 & 293.4 & 111.6 \tabularnewline
55 & 89 & 293.4 & -204.4 \tabularnewline
56 & 74 & 293.4 & -219.4 \tabularnewline
57 & 101 & 293.4 & -192.4 \tabularnewline
58 & 321 & 293.4 & 27.6 \tabularnewline
59 & 315 & 293.4 & 21.6 \tabularnewline
60 & 229 & 293.4 & -64.4 \tabularnewline
61 & 302 & 293.4 & 8.60000000000002 \tabularnewline
62 & 216 & 293.4 & -77.4 \tabularnewline
\hline
\end{tabular}
%Source: https://freestatistics.org/blog/index.php?pk=198636&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]521[/C][C]293.4[/C][C]227.6[/C][/ROW]
[ROW][C]2[/C][C]367[/C][C]498.428571428571[/C][C]-131.428571428571[/C][/ROW]
[ROW][C]3[/C][C]443[/C][C]498.428571428571[/C][C]-55.4285714285714[/C][/ROW]
[ROW][C]4[/C][C]365[/C][C]293.4[/C][C]71.6[/C][/ROW]
[ROW][C]5[/C][C]614[/C][C]498.428571428571[/C][C]115.571428571429[/C][/ROW]
[ROW][C]6[/C][C]385[/C][C]293.4[/C][C]91.6[/C][/ROW]
[ROW][C]7[/C][C]286[/C][C]293.4[/C][C]-7.39999999999998[/C][/ROW]
[ROW][C]8[/C][C]397[/C][C]293.4[/C][C]103.6[/C][/ROW]
[ROW][C]9[/C][C]764[/C][C]498.428571428571[/C][C]265.571428571429[/C][/ROW]
[ROW][C]10[/C][C]427[/C][C]293.4[/C][C]133.6[/C][/ROW]
[ROW][C]11[/C][C]153[/C][C]293.4[/C][C]-140.4[/C][/ROW]
[ROW][C]12[/C][C]231[/C][C]293.4[/C][C]-62.4[/C][/ROW]
[ROW][C]13[/C][C]524[/C][C]293.4[/C][C]230.6[/C][/ROW]
[ROW][C]14[/C][C]328[/C][C]293.4[/C][C]34.6[/C][/ROW]
[ROW][C]15[/C][C]240[/C][C]293.4[/C][C]-53.4[/C][/ROW]
[ROW][C]16[/C][C]286[/C][C]293.4[/C][C]-7.39999999999998[/C][/ROW]
[ROW][C]17[/C][C]285[/C][C]293.4[/C][C]-8.39999999999998[/C][/ROW]
[ROW][C]18[/C][C]569[/C][C]293.4[/C][C]275.6[/C][/ROW]
[ROW][C]19[/C][C]96[/C][C]293.4[/C][C]-197.4[/C][/ROW]
[ROW][C]20[/C][C]498[/C][C]498.428571428571[/C][C]-0.428571428571445[/C][/ROW]
[ROW][C]21[/C][C]481[/C][C]293.4[/C][C]187.6[/C][/ROW]
[ROW][C]22[/C][C]468[/C][C]293.4[/C][C]174.6[/C][/ROW]
[ROW][C]23[/C][C]177[/C][C]293.4[/C][C]-116.4[/C][/ROW]
[ROW][C]24[/C][C]198[/C][C]293.4[/C][C]-95.4[/C][/ROW]
[ROW][C]25[/C][C]458[/C][C]293.4[/C][C]164.6[/C][/ROW]
[ROW][C]26[/C][C]108[/C][C]293.4[/C][C]-185.4[/C][/ROW]
[ROW][C]27[/C][C]246[/C][C]293.4[/C][C]-47.4[/C][/ROW]
[ROW][C]28[/C][C]291[/C][C]498.428571428571[/C][C]-207.428571428571[/C][/ROW]
[ROW][C]29[/C][C]68[/C][C]293.4[/C][C]-225.4[/C][/ROW]
[ROW][C]30[/C][C]311[/C][C]293.4[/C][C]17.6[/C][/ROW]
[ROW][C]31[/C][C]606[/C][C]293.4[/C][C]312.6[/C][/ROW]
[ROW][C]32[/C][C]512[/C][C]498.428571428571[/C][C]13.5714285714286[/C][/ROW]
[ROW][C]33[/C][C]426[/C][C]293.4[/C][C]132.6[/C][/ROW]
[ROW][C]34[/C][C]47[/C][C]293.4[/C][C]-246.4[/C][/ROW]
[ROW][C]35[/C][C]265[/C][C]293.4[/C][C]-28.4[/C][/ROW]
[ROW][C]36[/C][C]370[/C][C]293.4[/C][C]76.6[/C][/ROW]
[ROW][C]37[/C][C]312[/C][C]293.4[/C][C]18.6[/C][/ROW]
[ROW][C]38[/C][C]222[/C][C]293.4[/C][C]-71.4[/C][/ROW]
[ROW][C]39[/C][C]280[/C][C]293.4[/C][C]-13.4[/C][/ROW]
[ROW][C]40[/C][C]759[/C][C]293.4[/C][C]465.6[/C][/ROW]
[ROW][C]41[/C][C]114[/C][C]293.4[/C][C]-179.4[/C][/ROW]
[ROW][C]42[/C][C]419[/C][C]293.4[/C][C]125.6[/C][/ROW]
[ROW][C]43[/C][C]435[/C][C]293.4[/C][C]141.6[/C][/ROW]
[ROW][C]44[/C][C]186[/C][C]293.4[/C][C]-107.4[/C][/ROW]
[ROW][C]45[/C][C]87[/C][C]293.4[/C][C]-206.4[/C][/ROW]
[ROW][C]46[/C][C]188[/C][C]293.4[/C][C]-105.4[/C][/ROW]
[ROW][C]47[/C][C]303[/C][C]293.4[/C][C]9.60000000000002[/C][/ROW]
[ROW][C]48[/C][C]102[/C][C]293.4[/C][C]-191.4[/C][/ROW]
[ROW][C]49[/C][C]127[/C][C]293.4[/C][C]-166.4[/C][/ROW]
[ROW][C]50[/C][C]251[/C][C]293.4[/C][C]-42.4[/C][/ROW]
[ROW][C]51[/C][C]205[/C][C]293.4[/C][C]-88.4[/C][/ROW]
[ROW][C]52[/C][C]453[/C][C]293.4[/C][C]159.6[/C][/ROW]
[ROW][C]53[/C][C]320[/C][C]293.4[/C][C]26.6[/C][/ROW]
[ROW][C]54[/C][C]405[/C][C]293.4[/C][C]111.6[/C][/ROW]
[ROW][C]55[/C][C]89[/C][C]293.4[/C][C]-204.4[/C][/ROW]
[ROW][C]56[/C][C]74[/C][C]293.4[/C][C]-219.4[/C][/ROW]
[ROW][C]57[/C][C]101[/C][C]293.4[/C][C]-192.4[/C][/ROW]
[ROW][C]58[/C][C]321[/C][C]293.4[/C][C]27.6[/C][/ROW]
[ROW][C]59[/C][C]315[/C][C]293.4[/C][C]21.6[/C][/ROW]
[ROW][C]60[/C][C]229[/C][C]293.4[/C][C]-64.4[/C][/ROW]
[ROW][C]61[/C][C]302[/C][C]293.4[/C][C]8.60000000000002[/C][/ROW]
[ROW][C]62[/C][C]216[/C][C]293.4[/C][C]-77.4[/C][/ROW]
[/TABLE]
Source: https://freestatistics.org/blog/index.php?pk=198636&T=2

Globally Unique Identifier (entire table): ba.freestatistics.org/blog/index.php?pk=198636&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
1521293.4227.6
2367498.428571428571-131.428571428571
3443498.428571428571-55.4285714285714
4365293.471.6
5614498.428571428571115.571428571429
6385293.491.6
7286293.4-7.39999999999998
8397293.4103.6
9764498.428571428571265.571428571429
10427293.4133.6
11153293.4-140.4
12231293.4-62.4
13524293.4230.6
14328293.434.6
15240293.4-53.4
16286293.4-7.39999999999998
17285293.4-8.39999999999998
18569293.4275.6
1996293.4-197.4
20498498.428571428571-0.428571428571445
21481293.4187.6
22468293.4174.6
23177293.4-116.4
24198293.4-95.4
25458293.4164.6
26108293.4-185.4
27246293.4-47.4
28291498.428571428571-207.428571428571
2968293.4-225.4
30311293.417.6
31606293.4312.6
32512498.42857142857113.5714285714286
33426293.4132.6
3447293.4-246.4
35265293.4-28.4
36370293.476.6
37312293.418.6
38222293.4-71.4
39280293.4-13.4
40759293.4465.6
41114293.4-179.4
42419293.4125.6
43435293.4141.6
44186293.4-107.4
4587293.4-206.4
46188293.4-105.4
47303293.49.60000000000002
48102293.4-191.4
49127293.4-166.4
50251293.4-42.4
51205293.4-88.4
52453293.4159.6
53320293.426.6
54405293.4111.6
5589293.4-204.4
5674293.4-219.4
57101293.4-192.4
58321293.427.6
59315293.421.6
60229293.4-64.4
61302293.48.60000000000002
62216293.4-77.4



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