?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Update Spanish translation
[gnumeric.git] / src / sstest.c
blob3b2d7b7962379dbb7699aa6098e4fd36f9bfc26d
1 /*
2 * sstest.c: Test code for Gnumeric
3 *
4 * Copyright (C) 2009,2017 Morten Welinder (terra@gnome.org)
5 */
6 #include <gnumeric-config.h>
7 #include <gnumeric.h>
8 #include <libgnumeric.h>
9 #include <goffice/goffice.h>
10 #include <command-context-stderr.h>
11 #include <workbook-view.h>
12 #include <workbook.h>
13 #include <gutils.h>
14 #include <gnm-plugin.h>
15 #include <parse-util.h>
16 #include <expr-name.h>
17 #include <expr.h>
18 #include <search.h>
19 #include <sheet.h>
20 #include <cell.h>
21 #include <value.h>
22 #include <func.h>
23 #include <parse-util.h>
24 #include <sheet-object-cell-comment.h>
25 #include <mathfunc.h>
26 #include <gnm-random.h>
27 #include <sf-dpq.h>
28 #include <sf-gamma.h>
29 #include <rangefunc.h>
30 #include <gnumeric-conf.h>
31
32 #include <gsf/gsf-input-stdio.h>
33 #include <gsf/gsf-input-textline.h>
34 #include <glib/gstdio.h>
35 #include <glib/gi18n.h>
36 #include <string.h>
37 #include <errno.h>
38
39 static gboolean sstest_show_version = FALSE;
40 static gboolean sstest_fast = FALSE;
41 static gchar *func_def_file = NULL;
42 static gchar *func_state_file = NULL;
43 static gchar *ext_refs_file = NULL;
44 static gchar *samples_file = NULL;
45
46 static GOptionEntry const sstest_options [] = {
47 {
48 "fast", 'f',
49 0, G_OPTION_ARG_NONE, &sstest_fast,
50 N_("Run fewer iterations"),
51 NULL
52 },
53
54 {
55 "dump-func-defs", 0,
56 0, G_OPTION_ARG_FILENAME, &func_def_file,
57 N_("Dumps the function definitions"),
58 N_("FILE")
59 },
60
61 {
62 "dump-func-state", 0,
63 0, G_OPTION_ARG_FILENAME, &func_state_file,
64 N_("Dumps the function definitions"),
65 N_("FILE")
66 },
67
68 {
69 "ext-refs-file", 0,
70 0, G_OPTION_ARG_FILENAME, &ext_refs_file,
71 N_("Dumps web page for function help"),
72 N_("FILE")
73 },
74
75 {
76 "samples-file", 0,
77 0, G_OPTION_ARG_FILENAME, &samples_file,
78 N_("Dumps list of samples in function help"),
79 N_("FILE")
80 },
81
82 {
83 "version", 'V',
84 0, G_OPTION_ARG_NONE, &sstest_show_version,
85 N_("Display program version"),
86 NULL
87 },
88
89 { NULL }
90 };
91
92 /* ------------------------------------------------------------------------- */
93
94 #define UNICODE_ELLIPSIS "\xe2\x80\xa6"
95
96 static char *
97 split_at_colon (char const *s, char **rest)
98 {
99 char *dup = g_strdup (s);
100 char *colon = strchr (dup, ':');
101 if (colon) {
102 *colon = 0;
103 if (rest) *rest = colon + 1;
104 } else {
105 if (rest) *rest = NULL;
106 }
107 return dup;
108 }
109
110
111 static void
112 dump_externals (GPtrArray *defs, FILE *out)
113 {
114 unsigned int ui;
115
116 fprintf (out, "<!--#set var=\"title\" value=\"Gnumeric Web Documentation\" -->");
117 fprintf (out, "<!--#set var=\"rootdir\" value=\".\" -->");
118 fprintf (out, "<!--#include virtual=\"header-begin.shtml\" -->");
119 fprintf (out, "<link rel=\"stylesheet\" href=\"style/index.css\" type=\"text/css\"/>");
120 fprintf (out, "<!--#include virtual=\"header-end.shtml\" -->");
121 fprintf (out, "<!--#set var=\"wolfram\" value=\"none\" -->");
122 fprintf (out, "<!--#set var=\"wiki\" value=\"none\" -->");
123 fprintf (out, "<!--\n\n-->");
124
125 for (ui = 0; ui < defs->len; ui++) {
126 GnmFunc *fd = g_ptr_array_index (defs, ui);
127 gboolean any = FALSE;
128 int j, n;
129 GnmFuncHelp const *help = gnm_func_get_help (fd, &n);
130
131 for (j = 0; j < n; j++) {
132 const char *s = gnm_func_gettext (fd, help[j].text);
133
134 switch (help[j].type) {
135 case GNM_FUNC_HELP_EXTREF:
136 if (!any) {
137 any = TRUE;
138 fprintf (out, "<!--#if expr=\"${QUERY_STRING} = %s\" -->", fd->name);
139 }
140
141 if (strncmp (s, "wolfram:", 8) == 0) {
142 fprintf (out, "<!--#set var=\"wolfram\" value=\"%s\" -->", s + 8);
143 }
144 if (strncmp (s, "wiki:", 5) == 0) {
145 char *lang, *page;
146 lang = split_at_colon (s + 5, &page);
147 fprintf (out, "<!--#set var=\"wiki_lang\" value=\"%s\" -->", lang);
148 fprintf (out, "<!--#set var=\"wiki\" value=\"%s\" -->", page);
149 g_free (lang);
150 }
151 break;
152 default:
153 break;
154 }
155 }
156
157 if (any)
158 fprintf (out, "<!--#endif\n\n-->");
159 }
160
161 fprintf (out, "<div class=\"floatflush\">\n");
162 fprintf (out, "<h1>Online Documentation for \"<!--#echo var=\"QUERY_STRING\" -->\"</h1>\n");
163 fprintf (out, "<p>When last checked, these sources provided useful information about\n");
164 fprintf (out, "this function. However, since the links are not controlled by the\n");
165 fprintf (out, "Gnumeric Team, we cannot guarantee that the links still work. If\n");
166 fprintf (out, "you find that they do not work, please drop us a line.</p>\n");
167 fprintf (out, "<ul>");
168 fprintf (out, "<!--#if expr=\"${wolfram} != none\"-->");
169 fprintf (out, "<li><a href=\"http://mathworld.wolfram.com/<!--#echo var=\"wolfram\" -->\">Wolfram Mathworld\nentry</a>.</li><!--#endif-->");
170 fprintf (out, "<!--#if expr=\"${wiki} != none\"--><li><a href=\"http://<!--#echo var=\"wiki_lang\" -->.wikipedia.org/wiki/<!--#echo var=\"wiki\" -->\">Wikipedia\nentry</a>.</li><!--#endif-->");
171 fprintf (out, "<li><a href=\"http://www.google.com/#q=<!--#echo var=\"QUERY_STRING\" -->\">Google Search</a>.</li>");
172 fprintf (out, "</ul>");
173 fprintf (out, "</div>\n");
174
175 fprintf (out, "<!--#include virtual=\"footer.shtml\" -->\n");
176 }
177
178 static void
179 csv_quoted_print (FILE *out, const char *s)
180 {
181 char quote = '"';
182 fputc (quote, out);
183 while (*s) {
184 if (*s == quote) {
185 fputc (quote, out);
186 fputc (quote, out);
187 s++;
188 } else {
189 int len = g_utf8_skip[(unsigned char)*s];
190 fprintf (out, "%-.*s", len, s);
191 s += len;
192 }
193 }
194 fputc ('"', out);
195 }
196
197 static void
198 dump_samples (GPtrArray *defs, FILE *out)
199 {
200 unsigned ui;
201 GnmFuncGroup *last_group = NULL;
202
203 for (ui = 0; ui < defs->len; ui++) {
204 GnmFunc *fd = g_ptr_array_index (defs, ui);
205 int j, n;
206 const char *last = NULL;
207 gboolean has_sample = FALSE;
208 GnmFuncHelp const *help = gnm_func_get_help (fd, &n);
209
210 if (last_group != gnm_func_get_function_group (fd)) {
211 last_group = gnm_func_get_function_group (fd);
212 csv_quoted_print (out, last_group->display_name->str);
213 fputc ('\n', out);
214 }
215
216 for (j = 0; j < n; j++) {
217 const char *s = help[j].text;
218
219 if (help[j].type != GNM_FUNC_HELP_EXAMPLES)
220 continue;
221
222 has_sample = TRUE;
223
224 /*
225 * Some of the random numbers functions have duplicate
226 * samples. We don't want the duplicates here.
227 */
228 if (s[0] != '=' || (last && strcmp (last, s) == 0))
229 continue;
230
231 fputc (',', out);
232 if (!last)
233 csv_quoted_print (out, fd->name);
234 last = s;
235
236 fputc (',', out);
237 csv_quoted_print (out, s);
238 fputc ('\n', out);
239 }
240
241 if (!has_sample)
242 g_printerr ("No samples for %s\n", fd->name);
243 }
244 }
245
246 static int
247 func_def_cmp (gconstpointer a, gconstpointer b)
248 {
249 GnmFunc *fda = *(GnmFunc **)a ;
250 GnmFunc *fdb = *(GnmFunc **)b ;
251 GnmFuncGroup *ga, *gb;
252
253 g_return_val_if_fail (fda->name != NULL, 0);
254 g_return_val_if_fail (fdb->name != NULL, 0);
255
256 ga = gnm_func_get_function_group (fda);
257 gb = gnm_func_get_function_group (fdb);
258
259 if (ga && gb) {
260 int res = go_string_cmp (ga->display_name, gb->display_name);
261 if (res != 0)
262 return res;
263 }
264
265 return g_ascii_strcasecmp (fda->name, fdb->name);
266 }
267
268 static GPtrArray *
269 enumerate_functions (gboolean filter)
270 {
271 GPtrArray *res = gnm_func_enumerate ();
272 unsigned ui;
273
274 for (ui = 0; ui < res->len; ui++) {
275 GnmFunc *fd = g_ptr_array_index (res, ui);
276
277 if (filter &&
278 (fd->name == NULL ||
279 strcmp (fd->name, "perl_adder") == 0 ||
280 strcmp (fd->name, "perl_date") == 0 ||
281 strcmp (fd->name, "perl_sed") == 0 ||
282 strcmp (fd->name, "py_capwords") == 0 ||
283 strcmp (fd->name, "py_printf") == 0 ||
284 strcmp (fd->name, "py_bitand") == 0)) {
285 g_ptr_array_remove_index_fast (res, ui);
286 ui--;
287 }
288
289 gnm_func_load_if_stub (fd);
290 }
291
292 g_ptr_array_sort (res, func_def_cmp);
293
294 return res;
295 }
296
297 /**
298 * function_dump_defs:
299 * @filename:
300 * @dump_type:
301 *
302 * A generic utility routine to operate on all funtion defs
303 * in various ways. @dump_type will change/extend as needed
304 * Right now
305 * 0 : www.gnumeric.org's function.shtml page
306 * 1:
307 * 2 : (obsolete)
308 * 3 : (obsolete)
309 * 4 : external refs
310 * 5 : all sample expressions
311 **/
312 static void
313 function_dump_defs (char const *filename, int dump_type)
314 {
315 FILE *output_file;
316 char *up, *catname;
317 unsigned i;
318 GPtrArray *ordered;
319 GnmFuncGroup const *group = NULL;
320
321 g_return_if_fail (filename != NULL);
322
323 if ((output_file = g_fopen (filename, "w")) == NULL){
324 g_printerr (_("Cannot create file %s\n"), filename);
325 exit (1);
326 }
327
328 /* TODO : Use the translated names and split by function group. */
329 ordered = enumerate_functions (TRUE);
330
331 if (dump_type == 4) {
332 dump_externals (ordered, output_file);
333 g_ptr_array_free (ordered, TRUE);
334 fclose (output_file);
335 return;
336 }
337
338 if (dump_type == 5) {
339 dump_samples (ordered, output_file);
340 g_ptr_array_free (ordered, TRUE);
341 fclose (output_file);
342 return;
343 }
344
345 if (dump_type == 0) {
346 int unique = 0;
347 for (i = 0; i < ordered->len; i++) {
348 GnmFunc *fd = g_ptr_array_index (ordered, i);
349 switch (gnm_func_get_impl_status (fd)) {
350 case GNM_FUNC_IMPL_STATUS_UNIQUE_TO_GNUMERIC:
351 unique++;
352 break;
353 default: ;
354 }
355 }
356
357 fprintf (output_file,
358 "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
359 "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n"
360 "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n"
361 "<!-- DEFINE current=Home -->\n"
362 "<!-- MARKER: start-header -->\n"
363 "<head>\n"
364 "<title>Gnumeric</title>\n"
365 "<link rel=\"stylesheet\" href=\"style/style.css\" type=\"text/css\" />\n"
366 "<link rel=\"icon\" type=\"image/png\" href=\"logo.png\" />\n"
367 "<style type=\"text/css\"><!--\n"
368 " div.functiongroup {\n"
369 " margin-top: 1em;\n"
370 " margin-bottom: 1em;\n"
371 " }\n"
372 " table.functiongroup {\n"
373 " border-style: solid;\n"
374 " border-width: 1px;\n"
375 " border-spacing: 0px;\n"
376 " }\n"
377 " tr.header td {\n"
378 " font-weight: bold;\n"
379 " font-size: 14pt;\n"
380 " border-style: solid;\n"
381 " border-width: 1px;\n"
382 " text-align: center;\n"
383 " }\n"
384 " tr.function td {\n"
385 " border: solid 1px;\n"
386 " }\n"
387 " td.testing-unknown { background: #ffffff; }\n"
388 " td.testing-nosuite { background: #ff7662; }\n"
389 " td.testing-basic { background: #fff79d; }\n"
390 " td.testing-exhaustive { background: #aef8b5; }\n"
391 " td.testing-devel { background: #ff6c00; }\n"
392 " td.imp-exists { background: #ffffff; }\n"
393 " td.imp-no { background: #ff7662; }\n"
394 " td.imp-subset { background: #fff79d; }\n"
395 " td.imp-complete { background: #aef8b5; }\n"
396 " td.imp-superset { background: #16e49e; }\n"
397 " td.imp-subsetext { background: #59fff2; }\n"
398 " td.imp-devel { background: #ff6c00; }\n"
399 " td.imp-gnumeric { background: #44be18; }\n"
400 "--></style>\n"
401 "</head>\n"
402 "<body>\n"
403 "<div id=\"wrap\">\n"
404 " <a href=\"/\"><div id=\"header\">\n"
405 " <h1 id=\"logo-text\"><span>Gnumeric</span></h1>\n"
406 " <p id=\"slogan\">Free, Fast, Accurate &mdash; Pick Any Three!</p>\n"
407 " <img id=\"logo\" src=\"gnumeric.png\" alt=\"logo\" class=\"float-right\"/>\n"
408 " </div></a>\n"
409 "\n"
410 " <div id=\"nav\">\n"
411 " <ul>\n"
412 " <li id=\"current\"><a href=\"/\">Home</a></li>\n"
413 " <li><a href=\"development.html\">Development</a></li>\n"
414 " <li><a href=\"contact.html\">Contact</a></li>\n"
415 " </ul>\n"
416 " </div>\n"
417 "\n"
418 " <div id=\"content-wrap\">\n"
419 " <!-- MARKER: start-main -->\n"
420 " <div id=\"main\">\n"
421 " <div class=\"generalitem\">\n"
422 " <h2><span class=\"gnumeric-bullet\"></span>Gnumeric Sheet Functions</h2>\n"
423 " <p>Gnumeric currently has %d functions for use in spreadsheets.\n"
424 " %d of these are unique to Gnumeric.</p>\n",
425 ordered->len, unique);
426 }
427
428 for (i = 0; i < ordered->len; i++) {
429 GnmFunc *fd = g_ptr_array_index (ordered, i);
430
431 // Skip internal-use function
432 if (g_ascii_strcasecmp (fd->name, "TABLE") == 0)
433 continue;
434
435 // Skip demo function
436 if (g_ascii_strcasecmp (fd->name, "ATL_LAST") == 0)
437 continue;
438
439 if (dump_type == 1) {
440 int i;
441 gboolean first_arg = TRUE;
442 GString *syntax = g_string_new (NULL);
443 GString *arg_desc = g_string_new (NULL);
444 GString *desc = g_string_new (NULL);
445 GString *odf = g_string_new (NULL);
446 GString *excel = g_string_new (NULL);
447 GString *note = g_string_new (NULL);
448 GString *seealso = g_string_new (NULL);
449 gint min, max;
450 GnmFuncGroup *group = gnm_func_get_function_group (fd);
451 int n;
452 GnmFuncHelp const *help = gnm_func_get_help (fd, &n);
453
454 fprintf (output_file, "@CATEGORY=%s\n",
455 gnm_func_gettext (fd, group->display_name->str));
456 for (i = 0; i < n; i++) {
457 switch (help[i].type) {
458 case GNM_FUNC_HELP_NAME: {
459 char *short_desc;
460 char *name = split_at_colon (gnm_func_gettext (fd, help[i].text), &short_desc);
461 fprintf (output_file,
462 "@FUNCTION=%s\n",
463 name);
464 fprintf (output_file,
465 "@SHORTDESC=%s\n",
466 short_desc);
467 g_string_append (syntax, name);
468 g_string_append_c (syntax, '(');
469 g_free (name);
470 break;
471 }
472 case GNM_FUNC_HELP_SEEALSO:
473 if (seealso->len > 0)
474 g_string_append (seealso, ",");
475 g_string_append (seealso, gnm_func_gettext (fd, help[i].text));
476 break;
477 case GNM_FUNC_HELP_DESCRIPTION:
478 if (desc->len > 0)
479 g_string_append (desc, "\n");
480 g_string_append (desc, gnm_func_gettext (fd, help[i].text));
481 break;
482 case GNM_FUNC_HELP_NOTE:
483 if (note->len > 0)
484 g_string_append (note, " ");
485 g_string_append (note, gnm_func_gettext (fd, help[i].text));
486 break;
487 case GNM_FUNC_HELP_ARG: {
488 char *argdesc;
489 char *name = split_at_colon (gnm_func_gettext (fd, help[i].text), &argdesc);
490 if (first_arg)
491 first_arg = FALSE;
492 else
493 g_string_append_c (syntax, go_locale_get_arg_sep ());
494 g_string_append (syntax, name);
495 if (argdesc) {
496 g_string_append_printf (arg_desc,
497 "@{%s}: %s\n",
498 name,
499 argdesc);
500 }
501 g_free (name);
502 /* FIXME: Optional args? */
503 break;
504 }
505 case GNM_FUNC_HELP_ODF:
506 if (odf->len > 0)
507 g_string_append (odf, " ");
508 g_string_append (odf, gnm_func_gettext (fd, help[i].text));
509 break;
510 case GNM_FUNC_HELP_EXCEL:
511 if (excel->len > 0)
512 g_string_append (excel, " ");
513 g_string_append (excel, gnm_func_gettext (fd, help[i].text));
514 break;
515
516 case GNM_FUNC_HELP_EXTREF:
517 /* FIXME! */
518 case GNM_FUNC_HELP_EXAMPLES:
519 /* FIXME! */
520 case GNM_FUNC_HELP_END:
521 break;
522 }
523 }
524
525 gnm_func_count_args (fd, &min, &max);
526 if (max == G_MAXINT)
527 fprintf (output_file,
528 "@SYNTAX=%s," UNICODE_ELLIPSIS ")\n",
529 syntax->str);
530 else
531 fprintf (output_file, "@SYNTAX=%s)\n",
532 syntax->str);
533
534 if (arg_desc->len > 0)
535 fprintf (output_file, "@ARGUMENTDESCRIPTION=%s", arg_desc->str);
536 if (desc->len > 0)
537 fprintf (output_file, "@DESCRIPTION=%s\n", desc->str);
538 if (note->len > 0)
539 fprintf (output_file, "@NOTE=%s\n", note->str);
540 if (excel->len > 0)
541 fprintf (output_file, "@EXCEL=%s\n", excel->str);
542 if (odf->len > 0)
543 fprintf (output_file, "@ODF=%s\n", odf->str);
544 if (seealso->len > 0)
545 fprintf (output_file, "@SEEALSO=%s\n", seealso->str);
546
547 g_string_free (syntax, TRUE);
548 g_string_free (arg_desc, TRUE);
549 g_string_free (desc, TRUE);
550 g_string_free (odf, TRUE);
551 g_string_free (excel, TRUE);
552 g_string_free (note, TRUE);
553 g_string_free (seealso, TRUE);
554
555 fputc ('\n', output_file);
556 } else if (dump_type == 0) {
557 static struct {
558 char const *name;
559 char const *klass;
560 } const testing [] = {
561 { "Unknown", "testing-unknown" },
562 { "No Testsuite", "testing-nosuite" },
563 { "Basic", "testing-basic" },
564 { "Exhaustive", "testing-exhaustive" },
565 { "Under Development", "testing-devel" }
566 };
567 static struct {
568 char const *name;
569 char const *klass;
570 } const implementation [] = {
571 { "Exists", "imp-exists" },
572 { "Unimplemented", "imp-no" },
573 { "Subset", "imp-subset" },
574 { "Complete", "imp-complete" },
575 { "Superset", "imp-superset" },
576 { "Subset with_extensions", "imp-subsetext" },
577 { "Under development", "imp-devel" },
578 { "Unique to Gnumeric", "imp-gnumeric" },
579 };
580 GnmFuncImplStatus imst = gnm_func_get_impl_status (fd);
581 GnmFuncTestStatus test = gnm_func_get_test_status (fd);
582
583 if (group != gnm_func_get_function_group (fd)) {
584 if (group) fprintf (output_file, "</table></div>\n");
585 group = gnm_func_get_function_group (fd);
586 fprintf (output_file,
587 "<h2>%s</h2>\n"
588 "<div class=\"functiongroup\"><table class=\"functiongroup\">\n"
589 "<tr class=\"header\">"
590 "<td>Function</td>"
591 "<td>Implementation</td>"
592 "<td>Testing</td>"
593 "</tr>\n",
594 group->display_name->str);
595 }
596 up = g_ascii_strup (fd->name, -1);
597 catname = g_strdup (group->display_name->str);
598 while (strchr (catname, ' '))
599 *strchr (catname, ' ') = '_';
600 fprintf (output_file, "<tr class=\"function\">\n");
601 fprintf (output_file,
602 "<td><a href =\"https://help.gnome.org/users/gnumeric/stable/gnumeric.html#gnumeric-function-%s\">%s</a></td>\n",
603 up, fd->name);
604 g_free (up);
605 g_free (catname);
606 fprintf (output_file,
607 "<td class=\"%s\"><a href=\"mailto:gnumeric-list@gnome.org?subject=Re: %s implementation\">%s</a></td>\n",
608 implementation[imst].klass,
609 fd->name,
610 implementation[imst].name);
611 fprintf (output_file,
612 "<td class=\"%s\"><a href=\"mailto:gnumeric-list@gnome.org?subject=Re: %s testing\">%s</a></td>\n",
613 testing[test].klass,
614 fd->name,
615 testing[test].name);
616 fprintf (output_file,"</tr>\n");
617 }
618 }
619 if (dump_type == 0) {
620 if (group) fprintf (output_file, "</table></div>\n");
621 fprintf (output_file,
622 " </div>\n"
623 " </div>\n"
624 " <!-- MARKER: end-main -->\n"
625 " <!-- MARKER: start-sidebar -->\n"
626 " <!-- MARKER: end-sidebar -->\n"
627 " </div>\n"
628 "</div>\n"
629 "</body>\n"
630 "</html>\n");
631 }
632
633 g_ptr_array_free (ordered, TRUE);
634 fclose (output_file);
635 }
636
637 /* ------------------------------------------------------------------------- */
638
639 static void
640 mark_test_start (const char *name)
641 {
642 g_printerr ("-----------------------------------------------------------------------------\nStart: %s\n-----------------------------------------------------------------------------\n\n", name);
643 }
644
645 static void
646 mark_test_end (const char *name)
647 {
648 g_printerr ("End: %s\n\n", name);
649 }
650
651 static void
652 cb_collect_names (G_GNUC_UNUSED const char *name, GnmNamedExpr *nexpr, GSList **names)
653 {
654 *names = g_slist_prepend (*names, nexpr);
655 }
656
657 static GnmCell *
658 fetch_cell (Sheet *sheet, const char *where)
659 {
660 GnmCellPos cp;
661 gboolean ok = cellpos_parse (where,
662 gnm_sheet_get_size (sheet),
663 &cp, TRUE) != NULL;
664 g_return_val_if_fail (ok, NULL);
665 return sheet_cell_fetch (sheet, cp.col, cp.row);
666 }
667
668 static void
669 set_cell (Sheet *sheet, const char *where, const char *what)
670 {
671 GnmCell *cell = fetch_cell (sheet, where);
672 if (cell)
673 gnm_cell_set_text (cell, what);
674 }
675
676 static void
677 dump_sheet (Sheet *sheet, const char *header)
678 {
679 GPtrArray *cells = sheet_cells (sheet, NULL);
680 unsigned ui;
681
682 if (header)
683 g_printerr ("# %s\n", header);
684 for (ui = 0; ui < cells->len; ui++) {
685 GnmCell *cell = g_ptr_array_index (cells, ui);
686 char *txt = gnm_cell_get_entered_text (cell);
687 g_printerr ("%s: %s\n",
688 cellpos_as_string (&cell->pos), txt);
689 g_free (txt);
690 }
691 g_ptr_array_free (cells, TRUE);
692 }
693
694
695 static void
696 dump_names (Workbook *wb)
697 {
698 GSList *l, *names = NULL;
699
700 workbook_foreach_name (wb, FALSE, (GHFunc)cb_collect_names, &names);
701 names = g_slist_sort (names, (GCompareFunc)expr_name_cmp_by_name);
702
703 g_printerr ("Dumping names...\n");
704 for (l = names; l; l = l->next) {
705 GnmNamedExpr *nexpr = l->data;
706 GnmConventionsOut out;
707
708 out.accum = g_string_new (NULL);
709 out.pp = &nexpr->pos;
710 out.convs = gnm_conventions_default;
711
712 g_string_append (out.accum, "Scope=");
713 if (out.pp->sheet)
714 g_string_append (out.accum, out.pp->sheet->name_quoted);
715 else
716 g_string_append (out.accum, "Global");
717
718 g_string_append (out.accum, " Name=");
719 go_strescape (out.accum, expr_name_name (nexpr));
720
721 g_string_append (out.accum, " Expr=");
722 gnm_expr_top_as_gstring (nexpr->texpr, &out);
723
724 g_printerr ("%s\n", out.accum->str);
725 g_string_free (out.accum, TRUE);
726 }
727 g_printerr ("Dumping names... Done\n");
728
729 g_slist_free (names);
730 }
731
732 static void
733 define_name (const char *name, const char *expr_txt, gpointer scope)
734 {
735 GnmParsePos pos;
736 GnmExprTop const *texpr;
737 GnmNamedExpr const *nexpr;
738 GnmConventions const *convs;
739
740 if (IS_SHEET (scope)) {
741 parse_pos_init_sheet (&pos, scope);
742 convs = sheet_get_conventions (pos.sheet);
743 } else {
744 parse_pos_init (&pos, WORKBOOK (scope), NULL, 0, 0);
745 convs = gnm_conventions_default;
746 }
747
748 texpr = gnm_expr_parse_str (expr_txt, &pos,
749 GNM_EXPR_PARSE_DEFAULT,
750 convs, NULL);
751 if (!texpr) {
752 g_printerr ("Failed to parse %s for name %s\n",
753 expr_txt, name);
754 return;
755 }
756
757 nexpr = expr_name_add (&pos, name, texpr, NULL, TRUE, NULL);
758 if (!nexpr)
759 g_printerr ("Failed to add name %s\n", name);
760 }
761
762 static void
763 test_insdel_rowcol_names (void)
764 {
765 Workbook *wb;
766 Sheet *sheet1,*sheet2;
767 const char *test_name = "test_insdel_rowcol_names";
768 GOUndo *undo;
769 int i;
770
771 mark_test_start (test_name);
772
773 wb = workbook_new ();
774 sheet1 = workbook_sheet_add (wb, -1,
775 GNM_DEFAULT_COLS, GNM_DEFAULT_ROWS);
776 sheet2 = workbook_sheet_add (wb, -1,
777 GNM_DEFAULT_COLS, GNM_DEFAULT_ROWS);
778
779 define_name ("Print_Area", "Sheet1!$A$1:$IV$65536", sheet1);
780 define_name ("Print_Area", "Sheet2!$A$1:$IV$65536", sheet2);
781
782 define_name ("NAMEGA1", "A1", wb);
783 define_name ("NAMEG2", "$A$14+Sheet1!$A$14+Sheet2!$A$14", wb);
784
785 define_name ("NAMEA1", "A1", sheet1);
786 define_name ("NAMEA2", "A2", sheet1);
787 define_name ("NAMEA1ABS", "$A$1", sheet1);
788 define_name ("NAMEA2ABS", "$A$2", sheet1);
789
790 dump_names (wb);
791
792 for (i = 3; i >= 0; i--) {
793 g_printerr ("About to insert before column %s on %s\n",
794 col_name (i), sheet1->name_unquoted);
795 sheet_insert_cols (sheet1, i, 12, &undo, NULL);
796 dump_names (wb);
797 g_printerr ("Undoing.\n");
798 go_undo_undo_with_data (undo, NULL);
799 g_object_unref (undo);
800 g_printerr ("Done.\n");
801 }
802
803 for (i = 3; i >= 0; i--) {
804 g_printerr ("About to insert before column %s on %s\n",
805 col_name (i), sheet2->name_unquoted);
806 sheet_insert_cols (sheet2, i, 12, &undo, NULL);
807 dump_names (wb);
808 g_printerr ("Undoing.\n");
809 go_undo_undo_with_data (undo, NULL);
810 g_object_unref (undo);
811 g_printerr ("Done.\n");
812 }
813
814 for (i = 3; i >= 0; i--) {
815 g_printerr ("About to delete column %s on %s\n",
816 col_name (i), sheet1->name_unquoted);
817 sheet_delete_cols (sheet1, i, 1, &undo, NULL);
818 dump_names (wb);
819 g_printerr ("Undoing.\n");
820 go_undo_undo_with_data (undo, NULL);
821 g_object_unref (undo);
822 g_printerr ("Done.\n");
823 }
824
825 g_object_unref (wb);
826
827 mark_test_end (test_name);
828 }
829
830 /* ------------------------------------------------------------------------- */
831
832 static void
833 test_insert_delete (void)
834 {
835 const char *test_name = "test_insert_delete";
836 Workbook *wb;
837 Sheet *sheet1;
838 int i;
839 GOUndo *u = NULL, *u1;
840
841 mark_test_start (test_name);
842
843 wb = workbook_new ();
844 sheet1 = workbook_sheet_add (wb, -1,
845 GNM_DEFAULT_COLS, GNM_DEFAULT_ROWS);
846 set_cell (sheet1, "B2", "=D4+1");
847 set_cell (sheet1, "D2", "=if(TRUE,B2,2)");
848
849 dump_sheet (sheet1, "Init");
850
851 for (i = 5; i >= 0; i--) {
852 g_printerr ("# About to insert column before %s\n",
853 col_name (i));
854 sheet_insert_cols (sheet1, i, 1, &u1, NULL);
855 u = go_undo_combine (u, u1);
856 dump_sheet (sheet1, NULL);
857 }
858
859 for (i = 5; i >= 0; i--) {
860 g_printerr ("# About to insert row before %s\n",
861 row_name (i));
862 sheet_insert_rows (sheet1, i, 1, &u1, NULL);
863 u = go_undo_combine (u, u1);
864 dump_sheet (sheet1, NULL);
865 }
866
867 go_undo_undo (u);
868 g_object_unref (u);
869 u = NULL;
870 dump_sheet (sheet1, "Undo the lot");
871
872 for (i = 5; i >= 0; i--) {
873 g_printerr ("# About to delete column %s\n",
874 col_name (i));
875 sheet_delete_cols (sheet1, i, 1, &u1, NULL);
876 u = go_undo_combine (u, u1);
877 dump_sheet (sheet1, NULL);
878 }
879
880 for (i = 5; i >= 0; i--) {
881 g_printerr ("# About to delete row %s\n",
882 row_name (i));
883 sheet_delete_rows (sheet1, i, 1, &u1, NULL);
884 u = go_undo_combine (u, u1);
885 dump_sheet (sheet1, NULL);
886 }
887
888 go_undo_undo (u);
889 g_object_unref (u);
890 u = NULL;
891 dump_sheet (sheet1, "Undo the lot");
892
893 g_object_unref (wb);
894
895 mark_test_end (test_name);
896 }
897
898 /* ------------------------------------------------------------------------- */
899
900 /* ------------------------------------------------------------------------- */
901
902 static gboolean
903 check_help_expression (const char *text, GnmFunc const *fd)
904 {
905 GnmConventions const *convs = gnm_conventions_default;
906 GnmParsePos pp;
907 GnmExprTop const *texpr;
908 Workbook *wb;
909 GnmParseError perr;
910
911 /* Create a dummy workbook with no sheets for interesting effects. */
912 wb = workbook_new ();
913 parse_pos_init (&pp, wb, NULL, 0, 0);
914
915 parse_error_init (&perr);
916
917 texpr = gnm_expr_parse_str (text, &pp,
918 GNM_EXPR_PARSE_DEFAULT,
919 convs,
920 &perr);
921 if (perr.err) {
922 g_printerr ("Error parsing %s: %s\n",
923 text, perr.err->message);
924 }
925 parse_error_free (&perr);
926 g_object_unref (wb);
927
928 if (!texpr)
929 return TRUE;
930
931 gnm_expr_top_unref (texpr);
932 return FALSE;
933 }
934
935 static gboolean
936 check_argument_refs (const char *text, GnmFunc *fd)
937 {
938 if (!gnm_func_is_fixargs (fd))
939 return FALSE;
940
941 while (1) {
942 const char *at = strchr (text, '@');
943 char *argname;
944 int i;
945
946 if (!at)
947 return FALSE;
948 if (at[1] != '{')
949 return TRUE;
950 text = strchr (at + 2, '}');
951 if (!text)
952 return FALSE;
953 argname = g_strndup (at + 2, text - at - 2);
954
955 for (i = 0; TRUE; i++) {
956 char *thisarg = gnm_func_get_arg_name (fd, i);
957 gboolean found;
958 if (!thisarg) {
959 g_free (argname);
960 return TRUE;
961 }
962 found = strcmp (argname, thisarg) == 0;
963 g_free (thisarg);
964 if (found)
965 break;
966 }
967 g_free (argname);
968 }
969 }
970
971
972 static int
973 gnm_func_sanity_check1 (GnmFunc *fd)
974 {
975 GnmFuncHelp const *h;
976 int counts[(int)GNM_FUNC_HELP_ODF + 1];
977 int res = 0;
978 size_t nlen = strlen (fd->name);
979 GHashTable *allargs;
980 int n;
981 GnmFuncHelp const *help = gnm_func_get_help (fd, &n);
982
983 allargs = g_hash_table_new_full
984 (g_str_hash, g_str_equal, (GDestroyNotify)g_free, NULL);
985
986 memset (counts, 0, sizeof (counts));
987 for (h = help; n-- > 0; h++) {
988 g_assert (h->type <= GNM_FUNC_HELP_ODF);
989 counts[h->type]++;
990
991 if (!g_utf8_validate (h->text, -1, NULL)) {
992 g_printerr ("%s: Invalid UTF-8 in type %i\n",
993 fd->name, h->type);
994 res = 1;
995 continue;
996 }
997
998 switch (h->type) {
999 case GNM_FUNC_HELP_NAME:
1000 if (g_ascii_strncasecmp (fd->name, h->text, nlen) ||
1001 h->text[nlen] != ':') {
1002 g_printerr ("%s: Invalid NAME record\n",
1003 fd->name);
1004 res = 1;
1005 } else if (h->text[nlen + 1] == ' ') {
1006 g_printerr ("%s: Unwanted space in NAME record\n",
1007 fd->name);
1008 res = 1;
1009 } else if (h->text[strlen (h->text) - 1] == '.') {
1010 g_printerr ("%s: Unwanted period in NAME record\n",
1011 fd->name);
1012 res = 1;
1013 }
1014 break;
1015 case GNM_FUNC_HELP_ARG: {
1016 const char *aend = strchr (h->text, ':');
1017 char *argname;
1018
1019 if (aend == NULL || aend == h->text) {
1020 g_printerr ("%s: Invalid ARG record\n",
1021 fd->name);
1022 res = 1;
1023 break;
1024 }
1025
1026 if (aend[1] == ' ') {
1027 g_printerr ("%s: Unwanted space in ARG record\n",
1028 fd->name);
1029 res = 1;
1030 }
1031 if (aend[1] == '\0') {
1032 g_printerr ("%s: Empty ARG record\n",
1033 fd->name);
1034 res = 1;
1035 }
1036 if (h->text[strlen (h->text) - 1] == '.') {
1037 g_printerr ("%s: Unwanted period in ARG record\n",
1038 fd->name);
1039 res = 1;
1040 }
1041 if (check_argument_refs (aend + 1, fd)) {
1042 g_printerr ("%s: Invalid argument reference, %s, in argument\n",
1043 aend + 1, fd->name);
1044 res = 1;
1045 }
1046 argname = g_strndup (h->text, aend - h->text);
1047 if (g_hash_table_lookup (allargs, argname)) {
1048 g_printerr ("%s: Duplicate argument name %s\n",
1049 fd->name, argname);
1050 res = 1;
1051 g_free (argname);
1052 g_printerr ("%s\n", h->text);
1053 } else
1054 g_hash_table_insert (allargs, argname, argname);
1055 break;
1056 }
1057 case GNM_FUNC_HELP_DESCRIPTION: {
1058 const char *p;
1059
1060 if (check_argument_refs (h->text, fd)) {
1061 g_printerr ("%s: Invalid argument reference in description\n",
1062 fd->name);
1063 res = 1;
1064 }
1065
1066 p = h->text;
1067 while (g_ascii_isupper (*p) ||
1068 (p != h->text && (*p == '_' ||
1069 *p == '.' ||
1070 g_ascii_isdigit (*p))))
1071 p++;
1072 if (*p == ' ' &&
1073 p - h->text >= 2 &&
1074 strncmp (h->text, "CP1252", 6) != 0) {
1075 if (g_ascii_strncasecmp (h->text, fd->name, nlen)) {
1076 g_printerr ("%s: Wrong function name in description\n",
1077 fd->name);
1078 res = 1;
1079 }
1080 }
1081 break;
1082 }
1083
1084 case GNM_FUNC_HELP_EXAMPLES:
1085 if (h->text[0] == '=') {
1086 if (check_help_expression (h->text + 1, fd)) {
1087 g_printerr ("%s: Invalid EXAMPLES record\n",
1088 fd->name);
1089 res = 1;
1090 }
1091 }
1092 break;
1093 default:
1094 ; /* Nothing */
1095 }
1096 }
1097
1098 g_hash_table_destroy (allargs);
1099
1100 if (gnm_func_is_fixargs (fd)) {
1101 int n = counts[GNM_FUNC_HELP_ARG];
1102 int min, max;
1103 gnm_func_count_args (fd, &min, &max);
1104 if (n != max) {
1105 g_printerr ("%s: Help for %d args, but takes %d-%d\n",
1106 fd->name, n, min, max);
1107 res = 1;
1108 }
1109 }
1110
1111 #if 0
1112 if (counts[GNM_FUNC_HELP_DESCRIPTION] != 1) {
1113 g_printerr ("%s: Help has %d descriptions.\n",
1114 fd->name, counts[GNM_FUNC_HELP_DESCRIPTION]);
1115 res = 1;
1116 }
1117 #endif
1118
1119 if (counts[GNM_FUNC_HELP_NAME] != 1) {
1120 g_printerr ("%s: Help has %d NAME records.\n",
1121 fd->name, counts[GNM_FUNC_HELP_NAME]);
1122 res = 1;
1123 }
1124
1125 if (counts[GNM_FUNC_HELP_EXCEL] > 1) {
1126 g_printerr ("%s: Help has %d Excel notes.\n",
1127 fd->name, counts[GNM_FUNC_HELP_EXCEL]);
1128 res = 1;
1129 }
1130
1131 if (counts[GNM_FUNC_HELP_ODF] > 1) {
1132 g_printerr ("%s: Help has %d ODF notes.\n",
1133 fd->name, counts[GNM_FUNC_HELP_ODF]);
1134 res = 1;
1135 }
1136
1137 return res;
1138 }
1139
1140 static int
1141 gnm_func_sanity_check (void)
1142 {
1143 int res = 0;
1144 GPtrArray *ordered;
1145 unsigned ui;
1146
1147 ordered = enumerate_functions (TRUE);
1148
1149 for (ui = 0; ui < ordered->len; ui++) {
1150 GnmFunc *fd = g_ptr_array_index (ordered, ui);
1151 if (gnm_func_sanity_check1 (fd))
1152 res = 1;
1153 }
1154
1155 g_ptr_array_free (ordered, TRUE);
1156
1157 return res;
1158 }
1159
1160 static void
1161 test_func_help (void)
1162 {
1163 const char *test_name = "test_func_help";
1164 int res;
1165
1166 mark_test_start (test_name);
1167
1168 res = gnm_func_sanity_check ();
1169 g_printerr ("Result = %d\n", res);
1170
1171 mark_test_end (test_name);
1172 }
1173
1174 /* ------------------------------------------------------------------------- */
1175
1176 static int
1177 test_strtol_ok (const char *s, long l, size_t expected_len)
1178 {
1179 long l2;
1180 char *end;
1181 int save_errno;
1182
1183 l2 = gnm_utf8_strtol (s, &end);
1184 save_errno = errno;
1185
1186 if (end != s + expected_len) {
1187 g_printerr ("Unexpect conversion end of [%s]\n", s);
1188 return 1;
1189 }
1190 if (l != l2) {
1191 g_printerr ("Unexpect conversion result of [%s]\n", s);
1192 return 1;
1193 }
1194 if (save_errno != 0) {
1195 g_printerr ("Unexpect conversion errno of [%s]\n", s);
1196 return 1;
1197 }
1198
1199 return 0;
1200 }
1201
1202 static int
1203 test_strtol_noconv (const char *s)
1204 {
1205 long l;
1206 char *end;
1207 int save_errno;
1208
1209 l = gnm_utf8_strtol (s, &end);
1210 save_errno = errno;
1211
1212 if (end != s) {
1213 g_printerr ("Unexpect conversion end of [%s]\n", s);
1214 return 1;
1215 }
1216 if (l != 0) {
1217 g_printerr ("Unexpect conversion result of [%s]\n", s);
1218 return 1;
1219 }
1220 if (save_errno != 0) {
1221 g_printerr ("Unexpect conversion errno of [%s]\n", s);
1222 return 1;
1223 }
1224
1225 return 0;
1226 }
1227
1228 static int
1229 test_strtol_overflow (const char *s, gboolean pos)
1230 {
1231 long l;
1232 char *end;
1233 int save_errno;
1234 size_t expected_len = strlen (s);
1235
1236 l = gnm_utf8_strtol (s, &end);
1237 save_errno = errno;
1238
1239 if (end != s + expected_len) {
1240 g_printerr ("Unexpect conversion end of [%s]\n", s);
1241 return 1;
1242 }
1243 if (l != (pos ? LONG_MAX : LONG_MIN)) {
1244 g_printerr ("Unexpect conversion result of [%s]\n", s);
1245 return 1;
1246 }
1247 if (save_errno != ERANGE) {
1248 g_printerr ("Unexpect conversion errno of [%s]\n", s);
1249 return 1;
1250 }
1251
1252 return 0;
1253 }
1254
1255 static int
1256 test_strtol_reverse (long l)
1257 {
1258 char buffer[4*sizeof(l) + 4];
1259 int res = 0;
1260
1261 sprintf(buffer, "%ld", l);
1262 res |= test_strtol_ok (buffer, l, strlen (buffer));
1263
1264 sprintf(buffer, " %ld", l);
1265 res |= test_strtol_ok (buffer, l, strlen (buffer));
1266
1267 sprintf(buffer, "\xc2\xa0\n\t%ld", l);
1268 res |= test_strtol_ok (buffer, l, strlen (buffer));
1269
1270 sprintf(buffer, " \t%ldx", l);
1271 res |= test_strtol_ok (buffer, l, strlen (buffer) - 1);
1272
1273 return res;
1274 }
1275
1276 static int
1277 test_strtod_ok (const char *s, double d, size_t expected_len)
1278 {
1279 gnm_float d2;
1280 char *end;
1281 int save_errno;
1282
1283 d2 = gnm_utf8_strto (s, &end);
1284 save_errno = errno;
1285
1286 if (end != s + expected_len) {
1287 g_printerr ("Unexpect conversion end of [%s]\n", s);
1288 return 1;
1289 }
1290 if (d != d2) {
1291 g_printerr ("Unexpect conversion result of [%s]\n", s);
1292 return 1;
1293 }
1294 if (save_errno != 0) {
1295 g_printerr ("Unexpect conversion errno of [%s]\n", s);
1296 return 1;
1297 }
1298
1299 return 0;
1300 }
1301
1302 static void
1303 test_nonascii_numbers (void)
1304 {
1305 const char *test_name = "test_nonascii_numbers";
1306 int res = 0;
1307
1308 mark_test_start (test_name);
1309
1310 res |= test_strtol_reverse (0);
1311 res |= test_strtol_reverse (1);
1312 res |= test_strtol_reverse (-1);
1313 res |= test_strtol_reverse (LONG_MIN);
1314 res |= test_strtol_reverse (LONG_MIN + 1);
1315 res |= test_strtol_reverse (LONG_MAX - 1);
1316
1317 res |= test_strtol_ok ("\xef\xbc\x8d\xef\xbc\x91", -1, 6);
1318 res |= test_strtol_ok ("\xc2\xa0+1", 1, 4);
1319
1320 res |= test_strtol_ok ("000000000000000000000000000000", 0, 30);
1321
1322 res |= test_strtol_noconv ("");
1323 res |= test_strtol_noconv (" ");
1324 res |= test_strtol_noconv (" +");
1325 res |= test_strtol_noconv (" -");
1326 res |= test_strtol_noconv (" .00");
1327 res |= test_strtol_noconv (" e0");
1328 res |= test_strtol_noconv ("--0");
1329 res |= test_strtol_noconv ("+-0");
1330 res |= test_strtol_noconv ("+ 0");
1331 res |= test_strtol_noconv ("- 0");
1332
1333 {
1334 char buffer[4 * sizeof (long) + 2];
1335
1336 sprintf (buffer, "-%lu", 1 + (unsigned long)LONG_MIN);
1337 res |= test_strtol_overflow (buffer, FALSE);
1338 sprintf (buffer, "-%lu", 10 + (unsigned long)LONG_MIN);
1339 res |= test_strtol_overflow (buffer, FALSE);
1340
1341 sprintf (buffer, "%lu", 1 + (unsigned long)LONG_MAX);
1342 res |= test_strtol_overflow (buffer, TRUE);
1343 sprintf (buffer, "%lu", 10 + (unsigned long)LONG_MAX);
1344 res |= test_strtol_overflow (buffer, TRUE);
1345 }
1346
1347 /* -------------------- */
1348
1349 res |= test_strtod_ok ("0", 0, 1);
1350 res |= test_strtod_ok ("1", 1, 1);
1351 res |= test_strtod_ok ("-1", -1, 2);
1352 res |= test_strtod_ok ("+1", 1, 2);
1353 res |= test_strtod_ok (" +1", 1, 3);
1354 res |= test_strtod_ok ("\xc2\xa0+1", 1, 4);
1355 res |= test_strtod_ok ("\xc2\xa0+1x", 1, 4);
1356 res |= test_strtod_ok ("\xc2\xa0+1e", 1, 4);
1357 res |= test_strtod_ok ("\xc2\xa0+1e+", 1, 4);
1358 res |= test_strtod_ok ("\xc2\xa0+1e+0", 1, 7);
1359 res |= test_strtod_ok ("-1e1", -10, 4);
1360 res |= test_strtod_ok ("100e-2", 1, 6);
1361 res |= test_strtod_ok ("100e+2", 10000, 6);
1362 res |= test_strtod_ok ("1x0p0", 1, 1);
1363 res |= test_strtod_ok ("+inf", gnm_pinf, 4);
1364 res |= test_strtod_ok ("-inf", gnm_ninf, 4);
1365 res |= test_strtod_ok ("1.25", 1.25, 4);
1366 res |= test_strtod_ok ("1.25e1", 12.5, 6);
1367 res |= test_strtod_ok ("12.5e-1", 1.25, 7);
1368
1369 g_printerr ("Result = %d\n", res);
1370
1371 mark_test_end (test_name);
1372 }
1373
1374 /* ------------------------------------------------------------------------- */
1375
1376 static char *random_summary = NULL;
1377
1378 static void
1379 add_random_fail (const char *s)
1380 {
1381 if (random_summary) {
1382 char *t = g_strconcat (random_summary, ", ", s, NULL);
1383 g_free (random_summary);
1384 random_summary = t;
1385 } else
1386 random_summary = g_strdup (s);
1387 }
1388
1389 static void
1390 define_cell (Sheet *sheet, int c, int r, const char *expr)
1391 {
1392 GnmCell *cell = sheet_cell_fetch (sheet, c, r);
1393 sheet_cell_set_text (cell, expr, NULL);
1394 }
1395
1396 #define GET_PROB(i_) ((i_) <= 0 ? 0 : ((i_) >= nf ? 1 : probs[(i_)]))
1397
1398 static gboolean
1399 rand_fractile_test (gnm_float const *vals, int N, int nf,
1400 gnm_float const *fractiles, gnm_float const *probs)
1401 {
1402 gnm_float f = 1.0 / nf;
1403 int *fractilecount = g_new (int, nf + 1);
1404 int *expected = g_new (int, nf + 1);
1405 int i;
1406 gboolean ok = TRUE;
1407 gboolean debug = TRUE;
1408
1409 if (debug) {
1410 g_printerr ("Bin upper limit:");
1411 for (i = 1; i <= nf; i++) {
1412 gnm_float U = (i == nf) ? gnm_pinf : fractiles[i];
1413 g_printerr ("%s%" GNM_FORMAT_g,
1414 (i == 1) ? " " : ", ",
1415 U);
1416 }
1417 g_printerr (".\n");
1418 }
1419
1420 if (debug && probs) {
1421 g_printerr ("Cumulative probabilities:");
1422 for (i = 1; i <= nf; i++)
1423 g_printerr ("%s%.1" GNM_FORMAT_f "%%",
1424 (i == 1) ? " " : ", ", 100 * GET_PROB (i));
1425 g_printerr (".\n");
1426 }
1427
1428 for (i = 1; i < nf - 1; i++) {
1429 if (!(fractiles[i] <= fractiles[i + 1])) {
1430 g_printerr ("Severe fractile ordering problem.\n");
1431 return FALSE;
1432 }
1433
1434 if (probs && !(probs[i] <= probs[i + 1])) {
1435 g_printerr ("Severe cumulative probabilities ordering problem.\n");
1436 return FALSE;
1437 }
1438 }
1439 if (probs && (probs[1] < 0 || probs[nf - 1] > 1)) {
1440 g_printerr ("Severe cumulative probabilities range problem.\n");
1441 return FALSE;
1442 }
1443
1444 for (i = 0; i <= nf; i++)
1445 fractilecount[i] = 0;
1446
1447 for (i = 0; i < N; i++) {
1448 gnm_float r = vals[i];
1449 int j;
1450 for (j = 1; j < nf; j++)
1451 if (r <= fractiles[j])
1452 break;
1453 fractilecount[j]++;
1454 }
1455 g_printerr ("Fractile counts:");
1456 for (i = 1; i <= nf; i++)
1457 g_printerr ("%s%d", (i == 1) ? " " : ", ", fractilecount[i]);
1458 g_printerr (".\n");
1459
1460 if (probs) {
1461 g_printerr ("Expected counts:");
1462 for (i = 1; i <= nf; i++) {
1463 gnm_float p = GET_PROB (i) - GET_PROB (i-1);
1464 expected[i] = gnm_floor (p * N + 0.5);
1465 g_printerr ("%s%d", (i == 1) ? " " : ", ", expected[i]);
1466 }
1467 g_printerr (".\n");
1468 } else {
1469 gnm_float T = f * N;
1470 g_printerr ("Expected count in each fractile: %.10" GNM_FORMAT_g "\n", T);
1471 for (i = 0; i <= nf; i++)
1472 expected[i] = T;
1473 }
1474
1475 for (i = 1; i <= nf; i++) {
1476 gnm_float T = expected[i];
1477 if (!(gnm_abs (fractilecount[i] - T) <= 4 * gnm_sqrt (T))) {
1478 g_printerr ("Fractile test failure for bin %d.\n", i);
1479 ok = FALSE;
1480 }
1481 }
1482
1483 g_free (fractilecount);
1484 g_free (expected);
1485
1486 return ok;
1487 }
1488
1489 #undef GET_PROB
1490
1491 static gnm_float *
1492 test_random_1 (int N, const char *expr,
1493 gnm_float *mean, gnm_float *var,
1494 gnm_float *skew, gnm_float *kurt)
1495 {
1496 Workbook *wb = workbook_new ();
1497 Sheet *sheet;
1498 gnm_float *res = g_new (gnm_float, N);
1499 int i;
1500 char *s;
1501 int cols = 2, rows = N;
1502
1503 g_printerr ("Testing %s\n", expr);
1504
1505 gnm_sheet_suggest_size (&cols, &rows);
1506 sheet = workbook_sheet_add (wb, -1, cols, rows);
1507
1508 for (i = 0; i < N; i++)
1509 define_cell (sheet, 0, i, expr);
1510
1511 s = g_strdup_printf ("=average(a1:a%d)", N);
1512 define_cell (sheet, 1, 0, s);
1513 g_free (s);
1514
1515 s = g_strdup_printf ("=var(a1:a%d)", N);
1516 define_cell (sheet, 1, 1, s);
1517 g_free (s);
1518
1519 s = g_strdup_printf ("=skew(a1:a%d)", N);
1520 define_cell (sheet, 1, 2, s);
1521 g_free (s);
1522
1523 s = g_strdup_printf ("=kurt(a1:a%d)", N);
1524 define_cell (sheet, 1, 3, s);
1525 g_free (s);
1526
1527 /* Force recalc of all dirty cells even in manual mode. */
1528 workbook_recalc (sheet->workbook);
1529
1530 for (i = 0; i < N; i++)
1531 res[i] = value_get_as_float (sheet_cell_get (sheet, 0, i)->value);
1532 *mean = value_get_as_float (sheet_cell_get (sheet, 1, 0)->value);
1533 g_printerr ("Mean: %.10" GNM_FORMAT_g "\n", *mean);
1534
1535 *var = value_get_as_float (sheet_cell_get (sheet, 1, 1)->value);
1536 g_printerr ("Var: %.10" GNM_FORMAT_g "\n", *var);
1537
1538 *skew = value_get_as_float (sheet_cell_get (sheet, 1, 2)->value);
1539 g_printerr ("Skew: %.10" GNM_FORMAT_g "\n", *skew);
1540
1541 *kurt = value_get_as_float (sheet_cell_get (sheet, 1, 3)->value);
1542 g_printerr ("Kurt: %.10" GNM_FORMAT_g "\n", *kurt);
1543
1544 g_object_unref (wb);
1545 return res;
1546 }
1547
1548 static gnm_float *
1549 test_random_normality (int N, const char *expr,
1550 gnm_float *mean, gnm_float *var,
1551 gnm_float *adtest, gnm_float *cvmtest,
1552 gnm_float *lkstest, gnm_float *sftest)
1553 {
1554 Workbook *wb = workbook_new ();
1555 Sheet *sheet;
1556 gnm_float *res = g_new (gnm_float, N);
1557 int i;
1558 char *s;
1559 int cols = 2, rows = N;
1560
1561 g_printerr ("Testing %s\n", expr);
1562
1563 gnm_sheet_suggest_size (&cols, &rows);
1564 sheet = workbook_sheet_add (wb, -1, cols, rows);
1565
1566 for (i = 0; i < N; i++)
1567 define_cell (sheet, 0, i, expr);
1568
1569 s = g_strdup_printf ("=average(a1:a%d)", N);
1570 define_cell (sheet, 1, 0, s);
1571 g_free (s);
1572
1573 s = g_strdup_printf ("=var(a1:a%d)", N);
1574 define_cell (sheet, 1, 1, s);
1575 g_free (s);
1576
1577 s = g_strdup_printf ("=adtest(a1:a%d)", N);
1578 define_cell (sheet, 1, 2, s);
1579 g_free (s);
1580
1581 s = g_strdup_printf ("=cvmtest(a1:a%d)", N);
1582 define_cell (sheet, 1, 3, s);
1583 g_free (s);
1584
1585 s = g_strdup_printf ("=lkstest(a1:a%d)", N);
1586 define_cell (sheet, 1, 4, s);
1587 g_free (s);
1588
1589 s = g_strdup_printf ("=sftest(a1:a%d)", N > 5000 ? 5000 : N);
1590 define_cell (sheet, 1, 5, s);
1591 g_free (s);
1592
1593 /* Force recalc of all dirty cells even in manual mode. */
1594 workbook_recalc (sheet->workbook);
1595
1596 for (i = 0; i < N; i++)
1597 res[i] = value_get_as_float (sheet_cell_get (sheet, 0, i)->value);
1598 *mean = value_get_as_float (sheet_cell_get (sheet, 1, 0)->value);
1599 g_printerr ("Mean: %.10" GNM_FORMAT_g "\n", *mean);
1600
1601 *var = value_get_as_float (sheet_cell_get (sheet, 1, 1)->value);
1602 g_printerr ("Var: %.10" GNM_FORMAT_g "\n", *var);
1603
1604 *adtest = value_get_as_float (sheet_cell_get (sheet, 1, 2)->value);
1605 g_printerr ("ADTest: %.10" GNM_FORMAT_g "\n", *adtest);
1606
1607 *cvmtest = value_get_as_float (sheet_cell_get (sheet, 1, 3)->value);
1608 g_printerr ("CVMTest: %.10" GNM_FORMAT_g "\n", *cvmtest);
1609
1610 *lkstest = value_get_as_float (sheet_cell_get (sheet, 1, 4)->value);
1611 g_printerr ("LKSTest: %.10" GNM_FORMAT_g "\n", *lkstest);
1612
1613 *sftest = value_get_as_float (sheet_cell_get (sheet, 1, 5)->value);
1614 g_printerr ("SFTest: %.10" GNM_FORMAT_g "\n", *sftest);
1615
1616 g_object_unref (wb);
1617 return res;
1618 }
1619
1620 static void
1621 test_random_rand (int N)
1622 {
1623 gnm_float mean, var, skew, kurt;
1624 gnm_float mean_target = 0.5;
1625 gnm_float var_target = 1.0 / 12;
1626 gnm_float skew_target = 0;
1627 gnm_float kurt_target = -6.0 / 5;
1628 gnm_float *vals;
1629 int i;
1630 gboolean ok;
1631 gnm_float T;
1632 gnm_float fractiles[10];
1633 const int nf = G_N_ELEMENTS (fractiles);
1634
1635 vals = test_random_1 (N, "=RAND()", &mean, &var, &skew, &kurt);
1636 ok = TRUE;
1637 for (i = 0; i < N; i++) {
1638 gnm_float r = vals[i];
1639 if (!(r >= 0 && r < 1)) {
1640 g_printerr ("Range failure.\n");
1641 ok = FALSE;
1642 break;
1643 }
1644 }
1645
1646 T = mean_target;
1647 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
1648 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
1649 ok = FALSE;
1650 }
1651 T = var_target;
1652 if (gnm_abs (var - T) > 0.01) {
1653 g_printerr ("Var failure.\n");
1654 ok = FALSE;
1655 }
1656 T = skew_target;
1657 if (gnm_abs (skew - T) > 0.05) {
1658 g_printerr ("Skew failure.\n");
1659 ok = FALSE;
1660 }
1661 T = kurt_target;
1662 if (gnm_abs (kurt - T) > 0.05) {
1663 g_printerr ("Kurt failure.\n");
1664 ok = FALSE;
1665 }
1666
1667 /* Fractile test */
1668 for (i = 1; i < nf; i++)
1669 fractiles[i] = i / (double)nf;
1670 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
1671 ok = FALSE;
1672
1673 if (ok)
1674 g_printerr ("OK\n");
1675 else
1676 add_random_fail ("RAND");
1677 g_printerr ("\n");
1678
1679 g_free (vals);
1680 }
1681
1682 static void
1683 test_random_randuniform (int N)
1684 {
1685 gnm_float mean, var, skew, kurt;
1686 gnm_float *vals;
1687 gboolean ok;
1688 gnm_float lsign = (random_01 () > 0.75 ? 1 : -1);
1689 gnm_float param_l = lsign * gnm_floor (1 / (0.0001 + gnm_pow (random_01 (), 4)));
1690 gnm_float param_h = param_l + gnm_floor (1 / (0.0001 + gnm_pow (random_01 () / 2, 4)));
1691 gnm_float n = param_h - param_l;
1692 gnm_float mean_target = (param_l + param_h) / 2;
1693 gnm_float var_target = (n * n) / 12;
1694 gnm_float skew_target = 0;
1695 gnm_float kurt_target = -6 / 5.0;
1696 char *expr;
1697 gnm_float T;
1698 int i;
1699 gnm_float fractiles[10];
1700 const int nf = G_N_ELEMENTS (fractiles);
1701
1702 expr = g_strdup_printf ("=RANDUNIFORM(%.10" GNM_FORMAT_g ",%.10" GNM_FORMAT_g ")", param_l, param_h);
1703 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
1704 g_free (expr);
1705
1706 ok = TRUE;
1707 for (i = 0; i < N; i++) {
1708 gnm_float r = vals[i];
1709 if (!(r >= param_l && r < param_h)) {
1710 g_printerr ("Range failure.\n");
1711 ok = FALSE;
1712 break;
1713 }
1714 }
1715
1716 T = mean_target;
1717 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
1718 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
1719 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
1720 ok = FALSE;
1721 }
1722
1723 T = var_target;
1724 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
1725 if (!(var >= 0 && gnm_finite (var))) {
1726 /* That is a very simplistic test! */
1727 g_printerr ("Var failure.\n");
1728 ok = FALSE;
1729 }
1730
1731 T = skew_target;
1732 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
1733 if (!gnm_finite (skew)) {
1734 /* That is a very simplistic test! */
1735 g_printerr ("Skew failure.\n");
1736 ok = FALSE;
1737 }
1738
1739 T = kurt_target;
1740 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
1741 if (!(kurt >= -3 && gnm_finite (kurt))) {
1742 /* That is a very simplistic test! */
1743 g_printerr ("Kurt failure.\n");
1744 ok = FALSE;
1745 }
1746
1747 /* Fractile test */
1748 for (i = 1; i < nf; i++)
1749 fractiles[i] = param_l + n * i / (double)nf;
1750 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
1751 ok = FALSE;
1752
1753 if (ok)
1754 g_printerr ("OK\n");
1755 else
1756 add_random_fail ("RANDUNIFORM");
1757 g_printerr ("\n");
1758
1759 g_free (vals);
1760 }
1761
1762 static void
1763 test_random_randbernoulli (int N)
1764 {
1765 gnm_float p = 0.3;
1766 gnm_float q = 1 - p;
1767 gnm_float mean, var, skew, kurt;
1768 gnm_float mean_target = p;
1769 gnm_float var_target = p * (1 - p);
1770 gnm_float skew_target = (q - p) / gnm_sqrt (p * q);
1771 gnm_float kurt_target = (1 - 6 * p * q) / (p * q);
1772 gnm_float *vals;
1773 int i;
1774 gboolean ok;
1775 char *expr;
1776 gnm_float T;
1777
1778 expr = g_strdup_printf ("=RANDBERNOULLI(%.10" GNM_FORMAT_g ")", p);
1779 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
1780 g_free (expr);
1781
1782 ok = TRUE;
1783 for (i = 0; i < N; i++) {
1784 gnm_float r = vals[i];
1785 if (!(r == 0 || r == 1)) {
1786 g_printerr ("Range failure.\n");
1787 ok = FALSE;
1788 break;
1789 }
1790 }
1791
1792 T = mean_target;
1793 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
1794 if (gnm_abs (mean - p) > 0.01) {
1795 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
1796 ok = FALSE;
1797 }
1798
1799 T = var_target;
1800 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
1801 if (gnm_abs (var - T) > 0.01) {
1802 g_printerr ("Var failure.\n");
1803 ok = FALSE;
1804 }
1805
1806 T = skew_target;
1807 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
1808 if (!(gnm_abs (skew - T) <= 0.10 * gnm_abs (T))) {
1809 g_printerr ("Skew failure.\n");
1810 ok = FALSE;
1811 }
1812
1813 T = kurt_target;
1814 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
1815 if (!(gnm_abs (kurt - T) <= 0.15 * gnm_abs (T))) {
1816 g_printerr ("Kurt failure.\n");
1817 ok = FALSE;
1818 }
1819 if (ok)
1820 g_printerr ("OK\n");
1821 else
1822 add_random_fail ("RANDBERNOULLI");
1823 g_printerr ("\n");
1824
1825 g_free (vals);
1826 }
1827
1828 static void
1829 test_random_randdiscrete (int N)
1830 {
1831 gnm_float mean, var, skew, kurt;
1832 gnm_float *vals;
1833 int i;
1834 gboolean ok;
1835 gnm_float mean_target = 13;
1836 gnm_float var_target = 156;
1837 gnm_float skew_target = 0.6748;
1838 gnm_float kurt_target = -0.9057;
1839 char *expr;
1840 gnm_float T;
1841
1842 expr = g_strdup_printf ("=RANDDISCRETE({0;1;4;9;16;25;36})");
1843 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
1844 g_free (expr);
1845
1846 ok = TRUE;
1847 for (i = 0; i < N; i++) {
1848 gnm_float r = vals[i];
1849 if (!(r >= 0 && r <= 36 && gnm_sqrt (r) == gnm_floor (gnm_sqrt (r)))) {
1850 g_printerr ("Range failure.\n");
1851 ok = FALSE;
1852 break;
1853 }
1854 }
1855
1856 T = mean_target;
1857 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
1858 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
1859 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
1860 ok = FALSE;
1861 }
1862
1863 T = var_target;
1864 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
1865 if (!(var >= 0 && gnm_finite (var))) {
1866 /* That is a very simplistic test! */
1867 g_printerr ("Var failure.\n");
1868 ok = FALSE;
1869 }
1870
1871 T = skew_target;
1872 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
1873 if (!gnm_finite (skew)) {
1874 /* That is a very simplistic test! */
1875 g_printerr ("Skew failure.\n");
1876 ok = FALSE;
1877 }
1878
1879 T = kurt_target;
1880 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
1881 if (!(kurt >= -3 && gnm_finite (kurt))) {
1882 /* That is a very simplistic test! */
1883 g_printerr ("Kurt failure.\n");
1884 ok = FALSE;
1885 }
1886
1887 if (ok)
1888 g_printerr ("OK\n");
1889 else
1890 add_random_fail ("RANDDISCRETE");
1891 g_printerr ("\n");
1892
1893 g_free (vals);
1894 }
1895
1896 static void
1897 test_random_randnorm (int N)
1898 {
1899 gnm_float mean, var, adtest, cvmtest, lkstest, sftest;
1900 gnm_float mean_target = 0, var_target = 1;
1901 gnm_float *vals;
1902 gboolean ok;
1903 char *expr;
1904 gnm_float T;
1905 int i;
1906 gnm_float fractiles[10];
1907 const int nf = G_N_ELEMENTS (fractiles);
1908
1909 expr = g_strdup_printf ("=RANDNORM(%.10" GNM_FORMAT_g ",%.10" GNM_FORMAT_g ")",
1910 mean_target, var_target);
1911 vals = test_random_normality (N, expr, &mean, &var, &adtest, &cvmtest, &lkstest, &sftest);
1912 g_free (expr);
1913
1914 ok = TRUE;
1915 for (i = 0; i < N; i++) {
1916 gnm_float r = vals[i];
1917 if (!gnm_finite (r)) {
1918 g_printerr ("Range failure.\n");
1919 ok = FALSE;
1920 break;
1921 }
1922 }
1923
1924 T = mean_target;
1925 if (gnm_abs (mean - T) > 0.02) {
1926 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
1927 ok = FALSE;
1928 }
1929 T = var_target;
1930 if (gnm_abs (var - T) > 0.02) {
1931 g_printerr ("Var failure.\n");
1932 ok = FALSE;
1933 }
1934
1935 /* Fractile test */
1936 for (i = 1; i < nf; i++)
1937 fractiles[i] = qnorm (i / (double)nf, mean_target, gnm_sqrt (var_target), TRUE, FALSE);
1938 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
1939 ok = FALSE;
1940
1941 if (adtest < 0.01) {
1942 g_printerr ("Anderson Darling Test rejected [%.10" GNM_FORMAT_g "]\n", adtest);
1943 ok = FALSE;
1944 }
1945 if (cvmtest < 0.01) {
1946 g_printerr ("Cramér-von Mises Test rejected [%.10" GNM_FORMAT_g "]\n", cvmtest);
1947 ok = FALSE;
1948 }
1949 if (lkstest < 0.01) {
1950 g_printerr ("Lilliefors (Kolmogorov-Smirnov) Test rejected [%.10" GNM_FORMAT_g "]\n",
1951 lkstest);
1952 ok = FALSE;
1953 }
1954 if (sftest < 0.01) {
1955 g_printerr ("Shapiro-Francia Test rejected [%.10" GNM_FORMAT_g "]\n", sftest);
1956 ok = FALSE;
1957 }
1958
1959 if (ok)
1960 g_printerr ("OK\n");
1961 else
1962 add_random_fail ("RANDNORM");
1963 g_printerr ("\n");
1964
1965 g_free (vals);
1966 }
1967
1968 static void
1969 test_random_randsnorm (int N)
1970 {
1971 gnm_float mean, var, skew, kurt;
1972 gnm_float *vals;
1973 gboolean ok;
1974 gnm_float alpha = 5;
1975 gnm_float delta = alpha/gnm_sqrt(1+alpha*alpha);
1976 gnm_float mean_target = delta * gnm_sqrt (2/M_PIgnum);
1977 gnm_float var_target = 1-mean_target*mean_target;
1978 char *expr;
1979 gnm_float T;
1980 int i;
1981
1982 expr = g_strdup_printf ("=RANDSNORM(%.10" GNM_FORMAT_g ")", alpha);
1983 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
1984 g_free (expr);
1985
1986 ok = TRUE;
1987 for (i = 0; i < N; i++) {
1988 gnm_float r = vals[i];
1989 if (!gnm_finite (r)) {
1990 g_printerr ("Range failure.\n");
1991 ok = FALSE;
1992 break;
1993 }
1994 }
1995
1996 T = mean_target;
1997 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
1998 if (gnm_abs (mean - T) > 0.01) {
1999 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2000 ok = FALSE;
2001 }
2002
2003 T = var_target;
2004 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2005 if (gnm_abs (var - T) > 0.01) {
2006 g_printerr ("Var failure.\n");
2007 ok = FALSE;
2008 }
2009
2010 T = mean_target/gnm_sqrt(var_target);
2011 T = T*T*T*(4-M_PIgnum)/2;
2012 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2013 if (gnm_abs (skew - T) > 0.05) {
2014 g_printerr ("Skew failure.\n");
2015 ok = FALSE;
2016 }
2017
2018 T = 2*(M_PIgnum - 3)*mean_target*mean_target*mean_target*mean_target/(var_target*var_target);
2019 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2020 if (gnm_abs (kurt - T) > 0.15) {
2021 g_printerr ("Kurt failure.\n");
2022 ok = FALSE;
2023 }
2024
2025 if (ok)
2026 g_printerr ("OK\n");
2027 else
2028 add_random_fail ("RANDSNORM");
2029 g_printerr ("\n");
2030
2031 g_free (vals);
2032 }
2033
2034 static void
2035 test_random_randexp (int N)
2036 {
2037 gnm_float mean, var, skew, kurt;
2038 gnm_float *vals;
2039 gboolean ok;
2040 gnm_float param_l = 1 / (0.0001 + gnm_pow (random_01 () / 2, 4));
2041 gnm_float mean_target = param_l;
2042 gnm_float var_target = mean_target * mean_target;
2043 gnm_float skew_target = 2;
2044 gnm_float kurt_target = 6;
2045 char *expr;
2046 gnm_float T;
2047 int i;
2048 gnm_float fractiles[10];
2049 const int nf = G_N_ELEMENTS (fractiles);
2050
2051 expr = g_strdup_printf ("=RANDEXP(%.10" GNM_FORMAT_g ")", param_l);
2052 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
2053 g_free (expr);
2054
2055 ok = TRUE;
2056 for (i = 0; i < N; i++) {
2057 gnm_float r = vals[i];
2058 if (!(r >= 0 && gnm_finite (r))) {
2059 g_printerr ("Range failure.\n");
2060 ok = FALSE;
2061 break;
2062 }
2063 }
2064
2065 T = mean_target;
2066 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
2067 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
2068 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2069 ok = FALSE;
2070 }
2071
2072 T = var_target;
2073 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2074 if (!(var >= 0 && gnm_finite (var))) {
2075 /* That is a very simplistic test! */
2076 g_printerr ("Var failure.\n");
2077 ok = FALSE;
2078 }
2079
2080 T = skew_target;
2081 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2082 if (!gnm_finite (skew)) {
2083 /* That is a very simplistic test! */
2084 g_printerr ("Skew failure.\n");
2085 ok = FALSE;
2086 }
2087
2088 T = kurt_target;
2089 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2090 if (!(kurt >= -3 && gnm_finite (kurt))) {
2091 /* That is a very simplistic test! */
2092 g_printerr ("Kurt failure.\n");
2093 ok = FALSE;
2094 }
2095
2096 /* Fractile test */
2097 for (i = 1; i < nf; i++)
2098 fractiles[i] = qexp (i / (double)nf, param_l, TRUE, FALSE);
2099 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
2100 ok = FALSE;
2101
2102 if (ok)
2103 g_printerr ("OK\n");
2104 else
2105 add_random_fail ("RANDEXP");
2106 g_printerr ("\n");
2107
2108 g_free (vals);
2109 }
2110
2111 static void
2112 test_random_randgamma (int N)
2113 {
2114 gnm_float mean, var, skew, kurt;
2115 gnm_float *vals;
2116 gboolean ok;
2117 gnm_float param_shape = gnm_floor (1 / (0.0001 + gnm_pow (random_01 (), 6)));
2118 gnm_float param_scale = 0.001 + gnm_pow (random_01 (), 4) * 1000;
2119 gnm_float mean_target = param_shape * param_scale;
2120 gnm_float var_target = mean_target * param_scale;
2121 gnm_float skew_target = 2 / gnm_sqrt (param_shape);
2122 gnm_float kurt_target = 6 / param_shape;
2123 char *expr;
2124 gnm_float T;
2125 int i;
2126 gnm_float fractiles[10];
2127 const int nf = G_N_ELEMENTS (fractiles);
2128
2129 expr = g_strdup_printf ("=RANDGAMMA(%.0" GNM_FORMAT_f ",%.10" GNM_FORMAT_g ")", param_shape, param_scale);
2130 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
2131 g_free (expr);
2132
2133 ok = TRUE;
2134 for (i = 0; i < N; i++) {
2135 gnm_float r = vals[i];
2136 if (!(r > 0 && gnm_finite (r))) {
2137 g_printerr ("Range failure.\n");
2138 ok = FALSE;
2139 break;
2140 }
2141 }
2142
2143 T = mean_target;
2144 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
2145 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
2146 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2147 ok = FALSE;
2148 }
2149
2150 T = var_target;
2151 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2152 if (!(var >= 0 && gnm_finite (var))) {
2153 /* That is a very simplistic test! */
2154 g_printerr ("Var failure.\n");
2155 ok = FALSE;
2156 }
2157
2158 T = skew_target;
2159 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2160 if (!gnm_finite (skew)) {
2161 /* That is a very simplistic test! */
2162 g_printerr ("Skew failure.\n");
2163 ok = FALSE;
2164 }
2165
2166 T = kurt_target;
2167 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2168 if (!(kurt >= -3 && gnm_finite (kurt))) {
2169 /* That is a very simplistic test! */
2170 g_printerr ("Kurt failure.\n");
2171 ok = FALSE;
2172 }
2173
2174 /* Fractile test */
2175 for (i = 1; i < nf; i++)
2176 fractiles[i] = qgamma (i / (double)nf, param_shape, param_scale, TRUE, FALSE);
2177 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
2178 ok = FALSE;
2179
2180 if (ok)
2181 g_printerr ("OK\n");
2182 else
2183 add_random_fail ("RANDGAMMA");
2184 g_printerr ("\n");
2185
2186 g_free (vals);
2187 }
2188
2189 static void
2190 test_random_randbeta (int N)
2191 {
2192 gnm_float mean, var, skew, kurt;
2193 gnm_float *vals;
2194 gboolean ok;
2195 gnm_float param_a = 1 / (0.0001 + gnm_pow (random_01 (), 6));
2196 gnm_float param_b = 1 / (0.0001 + gnm_pow (random_01 (), 6));
2197 gnm_float s = param_a + param_b;
2198 gnm_float mean_target = param_a / s;
2199 gnm_float var_target = mean_target * param_b / (s * (s + 1));
2200 gnm_float skew_target =
2201 (2 * (param_b - param_a) * gnm_sqrt (s + 1))/
2202 ((s + 2) * gnm_sqrt (param_a * param_b));
2203 gnm_float kurt_target = gnm_nan; /* Complicated */
2204 char *expr;
2205 gnm_float T;
2206 int i;
2207 gnm_float fractiles[10];
2208 const int nf = G_N_ELEMENTS (fractiles);
2209
2210 expr = g_strdup_printf ("=RANDBETA(%.10" GNM_FORMAT_g ",%.10" GNM_FORMAT_g ")", param_a, param_b);
2211 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
2212 g_free (expr);
2213
2214 ok = TRUE;
2215 for (i = 0; i < N; i++) {
2216 gnm_float r = vals[i];
2217 if (!(r >= 0 && r <= 1)) {
2218 g_printerr ("Range failure.\n");
2219 ok = FALSE;
2220 break;
2221 }
2222 }
2223
2224 T = mean_target;
2225 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
2226 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
2227 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2228 ok = FALSE;
2229 }
2230
2231 T = var_target;
2232 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2233 if (!(var >= 0 && gnm_finite (var))) {
2234 /* That is a very simplistic test! */
2235 g_printerr ("Var failure.\n");
2236 ok = FALSE;
2237 }
2238
2239 T = skew_target;
2240 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2241 if (!gnm_finite (skew)) {
2242 /* That is a very simplistic test! */
2243 g_printerr ("Skew failure.\n");
2244 ok = FALSE;
2245 }
2246
2247 T = kurt_target;
2248 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2249 if (!(kurt >= -3 && gnm_finite (kurt))) {
2250 /* That is a very simplistic test! */
2251 g_printerr ("Kurt failure.\n");
2252 ok = FALSE;
2253 }
2254
2255 /* Fractile test */
2256 for (i = 1; i < nf; i++)
2257 fractiles[i] = qbeta (i / (double)nf, param_a, param_b, TRUE, FALSE);
2258 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
2259 ok = FALSE;
2260
2261 if (ok)
2262 g_printerr ("OK\n");
2263 else
2264 add_random_fail ("RANDBETA");
2265 g_printerr ("\n");
2266
2267 g_free (vals);
2268 }
2269
2270 static void
2271 test_random_randtdist (int N)
2272 {
2273 gnm_float mean, var, skew, kurt;
2274 gnm_float *vals;
2275 gboolean ok;
2276 gnm_float param_df = 1 + gnm_floor (1 / (0.01 + gnm_pow (random_01 (), 6)));
2277 gnm_float mean_target = 0;
2278 gnm_float var_target = param_df > 2 ? param_df / (param_df - 2) : gnm_nan;
2279 gnm_float skew_target = param_df > 3 ? 0 : gnm_nan;
2280 gnm_float kurt_target = param_df > 4 ? 6 / (param_df - 4) : gnm_nan;
2281 char *expr;
2282 gnm_float T;
2283 int i;
2284 gnm_float fractiles[10];
2285 const int nf = G_N_ELEMENTS (fractiles);
2286
2287 expr = g_strdup_printf ("=RANDTDIST(%.0" GNM_FORMAT_f ")", param_df);
2288 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
2289 g_free (expr);
2290
2291 ok = TRUE;
2292 for (i = 0; i < N; i++) {
2293 gnm_float r = vals[i];
2294 if (!(gnm_finite (r))) {
2295 g_printerr ("Range failure.\n");
2296 ok = FALSE;
2297 break;
2298 }
2299 }
2300
2301 T = mean_target;
2302 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
2303 if (gnm_finite (var_target) && !(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
2304 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2305 ok = FALSE;
2306 }
2307
2308 T = var_target;
2309 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2310 if (!(var >= 0 && gnm_finite (var))) {
2311 /* That is a very simplistic test! */
2312 g_printerr ("Var failure.\n");
2313 ok = FALSE;
2314 }
2315
2316 T = skew_target;
2317 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2318 if (!gnm_finite (skew)) {
2319 /* That is a very simplistic test! */
2320 g_printerr ("Skew failure.\n");
2321 ok = FALSE;
2322 }
2323
2324 T = kurt_target;
2325 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2326 if (!(kurt >= -3 && gnm_finite (kurt))) {
2327 /* That is a very simplistic test! */
2328 g_printerr ("Kurt failure.\n");
2329 ok = FALSE;
2330 }
2331
2332 /* Fractile test */
2333 for (i = 1; i < nf; i++)
2334 fractiles[i] = qt (i / (double)nf, param_df, TRUE, FALSE);
2335 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
2336 ok = FALSE;
2337
2338 if (ok)
2339 g_printerr ("OK\n");
2340 else
2341 add_random_fail ("RANDTDIST");
2342 g_printerr ("\n");
2343
2344 g_free (vals);
2345 }
2346
2347 static void
2348 test_random_randfdist (int N)
2349 {
2350 gnm_float mean, var, skew, kurt;
2351 gnm_float *vals;
2352 gboolean ok;
2353 gnm_float param_df1 = 1 + gnm_floor (1 / (0.01 + gnm_pow (random_01 (), 6)));
2354 gnm_float param_df2 = 1 + gnm_floor (1 / (0.01 + gnm_pow (random_01 (), 6)));
2355 gnm_float mean_target = param_df2 > 2 ? param_df2 / (param_df2 - 2) : gnm_nan;
2356 gnm_float var_target = param_df2 > 4
2357 ? (2 * param_df2 * param_df2 * (param_df1 + param_df2 - 2) /
2358 (param_df1 * (param_df2 - 2) * (param_df2 - 2) * (param_df2 - 4)))
2359 : gnm_nan;
2360 gnm_float skew_target = gnm_nan; /* Complicated */
2361 gnm_float kurt_target = gnm_nan; /* Complicated */
2362 char *expr;
2363 gnm_float T;
2364 int i;
2365 gnm_float fractiles[10];
2366 const int nf = G_N_ELEMENTS (fractiles);
2367
2368 expr = g_strdup_printf ("=RANDFDIST(%.0" GNM_FORMAT_f ",%.0" GNM_FORMAT_f ")", param_df1, param_df2);
2369 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
2370 g_free (expr);
2371
2372 ok = TRUE;
2373 for (i = 0; i < N; i++) {
2374 gnm_float r = vals[i];
2375 if (!(r >= 0 && gnm_finite (r))) {
2376 g_printerr ("Range failure.\n");
2377 ok = FALSE;
2378 break;
2379 }
2380 }
2381
2382 T = mean_target;
2383 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
2384 if (gnm_finite (var_target) && !(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
2385 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2386 ok = FALSE;
2387 }
2388
2389 T = var_target;
2390 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2391 if (!(var >= 0 && gnm_finite (var))) {
2392 /* That is a very simplistic test! */
2393 g_printerr ("Var failure.\n");
2394 ok = FALSE;
2395 }
2396
2397 T = skew_target;
2398 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2399 if (!gnm_finite (skew)) {
2400 /* That is a very simplistic test! */
2401 g_printerr ("Skew failure.\n");
2402 ok = FALSE;
2403 }
2404
2405 T = kurt_target;
2406 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2407 if (!(kurt >= -3 && gnm_finite (kurt))) {
2408 /* That is a very simplistic test! */
2409 g_printerr ("Kurt failure.\n");
2410 ok = FALSE;
2411 }
2412
2413 /* Fractile test */
2414 for (i = 1; i < nf; i++)
2415 fractiles[i] = qf (i / (double)nf, param_df1, param_df2, TRUE, FALSE);
2416 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
2417 ok = FALSE;
2418
2419 if (ok)
2420 g_printerr ("OK\n");
2421 else
2422 add_random_fail ("RANDFDIST");
2423 g_printerr ("\n");
2424
2425 g_free (vals);
2426 }
2427
2428 static void
2429 test_random_randchisq (int N)
2430 {
2431 gnm_float mean, var, skew, kurt;
2432 gnm_float *vals;
2433 gboolean ok;
2434 gnm_float param_df = 1 + gnm_floor (1 / (0.01 + gnm_pow (random_01 (), 6)));
2435 gnm_float mean_target = param_df;
2436 gnm_float var_target = param_df * 2;
2437 gnm_float skew_target = gnm_sqrt (8 / param_df);
2438 gnm_float kurt_target = 12 / param_df;
2439 char *expr;
2440 gnm_float T;
2441 int i;
2442 gnm_float fractiles[10];
2443 const int nf = G_N_ELEMENTS (fractiles);
2444
2445 expr = g_strdup_printf ("=RANDCHISQ(%.10" GNM_FORMAT_g ")", param_df);
2446 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
2447 g_free (expr);
2448
2449 ok = TRUE;
2450 for (i = 0; i < N; i++) {
2451 gnm_float r = vals[i];
2452 if (!(r >= 0 && gnm_finite (r))) {
2453 g_printerr ("Range failure.\n");
2454 ok = FALSE;
2455 break;
2456 }
2457 }
2458
2459 T = mean_target;
2460 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
2461 if (gnm_finite (var_target) && !(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
2462 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2463 ok = FALSE;
2464 }
2465
2466 T = var_target;
2467 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2468 if (!(var >= 0 && gnm_finite (var))) {
2469 /* That is a very simplistic test! */
2470 g_printerr ("Var failure.\n");
2471 ok = FALSE;
2472 }
2473
2474 T = skew_target;
2475 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2476 if (!gnm_finite (skew)) {
2477 /* That is a very simplistic test! */
2478 g_printerr ("Skew failure.\n");
2479 ok = FALSE;
2480 }
2481
2482 T = kurt_target;
2483 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2484 if (!(kurt >= -3 && gnm_finite (kurt))) {
2485 /* That is a very simplistic test! */
2486 g_printerr ("Kurt failure.\n");
2487 ok = FALSE;
2488 }
2489
2490 /* Fractile test */
2491 for (i = 1; i < nf; i++)
2492 fractiles[i] = qchisq (i / (double)nf, param_df, TRUE, FALSE);
2493 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
2494 ok = FALSE;
2495
2496 if (ok)
2497 g_printerr ("OK\n");
2498 else
2499 add_random_fail ("RANDCHISQ");
2500 g_printerr ("\n");
2501
2502 g_free (vals);
2503 }
2504
2505 static void
2506 test_random_randcauchy (int N)
2507 {
2508 gnm_float mean, var, skew, kurt;
2509 gnm_float *vals;
2510 gboolean ok;
2511 gnm_float param_scale = 0.001 + gnm_pow (random_01 (), 4) * 1000;
2512 gnm_float mean_target = gnm_nan;
2513 gnm_float var_target = gnm_nan;
2514 gnm_float skew_target = gnm_nan;
2515 gnm_float kurt_target = gnm_nan;
2516 char *expr;
2517 gnm_float T;
2518 int i;
2519 gnm_float fractiles[10];
2520 const int nf = G_N_ELEMENTS (fractiles);
2521
2522 /*
2523 * The distribution has no mean, no variance, no skew, and no kurtosis.
2524 * The support is all reals.
2525 */
2526
2527 expr = g_strdup_printf ("=RANDCAUCHY(%.10" GNM_FORMAT_g ")", param_scale);
2528 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
2529 g_free (expr);
2530
2531 ok = TRUE;
2532 for (i = 0; i < N; i++) {
2533 gnm_float r = vals[i];
2534 if (!(gnm_finite (r))) {
2535 g_printerr ("Range failure.\n");
2536 ok = FALSE;
2537 break;
2538 }
2539 }
2540
2541 T = mean_target;
2542 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
2543 if (gnm_finite (var_target) && !(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
2544 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2545 ok = FALSE;
2546 }
2547
2548 T = var_target;
2549 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2550 if (!(var >= 0 && gnm_finite (var))) {
2551 /* That is a very simplistic test! */
2552 g_printerr ("Var failure.\n");
2553 ok = FALSE;
2554 }
2555
2556 T = skew_target;
2557 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2558 if (!gnm_finite (skew)) {
2559 /* That is a very simplistic test! */
2560 g_printerr ("Skew failure.\n");
2561 ok = FALSE;
2562 }
2563
2564 T = kurt_target;
2565 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2566 if (!(kurt >= -3 && gnm_finite (kurt))) {
2567 /* That is a very simplistic test! */
2568 g_printerr ("Kurt failure.\n");
2569 ok = FALSE;
2570 }
2571
2572 /* Fractile test */
2573 for (i = 1; i < nf; i++)
2574 fractiles[i] = qcauchy (i / (double)nf, 0.0, param_scale, TRUE, FALSE);
2575 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
2576 ok = FALSE;
2577
2578 if (ok)
2579 g_printerr ("OK\n");
2580 else
2581 add_random_fail ("RANDCAUCHY");
2582 g_printerr ("\n");
2583
2584 g_free (vals);
2585 }
2586
2587 static void
2588 test_random_randbinom (int N)
2589 {
2590 gnm_float mean, var, skew, kurt;
2591 gnm_float *vals;
2592 gboolean ok;
2593 gnm_float param_p = random_01 ();
2594 gnm_float param_trials = gnm_floor (1 / (0.0001 + gnm_pow (random_01 (), 4)));
2595 gnm_float mean_target = param_trials * param_p;
2596 gnm_float var_target = mean_target * (1 - param_p);
2597 gnm_float skew_target = (1 - 2 * param_p) / gnm_sqrt (var_target);
2598 gnm_float kurt_target = (1 - 6 * param_p * (1 - param_p)) / var_target;
2599 char *expr;
2600 gnm_float T;
2601 int i;
2602 gnm_float fractiles[10], probs[10];
2603 const int nf = G_N_ELEMENTS (fractiles);
2604
2605 expr = g_strdup_printf ("=RANDBINOM(%.10" GNM_FORMAT_g ",%.0" GNM_FORMAT_f ")", param_p, param_trials);
2606 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
2607 g_free (expr);
2608
2609 ok = TRUE;
2610 for (i = 0; i < N; i++) {
2611 gnm_float r = vals[i];
2612 if (!(r >= 0 && r <= param_trials && r == gnm_floor (r))) {
2613 g_printerr ("Range failure.\n");
2614 ok = FALSE;
2615 break;
2616 }
2617 }
2618
2619 T = mean_target;
2620 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
2621 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
2622 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2623 ok = FALSE;
2624 }
2625
2626 T = var_target;
2627 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2628 if (!(var >= 0 && gnm_finite (var))) {
2629 /* That is a very simplistic test! */
2630 g_printerr ("Var failure.\n");
2631 ok = FALSE;
2632 }
2633
2634 T = skew_target;
2635 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2636 if (!gnm_finite (skew)) {
2637 /* That is a very simplistic test! */
2638 g_printerr ("Skew failure.\n");
2639 ok = FALSE;
2640 }
2641
2642 T = kurt_target;
2643 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2644 if (!(kurt >= -3 && gnm_finite (kurt))) {
2645 /* That is a very simplistic test! */
2646 g_printerr ("Kurt failure.\n");
2647 ok = FALSE;
2648 }
2649
2650 /* Fractile test */
2651 for (i = 1; i < nf; i++) {
2652 fractiles[i] = qbinom (i / (double)nf, param_trials, param_p, TRUE, FALSE);
2653 probs[i] = pbinom (fractiles[i], param_trials, param_p, TRUE, FALSE);
2654 }
2655 if (!rand_fractile_test (vals, N, nf, fractiles, probs))
2656 ok = FALSE;
2657
2658 if (ok)
2659 g_printerr ("OK\n");
2660 else
2661 add_random_fail ("RANDBINOM");
2662 g_printerr ("\n");
2663
2664 g_free (vals);
2665 }
2666
2667 static void
2668 test_random_randnegbinom (int N)
2669 {
2670 gnm_float mean, var, skew, kurt;
2671 gnm_float *vals;
2672 gboolean ok;
2673 gnm_float param_p = random_01 ();
2674 gnm_float param_fails = gnm_floor (1 / (0.0001 + gnm_pow (random_01 (), 4)));
2675 /* Warning: these differ from Wikipedia by swapping p and 1-p. */
2676 gnm_float mean_target = param_fails * (1 - param_p) / param_p;
2677 gnm_float var_target = mean_target / param_p;
2678 gnm_float skew_target = (2 - param_p) / gnm_sqrt (param_fails * (1 - param_p));
2679 gnm_float kurt_target = 6 / param_fails + 1 / var_target;
2680 char *expr;
2681 gnm_float T;
2682 int i;
2683 gnm_float fractiles[10], probs[10];
2684 const int nf = G_N_ELEMENTS (fractiles);
2685
2686 expr = g_strdup_printf ("=RANDNEGBINOM(%.10" GNM_FORMAT_g ",%.0" GNM_FORMAT_f ")", param_p, param_fails);
2687 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
2688 g_free (expr);
2689
2690 ok = TRUE;
2691 for (i = 0; i < N; i++) {
2692 gnm_float r = vals[i];
2693 if (!(r >= 0 && gnm_finite (r) && r == gnm_floor (r))) {
2694 g_printerr ("Range failure.\n");
2695 ok = FALSE;
2696 break;
2697 }
2698 }
2699
2700 T = mean_target;
2701 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
2702 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
2703 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2704 ok = FALSE;
2705 }
2706
2707 T = var_target;
2708 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2709 if (!(var >= 0 && gnm_finite (var))) {
2710 /* That is a very simplistic test! */
2711 g_printerr ("Var failure.\n");
2712 ok = FALSE;
2713 }
2714
2715 T = skew_target;
2716 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2717 if (!gnm_finite (skew)) {
2718 /* That is a very simplistic test! */
2719 g_printerr ("Skew failure.\n");
2720 ok = FALSE;
2721 }
2722
2723 T = kurt_target;
2724 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2725 if (!(kurt >= -3 && gnm_finite (kurt))) {
2726 /* That is a very simplistic test! */
2727 g_printerr ("Kurt failure.\n");
2728 ok = FALSE;
2729 }
2730
2731 /* Fractile test */
2732 for (i = 1; i < nf; i++) {
2733 fractiles[i] = qnbinom (i / (double)nf, param_fails, param_p, TRUE, FALSE);
2734 probs[i] = pnbinom (fractiles[i], param_fails, param_p, TRUE, FALSE);
2735 }
2736 if (!rand_fractile_test (vals, N, nf, fractiles, probs))
2737 ok = FALSE;
2738
2739 if (ok)
2740 g_printerr ("OK\n");
2741 else
2742 add_random_fail ("RANDNEGBINOM");
2743 g_printerr ("\n");
2744
2745 g_free (vals);
2746 }
2747
2748 static void
2749 test_random_randhyperg (int N)
2750 {
2751 gnm_float mean, var, skew, kurt;
2752 gnm_float *vals;
2753 gboolean ok;
2754 gnm_float param_nr = gnm_floor (1 / (0.01 + gnm_pow (random_01 (), 4)));
2755 gnm_float param_nb = gnm_floor (1 / (0.01 + gnm_pow (random_01 (), 4)));
2756 gnm_float s = param_nr + param_nb;
2757 gnm_float param_n = gnm_floor (random_01 () * (s + 1));
2758 gnm_float mean_target = param_n * param_nr / s;
2759 gnm_float var_target = s > 1
2760 ? mean_target * (param_nb / s) * (s - param_n) / (s - 1)
2761 : 0;
2762 gnm_float skew_target = gnm_nan; /* Complicated */
2763 gnm_float kurt_target = gnm_nan; /* Complicated */
2764 char *expr;
2765 gnm_float T;
2766 int i;
2767 gnm_float fractiles[10], probs[10];
2768 const int nf = G_N_ELEMENTS (fractiles);
2769
2770 expr = g_strdup_printf ("=RANDHYPERG(%.10" GNM_FORMAT_g ",%.0" GNM_FORMAT_f ",%.0" GNM_FORMAT_f ")", param_nr, param_nb, param_n);
2771 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
2772 g_free (expr);
2773
2774 ok = TRUE;
2775 for (i = 0; i < N; i++) {
2776 gnm_float r = vals[i];
2777 if (!(r >= 0 && r <= param_n && r == gnm_floor (r))) {
2778 g_printerr ("Range failure.\n");
2779 ok = FALSE;
2780 break;
2781 }
2782 }
2783
2784 T = mean_target;
2785 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
2786 if (gnm_finite (var_target) &&
2787 !(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
2788 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2789 ok = FALSE;
2790 }
2791
2792 T = var_target;
2793 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2794 if (!(var >= 0 && gnm_finite (var))) {
2795 /* That is a very simplistic test! */
2796 g_printerr ("Var failure.\n");
2797 ok = FALSE;
2798 }
2799
2800 T = skew_target;
2801 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2802 if (!gnm_finite (skew)) {
2803 /* That is a very simplistic test! */
2804 g_printerr ("Skew failure.\n");
2805 ok = FALSE;
2806 }
2807
2808 T = kurt_target;
2809 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2810 if (!(kurt >= -3 && gnm_finite (kurt))) {
2811 /* That is a very simplistic test! */
2812 g_printerr ("Kurt failure.\n");
2813 ok = FALSE;
2814 }
2815
2816 /* Fractile test */
2817 for (i = 1; i < nf; i++) {
2818 fractiles[i] = qhyper (i / (double)nf, param_nr, param_nb, param_n, TRUE, FALSE);
2819 probs[i] = phyper (fractiles[i], param_nr, param_nb, param_n, TRUE, FALSE);
2820 }
2821 if (!rand_fractile_test (vals, N, nf, fractiles, probs))
2822 ok = FALSE;
2823
2824 if (ok)
2825 g_printerr ("OK\n");
2826 else
2827 add_random_fail ("RANDHYPERG");
2828 g_printerr ("\n");
2829
2830 g_free (vals);
2831 }
2832
2833 static void
2834 test_random_randbetween (int N)
2835 {
2836 gnm_float mean, var, skew, kurt;
2837 gnm_float *vals;
2838 gboolean ok;
2839 gnm_float lsign = (random_01 () > 0.75 ? 1 : -1);
2840 gnm_float param_l = lsign * gnm_floor (1 / (0.0001 + gnm_pow (random_01 (), 4)));
2841 gnm_float param_h = param_l + gnm_floor (1 / (0.0001 + gnm_pow (random_01 () / 2, 4)));
2842 gnm_float n = param_h - param_l + 1;
2843 gnm_float mean_target = (param_l + param_h) / 2;
2844 gnm_float var_target = (n * n - 1) / 12;
2845 gnm_float skew_target = 0;
2846 gnm_float kurt_target = (n * n + 1) / (n * n - 1) * -6 / 5;
2847 char *expr;
2848 gnm_float T;
2849 int i;
2850
2851 expr = g_strdup_printf ("=RANDBETWEEN(%.0" GNM_FORMAT_f ",%.0" GNM_FORMAT_f ")", param_l, param_h);
2852 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
2853 g_free (expr);
2854
2855 ok = TRUE;
2856 for (i = 0; i < N; i++) {
2857 gnm_float r = vals[i];
2858 if (!(r >= param_l && r <= param_h && r == gnm_floor (r))) {
2859 g_printerr ("Range failure.\n");
2860 ok = FALSE;
2861 break;
2862 }
2863 }
2864
2865 T = mean_target;
2866 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
2867 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
2868 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2869 ok = FALSE;
2870 }
2871
2872 T = var_target;
2873 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2874 if (!(var >= 0 && gnm_finite (var))) {
2875 /* That is a very simplistic test! */
2876 g_printerr ("Var failure.\n");
2877 ok = FALSE;
2878 }
2879
2880 T = skew_target;
2881 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2882 if (!gnm_finite (skew)) {
2883 /* That is a very simplistic test! */
2884 g_printerr ("Skew failure.\n");
2885 ok = FALSE;
2886 }
2887
2888 T = kurt_target;
2889 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2890 if (!(kurt >= -3 && gnm_finite (kurt))) {
2891 /* That is a very simplistic test! */
2892 g_printerr ("Kurt failure.\n");
2893 ok = FALSE;
2894 }
2895
2896 if (ok)
2897 g_printerr ("OK\n");
2898 else
2899 add_random_fail ("RANDBETWEEN");
2900 g_printerr ("\n");
2901
2902 g_free (vals);
2903 }
2904
2905 static void
2906 test_random_randpoisson (int N)
2907 {
2908 gnm_float mean, var, skew, kurt;
2909 gnm_float *vals;
2910 gboolean ok;
2911 gnm_float param_l = 1 / (0.0001 + gnm_pow (random_01 () / 2, 4));
2912 gnm_float mean_target = param_l;
2913 gnm_float var_target = param_l;
2914 gnm_float skew_target = 1 / gnm_sqrt (param_l);
2915 gnm_float kurt_target = 1 / param_l;
2916 char *expr;
2917 gnm_float T;
2918 int i;
2919 gnm_float fractiles[10], probs[10];
2920 const int nf = G_N_ELEMENTS (fractiles);
2921
2922 expr = g_strdup_printf ("=RANDPOISSON(%.10" GNM_FORMAT_g ")", param_l);
2923 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
2924 g_free (expr);
2925
2926 ok = TRUE;
2927 for (i = 0; i < N; i++) {
2928 gnm_float r = vals[i];
2929 if (!(r >= 0 && gnm_finite (r) && r == gnm_floor (r))) {
2930 g_printerr ("Range failure.\n");
2931 ok = FALSE;
2932 break;
2933 }
2934 }
2935
2936 T = mean_target;
2937 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
2938 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
2939 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
2940 ok = FALSE;
2941 }
2942
2943 T = var_target;
2944 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
2945 if (!(var >= 0 && gnm_finite (var))) {
2946 /* That is a very simplistic test! */
2947 g_printerr ("Var failure.\n");
2948 ok = FALSE;
2949 }
2950
2951 T = skew_target;
2952 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
2953 if (!gnm_finite (skew)) {
2954 /* That is a very simplistic test! */
2955 g_printerr ("Skew failure.\n");
2956 ok = FALSE;
2957 }
2958
2959 T = kurt_target;
2960 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
2961 if (!(kurt >= -3 && gnm_finite (kurt))) {
2962 /* That is a very simplistic test! */
2963 g_printerr ("Kurt failure.\n");
2964 ok = FALSE;
2965 }
2966
2967 /* Fractile test */
2968 for (i = 1; i < nf; i++) {
2969 fractiles[i] = qpois (i / (double)nf, param_l, TRUE, FALSE);
2970 probs[i] = ppois (fractiles[i], param_l, TRUE, FALSE);
2971 }
2972 if (!rand_fractile_test (vals, N, nf, fractiles, probs))
2973 ok = FALSE;
2974
2975 if (ok)
2976 g_printerr ("OK\n");
2977 else
2978 add_random_fail ("RANDPOISSON");
2979 g_printerr ("\n");
2980
2981 g_free (vals);
2982 }
2983
2984 /*
2985 * Note: this geometric distribution is the only with support {0,1,2,...}
2986 */
2987 static void
2988 test_random_randgeom (int N)
2989 {
2990 gnm_float mean, var, skew, kurt;
2991 gnm_float *vals;
2992 gboolean ok;
2993 gnm_float param_p = random_01 ();
2994 gnm_float mean_target = (1 - param_p) / param_p;
2995 gnm_float var_target = (1 - param_p) / (param_p * param_p);
2996 gnm_float skew_target = (2 - param_p) / gnm_sqrt (1 - param_p);
2997 gnm_float kurt_target = 6 + (param_p * param_p) / (1 - param_p);
2998 char *expr;
2999 gnm_float T;
3000 int i;
3001 gnm_float fractiles[10], probs[10];
3002 const int nf = G_N_ELEMENTS (fractiles);
3003
3004 expr = g_strdup_printf ("=RANDGEOM(%.10" GNM_FORMAT_g ")", param_p);
3005 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
3006 g_free (expr);
3007
3008 ok = TRUE;
3009 for (i = 0; i < N; i++) {
3010 gnm_float r = vals[i];
3011 if (!(r >= 0 && gnm_finite (r) && r == gnm_floor (r))) {
3012 g_printerr ("Range failure.\n");
3013 ok = FALSE;
3014 break;
3015 }
3016 }
3017
3018 T = mean_target;
3019 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
3020 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
3021 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
3022 ok = FALSE;
3023 }
3024
3025 T = var_target;
3026 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
3027 if (!(var >= 0 && gnm_finite (var))) {
3028 /* That is a very simplistic test! */
3029 g_printerr ("Var failure.\n");
3030 ok = FALSE;
3031 }
3032
3033 T = skew_target;
3034 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
3035 if (!gnm_finite (skew)) {
3036 /* That is a very simplistic test! */
3037 g_printerr ("Skew failure.\n");
3038 ok = FALSE;
3039 }
3040
3041 T = kurt_target;
3042 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
3043 if (!(kurt >= -3 && gnm_finite (kurt))) {
3044 /* That is a very simplistic test! */
3045 g_printerr ("Kurt failure.\n");
3046 ok = FALSE;
3047 }
3048
3049 /* Fractile test */
3050 for (i = 1; i < nf; i++) {
3051 fractiles[i] = qgeom (i / (double)nf, param_p, TRUE, FALSE);
3052 probs[i] = pgeom (fractiles[i], param_p, TRUE, FALSE);
3053 }
3054 if (!rand_fractile_test (vals, N, nf, fractiles, probs))
3055 ok = FALSE;
3056
3057 if (ok)
3058 g_printerr ("OK\n");
3059 else
3060 add_random_fail ("RANDGEOM");
3061 g_printerr ("\n");
3062
3063 g_free (vals);
3064 }
3065
3066 static void
3067 test_random_randlog (int N)
3068 {
3069 gnm_float mean, var, skew, kurt;
3070 gnm_float *vals;
3071 gboolean ok;
3072 gnm_float param_p = random_01 ();
3073 gnm_float p = param_p;
3074 gnm_float l1mp = gnm_log1p (-p);
3075 gnm_float mean_target = -p / (1 - p) / l1mp;
3076 gnm_float var_target = -(p * (p + l1mp)) / gnm_pow ((1 - p) * l1mp, 2);
3077 /* See http://mathworld.wolfram.com/Log-SeriesDistribution.html */
3078 gnm_float skew_target =
3079 -l1mp *
3080 (2 * p * p + 3 * p * l1mp + (1 + p) * l1mp * l1mp) /
3081 (l1mp * (p + l1mp) * gnm_sqrt (-p * (p + l1mp)));
3082 gnm_float kurt_target =
3083 -(6 * p * p * p +
3084 12 * p * p * l1mp +
3085 p * (7 + 4 * p) * l1mp * l1mp +
3086 (1 + 4 * p + p * p) * l1mp * l1mp * l1mp) /
3087 (p * gnm_pow (p + l1mp, 2));
3088 char *expr;
3089 gnm_float T;
3090 int i;
3091
3092 expr = g_strdup_printf ("=RANDLOG(%.10" GNM_FORMAT_g ")", param_p);
3093 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
3094 g_free (expr);
3095
3096 ok = TRUE;
3097 for (i = 0; i < N; i++) {
3098 gnm_float r = vals[i];
3099 if (!(r >= 1 && gnm_finite (r) && r == gnm_floor (r))) {
3100 g_printerr ("Range failure.\n");
3101 ok = FALSE;
3102 break;
3103 }
3104 }
3105
3106 T = mean_target;
3107 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
3108 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
3109 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
3110 ok = FALSE;
3111 }
3112
3113 T = var_target;
3114 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
3115 if (!(var >= 0 && gnm_finite (var))) {
3116 /* That is a very simplistic test! */
3117 g_printerr ("Var failure.\n");
3118 ok = FALSE;
3119 }
3120
3121 T = skew_target;
3122 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
3123 if (!gnm_finite (skew)) {
3124 /* That is a very simplistic test! */
3125 g_printerr ("Skew failure.\n");
3126 ok = FALSE;
3127 }
3128
3129 T = kurt_target;
3130 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
3131 if (!(kurt >= -3 && gnm_finite (kurt))) {
3132 /* That is a very simplistic test! */
3133 g_printerr ("Kurt failure.\n");
3134 ok = FALSE;
3135 }
3136
3137 if (ok)
3138 g_printerr ("OK\n");
3139 else
3140 add_random_fail ("RANDLOG");
3141 g_printerr ("\n");
3142
3143 g_free (vals);
3144 }
3145
3146 static void
3147 test_random_randweibull (int N)
3148 {
3149 gnm_float mean, var, skew, kurt;
3150 gnm_float *vals;
3151 gboolean ok;
3152 gnm_float shape = 1 / (0.0001 + gnm_pow (random_01 () / 2, 2));
3153 gnm_float scale = 2 * random_01 ();
3154 gnm_float mean_target = scale * gnm_gamma (1 + 1 / shape);
3155 gnm_float var_target = scale * scale *
3156 (gnm_gamma (1 + 2 / shape) -
3157 gnm_pow (gnm_gamma (1 + 1 / shape), 2));
3158 /* See https://en.wikipedia.org/wiki/Weibull_distribution */
3159 gnm_float skew_target =
3160 (gnm_gamma (1 + 3 / shape) * gnm_pow (scale, 3) -
3161 3 * mean_target * var_target -
3162 gnm_pow (mean_target, 3)) /
3163 gnm_pow (var_target, 1.5);
3164 gnm_float kurt_target = gnm_nan; /* Complicated */
3165 char *expr;
3166 gnm_float T;
3167 int i;
3168 gnm_float fractiles[10];
3169 const int nf = G_N_ELEMENTS (fractiles);
3170
3171 expr = g_strdup_printf ("=RANDWEIBULL(%.10" GNM_FORMAT_f ",%.10" GNM_FORMAT_f ")", scale, shape);
3172 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
3173 g_free (expr);
3174
3175 ok = TRUE;
3176 for (i = 0; i < N; i++) {
3177 gnm_float r = vals[i];
3178 if (!(r >= 0 && gnm_finite (r))) {
3179 g_printerr ("Range failure.\n");
3180 ok = FALSE;
3181 break;
3182 }
3183 }
3184
3185 T = mean_target;
3186 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
3187 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
3188 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
3189 ok = FALSE;
3190 }
3191
3192 T = var_target;
3193 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
3194 if (!(var >= 0 && gnm_finite (var))) {
3195 /* That is a very simplistic test! */
3196 g_printerr ("Var failure.\n");
3197 ok = FALSE;
3198 }
3199
3200 T = skew_target;
3201 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
3202 if (!gnm_finite (skew)) {
3203 /* That is a very simplistic test! */
3204 g_printerr ("Skew failure.\n");
3205 ok = FALSE;
3206 }
3207
3208 T = kurt_target;
3209 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
3210 if (!(kurt >= -3 && gnm_finite (kurt))) {
3211 /* That is a very simplistic test! */
3212 g_printerr ("Kurt failure.\n");
3213 ok = FALSE;
3214 }
3215
3216 /* Fractile test */
3217 for (i = 1; i < nf; i++)
3218 fractiles[i] = qweibull (i / (double)nf, shape, scale, TRUE, FALSE);
3219 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
3220 ok = FALSE;
3221
3222 if (ok)
3223 g_printerr ("OK\n");
3224 else
3225 add_random_fail ("RANDWEIBULL");
3226 g_printerr ("\n");
3227
3228 g_free (vals);
3229 }
3230
3231 static void
3232 test_random_randlognorm (int N)
3233 {
3234 gnm_float mean, var, skew, kurt;
3235 gnm_float *vals;
3236 gboolean ok;
3237 gnm_float lm = (random_01() - 0.5) / (0.1 + gnm_pow (random_01 () / 2, 2));
3238 gnm_float ls = 1 / (1 + gnm_pow (random_01 () / 2, 2));
3239 gnm_float mean_target = gnm_exp (lm + ls * ls / 2);
3240 gnm_float var_target = gnm_expm1 (ls * ls) * (mean_target * mean_target);
3241 /* See https://en.wikipedia.org/wiki/Log-normal_distribution */
3242 gnm_float skew_target = (gnm_exp (ls * ls) + 2) *
3243 gnm_sqrt (gnm_expm1 (ls * ls));
3244 gnm_float kurt_target = gnm_nan; /* Complicated */
3245 char *expr;
3246 gnm_float T;
3247 int i;
3248 gnm_float fractiles[10];
3249 const int nf = G_N_ELEMENTS (fractiles);
3250
3251 expr = g_strdup_printf ("=RANDLOGNORM(%.10" GNM_FORMAT_f ",%.10" GNM_FORMAT_f ")", lm, ls);
3252 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
3253 g_free (expr);
3254
3255 ok = TRUE;
3256 for (i = 0; i < N; i++) {
3257 gnm_float r = vals[i];
3258 if (!(r >= 0 && r <= gnm_pinf)) {
3259 g_printerr ("Range failure.\n");
3260 ok = FALSE;
3261 break;
3262 }
3263 }
3264
3265 T = mean_target;
3266 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
3267 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
3268 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
3269 ok = FALSE;
3270 }
3271
3272 T = var_target;
3273 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
3274 if (!(var >= 0 && gnm_finite (var))) {
3275 /* That is a very simplistic test! */
3276 g_printerr ("Var failure.\n");
3277 ok = FALSE;
3278 }
3279
3280 T = skew_target;
3281 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
3282 if (!gnm_finite (skew)) {
3283 /* That is a very simplistic test! */
3284 g_printerr ("Skew failure.\n");
3285 ok = FALSE;
3286 }
3287
3288 T = kurt_target;
3289 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
3290 if (!(kurt >= -3 && gnm_finite (kurt))) {
3291 /* That is a very simplistic test! */
3292 g_printerr ("Kurt failure.\n");
3293 ok = FALSE;
3294 }
3295
3296 /* Fractile test */
3297 for (i = 1; i < nf; i++)
3298 fractiles[i] = qlnorm (i / (double)nf, lm, ls, TRUE, FALSE);
3299 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
3300 ok = FALSE;
3301
3302 if (ok)
3303 g_printerr ("OK\n");
3304 else
3305 add_random_fail ("RANDLOGNORM");
3306 g_printerr ("\n");
3307
3308 g_free (vals);
3309 }
3310
3311 static void
3312 test_random_randrayleigh (int N)
3313 {
3314 gnm_float mean, var, skew, kurt;
3315 gnm_float *vals;
3316 gboolean ok;
3317 gnm_float ls = 1 / (1 + gnm_pow (random_01 () / 2, 2));
3318 gnm_float mean_target = ls * gnm_sqrt (M_PIgnum / 2);
3319 gnm_float var_target = (4 - M_PIgnum) / 2 * ls * ls;
3320 gnm_float skew_target = 2 * gnm_sqrt (M_PIgnum) * (M_PIgnum - 3) /
3321 gnm_pow (4 - M_PIgnum, 1.5);
3322 gnm_float kurt_target = gnm_nan; /* Complicated */
3323 char *expr;
3324 gnm_float T;
3325 int i;
3326 gnm_float fractiles[10];
3327 const int nf = G_N_ELEMENTS (fractiles);
3328
3329 expr = g_strdup_printf ("=RANDRAYLEIGH(%.10" GNM_FORMAT_f ")", ls);
3330 vals = test_random_1 (N, expr, &mean, &var, &skew, &kurt);
3331 g_free (expr);
3332
3333 ok = TRUE;
3334 for (i = 0; i < N; i++) {
3335 gnm_float r = vals[i];
3336 if (!(r >= 0 && gnm_finite (r))) {
3337 g_printerr ("Range failure.\n");
3338 ok = FALSE;
3339 break;
3340 }
3341 }
3342
3343 T = mean_target;
3344 g_printerr ("Expected mean: %.10" GNM_FORMAT_g "\n", T);
3345 if (!(gnm_abs (mean - T) <= 3 * gnm_sqrt (var_target / N))) {
3346 g_printerr ("Mean failure [%.1" GNM_FORMAT_f " stdev]\n", (mean - T) / gnm_sqrt (var_target / N));
3347 ok = FALSE;
3348 }
3349
3350 T = var_target;
3351 g_printerr ("Expected var: %.10" GNM_FORMAT_g "\n", T);
3352 if (!(var >= 0 && gnm_finite (var))) {
3353 /* That is a very simplistic test! */
3354 g_printerr ("Var failure.\n");
3355 ok = FALSE;
3356 }
3357
3358 T = skew_target;
3359 g_printerr ("Expected skew: %.10" GNM_FORMAT_g "\n", T);
3360 if (!gnm_finite (skew)) {
3361 /* That is a very simplistic test! */
3362 g_printerr ("Skew failure.\n");
3363 ok = FALSE;
3364 }
3365
3366 T = kurt_target;
3367 g_printerr ("Expected kurt: %.10" GNM_FORMAT_g "\n", T);
3368 if (!(kurt >= -3 && gnm_finite (kurt))) {
3369 /* That is a very simplistic test! */
3370 g_printerr ("Kurt failure.\n");
3371 ok = FALSE;
3372 }
3373
3374 /* Fractile test */
3375 for (i = 1; i < nf; i++)
3376 fractiles[i] = qrayleigh (i / (double)nf, ls, TRUE, FALSE);
3377 if (!rand_fractile_test (vals, N, nf, fractiles, NULL))
3378 ok = FALSE;
3379
3380 if (ok)
3381 g_printerr ("OK\n");
3382 else
3383 add_random_fail ("RANDRAYLEIGH");
3384 g_printerr ("\n");
3385
3386 g_free (vals);
3387 }
3388
3389 static void
3390 test_random (void)
3391 {
3392 const char *test_name = "test_random";
3393 const int N = sstest_fast ? 2000 : 20000;
3394 const int High_N = N * 10;
3395 const char *single = g_getenv ("SSTEST_RANDOM");
3396
3397 mark_test_start (test_name);
3398
3399 #define CHECK1(NAME,C) \
3400 do { if (!single || strcmp(single,#NAME) == 0) test_random_ ## NAME (C); } while (0)
3401
3402 /* Continuous */
3403 CHECK1 (rand, N);
3404 CHECK1 (randuniform, N);
3405 CHECK1 (randbeta, N);
3406 CHECK1 (randcauchy, N);
3407 CHECK1 (randchisq, N);
3408 CHECK1 (randexp, N);
3409 CHECK1 (randfdist, N);
3410 CHECK1 (randgamma, N);
3411 CHECK1 (randlog, N);
3412 CHECK1 (randlognorm, N);
3413 CHECK1 (randnorm, High_N);
3414 CHECK1 (randsnorm, High_N);
3415 CHECK1 (randtdist, N);
3416 CHECK1 (randweibull, N);
3417 CHECK1 (randrayleigh, N);
3418 #if 0
3419 CHECK1 (randexppow, N);
3420 CHECK1 (randgumbel, N);
3421 CHECK1 (randlandau, N);
3422 CHECK1 (randlaplace, N);
3423 CHECK1 (randlevy, N);
3424 CHECK1 (randlogistic, N);
3425 CHECK1 (randnormtail, N);
3426 CHECK1 (randpareto, N);
3427 CHECK1 (randrayleightail, N);
3428 CHECK1 (randstdist, N);
3429 #endif
3430
3431 /* Discrete */
3432 CHECK1 (randbernoulli, N);
3433 CHECK1 (randbetween, N);
3434 CHECK1 (randbinom, N);
3435 CHECK1 (randdiscrete, N);
3436 CHECK1 (randgeom, High_N);
3437 CHECK1 (randhyperg, High_N);
3438 CHECK1 (randnegbinom, High_N);
3439 CHECK1 (randpoisson, High_N);
3440
3441 #undef CHECK1
3442
3443 if (!single) {
3444 if (random_summary)
3445 g_printerr ("SUMMARY: FAIL for %s\n\n", random_summary);
3446 else
3447 g_printerr ("SUMMARY: OK\n\n");
3448 }
3449 g_free (random_summary);
3450 random_summary = NULL;
3451
3452 mark_test_end (test_name);
3453 }
3454
3455 /* ------------------------------------------------------------------------- */
3456
3457 #define MAYBE_DO(name) if (strcmp (testname, "all") != 0 && strcmp (testname, (name)) != 0) { } else
3458
3459 int
3460 main (int argc, char const **argv)
3461 {
3462 GOErrorInfo *plugin_errs;
3463 GOCmdContext *cc;
3464 GOptionContext *ocontext;
3465 GError *error = NULL;
3466 const char *testname;
3467
3468 /* No code before here, we need to init threads */
3469 argv = gnm_pre_parse_init (argc, argv);
3470
3471 gnm_conf_set_persistence (FALSE);
3472
3473 ocontext = g_option_context_new (_("[testname]"));
3474 g_option_context_add_main_entries (ocontext, sstest_options, GETTEXT_PACKAGE);
3475 g_option_context_add_group (ocontext, gnm_get_option_group ());
3476 g_option_context_parse (ocontext, &argc, (gchar ***)&argv, &error);
3477 g_option_context_free (ocontext);
3478
3479 if (error) {
3480 g_printerr (_("%s\nRun '%s --help' to see a full list of available command line options.\n"),
3481 error->message, g_get_prgname ());
3482 g_error_free (error);
3483 return 1;
3484 }
3485
3486 if (sstest_show_version) {
3487 g_printerr (_("version '%s'\ndatadir := '%s'\nlibdir := '%s'\n"),
3488 GNM_VERSION_FULL, gnm_sys_data_dir (), gnm_sys_lib_dir ());
3489 return 0;
3490 }
3491
3492 gnm_init ();
3493
3494 cc = gnm_cmd_context_stderr_new ();
3495 gnm_plugins_init (GO_CMD_CONTEXT (cc));
3496 go_plugin_db_activate_plugin_list (
3497 go_plugins_get_available_plugins (), &plugin_errs);
3498 if (plugin_errs) {
3499 /* FIXME: What do we want to do here? */
3500 go_error_info_free (plugin_errs);
3501 }
3502 g_object_unref (cc);
3503 cc = NULL;
3504
3505 if (func_state_file) {
3506 function_dump_defs (func_state_file, 0);
3507 return 0;
3508 }
3509 if (func_def_file) {
3510 function_dump_defs (func_def_file, 1);
3511 return 0;
3512 }
3513 if (ext_refs_file) {
3514 function_dump_defs (ext_refs_file, 4);
3515 return 0;
3516 }
3517 if (samples_file) {
3518 function_dump_defs (samples_file, 5);
3519 return 0;
3520 }
3521
3522 testname = argv[1];
3523 if (!testname) testname = "all";
3524
3525 /* ---------------------------------------- */
3526
3527 MAYBE_DO ("test_insdel_rowcol_names") test_insdel_rowcol_names ();
3528 MAYBE_DO ("test_insert_delete") test_insert_delete ();
3529 MAYBE_DO ("test_func_help") test_func_help ();
3530 MAYBE_DO ("test_nonascii_numbers") test_nonascii_numbers ();
3531 MAYBE_DO ("test_random") test_random ();
3532
3533 /* ---------------------------------------- */
3534
3535 gnm_shutdown ();
3536 gnm_pre_parse_shutdown ();
3537
3538 return 0;
3539 }
gnumeric mirror