From: <per...@li...> - 2006-04-11 04:28:55
|
Update of /cvsroot/perl-flat/perl-flat/lib/FLAT In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4496/lib/FLAT Modified Files: PFA.pm Log Message: just another commit of non-working pfa/pre code Index: PFA.pm =================================================================== RCS file: /cvsroot/perl-flat/perl-flat/lib/FLAT/PFA.pm,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** PFA.pm 9 Apr 2006 19:37:31 -0000 1.6 --- PFA.pm 11 Apr 2006 04:28:51 -0000 1.7 *************** *** 35,39 **** $pfa->set_transition(0, 1, $char); } ! # need to handle nodes...\ return $pfa; --- 35,39 ---- $pfa->set_transition(0, 1, $char); } ! # need to handle nodes...???\ return $pfa; *************** *** 43,71 **** sub as_pfa { $_[0]->clone() } ! sub union { } sub concat { ! } ! sub kleene { } ! # Shuffle constructor - pinch with lambda transitions ! sub shuffle { ! } ! # PFA->NFA conversion algorithm ! sub as_nfa { ! } - # Implement? sub reverse { ! } --- 43,125 ---- sub as_pfa { $_[0]->clone() } ! sub shuffle { ! my @pfas = map { $_->as_pfa } @_; ! my $result = $pfas[0]->clone; ! # something like FA::_swallow, but for lambda ! $result; ! } + sub union { + my @pfas = map { $_->as_pfa } @_; + my $result = $pfas[0]->clone; + $result->_swallow($_) for @pfas[1 .. $#pfas]; + $result; } sub concat { + my @pfas = map { $_->as_pfa } @_; + + my $result = $pfas[0]->clone; + my @newstate = ([ $result->get_states ]); + my @start = $result->get_starting; ! for (1 .. $#pfas) { ! push @newstate, [ $result->_swallow( $pfas[$_] ) ]; ! } ! $result->unset_accepting($result->get_states); ! $result->unset_starting($result->get_states); ! $result->set_starting(@start); ! ! for my $pfa_id (1 .. $#pfas) { ! for my $s1 ($pfas[$pfa_id-1]->get_accepting) { ! for my $s2 ($pfas[$pfa_id]->get_starting) { ! $result->set_transition( ! $newstate[$pfa_id-1][$s1], ! $newstate[$pfa_id][$s2], "" ); ! }} ! } ! ! $result->set_accepting( ! @{$newstate[-1]}[ $pfas[-1]->get_accepting ] ); + $result; } ! sub kleene { ! my $result = $_[0]->clone; ! ! my ($newstart, $newfinal) = $result->add_states(2); ! ! $result->set_transition($newstart, $_, "") ! for $result->get_starting; ! $result->unset_starting( $result->get_starting ); ! $result->set_starting($newstart); ! $result->set_transition($_, $newfinal, "") ! for $result->get_accepting; ! $result->unset_accepting( $result->get_accepting ); ! $result->set_accepting($newfinal); ! $result->set_transition($newstart, $newfinal, ""); ! $result->set_transition($newfinal, $newstart, ""); ! ! $result; } sub reverse { ! my $self = $_[0]->clone; ! $self->_transpose; ! ! my @start = $self->get_starting; ! my @final = $self->get_accepting; ! ! $self->unset_accepting( $self->get_states ); ! $self->unset_starting( $self->get_states ); ! ! $self->set_accepting( @start ); ! $self->set_starting( @final ); ! ! $self; } |