From: notifies s. of c. c. <per...@li...> - 2007-03-05 04:52:51
|
Revision: 115 http://svn.sourceforge.net/perl-flat/?rev=115&view=rev Author: estrabd Date: 2007-03-04 20:52:51 -0800 (Sun, 04 Mar 2007) Log Message: ----------- adding file to implement prototype of my new method for getting strings from an infinite dfa Added Paths: ----------- trunk/perl-flat/dev-scripts/explode.pl Added: trunk/perl-flat/dev-scripts/explode.pl =================================================================== --- trunk/perl-flat/dev-scripts/explode.pl (rev 0) +++ trunk/perl-flat/dev-scripts/explode.pl 2007-03-05 04:52:51 UTC (rev 115) @@ -0,0 +1,86 @@ +#!/usr/bin/env perl -l + +# +# To be implemented in the main module code soon +# (minus not the store/retrieve stuff); that is here for the convenience of testing +# + +# +# employs a recursive DFS based determination of all acyclic paths, which is +# pretty darn efficient +# + +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; +# tree edge detection + if (!exists($dflabel{$startNode})) { + $dflabel{$startNode} = ++$lastDFLabel; # the order inwhich this link was explored + foreach my $adjacent (keys(%{$nodes{$startNode}})) { + if (!exists($dflabel{$adjacent})) { # initial tree edge + foreach my $symbol (@{$nodes{$startNode}{$adjacent}}) { + push(@string,$symbol); + acyclic($adjacent); + 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--; + return; +}; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: notifies s. of c. c. <per...@li...> - 2007-03-05 23:01:07
|
Revision: 117 http://svn.sourceforge.net/perl-flat/?rev=117&view=rev Author: estrabd Date: 2007-03-05 15:01:08 -0800 (Mon, 05 Mar 2007) Log Message: ----------- modified acyclic path search to accept @goals nodes in addition to the src node Modified Paths: -------------- trunk/perl-flat/dev-scripts/explode.pl Modified: trunk/perl-flat/dev-scripts/explode.pl =================================================================== --- trunk/perl-flat/dev-scripts/explode.pl 2007-03-05 22:50:48 UTC (rev 116) +++ trunk/perl-flat/dev-scripts/explode.pl 2007-03-05 23:01:08 UTC (rev 117) @@ -42,7 +42,12 @@ &acyclic($dfa->get_starting(),$dfa->get_accepting()); #<-- accepts start node and set of possible goals -# this function finds all acyclic paths in the dfa for each symbol!! + +# Given a start node and a set of valid @goal nodes, we can find an acyclic path; based +# how one composes the @goal set determines its behavior. What matters first and foremost +# is that we return to a node on the parent acyclic that is assumed to at some point to get a final node + + sub acyclic { my $startNode = shift; my @goalNodes = @_; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: notifies s. of c. c. <per...@li...> - 2007-05-04 21:20:47
|
Revision: 118 http://svn.sourceforge.net/perl-flat/?rev=118&view=rev Author: estrabd Date: 2007-05-04 14:20:47 -0700 (Fri, 04 May 2007) Log Message: ----------- Modified Paths: -------------- trunk/perl-flat/dev-scripts/explode.pl Modified: trunk/perl-flat/dev-scripts/explode.pl =================================================================== --- trunk/perl-flat/dev-scripts/explode.pl 2007-03-05 23:01:08 UTC (rev 117) +++ trunk/perl-flat/dev-scripts/explode.pl 2007-05-04 21:20:47 UTC (rev 118) @@ -42,12 +42,10 @@ &acyclic($dfa->get_starting(),$dfa->get_accepting()); #<-- accepts start node and set of possible goals - # Given a start node and a set of valid @goal nodes, we can find an acyclic path; based # how one composes the @goal set determines its behavior. What matters first and foremost # is that we return to a node on the parent acyclic that is assumed to at some point to get a final node - sub acyclic { my $startNode = shift; my @goalNodes = @_; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |