summaryrefslogtreecommitdiff
path: root/lib/FLAT/FA.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/FLAT/FA.pm')
-rw-r--r--lib/FLAT/FA.pm554
1 files changed, 0 insertions, 554 deletions
diff --git a/lib/FLAT/FA.pm b/lib/FLAT/FA.pm
deleted file mode 100644
index dd77f50..0000000
--- a/lib/FLAT/FA.pm
+++ /dev/null
@@ -1,554 +0,0 @@
-package FLAT::FA;
-
-use strict;
-use base 'FLAT';
-use Carp;
-
-use FLAT::Transition;
-
-=head1 NAME
-
-FLAT::FA - Base class for regular finite automata
-
-=head1 SYNOPSIS
-
-A FLAT::FA object is a collection of states and transitions. Each state
-may be labeled as starting or accepting. Each transition between states
-is labeled with a transition object.
-
-=head1 USAGE
-
-FLAT::FA is a superclass that is not intended to be used directly. However,
-it does provide the following methods:
-
-=cut
-
-sub new {
- my $pkg = shift;
- bless {
- STATES => [],
- TRANS => [],
- ALPHA => {}
- }, $pkg;
-}
-
-sub get_states {
- my $self = shift;
- return 0 .. ($self->num_states - 1);
-}
-
-sub num_states {
- my $self = shift;
- return scalar @{ $self->{STATES} };
-}
-
-sub is_state {
- my ($self, $state) = @_;
- exists $self->{STATES}->[$state];
-}
-
-sub _assert_states {
- my ($self, @states) = @_;
- for (@states) {
- croak "'$_' is not a state" if not $self->is_state($_);
- }
-}
-sub _assert_non_states {
- my ($self, @states) = @_;
- for (@states) {
- croak "There is already a state called '$_'" if $self->is_state($_);
- }
-}
-
-sub delete_states {
- my ($self, @states) = @_;
-
- $self->_assert_states(@states);
-
- for my $s ( sort { $b <=> $a } @states ) {
- $self->_decr_alphabet($_)
- for @{ splice @{ $self->{TRANS} }, $s, 1 };
-
- $self->_decr_alphabet( splice @$_, $s, 1 )
- for @{ $self->{TRANS} };
-
- splice @{ $self->{STATES} }, $s, 1;
- }
-}
-
-sub add_states {
- my ($self, $num) = @_;
- my $id = $self->num_states;
-
- for my $s ( $id .. ($id+$num-1) ) {
- push @$_, undef for @{ $self->{TRANS} };
- push @{ $self->{TRANS} }, [ (undef) x ($s+1) ];
- push @{ $self->{STATES} }, {
- starting => 0,
- accepting => 0
- };
- }
-
- return wantarray ? ($id .. ($id+$num-1))
- : $id+$num-1;
-}
-
-##############
-
-sub is_starting {
- my ($self, $state) = @_;
- $self->_assert_states($state);
- return $self->{STATES}[$state]{starting};
-}
-sub set_starting {
- my ($self, @states) = @_;
- $self->_assert_states(@states);
- $self->{STATES}[$_]{starting} = 1 for @states;
-}
-sub unset_starting {
- my ($self, @states) = @_;
- $self->_assert_states(@states);
- $self->{STATES}[$_]{starting} = 0 for @states;
-}
-sub get_starting {
- my $self = shift;
- return grep { $self->is_starting($_) } $self->get_states;
-}
-
-##############
-
-sub is_accepting {
- my ($self, $state) = @_;
- $self->_assert_states($state);
- return $self->{STATES}[$state]{accepting};
-}
-sub set_accepting {
- my ($self, @states) = @_;
- $self->_assert_states(@states);
- $self->{STATES}[$_]{accepting} = 1 for @states;
-}
-sub unset_accepting {
- my ($self, @states) = @_;
- $self->_assert_states(@states);
- $self->{STATES}[$_]{accepting} = 0 for @states;
-}
-sub get_accepting {
- my $self = shift;
- return grep { $self->is_accepting($_) } $self->get_states;
-}
-
-###############
-
-sub _decr_alphabet {
- my ($self, $t) = @_;
- return if not defined $t;
- for ($t->alphabet) {
- delete $self->{ALPHA}{$_} if not --$self->{ALPHA}{$_};
- }
-}
-sub _incr_alphabet {
- my ($self, $t) = @_;
- return if not defined $t;
- $self->{ALPHA}{$_}++ for $t->alphabet;
-}
-
-sub set_transition {
- my ($self, $state1, $state2, @label) = @_;
- $self->remove_transition($state1, $state2);
-
- @label = grep defined, @label;
- return if not @label;
-
- my $t = $self->{TRANS_CLASS}->new(@label);
- $self->_incr_alphabet($t);
-
- $self->{TRANS}[$state1][$state2] = $t;
-}
-
-sub add_transition {
- my ($self, $state1, $state2, @label) = @_;
-
- @label = grep defined, @label;
- return if not @label;
-
- my $t = $self->get_transition($state1, $state2);
- $self->_decr_alphabet($t);
-
- if (!$t) {
- $t = $self->{TRANS}[$state1][$state2] = $self->{TRANS_CLASS}->new;
- }
-
- $t->add(@label);
- $self->_incr_alphabet($t);
-}
-
-sub get_transition {
- my ($self, $state1, $state2) = @_;
- $self->_assert_states($state1, $state2);
-
- $self->{TRANS}[$state1][$state2];
-}
-
-sub remove_transition {
- my ($self, $state1, $state2) = @_;
-
- $self->_decr_alphabet( $self->{TRANS}[$state1][$state2] );
- $self->{TRANS}[$state1][$state2] = undef;
-}
-
-# given a state and a symbol, it tells you
-# what the next state(s) are; do get successors
-# for find the successors for a set of symbols,
-# use array refs. For example:
-# @NEXT=$self->successors([@nodes],[@symbols]);
-sub successors {
- my ($self, $state, $symb) = @_;
-
- my @states = ref $state eq 'ARRAY' ? @$state : ($state);
- my @symbs = defined $symb
- ? (ref $symb eq 'ARRAY' ? @$symb : ($symb))
- : ();
-
- $self->_assert_states(@states);
-
- my %succ;
- for my $s (@states) {
- $succ{$_}++
- for grep { my $t = $self->{TRANS}[$s][$_];
- defined $t && (@symbs ? $t->does(@symbs) : 1) } $self->get_states;
- }
-
- return keys %succ;
-}
-
-sub predecessors {
- my $self = shift;
- $self->clone->reverse->successors(@_);
-}
-
-# reverse - no change from NFA
-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;
-}
-
-# get an array of all symbols
-sub alphabet {
- my $self = shift;
- grep length, keys %{ $self->{ALPHA} };
-}
-
-# give an array of symbols, return the symbols that
-# are in the alphabet
-#sub is_in_alphabet {
-# my $self = shift;
-# my $
-#}
-
-############
-sub prune {
- my $self = shift;
-
- my @queue = $self->get_starting;
- my %seen = map { $_ => 1 } @queue;
-
- while (@queue) {
- @queue = grep { ! $seen{$_}++ } $self->successors(\@queue);
- }
-
- my @useless = grep { !$seen{$_} } $self->get_states;
- $self->delete_states(@useless);
-
- return @useless;
-}
-
-
-############
-
-use Storable 'dclone';
-sub clone {
- dclone( $_[0] );
-}
-
-sub _transpose {
- my $self = shift;
- my $N = $self->num_states - 1;
-
- $self->{TRANS} = [
- map {
- my $row = $_;
- [ map { $_->[$row] } @{$self->{TRANS}} ]
- } 0 .. $N
- ];
-}
-
-# tests to see if set1 is a subset of set2
-sub array_is_subset {
- my $self = shift;
- my $set1 = shift;
- my $set2 = shift;
- my $ok = 1;
- my %setcount = ();
- foreach ($self->array_unique(@{$set1}),$self->array_unique(@{$set2})) {
- $setcount{$_}++;
- }
- foreach ($self->array_unique(@{$set1})) {
- if ($setcount{$_} != 2) {
- $ok = 0;
- last;
- }
- }
- return $ok;
-}
-
-sub array_unique {
- my $self = shift;
- my %ret = ();
- foreach (@_) {
- $ret{$_}++;
- }
- return keys(%ret);
-}
-
-sub array_complement {
- my $self = shift;
- my $set1 = shift;
- my $set2 = shift;
- my @ret = ();
- # convert set1 to a hash
- my %set1hash = map {$_ => 1} @{$set1};
- # iterate of set2 and test if $set1
- foreach (@{$set2}) {
- if (!defined $set1hash{$_}) {
- push(@ret,$_);
- }
- }
- ## Now do the same using $set2
- # convert set2 to a hash
- my %set2hash = map {$_ => 1} @{$set2};
- # iterate of set1 and test if $set1
- foreach (@{$set1}) {
- if (!defined $set2hash{$_}) {
- push(@ret,$_);
- }
- }
- # now @ret contains all items in $set1 not in $set 2 and all
- # items in $set2 not in $set1
- return @ret;
-}
-
-# returns all items that 2 arrays have in common
-sub array_intersect {
- my $self = shift;
- my $set1 = shift;
- my $set2 = shift;
- my %setcount = ();
- my @ret = ();
- foreach ($self->array_unique(@{$set1})) {
- $setcount{$_}++;
- }
- foreach ($self->array_unique(@{$set2})) {
- $setcount{$_}++;
- push(@ret,$_) if ($setcount{$_} > 1);
- }
- return @ret;
-}
-
-# given a set of symbols, returns only the valid ones
-sub get_valid_symbols {
- my $self = shift;
- my $symbols = shift;
- return $self->array_intersect([$self->alphabet()],[@{$symbols}])
-}
-
-## add an FA's states & transitions to this FA (as disjoint union)
-sub _swallow {
- my ($self, $other) = @_;
- my $N1 = $self->num_states;
- my $N2 = $other->num_states;
-
- push @$_, (undef) x $N2
- for @{ $self->{TRANS} };
-
- push @{ $self->{TRANS} }, [ (undef) x $N1, @{ clone $_ } ]
- for @{ $other->{TRANS} };
-
- push @{ $self->{STATES} }, @{ clone $other->{STATES} };
-
- $self->{ALPHA}{$_} += $other->{ALPHA}{$_}
- for keys %{ $other->{ALPHA} };
-
- return map { $_ + $N1 } $other->get_states;
-}
-
-1;
-
-__END__
-
-
-=head2 Manipulation & Inspection Of States
-
-=over
-
-=item $fa-E<gt>get_states
-
-Returns a list of all the state "names" in $fa.
-
-=item $fa-E<gt>num_states
-
-Returns the number of states in $fa.
-
-=item $fa-E<gt>is_state($state_id)
-
-Returns a boolean indicating whether $state_id is a recognized state "name."
-
-=item $fa-E<gt>delete_states(@states)
-
-Deletes the states given in @states and their corresponding transitions. The
-remaining states in the FA may be "renamed" (renumbered)! Return value not
-used.
-
-=item $fa-E<gt>add_states($num)
-
-Adds $num states to $fa, and returns a list of the new state "names."
-
-=item $fa-E<gt>get_starting
-
-=item $fa-E<gt>get_accepting
-
-Returns a list of all the states which are labeled as starting/accepting,
-respectively.
-
-=item $fa-E<gt>set_accepting(@states)
-
-=item $fa-E<gt>unset_accepting(@states)
-
-=item $fa-E<gt>set_starting(@states)
-
-=item $fa-E<gt>unset_starting(@states)
-
-Sets/unsets a list of states as being labeled starting/accepting,
-respectively.
-
-=item $fa-E<gt>is_starting($state)
-
-=item $fa-E<gt>is_accepting($state)
-
-Returns a boolean indicating whether $state is labeled as starting/accepting,
-respectively.
-
-=item $fa-E<gt>prune
-
-Deletes the states which are not reachable (via zero or more transitions)
-from starting states. Returns a list of the "names" of states that were
-deleted.
-
-=back
-
-=head2 Manipulation & Inspection Of Transitions
-
-Each transition between states is a transition object, which knows how
-to organize several "labels." Think of this as the mechanism by which
-multiple arrows in the state diagram between the same states are collapsed
-to a single arrow. This interface is abstracted away into the following
-public methods:
-
-=over
-
-=item $fa-E<gt>set_transition($state1, $state2, @labels)
-
-Resets the transition between $state1 and $state2 to a transition
-initialized using data @labels. If @labels is omitted or contains
-only undefined elements, then the call is equivalent to C<remove_transition>.
-
-=item $fa-E<gt>add_transition($state1, $state2, @labels)
-
-Adds @labels to the transition between $state1 and $state2.
-
-=item $fa-E<gt>get_transition($state1, $state2)
-
-Returns the transition object stored between $state1 and $state2, or
-undef if there is no transition.
-
-=item $fa-E<gt>remove_transition($state1, $state2)
-
-Removes the transition object between $state1 and $state2.
-
-=item $fa-E<gt>successors(\@states)
-
-=item $fa-E<gt>successors($state)
-
-=item $fa-E<gt>successors(\@states, $label)
-
-=item $fa-E<gt>successors($state, $label)
-
-=item $fa-E<gt>successors(\@states, \@labels)
-
-=item $fa-E<gt>successors($state, \@labels)
-
-Given a state/set of states, and one or more labels, returns a list of
-the states (without duplicates) reachable from the states via a single
-transition having any of the given labels. If no labels are given, returns
-the states reachable by any (single) transition.
-
-Note that this method makes no distinction for epsilon transitions, these
-are only special in FLAT::NFA objects.
-
-=item $fa-E<gt>alphabet
-
-Returns the list of characters (without duplicates) used among all
-transition labels in the automaton.
-
-=back
-
-=head2 Conversions To External Formats
-
-=over
-
-=item $fa-E<gt>as_graphviz
-
-Returns a string containing a GraphViz (dot) description of the automaton,
-suitable for rendering with your favorite GraphViz layout engine.
-
-=item $fa-E<gt>as_summary
-
-Returns a string containing a plaintext description of the automaton,
-suitable for debugging purposes.
-
-=back
-
-=head2 Miscellaneous
-
-=over
-
-=item $fa-E<gt>clone
-
-Returns an identical copy of $fa.
-
-=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-21 20:55:38 +0000