2015/38.pl

   1 #!/usr/bin/perl -w
   2
   3 use v5.16;
   4 use strict;
   5
   6 my %rules;
   7 while (<>) {
   8         chomp;
   9         last if /^$/;
  10         my ($src, $dst) = /(\w+) => (\w+)/;
  11         # push @rules, [$src, $dst];
  12         push @{ $rules{$src} }, [ split(/(?=[A-Z])/, $dst) ];
  13 }
  14
  15 chomp (my $mol = <>);
  16 my @mol = split(/(?=[A-Z])/, $mol);
  17
  18 $; = ',';
  19 my $added = 1;
  20 while ($added) {
  21         $added = 0;
  22         for my $elem (keys %rules) {
  23                 for my $rule (@{ $rules{$elem} }) {
  24                         my $first = $
  25 my @q = ([ ['e'], \@mol, 0 ]);
  26
  27 my %seen;
  28
  29 while (@q) {
  30         my $entry = shift @q;
  31         my ($stack, $mol, $steps) = @$entry;
  32
  33         if (!@$stack && !@$mol) {
  34                 say $steps;
  35                 last;
  36         }
  37         if (!@$stack || !@$mol) {
  38                 next;
  39         }
  40         say "apply $steps: @$stack => @$mol";
  41
  42         if ($stack->[0] eq $mol->[0]) {
  43                 say "reduce $stack->[0]";
  44                 my @nstack = @$stack;
  45                 shift @nstack;
  46                 my @nmol = @$mol;
  47                 shift @nmol;
  48                 unshift @q, [ \@nstack, \@nmol, $steps ];
  49         }
  50         for my $rule (@{ $rules{$stack->[0]} }) {
  51                 my @nstack = @$stack;
  52                 shift @nstack;
  53                 unshift @nstack, @$rule;
  54                 my $key = join(' ', @nstack, '=', @$mol);
  55                 next if $seen{$key}++;
  56                 say "push $stack->[0] => @$rule";
  57                 push @q, [ \@nstack, [ @$mol ], $steps+1 ];
  58         }
  59 }