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