perl-flat-cvs-notify

[<per...@li...>]

Update of /cvsroot/perl-flat/blokhead/lib/FLAT
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7074/lib/FLAT

Modified Files:
	DFA.pm NFA.pm 
Log Message:
DFA complement, intersection (still needs work)
NFA extend alphabet



Index: DFA.pm
===================================================================
RCS file: /cvsroot/perl-flat/blokhead/lib/FLAT/DFA.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** DFA.pm	24 Feb 2006 06:20:25 -0000	1.2
--- DFA.pm	1 Mar 2006 18:29:22 -0000	1.3
***************
*** 14,17 ****
--- 14,74 ----
  }
  
+ sub complement {
+     my $self = $_[0]->clone;
+     
+     for my $s ($self->get_states) {
+         $self->is_accepting($s)
+             ? $self->unset_accepting($s)
+             : $self->set_accepting($s);
+     }
+     
+     return $self;
+ }
+ 
+ sub _TUPLE_ID { join "\0", @_ }
+ sub _uniq { my %seen; grep { !$seen{$_}++ } @_; }
+ 
+ ## this method still needs more work..
+ sub intersect {
+     my @dfas = map { $_->as_dfa } @_;
+     
+     my $return = FLAT::DFA->new;
+     my %newstates;
+     my @alpha = _uniq( map { $_->alphabet } @dfas );
+     
+     $_->_extend_alphabet(@alpha) for @dfas;
+ 
+     my @start = map { $_->get_starting } @dfas;
+     my $start = $newstates{ _TUPLE_ID(@start) } = $return->add_states(1);
+     $return->set_starting($start);
+     $return->set_accepting($start)
+         if ! grep { ! $dfas[$_]->is_accepting( $start[$_] ) } 0 .. $#dfas;
+ 
+     my @queue = (\@start);
+     while (@queue) {
+         my @tuple = @{ shift @queue };
+ 
+         for my $char (@alpha) {
+             my @next = map { $dfas[$_]->successors( $tuple[$_], $char ) }
+                         0 .. $#dfas;
+             
+             warn "[@tuple] --> [@next] via $char\n";
+             
+             if (not exists $newstates{ _TUPLE_ID(@next) }) {
+                 my $s = $newstates{ _TUPLE_ID(@next) } = $return->add_states(1);
+                 $return->set_accepting($s)
+                     if ! grep { ! $dfas[$_]->is_accepting( $next[$_] ) } 0 .. $#dfas;
+                 push @queue, \@next;
+             }
+             
+             $return->add_transition( $newstates{ _TUPLE_ID(@tuple) },
+                                      $newstates{ _TUPLE_ID(@next) },
+                                      $char );
+         }            
+     }
+ 
+     return $return;    
+ }
+ 
  sub unset_starting {
      my $self = shift;

Index: NFA.pm
===================================================================
RCS file: /cvsroot/perl-flat/blokhead/lib/FLAT/NFA.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** NFA.pm	24 Feb 2006 15:41:02 -0000	1.9
--- NFA.pm	1 Mar 2006 18:29:22 -0000	1.10
***************
*** 203,206 ****
--- 203,225 ----
      return @trace;
  }
+ ############
+ 
+ sub _extend_alphabet {
+     my ($self, @alpha) = @_;
+     
+     my %alpha = map { $_ => 1 } @alpha;
+     delete $alpha{$_} for $self->alphabet;
+ 
+     return if not keys %alpha;
+ 
+     my $trash = $self->add_states(1);
+     for my $state ($self->get_states) {
+         next if $state eq $trash;
+         for my $char (keys %alpha) {
+             $self->add_transition($state, $trash, $char);
+         }
+     }
+     $self->add_transition($trash, $trash, $self->alphabet);
+ }
  
  ############
***************
*** 232,236 ****
  }
  
! sub _SET_ID { join "\0", sort { $a <=> $b } @_; } # could this be encapsulated as inside of a closure or anonymous function?
  sub as_dfa {
      my $self = shift;
--- 251,255 ----
  }
  
! sub _SET_ID { join "\0", sort { $a <=> $b } @_; }
  sub as_dfa {
      my $self = shift;