truth_table

#!/usr/bin/perl
# ===========================================================================
# truth_table
# 
# Given a file with lines of the format
#
#    heading: value1, value2, ..., valueN
#
# this script will generate a table with a column for each heading and
# every possible combination of values. For example, given the input
#
#    A: 0,1
#    B: 0,1
#
# the script will produce
#
# $ truth_table xxx.tt                  
#   0  0    
#   0  1    
#   1  0    
#   1  1    
#   
# ===========================================================================
$filename = $ARGV[0];

open(IN, "< $filename");
while ($line = <IN>)
{
   chomp($line);
   ($variable, $value_list) = split(/s*:s*/, $line);
   push(@{$ds{'!order!'}}, $variable);
   @{$ds{$variable}} = split(/s*,s*/, $value_list);
}
close(IN);

$count = count_rows(%ds);
@row = first_row(%ds);
for ($idx = 0 ; $idx < $count ; $idx++)
{
   size_row(@row);
   @row = next_row(%ds, @row);
}

@row = first_row(%ds);
for ($idx = 0 ; $idx < $count ; $idx++)
{
   show_row(@row);
   @row = next_row(%ds, @row);
}


{
   my (@width);

# ===========================================================================
sub size_row
{
   my ($i);

   for ($i = 0 ; $i < @_ ; $i++)
   {
      $width[$i] = max($width[$i], length($_[$i]));
   }
}

# ===========================================================================
sub show_row
{
   # print(join("   ", @_), "n");
   for ($i = 0 ; $i < @_ ; $i++)
   {
      printf("  %*s", $width[$i], $_[$i]);
   }
   print("n");
}
}

# ===========================================================================
sub count_rows
{
   my ($d, $k, $rval);

   ($d) = @_;

   $rval = 1;
   foreach $k (grep(!/!order!/, keys(%{$d})))
   {
      $rval *= scalar(@{$d->{$k}});
   }
   return $rval;
}

# ===========================================================================
sub max
{
   @s = reverse(sort(@_));
   return $s[0];
}

{
   my @idx;

# ===========================================================================
sub first_row
{
   my ($d, $k, @row);

   ($d) = @_;

   foreach $k (@{$d->{'!order!'}})
   {
      push(@idx, 0);
   }

   return set_row($d);
}

# ===========================================================================
sub next_row
{
   my ($carry, $d, $j, @o);

   ($d) = @_;

   @o = @{$d->{'!order!'}};
   $carry = 1;
   for ($j = @idx - 1 ; 0 <= $j ; $j--)
   {
      $idx[$j]++ if $carry;
      if (@{$d->{$o[$j]}} <= $idx[$j])
      {
         $idx[$j] = 0;
         $carry = 1;
      }
      else
      {
         $carry = 0;
      }
   }

   return set_row($d);
}

# ===========================================================================
sub set_row
{
   my ($d, $j, @row);

   ($d) = @_;

   for ($j = 0 ; $j < @idx ; $j++)
   {
      push(@row, $d->{$d->{'!order!'}->[$j]}->[$idx[$j]]);
   }
   return @row;
}
}