DFA::Kleene - Kleene's Algorithm for Deterministic Finite Automata

#  Copyright (c) 1996, 1997 by Steffen Beyer. All rights reserved.
#  This package is free software; you can redistribute it and/or
#  modify it under the same terms as Perl itself.

package DFA::Kleene;  #  DFA = Deterministic Finite Automaton

# Other modules in this series (variants of Kleene's algorithm):
#
# Math::MatrixBool (see "Kleene()")
# Math::MatrixReal (see "kleene()")

use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION
            $number_of_states %alphabet
            %accepting_states @delta
            @words %language);

require Exporter;

@ISA = qw(Exporter);

@EXPORT = qw();

@EXPORT_OK = qw(initialize define_accepting_states define_delta kleene example);

%EXPORT_TAGS = (all => [@EXPORT_OK]);

$VERSION = '1.0';

use Carp;

sub initialize
{
    croak "Usage: DFA::Kleene::initialize(\$number_of_states,\$alphabet)"
      if (@_ != 2);

    my($number,$alpha) = @_;
    my($i,$j,$k);

    croak "DFA::Kleene::initialize(): number of states must be > 0"
      if ($number <= 0);
    croak "DFA::Kleene::initialize(): alphabet must comprise at least one character"
      if (length($alpha) == 0);

    $number_of_states = $number;

    undef %alphabet;
    undef %accepting_states;
    undef @delta;
    undef @words;
    undef %language;

    for ( $i = 0; $i < length($alpha); $i++ )
    {
        $alphabet{substr($alpha,$i,1)} = 1;
    }

    for ( $i = 1; $i <= $number_of_states; $i++ )
    {
        $delta[$i] = { };
        $words[$i] = [ ];
        for ( $j = 1; $j <= $number_of_states; $j++ )
        {
            $words[$i][$j] = [ ];
            for ( $k = 0; $k <= $number_of_states; $k++ )
            {
                $words[$i][$j][$k] = { };
            }
        }
    }
}

sub define_accepting_states
{
    croak "Usage: DFA::Kleene::define_accepting_states(\@accepting_states)"
      if (@_ < 1);

    my(@final) = @_;
    my($state);

    undef %accepting_states;
    foreach $state (@final)
    {
        croak "DFA::Kleene::define_accepting_states(): state $state not in [1..$number_of_states]"
          if (($state < 1) || ($state > $number_of_states));
        $accepting_states{$state} = 1;
    }
}

sub define_delta
{
    croak "Usage: DFA::Kleene::define_delta(\$state1,\$character,\$state2)"
      if (@_ != 3);

    my($state1,$character,$state2) = @_;

    croak "DFA::Kleene::define_delta(): state $state1 not in [1..$number_of_states]"
      if (($state1 < 1) || ($state1 > $number_of_states));
    croak "DFA::Kleene::define_delta(): state $state2 not in [1..$number_of_states]"
      if (($state2 < 1) || ($state2 > $number_of_states));
    croak "DFA::Kleene::define_delta(): only single character or empty string permitted"
      if (length($character) > 1);
    croak "DFA::Kleene::define_delta(): character is not contained in alphabet"
      if ($character && !($alphabet{$character}));
    croak "DFA::Kleene::define_delta(): \$delta[$state1]{'$character'} already defined"
      if (defined $delta[$state1]{$character});

    $delta[$state1]{$character} = $state2;
}

sub kleene
{
    croak "Usage: DFA::Kleene::kleene()"
      if (@_ != 0);

    my($i,$j,$k);
    my($state,$word,$word1,$word2,$word3);

    for ( $i = 1; $i <= $number_of_states; $i++ )
    {
        for ( $j = 1; $j <= $number_of_states; $j++ )
        {
            foreach $_ (keys %{$delta[$i]})
            {
                if ($delta[$i]{$_} == $j)
                {
                    $words[$i][$j][0]{$_} = 1;
                }
            }
            if ($i == $j) { $words[$i][$j][0]{''} = 1; }
        }
    }

    for ( $k = 1; $k <= $number_of_states; $k++ )
    {
        for ( $i = 1; $i <= $number_of_states; $i++ )
        {
            for ( $j = 1; $j <= $number_of_states; $j++ )
            {
                foreach $word (keys %{$words[$i][$j][$k-1]})
                {
                    $words[$i][$j][$k]{$word} = 1;
                }
                foreach $word1 (keys %{$words[$i][$k][$k-1]})
                {
                    foreach $word2 (keys %{$words[$k][$k][$k-1]})
                    {
                        foreach $word3 (keys %{$words[$k][$j][$k-1]})
                        {
                            if ($word2)
                                { $word = "${word1}(${word2})*${word3}"; }
                            else
                                { $word = "${word1}${word3}"; }
                            $words[$i][$j][$k]{$word} = 1;
                        }
                    }
                }
            }
        }
    }
    undef %language;
    foreach $state (keys %accepting_states)
    {
        # Note that the following assumes state #1 to be the "start" state:

        foreach $word (keys %{$words[1][$state][$number_of_states]})
        {
            $language{$word} = 1;
        }
    }
    return( sort(keys %language) );
}

sub example
{
    &initialize(6,"ab");
    &define_accepting_states(2,3,4,5);
    &define_delta(1,'a',4);
    &define_delta(1,'b',6);
    &define_delta(2,'a',2);
    &define_delta(2,'b',5);
    &define_delta(3,'a',6);
    &define_delta(3,'b',3);
    &define_delta(4,'a',2);
    &define_delta(4,'b',5);
    &define_delta(5,'a',4);
    &define_delta(5,'b',3);
    &define_delta(6,'a',6);
    &define_delta(6,'b',6);

    # should return something equivalent to:
    #         (a(a)*b)*a(a)*(b)*
    # which is the same as ((a+)b)*(a+)b*

    foreach $_ ( &kleene() )
    {
        print "'$_'\n";
    }
}

1;

__END__