From 00e57331b1c7ef2b1f402f41e1223308e0d8ce61 Mon Sep 17 00:00:00 2001 From: Daniel Friesel Date: Mon, 3 Apr 2017 15:04:15 +0200 Subject: initial commit --- lib/FLAT/NFA.pm | 509 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 509 insertions(+) create mode 100644 lib/FLAT/NFA.pm (limited to 'lib/FLAT/NFA.pm') diff --git a/lib/FLAT/NFA.pm b/lib/FLAT/NFA.pm new file mode 100644 index 0000000..344ea76 --- /dev/null +++ b/lib/FLAT/NFA.pm @@ -0,0 +1,509 @@ +package FLAT::NFA; + +use strict; +use base 'FLAT::FA'; + +use FLAT::Transition; + +=head1 NAME + +FLAT::NFA - Nondeterministic finite automata + +=head1 SYNOPSIS + +A FLAT::NFA object is a finite automata whose transitions are labeled +either with characters or the empty string (epsilon). + +=cut + +sub new { + my $pkg = shift; + my $self = $pkg->SUPER::new(@_); + $self->{TRANS_CLASS} = "FLAT::Transition"; + return $self; +} + +sub singleton { + my ($class, $char) = @_; + my $nfa = $class->new; + + if (not defined $char) { + $nfa->add_states(1); + $nfa->set_starting(0); + } elsif ($char eq "") { + $nfa->add_states(1); + $nfa->set_starting(0); + $nfa->set_accepting(0); + } else { + $nfa->add_states(2); + $nfa->set_starting(0); + $nfa->set_accepting(1); + $nfa->set_transition(0, 1, $char); + } + return $nfa; +} + +sub as_nfa { $_[0]->clone } + +sub union { + my @nfas = map { $_->as_nfa } @_; + my $result = $nfas[0]->clone; + $result->_swallow($_) for @nfas[1 .. $#nfas]; + $result; +} + +sub concat { + my @nfas = map { $_->as_nfa } @_; + + my $result = $nfas[0]->clone; + my @newstate = ([ $result->get_states ]); + my @start = $result->get_starting; + + for (1 .. $#nfas) { + push @newstate, [ $result->_swallow( $nfas[$_] ) ]; + } + + $result->unset_accepting($result->get_states); + $result->unset_starting($result->get_states); + $result->set_starting(@start); + + for my $nfa_id (1 .. $#nfas) { + for my $s1 ($nfas[$nfa_id-1]->get_accepting) { + for my $s2 ($nfas[$nfa_id]->get_starting) { + $result->set_transition( + $newstate[$nfa_id-1][$s1], + $newstate[$nfa_id][$s2], "" ); + }} + } + + $result->set_accepting( + @{$newstate[-1]}[ $nfas[-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; +} + +########### + +sub is_empty { + my $self = shift; + + my @queue = $self->get_starting; + my %seen = map { $_ => 1 } @queue; + + while (@queue) { + return 0 if grep { $self->is_accepting($_) } @queue; + @queue = grep { !$seen{$_}++ } $self->successors(\@queue); + } + return 1; +} + +sub is_finite { + my $self = shift; + + my @alphabet = $self->alphabet; + return 1 if @alphabet == 0; + + my @queue = $self->get_starting; + my %seen = map { $_ => 1 } @queue; + + while (@queue) { + @queue = grep { !$seen{$_}++ } $self->successors(\@queue); + } + + for my $s ( grep { $self->is_accepting($_) } keys %seen ) { + @queue = $self->epsilon_closure($s); + %seen = map { $_ => 1 } @queue; + + while (@queue) { + my @next = $self->epsilon_closure( + $self->successors(\@queue, \@alphabet) ); + + return 0 if grep { $s eq $_ } @next; + @queue = grep { !$seen{$_}++ } @next; + } + } + return 1; +} + +sub epsilon_closure { + my ($self, @states) = @_; + my %seen = map { $_ => 1 } @states; + my @queue = @states; + + while (@queue) { + @queue = grep { ! $seen{$_}++ } $self->successors( \@queue, "" ); + } + + keys %seen; +} + + +sub contains { + my ($self, $string) = @_; + + my @active = $self->epsilon_closure( $self->get_starting ); + for my $char (split //, $string) { + return 0 if ! @active; + @active = $self->epsilon_closure( $self->successors(\@active, $char) ); + } + return !! grep { $self->is_accepting($_) } @active; +} + +sub trace { + my ($self, $string) = @_; + + my @trace = ([ $self->epsilon_closure( $self->get_starting ) ]); + + for my $char (split //, $string) { + push @trace, + [ $self->epsilon_closure( $self->successors($trace[-1], $char) ) ]; + } + 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); +} + +######## transformations + +# subset construction +sub as_dfa { + my $self = shift; + + my $result = FLAT::DFA->new; + my %subset; + + my %final = map { $_ => 1 } $self->get_accepting; + my @start = sort { $a <=> $b } $self->epsilon_closure( $self->get_starting ); + + my $start = $subset{ _SET_ID(@start) } = $result->add_states(1); + $result->set_starting($start); + + $result->set_accepting( $start ) + if grep $_, @final{@start}; + + my @queue = (\@start); + while (@queue) { + my @states = @{ shift @queue }; + my $S = $subset{ _SET_ID(@states) }; + + for my $symb ($self->alphabet) { + my @to = $self->epsilon_closure( + $self->successors(\@states, $symb) ); + + if ( not exists $subset{_SET_ID(@to)} ) { + push @queue, \@to; + my $T = $subset{_SET_ID(@to)} = $result->add_states(1); + $result->set_accepting($T) + if grep $_, @final{@to}; + } + + $result->add_transition($S, $subset{ _SET_ID(@to) }, $symb); + } + } + + $result; +} + +############ Formatted output + +# Format that Dr. Sukhamay KUNDU likes to use in his assignments :) +# This format is just a undirected graph - so transition and state info is lost + +sub as_undirected { + my $self = shift; + my @symbols = $self->alphabet(); + my @states = $self->get_states(); + my %edges = (); + foreach (@states) { + my $s = $_; + foreach (@symbols) { + my $a = $_; + # foreach state, get all nodes connected to it; ignore symbols and + # treat transitions simply as directed + push(@{$edges{$s}},$self->successors($s,$a)); + foreach ($self->successors($s,$a)) { + push(@{$edges{$_}},$s); + } + } + } + my @lines = (($#states+1)); + foreach (sort{$a <=> $b;}(keys(%edges))) { #<-- iterate over numerically sorted list of keys + @{$edges{$_}} = sort {$a <=> $b;} $self->array_unique(@{$edges{$_}}); #<- make items unique and sort numerically + push(@lines,sprintf("%s(%s):%s",$_,($#{$edges{$_}}+1),join(' ',@{$edges{$_}}))); + } + return join("\n",@lines); + } + +# Format that Dr. Sukhamay KUNDU likes to use in his assignments :) +# This format is just a directed graph - so transition and state info is lost + +sub as_digraph { + my $self = shift; + my @symbols = $self->alphabet(); + my @states = $self->get_states(); + my @lines = (); + foreach (@states) { + my $s = $_; + my @edges = (); + foreach (@symbols) { + my $a = $_; + # foreach state, get all nodes connected to it; ignore symbols and + # treat transitions simply as directed + push(@edges,$self->successors($s,$a)); + } + @edges = sort {$a <=> $b;} $self->array_unique(@edges); #<- make items unique and sort numerically + push(@lines,sprintf("%s(%s): %s",$s,($#edges+1),join(' ',@edges))); + } + return sprintf("%s\n%s",($#states+1),join("\n",@lines)); +} + + +# Graph Description Language, aiSee, etc +sub as_gdl { + my $self = shift; + + my @states = map { + sprintf qq{node: { title:"%s" shape:circle borderstyle: %s}\n}, + $_, + ($self->is_accepting($_) ? "double bordercolor: red" : "solid") + } $self->get_states; + + my @trans; + for my $s1 ($self->get_states) { + for my $s2 ($self->get_states) { + my $t = $self->get_transition($s1, $s2); + + if (defined $t) { + push @trans, sprintf qq[edge: { source: "%s" target: "%s" label: "%s" arrowstyle: line }\n], + $s1, $s2, $t->as_string; + } + }} + + return sprintf "graph: {\ndisplay_edge_labels: yes\n\n%s\n%s}\n", + join("", @states), + join("", @trans); +} + +# Graphviz: dot, etc +## digraph, directed +sub as_graphviz { + my $self = shift; + + my @states = map { + sprintf qq{%s [label="%s",shape=%s]\n}, + $_, + ($self->is_starting($_) ? "start ($_)" : "$_"), + ($self->is_accepting($_) ? "doublecircle" : "circle") + } $self->get_states; + + my @trans; + for my $s1 ($self->get_states) { + for my $s2 ($self->get_states) { + my $t = $self->get_transition($s1, $s2); + + if (defined $t) { + push @trans, sprintf qq[%s -> %s [label="%s"]\n], + $s1, $s2, $t->as_string; + } + }} + + return sprintf "digraph G {\ngraph [rankdir=LR]\n\n%s\n%s}\n", + join("", @states), + join("", @trans); +} +## undirected +sub as_undirected_graphviz { + my $self = shift; + + my @states = map { + sprintf qq{%s [label="%s",shape=%s]\n}, + $_, + ("$_"), + ("circle") + } $self->get_states; + + my @trans; + for my $s1 ($self->get_states) { + for my $s2 ($self->get_states) { + my $t = $self->get_transition($s1, $s2); + + if (defined $t) { + push @trans, sprintf qq[%s -- %s\n], + $s1, $s2, $t->as_string; + } + }} + + return sprintf "graph G {\ngraph [rankdir=LR]\n\n%s\n%s}\n", + join("", @states), + join("", @trans); +} + +sub _SET_ID { return join "\0", sort { $a <=> $b } @_; } + +sub as_summary { + my $self = shift; + my $out = ''; + $out .= sprintf ("States : "); + my @start; + my @final; + foreach ($self->get_states()) { + $out .= sprintf "'$_' "; + if ($self->is_starting($_)) { + push(@start,$_); + } + if ($self->is_accepting($_)) { + push(@final,$_); + } + } + $out .= sprintf ("\nStart State : '%s'\n",join('',@start)); + $out .= sprintf ("Final State(s) : "); + foreach (@final) { + $out .= sprintf "'$_' "; + } + $out .= sprintf ("\nAlphabet : "); + foreach ($self->alphabet()) { + $out .= sprintf "'$_' "; + } + $out .= sprintf ("\nTransitions :\n"); + my @trans; + for my $s1 ($self->get_states) { + for my $s2 ($self->get_states) { + my $t = $self->get_transition($s1, $s2); + if (defined $t) { + push @trans, sprintf qq[%s -> %s on "%s"\n], + $s1, $s2, $t->as_string; + } + }} + $out .= join('',@trans); + return $out; +} + +1; + +__END__ + +=head1 USAGE + +In addition to implementing the interface specified in L, FLAT::NFA +objects provide the following NFA-specific methods: + +=over + +=item $nfa-Eepsilon_closure(@states) + +Returns the set of states (without duplicates) which are reachable from +@states via zero or more epsilon-labeled transitions. + +=item $nfa-Etrace($string) + +Returns a list of N+1 arrayrefs, where N is the length of $string. The +I-th arrayref contains the states which are reachable from the starting +state(s) of $nfa after reading I characters of $string. Correctly accounts +for epsilon transitions. + +=item $nfa-Eas_undirected + +Outputs FA in a format that may be easily read into an external program as +a description of an undirected graph. + +=item $nfa-Eas_digraph + +Outputs FA in a format that may be easily read into an external program as +a description of an directed graph. + +=item $nfa-Eas_gdl + +Outputs FA in Graph Description Language (GDL), including directed transitions +with symbols and state names labeled. + +=item $nfa-Eas_graphviz + +Outputs FA in Graphviz format, including directed transitions with symbols and +and state names labeled. This output may be directly piped into any of the +Graphviz layout programs, and in turn one may output an image using a single +commandline instruction. C uses this function to implement its "nfa2gv" +command: + + fash nfa2gv "a*b" | dot -Tpng > nfa.png + +=item $nfa-Eas_undirected_graphviz + +Outputs FA in Graphviz format, with out the directed transitions or labels. +The output is suitable for any of the Graphvize layout programs, as discussed +above. + +=item $nfa-Eas_summary + +Outputs a summary of the FA, including its states, symbols, and transition matrix. +It is useful for manually validating what the FA looks like. + +=back + +=head1 AUTHORS & ACKNOWLEDGEMENTS + +FLAT is written by Mike Rosulek Emike at mikero dot comE and +Brett Estrade Eestradb at gmail dot comE. + +The initial version (FLAT::Legacy) by Brett Estrade was work towards an +MS thesis at the University of Southern Mississippi. + +Please visit the Wiki at http://www.0x743.com/flat + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. -- cgit v1.2.3