tests/expressions/randist/randist.pl

   1 use warnings;
   2
   3 our (@funcs);
   4 our (@vars);
   5 our (%values);
   6
   7 while (<>) {
   8     chomp;
   9     s/#.*//;
  10     next if /^\s*$/;
  11     my ($dist) = /^(.+):\s*$/ or die;
  12
  13     @funcs = ();
  14     @vars = ();
  15     %values = ('P' => [.01, .1, .2, .3, .4, .5, .6, .7, .8, .9, .99]);
  16     while (<>) {
  17         last if /^\s*$/;
  18
  19         my ($key, $value) = /^\s*(\w+)\s*=\s*(.*)$/;
  20         my (@values);
  21         foreach my $s (split (/\s+/, $value)) {
  22             if (my ($from, $to, $by) = $s =~ /^(.*):(.*):(.*)$/) {
  23                 for (my ($x) = $from; $x <= $to; $x += $by) {
  24                     push (@values, sprintf ("%.2f", $x) + 0);
  25                 }
  26             } else {
  27                 push (@values, $s);
  28             }
  29         }
  30
  31         if ($key eq 'funcs') {
  32             @funcs = @values;
  33         } else {
  34             push (@vars, $key);
  35             $values{$key} = \@values;
  36         }
  37     }
  38
  39     print "DATA LIST LIST/", join (' ', 'P', @vars), ".\n";
  40     print "COMPUTE x = IDF.$dist (", join (', ', 'P', @vars), ").\n";
  41     foreach my $func (@funcs) {
  42         print "COMPUTE $func = $func.$dist (",
  43           join (', ', 'x', @vars), ").\n";
  44     }
  45     print "PRINT OUTFILE='$dist.out'/",
  46       join (' ', 'P', @vars, 'x', @funcs), ".\n";
  47     print "BEGIN DATA.\n";
  48     print_all_values (['P', @vars], []);
  49     print "END DATA.\n";
  50 }
  51
  52 sub print_all_values {
  53     my (@vars) = @{$_[0]};
  54     my (@assign) = @{$_[1]};
  55     if (@vars == @assign) {
  56         print join (' ', @assign), "\n";
  57     } else {
  58         push (@assign, 0);
  59         my ($var) = $vars[$#assign];
  60         foreach my $value (@{$values{$var}}) {
  61             $assign[$#assign] = $value;
  62             print_all_values (\@vars, \@assign);
  63         }
  64     }
  65 }