[Perl-flat-commit-notify] SF.net SVN: perl-flat: [110] trunk/perl-flat/dev-scripts/ all-strings-no-cycles.pl

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

Revision: 110
          http://svn.sourceforge.net/perl-flat/?rev=110&view=rev
Author:   estrabd
Date:     2007-02-27 12:50:51 -0800 (Tue, 27 Feb 2007)

Log Message:
-----------
new file contains the code to generate all valid strings possible that do not include cycles due to closure

Added Paths:
-----------
    trunk/perl-flat/dev-scripts/all-strings-no-cycles.pl

Added: trunk/perl-flat/dev-scripts/all-strings-no-cycles.pl
===================================================================
--- trunk/perl-flat/dev-scripts/all-strings-no-cycles.pl	                        (rev 0)
+++ trunk/perl-flat/dev-scripts/all-strings-no-cycles.pl	2007-02-27 20:50:51 UTC (rev 110)
@@ -0,0 +1,80 @@
+#!/usr/bin/env perl -l
+use strict;
+
+use lib qw(../lib);
+use FLAT::DFA;
+use FLAT::Regex::WithExtraOps;
+
+# fucking A!
+# perl bdetest.pl "a&b&c&d" will give you all permutations ... once the transformations are done.
+# because it takes so darn long to do transformations, it it might be useful to have a native
+# interface to dumping a "frozen" DFA object to file...time to investigate 
+
+print STDERR <<END;
+
+  This example includes the serialization of the DFA object, 
+  so if the file exists, it will not go through the transformation again;
+  In a basic sense, this is an example of compressing data - compare the 
+  size of the serialized object with a text file containing all strings stored
+  in the DFA.  The "compression" is even more extreme if you compare the size 
+  of the output'd text with the size of the actual regular expression.
+END
+
+my $dfa;
+#example:
+use Storable;
+
+mkdir "dat" if (! -e "dat");
+
+if (!-e "dat/$ARGV[0].dat") {
+  $dfa = FLAT::Regex::WithExtraOps->new($ARGV[0])->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
+  store $dfa, "dat/$ARGV[0].dat";
+} else {
+  print STDERR "dat/$ARGV[0].dat found.."; 
+  $dfa = retrieve "dat/$ARGV[0].dat";
+}
+
+my %nodes = $dfa->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 @string        = ();
+# anonymous, recursive function
+
+&acyclic($dfa->get_starting());
+
+# this function finds all acyclic paths in the dfa for each symbol!!
+sub acyclic {                            
+  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}})) {
+      if (!exists($dflabel{$adjacent})) {      # initial tree edge
+        foreach my $symbol (@{$nodes{$startNode}{$adjacent}}) {
+	  push(@string,$symbol);
+          acyclic($adjacent);
+          $backtracked{$adjacent}++;  # <- track backtracked nodes
+	  if ($low{$startNode} > $low{$adjacent}) {
+	    $low{$startNode} = $low{$adjacent};
+	  }	
+	  if ($dfa->is_accepting($adjacent)) {
+            printf("%s\n",join('',@string));
+	  }
+	  pop(@string);
+        }
+      }
+    } 
+  }
+  # remove startNode entry to facilitate acyclic path determination
+  delete($dflabel{$startNode});
+  $lastDFLabel--;
+  $recurse_level--; # <- tracker
+  return;     
+};


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