[Perl-flat-commit-notify] SF.net SVN: perl-flat: [104] trunk/perl-flat

[notifies s. of c. c. <per...@li...>]

Revision: 104
          http://svn.sourceforge.net/perl-flat/?rev=104&view=rev
Author:   estrabd
Date:     2007-02-23 14:40:01 -0800 (Fri, 23 Feb 2007)

Log Message:
-----------
fixed major implementation issue wrt dft and mini-dfa - i.e., removal of sink states is required; also, very basic proof of concept regarding the use of a dft to generate valid strings is working

Modified Paths:
--------------
    trunk/perl-flat/dev-scripts/bdetest.pl
    trunk/perl-flat/lib/FLAT/DFA.pm
    trunk/perl-flat/lib/FLAT/NFA.pm

Modified: trunk/perl-flat/dev-scripts/bdetest.pl
===================================================================
--- trunk/perl-flat/dev-scripts/bdetest.pl	2007-02-23 03:28:40 UTC (rev 103)
+++ trunk/perl-flat/dev-scripts/bdetest.pl	2007-02-23 22:40:01 UTC (rev 104)
@@ -7,12 +7,5 @@
 use FLAT::PFA;
 use FLAT::Regex::WithExtraOps;
 
-my $dfa = FLAT::Regex::WithExtraOps->new($ARGV[0])->as_pfa->as_nfa->as_dfa;
-
-use Data::Dumper;
-$Data::Dumper::Deepcopy = 1;
-
-#print Dumper($dfa->as_node_list);
-
-my $tree = $dfa->as_depth_first_tree();
-#print Dumper($tree);
+my $dfa = FLAT::Regex::WithExtraOps->new($ARGV[0])->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
+$dfa->depth_first();

Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm	2007-02-23 03:28:40 UTC (rev 103)
+++ trunk/perl-flat/lib/FLAT/DFA.pm	2007-02-23 22:40:01 UTC (rev 104)
@@ -175,6 +175,53 @@
   return %node;
 }
 
+# does a dft of digraph, but does not return a tree
+sub depth_first {
+  use Sub::Recursive;
+  my $self = shift;
+  # data structure to do dft over
+  my %nodes = $self->as_node_list();
+  my %dflabel  = ();    # "global" lookup table for dflable
+  my %backtracked = (); # "global" lookup table for backtracked edges
+  my %low         = (); # "global" lookup table for low
+  my $lastDFLabel = 0;
+  my $recurse_level = 0; # tracks recurse level
+  my $search = recursive {                            
+    my $startNode = shift;
+    $recurse_level++; # <- tracker
+    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";      
+	}
+        $REC->($adjacent);
+        # on back tracking, do the following
+        $backtracked{$adjacent}++;  # <- track backtracked nodes
+        # update LOW of $startNode
+	if ($low{$startNode} > $low{$adjacent}) {
+	  $low{$startNode} = $low{$adjacent};
+	}	
+      } 
+    }
+    $recurse_level--; # <- tracker
+    return;     
+  };
+  # start the recursive dft search off
+  $search->($self->get_starting());
+  return;
+}
+
 # returns a tree stucture resulting from a dft of the DFA;
 sub as_depth_first_tree {
   use Sub::Recursive;
@@ -229,6 +276,7 @@
 	  }
 	}	
       }
+      $backtracked{$startNode}++;  # <- track backtracked nodes
       # leave
       $recurse_level--; # <- tracker
       return \%treeNode;

Modified: trunk/perl-flat/lib/FLAT/NFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/NFA.pm	2007-02-23 03:28:40 UTC (rev 103)
+++ trunk/perl-flat/lib/FLAT/NFA.pm	2007-02-23 22:40:01 UTC (rev 104)
@@ -279,7 +279,7 @@
                 $s1, $s2, $t->as_string;
         }
     }}
-    
+  
     return sprintf "graph: {\ndisplay_edge_labels: yes\n\n%s\n%s}\n",
         join("", @states),
         join("", @trans);
@@ -292,7 +292,7 @@
     my @states = map {
         sprintf qq{%s [label="%s",shape=%s]\n},
             $_,
-            ($self->is_starting($_) ? "start" : ""),
+            ($self->is_starting($_) ? "start ($_)" : "$_"),
             ($self->is_accepting($_) ? "doublecircle" : "circle")
     } $self->get_states;
     


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.