Menu
▾
▴
[Perl-flat-commit-notify] SF.net SVN: perl-flat: [106] trunk/perl-flat
|
From: notifies s. of c. c. <per...@li...> - 2007-02-26 13:32:00
|
Revision: 106
http://svn.sourceforge.net/perl-flat/?rev=106&view=rev
Author: estrabd
Date: 2007-02-26 05:31:56 -0800 (Mon, 26 Feb 2007)
Log Message:
-----------
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/bdetest.pl
trunk/perl-flat/lib/FLAT/DFA.pm
Modified: trunk/perl-flat/dev-scripts/bdetest.pl
===================================================================
--- trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-23 22:42:52 UTC (rev 105)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-26 13:31:56 UTC (rev 106)
@@ -8,4 +8,4 @@
use FLAT::Regex::WithExtraOps;
my $dfa = FLAT::Regex::WithExtraOps->new($ARGV[0])->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
-$dfa->depth_first();
+$dfa->acyclic();
Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-23 22:42:52 UTC (rev 105)
+++ trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-26 13:31:56 UTC (rev 106)
@@ -2,8 +2,8 @@
use strict;
use base 'FLAT::NFA';
use Carp;
+$|++;
-
sub set_starting {
my $self = shift;
$self->SUPER::set_starting(@_);
@@ -175,9 +175,8 @@
return %node;
}
-# does a dft of digraph, but does not return a tree
-sub depth_first {
- use Sub::Recursive;
+# finds all acyclic s->f paths (f \in F)
+sub acyclic {
my $self = shift;
# data structure to do dft over
my %nodes = $self->as_node_list();
@@ -186,35 +185,33 @@
my %low = (); # "global" lookup table for low
my $lastDFLabel = 0;
my $recurse_level = 0; # tracks recurse level
+ my @string = ();
+ # anonymous, recursive function
+ use Sub::Recursive;
my $search = recursive {
my $startNode = shift;
$recurse_level++; # <- tracker
+# tree edge detection
if (!exists($dflabel{$startNode})) {
$dflabel{$startNode} = ++$lastDFLabel; # the order inwhich this link was explored
$low{$startNode} = $lastDFLabel;
$backtracked{$startNode} = 0; # marks this node as visited before - for cross edge detection
foreach my $adjacent (keys(%{$nodes{$startNode}})) {
- #printf("%s",$nodes{$startNode}{$adjacent}->[0]);
- #print "" if ($self->is_accepting($adjacent));
if (!exists($dflabel{$adjacent})) { # initial tree edge
-# print "tree edge! $startNode -> $adjacent"; # for testing only
- } elsif (-1 == ($dflabel{$adjacent} - $dflabel{$startNode})){ # detects child visiting a parent
-# print "tree edge, 2nd visit! $startNode is child of $adjacent!\n"; # for testing only
- } elsif ($dflabel{$adjacent} < $dflabel{$startNode}) { # back edge
-# print "back edge!";
- } elsif ($dflabel{$adjacent} < $dflabel{$startNode}) { # back edge
-# print "back edge, 2nd visit!\n";
+ push(@string,$nodes{$startNode}{$adjacent}->[0]);
+ $REC->($adjacent);
+ $backtracked{$adjacent}++; # <- track backtracked nodes
+ if ($low{$startNode} > $low{$adjacent}) {
+ $low{$startNode} = $low{$adjacent};
+ }
}
- $REC->($adjacent);
- # on back tracking, do the following
- $backtracked{$adjacent}++; # <- track backtracked nodes
- print "$backtracked{$adjacent}";
- # update LOW of $startNode
- if ($low{$startNode} > $low{$adjacent}) {
- $low{$startNode} = $low{$adjacent};
- }
+ print join('',@string) if ($self->is_accepting($adjacent));
+ pop(@string);
}
}
+ # remove startNode entry to facilitate acyclic path determination
+ delete($dflabel{$startNode});
+ $lastDFLabel--;
$recurse_level--; # <- tracker
return;
};
@@ -223,9 +220,11 @@
return;
}
-# returns a tree stucture resulting from a dft of the DFA;
-sub as_depth_first_tree {
- use Sub::Recursive;
+# does a dft of digraph, but does not return a tree
+# incorporates strong component detection, which I
+# think might yield some interesting methods for
+# generating valid strings
+sub depth_first {
my $self = shift;
# data structure to do dft over
my %nodes = $self->as_node_list();
@@ -234,62 +233,53 @@
my %low = (); # "global" lookup table for low
my $lastDFLabel = 0;
my $recurse_level = 0; # tracks recurse level
+ # anonymous, recursive function
+ use Sub::Recursive;
my $search = recursive {
my $startNode = shift;
- my %treeNode; # initialize
$recurse_level++; # <- tracker
+# tree edge detection
if (!exists($dflabel{$startNode})) {
- print "Accepting Node $startNode Found" if ($self->is_accepting($startNode));
$dflabel{$startNode} = ++$lastDFLabel; # the order inwhich this link was explored
$low{$startNode} = $lastDFLabel;
$backtracked{$startNode} = 0; # marks this node as visited before - for cross edge detection
- # tree node "struct" - really a hash..
- %treeNode = (
- node => $startNode,
- parent => undef,
- left => undef,
- right => undef,
- first => undef,
- last => undef,
- );
foreach my $adjacent (keys(%{$nodes{$startNode}})) {
+ #printf("%s",$nodes{$startNode}{$adjacent}->[0]);
+ #print "" if ($self->is_accepting($adjacent));
if (!exists($dflabel{$adjacent})) { # initial tree edge
-# print "tree edge! $startNode -> $adjacent\n"; # for testing only
- } elsif (-1 == ($dflabel{$adjacent} - $dflabel{$startNode})){ # detects child visiting a parent
-# print "tree edge, 2nd visit! $startNode is child of $adjacent!\n"; # for testing only
- } elsif ($dflabel{$adjacent} < $dflabel{$startNode}) { # back edge
-# print "back edge!";
- } elsif ($dflabel{$adjacent} < $dflabel{$startNode}) { # back edge
-# print "back edge, 2nd visit!\n";
- }
- my $child = $REC->($adjacent);
- if (defined($child)) {
- $child->{right} = undef;
- $child->{left} = undef;
- $child->{parent} = \%treeNode;
- if (!defined($treeNode{first})) {
- $treeNode{first} = $child;
- $treeNode{last} = $child;
- } else {
- $child->{left} = $treeNode{last};
- $treeNode{last}->{right} = $child;
- $treeNode{last} = $child;
+ print "tree edge! $startNode -> $adjacent"; # for testing only
+ $REC->($adjacent);
+ print "Backtracking $adjacent -> $startNode";
+ # on back tracking, do the following
+ $backtracked{$adjacent}++; # <- track backtracked nodes
+# print "$startNode -> $adjacent : $backtracked{$adjacent}";
+ # update LOW of $startNode
+ if ($low{$startNode} > $low{$adjacent}) {
+ $low{$startNode} = $low{$adjacent};
+ }
+ # detect strong component
+ if ($low{$adjacent} == $dflabel{$adjacent}) {
+ print "STRONG COMPONENT";
}
- }
- }
- $backtracked{$startNode}++; # <- track backtracked nodes
- # leave
- $recurse_level--; # <- tracker
- return \%treeNode;
+# back edge detection
+ } elsif ($dflabel{$adjacent} < $dflabel{$startNode} && !exists($backtracked{$adjacent})) { # back edge
+ print "back edge! $startNode -> $adjacent";
+# cross edge detection
+ } elsif ($backtracked{$adjacent}) {
+ print "cross edge! $startNode -> $adjacent";
+ # update low(startNode) with dflabel(adjacent) if low is greater than dflabel
+ if ($dflabel{$adjacent} < $low{$startNode}) {
+ $low{$startNode} = $dflabel{$adjacent};
+ }
+ }
+ }
}
$recurse_level--; # <- tracker
- return undef;
+ return;
};
-
- # start the recursive dft search
- my $tree = $search->($self->get_starting());
- # return tree
- return $tree;
+ # start the recursive dft search off
+ $search->($self->get_starting());
+ return;
}
# creates table used by a FLAT::DFA::Validator object to assess
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
