summaryrefslogtreecommitdiff
path: root/lib/FLAT/NFA.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/FLAT/NFA.pm')
-rw-r--r--lib/FLAT/NFA.pm509
1 files changed, 0 insertions, 509 deletions
diff --git a/lib/FLAT/NFA.pm b/lib/FLAT/NFA.pm
deleted file mode 100644
index 344ea76..0000000
--- a/lib/FLAT/NFA.pm
+++ /dev/null
@@ -1,509 +0,0 @@
-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>, FLAT::NFA
-objects provide the following NFA-specific methods:
-
-=over
-
-=item $nfa-E<gt>epsilon_closure(@states)
-
-Returns the set of states (without duplicates) which are reachable from
-@states via zero or more epsilon-labeled transitions.
-
-=item $nfa-E<gt>trace($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-E<gt>as_undirected
-
-Outputs FA in a format that may be easily read into an external program as
-a description of an undirected graph.
-
-=item $nfa-E<gt>as_digraph
-
-Outputs FA in a format that may be easily read into an external program as
-a description of an directed graph.
-
-=item $nfa-E<gt>as_gdl
-
-Outputs FA in Graph Description Language (GDL), including directed transitions
-with symbols and state names labeled.
-
-=item $nfa-E<gt>as_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<fash> uses this function to implement its "nfa2gv"
-command:
-
- fash nfa2gv "a*b" | dot -Tpng > nfa.png
-
-=item $nfa-E<gt>as_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-E<gt>as_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 E<lt>mike at mikero dot comE<gt> and
-Brett Estrade E<lt>estradb at gmail dot comE<gt>.
-
-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.
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-22 12:21:44 +0000