examples/nfa2dfa.pl

   1 use v6;
   2 use Set;
   3
   4 sub epsilon_closure($nfa, $states) {
   5     my @q = $states.members;
   6
   7     # Why don't I just make @ret a set here, instead of grepping on
   8     # it as if it were?  Well, because if I do, then apparently
   9     # it's not true that 2 == 2 anymore.  Yes, very strange.  Try it.
  10     my @ret;
  11
  12     while (@q) {
  13         my $state = @q.shift;
  14         unless (@ret.grep:{ $state eq $_ }) {
  15             @ret.push($state);
  16             for @($nfa{$state}) {
  17                 if .key eq '' {
  18                     @q.push(.value);
  19                 }
  20             }
  21         }
  22     }
  23
  24     return set(@ret);
  25 }
  26
  27 sub scan($nfa, $states, $tran)  {
  28     my $ret = set();
  29     for ($states.members) -> $state {
  30         for @($nfa{$state}) {
  31             if .key eq $tran {
  32                 $ret.insert(.value);
  33             }
  34         }
  35     }
  36     return $ret;
  37 }
  38
  39 sub transitions($nfa, $states) {
  40     my $ret = set();
  41     for ($states.members) {
  42         my $list = $nfa{$_};
  43         $ret.insert($list.map: {.key});
  44     }
  45
  46     return $ret;
  47 }
  48
  49 sub set2str($set) {
  50     my @elem = $set.members.sort;
  51
  52     return @elem.join(';');
  53 }
  54
  55 sub nfa2dfa($nfa, $start) {
  56     my $inistate = epsilon_closure($nfa, set($start));
  57     my @q = ($inistate);
  58     my $dfa = {};
  59     my $seen = set();
  60     while (@q) {
  61         my $state = @q.shift;
  62         my $strstate = set2str($state);
  63         next if $seen.includes($strstate);
  64         $seen.insert($strstate);
  65         for transitions($nfa, $state).members -> $tran {
  66             next if $tran eq '';
  67             my $scan = scan($nfa, $state, $tran);
  68             my $newstate = epsilon_closure($nfa, $scan);
  69             $dfa{set2str($state)}{$tran} = set2str($newstate);
  70             @q.push($newstate) unless $seen.includes(set2str($newstate));
  71         }
  72     }
  73
  74     return ($dfa, set2str($inistate));
  75 }
  76
  77 # nfa for /foo*[ba|oba]*[r|z]/
  78 my $nfa = {
  79     0  => [ 'f' => 1 ],
  80     1  => [ 'o' => 2 ],
  81     2  => [ 'o' => 2, '' => 3 ],
  82     3  => [ ''  => 4, '' => 7 ],
  83     4  => [ 'b' => 5 ],
  84     5  => [ 'a' => 6 ],
  85     6  => [ ''  => 3, '' => 11 ],
  86     7  => [ 'o' => 8 ],
  87     8  => [ 'b' => 9 ],
  88     9  => [ 'a' => 10 ],
  89     10 => [ ''  => 3, '' => 11 ],
  90     11 => [ 'r'  => 'X', 'z' => 'X' ],
  91 };
  92
  93 my ($dfa, $start) = nfa2dfa($nfa, 0);
  94 say "START: $start";
  95 for $dfa.kv -> $s, $t {
  96     printf("%-13s : %s\n", $s, $t.perl);
  97 }
  98
  99 # vim: ft=perl6 :