Algorithm-ConstructDFA
view release on metacpan or search on metacpan
Revision history for Perl extension Algorithm::ConstructDFA.
0.03 February 2014
- minor performance improvements
- made `start` option an array instead of string
0.02 February 2014
- Slight speedup for nullable check.
Memoize is slower than expected.
- Fixed bug in $all_reachable_and_self routine
- Minor documentation fixes
0.01 January 2014
- original version
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
my %seen;
my @todo = (@_);
while (@todo) {
my $c = pop @todo;
next if $seen{$c}++;
push @todo, $successors->($c) if $nullable->($c);
}
keys %seen;
};
my $start = [
sort { $a cmp $b }
uniq map {
$nullable->($_) ? @{ $all_reachable_and_self->($_) } : $_
}
map { $m->s2n($_) }
@$roots
];
my $start_s = join ' ', @$start;
my @todo = ($start);
my %seen;
my $dfa;
my @accepting_dfa_states;
my %predecessors;
while (@todo) {
my $src = pop @todo;
my @src = @{ $src };
my $src_s = join ' ', @src;
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
my %seen;
my @todo = @accepting_dfa_states;
while (@todo) {
my $c = pop @todo;
next if $seen{$c}++;
push @todo, keys %{ $predecessors{$c} };
}
map { $_ => 1 } keys %seen;
};
my $o = Data::AutoBimap->new(start => 0);
# Ensure that DFA state 0 is the one that corresponds to no
# vertices in the input graph. This is an API convention and
# does not have significance beyond that.
my $r = { $o->s2n('') => {
Combines => [],
Accepts => $accepting->()
} };
# Ensure start state is 1 also as a convention
$o->s2n($start_s);
while (my ($src, $x) = each %$dfa) {
# Merge dead states
$src = '' unless $reachable{$src};
my @src_combines = map { $m->n2s($_) } split/ /, $src;
$r->{$o->s2n($src)}{Combines} //= \@src_combines;
$r->{$o->s2n($src)}{Combines} = [ sort { $a cmp $b }
uniq (@{$r->{$o->s2n($src)}{Combines} // []}, @src_combines) ]
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
return $r;
}
sub construct_dfa {
my (%o) = @_;
die unless ref $o{is_nullable};
die unless ref $o{is_accepting} or exists $o{final};
die unless ref $o{successors};
die unless ref $o{get_label};
die unless exists $o{start};
die if ref $o{is_accepting} and exists $o{final};
if (exists $o{final}) {
my %in_final = map { $_ => 1 } @{ $o{final} };
$o{is_accepting} = sub {
grep { $in_final{$_} } @_
};
}
_get_graph($o{start}, $o{get_label}, $o{is_nullable},
$o{successors}, $o{is_accepting});
}
1;
__END__
=head1 NAME
Algorithm::ConstructDFA - Deterministic finite automaton construction
=head1 SYNOPSIS
use Algorithm::ConstructDFA;
my $dfa = construct_dfa(
start => [ $start_vertex ],
is_accepting => sub { grep { $_ eq $final_vertex } @_ },
is_nullable => sub {
$g->has_vertex_attribute($_[0], 'label')
},
successors => sub { $g->successors($_[0]) },
get_label => sub {
$g->get_vertex_attribute($_[0], 'label')
},
);
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
=head1 FUNCTIONS
=over
=item construct_dfa(%options)
Construct a DFA using the given options.
=over
=item start
An array of start states for the initial configuration of the
automaton.
=item final
An array of final accepting states. This can be used instead
of specifying a subroutine in C<is_accepting>.
=item is_accepting
A subroutine returning a boolean indicating whether this is an
lib/Algorithm/ConstructDFA.pm view on Meta::CPAN
A subroutine that returns a caller-defined string representing what
kind of input is expected to move past the supplied vertex. Can also
be C<undef> for vertices without label.
=back
The function returns the DFA as hash reference with integer keys. The
key C<0> is a non-accepting state with no transitions to other states
(the automaton would go into this state if the match has failed). The
key C<1> is the start state. The value of each entry is another hash
reference. As an example:
'1':
Accepts: 1
Combines:
- 0
- 1
- 2
NextOver:
a: 0
b: 1
The C<Accepts> key indicates whether this is an accepting state. The
C<Combines> key provides access to the list of states in the input
automaton this DFA state corresponds to. The C<NextOver> field is the
transition table out of this state. This automaton matches any sequence
of zero or more C<b>s. The alphabet also includes the label C<a> but
the automaton moves from the start state over the label C<a> to the
non-accepting sink state C<0> and would never enter an accepting state
after that.
An exception to the rule above is when C<is_accepting> returns a true
value when passed no arguments (i.e., the automaton accepts when it is
in none of the states in the input automaton). Then state C<0> is made
an accepting state (and combines states from which the final vertex is
unreachable as before). This can be useful to compute complement graphs.
=back
t/02simple.t view on Meta::CPAN
);
my %labels;
my @vertices = $g->vertices;
for my $v (@vertices) {
next unless rand > 0.3;
my $label = ['a', 'b', 'c']->[int rand 3];
$g->set_vertex_attribute($v, 'label', $label);
}
my $start = [sort_by { scalar $g->successors($_) } @vertices]->[-1];
next unless defined $start;
my $final = [$g->all_successors($start), $start]
->[int rand(1 + scalar $g->all_successors($start))];
next unless defined $final;
my $dfa = construct_dfa(
is_nullable => sub {
not $g->has_vertex_attribute($_[0], 'label')
},
# is_accepting => sub { grep { $_ eq $final } @_ },
final => [ $final ],
successors => sub { $g->successors($_[0]) },
get_label => sub { $g->get_vertex_attribute($_[0], 'label') // '' },
start => [ $start ],
);
my $dfa_g = Graph::Directed->new;
my $dfa_g_final = "final";
for my $s (keys %$dfa) {
for my $label (keys %{$dfa->{$s}{NextOver}}) {
my $mid = $s . ':' . $label;
$dfa_g->add_edge($s, $mid);
$dfa_g->add_edge($mid, $dfa->{$s}{NextOver}{$label});
$dfa_g->set_vertex_attribute($mid, 'label', $label) if length $label;
t/02simple.t view on Meta::CPAN
last unless defined $s;
push @path, $s;
}
unless ($path[-1] eq $dst) {
splice @path, $#path, 1, $copy->SP_Dijkstra($path[-1], $dst);
}
return @path;
}
};
for my $config ([$g, $start, $final, $dfa_g, 1, $dfa_g_final],
[$dfa_g, 1, $dfa_g_final, $g, $start, $final]
) {
my ($g1, $start, $final, $g2, $start2, $final2) = @$config;
my $rnd;
eval {
$rnd = Graph::RandomPath->create_generator($g1, $start, $final);
};
next if $@;
for (1 .. 4) {
my @path = $rnd->();
my @word =
map { $g1->get_vertex_attribute($_, 'label') }
grep { $g1->has_vertex_attribute($_, 'label') }
@path[0 .. $#path - 1];
# use YAML::XS;
# warn Dump { path => \@path, word => join('/', @word), };
my @word_copy = @word;
my @state = $start2;
while (1) {
my %seen;
my @todo = @state;
@state = ();
while (@todo) {
my $t = pop @todo;
next if $seen{$t}++;
push @state, $t;
next if $g2->has_vertex_attribute($t, 'label');
( run in 0.238 second using v1.01-cache-2.11-cpan-0d8aa00de5b )