1 /* -------------------------------------------------------------------
2 xldlas -- A Stastics Package
3
4 Copyright (C) 1996 Thor Sigvaldason
5
6 This file includes all the routines accessed from the
7 analysis menu, including regress, GA fit, and NN fit.
8
9 -------------------------------------------------------------------*/
10
11 #include "xldlas.h"
12
13 /*
14 Need the following for XFree86/2 as M_E is not defined
15 in math.h
16 */
17 #ifdef __EMX__
18 #include <float.h>
19 #endif
20
21
22 extern void simple_line_output(char which_routine[XLDLASMAX_INPUT], char the_output[XLDLASMAX_INPUT]);
23 extern void begin_column_output(char the_output[XLDLASMAX_INPUT], int justify);
24 extern void add_column_output(char the_output[XLDLASMAX_INPUT], int justify);
25 extern void end_column_output();
26 extern void seperator_output(int how_many);
27 extern void begin_table_output(int how_many, char title[XLDLASMAX_INPUT]);
28 extern void end_table_output(int how_many);
29 extern void filter_tex_specials(char input_string[XLDLASMAX_INPUT]);
30
31 extern void inhibit_input();
32 extern void reenable_input();
33
34 extern int check_variable_name(char proposed[XLDLASMAX_INPUT]);
35
36 extern void say_status(char the_status[XLDLASMAX_INPUT]);
37
38 extern void sync_graph_browsers(int type);
39
inhibit_nn_input()40 void inhibit_nn_input()
41 {
42 fl_deactivate_object(nnet_input_browser);
43 fl_set_object_lcol(nnet_input_browser, FL_INACTIVE);
44 fl_deactivate_object(nnet_hidden_counter);
45 fl_set_object_lcol(nnet_hidden_counter, FL_INACTIVE);
46 fl_deactivate_object(nnet_output_browser);
47 fl_set_object_lcol(nnet_output_browser, FL_INACTIVE);
48 fl_deactivate_object(nnet_from_counter);
49 fl_set_object_lcol(nnet_from_counter, FL_INACTIVE);
50 fl_deactivate_object(nnet_to_counter);
51 fl_set_object_lcol(nnet_to_counter, FL_INACTIVE);
52 fl_deactivate_object(nnet_variable_input);
53 fl_set_object_lcol(nnet_variable_input, FL_INACTIVE);
54 fl_deactivate_object(nnet_overwrite_button);
55 fl_set_object_lcol(nnet_overwrite_button, FL_INACTIVE);
56 fl_deactivate_object(nnet_go_button);
57 fl_set_object_lcol(nnet_go_button, FL_INACTIVE);
58 fl_deactivate_object(nnet_done_button);
59 fl_set_object_lcol(nnet_done_button, FL_INACTIVE);
60
61 }
62
reenable_nn_input()63 void reenable_nn_input()
64 {
65 fl_activate_object(nnet_input_browser);
66 fl_set_object_lcol(nnet_input_browser, FL_BLACK);
67 fl_activate_object(nnet_hidden_counter);
68 fl_set_object_lcol(nnet_hidden_counter, FL_BLACK);
69 fl_activate_object(nnet_output_browser);
70 fl_set_object_lcol(nnet_output_browser, FL_BLACK);
71 fl_activate_object(nnet_from_counter);
72 fl_set_object_lcol(nnet_from_counter, FL_BLACK);
73 fl_activate_object(nnet_to_counter);
74 fl_set_object_lcol(nnet_to_counter, FL_BLACK);
75 fl_activate_object(nnet_variable_input);
76 fl_set_object_lcol(nnet_variable_input, FL_BLACK);
77 fl_activate_object(nnet_overwrite_button);
78 fl_set_object_lcol(nnet_overwrite_button, FL_BLACK);
79 fl_activate_object(nnet_go_button);
80 fl_set_object_lcol(nnet_go_button, FL_BLACK);
81 fl_activate_object(nnet_done_button);
82 fl_set_object_lcol(nnet_done_button, FL_BLACK);
83
84 }
85
squasher_function(float the_input)86 float squasher_function(float the_input)
87 {
88 if(nn_squash == 1)
89 {
90 if(the_input < 0.0) return(0.0);
91 return(1.0);
92 }
93 if(nn_squash == 2)
94 {
95 if(the_input < -1.0) return(0.0);
96 if(the_input < 1.0) return((the_input + 1.0) / 2.0);
97 return(1.0);
98 }
99 if(nn_squash == 3)
100 {
101 return(1.0/(1.0 + pow(M_E,(-1.0 * the_input))));
102 }
103 fl_show_alert("Reached Somewhere we weren't supposed to", "Please tell the author how you did that!","", TRUE);
104 return(1.0);
105 }
106
simulated_annealing(float the_input,int current_cycle,int total_cycles)107 float simulated_annealing(float the_input, int current_cycle, int total_cycles)
108 {
109 float scratch;
110 if(nn_annealing == FALSE)
111 {
112 return(the_input);
113 }
114 scratch = rand() % 2000;
115 scratch = scratch / 1000 - 1.0;
116 scratch = (scratch / (total_cycles - current_cycle)) * nn_learn;
117 return(the_input + scratch);
118 }
119
do_nnet()120 int do_nnet()
121 {
122 int output_variable;
123 int to_nnet[MAX_VARS], input_number;
124 int i,j,k,l;
125 int length;
126 float scratch;
127 float largest, smallest;
128 float input_smallest[MAX_VARS];
129 float input_largest[MAX_VARS];
130 float *bigmatrix[MAX_VARS];
131 char string_one[XLDLASMAX_INPUT];
132 float hidden_layer[MAX_VARS];
133 float output_layer;
134 float output_bias;
135 float in_to_hid_weights[MAX_VARS][MAX_VARS];
136 float in_to_out_weights[MAX_VARS];
137 float hid_to_out_weights[MAX_VARS];
138 float hidden_bias[MAX_VARS];
139 float error_signal;
140 float hidden_errors[MAX_VARS];
141 float average_error;
142 int to_write, fit_type;
143 int ok_to_write;
144 inhibit_nn_input();
145 output_variable = -1;
146 for(i = 0; i < numb_variables; i++)
147 {
148 if(fl_isselected_browser_line(nnet_output_browser, i+1))
149 {
150 output_variable = i;
151 i = numb_variables;
152 }
153 }
154 if(output_variable == -1)
155 {
156 fl_show_alert("No Output Variable Selected","","",TRUE);
157 return(-1);
158 }
159 input_number = 0;
160 for(i = 0; i < numb_variables; i++)
161 {
162 if(fl_isselected_browser_line(nnet_input_browser, i+1) && i != output_variable)
163 {
164 to_nnet[input_number] = i;
165 input_number++;
166 }
167 }
168 if(input_number == 0)
169 {
170 fl_show_alert("No Input Variable(s) Selected","","",TRUE);
171 return(-1);
172 }
173 all_start = fl_get_counter_value(nnet_from_counter);
174 all_stop = fl_get_counter_value(nnet_to_counter);
175 if(all_stop < all_start)
176 {
177 fl_show_alert("From Value greater than To Value","","",TRUE);
178 return(-1);
179 }
180 for(i = all_start - 1; i < all_stop; i++)
181 {
182 if(i < data_matrix[output_variable].obs)
183 {
184 working[i - (all_start - 1)] = *(fvector[output_variable] + i);
185 }
186 else
187 {
188 working[i - (all_start - 1)] = missing_value;
189 }
190 }
191 length = all_stop - (all_start - 1);
192 for(i = 0; i < input_number; i++)
193 {
194 bigmatrix[i] = (float *) malloc (length * sizeof (float));
195 if(!bigmatrix[i])
196 {
197 fl_show_alert("Not Enough Memory to Build Neural Net Matrix", "Man, that sounds like something from Star Trek!","", TRUE);
198 return(-1);
199 }
200 }
201 say_status("Building Neural Net Matrix..");
202 for(i = 0; i < input_number; i++)
203 {
204 for(j = all_start - 1; j < all_stop; j++)
205 {
206 if(j < data_matrix[to_nnet[i]].obs)
207 {
208 *(bigmatrix[i] + j - (all_start - 1)) = *(fvector[to_nnet[i]] + j);
209 }
210 else
211 {
212 *(bigmatrix[i] + j - (all_start - 1)) = missing_value;
213 }
214 }
215 }
216 say_status("Zapping Missing Elements");
217 for(i = 0; i < length; i++)
218 {
219 if(working[i] == missing_value)
220 {
221 for(j = i; j < length - 1; j++)
222 {
223 working[j] = working[j+1];
224 }
225 for(j = 0; j < input_number; j++)
226 {
227 for(k = i; k < length - 1; k++)
228 {
229 *(bigmatrix[j] + k) = *(bigmatrix[j] + k + 1);
230 }
231 }
232 length--;
233 if(length < 1)
234 {
235 fl_show_alert("No set of observations without missing values!","","",TRUE);
236 for(j = 0; j < input_number; j++)
237 {
238 free(bigmatrix[j]);
239 }
240 return(-1);
241 }
242 i--;
243 }
244 }
245 for(i = 0; i < input_number; i++)
246 {
247 for(j = 0; j < length; j++)
248 {
249 if(*(bigmatrix[i] + j) == missing_value)
250 {
251 for(k = 0; k < input_number; k++)
252 {
253 for(l = j; l < length - 1; l++)
254 {
255 *(bigmatrix[k] + l) = *(bigmatrix[k] + l + 1);
256 }
257 }
258 for(k = j; k < length - 1; k++)
259 {
260 working[k] = working[k+1];
261 }
262 length--;
263 if(length < 1)
264 {
265 fl_show_alert("No set of observations without missing values!","","",TRUE);
266 for(j = 0; j < input_number; j++)
267 {
268 free(bigmatrix[j]);
269 }
270 return(-1);
271 }
272 j--;
273 }
274
275 }
276 }
277 smallest = working[0];
278 largest = working[0];
279
280
281 say_status("Converting to 0-1");
282 for(i = 0; i < input_number; i++)
283 {
284 input_smallest[i] = *(bigmatrix[i]);
285 input_largest[i] = *(bigmatrix[i]);
286 for(j = 0; j < length; j++)
287 {
288 if(input_smallest[i] > *(bigmatrix[i] + j)) input_smallest[i] = *(bigmatrix[i] + j);
289 if(input_largest[i] < *(bigmatrix[i] + j)) input_largest[i] = *(bigmatrix[i] + j);
290 }
291 if(input_smallest[i] < input_largest[i])
292 {
293 for(j = 0; j < length; j++)
294 {
295 *(bigmatrix[i] + j) = (*(bigmatrix[i] + j) - input_smallest[i]) / (input_largest[i] - input_smallest[i]);
296 }
297 }
298 else
299 {
300 sprintf(string_one,"%s", data_matrix[to_nnet[i]].name);
301 fl_show_alert("Warning: No variation in the following variable", string_one,"", TRUE);
302 return(-1);
303 }
304 }
305 for(i = 0; i < length; i++)
306 {
307 if(smallest > working[i]) smallest = working[i];
308 if(largest < working[i]) largest = working[i];
309 }
310 if(smallest < largest)
311 {
312 for(i = 0; i < length; i++)
313 {
314 working[i] = (working[i] - smallest) / (largest - smallest);
315 }
316 }
317 else
318 {
319 fl_show_alert("No Variation in Output Variable","","",TRUE);
320 return(-1);
321 }
322
323 for(i = 0; i < input_number; i++)
324 {
325 for(j = 0; j < nn_hidden; j++)
326 {
327 in_to_hid_weights[i][j] = rand() % 2000;
328 in_to_hid_weights[i][j] = in_to_hid_weights[i][j] / 1000.0 - 1.0;
329 }
330 in_to_out_weights[i] = rand() % 2000;
331 in_to_out_weights[i] = in_to_out_weights[i] / 1000.0 - 1.0;
332 }
333 for(i = 0; i < nn_hidden; i++)
334 {
335 hid_to_out_weights[i] = rand() % 2000;
336 hid_to_out_weights[i] = hid_to_out_weights[i] / 1000.0 - 1.0;
337 hidden_bias[i] = rand() % 2000;
338 hidden_bias[i] = hidden_bias[i] / 1000.0 - 1.0;
339 }
340 output_layer = 0.0;
341 average_error = 0.0;
342 output_bias = rand() % 2000;
343 output_bias = output_bias / 1000.0 - 1.0;
344 fl_clear_chart(do_nnet_chart);
345 fl_set_chart_maxnumb(do_nnet_chart,50);
346 say_status("Fitting Neural Network...");
347 fl_show_form(do_nnet_window,FL_PLACE_FREE,FL_FULLBORDER,"Fitting Neural Network");
348 general_abort = FALSE;
349 for(i = 0; i < nn_cycles; i++)
350 {
351 average_error = 0.0;
352 for(j = 0; j < length; j++)
353 {
354 for(k = 0; k < nn_hidden; k++)
355 {
356 hidden_layer[k] = hidden_bias[k];
357 for(l = 0; l < input_number; l++)
358 {
359 hidden_layer[k] = hidden_layer[k] + (in_to_hid_weights[l][k] * (*(bigmatrix[l] + j)));
360 }
361 hidden_layer[k] = squasher_function(hidden_layer[k]);
362 }
363 output_layer = output_bias;
364 for(k = 0; k < input_number; k++)
365 {
366 output_layer = output_layer + (in_to_out_weights[k] * (*(bigmatrix[k] + j)));
367 }
368 for(k = 0; k < nn_hidden; k++)
369 {
370 output_layer = output_layer + (hid_to_out_weights[k] * hidden_layer[k]);
371 }
372 output_layer = squasher_function(output_layer);
373 error_signal = (working[j] - output_layer) * output_layer * (1.0 - output_layer);
374 for(k = 0; k < input_number; k++)
375 {
376 in_to_out_weights[k] = in_to_out_weights[k] + (error_signal * nn_learn * (*(bigmatrix[k] + j)));
377 in_to_out_weights[k] = simulated_annealing(in_to_out_weights[k], i, nn_cycles);
378 }
379 output_bias = output_bias + (error_signal * nn_learn);
380 output_bias = simulated_annealing(output_bias, i, nn_cycles);
381 for(k = 0; k < nn_hidden; k++)
382 {
383 hidden_errors[k] = hidden_layer[k] * (1.0 - hidden_layer[k]) * error_signal * hid_to_out_weights[k];
384 hid_to_out_weights[k] = hid_to_out_weights[k] + (error_signal * nn_learn * hidden_layer[k]);
385 hid_to_out_weights[k] = simulated_annealing(hid_to_out_weights[k], i, nn_cycles);
386 }
387 for(k = 0; k < input_number; k++)
388 {
389 for(l = 0; l < nn_hidden; l++)
390 {
391 in_to_hid_weights[k][l] = in_to_hid_weights[k][l] + (nn_learn * hidden_errors[l] * (*(bigmatrix[k] + l)));
392 in_to_hid_weights[k][l] = simulated_annealing(in_to_hid_weights[k][l], i, nn_cycles);
393 }
394 }
395 for(k = 0; k < nn_hidden; k++)
396 {
397 hidden_bias[k] = hidden_bias[k] + (nn_learn * hidden_errors[k]);
398 hidden_bias[k] = simulated_annealing(hidden_bias[k],i,nn_cycles);
399 }
400 average_error = average_error + fabs(output_layer - working[j]);
401 }
402 average_error = average_error / length;
403 sprintf(string_one,"%d,%16.14f",i,average_error);
404 fl_clear_browser(do_nnet_browser);
405 fl_addto_browser(do_nnet_browser,string_one);
406 fl_add_chart_value(do_nnet_chart, average_error,"",FL_RED);
407 fl_check_forms();
408 if(general_abort == TRUE) return(0);
409 }
410 sprintf(string_one, "Output Variable: %s",data_matrix[output_variable].name);
411 simple_line_output("nnfit", string_one);
412 strcpy(string_one,"Input Variable(s): ");
413 for(i = 0; i < input_number; i++)
414 {
415 strcat(string_one, data_matrix[to_nnet[i]].name);
416 if(i < input_number - 1)
417 {
418 strcat(string_one,", ");
419 }
420 }
421 simple_line_output("nnfit",string_one);
422 begin_table_output(2, "NN Fit: Settings Used");
423 begin_column_output("Squasher Function ", XLDLAS_JUST_CENTER);
424 if(nn_squash == 1) add_column_output("step", XLDLAS_JUST_CENTER);
425 if(nn_squash == 2) add_column_output("straight", XLDLAS_JUST_CENTER);
426 if(nn_squash == 3) add_column_output("sigmoid", XLDLAS_JUST_CENTER);
427 end_column_output();
428 begin_column_output("Simulated Annealing ", XLDLAS_JUST_CENTER);
429 if(nn_annealing == TRUE) add_column_output("On", XLDLAS_JUST_CENTER);
430 if(nn_annealing == FALSE) add_column_output("Off", XLDLAS_JUST_CENTER);
431 end_column_output();
432 begin_column_output("Number of Cycles ", XLDLAS_JUST_CENTER);
433 sprintf(string_one,"%d", nn_cycles);
434 add_column_output(string_one,XLDLAS_JUST_CENTER);
435 end_column_output();
436 begin_column_output("Observations ", XLDLAS_JUST_CENTER);
437 sprintf(string_one, "%d", length);
438 add_column_output(string_one, XLDLAS_JUST_CENTER);
439 end_column_output();
440 begin_column_output("Input Layer Nodes ", XLDLAS_JUST_CENTER);
441 sprintf(string_one,"%d", input_number);
442 add_column_output(string_one, XLDLAS_JUST_CENTER);
443 end_column_output();
444 begin_column_output("Hidden Layer Nodes ", XLDLAS_JUST_CENTER);
445 sprintf(string_one,"%d", nn_hidden);
446 add_column_output(string_one, XLDLAS_JUST_CENTER);
447 end_column_output();
448 begin_column_output("Final Error ", XLDLAS_JUST_CENTER);
449 sprintf(string_one,"%f", average_error);
450 add_column_output(string_one, XLDLAS_JUST_CENTER);
451 end_column_output();
452 end_table_output(2);
453
454
455 begin_table_output(nn_hidden+2,"NN Fit: Weights");
456 begin_column_output(" ", XLDLAS_JUST_CENTER);
457 for(i = 0; i < nn_hidden; i++)
458 {
459 sprintf(string_one," H%2d", i+1);
460 add_column_output(string_one, XLDLAS_JUST_CENTER);
461 }
462 sprintf(string_one,"%14s", data_matrix[output_variable].name);
463 add_column_output(string_one, XLDLAS_JUST_CENTER);
464 end_column_output();
465 seperator_output(nn_hidden+2);
466 begin_column_output(" BIAS", XLDLAS_JUST_RIGHT);
467 for(i = 0; i < nn_hidden; i++)
468 {
469 sprintf(string_one,"%14f", hidden_bias[i]);
470 add_column_output(string_one,XLDLAS_JUST_RIGHT);
471 }
472 sprintf(string_one,"%14f", output_bias);
473 add_column_output(string_one,XLDLAS_JUST_RIGHT);
474 end_column_output();
475 seperator_output(nn_hidden+2);
476 for(i = 0; i < input_number; i++)
477 {
478 sprintf(string_one,"%14s", data_matrix[to_nnet[i]].name);
479 begin_column_output(string_one, XLDLAS_JUST_RIGHT);
480 for(j = 0; j < nn_hidden; j++)
481 {
482 sprintf(string_one,"%14f", in_to_hid_weights[i][j]);
483 add_column_output(string_one, XLDLAS_JUST_RIGHT);
484 }
485 sprintf(string_one,"%14f", in_to_out_weights[i]);
486 add_column_output(string_one, XLDLAS_JUST_RIGHT);
487 end_column_output();
488 }
489 seperator_output(nn_hidden+2);
490 sprintf(string_one,"%14s", data_matrix[output_variable].name);
491 begin_column_output(string_one, XLDLAS_JUST_RIGHT);
492 for(i = 0; i < nn_hidden; i++)
493 {
494 sprintf(string_one,"%14f", hid_to_out_weights[i]);
495 add_column_output(string_one,XLDLAS_JUST_CENTER);
496 }
497 add_column_output(" ", XLDLAS_JUST_CENTER);
498 end_column_output();
499 end_table_output(2+nn_hidden);
500
501 strcpy(string_one,fl_get_input(nnet_variable_input));
502 to_write = -1;
503 fit_type = 3;
504 if(strlen(string_one) > 0)
505 {
506 if(check_variable_name(string_one) == FALSE && fl_get_button(nnet_overwrite_button) == FALSE)
507 {
508 fl_show_alert("Variable Already Exists","","",TRUE);
509 return(0);
510 }
511 if(check_variable_name(string_one) == FALSE)
512 {
513
514 for(i = 0; i < numb_variables; i++)
515 {
516 if(strcmp(data_matrix[i].name,string_one) == 0)
517 {
518 to_write = i;
519 free(fvector[i]);
520 }
521 }
522 fit_type = 1;
523 }
524 else
525 {
526 if(numb_variables == MAX_VARS)
527 {
528 fl_show_alert("No more Space left to Add Variables","","",TRUE);
529 return(0);
530 }
531 to_write = numb_variables;
532 numb_variables++;
533 fit_type = 0;
534 }
535 fvector[to_write] = (float *) malloc (MAX_OBS * sizeof (float));
536 if(!fvector[to_write])
537 {
538 fl_show_alert("Not enough Memory to Save Fitted Values","","",TRUE);
539 return(0);
540 }
541 strcpy(data_matrix[to_write].name, string_one);
542 strcpy(data_matrix[to_write].description, "Fitted Values from NN Fit");
543 data_matrix[to_write].obs = all_stop;
544 for(i = 0; i < all_start - 1; i++)
545 {
546 *(fvector[to_write] + i) = missing_value;
547 }
548 for(i = all_start - 1; i < all_stop; i++)
549 {
550 ok_to_write = TRUE;
551 for(j = 0; j < input_number; j++)
552 {
553 if(*(fvector[to_nnet[j]] + i) == missing_value) ok_to_write = FALSE;
554 }
555 if(ok_to_write == FALSE)
556 {
557 *(fvector[to_write] + i) = missing_value;
558 }
559 else
560 {
561 for(k = 0; k < nn_hidden; k++)
562 {
563 hidden_layer[k] = hidden_bias[k];
564 for(l = 0; l < input_number; l++)
565 {
566 hidden_layer[k] = hidden_layer[k] + in_to_hid_weights[l][k] * ((*(fvector[to_nnet[l]] + i) - input_smallest[l])/(input_largest[l] - input_smallest[l]));
567 }
568 }
569 output_layer = output_bias;
570 for(k = 0; k < nn_hidden; k++)
571 {
572 hidden_layer[k] = squasher_function(hidden_layer[k]);
573 output_layer = output_layer + hid_to_out_weights[k] * hidden_layer[k];
574 }
575 for(k = 0; k < input_number; k++)
576 {
577 output_layer = output_layer + in_to_out_weights[k] * ((*(fvector[to_nnet[k]] + i) - input_smallest[k])/(input_largest[k] - input_smallest[k]));
578 }
579 output_layer = squasher_function(output_layer);
580 *(fvector[to_write] + i) = smallest + (output_layer * (largest - smallest));
581 }
582 }
583 sprintf(string_one, "%d observations fitted to %s", all_stop - (all_start - 1), data_matrix[to_write].name);
584 simple_line_output("nnfit", string_one);
585 oktoquit = FALSE;
586 sync_graph_browsers(fit_type);
587 }
588 if(nn_pictex == TRUE && texlog_on == TRUE)
589 {
590 say_status("Writing PiCTeX Macros to TeXLog");
591 fprintf(texlog_file,"\n%%\n%% PiCTeX Macros for Fitted Neural Network\n%%\n\n");
592 fprintf(texlog_file,"\\midinsert\n");
593 fprintf(texlog_file,"\\line \\bgroup \\hss\n");
594 fprintf(texlog_file,"\\beginpicture\n");
595 fprintf(texlog_file,"\\setcoordinatesystem units <0.25in,0.25in>\n");
596 fprintf(texlog_file,"\\setsolid\n");
597 fprintf(texlog_file,"%%\n%% Change the above two coordinate numbers to scale the image\n%%\n");
598 for(i = 0; i < input_number; i++)
599 {
600 fprintf(texlog_file,"\\putrectangle corners at %d %d and %d %d\n", i*4, 1, i*4+1, 0);
601 fprintf(texlog_file,"\\put {$I_%d$} at %f %f\n", i+1, (i*4) + 0.5, 0.5);
602 filter_tex_specials(data_matrix[to_nnet[i]].name);
603 fprintf(texlog_file,"\\put {\\sevenrm %s} at %f %f\n", filtered_tex_string, (i*4) + 0.5, -0.5);
604 fprintf(texlog_file,"\\putrule from %f %f to %f %f\n", i*4 + 0.5,0.0,i*4 + 0.5, -0.2);
605 }
606 scratch = ((((input_number + 1.0) * 4.0) - 1.0)/2) + 0.5 - (((nn_hidden + 1.0) * 4.0) / 2.0);
607 for(i = 0; i < nn_hidden; i++)
608 {
609
610 fprintf(texlog_file,"\\putrectangle corners at %f %d and %f %d\n", scratch + (i*4), 5, scratch + (i*4)+1, 4);
611 fprintf(texlog_file,"\\put {$H_%d$} at %f %f\n", i+1, scratch + (i*4) + 0.5, 4.5);
612 fprintf(texlog_file,"\\put {\\sevenrm %f} [l] at %f %f\n", hidden_bias[i], scratch + (i*4) + 1.5, 4.5);
613 fprintf(texlog_file,"\\putrule from %f %f to %f %f\n", scratch + (i*4) + 1.0, 4.5, scratch + (i*4) + 1.2, 4.5);
614 }
615 scratch = ((((input_number + 1.0) * 4.0) - 1.0)/2) - 3.5;
616 fprintf(texlog_file,"\\putrectangle corners at %f %d and %f %d\n", scratch, 9, scratch + 1.0, 8);
617 fprintf(texlog_file,"\\put {$O_1$} at %f %f\n", scratch + 0.5, 8.5);
618 fprintf(texlog_file,"\\put {\\sevenrm %f} [l] at %f %f\n", output_bias, scratch + 1.5, 8.5);
619 fprintf(texlog_file,"\\putrule from %f %f to %f %f\n", scratch + 1.0, 8.5, scratch + 1.2, 8.5);
620 filter_tex_specials(data_matrix[output_variable].name);
621 fprintf(texlog_file,"\\put {\\sevenrm %s} at %f %f\n", filtered_tex_string, scratch + 0.5, 9.5);
622 fprintf(texlog_file,"\\putrule from %f %f to %f %f\n", scratch + 0.5, 9.0, scratch + 0.5, 9.2);
623 fprintf(texlog_file,"%%\n%% The next code segment draws the input to hidden weights\n%% (It can safely be deleted for clarity)\n%%\n");
624 fprintf(texlog_file,"\\setlinear\n");
625 scratch = ((((input_number + 1.0) * 4.0) - 1.0)/2) + 0.5 - (((nn_hidden + 1.0) * 4.0) / 2.0);
626 for(i = 0; i < input_number; i++)
627 {
628 for(j = 0; j < nn_hidden; j++)
629 {
630 fprintf(texlog_file,"\\plot %f %f %f %f /\n", i*4 + 0.5, 1.0, scratch + (j*4) + 0.5, 4.0);
631 }
632 }
633 fprintf(texlog_file,"%%\n%% This segment draws the hidden to output weights\n%% (It can safely be deleted for clarity)\n%%\n");
634 for(i = 0; i < nn_hidden; i++)
635 {
636 fprintf(texlog_file,"\\plot %f %f %f %f /\n", scratch + (i * 4) + 0.5, 5.0, ((((input_number + 1.0) * 4.0) - 1.0)/2) - 3.0, 8.0);
637 }
638 fprintf(texlog_file,"%%\n%% Finally, we draw the input to output weights\n%% (This will often need to be deleted for clarity)\n%%\n");
639 fprintf(texlog_file, "\\setdots\n");
640 scratch = ((((input_number + 1.0) * 4.0) - 1.0)/2) - 3.0;
641 for(i = 0; i < input_number; i++)
642 {
643 fprintf(texlog_file,"\\plot %f %f %f %f /\n", (i*4) + 0.5, 1.0, scratch, 8.0);
644 }
645 fprintf(texlog_file,"\\endpicture\n");
646 fprintf(texlog_file,"\\hss\\egroup\n");
647 fprintf(texlog_file,"\\bigskip\n");
648 fprintf(texlog_file,"\\endinsert\n");
649 }
650 return(0);
651 }
652
handle_nnet_buttons(FL_OBJECT * obj,long arg)653 void handle_nnet_buttons(FL_OBJECT *obj, long arg)
654 {
655 if(arg == 0)
656 {
657 window_geometry[XLDLAS_NNFIT][0] = obj->form->x;
658 window_geometry[XLDLAS_NNFIT][1] = obj->form->y;
659 window_geometry[XLDLAS_NNFIT][2] = obj->form->w;
660 window_geometry[XLDLAS_NNFIT][3] = obj->form->h;
661 reenable_input();
662 fl_hide_form(nnet_window);
663 say_status("Ready");
664 }
665 if(arg == 1)
666 {
667 if(do_nnet() == 0)
668 {
669 fl_hide_form(do_nnet_window);
670 reenable_nn_input();
671 say_status("Waiting for Variables for Neural Network");
672 }
673 else
674 {
675 reenable_nn_input();
676 say_status("Waiting for Variables for Neural Network");
677 }
678 }
679 if(arg == 3)
680 {
681 nn_cycles = fl_get_counter_value(nnet_cycles_counter);
682 }
683 if(arg == 4)
684 {
685 nn_learn = fl_get_counter_value(nnet_learn_counter);
686 }
687 if(arg == 5)
688 {
689 nn_hidden = fl_get_counter_value(nnet_hidden_counter);
690 }
691 if(arg == 10)
692 {
693 nn_annealing = fl_get_button(nnet_annealing_button);
694 }
695 if(arg > 10 && arg < 14)
696 {
697 nn_squash = arg - 10;
698 }
699 if(arg == 15)
700 {
701 nn_pictex = fl_get_button(nnet_pictex_button);
702 }
703 }
704
start_nnet()705 void start_nnet()
706 {
707 int i, largest;
708 inhibit_input();
709 fl_clear_browser(nnet_input_browser);
710 fl_clear_browser(nnet_output_browser);
711 largest = 1;
712 for(i = 0; i < numb_variables; i++)
713 {
714 if(largest < data_matrix[i].obs) largest = data_matrix[i].obs;
715 fl_addto_browser(nnet_input_browser, data_matrix[i].name);
716 fl_addto_browser(nnet_output_browser, data_matrix[i].name);
717 }
718 if(nn_squash == 1)
719 {
720 fl_set_button(nnet_step_button, 1);
721 fl_set_button(nnet_straight_button, 0);
722 fl_set_button(nnet_sigmoid_button, 0);
723 }
724 if(nn_squash == 2)
725 {
726 fl_set_button(nnet_step_button, 0);
727 fl_set_button(nnet_straight_button, 1);
728 fl_set_button(nnet_sigmoid_button, 0);
729 }
730 if(nn_squash == 3)
731 {
732 fl_set_button(nnet_step_button, 0);
733 fl_set_button(nnet_straight_button, 0);
734 fl_set_button(nnet_sigmoid_button, 1);
735 }
736 fl_set_button(nnet_annealing_button, nn_annealing);
737 if(texlog_on == TRUE)
738 {
739 fl_set_button(nnet_pictex_button, nn_pictex);
740 fl_activate_object(nnet_pictex_button);
741 fl_set_object_lcol(nnet_pictex_button, FL_BLACK);
742 }
743 else
744 {
745 fl_set_button(nnet_pictex_button, 0);
746 fl_deactivate_object(nnet_pictex_button);
747 fl_set_object_lcol(nnet_pictex_button, FL_INACTIVE);
748 }
749 fl_set_counter_value(nnet_cycles_counter, nn_cycles);
750 fl_set_counter_value(nnet_hidden_counter, nn_hidden);
751 fl_set_counter_value(nnet_learn_counter, nn_learn);
752 fl_set_counter_value(nnet_from_counter, 1);
753 fl_set_counter_bounds(nnet_from_counter, 1, largest);
754 fl_set_counter_bounds(nnet_learn_counter, 0, 20.0);
755 fl_set_counter_bounds(nnet_cycles_counter, 0, XLDLAS_MAX_GA_CYCLES);
756 fl_set_counter_value(nnet_to_counter, largest);
757 fl_set_counter_bounds(nnet_to_counter, 1, largest);
758 say_status("Waiting for Variables for Neural Network");
759 if(window_geometry[XLDLAS_NNFIT][0] != -1)
760 {
761 fl_set_form_geometry(nnet_window,
762 window_geometry[XLDLAS_NNFIT][0],
763 window_geometry[XLDLAS_NNFIT][1],
764 window_geometry[XLDLAS_NNFIT][2],
765 window_geometry[XLDLAS_NNFIT][3]);
766 }
767 fl_show_form(nnet_window,FL_PLACE_FREE,FL_FULLBORDER,"Neural Network Fit");
768 }
769
handle_anova_buttons(FL_OBJECT * obj,long arg)770 void handle_anova_buttons(FL_OBJECT *obj, long arg)
771 {
772 if(arg == 1)
773 {
774 anova_type = 1;
775 fl_deactivate_object(anova_block_browser);
776 fl_set_object_lcol(anova_block_browser, FL_INACTIVE);
777 fl_deactivate_object(anova_block_counter);
778 fl_set_object_lcol(anova_block_counter, FL_INACTIVE);
779 fl_set_button(anova_one_button, 1);
780 fl_set_button(anova_two_button, 0);
781 }
782 if(arg == 2)
783 {
784 anova_type = 2;
785 fl_activate_object(anova_block_browser);
786 fl_set_object_lcol(anova_block_browser, FL_BLACK);
787 fl_activate_object(anova_block_counter);
788 fl_set_object_lcol(anova_block_counter, FL_BLACK);
789 fl_set_button(anova_one_button, 0);
790 fl_set_button(anova_two_button, 1);
791 }
792 }
793
done_anova(FL_OBJECT * obj,long arg)794 void done_anova(FL_OBJECT *obj, long arg)
795 {
796 window_geometry[XLDLAS_ANOVA][0] = obj->form->x;
797 window_geometry[XLDLAS_ANOVA][1] = obj->form->y;
798 window_geometry[XLDLAS_ANOVA][2] = obj->form->w;
799 window_geometry[XLDLAS_ANOVA][3] = obj->form->h;
800 fl_hide_form(anova_window);
801 reenable_input();
802 say_status("Ready");
803 }
804
click_done_anova(FL_FORM * form,void * arg)805 int click_done_anova(FL_FORM *form, void *arg)
806 {
807 window_geometry[XLDLAS_ANOVA][0] = form->x;
808 window_geometry[XLDLAS_ANOVA][1] = form->y;
809 window_geometry[XLDLAS_ANOVA][2] = form->w;
810 window_geometry[XLDLAS_ANOVA][3] = form->h;
811 reenable_input();
812 say_status("Ready");
813 return(FL_OK);
814 }
815
click_done_nnet(FL_FORM * form,void * arg)816 int click_done_nnet(FL_FORM *form, void *arg)
817 {
818 window_geometry[XLDLAS_NNFIT][0] = form->x;
819 window_geometry[XLDLAS_NNFIT][1] = form->y;
820 window_geometry[XLDLAS_NNFIT][2] = form->w;
821 window_geometry[XLDLAS_NNFIT][3] = form->h;
822 reenable_input();
823 say_status("Ready");
824 return(FL_OK);
825 }
826
827
start_anova()828 void start_anova()
829 {
830 int i, largest;
831 inhibit_input();
832 largest = 0;
833 fl_clear_browser(anova_block_browser);
834 fl_clear_browser(anova_variable_browser);
835 for(i = 0; i < numb_variables; i++)
836 {
837 if(largest < data_matrix[i].obs) largest = data_matrix[i].obs;
838 fl_addto_browser(anova_block_browser,data_matrix[i].name);
839 fl_addto_browser(anova_variable_browser,data_matrix[i].name);
840 }
841 fl_set_counter_value(anova_from_counter, 1);
842 fl_set_counter_bounds(anova_from_counter, 1, largest);
843 fl_set_counter_value(anova_to_counter, largest);
844 fl_set_counter_bounds(anova_to_counter, 1, largest);
845 fl_set_counter_value(anova_block_counter, 5);
846 fl_set_counter_bounds(anova_block_counter, 1, MAX_VARS);
847
848 fl_set_button(anova_one_button, 0);
849 fl_set_button(anova_two_button, 0);
850 if(anova_type == 1)
851 {
852 fl_deactivate_object(anova_block_browser);
853 fl_set_object_lcol(anova_block_browser, FL_INACTIVE);
854 fl_deactivate_object(anova_block_counter);
855 fl_set_object_lcol(anova_block_counter, FL_INACTIVE);
856 fl_set_button(anova_one_button, 1);
857 }
858 else
859 {
860 fl_activate_object(anova_block_browser);
861 fl_set_object_lcol(anova_block_browser, FL_BLACK);
862 fl_activate_object(anova_block_counter);
863 fl_set_object_lcol(anova_block_counter, FL_BLACK);
864 fl_set_button(anova_two_button, 1);
865 }
866
867 say_status("Waiting for Variable/Type selection to do ANOVA");
868 if(window_geometry[XLDLAS_ANOVA][0] != -1)
869 {
870 fl_set_form_geometry(anova_window,
871 window_geometry[XLDLAS_ANOVA][0],
872 window_geometry[XLDLAS_ANOVA][1],
873 window_geometry[XLDLAS_ANOVA][2],
874 window_geometry[XLDLAS_ANOVA][3]);
875 }
876 fl_show_form(anova_window,FL_PLACE_FREE,FL_FULLBORDER,"Analysis of Variance");
877 }
878
879
inhibit_ga_input()880 void inhibit_ga_input()
881 {
882 fl_deactivate_object(ga_xvars_browser);
883 fl_set_object_lcol(ga_xvars_browser, FL_INACTIVE);
884
885 fl_deactivate_object(ga_yvar_browser);
886 fl_set_object_lcol(ga_yvar_browser, FL_INACTIVE);
887
888 fl_deactivate_object(ga_save_input);
889 fl_set_object_lcol(ga_save_input, FL_INACTIVE);
890
891 fl_deactivate_object(ga_overwrite_button);
892 fl_set_object_lcol(ga_overwrite_button, FL_INACTIVE);
893
894 fl_deactivate_object(ga_go_button);
895 fl_set_object_lcol(ga_go_button, FL_INACTIVE);
896
897 fl_deactivate_object(ga_done_button);
898 fl_set_object_lcol(ga_done_button, FL_INACTIVE);
899
900 fl_deactivate_object(ga_from_counter);
901 fl_set_object_lcol(ga_from_counter, FL_INACTIVE);
902 fl_deactivate_object(ga_to_counter);
903 fl_set_object_lcol(ga_to_counter, FL_INACTIVE);
904 fl_deactivate_object(ga_maxreal_counter);
905 fl_set_object_lcol(ga_maxreal_counter, FL_INACTIVE);
906 fl_deactivate_object(ga_bitsize_counter);
907 fl_set_object_lcol(ga_bitsize_counter, FL_INACTIVE);
908 fl_deactivate_object(ga_poolsize_counter);
909 fl_set_object_lcol(ga_poolsize_counter, FL_INACTIVE);
910 }
911
reenable_ga_input()912 void reenable_ga_input()
913 {
914 fl_activate_object(ga_xvars_browser);
915 fl_set_object_lcol(ga_xvars_browser, FL_BLACK);
916
917 fl_activate_object(ga_yvar_browser);
918 fl_set_object_lcol(ga_yvar_browser, FL_BLACK);
919
920 fl_activate_object(ga_save_input);
921 fl_set_object_lcol(ga_save_input, FL_BLACK);
922
923 fl_activate_object(ga_overwrite_button);
924 fl_set_object_lcol(ga_overwrite_button, FL_BLACK);
925
926 fl_activate_object(ga_go_button);
927 fl_set_object_lcol(ga_go_button, FL_YELLOW);
928
929 fl_activate_object(ga_done_button);
930 fl_set_object_lcol(ga_done_button, FL_BLACK);
931
932 fl_activate_object(ga_from_counter);
933 fl_set_object_lcol(ga_from_counter, FL_BLACK);
934 fl_activate_object(ga_to_counter);
935 fl_set_object_lcol(ga_to_counter, FL_BLACK);
936 fl_activate_object(ga_maxreal_counter);
937 fl_set_object_lcol(ga_maxreal_counter, FL_BLACK);
938 fl_activate_object(ga_bitsize_counter);
939 fl_set_object_lcol(ga_bitsize_counter, FL_BLACK);
940 fl_activate_object(ga_poolsize_counter);
941 fl_set_object_lcol(ga_poolsize_counter, FL_BLACK);
942 }
943
handle_ga_buttons(FL_OBJECT * obj,long arg)944 void handle_ga_buttons(FL_OBJECT *obj, long arg)
945 {
946 if(fl_get_button(ga_force_button) == TRUE) ga_force = TRUE;
947 else ga_force = FALSE;
948 if(fl_get_button(ga_mutate_button) == TRUE) ga_mutate_ok = TRUE;
949 else ga_mutate_ok = FALSE;
950 if(fl_get_button(ga_cross_button) == TRUE) ga_cross_ok = TRUE;
951 else ga_cross_ok = FALSE;
952 if(fl_get_button(ga_perturbe_button) == TRUE) ga_perturbe_ok = TRUE;
953 else ga_perturbe_ok = FALSE;
954 }
955
956
957
handle_ga_counters(FL_OBJECT * obj,long arg)958 void handle_ga_counters(FL_OBJECT *obj, long arg)
959 {
960 if(arg == 1) all_start = fl_get_counter_value(ga_from_counter);
961 if(arg == 2) all_stop = fl_get_counter_value(ga_to_counter);
962 if(arg == 3) ga_cycles = fl_get_counter_value(ga_cycles_counter);
963 if(arg == 4) ga_update = fl_get_counter_value(ga_update_counter);
964 if(arg == 5) ga_mutate = fl_get_counter_value(ga_mutate_counter);
965 if(arg == 6) ga_maxreal = fl_get_counter_value(ga_maxreal_counter);
966 if(arg == 7) ga_bitsize = fl_get_counter_value(ga_bitsize_counter);
967 if(arg == 8) ga_poolsize = fl_get_counter_value(ga_poolsize_counter);
968 if(arg == 9) ga_swap = fl_get_counter_value(ga_swap_counter);
969 if(arg == 10) ga_cross = fl_get_counter_value(ga_cross_counter);
970 if(arg == 11) ga_perturbe = fl_get_counter_value(ga_perturbe_counter);
971 if(arg == 12) ga_tolerance = fl_get_counter_value(ga_tolerance_counter);
972 }
973
974
gammaln(float xx)975 float gammaln(float xx)
976 {
977 double x,y,tmp,ser;
978 static double cof[6] = { 76.18009172947146,
979 -86.50532032941677,
980 24.01409824083091,
981 -1.231739572450155,
982 0.1208650973866179e-2,
983 -0.5395239384953e-5};
984 int j;
985 y = x = xx;
986 tmp = x + 5.5;
987 tmp = tmp - (x+0.5) * log(tmp);
988 ser = 1.000000000190015;
989 for(j=0; j <=5; j++)
990 {
991 ser = ser + cof[j] / ++y;
992 }
993 return -tmp+log(2.5066282746310005*ser/x);
994 }
995
996
betacf(float a,float b,float x)997 float betacf(float a, float b, float x)
998 {
999 int m,m2;
1000 float aa,c,d,del,h,qab,qam,qap;
1001 qab=a+b;
1002 qap=a+1.0;
1003 qam=a-1.0;
1004 c=1.0;
1005 d=1.0-qab*x/qap;
1006 if(fabs(d) < FPMIN) d = FPMIN;
1007 d=1.0/d;
1008 h=d;
1009 for(m=1;m<MAXIT;m++)
1010 {
1011 m2=2*m;
1012 aa=m*(b-m)*x/((qam+m2)*(a+m2));
1013 d=1.0+aa*d;
1014 if(fabs(d) < FPMIN) d = FPMIN;
1015 c=1.0+aa/c;
1016 if(fabs(c) < FPMIN) c = FPMIN;
1017 d = 1.0/d;
1018 h = h * d * c;
1019 aa = -(a+m)*(qab+m)*x/((a+m2)*(qap+m2));
1020 d=1.0+aa*d;
1021 if(fabs(d) < FPMIN) d = FPMIN;
1022 c=1.0+aa/c;
1023 if(fabs(c) < FPMIN) c = FPMIN;
1024 d = 1.0/d;
1025 del = d*c;
1026 h = h * del;
1027 if(fabs(del-1.0) < EPS) break;
1028 }
1029 if(m > MAXIT)
1030 {
1031 fl_show_alert("Calculation of Beta Function did not Converge",
1032 "Expect very innacurate results in current/forthcoming output",
1033 "",
1034 TRUE);
1035 }
1036 return(h);
1037 }
1038
1039
betai(float a,float b,float x)1040 float betai(float a, float b, float x)
1041 {
1042 float bt;
1043 if(x == 0.0 || x == 1.0) bt = 0.0;
1044 else bt = exp(gammaln(a+b)-gammaln(a)-gammaln(b)+a*log(x)+b*log(1.0-x));
1045 if( x < (a+1.0) / a+b+2.0) return bt * betacf(a,b,x)/a;
1046 else return 1.0-bt*betacf(b,a,1.0-x)/b;
1047 }
1048
pearsn_r(float x[],float y[],int n)1049 float pearsn_r(float x[], float y[], int n)
1050 {
1051 unsigned long j;
1052 float yt, xt, t, df, r;
1053 float syy=0.0, sxy = 0.0, sxx=0.0, ay=0.0, ax=0.0;
1054
1055 for(j=1; j < n; j++)
1056 {
1057 ax = ax + x[j];
1058 ay = ay + y[j];
1059 }
1060 ax = ax / n;
1061 ay = ay / n;
1062 for(j=1; j < n; j++)
1063 {
1064 xt = x[j] - ax;
1065 yt = y[j] - ay;
1066 sxx = sxx + xt * xt;
1067 syy = syy + yt * yt;
1068 sxy = sxy + xt * yt;
1069 }
1070 r = sxy / (sqrt(sxx*syy) + TINY);
1071 df=n-2;
1072 t = r * sqrt(df/((1.0 - r + TINY) * (1.0 + r + TINY)));
1073 return(r);
1074 }
1075
pearsn_prob(float x[],float y[],int n)1076 float pearsn_prob(float x[], float y[], int n)
1077 {
1078 unsigned long j;
1079 float yt, xt, t, df, r, prob;
1080 float syy=0.0, sxy = 0.0, sxx=0.0, ay=0.0, ax=0.0;
1081
1082 for(j=1; j < n; j++)
1083 {
1084 ax = ax + x[j];
1085 ay = ay + y[j];
1086 }
1087 ax = ax / n;
1088 ay = ay / n;
1089 for(j=1; j < n; j++)
1090 {
1091 xt = x[j] - ax;
1092 yt = y[j] - ay;
1093 sxx = sxx + xt * xt;
1094 syy = syy + yt * yt;
1095 sxy = sxy + xt * yt;
1096 }
1097 r = sxy / (sqrt(sxx*syy) + TINY);
1098 df=n-2;
1099 t = r * sqrt(df/((1.0 - r + TINY) * (1.0 + r + TINY)));
1100 prob = betai(0.5*df,0.5,df/(df+t*t));
1101 return(prob);
1102 }
1103
1104
sort_working_vector()1105 void sort_working_vector()
1106 {
1107 int i, escape;
1108 float temp;
1109 escape = FALSE;
1110 while(escape == FALSE)
1111 {
1112 escape = TRUE;
1113 for(i = 0; i < worksize - 1; i++)
1114 {
1115 if(working[i] > working[i+1])
1116 {
1117 temp = working[i];
1118 working[i] = working[i+1];
1119 working[i+1] = temp;
1120 escape = FALSE;
1121 }
1122 }
1123 }
1124 }
1125
done_ga(FL_OBJECT * obj,long arg)1126 void done_ga(FL_OBJECT *obj, long arg)
1127 {
1128 window_geometry[XLDLAS_GAFIT][0] = obj->form->x;
1129 window_geometry[XLDLAS_GAFIT][1] = obj->form->y;
1130 window_geometry[XLDLAS_GAFIT][2] = obj->form->w;
1131 window_geometry[XLDLAS_GAFIT][3] = obj->form->h;
1132 fl_hide_form(ga_window);
1133 reenable_input();
1134 say_status("Ready");
1135 }
1136
click_done_ga(FL_FORM * form,void * arg)1137 int click_done_ga(FL_FORM *form, void *arg)
1138 {
1139 window_geometry[XLDLAS_GAFIT][0] = form->x;
1140 window_geometry[XLDLAS_GAFIT][1] = form->y;
1141 window_geometry[XLDLAS_GAFIT][2] = form->w;
1142 window_geometry[XLDLAS_GAFIT][3] = form->h;
1143 say_status("Ready");
1144 reenable_input();
1145 return(FL_OK);
1146 }
1147
click_user_summarize_variable(FL_FORM * form,void * arg)1148 int click_user_summarize_variable(FL_FORM *form, void *arg)
1149 {
1150 say_status("Ready");
1151 reenable_input();
1152 return(FL_OK);
1153 }
1154
user_summarize_variable(FL_OBJECT * obj,long arg)1155 void user_summarize_variable(FL_OBJECT *obj, long arg)
1156 {
1157 char string_one[XLDLASMAX_INPUT];
1158 int i, j, to_summarize[MAX_VARS];
1159 int nrealobs[MAX_VARS], stat_denom[MAX_VARS], numb_summaries;
1160 float running[MAX_VARS],
1161 runningt,
1162 smallest[MAX_VARS],
1163 largest[MAX_VARS],
1164 average[MAX_VARS],
1165 median[MAX_VARS],
1166 firstq[MAX_VARS],
1167 thirdq[MAX_VARS],
1168 variance[MAX_VARS],
1169 mad[MAX_VARS],
1170 skew[MAX_VARS],
1171 kurt[MAX_VARS],
1172 sdev[MAX_VARS];
1173 int summ_start[MAX_VARS];
1174 int summ_stop[MAX_VARS];
1175 fl_hide_form(summarize_window);
1176 say_status("Summarizing Variable(s)");
1177 all_start = fl_get_counter_value(summarize_from_counter);
1178 all_stop = fl_get_counter_value(summarize_to_counter);
1179 numb_summaries = 0;
1180 for(i = 0; i < numb_variables; i++)
1181 {
1182 if(fl_isselected_browser_line(summarize_browser, i+1))
1183 {
1184 to_summarize[numb_summaries] = i;
1185 summ_start[numb_summaries] = fl_get_counter_value(summarize_from_counter);
1186 summ_stop[numb_summaries] = fl_get_counter_value(summarize_to_counter);
1187 if(summ_stop[numb_summaries] > data_matrix[i].obs) summ_stop[numb_summaries] = data_matrix[i].obs;
1188 if(summ_stop[numb_summaries] < summ_start[numb_summaries])
1189 {
1190 fl_show_alert("Some Variables have no Observations",
1191 "Try adjusting From: value",
1192 "",
1193 TRUE);
1194 reenable_input();
1195 say_status("Ready");
1196 return;
1197 }
1198 numb_summaries++;
1199 }
1200 }
1201 if(numb_summaries == 0)
1202 {
1203 say_status("Ready");
1204 reenable_input();
1205 return;
1206 }
1207 for(i = 0; i < numb_summaries; i++)
1208 {
1209 nrealobs[i]=0;
1210 running[i] = 0;
1211 runningt = 0;
1212 smallest[i] = *(fvector[to_summarize[i]] + summ_start[i] - 1);
1213 largest[i] = *(fvector[to_summarize[i]] + summ_start[i] - 1);
1214 for(j=summ_start[i] - 1;j < summ_stop[i]; j++)
1215 {
1216 if( *(fvector[to_summarize[i]] + j) != missing_value)
1217 {
1218 running[i] = running[i] + *(fvector[to_summarize[i]] + j);
1219 runningt = runningt + (*(fvector[to_summarize[i]] + j) * *(fvector[to_summarize[i]] + j));
1220 if(smallest[i] > *(fvector[to_summarize[i]] + j) || smallest[i] == missing_value) smallest[i] = *(fvector[to_summarize[i]] + j);
1221 if(largest[i] < *(fvector[to_summarize[i]] + j) || largest[i] == missing_value) largest[i] = *(fvector[to_summarize[i]] + j);
1222 nrealobs[i]++;
1223 }
1224 }
1225 stat_denom[i] = nrealobs[i];
1226 if(assume_sample == TRUE && nrealobs[i] > 1) stat_denom[i]--;
1227 average[i] = running[i] / nrealobs[i];
1228 variance[i] = (runningt - (nrealobs[i] * pow(average[i], 2))) / stat_denom[i];
1229 sdev[i] = pow(variance[i],0.5);
1230 mad[i] = 0;
1231 skew[i] = 0;
1232 kurt[i] = 0;
1233 for(j=summ_start[i] - 1;j < summ_stop[i]; j++)
1234 {
1235 if( *(fvector[to_summarize[i]] + j) != missing_value)
1236 {
1237 mad[i] = mad[i] + fabs(*(fvector[to_summarize[i]] + j) - average[i]);
1238 skew[i] = skew[i] + pow(((*(fvector[to_summarize[i]] + j) - average[i]) / sdev[i]), 3);
1239 kurt[i] = kurt[i] + pow(((*(fvector[to_summarize[i]] + j) - average[i]) / sdev[i]), 4);
1240 }
1241 }
1242
1243 mad[i] = mad[i] / nrealobs[i];
1244 skew[i] = skew[i] / stat_denom[i];
1245 kurt[i] = kurt[i] / stat_denom[i];
1246 kurt[i] = kurt[i] - 3.0;
1247 worksize = 0;
1248 for(j=summ_start[i] - 1; j < summ_stop[i]; j++)
1249 {
1250 if( *(fvector[to_summarize[i]] + j) != missing_value)
1251 {
1252 working[j - (all_start - 1)] = *(fvector[to_summarize[i]] + j);
1253 worksize++;
1254 }
1255 }
1256 sort_working_vector();
1257 median[i] = (float) working[worksize / 2];
1258 if(nrealobs[i] % 2 == 0) median[i] = (working[worksize / 2 - 1] + working[worksize / 2]) / 2.0;
1259 firstq[i] = (float) working[worksize / 4];
1260 thirdq[i] = (float) working[(3 * worksize) /4];
1261 if((worksize - 1) % 4 != 0)
1262 {
1263 firstq[i] = working[worksize / 4] + (0.25 * (working[(worksize / 4) + 1] - working[worksize/4]));
1264 thirdq[i] = working[((3* worksize) / 4) - 1] + 0.75 * (working[(3 * worksize)/ 4] - working[((3 * worksize) /4) - 1]);
1265 }
1266 }
1267 sprintf(string_one,"Summary of data between observations %d and %d", all_start, all_stop);
1268 simple_line_output("summ","Variable Summary");
1269 begin_table_output(numb_summaries + 1, string_one);
1270 begin_column_output(" ", XLDLAS_JUST_CENTER);
1271 for(i=0; i < numb_summaries; i++)
1272 {
1273 sprintf(string_one,"%14s",data_matrix[to_summarize[i]].name);
1274 add_column_output(string_one, XLDLAS_JUST_CENTER);
1275 }
1276 end_column_output();
1277 seperator_output(numb_summaries + 1);
1278 begin_column_output(" Apparent Observations ", XLDLAS_JUST_RIGHT);
1279 for(i=0; i < numb_summaries; i++)
1280 {
1281 sprintf(string_one,"%14i",(all_stop-all_start)+1);
1282 add_column_output(string_one, XLDLAS_JUST_CENTER);
1283 }
1284 end_column_output();
1285 begin_column_output(" Real Observations ", XLDLAS_JUST_RIGHT);
1286 for(i=0; i < numb_summaries; i++)
1287 {
1288 sprintf(string_one,"%14i",nrealobs[i]);
1289 add_column_output(string_one, XLDLAS_JUST_CENTER);
1290 }
1291 end_column_output();
1292 seperator_output(numb_summaries + 1);
1293 begin_column_output(" Sum ", XLDLAS_JUST_RIGHT);
1294 for(i=0; i < numb_summaries; i++)
1295 {
1296 sprintf(string_one,"%14.3f",running[i]);
1297 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1298 }
1299 end_column_output();
1300 begin_column_output(" Mean ", XLDLAS_JUST_RIGHT);
1301 for(i=0; i < numb_summaries; i++)
1302 {
1303 sprintf(string_one,"%14.3f",average[i]);
1304 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1305 }
1306 end_column_output();
1307 begin_column_output(" Smallest ", XLDLAS_JUST_RIGHT);
1308 for(i=0; i < numb_summaries; i++)
1309 {
1310 sprintf(string_one,"%14.3f",smallest[i]);
1311 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1312 }
1313 end_column_output();
1314 begin_column_output(" Largest ", XLDLAS_JUST_RIGHT);
1315 for(i=0; i < numb_summaries; i++)
1316 {
1317 sprintf(string_one,"%14.3f",largest[i]);
1318 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1319 }
1320 end_column_output();
1321 begin_column_output(" Variance ", XLDLAS_JUST_RIGHT);
1322 for(i=0; i < numb_summaries; i++)
1323 {
1324 sprintf(string_one,"%14.3f",variance[i]);
1325 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1326 }
1327 end_column_output();
1328 begin_column_output(" Standard Deviation ", XLDLAS_JUST_RIGHT);
1329 for(i=0; i < numb_summaries; i++)
1330 {
1331 sprintf(string_one,"%14.3f",sdev[i]);
1332 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1333 }
1334 end_column_output();
1335 begin_column_output(" Mean Absolute Deviation ", XLDLAS_JUST_RIGHT);
1336 for(i=0; i < numb_summaries; i++)
1337 {
1338 sprintf(string_one,"%14.3f",mad[i]);
1339 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1340 }
1341 end_column_output();
1342 begin_column_output(" Median ", XLDLAS_JUST_RIGHT);
1343 for(i=0; i < numb_summaries; i++)
1344 {
1345 sprintf(string_one,"%14.3f",median[i]);
1346 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1347 }
1348 end_column_output();
1349 begin_column_output(" First Quartile ", XLDLAS_JUST_RIGHT);
1350 for(i=0; i < numb_summaries; i++)
1351 {
1352 sprintf(string_one,"%14.3f",firstq[i]);
1353 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1354 }
1355 end_column_output();
1356 begin_column_output(" Third Quartile ", XLDLAS_JUST_RIGHT);
1357 for(i=0; i < numb_summaries; i++)
1358 {
1359 sprintf(string_one,"%14.3f",thirdq[i]);
1360 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1361 }
1362 end_column_output();
1363 begin_column_output(" Skewness ", XLDLAS_JUST_RIGHT);
1364 for(i=0; i < numb_summaries; i++)
1365 {
1366 sprintf(string_one,"%14.3f",skew[i]);
1367 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1368 }
1369 end_column_output();
1370 begin_column_output(" Kurtosis ", XLDLAS_JUST_RIGHT);
1371 for(i=0; i < numb_summaries; i++)
1372 {
1373 sprintf(string_one,"%14.3f", kurt[i]);
1374 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1375 }
1376 end_column_output();
1377 end_table_output(2);
1378 say_status("Ready");
1379 reenable_input();
1380 }
1381
1382
begin_summarize(FL_OBJECT * menu,long user_data)1383 void begin_summarize(FL_OBJECT *menu, long user_data)
1384 {
1385 int i, largest;
1386 inhibit_input();
1387 say_status("Waiting for Choice");
1388 fl_freeze_form(summarize_window);
1389 fl_clear_browser(summarize_browser);
1390 largest = 0;
1391 for(i=0; i < numb_variables; i++)
1392 {
1393 fl_addto_browser(summarize_browser,data_matrix[i].name);
1394 if(largest < data_matrix[i].obs) largest = data_matrix[i].obs;
1395 }
1396
1397 fl_set_counter_value(summarize_from_counter, 1);
1398 fl_set_counter_bounds(summarize_from_counter, 1, largest);
1399 fl_set_counter_step(summarize_from_counter, 1, 10);
1400 fl_set_counter_value(summarize_to_counter, largest);
1401 fl_set_counter_bounds(summarize_to_counter, 1, largest);
1402 fl_set_counter_step(summarize_to_counter, 1, 10);
1403 fl_redraw_object(summarize_to_counter);
1404 fl_set_counter_value(summarize_to_counter, largest);
1405 fl_redraw_object(summarize_to_counter);
1406 fl_redraw_form(summarize_window);
1407 fl_show_form(summarize_window,FL_PLACE_FREE,FL_TRANSIENT,"Choose Variable(s)");
1408 fl_unfreeze_form(summarize_window);
1409 }
1410
corr_variables(FL_OBJECT * obj,long arg)1411 void corr_variables(FL_OBJECT *obj, long arg)
1412 {
1413 int i, j, k, numb_corr, to_corr[MAX_VARS], corr_obs;
1414 char string_one[XLDLASMAX_INPUT];
1415 char string_two[XLDLASMAX_INPUT];
1416 fl_hide_form(corr_window);
1417 all_start = fl_get_counter_value(corr_from_counter);
1418 all_stop = fl_get_counter_value(corr_to_counter);
1419 if(all_stop < all_start)
1420 {
1421 fl_show_alert("From Value Greater than to Value!",
1422 "",
1423 "",
1424 TRUE);
1425 reenable_input();
1426 say_status("Ready");
1427 return;
1428 }
1429 strcpy(string_one, "Variables: ");
1430 numb_corr = 0;
1431 for(i = 0; i < numb_variables; i++)
1432 {
1433 if(fl_isselected_browser_line(corr_browser, i+1))
1434 {
1435 to_corr[numb_corr] = i;
1436 sprintf(string_two," %s", data_matrix[i].name);
1437 strcat(string_one, string_two);
1438 numb_corr++;
1439 }
1440 }
1441 if(numb_corr == 0)
1442 {
1443 reenable_input();
1444 say_status("Ready");
1445 return;
1446 }
1447 if(numb_corr == 1)
1448 {
1449 fl_show_alert("Can't Correlate a Variable with Itself!",
1450 "",
1451 "",
1452 TRUE);
1453 reenable_input();
1454 say_status("Ready");
1455 return;
1456 }
1457 say_status("Correlating Variable(s)");
1458 simple_line_output("corr",string_one);
1459 begin_table_output(numb_corr, "Correlation Table");
1460 strcpy(string_one,"");
1461 for(i=0; i < NAME_LENGTH; i++)
1462 {
1463 strcat(string_one," ");
1464 }
1465 begin_column_output(string_one, XLDLAS_JUST_CENTER);
1466 for(i=0; i < numb_corr - 1; i++)
1467 {
1468 sprintf(string_one,"%*s",NAME_LENGTH, data_matrix[to_corr[i]].name);
1469 add_column_output(string_one, XLDLAS_JUST_CENTER);
1470 }
1471 end_column_output();
1472 seperator_output(numb_corr + 1);
1473 for(i = 1; i < numb_corr; i++)
1474 {
1475 sprintf(string_one,"%-*s", NAME_LENGTH, data_matrix[to_corr[i]].name);
1476 begin_column_output(string_one, XLDLAS_JUST_CENTER);
1477 for(j = 0; j < numb_corr - 1; j++)
1478 {
1479 if(i <= j)
1480 {
1481 strcpy(string_one,"");
1482 for(k=0; k < NAME_LENGTH; k++)
1483 {
1484 strcat(string_one," ");
1485 }
1486 add_column_output(string_one, XLDLAS_JUST_CENTER);
1487 }
1488 else
1489 {
1490 corr_obs = 0;
1491 for(k=all_start - 1; k < all_stop; k++)
1492 {
1493 if( *(fvector[to_corr[i]] + k) != missing_value
1494 && *(fvector[to_corr[j]] + k) != missing_value
1495 && k < data_matrix[to_corr[i]].obs
1496 && k < data_matrix[to_corr[j]].obs)
1497 {
1498 working[corr_obs] = *(fvector[to_corr[i]] + k);
1499 working_two[corr_obs] = *(fvector[to_corr[j]] + k);
1500 corr_obs++;
1501 }
1502 }
1503 if(corr_obs > 1)
1504 {
1505 sprintf(string_one,"%*f (%*f)",NAME_LENGTH / 2,pearsn_r(working, working_two, corr_obs), (NAME_LENGTH / 2)-3, pearsn_prob(working,working_two, corr_obs));
1506 }
1507 else
1508 {
1509 strcpy(string_one,"");
1510 for(k=0; k < NAME_LENGTH; k++)
1511 {
1512 strcat(string_one," ");
1513 }
1514 }
1515 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1516
1517 }
1518 }
1519 end_column_output();
1520 }
1521 end_table_output(numb_corr);
1522 reenable_input();
1523 say_status("Ready");
1524 }
1525
1526
start_corr_variables()1527 void start_corr_variables()
1528 {
1529 int i;
1530 int largest;
1531 inhibit_input();
1532 say_status("Waiting for Variable(s) Selection");
1533 fl_clear_browser(corr_browser);
1534 largest = 0;
1535 for(i=0; i < numb_variables; i++)
1536 {
1537 if(data_matrix[i].obs > largest) largest = data_matrix[i].obs;
1538 fl_addto_browser(corr_browser,data_matrix[i].name);
1539 }
1540
1541 fl_set_counter_value(corr_from_counter, 1);
1542 fl_set_counter_bounds(corr_from_counter, 1, largest);
1543 fl_set_counter_step(corr_from_counter, 1, 10);
1544
1545 fl_set_counter_value(corr_to_counter, largest);
1546 fl_set_counter_bounds(corr_to_counter, 1, largest);
1547 fl_set_counter_step(corr_to_counter, 1, 10);
1548
1549 fl_show_form(corr_window,FL_PLACE_FREE,FL_TRANSIENT,"Select Variable(s) for Corr");
1550 }
1551
1552
1553 /*
1554 Abort listing by closing the list browser window
1555 */
1556
click_abort_corr_variables(FL_FORM * form,void * arg)1557 int click_abort_corr_variables(FL_FORM *form, void *arg)
1558 {
1559 say_status("Ready");
1560 reenable_input();
1561 return(FL_OK);
1562 }
1563
1564 /*
1565 Abort regression by closing the list browser window
1566 */
1567
click_abort_regress_variables(FL_FORM * form,void * arg)1568 int click_abort_regress_variables(FL_FORM *form, void *arg)
1569 {
1570 window_geometry[XLDLAS_REGRESS][0] = form->x;
1571 window_geometry[XLDLAS_REGRESS][1] = form->y;
1572 window_geometry[XLDLAS_REGRESS][2] = form->w;
1573 window_geometry[XLDLAS_REGRESS][3] = form->h;
1574 say_status("Ready");
1575 reenable_input();
1576 return(FL_OK);
1577 }
1578
1579
calculate_regression(int depend,int independ[],int numb_independ,int start,int stop)1580 void calculate_regression(int depend, int independ[], int numb_independ, int start, int stop)
1581 {
1582 char string_one[XLDLASMAX_INPUT];
1583 char string_two[XLDLASMAX_INPUT];
1584 int escape, count, countt, counts;
1585 int numbvars;
1586 int length;
1587 int fit_type;
1588 int fitnumber, place;
1589 int variables[MAX_VARS];
1590 float coefs[MAX_VARS];
1591 float fitted[MAX_OBS];
1592 float theintercept;
1593 float ybar, xbar, sst, ssr, scratch, mse;
1594 double *bigmatrix;
1595 double *matrix;
1596 double running;
1597 int max, column;
1598 double temp1,temp2;
1599 escape = FALSE;
1600 numbvars = numb_independ + 1;
1601 length = (stop - start) + 1;
1602 theintercept = 0;
1603 fitnumber = -1;
1604 fit_type = 3;
1605 for(count=0; count < numb_independ; count++)
1606 {
1607 variables[count] = independ[count];
1608 }
1609 variables[count] = depend;
1610 if(length <= numbvars)
1611 {
1612 fl_show_alert("More Variables than Observations","","",TRUE);
1613 return;
1614 }
1615 if(length - numbvars - 1 <= 0)
1616 {
1617 fl_show_alert("Not Enough Observations for Number of Variables","","",TRUE);
1618 return;
1619 }
1620 say_status("Building Matrix... ");
1621 bigmatrix = (double *) malloc ((length * (numbvars + 1)) * sizeof (double));
1622 if(!bigmatrix)
1623 {
1624 fl_show_alert("Not Enough Memory to Build Regression Matrix","","",TRUE);
1625 return;
1626 }
1627 for(count = 0; count < length; count++)
1628 {
1629 *(bigmatrix + count) = 1;
1630 }
1631 for(count = 1; count <= numbvars; count++)
1632 {
1633 for(countt = 0; countt < length; countt++)
1634 {
1635 if((countt + start - 1) < data_matrix[variables[count - 1]].obs)
1636 {
1637 *(bigmatrix + countt + (count * length)) = *(fvector[variables[count - 1]] + countt + (start - 1));
1638 }
1639 else
1640 {
1641 *(bigmatrix + countt + (count * length)) = missing_value;
1642 }
1643 }
1644 }
1645 say_status("Zapping Missings...");
1646 for(count = 0; count < (length * (numbvars + 1)); count ++)
1647 {
1648 if(*(bigmatrix + count) == missing_value)
1649 {
1650 column = count % length;
1651 for(countt = numbvars; countt >= 0; countt--)
1652 {
1653 for(counts = (countt * length) + column; counts < (length * (numbvars + 1)) - 1; counts++)
1654 {
1655 *(bigmatrix + counts) = *(bigmatrix + counts + 1);
1656 }
1657 }
1658 count = 0;
1659 length--;
1660 if(length <= numbvars)
1661 {
1662 fl_show_alert("Not Enough Actual Observations in Data","","",TRUE);
1663 free(bigmatrix);
1664 return;
1665 }
1666 }
1667 }
1668 matrix = (double *) malloc ((numbvars * (numbvars + 1)) * sizeof (double));
1669 if(!matrix)
1670 {
1671 fl_show_alert("Not Enough Memory to Build Regression Sub-Matrix","","",TRUE);
1672 return;
1673 }
1674 say_status("Building System of Equations");
1675 for(count = 0; count < numbvars; count++)
1676 {
1677 for(countt = 0; countt <= numbvars; countt++)
1678 {
1679 running = 0;
1680 for(counts = 0; counts < length; counts++)
1681 {
1682 running = running + *(bigmatrix + counts + (count * length)) * *(bigmatrix + counts + (countt * length));
1683 }
1684 *(matrix + count + (countt * numbvars)) = running;
1685 }
1686 }
1687 say_status("Gauss Eliminating ... ");
1688 for(count = 0; count < numbvars; count++)
1689 {
1690 max = count;
1691 for(countt = count + 1; countt < numbvars; countt++)
1692 {
1693 temp1 = *(matrix + countt + (count * numbvars));
1694 temp2 = *(matrix + max + (count * numbvars));
1695 if(fabs(temp1) > fabs(temp2)) max = countt;
1696 for(counts = 0; counts <= numbvars; counts++)
1697 {
1698 running = *(matrix + count + (counts * numbvars));
1699 *(matrix + count + (counts * numbvars)) = *(matrix + max + (counts * numbvars));
1700 *(matrix + max + (counts * numbvars)) = running;
1701 }
1702 }
1703 for(countt = count + 1; countt < numbvars; countt++)
1704 {
1705 for(counts = numbvars; counts >= 0; counts--)
1706 {
1707 temp1 = *(matrix + count + (count * numbvars));
1708 if(temp1 == 0)
1709 {
1710 fl_show_alert("The Regression Matrix is Singular!","","",TRUE);
1711 return;
1712 }
1713 *(matrix + countt + (counts * numbvars)) = *(matrix + countt + (counts * numbvars)) - *(matrix + count + (counts * numbvars)) * *(matrix + countt + (count * numbvars)) / *(matrix + count + (count * numbvars));
1714 }
1715 }
1716 }
1717 say_status("Doing Substitions...");
1718 for(count = 0; count <= numbvars; count++)
1719 {
1720 coefs[count] = 0;
1721 }
1722 for(count = numbvars - 1; count >= 0; count--)
1723 {
1724 running = 0;
1725 for(countt = count + 1; countt <= numbvars; countt++)
1726 {
1727 running = running + *(matrix + count + (countt * numbvars)) * coefs[countt];
1728 temp1 = *(matrix + count + (count * numbvars));
1729 if(temp1 == 0)
1730 {
1731 fl_show_alert("The Reduced Regression Matrix is Singular!","","",TRUE);
1732 return;
1733 }
1734 coefs[count]= ( *(matrix + count + (numbvars * numbvars)) - running ) / *(matrix + count + (count * numbvars));
1735 }
1736 }
1737 theintercept = coefs[0];
1738 for(count = 0; count < MAX_OBS; count++)
1739 {
1740 working[count] = 0;
1741 }
1742 ybar = 0;
1743 for(count = 0; count < length; count++)
1744 {
1745 working[count] = *(bigmatrix + count + (numbvars * length));
1746 ybar = ybar + working[count];
1747 }
1748 scratch = length;
1749 ybar = ybar / scratch;
1750 sst = 0;
1751 for(count = 0; count < length; count++)
1752 {
1753 sst = sst + ((working[count] - ybar) * (working[count] - ybar));
1754 }
1755 for(count = 0; count < MAX_OBS; count++)
1756 {
1757 fitted[count] = 0;
1758 }
1759 for(count = 0; count < length; count++)
1760 {
1761 scratch = theintercept;
1762 for(countt = 1; countt < numbvars; countt++)
1763 {
1764 scratch = scratch + *(bigmatrix + count + (countt * length)) * coefs[countt];
1765 }
1766 fitted[count] = scratch;
1767 }
1768 ssr = 0;
1769 for(count = 0; count < length; count++)
1770 {
1771 ssr = ssr + ((fitted[count] - ybar) * (fitted[count] - ybar));
1772 }
1773 say_status("Displaying Regression Results");
1774 begin_table_output(2, "OLS Regression Results: Summary Statistics");
1775 begin_column_output(" Number of obs ", XLDLAS_JUST_CENTER);
1776 sprintf(string_one,"%i",length);
1777 add_column_output(string_one, XLDLAS_JUST_CENTER);
1778 end_column_output(2);
1779 sprintf(string_one," F(%4d,%4d) ",(numbvars - 1), length - numbvars);
1780 begin_column_output(string_one, XLDLAS_JUST_CENTER);
1781 sprintf(string_one,"%6.4f",((ssr/(numbvars - 1)) / ((sst - ssr) / (length - numbvars))));
1782 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1783 end_column_output(2);
1784
1785 sprintf(string_one," Prob(F) ");
1786 begin_column_output(string_one, XLDLAS_JUST_CENTER);
1787
1788 scratch = 1.0 - betai((length-numbvars) / 2.0, (numbvars - 1)/2.0, (length - numbvars) / ((length - numbvars) + ((numbvars - 1) * ((ssr/(numbvars - 1)) / ((sst - ssr) / (length - numbvars))))));
1789
1790 sprintf(string_one,"%6.4f",scratch);
1791 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1792 end_column_output(2);
1793
1794
1795 sprintf(string_one," R-square ");
1796 begin_column_output(string_one, XLDLAS_JUST_CENTER);
1797 sprintf(string_one,"%6.4f",ssr/sst);
1798 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1799 end_column_output(2);
1800 scratch = numbvars - 1;
1801 scratch = scratch / (length - 1);
1802 scratch = scratch * (1 - (ssr/sst));
1803
1804 sprintf(string_one," Adj R-square ");
1805 begin_column_output(string_one, XLDLAS_JUST_CENTER);
1806 sprintf(string_one,"%6.4f",(ssr/sst) - scratch);
1807 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1808 end_column_output(2);
1809
1810 sprintf(string_one," Root MSE ");
1811 begin_column_output(string_one, XLDLAS_JUST_CENTER);
1812 sprintf(string_one,"%6.4f", sqrt((sst - ssr) / (length - numbvars)));
1813 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1814 end_column_output(2);
1815 end_table_output(2);
1816
1817
1818 begin_table_output(4, "OLS Regression Results: Model SS vs. Residual SS");
1819 begin_column_output("Source ", XLDLAS_JUST_CENTER);
1820 add_column_output(" SS", XLDLAS_JUST_CENTER);
1821 add_column_output(" df", XLDLAS_JUST_CENTER);
1822 add_column_output(" MS", XLDLAS_JUST_CENTER);
1823 end_column_output();
1824 seperator_output(4);
1825
1826 begin_column_output("Model ", XLDLAS_JUST_CENTER);
1827 sprintf(string_one,"%14.3f", ssr);
1828 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1829 sprintf(string_one,"%14i", numbvars - 1);
1830 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1831 sprintf(string_one,"%14.3f", ssr / (numbvars - 1));
1832 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1833 end_column_output();
1834
1835 begin_column_output("Residual ", XLDLAS_JUST_CENTER);
1836 sprintf(string_one,"%14.3f", sst - ssr);
1837 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1838 sprintf(string_one,"%14i", length - numbvars);
1839 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1840 sprintf(string_one,"%14.3f", (sst - ssr) / (length - numbvars));
1841 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1842 end_column_output();
1843
1844 seperator_output(4);
1845
1846 begin_column_output("Total ", XLDLAS_JUST_CENTER);
1847 sprintf(string_one,"%14.3f", sst);
1848 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1849 sprintf(string_one,"%14i", length - 1);
1850 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1851 sprintf(string_one,"%14.3f", sst / (length - 1));
1852 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1853 end_column_output();
1854
1855 end_table_output(4);
1856
1857
1858 begin_table_output(6, "OLS Regression Results: Estimates of Coefficients");
1859
1860 strcpy(string_two,"Variable");
1861 sprintf(string_one,"%-*s",NAME_LENGTH,string_two);
1862 begin_column_output(string_one, XLDLAS_JUST_CENTER);
1863 add_column_output(" Coefficient", XLDLAS_JUST_CENTER);
1864 add_column_output(" Std. Error", XLDLAS_JUST_CENTER);
1865 add_column_output(" t", XLDLAS_JUST_CENTER);
1866 add_column_output(" Prob(t)", XLDLAS_JUST_CENTER);
1867 add_column_output(" Mean", XLDLAS_JUST_CENTER);
1868 end_column_output();
1869
1870 seperator_output(6);
1871
1872 sprintf(string_one,"%-*s",NAME_LENGTH,data_matrix[depend].name);
1873 begin_column_output(string_one, XLDLAS_JUST_CENTER);
1874 add_column_output(" ", XLDLAS_JUST_CENTER);
1875 add_column_output(" ", XLDLAS_JUST_CENTER);
1876 add_column_output(" ", XLDLAS_JUST_CENTER);
1877 add_column_output(" ", XLDLAS_JUST_CENTER);
1878 sprintf(string_one,"%14.3f", ybar);
1879 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1880 end_column_output();
1881
1882 seperator_output(6);
1883
1884 strcpy(string_two,"(intcpt)");
1885 sprintf(string_one,"%-*s",NAME_LENGTH,string_two);
1886 begin_column_output(string_one, XLDLAS_JUST_CENTER);
1887 sprintf(string_one,"%14.3f", coefs[0]);
1888 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1889 add_column_output(" ", XLDLAS_JUST_RIGHT);
1890 add_column_output(" ", XLDLAS_JUST_RIGHT);
1891 add_column_output(" ", XLDLAS_JUST_CENTER);
1892 add_column_output(" ", XLDLAS_JUST_RIGHT);
1893 end_column_output();
1894
1895 seperator_output(6);
1896
1897 mse = ((sst - ssr) / (length - numbvars));
1898
1899 for(count = 1; count < numbvars; count++)
1900 {
1901 scratch = 0;
1902 xbar = 0;
1903 for(countt = 0; countt < length; countt++)
1904 {
1905 working[countt] = *(bigmatrix + countt + (count * length));
1906 xbar = xbar + working[countt];
1907 }
1908 xbar = xbar / length;
1909 for(countt = 0; countt < length; countt++)
1910 {
1911 scratch = scratch + ((working[countt] - xbar) * (working[countt] - xbar));
1912 }
1913
1914 sprintf(string_one,"%-*s", NAME_LENGTH, data_matrix[variables[count - 1]].name);
1915 begin_column_output(string_one, XLDLAS_JUST_CENTER);
1916 sprintf(string_one,"%14.3f", coefs[count]);
1917 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1918 sprintf(string_one,"%14.3f", sqrt(mse/scratch));
1919 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1920 sprintf(string_one,"%14.3f", coefs[count] / (sqrt(mse/scratch)));
1921 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1922
1923 scratch = (length - numbvars - 1) / ((length - numbvars - 1) + pow(coefs[count] / (sqrt(mse/scratch)),2));
1924 scratch = 1.0 - betai((length - numbvars - 1)/2.0, 0.5, scratch);
1925
1926 sprintf(string_one,"%14.3f", scratch);
1927 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1928 sprintf(string_one,"%14.3f", xbar);
1929 add_column_output(string_one, XLDLAS_JUST_RIGHT);
1930 end_column_output();
1931 }
1932
1933 end_table_output(6);
1934
1935 free(matrix);
1936 free(bigmatrix);
1937
1938 strcpy(string_one, fl_get_input(fit_variable_input));
1939 if(strlen(string_one) > 0 && numb_variables == MAX_VARS && check_variable_name(string_one) == TRUE)
1940 {
1941 fl_show_alert("No Room to Add Fitted Variable","","",TRUE);
1942 }
1943 if(strlen(string_one) > 0 && numb_variables < MAX_VARS)
1944 {
1945 if(fl_get_button(fit_overwrite_button) == TRUE)
1946 {
1947 if(check_variable_name(string_one) == TRUE)
1948 {
1949 strcpy(data_matrix[numb_variables].name,string_one);
1950 strcpy(data_matrix[numb_variables].description,"Fitted Values from OLS Regression");
1951 fvector[numb_variables] = (float *) malloc (MAX_OBS * sizeof (float));
1952 fitnumber = numb_variables;
1953 numb_variables++;
1954 fit_type = 0;
1955 }
1956 else
1957 {
1958 for(count = 0; count < numb_variables; count++)
1959 {
1960 if(strcmp(data_matrix[count].name,string_one) == 0) fitnumber = count;
1961 }
1962 free(fvector[fitnumber]);
1963 fvector[fitnumber] = (float *) malloc (MAX_OBS * sizeof (float));
1964 fit_type = 1;
1965 }
1966 }
1967 else
1968 {
1969 if(check_variable_name(string_one) == FALSE)
1970 {
1971 fl_show_alert("Variable Name for Fitted Values Already Exists","","",TRUE);
1972 return;
1973 }
1974 strcpy(data_matrix[numb_variables].name,string_one);
1975 strcpy(data_matrix[numb_variables].description,"Fitted Values from OLS Regression");
1976 fvector[numb_variables] = (float *) malloc (MAX_OBS * sizeof (float));
1977 fitnumber = numb_variables;
1978 numb_variables++;
1979 fit_type = 0;
1980 }
1981 place = 0;
1982 for(count = 0; count < start - 1; count++)
1983 {
1984 *(fvector[fitnumber] + place) = missing_value;
1985 place++;
1986 }
1987 for(count = start - 1; count < stop; count++)
1988 {
1989 *(fvector[fitnumber] + place) = theintercept;
1990 for(countt = 1; countt < numbvars; countt++)
1991 {
1992 if(*(fvector[variables[countt - 1]] + count + (start - 1)) == missing_value || data_matrix[variables[countt - 1]].obs <= count + (start - 1))
1993 {
1994 countt = numbvars;
1995 *(fvector[fitnumber] + place) = missing_value;
1996 }
1997 else
1998 {
1999 *(fvector[fitnumber] + place) = *(fvector[fitnumber] + place) + (coefs[countt] * *(fvector[variables[countt - 1]] + count + (start - 1)));
2000 }
2001 }
2002 place++;
2003 }
2004 sprintf(string_one,"%d fitted observations stored in %s", place, data_matrix[fitnumber].name);
2005 simple_line_output("reg",string_one);
2006 oktoquit = FALSE;
2007 data_matrix[fitnumber].obs = place;
2008 sync_graph_browsers(fit_type);
2009 }
2010
2011 }
2012
2013
regress_variables(FL_OBJECT * obj,long arg)2014 void regress_variables(FL_OBJECT *obj, long arg)
2015 {
2016 int i, dependent;
2017 int independent[MAX_VARS];
2018 int numb_independent;
2019 char string_one[XLDLASMAX_INPUT];
2020 char string_two[XLDLASMAX_INPUT];
2021 say_status("Starting Regression ...");
2022 all_start = fl_get_counter_value(regress_from_counter);
2023 all_stop = fl_get_counter_value(regress_to_counter);
2024 if(all_stop < all_start)
2025 {
2026 fl_show_alert("From Value Greater than to Value!",
2027 "",
2028 "",
2029 TRUE);
2030 reenable_input();
2031 say_status("Ready");
2032 return;
2033 }
2034 strcpy(string_one, "OLS Regression Equation: ");
2035 dependent = fl_get_browser(regress1_browser) - 1;
2036 if(dependent < 0)
2037 {
2038 fl_show_alert("No Dependent Variable Selected!",
2039 "",
2040 "",
2041 TRUE);
2042 reenable_input();
2043 say_status("Ready");
2044 return;
2045 }
2046 sprintf(string_two,"%s = a ",data_matrix[dependent].name);
2047 strcat(string_one, string_two);
2048 numb_independent = 0;
2049 for(i = 0; i < numb_variables; i++)
2050 {
2051 if(fl_isselected_browser_line(regress2_browser, i+1) && i != dependent)
2052 {
2053 independent[numb_independent] = i;
2054 sprintf(string_two,"+ b%d * %s ", numb_independent + 1, data_matrix[i].name);
2055 strcat(string_one, string_two);
2056 numb_independent++;
2057 }
2058 }
2059 if(numb_independent == 0)
2060 {
2061 fl_show_alert("No Independent Variables Selected!",
2062 "",
2063 "",
2064 TRUE);
2065 reenable_input();
2066 say_status("Ready");
2067 return;
2068 }
2069 simple_line_output("reg",string_one);
2070 calculate_regression(dependent, independent, numb_independent, all_start, all_stop);
2071 say_status("Waiting for Variable Selection");
2072 }
2073
done_regress_variables(FL_OBJECT * obj,long arg)2074 void done_regress_variables(FL_OBJECT *obj, long arg)
2075 {
2076 window_geometry[XLDLAS_REGRESS][0] = obj->form->x;
2077 window_geometry[XLDLAS_REGRESS][1] = obj->form->y;
2078 window_geometry[XLDLAS_REGRESS][2] = obj->form->w;
2079 window_geometry[XLDLAS_REGRESS][3] = obj->form->h;
2080 fl_hide_form(regress_window);
2081 say_status("Ready");
2082 reenable_input();
2083 }
2084
2085
2086
start_regress_variables(FL_OBJECT * obj,long arg)2087 void start_regress_variables(FL_OBJECT *obj, long arg)
2088 {
2089 int i;
2090 int largest;
2091 inhibit_input();
2092 say_status("Waiting for Variable Selection");
2093 fl_clear_browser(regress1_browser);
2094 fl_clear_browser(regress2_browser);
2095 largest = 0;
2096 for(i=0; i < numb_variables; i++)
2097 {
2098 if(data_matrix[i].obs > largest) largest = data_matrix[i].obs;
2099 fl_addto_browser(regress1_browser,data_matrix[i].name);
2100 fl_addto_browser(regress2_browser,data_matrix[i].name);
2101 }
2102
2103 fl_set_counter_value(regress_from_counter, 1);
2104 fl_set_counter_bounds(regress_from_counter, 1, largest);
2105 fl_set_counter_step(regress_from_counter, 1, 10);
2106
2107 fl_set_counter_value(regress_to_counter, largest);
2108 fl_set_counter_bounds(regress_to_counter, 1, largest);
2109 fl_set_counter_step(regress_to_counter, 1, 10);
2110 if(window_geometry[XLDLAS_REGRESS][0] != -1)
2111 {
2112 fl_set_form_geometry(regress_window,
2113 window_geometry[XLDLAS_REGRESS][0],
2114 window_geometry[XLDLAS_REGRESS][1],
2115 window_geometry[XLDLAS_REGRESS][2],
2116 window_geometry[XLDLAS_REGRESS][3]);
2117 }
2118 fl_show_form(regress_window,FL_PLACE_FREE,FL_FULLBORDER,"Regression Analysis");
2119 }
2120
fit_gavariable(int tofit,int variables[],int numbvars,float intercept,int start,int stop)2121 void fit_gavariable(int tofit, int variables[], int numbvars, float intercept, int start, int stop)
2122 {
2123 int i, j, k;
2124 float scratch;
2125 int oktoprocess;
2126 for(i = 0; i < start-1; i++)
2127 {
2128 *(fvector[tofit] + i) = missing_value;
2129 }
2130 for(i = start - 1; i < stop; i++)
2131 {
2132 oktoprocess = TRUE;
2133 for(j = 0; j < numbvars; j++)
2134 {
2135 if(*(fvector[variables[j]] + i) == missing_value)
2136 oktoprocess = FALSE;
2137 }
2138 if(oktoprocess == TRUE)
2139 {
2140 scratch = intercept;
2141 for(j = 0; j < numbvars; j++)
2142 {
2143 for(k = 0; k < 4; k++)
2144 {
2145 scratch = scratch + ga_coefs[j][k] * pow(*(fvector[variables[j]] + i), ga_powers[j][k]);
2146 }
2147 }
2148 *(fvector[tofit] + i) = scratch;
2149 }
2150 else
2151 {
2152 *(fvector[tofit] + i) = missing_value;
2153 }
2154 }
2155 }
2156
calculate_sserrors(int dependent,int variables[],int numbvars,float intercept,int start,int stop)2157 double calculate_sserrors(int dependent, int variables[], int numbvars, float intercept, int start, int stop)
2158 {
2159 int i, j, k, count;
2160 float scratch;
2161 double errors;
2162 int oktoprocess;
2163 errors = 0.0;
2164 count = 0;
2165 for(i = start - 1; i < stop; i++)
2166 {
2167 oktoprocess = TRUE;
2168 if(*(fvector[dependent] + i) == missing_value)
2169 oktoprocess = FALSE;
2170 for(j = 0; j < numbvars; j++)
2171 {
2172 if(*(fvector[variables[j]] + i) == missing_value)
2173 oktoprocess = FALSE;
2174 }
2175 if(oktoprocess == TRUE)
2176 {
2177 scratch = intercept;
2178 for(j = 0; j < numbvars; j++)
2179 {
2180 for(k = 0; k < 4; k++)
2181 {
2182 scratch = scratch + ga_coefs[j][k] * pow(*(fvector[variables[j]] + i), ga_powers[j][k]);
2183 }
2184 }
2185 errors = errors + pow((scratch - *(fvector[dependent] + i)), 2);
2186 count++;
2187 }
2188 }
2189 errors = errors / count;
2190 return(errors);
2191 }
2192
draw_ga_chart(int winner,int loser,double values[],int how_many,int round,int total)2193 void draw_ga_chart(int winner, int loser, double values[], int how_many, int round, int total)
2194 {
2195 int i;
2196 char string_one[XLDLASMAX_INPUT];
2197 int colour[XLDLAS_MAX_GA_POOLSIZE];
2198 fl_freeze_form(ga_window);
2199 fl_clear_chart(ga_chart);
2200 for(i = 0; i < how_many; i++)
2201 {
2202 if(values[i] > 10 * values[winner])
2203 {
2204 values[i] = 10 * values[winner];
2205 colour[i] = FL_RED;
2206 }
2207 else
2208 {
2209 if( i == winner) colour[i] = FL_YELLOW;
2210 else colour[i] = FL_BLUE;
2211
2212 }
2213 }
2214 for(i = 0; i < how_many; i++)
2215 {
2216 if(i != how_many / 3 && i != (how_many / 3) * 2)
2217 {
2218 fl_add_chart_value(ga_chart, values[i], "", colour[i]);
2219 }
2220 else
2221 {
2222 if( i == how_many / 3)
2223 {
2224 sprintf(string_one,"%f", values[winner]);
2225 fl_add_chart_value(ga_chart, values[i], string_one, colour[i]);
2226 }
2227 if( i == (how_many / 3) * 2)
2228 {
2229 sprintf(string_one,"%d/%d", round+1, total);
2230 fl_add_chart_value(ga_chart, values[i], string_one, colour[i]);
2231 }
2232 }
2233 }
2234 fl_unfreeze_form(ga_window);
2235 }
2236
2237
run_ga(int dependent,int variables[],int numbvars,int ga_start,int ga_stop)2238 void run_ga(int dependent, int variables[], int numbvars, int ga_start, int ga_stop)
2239 {
2240 int i,j,k,l,m, length, rander, cross_one, cross_two,
2241 crosser, pstart, pstop, fitnumber, fit_type;
2242 float intercept, scratch;
2243 float ga_denom;
2244 int negative_exists[MAX_VARS];
2245 int changed[XLDLAS_MAX_GA_POOLSIZE];
2246 double ss_errors[XLDLAS_MAX_GA_POOLSIZE];
2247 double smallest, largest;
2248 int small_numb, large_numb;
2249 int *ga_pool[XLDLAS_MAX_GA_POOLSIZE];
2250 char string_one[XLDLASMAX_INPUT];
2251 char string_two[XLDLASMAX_INPUT];
2252 inhibit_ga_input();
2253 say_status("GA Fitting (this may take awhile ...)");
2254 fl_set_chart_maxnumb(ga_chart,ga_poolsize);
2255 ga_denom = 0;
2256 for(i = 0; i < ga_bitsize; i++)
2257 {
2258 ga_denom = ga_denom + pow(2,i);
2259 }
2260 for(i = 0; i < numbvars; i++)
2261 {
2262 negative_exists[i] = FALSE;
2263 for(j = ga_start - 1; j < ga_stop; j++)
2264 {
2265 if(*(fvector[variables[i]] + j) < 0.0)
2266 {
2267 negative_exists[i] = TRUE;
2268 j = ga_stop;
2269 }
2270 }
2271 }
2272 length = 1 + ga_bitsize + numbvars * (4 + 4 * (2 + 2 * ga_bitsize));
2273 for(i = 0; i < ga_poolsize; i++)
2274 {
2275 ga_pool[i] = (int *) malloc(length * sizeof (int));
2276 if(!ga_pool[i])
2277 {
2278 fl_show_alert("Not enough memory to build GA Pool","","",TRUE);
2279 return;
2280 }
2281 changed[i] = TRUE;
2282 for(j = 0; j < length; j++)
2283 {
2284 rander = rand() % 1000;
2285 if(rander < 500)
2286 {
2287 *(ga_pool[i] + j) = TRUE;
2288 }
2289 else
2290 {
2291 *(ga_pool[i] + j) = FALSE;
2292 }
2293 }
2294 }
2295 general_abort = FALSE;
2296 fl_show_form(abort_window,FL_PLACE_FREE,FL_FULLBORDER,"Abort GAFit");
2297 for(i = 0; i < ga_cycles; i++)
2298 {
2299 fl_check_forms();
2300 if(general_abort == TRUE)
2301 {
2302 general_abort = FALSE;
2303 for(j = 0; j < ga_poolsize; j++)
2304 {
2305 free(ga_pool[j]);
2306 }
2307 fl_clear_chart(ga_chart);
2308 reenable_ga_input();
2309 fl_hide_form(abort_window);
2310 sprintf(string_one,"GA Fit was aborted at cycle %d", i+1);
2311 simple_line_output("abort", string_one);
2312 return;
2313 }
2314 for(j = 0; j < ga_poolsize; j++)
2315 {
2316 if(changed[j] == TRUE)
2317 {
2318 intercept = 0;
2319 for(k = 1; k < 1 + ga_bitsize; k++)
2320 {
2321 if(*(ga_pool[j] + k) == TRUE)
2322 {
2323 intercept = intercept + pow(2,k-1);
2324 }
2325 }
2326 intercept = intercept / ga_denom;
2327 intercept = intercept * ga_maxreal;
2328 if(*(ga_pool[j]) == TRUE)
2329 {
2330 intercept = -1.0 * intercept;
2331 }
2332 for(k = 0; k < numbvars; k++)
2333 {
2334 for(l = 0; l < 4; l++)
2335 {
2336 if(*(ga_pool[j] + ga_bitsize + 1 + k * (4 + 4 * (ga_bitsize + 2)) + l) == TRUE || (ga_force == TRUE && l == 0))
2337 {
2338 ga_coefs[k][l] = 0.0;
2339 for(m = 0; m < ga_bitsize; m++)
2340 {
2341 if(*(ga_pool[j] + 1 + ga_bitsize + k * (4 + 4 * (ga_bitsize + 2)) + 4 + l * (2 * (ga_bitsize + 1)) + 1 + m) == TRUE)
2342 {
2343 ga_coefs[k][l] = ga_coefs[k][l] + pow(2,m);
2344 }
2345 }
2346 ga_coefs[k][l] = ga_coefs[k][l] / ga_denom;
2347 ga_coefs[k][l] = ga_coefs[k][l] * ga_maxreal;
2348 if(*(ga_pool[j] + 1 + ga_bitsize + k * (4 + 4 * ( ga_bitsize +2)) + 4 + l * ( 2 *(ga_bitsize+1))) == FALSE)
2349 {
2350 ga_coefs[k][l] = -1.0 * ga_coefs[k][l];
2351 }
2352 ga_powers[k][l] = 0.0;
2353 for(m = 0; m < ga_bitsize; m++)
2354 {
2355 if(*(ga_pool[j] + 1 + ga_bitsize + k * (4 + 4 * (ga_bitsize + 2)) + 4 + l * (2 * (ga_bitsize + 1)) + 1 + m + ga_bitsize + 1) == TRUE)
2356 {
2357 ga_powers[k][l] = ga_powers[k][l] + pow(2,m);
2358 }
2359 }
2360 ga_powers[k][l] = ga_powers[k][l] / ga_denom;
2361 ga_powers[k][l] = ga_powers[k][l] * 10.0;
2362 if(negative_exists[k] == TRUE)
2363 {
2364 ga_powers[k][l] = ((int) ga_powers[k][l]) + 1;
2365 }
2366 }
2367 else
2368 {
2369 ga_coefs[k][l] = 0.0;
2370 ga_powers[k][l] = 1.0;
2371 }
2372 }
2373 }
2374 ss_errors[j] = calculate_sserrors(dependent, variables, numbvars, intercept, ga_start, ga_stop);
2375 changed[j] = FALSE;
2376 }
2377 }
2378 smallest = ss_errors[0];
2379 small_numb = 0;
2380 for(j = 1; j < ga_poolsize; j++)
2381 {
2382 if(smallest > ss_errors[j])
2383 {
2384 smallest = ss_errors[j];
2385 small_numb = j;
2386 }
2387 }
2388 largest = ss_errors[0];
2389 large_numb = 0;
2390 for(j = 1; j < ga_poolsize; j++)
2391 {
2392 if(largest < ss_errors[j])
2393 {
2394 largest = ss_errors[j];
2395 large_numb = j;
2396 }
2397 }
2398 if( (i+1) % ga_update == 0 || i == 0 || i == ga_cycles - 1) draw_ga_chart(small_numb, large_numb, ss_errors, ga_poolsize, i, ga_cycles);
2399 for(j = 0; j < ga_swap; j++)
2400 {
2401 largest = ss_errors[0];
2402 large_numb = 0;
2403 for(k = 1; k < ga_poolsize; k++)
2404 {
2405 if(largest < ss_errors[k])
2406 {
2407 largest = ss_errors[k];
2408 large_numb = k;
2409 }
2410 }
2411 for(k = 0; k < length; k++)
2412 {
2413 *(ga_pool[large_numb] + k) = *(ga_pool[small_numb] + k);
2414 }
2415 ss_errors[large_numb] = ss_errors[small_numb];
2416 }
2417 if(smallest < ga_tolerance) i = ga_cycles - 1;
2418 if(i != ga_cycles - 1)
2419 {
2420 if(ga_cross_ok == TRUE)
2421 {
2422 for(j = 0; j < ga_poolsize; j++)
2423 {
2424 rander= rand() % ga_cross;
2425 if(rander < 1)
2426 {
2427 crosser = rand() % ga_poolsize;
2428 cross_one = rand() % length;
2429 cross_two = rand() % length;
2430 if(cross_two < cross_one)
2431 {
2432 rander = cross_one;
2433 cross_one = cross_two;
2434 cross_two = rander;
2435 }
2436 for(k = cross_one; k <= cross_two; k++)
2437 {
2438 rander = *(ga_pool[j] + k);
2439 *(ga_pool[j] + k) = *(ga_pool[crosser] + k);
2440 *(ga_pool[crosser] + k) = rander;
2441 }
2442 changed[j] = TRUE;
2443 changed[crosser] = TRUE;
2444 }
2445 }
2446 }
2447 if(ga_mutate_ok == TRUE)
2448 {
2449 for(j = 0; j < ga_poolsize; j++)
2450 {
2451 for(k = 0; k < length; k++)
2452 {
2453 rander = rand() % ga_mutate;
2454 if(rander < 1)
2455 {
2456 if(*(ga_pool[j] + k) == TRUE) *(ga_pool[j] + k) = FALSE;
2457 else *(ga_pool[j] + k) = TRUE;
2458 changed[j] = TRUE;
2459 }
2460 }
2461 }
2462 }
2463 if(ga_perturbe_ok == TRUE)
2464 {
2465 for(j = 0 ; j < ga_poolsize; j++)
2466 {
2467 for(k = 0; k < 1 + numbvars; k++)
2468 {
2469 rander = rand() % ga_perturbe;
2470 if(rander < 1)
2471 {
2472 if(k == 0)
2473 {
2474 pstart = 1;
2475 pstop = 1 + ga_bitsize;
2476 }
2477 else
2478 {
2479 pstart = 1 + ga_bitsize + ((k-1) * (4 + 2 * (ga_bitsize + 1))) + 4 + 1 + ((rand() % 2) * (ga_bitsize + 1));
2480 pstop = pstart + ga_bitsize;
2481 }
2482 scratch = 0;
2483 for(l = pstart; l < pstop; l++)
2484 {
2485 if(*(ga_pool[j] + l) == TRUE)
2486 {
2487 scratch = scratch + pow(2,l-pstart);
2488 }
2489 }
2490 rander = rand() % 1000;
2491 if(rander < 500) scratch = scratch + 1;
2492 else scratch = scratch - 1;
2493 if(scratch <= ga_denom && scratch >= 0)
2494 {
2495 for(l = pstop - 1; l >= pstart; l--)
2496 {
2497 if(scratch >= pow(2,l-pstart))
2498 {
2499 *(ga_pool[j]+l) = TRUE;
2500 scratch = scratch - pow(2,l-pstart);
2501 }
2502 else
2503 {
2504 *(ga_pool[j]+l) = FALSE;
2505 }
2506 }
2507 changed[j] = TRUE;
2508 }
2509 }
2510 }
2511 }
2512 }
2513 }
2514 }
2515 fl_hide_form(abort_window);
2516 smallest = ss_errors[0];
2517 small_numb = 0;
2518 for(j = 1; j < ga_poolsize; j++)
2519 {
2520 if(smallest > ss_errors[j])
2521 {
2522 smallest = ss_errors[j];
2523 small_numb = j;
2524 }
2525 }
2526 intercept = 0;
2527 for(k = 1; k < 1 + ga_bitsize; k++)
2528 {
2529 if(*(ga_pool[small_numb] + k) == TRUE)
2530 {
2531 intercept = intercept + pow(2,k-1);
2532 }
2533 }
2534 intercept = intercept / ga_denom;
2535 intercept = intercept * ga_maxreal;
2536 if(*(ga_pool[small_numb]) == TRUE)
2537 {
2538 intercept = -1.0 * intercept;
2539 }
2540 for(k = 0; k < numbvars; k++)
2541 {
2542 for(l = 0 ; l < 4; l++)
2543 {
2544 if(*(ga_pool[small_numb] + ga_bitsize + 1 + k * (4 + 4 * (ga_bitsize + 2)) + l) == TRUE || (ga_force == TRUE && l == 0))
2545 {
2546 ga_coefs[k][l] = 0.0;
2547 for(m = 0; m < ga_bitsize; m++)
2548 {
2549 if(*(ga_pool[small_numb] + 1 + ga_bitsize + k * (4 + 4 * (ga_bitsize + 2)) + 4 + l * (2 * (ga_bitsize + 1)) + 1 + m) == TRUE)
2550 {
2551 ga_coefs[k][l] = ga_coefs[k][l] + pow(2,m);
2552 }
2553 }
2554 ga_coefs[k][l] = ga_coefs[k][l] / ga_denom;
2555 ga_coefs[k][l] = ga_coefs[k][l] * ga_maxreal;
2556 if(*(ga_pool[small_numb] + 1 + ga_bitsize + k * (4 + 4 * ( ga_bitsize +2)) + 4 + l * ( 2 *(ga_bitsize+1))) == FALSE)
2557 {
2558 ga_coefs[k][l] = -1.0 * ga_coefs[k][l];
2559 }
2560 ga_powers[k][l] = 0.0;
2561 for(m = 0; m < ga_bitsize; m++)
2562 {
2563 if(*(ga_pool[small_numb] + 1 + ga_bitsize + k * (4 + 4 * (ga_bitsize + 2)) + 4 + l * (2 * (ga_bitsize + 1)) + 1 + m + ga_bitsize + 1) == TRUE)
2564 {
2565 ga_powers[k][l] = ga_powers[k][l] + pow(2,m);
2566 }
2567 }
2568 ga_powers[k][l] = ga_powers[k][l] / ga_denom;
2569 ga_powers[k][l] = ga_powers[k][l] * 10.0;
2570 if(negative_exists[k] == TRUE)
2571 {
2572 ga_powers[k][l] = ((int) ga_powers[k][l]) + 1;
2573 }
2574 }
2575 else
2576 {
2577 ga_coefs[k][l] = 0.0;
2578 ga_powers[k][l] = 1.0;
2579 }
2580 }
2581 }
2582 sprintf(string_one,"GA Fitted Equation: %s = a ",data_matrix[dependent].name);
2583 for(i = 0; i < numbvars; i++)
2584 {
2585 strcat(string_one,"+/- ");
2586 sprintf(string_two,"b%d * (%s)^p%d ",i, data_matrix[variables[i]].name, i);
2587 strcat(string_one,string_two);
2588 }
2589 simple_line_output("gafit",string_one);
2590
2591 begin_table_output(2, "GA Fit: Settings Used");
2592 begin_column_output("Cycles ", XLDLAS_JUST_CENTER);
2593 sprintf(string_one,"%d", ga_cycles);
2594 add_column_output(string_one, XLDLAS_JUST_CENTER);
2595 end_column_output();
2596 begin_column_output("Pool Size ", XLDLAS_JUST_CENTER);
2597 sprintf(string_one,"%d", ga_poolsize);
2598 add_column_output(string_one, XLDLAS_JUST_CENTER);
2599 end_column_output();
2600 if(ga_mutate_ok == TRUE)
2601 {
2602 begin_column_output("Mutation ", XLDLAS_JUST_CENTER);
2603 sprintf(string_one,"1/%d", ga_mutate);
2604 add_column_output(string_one, XLDLAS_JUST_CENTER);
2605 end_column_output();
2606 }
2607 if(ga_cross_ok == TRUE)
2608 {
2609 begin_column_output("Crossover ", XLDLAS_JUST_CENTER);
2610 sprintf(string_one,"1/%d", ga_cross);
2611 add_column_output(string_one, XLDLAS_JUST_CENTER);
2612 end_column_output();
2613 }
2614 if(ga_perturbe_ok == TRUE)
2615 {
2616 begin_column_output("Perturbation ", XLDLAS_JUST_CENTER);
2617 sprintf(string_one,"1/%d", ga_perturbe);
2618 add_column_output(string_one, XLDLAS_JUST_CENTER);
2619 end_column_output();
2620 }
2621 begin_column_output("Segment Length ", XLDLAS_JUST_CENTER);
2622 sprintf(string_one,"%d", ga_bitsize);
2623 add_column_output(string_one, XLDLAS_JUST_CENTER);
2624 end_column_output();
2625 begin_column_output("Maximum Real ", XLDLAS_JUST_CENTER);
2626 sprintf(string_one,"+/-%d", ga_maxreal);
2627 add_column_output(string_one, XLDLAS_JUST_CENTER);
2628 end_column_output();
2629 begin_column_output("Swapping ", XLDLAS_JUST_CENTER);
2630 sprintf(string_one,"%d", ga_swap);
2631 add_column_output(string_one, XLDLAS_JUST_CENTER);
2632 end_column_output();
2633 begin_column_output("Tolerance ", XLDLAS_JUST_CENTER);
2634 sprintf(string_one,"%d", ga_tolerance);
2635 add_column_output(string_one, XLDLAS_JUST_CENTER);
2636 end_column_output();
2637 begin_column_output("Observations ", XLDLAS_JUST_CENTER);
2638 sprintf(string_one,"%d - %d", ga_start, ga_stop);
2639 add_column_output(string_one, XLDLAS_JUST_CENTER);
2640 end_column_output();
2641 end_table_output(2);
2642
2643 begin_table_output(4, "GA Fit: Estimates");
2644 strcpy(string_one,"Name");
2645 for(i = strlen(string_one); i < NAME_LENGTH; i++)
2646 {
2647 strcat(string_one," ");
2648 }
2649 begin_column_output(string_one, XLDLAS_JUST_CENTER);
2650 add_column_output(" Opr ", XLDLAS_JUST_CENTER);
2651 add_column_output(" Coefficient", XLDLAS_JUST_CENTER);
2652 add_column_output(" Power", XLDLAS_JUST_CENTER);
2653 end_column_output();
2654 seperator_output(4);
2655
2656 sprintf(string_one,"%-*s", NAME_LENGTH, data_matrix[dependent].name);
2657 begin_column_output(string_one, XLDLAS_JUST_CENTER);
2658 add_column_output(" = ", XLDLAS_JUST_CENTER);
2659 add_column_output(" ", XLDLAS_JUST_CENTER);
2660 add_column_output(" ", XLDLAS_JUST_CENTER);
2661 end_column_output();
2662 seperator_output(4);
2663
2664 strcpy(string_one,"(intrcpt)");
2665 for(i =strlen(string_one); i < NAME_LENGTH; i++)
2666 {
2667 strcat(string_one," ");
2668 }
2669 begin_column_output(string_one, XLDLAS_JUST_CENTER);
2670 add_column_output(" ", XLDLAS_JUST_CENTER);
2671 sprintf(string_one,"%15f",intercept);
2672 add_column_output(string_one, XLDLAS_JUST_RIGHT);
2673 add_column_output(" ", XLDLAS_JUST_CENTER);
2674 end_column_output();
2675 seperator_output(4);
2676 for(i = 0; i < numbvars; i++)
2677 {
2678 for(j = 0; j < 4; j++)
2679 {
2680 if(ga_coefs[i][j] != 0.0)
2681 {
2682 sprintf(string_one,"%-*s", NAME_LENGTH, data_matrix[variables[i]].name);
2683 begin_column_output(string_one, XLDLAS_JUST_CENTER);
2684 if(ga_coefs[i][j] > 0.0)
2685 {
2686 add_column_output(" + ", XLDLAS_JUST_CENTER);
2687 sprintf(string_one,"%15f", ga_coefs[i][j]);
2688 }
2689 else
2690 {
2691 add_column_output(" - ", XLDLAS_JUST_CENTER);
2692 sprintf(string_one,"%15f", -1.0 * ga_coefs[i][j]);
2693 }
2694 add_column_output(string_one, XLDLAS_JUST_RIGHT);
2695 sprintf(string_one,"%15f", ga_powers[i][j]);
2696 add_column_output(string_one, XLDLAS_JUST_RIGHT);
2697 end_column_output();
2698 }
2699 }
2700 }
2701 end_table_output(4);
2702
2703 strcpy(string_one,fl_get_input(ga_save_input));
2704 fitnumber = -1;
2705 fit_type = 3;
2706 if(strlen(string_one) > 0)
2707 {
2708 if(check_variable_name(string_one) == TRUE && numb_variables != MAX_VARS)
2709 {
2710 strcpy(data_matrix[numb_variables].name,string_one);
2711 strcpy(data_matrix[numb_variables].description,"Fitted Values from GA Fit");
2712 data_matrix[numb_variables].obs = ga_stop;
2713 fitnumber = numb_variables;
2714 fvector[fitnumber] = (float *) malloc (MAX_OBS * sizeof (float));
2715 numb_variables++;
2716 fit_type = 0;
2717 }
2718 if(check_variable_name(string_one) == TRUE && numb_variables == MAX_VARS)
2719 {
2720 fl_show_alert("No Room to Add Fitted Variables","","",TRUE);
2721 }
2722 if(fitnumber == -1 && check_variable_name(string_one) == FALSE && fl_get_button(ga_overwrite_button) == TRUE)
2723 {
2724 for(i = 0; i < numb_variables; i++)
2725 {
2726 if(strcmp(data_matrix[i].name,string_one) == 0)
2727 {
2728 fitnumber = i;
2729 data_matrix[i].obs = ga_stop;
2730 }
2731 }
2732 fit_type = 1;
2733 }
2734 if(fitnumber == -1 && check_variable_name(string_one) == FALSE && fl_get_button(ga_overwrite_button) == FALSE)
2735 {
2736 #ifdef XFORMS86
2737 i = fl_show_choice("Name for Fitted Variable Exists", "Should I overwrite it's current values?", "", 3,
2738 "Yes","No", "Cancel",1);
2739 #else
2740 i = fl_show_choice("Name for Fitted Variable Exists", "Should I overwrite it's current values?", "", 3,
2741 "Yes","No", "Cancel");
2742 #endif
2743 if( i == 1)
2744 {
2745 for(j = 0; j < numb_variables; j++)
2746 {
2747 if(strcmp(data_matrix[j].name,string_one) == 0)
2748 {
2749 fitnumber = j;
2750 data_matrix[i].obs = ga_stop;
2751 }
2752 }
2753 fit_type = 1;
2754 }
2755
2756 }
2757 }
2758 if(fitnumber != -1)
2759 {
2760 fit_gavariable(fitnumber, variables, numbvars, intercept, ga_start, ga_stop);
2761 sprintf(string_one,"%d observations fitted to %s", ga_stop - (ga_start - 1), data_matrix[fitnumber].name);
2762 simple_line_output("gafit",string_one);
2763 oktoquit = FALSE;
2764 sync_graph_browsers(fit_type);
2765 }
2766 for(i = 0; i < ga_poolsize; i++)
2767 {
2768 free(ga_pool[i]);
2769 }
2770 reenable_ga_input();
2771 say_status("Waiting for GA variables");
2772 }
2773
2774
launch_ga(FL_OBJECT * obj,long arg)2775 void launch_ga(FL_OBJECT *obj, long arg)
2776 {
2777 int i, dep;
2778 int indeps[MAX_VARS];
2779 int numbindeps;
2780 numbindeps = 0;
2781 dep = -1;
2782 for(i = 0; i < numb_variables; i++)
2783 {
2784 if(fl_isselected_browser_line(ga_yvar_browser, i+1))
2785 {
2786 dep = i;
2787 i = numb_variables;
2788 }
2789 }
2790 if(dep == -1)
2791 {
2792 fl_show_alert("No Dependent Variable Selected!","","",TRUE);
2793 return;
2794 }
2795 if(all_stop > data_matrix[dep].obs) all_stop = data_matrix[dep].obs;
2796 if(all_stop < all_start)
2797 {
2798 fl_show_alert("From Value Greater than to Value!",
2799 "(or at least it is after to was adjusted to the dependent",
2800 "variables number of observations)",
2801 TRUE);
2802 return;
2803 }
2804 for(i = 0; i < numb_variables; i++)
2805 {
2806 if(fl_isselected_browser_line(ga_xvars_browser, i+1) && i != dep)
2807 {
2808 indeps[numbindeps] = i;
2809 numbindeps++;
2810 }
2811 }
2812 if(numbindeps == 0)
2813 {
2814 fl_show_alert("No Independent Variable(s) Selected!","","",TRUE);
2815 return;
2816 }
2817 run_ga(dep, indeps, numbindeps, all_start, all_stop);
2818 }
2819
2820
start_gafit()2821 void start_gafit()
2822 {
2823 int i;
2824 int largest;
2825 inhibit_input();
2826 say_status("Waiting for GA Values");
2827 largest = 0;
2828 fl_clear_browser(ga_xvars_browser);
2829 fl_clear_browser(ga_yvar_browser);
2830 for(i=0; i < numb_variables; i++)
2831 {
2832 if(data_matrix[i].obs > largest) largest = data_matrix[i].obs;
2833 fl_addto_browser(ga_xvars_browser,data_matrix[i].name);
2834 fl_addto_browser(ga_yvar_browser,data_matrix[i].name);
2835 }
2836 fl_set_counter_value(ga_from_counter, 1);
2837 fl_set_counter_bounds(ga_from_counter, 1, largest);
2838 fl_set_counter_step(ga_from_counter, 1, 10);
2839 all_start = 1;
2840 fl_clear_chart(ga_chart);
2841
2842 fl_set_counter_value(ga_to_counter, largest);
2843 fl_set_counter_bounds(ga_to_counter, 1, largest);
2844 fl_set_counter_step(ga_to_counter, 1, 10);
2845 all_stop = largest;
2846
2847 fl_set_counter_value(ga_cycles_counter, ga_cycles);
2848 fl_set_counter_bounds(ga_cycles_counter, 1, XLDLAS_MAX_GA_CYCLES);
2849 fl_set_counter_step(ga_cycles_counter, 1, 10);
2850
2851 fl_set_counter_value(ga_update_counter, ga_update);
2852 fl_set_counter_bounds(ga_update_counter, 1, XLDLAS_MAX_GA_CYCLES);
2853 fl_set_counter_step(ga_update_counter, 1, 10);
2854
2855 fl_set_counter_value(ga_mutate_counter, ga_mutate);
2856 fl_set_counter_bounds(ga_mutate_counter, 1, XLDLAS_MAX_GA_CYCLES);
2857 fl_set_counter_step(ga_mutate_counter, 1, 10);
2858
2859 fl_set_counter_value(ga_maxreal_counter, ga_maxreal);
2860 fl_set_counter_bounds(ga_maxreal_counter, 1, XLDLAS_GA_MAXREAL);
2861 fl_set_counter_step(ga_maxreal_counter, 1, 10);
2862
2863 fl_set_counter_value(ga_poolsize_counter, ga_poolsize);
2864 fl_set_counter_bounds(ga_poolsize_counter, 1, XLDLAS_MAX_GA_POOLSIZE);
2865 fl_set_counter_step(ga_poolsize_counter, 1, 10);
2866
2867 fl_set_counter_value(ga_bitsize_counter, ga_bitsize);
2868 fl_set_counter_bounds(ga_bitsize_counter, 1, XLDLAS_MAX_GA_BITSIZE);
2869 fl_set_counter_step(ga_bitsize_counter, 1, 10);
2870
2871 fl_set_counter_value(ga_swap_counter, ga_swap);
2872 fl_set_counter_bounds(ga_swap_counter, 1, XLDLAS_MAX_GA_POOLSIZE);
2873 fl_set_counter_step(ga_swap_counter, 1, 10);
2874
2875 fl_set_counter_value(ga_cross_counter, ga_cross);
2876 fl_set_counter_bounds(ga_cross_counter, 1, XLDLAS_MAX_GA_CYCLES);
2877 fl_set_counter_step(ga_cross_counter, 1, 10);
2878
2879 fl_set_counter_value(ga_perturbe_counter, ga_perturbe);
2880 fl_set_counter_bounds(ga_perturbe_counter, 1, XLDLAS_MAX_GA_CYCLES);
2881 fl_set_counter_step(ga_perturbe_counter, 1, 10);
2882
2883 fl_set_counter_value(ga_tolerance_counter, ga_tolerance);
2884 fl_set_counter_bounds(ga_tolerance_counter, 0, XLDLAS_GA_MAXREAL);
2885 fl_set_counter_step(ga_tolerance_counter, 1, 10);
2886
2887 if(ga_force == TRUE) fl_set_button(ga_force_button,1);
2888 else fl_set_button(ga_force_button, 0);
2889
2890 if(ga_mutate_ok == TRUE) fl_set_button(ga_mutate_button,1);
2891 else fl_set_button(ga_mutate_button, 0);
2892
2893 if(ga_cross_ok == TRUE) fl_set_button(ga_cross_button,1);
2894 else fl_set_button(ga_cross_button, 0);
2895
2896 if(ga_perturbe_ok == TRUE) fl_set_button(ga_perturbe_button,1);
2897 else fl_set_button(ga_perturbe_button, 0);
2898 if(window_geometry[XLDLAS_GAFIT][0] != -1)
2899 {
2900 fl_set_form_geometry(ga_window,
2901 window_geometry[XLDLAS_GAFIT][0],
2902 window_geometry[XLDLAS_GAFIT][1],
2903 window_geometry[XLDLAS_GAFIT][2],
2904 window_geometry[XLDLAS_GAFIT][3]);
2905 }
2906
2907 fl_show_form(ga_window,FL_PLACE_FREE,FL_FULLBORDER,"Fit Data Using a Genetic Algorithm");
2908 }
2909
2910
do_twoway_anova()2911 void do_twoway_anova()
2912 {
2913 float smallest, largest;
2914 char string_one[XLDLASMAX_INPUT];
2915 char string_two[XLDLASMAX_INPUT];
2916 int to_anova[MAX_VARS];
2917 int numb_anova, i,j,k;
2918 int block_variable;
2919 int block_categories;
2920 float block_boundary_step;
2921 float group_means[MAX_VARS];
2922 int group_obs[MAX_VARS];
2923 float block_means[MAX_VARS];
2924 int block_obs[MAX_VARS];
2925 float cell_means[MAX_VARS][MAX_VARS];
2926 int cell_obs[MAX_VARS][MAX_VARS];
2927 float overall_mean;
2928 int total_obs;
2929 float ssg, ssb, sse, sst, ssi;
2930 float mean_ss_one, mean_ss_two;
2931 int df_one, df_two;
2932 say_status("Doing Two Way ANOVA");
2933 all_start = fl_get_counter_value(anova_from_counter);
2934 all_stop = fl_get_counter_value(anova_to_counter);
2935 if(all_stop < all_start)
2936 {
2937 fl_show_alert("From Value Great than To Value","","",TRUE);
2938 return;
2939 }
2940 numb_anova = 0;
2941 strcpy(string_one,"Two Way ANOVA on: ");
2942 block_variable = -1;
2943 for(i = 0; i < numb_variables; i++)
2944 {
2945 if(fl_isselected_browser_line(anova_block_browser, i+1))
2946 {
2947 block_variable = i;
2948 i = numb_variables;
2949 }
2950
2951 }
2952 if(block_variable == -1)
2953 {
2954 fl_show_alert("No Block Variable Selected for Two Way Anova","","",TRUE);
2955 return;
2956 }
2957 for(i = 0; i < numb_variables; i++)
2958 {
2959 if(fl_isselected_browser_line(anova_variable_browser, i+1) && i != block_variable)
2960 {
2961 to_anova[numb_anova] = i;
2962 numb_anova++;
2963 strcat(string_one,data_matrix[i].name);
2964 strcat(string_one, " ");
2965 }
2966
2967 }
2968 if(numb_anova == 0)
2969 {
2970 fl_show_alert("No variables Selected","","",TRUE);
2971 return;
2972 }
2973 if(numb_anova == 1)
2974 {
2975 fl_show_alert("ANOVA Requires at Least Two Variables","","",TRUE);
2976 return;
2977 }
2978 block_categories = fl_get_counter_value(anova_block_counter);
2979 sprintf(string_two," ( Block is %s, %d categories) ", data_matrix[block_variable].name, block_categories);
2980 strcat(string_one,string_two);
2981
2982 if(all_start > data_matrix[block_variable].obs)
2983 {
2984 fl_show_alert("No Block Variable Observations in Range","","",TRUE);
2985 return;
2986 }
2987
2988 smallest = *(fvector[block_variable] + all_start - 1);
2989 largest = *(fvector[block_variable] + all_start - 1);
2990 for(i = all_start - 1; i < all_stop; i++)
2991 {
2992 if(*(fvector[block_variable] + i) != missing_value && i < data_matrix[block_variable].obs)
2993 {
2994 if(smallest == missing_value || smallest > *(fvector[block_variable] + i))
2995 {
2996 smallest = *(fvector[block_variable] + i);
2997 }
2998 if(largest == missing_value || largest < *(fvector[block_variable] + i))
2999 {
3000 largest = *(fvector[block_variable] + i);
3001 }
3002 }
3003 }
3004 if(smallest == missing_value || largest == missing_value)
3005 {
3006 fl_show_alert("No observations for Block Variable in Boundaries","","",TRUE);
3007 return;
3008 }
3009 if(smallest == largest)
3010 {
3011 fl_show_alert("No variation in Block Variable","Just do One Way Anova?","",TRUE);
3012 return;
3013 }
3014 block_boundary_step = (largest - smallest) / block_categories;
3015 simple_line_output("anova", string_one);
3016
3017 begin_table_output(2, "Block Boundaries");
3018 begin_column_output("Category",XLDLAS_JUST_CENTER);
3019 add_column_output(" Bounds ", XLDLAS_JUST_CENTER);
3020 end_column_output();
3021
3022 seperator_output(2);
3023
3024 for(i = 0; i < block_categories; i++)
3025 {
3026 sprintf(string_two,"%8d", i+1);
3027 begin_column_output(string_two, XLDLAS_JUST_CENTER);
3028 sprintf(string_two,"%14.3f to %-14.3f", smallest + (i * block_boundary_step), smallest + ((i+1) * block_boundary_step));
3029 add_column_output(string_two, XLDLAS_JUST_CENTER);
3030 end_column_output();
3031 block_means[i] = 0.0;
3032 block_obs[i] = 0;
3033 for(j = 0; j < block_categories; j++)
3034 {
3035 cell_means[i][j] = 0.0;
3036 cell_obs[i][j] = 0;
3037 }
3038 }
3039 end_table_output(2);
3040
3041
3042 for(i = 0 ; i < numb_anova; i++)
3043 {
3044 group_means[i] = 0;
3045 group_obs[i] = 0;
3046 for(j = all_start - 1; j < all_stop; j++)
3047 {
3048 if(j < data_matrix[to_anova[i]].obs && *(fvector[to_anova[i]] + j) != missing_value && *(fvector[block_variable] + j) != missing_value)
3049 {
3050 group_means[i] = group_means[i] + *(fvector[to_anova[i]] + j);
3051 group_obs[i]++;
3052 for(k = 0; k < block_categories; k++)
3053 {
3054 if(*(fvector[block_variable] + j) == largest)
3055 {
3056 block_means[block_categories - 1] = block_means[block_categories - 1] + *(fvector[to_anova[i]] + j);
3057 block_obs[block_categories - 1]++;
3058 cell_means[i][block_categories - 1] = cell_means[i][block_categories - 1] + *(fvector[to_anova[i]] + j);
3059 cell_obs[i][block_categories - 1]++;
3060 k = block_categories;
3061 }
3062 else
3063 {
3064 if(*(fvector[block_variable] + j) >= smallest + (k * block_boundary_step) && *(fvector[block_variable] + j) < smallest + ((k + 1) * block_boundary_step))
3065 {
3066 block_means[k] = block_means[k] + *(fvector[to_anova[i]] + j);
3067 block_obs[k]++;
3068 cell_means[i][k] = cell_means[i][k] + *(fvector[to_anova[i]] + j);
3069 cell_obs[i][k]++;
3070 k = block_categories;
3071 }
3072 }
3073 }
3074 }
3075 }
3076 if(group_obs[i] == 0)
3077 {
3078 fl_show_alert("No observations in the Following Variable", data_matrix[to_anova[i]].name, "", TRUE);
3079 return;
3080 }
3081 group_means[i] = group_means[i] / group_obs[i];
3082 }
3083 overall_mean = 0;
3084 total_obs = 0;
3085 for(i = 0; i < block_categories; i++)
3086 {
3087 if(block_obs[i] == 0)
3088 {
3089 sprintf(string_two,"%d", i+1);
3090 fl_show_alert("No Observations in the following category of Block Variable", string_two, "", TRUE);
3091 return;
3092 }
3093 else
3094 {
3095 overall_mean = overall_mean + block_means[i];
3096 block_means[i] = block_means[i] / block_obs[i];
3097 total_obs = total_obs + block_obs[i];
3098 }
3099 }
3100 overall_mean = overall_mean / total_obs;
3101 ssg = 0;
3102 ssb = 0;
3103 sst = 0;
3104 ssi = 0;
3105 for(i = 0 ; i < numb_anova; i++)
3106 {
3107 for(j = all_start - 1; j < all_stop; j++)
3108 {
3109 if(j < data_matrix[to_anova[i]].obs && *(fvector[to_anova[i]] + j) != missing_value && *(fvector[block_variable] + j) != missing_value)
3110 {
3111 sst = sst + pow(*(fvector[to_anova[i]] + j) - overall_mean, 2);
3112 }
3113 }
3114 for(j = 0; j < block_categories; j++)
3115 {
3116 cell_means[i][j] = cell_means[i][j] / cell_obs[i][j];
3117 }
3118 }
3119
3120 for(i = 0; i < numb_anova; i++)
3121 {
3122 ssg = ssg + group_obs[i] * pow(group_means[i] - overall_mean, 2);
3123 }
3124
3125 for(i = 0; i < block_categories; i++)
3126 {
3127 ssb = ssb + block_obs[i] * pow(block_means[i] - overall_mean, 2);
3128 }
3129
3130 if(cell_obs[0][0] == 1)
3131 {
3132 sse = sst - ssg - ssb;
3133 say_status("Displaying ANOVA Table");
3134 begin_table_output(6, "Two Way ANOVA (1 observation per cell)");
3135 begin_column_output(" Source of ", XLDLAS_JUST_CENTER);
3136 add_column_output( " Sums of", XLDLAS_JUST_CENTER);
3137 add_column_output( " Degrees of", XLDLAS_JUST_CENTER);
3138 add_column_output( " Mean", XLDLAS_JUST_CENTER);
3139 add_column_output( " ", XLDLAS_JUST_CENTER);
3140 add_column_output( " ", XLDLAS_JUST_CENTER);
3141 end_column_output();
3142
3143 begin_column_output(" Variation ", XLDLAS_JUST_CENTER);
3144 add_column_output( " Squares", XLDLAS_JUST_CENTER);
3145 add_column_output( " Freedom", XLDLAS_JUST_CENTER);
3146 add_column_output( " Squares", XLDLAS_JUST_CENTER);
3147 add_column_output( " F Ratio", XLDLAS_JUST_CENTER);
3148 add_column_output( " Prob(F)", XLDLAS_JUST_CENTER);
3149 end_column_output();
3150
3151 seperator_output(6);
3152
3153 begin_column_output(" Between Groups ", XLDLAS_JUST_RIGHT);
3154 sprintf(string_one,"%14.3f", ssg);
3155 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3156 sprintf(string_one,"%14d", numb_anova - 1);
3157 add_column_output(string_one, XLDLAS_JUST_CENTER);
3158 sprintf(string_one,"%14.3f", ssg / (numb_anova - 1));
3159 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3160 sprintf(string_one,"%14.3f", (ssg / (numb_anova - 1)) / (sse / ((numb_anova - 1) *(block_categories - 1))));
3161 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3162 sprintf(string_one,"%14.3f", 1.0 - betai(((block_categories - 1) * (numb_anova - 1)) / 2.0,
3163 (numb_anova - 1) / 2.0 ,
3164 ((block_categories - 1) * (numb_anova - 1)) / ( ((block_categories - 1) * (numb_anova - 1)) + ((numb_anova - 1) * ((ssg / (numb_anova - 1)) / (sse / ((numb_anova - 1) *(block_categories - 1))))))));
3165 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3166 end_column_output();
3167
3168 begin_column_output(" Between Blocks ", XLDLAS_JUST_RIGHT);
3169 sprintf(string_one,"%14.3f", ssb);
3170 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3171 sprintf(string_one,"%14d", block_categories - 1);
3172 add_column_output(string_one, XLDLAS_JUST_CENTER);
3173 sprintf(string_one,"%14.3f", ssb / (block_categories - 1));
3174 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3175 sprintf(string_one,"%14.3f", (ssb / (block_categories - 1)) / (sse / ((numb_anova - 1) *(block_categories - 1))));
3176 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3177 sprintf(string_one,"%14.3f", 1.0 - betai(((block_categories - 1) * (numb_anova - 1)) / 2.0,
3178 (block_categories - 1) / 2.0 ,
3179 ((block_categories - 1) * (numb_anova - 1)) / ( ((block_categories - 1) * (numb_anova - 1)) + ((block_categories - 1) * ((ssb / (block_categories - 1)) / (sse / ((numb_anova - 1) *(block_categories - 1))))))));
3180 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3181 end_column_output();
3182
3183 begin_column_output(" Error ", XLDLAS_JUST_RIGHT);
3184 sprintf(string_one,"%14.3f", sse);
3185 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3186 sprintf(string_one,"%14d", (block_categories - 1) * (numb_anova - 1));
3187 add_column_output(string_one, XLDLAS_JUST_CENTER);
3188 sprintf(string_one,"%14.3f", sse / ((block_categories - 1) * (numb_anova - 1)));
3189 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3190 add_column_output( " ", XLDLAS_JUST_RIGHT);
3191 add_column_output( " ", XLDLAS_JUST_RIGHT);
3192 end_column_output();
3193
3194
3195 seperator_output(6);
3196
3197 begin_column_output(" Total ", XLDLAS_JUST_RIGHT);
3198 sprintf(string_one,"%14.3f", sst);
3199 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3200 sprintf(string_one,"%14d", total_obs - 1);
3201 add_column_output(string_one, XLDLAS_JUST_CENTER);
3202 add_column_output( " ", XLDLAS_JUST_RIGHT);
3203 add_column_output( " ", XLDLAS_JUST_RIGHT);
3204 add_column_output( " ", XLDLAS_JUST_RIGHT);
3205 end_column_output();
3206
3207 end_table_output(6);
3208 }
3209 else
3210 {
3211 ssi = 0;
3212 for(i = 0; i < numb_anova; i++)
3213 {
3214 for(j = 0; j < block_categories; j++)
3215 {
3216 ssi = ssi + cell_obs[i][j] * pow(cell_means[i][j] - group_means[i] - block_means[j] + overall_mean,2);
3217 }
3218 }
3219 sse = sst - ssg - ssb - ssi;
3220 say_status("Displaying ANOVA Table");
3221 begin_table_output(6, "Two Way ANOVA (Multiple observations per cell)");
3222 begin_column_output(" Source of ", XLDLAS_JUST_CENTER);
3223 add_column_output( " Sums of", XLDLAS_JUST_CENTER);
3224 add_column_output( " Degrees of", XLDLAS_JUST_CENTER);
3225 add_column_output( " Mean", XLDLAS_JUST_CENTER);
3226 add_column_output( " ", XLDLAS_JUST_CENTER);
3227 add_column_output( " ", XLDLAS_JUST_CENTER);
3228 end_column_output();
3229
3230 begin_column_output(" Variation ", XLDLAS_JUST_CENTER);
3231 add_column_output( " Squares", XLDLAS_JUST_CENTER);
3232 add_column_output( " Freedom", XLDLAS_JUST_CENTER);
3233 add_column_output( " Squares", XLDLAS_JUST_CENTER);
3234 add_column_output( " F Ratio", XLDLAS_JUST_CENTER);
3235 add_column_output( " Prob(F)", XLDLAS_JUST_CENTER);
3236 end_column_output();
3237
3238 seperator_output(6);
3239
3240 df_one = numb_anova - 1;
3241 df_two = numb_anova * block_categories * (cell_obs[0][0] - 1);
3242 mean_ss_one = ssg / df_one;
3243 mean_ss_two = sse / df_two;
3244 begin_column_output(" Between Groups ", XLDLAS_JUST_RIGHT);
3245 sprintf(string_one,"%14.3f", ssg);
3246 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3247 sprintf(string_one,"%14d", df_one);
3248 add_column_output(string_one, XLDLAS_JUST_CENTER);
3249 sprintf(string_one,"%14.3f", mean_ss_one);
3250 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3251 sprintf(string_one,"%14.3f", mean_ss_one / mean_ss_two);
3252 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3253 sprintf(string_one,"%14.3f", 1.0 - betai(df_two/2.0, df_one/2.0, df_two/(df_two+(df_one * (mean_ss_one/mean_ss_two)))));
3254 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3255 end_column_output();
3256
3257 df_one = block_categories - 1;
3258 mean_ss_one = ssb / df_one;
3259 begin_column_output(" Between Blocks ", XLDLAS_JUST_RIGHT);
3260 sprintf(string_one,"%14.3f", ssb);
3261 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3262 sprintf(string_one,"%14d", df_one);
3263 add_column_output(string_one, XLDLAS_JUST_CENTER);
3264 sprintf(string_one,"%14.3f", mean_ss_one);
3265 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3266 sprintf(string_one,"%14.3f", mean_ss_one / mean_ss_two);
3267 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3268 sprintf(string_one,"%14.3f", 1.0 - betai(df_two/2.0, df_one/2.0, df_two/(df_two+(df_one * (mean_ss_one/mean_ss_two)))));
3269 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3270 end_column_output();
3271
3272 df_one = (block_categories - 1) * (numb_anova - 1);
3273 mean_ss_one = ssi / df_one;
3274 begin_column_output(" Interaction ", XLDLAS_JUST_RIGHT);
3275 sprintf(string_one,"%14.3f", ssi);
3276 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3277 sprintf(string_one,"%14d", df_one);
3278 add_column_output(string_one, XLDLAS_JUST_CENTER);
3279 sprintf(string_one,"%14.3f", mean_ss_one);
3280 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3281 sprintf(string_one,"%14.3f", mean_ss_one / mean_ss_two);
3282 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3283 sprintf(string_one,"%14.3f", 1.0 - betai(df_two/2.0, df_one/2.0, df_two/(df_two+ (df_one * (mean_ss_one/mean_ss_two)))));
3284 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3285 end_column_output();
3286
3287 begin_column_output(" Error ", XLDLAS_JUST_RIGHT);
3288 sprintf(string_one,"%14.3f", sse);
3289 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3290 sprintf(string_one,"%14d", df_two);
3291 add_column_output(string_one, XLDLAS_JUST_CENTER);
3292 sprintf(string_one,"%14.3f", mean_ss_two);
3293 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3294 add_column_output( " ", XLDLAS_JUST_RIGHT);
3295 add_column_output( " ", XLDLAS_JUST_RIGHT);
3296 end_column_output();
3297
3298
3299 seperator_output(6);
3300
3301 begin_column_output(" Total ", XLDLAS_JUST_RIGHT);
3302 sprintf(string_one,"%14.3f", sst);
3303 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3304 sprintf(string_one,"%14d", cell_obs[0][0] * numb_anova * block_categories - 1);
3305 add_column_output(string_one, XLDLAS_JUST_CENTER);
3306 add_column_output( " ", XLDLAS_JUST_RIGHT);
3307 add_column_output( " ", XLDLAS_JUST_RIGHT);
3308 add_column_output( " ", XLDLAS_JUST_RIGHT);
3309 end_column_output();
3310
3311 end_table_output(6);
3312 }
3313
3314 }
3315
3316
do_anova(FL_OBJECT * obj,long arg)3317 void do_anova(FL_OBJECT *obj, long arg)
3318 {
3319 char string_one[XLDLASMAX_INPUT];
3320 float ssg, ssw, sst;
3321 int to_anova[MAX_VARS];
3322 int numb_anova, i,j;
3323 float sample_means[MAX_VARS];
3324 int true_obs[MAX_VARS];
3325 float total_mean;
3326 float ss_groups[MAX_VARS];
3327 int total_obs;
3328 if(anova_type == 1)
3329 {
3330 say_status("Doing One Way ANOVA");
3331 all_start = fl_get_counter_value(anova_from_counter);
3332 all_stop = fl_get_counter_value(anova_to_counter);
3333 if(all_stop < all_start)
3334 {
3335 fl_show_alert("From Value Great than To Value","","",TRUE);
3336 say_status("Waiting for Variable/Type selection to do ANOVA");
3337 return;
3338 }
3339 numb_anova = 0;
3340 strcpy(string_one,"One Way ANOVA on: ");
3341 for(i = 0; i < numb_variables; i++)
3342 {
3343 if(fl_isselected_browser_line(anova_variable_browser, i+1))
3344 {
3345 to_anova[numb_anova] = i;
3346 numb_anova++;
3347 strcat(string_one,data_matrix[i].name);
3348 strcat(string_one, " ");
3349 }
3350
3351 }
3352 if(numb_anova == 0)
3353 {
3354 fl_show_alert("No variables Selected","","",TRUE);
3355 say_status("Waiting for Variable/Type selection to do ANOVA");
3356 return;
3357 }
3358 if(numb_anova == 1)
3359 {
3360 fl_show_alert("ANOVA Requires at Least Two Variables","","",TRUE);
3361 say_status("Waiting for Variable/Type selection to do ANOVA");
3362 return;
3363 }
3364
3365 for(i = 0; i < numb_anova; i++)
3366 {
3367 sample_means[i] = 0.0;
3368 true_obs[i] = 0;
3369 for(j = all_start - 1; j < all_stop; j++)
3370 {
3371 if(*(fvector[to_anova[i]] + j) != missing_value && j < data_matrix[to_anova[i]].obs)
3372 {
3373 sample_means[i] = sample_means[i] + *(fvector[to_anova[i]] + j);
3374 true_obs[i]++;
3375 }
3376 }
3377 if(true_obs[i] == 0)
3378 {
3379 strcpy(string_one, data_matrix[to_anova[i]].name);
3380 fl_show_alert("The following Variable has no Observations in Current Range:", string_one, "", TRUE);
3381 say_status("Waiting for Variable/Type selection to do ANOVA");
3382 return;
3383 }
3384 sample_means[i] = sample_means[i] / true_obs[i];
3385 }
3386 total_mean = 0;
3387 total_obs = 0;
3388 for(i = 0; i < numb_anova; i++)
3389 {
3390 total_mean = total_mean + sample_means[i] * true_obs[i];
3391 total_obs = total_obs + true_obs[i];
3392 }
3393 total_mean = total_mean / total_obs;
3394 ssw = 0;
3395 for(i = 0; i < numb_anova; i++)
3396 {
3397 ss_groups[i] = 0;
3398 for(j = all_start - 1; j < all_stop; j++)
3399 {
3400 if(*(fvector[to_anova[i]] + j) != missing_value && j < data_matrix[to_anova[i]].obs)
3401 {
3402 ss_groups[i] = ss_groups[i] + pow(*(fvector[to_anova[i]] + j) - sample_means[i], 2);
3403 }
3404 }
3405 ssw = ssw + ss_groups[i];
3406 }
3407 ssg = 0;
3408 for(i = 0; i < numb_anova; i++)
3409 {
3410 ssg = ssg + true_obs[i] * pow(sample_means[i] - total_mean,2);
3411 }
3412 sst = ssg + ssw;
3413
3414 say_status("Displaying ANOVA Table");
3415 simple_line_output("anova", "One Way Analysis of Variance");
3416 begin_table_output(6, string_one);
3417
3418 begin_column_output(" Source of ", XLDLAS_JUST_RIGHT);
3419 add_column_output( " Sums of", XLDLAS_JUST_CENTER);
3420 add_column_output( " Degrees of", XLDLAS_JUST_CENTER);
3421 add_column_output( " Mean", XLDLAS_JUST_CENTER);
3422 add_column_output( " ", XLDLAS_JUST_CENTER);
3423 add_column_output( " ", XLDLAS_JUST_CENTER);
3424 end_column_output();
3425
3426 begin_column_output(" Variation ", XLDLAS_JUST_RIGHT);
3427 add_column_output( " Squares", XLDLAS_JUST_CENTER);
3428 add_column_output( " Freedom", XLDLAS_JUST_CENTER);
3429 add_column_output( " Squares", XLDLAS_JUST_CENTER);
3430 add_column_output( " F Ratio", XLDLAS_JUST_CENTER);
3431 add_column_output( " Prob(F)", XLDLAS_JUST_CENTER);
3432 end_column_output();
3433
3434 seperator_output(6);
3435
3436 begin_column_output(" Between Groups ", XLDLAS_JUST_RIGHT);
3437 sprintf(string_one,"%14.3f", ssg);
3438 add_column_output(string_one, XLDLAS_JUST_CENTER);
3439 sprintf(string_one,"%14d", numb_anova - 1);
3440 add_column_output(string_one, XLDLAS_JUST_CENTER);
3441 sprintf(string_one,"%14.3f", ssg / (numb_anova - 1));
3442 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3443 sprintf(string_one,"%14.3f", (ssg / (numb_anova - 1)) / (ssw / (total_obs - numb_anova)));
3444 add_column_output(string_one, XLDLAS_JUST_CENTER);
3445 sprintf(string_one,"%14.3f", 1.0 - betai((total_obs - numb_anova) / 2.0,
3446 (numb_anova - 1) / 2.0 ,
3447 (total_obs - numb_anova) / ( (total_obs - numb_anova) + ((numb_anova - 1) * ((ssg / (numb_anova - 1)) / (ssw / (total_obs - numb_anova))))) ));
3448 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3449 end_column_output();
3450
3451 begin_column_output(" Within Groups ", XLDLAS_JUST_RIGHT);
3452 sprintf(string_one,"%14.3f", ssw);
3453 add_column_output(string_one, XLDLAS_JUST_CENTER);
3454 sprintf(string_one,"%14d", total_obs - numb_anova);
3455 add_column_output(string_one, XLDLAS_JUST_CENTER);
3456 sprintf(string_one,"%14.3f", ssw / (total_obs - numb_anova));
3457 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3458 add_column_output( " ", XLDLAS_JUST_CENTER);
3459 add_column_output( " ", XLDLAS_JUST_CENTER);
3460 end_column_output();
3461
3462 seperator_output(6);
3463
3464 begin_column_output(" Total ", XLDLAS_JUST_RIGHT);
3465 sprintf(string_one,"%14.3f", sst);
3466 add_column_output(string_one, XLDLAS_JUST_RIGHT);
3467 sprintf(string_one,"%14d", total_obs - 1);
3468 add_column_output(string_one, XLDLAS_JUST_CENTER);
3469 add_column_output( " ", XLDLAS_JUST_CENTER);
3470 add_column_output( " ", XLDLAS_JUST_CENTER);
3471 add_column_output( " ", XLDLAS_JUST_CENTER);
3472 end_column_output();
3473
3474
3475 end_table_output(6);
3476
3477 }
3478 if(anova_type == 2)
3479 {
3480 do_twoway_anova();
3481 }
3482 say_status("Waiting for Variable/Type selection to do ANOVA");
3483 }
3484
3485
3486
analysis_routines(FL_OBJECT * menu,long user_data)3487 void analysis_routines(FL_OBJECT *menu, long user_data)
3488 {
3489 int choice;
3490 choice = fl_get_menu(menu);
3491 if(choice == 1) begin_summarize(menu, 0);
3492 if(choice == 2) start_corr_variables(menu, 0);
3493 if(choice == 3) start_regress_variables(menu, 0);
3494 if(choice == 4) start_gafit();
3495 if(choice == 5) start_nnet();
3496 if(choice == 6) start_anova();
3497 }
3498