Menu
▾
▴
perl-flat-cvs-notify — notifies subscribers of cvs commits
You can subscribe to this list here.
| 2006 |
Jan
|
Feb
(32) |
Mar
(25) |
Apr
(13) |
May
(3) |
Jun
|
Jul
|
Aug
(1) |
Sep
(5) |
Oct
(2) |
Nov
|
Dec
(1) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2007 |
Jan
|
Feb
(28) |
Mar
(6) |
Apr
|
May
(3) |
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: notifies s. of c. c. <per...@li...> - 2007-05-16 03:25:58
|
Revision: 120
http://svn.sourceforge.net/perl-flat/?rev=120&view=rev
Author: estrabd
Date: 2007-05-15 20:25:53 -0700 (Tue, 15 May 2007)
Log Message:
-----------
Added Paths:
-----------
trunk/perl-flat/MANIFEST
trunk/perl-flat/Makefile
Removed Paths:
-------------
trunk/perl-flat/MANIFEST
trunk/perl-flat/Makefile.PL
trunk/perl-flat/TODO
Deleted: trunk/perl-flat/MANIFEST
===================================================================
--- trunk/perl-flat/MANIFEST 2007-05-16 03:11:59 UTC (rev 119)
+++ trunk/perl-flat/MANIFEST 2007-05-16 03:25:53 UTC (rev 120)
@@ -1,20 +0,0 @@
-t/01-regex.t
-t/02-fa.t
-t/03/pregex-pfa.t
-t/04-transform.t
-MANIFEST
-lib/FLAT/Regex/Op.pm
-lib/FLAT/Regex/Parser.pm
-lib/FLAT/Regex/Transform.pm
-lib/FLAT/Regex/WithNegations.pm
-lib/FLAT/Regex/Transform.pm
-lib/FLAT/Regex.pm
-lib/FLAT/FA.pm
-lib/FLAT/NFA.pm
-lib/FLAT/DFA.pm
-lib/FLAT/Transition.pm
-lib/FLAT.pm
-bin/util-put.pl
-bin/fash
-Makefile.PL
-META.yml Module meta-data (added by MakeMaker)
Added: trunk/perl-flat/MANIFEST
===================================================================
--- trunk/perl-flat/MANIFEST (rev 0)
+++ trunk/perl-flat/MANIFEST 2007-05-16 03:25:53 UTC (rev 120)
@@ -0,0 +1,20 @@
+t/01-regex.t
+t/02-fa.t
+t/03/pregex-pfa.t
+t/04-transform.t
+MANIFEST
+lib/FLAT/Regex/Op.pm
+lib/FLAT/Regex/Parser.pm
+lib/FLAT/Regex/Transform.pm
+lib/FLAT/Regex/WithNegations.pm
+lib/FLAT/Regex/Transform.pm
+lib/FLAT/Regex.pm
+lib/FLAT/FA.pm
+lib/FLAT/NFA.pm
+lib/FLAT/DFA.pm
+lib/FLAT/Transition.pm
+lib/FLAT.pm
+bin/util-put.pl
+bin/fash
+Makefile.PL
+META.yml Module meta-data (added by MakeMaker)
Added: trunk/perl-flat/Makefile
===================================================================
--- trunk/perl-flat/Makefile (rev 0)
+++ trunk/perl-flat/Makefile 2007-05-16 03:25:53 UTC (rev 120)
@@ -0,0 +1,13 @@
+use 5.008;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'FLAT',
+ VERSION_FROM => 'lib/FLAT.pm',
+ PREREQ_PM => { Parse::RecDescent => 0,},
+ PL_FILES => {'bin/util-put.pl', 'bin/util-put'},
+ ($] >= 5.005 ? (ABSTRACT_FROM => 'lib/FLAT.pm',
+ AUTHOR => 'perl-flat')
+ : ()),
+);
Deleted: trunk/perl-flat/Makefile.PL
===================================================================
--- trunk/perl-flat/Makefile.PL 2007-05-16 03:11:59 UTC (rev 119)
+++ trunk/perl-flat/Makefile.PL 2007-05-16 03:25:53 UTC (rev 120)
@@ -1,13 +0,0 @@
-use 5.008;
-use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-WriteMakefile(
- NAME => 'FLAT',
- VERSION_FROM => 'lib/FLAT.pm',
- PREREQ_PM => { Parse::RecDescent => 0,},
- PL_FILES => {'bin/util-put.pl', 'bin/util-put'},
- ($] >= 5.005 ? (ABSTRACT_FROM => 'lib/FLAT.pm',
- AUTHOR => 'perl-flat')
- : ()),
-);
Deleted: trunk/perl-flat/TODO
===================================================================
--- trunk/perl-flat/TODO 2007-05-16 03:11:59 UTC (rev 119)
+++ trunk/perl-flat/TODO 2007-05-16 03:25:53 UTC (rev 120)
@@ -1,13 +0,0 @@
-error checking for doing certain operations on 0-state FAs...
-
-in dfa minimization, there should be some way to return the equivalence
- classes, as well as perhaps the distinguishing strings
-
-TESTS TESTS TESTS TESTS TESTS TESTS TESTS
-
-keep track of where in the code we assume ->get_states are numbers (if
- we want to add state label support back).
-
-input and output options and formats - most likely the ability to read in graphviz and GDL formats....heck, even the ability to read in an adcirc style mesh would freaking rock!
-
-look at creating a 'drop in' regex/pregex parser using the custom recdesc one build for FLAT::Legacy
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-16 03:12:03
|
Revision: 119
http://svn.sourceforge.net/perl-flat/?rev=119&view=rev
Author: estrabd
Date: 2007-05-15 20:11:59 -0700 (Tue, 15 May 2007)
Log Message:
-----------
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/explode.pl
Added Paths:
-----------
trunk/perl-flat/branches/
trunk/perl-flat/tags/
trunk/perl-flat/trunk/
Modified: trunk/perl-flat/dev-scripts/explode.pl
===================================================================
--- trunk/perl-flat/dev-scripts/explode.pl 2007-05-04 21:20:47 UTC (rev 118)
+++ trunk/perl-flat/dev-scripts/explode.pl 2007-05-16 03:11:59 UTC (rev 119)
@@ -32,33 +32,40 @@
my %nodes = $dfa->as_node_list();
-my %dflabel = (); # "global" lookup table for dflable
+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 = ();
+my $recurse_level = 0; # tracks recurse level
+my @string = (); # stores latest string
+my @path = (); # stores latest path
# anonymous, recursive function
-&acyclic($dfa->get_starting(),$dfa->get_accepting()); #<-- accepts start node and set of possible goals
+# accepts start node and set of possible goals
+&acyclic($dfa->get_starting(),$dfa->get_accepting());
-# 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
+# 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 = @_;
-# tree edge detection
+ # 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
+ if (!exists($dflabel{$adjacent})) { # initial tree edge
foreach my $symbol (@{$nodes{$startNode}{$adjacent}}) {
push(@string,$symbol);
acyclic($adjacent,@goalNodes);
if ($dfa->array_is_subset([$adjacent],[@goalNodes])) { #< proof of concept
printf("%s\n",join('',@string));
+ # at this point, an acyclic path has been found
+ # &explode(...)
}
pop(@string);
}
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.
|
|
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-03-05 22:50:47
|
Revision: 116
http://svn.sourceforge.net/perl-flat/?rev=116&view=rev
Author: estrabd
Date: 2007-03-05 14:50:48 -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/all-strings-no-cycles.pl
trunk/perl-flat/dev-scripts/explode.pl
Modified: trunk/perl-flat/dev-scripts/all-strings-no-cycles.pl
===================================================================
--- trunk/perl-flat/dev-scripts/all-strings-no-cycles.pl 2007-03-05 04:52:51 UTC (rev 115)
+++ trunk/perl-flat/dev-scripts/all-strings-no-cycles.pl 2007-03-05 22:50:48 UTC (rev 116)
@@ -68,10 +68,7 @@
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)) {
+ if ($dfa->array_is_subset([$adjacent],[$dfa->get_accepting()])) { #< proof of concept
printf("%s\n",join('',@string));
}
pop(@string);
Modified: trunk/perl-flat/dev-scripts/explode.pl
===================================================================
--- trunk/perl-flat/dev-scripts/explode.pl 2007-03-05 04:52:51 UTC (rev 115)
+++ trunk/perl-flat/dev-scripts/explode.pl 2007-03-05 22:50:48 UTC (rev 116)
@@ -16,21 +16,6 @@
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;
@@ -55,11 +40,12 @@
my @string = ();
# anonymous, recursive function
-&acyclic($dfa->get_starting());
+&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!!
sub acyclic {
my $startNode = shift;
+ my @goalNodes = @_;
# tree edge detection
if (!exists($dflabel{$startNode})) {
$dflabel{$startNode} = ++$lastDFLabel; # the order inwhich this link was explored
@@ -67,11 +53,8 @@
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)) {
+ acyclic($adjacent,@goalNodes);
+ if ($dfa->array_is_subset([$adjacent],[@goalNodes])) { #< proof of concept
printf("%s\n",join('',@string));
}
pop(@string);
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 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-02 04:17:53
|
Revision: 114
http://svn.sourceforge.net/perl-flat/?rev=114&view=rev
Author: estrabd
Date: 2007-03-01 20:17:49 -0800 (Thu, 01 Mar 2007)
Log Message:
-----------
took out dependency for Sub::Recursive
Modified Paths:
--------------
trunk/perl-flat/lib/FLAT.pm
Modified: trunk/perl-flat/lib/FLAT.pm
===================================================================
--- trunk/perl-flat/lib/FLAT.pm 2007-03-02 04:16:19 UTC (rev 113)
+++ trunk/perl-flat/lib/FLAT.pm 2007-03-02 04:17:49 UTC (rev 114)
@@ -107,7 +107,9 @@
NB: with the addtional shuffle operator, "&". All this
NB: means is that you can use the ambersand (&) as a symbol
NB: in the regular expressions you submit because it will be
- NB: detected as an operator.
+ NB: detected as an operator.That said, if you avoid using
+ NB: the "&" operator, you can forget about all that shuffle
+ NB: business.
COMMANDS:
%perl -MFLAT -e
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-02 04:17:05
|
Revision: 113
http://svn.sourceforge.net/perl-flat/?rev=113&view=rev
Author: estrabd
Date: 2007-03-01 20:16:19 -0800 (Thu, 01 Mar 2007)
Log Message:
-----------
took out dependency for Sub::Recursive
Modified Paths:
--------------
trunk/perl-flat/lib/FLAT.pm
Modified: trunk/perl-flat/lib/FLAT.pm
===================================================================
--- trunk/perl-flat/lib/FLAT.pm 2007-03-02 04:14:12 UTC (rev 112)
+++ trunk/perl-flat/lib/FLAT.pm 2007-03-02 04:16:19 UTC (rev 113)
@@ -103,7 +103,7 @@
|____| \___ >__| |____/ \___ / |_______ (____ /____|
\/ \/ \/ \/
- NB: Everything is wrt parallel regular expressions, i.e.,
+ NB: Everything is wrt parallel regular expressions, i.e.,
NB: with the addtional shuffle operator, "&". All this
NB: means is that you can use the ambersand (&) as a symbol
NB: in the regular expressions you submit because it will be
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-02 04:14:16
|
Revision: 112
http://svn.sourceforge.net/perl-flat/?rev=112&view=rev
Author: estrabd
Date: 2007-03-01 20:14:12 -0800 (Thu, 01 Mar 2007)
Log Message:
-----------
took out dependency for Sub::Recursive
Modified Paths:
--------------
trunk/perl-flat/Makefile.PL
Modified: trunk/perl-flat/Makefile.PL
===================================================================
--- trunk/perl-flat/Makefile.PL 2007-02-27 23:31:43 UTC (rev 111)
+++ trunk/perl-flat/Makefile.PL 2007-03-02 04:14:12 UTC (rev 112)
@@ -5,8 +5,7 @@
WriteMakefile(
NAME => 'FLAT',
VERSION_FROM => 'lib/FLAT.pm',
- PREREQ_PM => { Parse::RecDescent => 0,
- Sub::Recursive => 0 },
+ PREREQ_PM => { Parse::RecDescent => 0,},
PL_FILES => {'bin/util-put.pl', 'bin/util-put'},
($] >= 5.005 ? (ABSTRACT_FROM => 'lib/FLAT.pm',
AUTHOR => 'perl-flat')
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-02-27 23:31:47
|
Revision: 111
http://svn.sourceforge.net/perl-flat/?rev=111&view=rev
Author: estrabd
Date: 2007-02-27 15:31:43 -0800 (Tue, 27 Feb 2007)
Log Message:
-----------
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/all-strings-no-cycles.pl
Modified: trunk/perl-flat/dev-scripts/all-strings-no-cycles.pl
===================================================================
--- trunk/perl-flat/dev-scripts/all-strings-no-cycles.pl 2007-02-27 20:50:51 UTC (rev 110)
+++ trunk/perl-flat/dev-scripts/all-strings-no-cycles.pl 2007-02-27 23:31:43 UTC (rev 111)
@@ -1,4 +1,15 @@
#!/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);
@@ -49,18 +60,14 @@
# 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};
}
@@ -75,6 +82,5 @@
# 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.
|
|
From: notifies s. of c. c. <per...@li...> - 2007-02-27 20:50:53
|
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.
|
|
From: notifies s. of c. c. <per...@li...> - 2007-02-27 05:11:52
|
Revision: 109
http://svn.sourceforge.net/perl-flat/?rev=109&view=rev
Author: estrabd
Date: 2007-02-26 21:11:54 -0800 (Mon, 26 Feb 2007)
Log Message:
-----------
more playing with script - need to put it into module code...also, need to figure out iterative thing and cycle thing
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/bdetest.pl
Modified: trunk/perl-flat/dev-scripts/bdetest.pl
===================================================================
--- trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-27 03:01:37 UTC (rev 108)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-27 05:11:54 UTC (rev 109)
@@ -5,8 +5,35 @@
use FLAT::DFA;
use FLAT::Regex::WithExtraOps;
-my $dfa = FLAT::Regex::WithExtraOps->new($ARGV[0])->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
+# 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
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-02-27 03:01:37
|
Revision: 108
http://svn.sourceforge.net/perl-flat/?rev=108&view=rev
Author: estrabd
Date: 2007-02-26 19:01:37 -0800 (Mon, 26 Feb 2007)
Log Message:
-----------
prototype function emits all valid strings for all acyclic paths in the digraph ... on to handling cycles
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-26 22:52:23 UTC (rev 107)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-27 03:01:37 UTC (rev 108)
@@ -3,9 +3,51 @@
use lib qw(../lib);
use FLAT::DFA;
-use FLAT::NFA;
-use FLAT::PFA;
use FLAT::Regex::WithExtraOps;
my $dfa = FLAT::Regex::WithExtraOps->new($ARGV[0])->as_pfa->as_nfa->as_dfa->as_min_dfa->trim_sinks;
-$dfa->acyclic();
+
+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;
+};
Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-26 22:52:23 UTC (rev 107)
+++ trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-27 03:01:37 UTC (rev 108)
@@ -203,113 +203,6 @@
return %node;
}
-# 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();
- 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
- 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}})) {
- if (!exists($dflabel{$adjacent})) { # initial tree edge
- push(@string,$nodes{$startNode}{$adjacent}->[0]);
- $REC->($adjacent);
- $backtracked{$adjacent}++; # <- track backtracked nodes
- 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;
- };
- # start the recursive dft search off
- $search->($self->get_starting());
- return;
-}
-
-# 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();
- 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
- # 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
- $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";
- }
-# 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;
- };
- # start the recursive dft search off
- $search->($self->get_starting());
- return;
-}
-
1;
__END__
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-02-26 22:52:26
|
Revision: 107
http://svn.sourceforge.net/perl-flat/?rev=107&view=rev
Author: estrabd
Date: 2007-02-26 14:52:23 -0800 (Mon, 26 Feb 2007)
Log Message:
-----------
Modified Paths:
--------------
trunk/perl-flat/lib/FLAT/DFA.pm
Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-26 13:31:56 UTC (rev 106)
+++ trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-26 22:52:23 UTC (rev 107)
@@ -159,6 +159,34 @@
}
+# the validity of a given string <-- executes symbols over DFA
+# if there is not transition for given state and symbol, it fails immediately
+# if the current state we're in is not final when symbols are exhausted, then it fails
+
+sub is_valid_string {
+ my $self = shift;
+ my $string = shift;
+ chomp $string;
+ my $OK = undef;
+ my @stack = split('',$string);
+ # this is confusing all funcs return arrays
+ my @current = $self->get_starting();
+ my $current = pop @current;
+ foreach (@stack) {
+ my @next = $self->successors($current,$_);
+ if (!@next) {
+ return $OK; #<--returns undef bc no transition found
+ }
+ $current = $next[0];
+ }
+ $OK++ if ($self->is_accepting($current));
+ return $OK;
+}
+
+#
+# Experimental!!
+#
+
# DFT stuff in preparation for DFA pump stuff;
sub as_node_list {
my $self = shift;
@@ -282,31 +310,6 @@
return;
}
-# creates table used by a FLAT::DFA::Validator object to assess
-# the validity of a given string <-- executes symbols over DFA
-# if there is not transition for given state and symbol, it fails immediately
-# if the current state we're in is not final when symbols are exhausted, then it fails
-
-sub is_valid_string {
- my $self = shift;
- my $string = shift;
- chomp $string;
- my $OK = undef;
- my @stack = split('',$string);
- # this is confusing all funcs return arrays
- my @current = $self->get_starting();
- my $current = pop @current;
- foreach (@stack) {
- my @next = $self->successors($current,$_);
- if (!@next) {
- return $OK; #<--returns undef bc no transition found
- }
- $current = $next[0];
- }
- $OK++ if ($self->is_accepting($current));
- return $OK;
-}
-
1;
__END__
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-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.
|
|
From: notifies s. of c. c. <per...@li...> - 2007-02-23 22:42:52
|
Revision: 105
http://svn.sourceforge.net/perl-flat/?rev=105&view=rev
Author: estrabd
Date: 2007-02-23 14:42:52 -0800 (Fri, 23 Feb 2007)
Log Message:
-----------
Modified Paths:
--------------
trunk/perl-flat/lib/FLAT/DFA.pm
Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-23 22:40:01 UTC (rev 104)
+++ trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-23 22:42:52 UTC (rev 105)
@@ -194,8 +194,8 @@
$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));
+ #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
@@ -208,6 +208,7 @@
$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};
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-02-23 22:40:08
|
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.
|
|
From: notifies s. of c. c. <per...@li...> - 2007-02-23 03:28:45
|
Revision: 103
http://svn.sourceforge.net/perl-flat/?rev=103&view=rev
Author: estrabd
Date: 2007-02-22 19:28:40 -0800 (Thu, 22 Feb 2007)
Log Message:
-----------
added a fix for recursive anonymous subroutine via Sub::Recursive
Modified Paths:
--------------
trunk/perl-flat/Makefile.PL
trunk/perl-flat/dev-scripts/bdetest.pl
trunk/perl-flat/lib/FLAT/DFA.pm
Modified: trunk/perl-flat/Makefile.PL
===================================================================
--- trunk/perl-flat/Makefile.PL 2007-02-22 22:27:12 UTC (rev 102)
+++ trunk/perl-flat/Makefile.PL 2007-02-23 03:28:40 UTC (rev 103)
@@ -5,7 +5,8 @@
WriteMakefile(
NAME => 'FLAT',
VERSION_FROM => 'lib/FLAT.pm',
- PREREQ_PM => { Parse::RecDescent => 0 },
+ PREREQ_PM => { Parse::RecDescent => 0,
+ Sub::Recursive => 0 },
PL_FILES => {'bin/util-put.pl', 'bin/util-put'},
($] >= 5.005 ? (ABSTRACT_FROM => 'lib/FLAT.pm',
AUTHOR => 'perl-flat')
Modified: trunk/perl-flat/dev-scripts/bdetest.pl
===================================================================
--- trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-22 22:27:12 UTC (rev 102)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-23 03:28:40 UTC (rev 103)
@@ -15,4 +15,4 @@
#print Dumper($dfa->as_node_list);
my $tree = $dfa->as_depth_first_tree();
-print Dumper($tree);
+#print Dumper($tree);
Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-22 22:27:12 UTC (rev 102)
+++ trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-23 03:28:40 UTC (rev 103)
@@ -177,6 +177,7 @@
# returns a tree stucture resulting from a dft of the DFA;
sub as_depth_first_tree {
+ use Sub::Recursive;
my $self = shift;
# data structure to do dft over
my %nodes = $self->as_node_list();
@@ -185,12 +186,12 @@
my %low = (); # "global" lookup table for low
my $lastDFLabel = 0;
my $recurse_level = 0; # tracks recurse level
- my $search = sub { };
- $search = sub {
+ my $search = recursive {
my $startNode = shift;
my %treeNode; # initialize
$recurse_level++; # <- tracker
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
@@ -213,7 +214,7 @@
} elsif ($dflabel{$adjacent} < $dflabel{$startNode}) { # back edge
# print "back edge, 2nd visit!\n";
}
- my $child = $search->($adjacent);
+ my $child = $REC->($adjacent);
if (defined($child)) {
$child->{right} = undef;
$child->{left} = undef;
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-02-22 22:27:12
|
Revision: 102
http://svn.sourceforge.net/perl-flat/?rev=102&view=rev
Author: estrabd
Date: 2007-02-22 14:27:12 -0800 (Thu, 22 Feb 2007)
Log Message:
-----------
dft needs more testing
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-22 05:27:24 UTC (rev 101)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-22 22:27:12 UTC (rev 102)
@@ -7,9 +7,12 @@
use FLAT::PFA;
use FLAT::Regex::WithExtraOps;
-my $dfa = FLAT::Regex->new($ARGV[0])->as_nfa->as_dfa;
+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);
-$dfa->as_depth_first_tree();
+my $tree = $dfa->as_depth_first_tree();
+print Dumper($tree);
Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-22 05:27:24 UTC (rev 101)
+++ trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-22 22:27:12 UTC (rev 102)
@@ -185,52 +185,55 @@
my %low = (); # "global" lookup table for low
my $lastDFLabel = 0;
my $recurse_level = 0; # tracks recurse level
- my $search = sub {
+ my $search = sub { };
+ $search = sub {
my $startNode = shift;
- my %treeNode = undef; # initialize
+ my %treeNode; # initialize
$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
# tree node "struct" - really a hash..
- %treeNode = {
+ %treeNode = (
node => $startNode,
parent => undef,
- leftchild => undef,
- rightchild => undef,
+ left => undef,
+ right => undef,
first => undef,
last => undef,
- };
+ );
foreach my $adjacent (keys(%{$nodes{$startNode}})) {
if (!exists($dflabel{$adjacent})) { # initial tree edge
- print "tree edge! $startNode -> $adjacent\n"; # for testing only
+# 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
+# print "tree edge, 2nd visit! $startNode is child of $adjacent!\n"; # for testing only
} elsif ($dflabel{$adjacent} < $dflabel{$startNode}) { # back edge
- print "back edge!";
+# print "back edge!";
} elsif ($dflabel{$adjacent} < $dflabel{$startNode}) { # back edge
- print "back edge, 2nd visit!\n";
+# print "back edge, 2nd visit!\n";
}
- my $child = $search->($adjacentNode);
+ my $child = $search->($adjacent);
if (defined($child)) {
$child->{right} = undef;
$child->{left} = undef;
- $child->{parent} => \%treeNode;
- if (!defined($treeNode->{first})) {
- $treeNode->{first} = $child;
- $treeNode->{last} = $child;
+ $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;
+ $child->{left} = $treeNode{last};
+ $treeNode{last}->{right} = $child;
+ $treeNode{last} = $child;
}
}
}
+ # leave
+ $recurse_level--; # <- tracker
+ return \%treeNode;
}
- # leave
$recurse_level--; # <- tracker
- return \%treeNode;
+ return undef;
};
# start the recursive dft search
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-02-22 05:27:24
|
Revision: 101
http://svn.sourceforge.net/perl-flat/?rev=101&view=rev
Author: estrabd
Date: 2007-02-21 21:27:24 -0800 (Wed, 21 Feb 2007)
Log Message:
-----------
started dfa->as_depth_first_tree .. screaming errors, but the basic stuff is there..
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-19 21:48:47 UTC (rev 100)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-22 05:27:24 UTC (rev 101)
@@ -10,4 +10,6 @@
my $dfa = FLAT::Regex->new($ARGV[0])->as_nfa->as_dfa;
use Data::Dumper;
-print Dumper($dfa->as_node_list);
+#print Dumper($dfa->as_node_list);
+
+$dfa->as_depth_first_tree();
Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-19 21:48:47 UTC (rev 100)
+++ trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-22 05:27:24 UTC (rev 101)
@@ -168,7 +168,7 @@
my $t = $self->get_transition($s1, $s2);
if (defined $t) {
# array of symbols that $s1 will go to $s2 on...
- push(@{$node{$s1}{edges}{$s2}},split(',',$t->as_string));
+ push(@{$node{$s1}{$s2}},split(',',$t->as_string));
}
}
}
@@ -180,14 +180,57 @@
my $self = shift;
# data structure to do dft over
my %nodes = $self->as_node_list();
- my %dflabels = (); # "global" lookup table for dflable
- my %parents = (); # "global" lookup table for parents
+ 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 = sub {
- $recurse_level++;
-
+ my $startNode = shift;
+ my %treeNode = undef; # initialize
+ $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
+ # tree node "struct" - really a hash..
+ %treeNode = {
+ node => $startNode,
+ parent => undef,
+ leftchild => undef,
+ rightchild => undef,
+ first => undef,
+ last => undef,
+ };
+ foreach my $adjacent (keys(%{$nodes{$startNode}})) {
+ 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 = $search->($adjacentNode);
+ 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;
+ }
+ }
+ }
+ }
# leave
- $recurse_level--;
+ $recurse_level--; # <- tracker
+ return \%treeNode;
};
# start the recursive dft search
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-02-19 21:48:48
|
Revision: 100
http://svn.sourceforge.net/perl-flat/?rev=100&view=rev
Author: estrabd
Date: 2007-02-19 13:48:47 -0800 (Mon, 19 Feb 2007)
Log Message:
-----------
created node list for DFA, next step is dft creation
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/bdetest.pl
trunk/perl-flat/lib/FLAT/DFA.pm
trunk/perl-flat/lib/FLAT/NFA.pm
trunk/perl-flat/lib/FLAT.pm
Modified: trunk/perl-flat/dev-scripts/bdetest.pl
===================================================================
--- trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-19 14:59:39 UTC (rev 99)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-19 21:48:47 UTC (rev 100)
@@ -8,8 +8,6 @@
use FLAT::Regex::WithExtraOps;
my $dfa = FLAT::Regex->new($ARGV[0])->as_nfa->as_dfa;
-if ($dfa->is_valid($ARGV[1])) {
- print "valid"
-} else {
- print "not valid"
-}
+
+use Data::Dumper;
+print Dumper($dfa->as_node_list);
Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-19 14:59:39 UTC (rev 99)
+++ trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-19 21:48:47 UTC (rev 100)
@@ -80,6 +80,8 @@
if $num != 1;
}
+#### transformations
+
sub trim_sinks {
my $self = shift;
my $result = $self->clone();
@@ -157,10 +159,49 @@
}
+# DFT stuff in preparation for DFA pump stuff;
+sub as_node_list {
+ my $self = shift;
+ my %node = ();
+ for my $s1 ($self->get_states) {
+ for my $s2 ($self->get_states) {
+ my $t = $self->get_transition($s1, $s2);
+ if (defined $t) {
+ # array of symbols that $s1 will go to $s2 on...
+ push(@{$node{$s1}{edges}{$s2}},split(',',$t->as_string));
+ }
+ }
+ }
+ return %node;
+}
+
+# returns a tree stucture resulting from a dft of the DFA;
+sub as_depth_first_tree {
+ my $self = shift;
+ # data structure to do dft over
+ my %nodes = $self->as_node_list();
+ my %dflabels = (); # "global" lookup table for dflable
+ my %parents = (); # "global" lookup table for parents
+ my $recurse_level = 0; # tracks recurse level
+ my $search = sub {
+ $recurse_level++;
+
+ # leave
+ $recurse_level--;
+ };
+
+ # start the recursive dft search
+ my $tree = $search->($self->get_starting());
+ # return tree
+ return $tree;
+}
+
# creates table used by a FLAT::DFA::Validator object to assess
-# the validity of a given string
+# the validity of a given string <-- executes symbols over DFA
+# if there is not transition for given state and symbol, it fails immediately
+# if the current state we're in is not final when symbols are exhausted, then it fails
-sub is_valid {
+sub is_valid_string {
my $self = shift;
my $string = shift;
chomp $string;
Modified: trunk/perl-flat/lib/FLAT/NFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/NFA.pm 2007-02-19 14:59:39 UTC (rev 99)
+++ trunk/perl-flat/lib/FLAT/NFA.pm 2007-02-19 21:48:47 UTC (rev 100)
@@ -316,16 +316,6 @@
######## transformations
-# returns a tree stucture resulting from a dft of the FA;
-sub as_depth_first_tree {
- my $search =
- sub {
- # anonymous sub called by $search->(..)
- };
-
-
-}
-
# subset construction
sub as_dfa {
my $self = shift;
Modified: trunk/perl-flat/lib/FLAT.pm
===================================================================
--- trunk/perl-flat/lib/FLAT.pm 2007-02-19 14:59:39 UTC (rev 99)
+++ trunk/perl-flat/lib/FLAT.pm 2007-02-19 21:48:47 UTC (rev 100)
@@ -181,7 +181,7 @@
if (@_)
{ my $FA = FLAT::Regex::WithExtraOps->new(shift @_)->as_pfa()->as_nfa->as_dfa();
foreach (@_)
- { if ($FA->is_valid($_)) {
+ { if ($FA->is_valid_string($_)) {
print "(+): $_\n";
} else {
print "(-): $_\n";
@@ -194,7 +194,7 @@
if ($. == 1) { #<-- uses first line as regex!
$FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa->as_dfa();
} else {
- if ($FA->is_valid($_)) {
+ if ($FA->is_valid_string($_)) {
print "(+): $_\n";
} else {
print "(-): $_\n";
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-02-19 14:59:39
|
Revision: 99
http://svn.sourceforge.net/perl-flat/?rev=99&view=rev
Author: estrabd
Date: 2007-02-19 06:59:39 -0800 (Mon, 19 Feb 2007)
Log Message:
-----------
setting the stage for regex pump
Modified Paths:
--------------
trunk/perl-flat/lib/FLAT/NFA.pm
Modified: trunk/perl-flat/lib/FLAT/NFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/NFA.pm 2007-02-18 01:05:37 UTC (rev 98)
+++ trunk/perl-flat/lib/FLAT/NFA.pm 2007-02-19 14:59:39 UTC (rev 99)
@@ -316,6 +316,17 @@
######## transformations
+# returns a tree stucture resulting from a dft of the FA;
+sub as_depth_first_tree {
+ my $search =
+ sub {
+ # anonymous sub called by $search->(..)
+ };
+
+
+}
+
+# subset construction
sub as_dfa {
my $self = shift;
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-02-18 01:05:37
|
Revision: 98
http://svn.sourceforge.net/perl-flat/?rev=98&view=rev
Author: estrabd
Date: 2007-02-17 17:05:37 -0800 (Sat, 17 Feb 2007)
Log Message:
-----------
supports test command!
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/bdetest.pl
trunk/perl-flat/lib/FLAT/DFA.pm
trunk/perl-flat/lib/FLAT.pm
Modified: trunk/perl-flat/dev-scripts/bdetest.pl
===================================================================
--- trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-17 19:28:55 UTC (rev 97)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-18 01:05:37 UTC (rev 98)
@@ -7,4 +7,9 @@
use FLAT::PFA;
use FLAT::Regex::WithExtraOps;
-print FLAT::Regex->new($ARGV[0])->as_nfa->as_dfa->as_min_dfa->trim_sinks->as_undirected;
+my $dfa = FLAT::Regex->new($ARGV[0])->as_nfa->as_dfa;
+if ($dfa->is_valid($ARGV[1])) {
+ print "valid"
+} else {
+ print "not valid"
+}
Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-17 19:28:55 UTC (rev 97)
+++ trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-18 01:05:37 UTC (rev 98)
@@ -157,6 +157,29 @@
}
+# creates table used by a FLAT::DFA::Validator object to assess
+# the validity of a given string
+
+sub is_valid {
+ my $self = shift;
+ my $string = shift;
+ chomp $string;
+ my $OK = undef;
+ my @stack = split('',$string);
+ # this is confusing all funcs return arrays
+ my @current = $self->get_starting();
+ my $current = pop @current;
+ foreach (@stack) {
+ my @next = $self->successors($current,$_);
+ if (!@next) {
+ return $OK; #<--returns undef bc no transition found
+ }
+ $current = $next[0];
+ }
+ $OK++ if ($self->is_accepting($current));
+ return $OK;
+}
+
1;
__END__
Modified: trunk/perl-flat/lib/FLAT.pm
===================================================================
--- trunk/perl-flat/lib/FLAT.pm 2007-02-17 19:28:55 UTC (rev 97)
+++ trunk/perl-flat/lib/FLAT.pm 2007-02-18 01:05:37 UTC (rev 98)
@@ -75,6 +75,7 @@
pfa2undirected
random_pre
random_re
+ test
help
);
@@ -110,19 +111,20 @@
COMMANDS:
%perl -MFLAT -e
- "compare 're1','re2'" # comares 2 regexs | see note [2]
- "dump 're1'" # dumps parse trees | see note[1]
- "dfa2gv 're1'" # dumps graphviz graph desc | see note[1]
- "nfa2gv 're1'" # dumps graphviz graph desc | see note[1]
- "pfa2gv 're1'" # dumps graphviz graph desc | see note[1]
- dfa2digraph # dumps directed graph without transitions
- nfa2digraph # dumps directed graph without transitions
- pfa2digraph # dumps directed graph without transitions
- dfa2undirected # dumps undirected graph without transitions
- nfa2undirected # dumps undirected graph without transitions
- pfa2undirected # dumps undirected graph without transitions
+ "compare 're1','re2'" # comares 2 regexs | see note [2]
+ "dump 're1'" # dumps parse trees | see note[1]
+ "dfa2gv 're1'" # dumps graphviz graph desc | see note[1]
+ "nfa2gv 're1'" # dumps graphviz graph desc | see note[1]
+ "pfa2gv 're1'" # dumps graphviz graph desc | see note[1]
+ dfa2digraph # dumps directed graph without transitions
+ nfa2digraph # dumps directed graph without transitions
+ pfa2digraph # dumps directed graph without transitions
+ dfa2undirected # dumps undirected graph without transitions
+ nfa2undirected # dumps undirected graph without transitions
+ pfa2undirected # dumps undirected graph without transitions
random_pre
random_re
+ "test 'regex' 'string1'" # give a regex, reports if subsequent strings are valid
help
NOTES:
@@ -166,6 +168,42 @@
END
}
+# dumps directed graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "pfa2directed('a&b&c&d*e*')"
+sub test {
+ shift;
+ use FLAT::Regex::WithExtraOps;
+ use FLAT::PFA;
+ use FLAT::NFA;
+ use FLAT::DFA;
+ # handles multiple strings; first is considered the regex
+ if (@_)
+ { my $FA = FLAT::Regex::WithExtraOps->new(shift @_)->as_pfa()->as_nfa->as_dfa();
+ foreach (@_)
+ { if ($FA->is_valid($_)) {
+ print "(+): $_\n";
+ } else {
+ print "(-): $_\n";
+ }
+ }
+ } else {
+ my $FA;
+ while (<STDIN>) {
+ chomp;
+ if ($. == 1) { #<-- uses first line as regex!
+ $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa->as_dfa();
+ } else {
+ if ($FA->is_valid($_)) {
+ print "(+): $_\n";
+ } else {
+ print "(-): $_\n";
+ }
+ }
+ }
+ }
+}
+
# dumps parse tree
# Usage:
# perl -MFLAT -e "dump('re1','re2',...,'reN')"
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-02-17 19:28:55
|
Revision: 97
http://svn.sourceforge.net/perl-flat/?rev=97&view=rev
Author: estrabd
Date: 2007-02-17 11:28:55 -0800 (Sat, 17 Feb 2007)
Log Message:
-----------
got as_undirected to work by avoiding the unset_start thing and it now looks like it works fine
Modified Paths:
--------------
trunk/perl-flat/lib/FLAT/DFA.pm
trunk/perl-flat/lib/FLAT/NFA.pm
trunk/perl-flat/lib/FLAT.pm
Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-17 00:20:43 UTC (rev 96)
+++ trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-17 19:28:55 UTC (rev 97)
@@ -72,13 +72,13 @@
# this is meant to enforce 1 starting state for a DFA, but it is getting us into trouble
# when a DFA object calls unset_starting
-#sub unset_starting {
-# my $self = shift;
-# $self->SUPER::unset_starting(@_);
-# my $num = () = $self->unset_starting;
-# croak "DFA must have exactly one starting state"
-# if $num != 1;
-#}
+sub unset_starting {
+ my $self = shift;
+ $self->SUPER::unset_starting(@_);
+ my $num = () = $self->unset_starting;
+ croak "DFA must have exactly one starting state"
+ if $num != 1;
+}
sub trim_sinks {
my $self = shift;
Modified: trunk/perl-flat/lib/FLAT/NFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/NFA.pm 2007-02-17 00:20:43 UTC (rev 96)
+++ trunk/perl-flat/lib/FLAT/NFA.pm 2007-02-17 19:28:55 UTC (rev 97)
@@ -211,46 +211,49 @@
# This format is just a undirected graph - so transition and state info is lost
sub as_undirected {
-# return "This function is not implemented yet because of weird problem...";
my $self = shift;
my @symbols = $self->alphabet();
my @states = $self->get_states();
- my @lines = ();
+ my %edges = ();
foreach (@states) {
my $s = $_;
- my @conns = ();
foreach (@symbols) {
my $a = $_;
# foreach state, get all nodes connected to it; ignore symbols and
# treat transitions simply as directed
- push(@conns,$self->successors($s,$a));
- push(@conns,$self->predecessors($s,$a)); #<-- something terribly wrong is going on here
+ push(@{$edges{$s}},$self->successors($s,$a));
+ foreach ($self->successors($s,$a)) {
+ push(@{$edges{$_}},$s);
+ }
}
- @conns = $self->array_unique(@conns);
- push(@lines,sprintf("%s (%s) %s",$s,($#conns+1),join(' ',@conns)));
}
- return sprintf("%s\n%s",($#states+1),join("\n",@lines));
-}
+ my @lines = (($#states+1));
+ foreach (sort{$a <=> $b;}(keys(%edges))) { #<-- iterate over numerically sorted list of keys
+ @{$edges{$_}} = sort {$a <=> $b;} $self->array_unique(@{$edges{$_}}); #<- make items unique and sort numerically
+ push(@lines,sprintf("%s (%s) %s",$_,($#{$edges{$_}}+1),join(' ',@{$edges{$_}})));
+ }
+ return join("\n",@lines);
+ }
# Format that Dr. Sukhamay KUNDU likes to use in his assignments :)
# This format is just a directed graph - so transition and state info is lost
-sub as_directed {
+sub as_digraph {
my $self = shift;
my @symbols = $self->alphabet();
my @states = $self->get_states();
my @lines = ();
foreach (@states) {
my $s = $_;
- my @conns = ();
+ my @edges = ();
foreach (@symbols) {
my $a = $_;
# foreach state, get all nodes connected to it; ignore symbols and
# treat transitions simply as directed
- push(@conns,$self->successors($s,$a));
+ push(@edges,$self->successors($s,$a));
}
- @conns = $self->array_unique(@conns);
- push(@lines,sprintf("%s (%s) %s",$s,($#conns+1),join(' ',@conns)));
+ @edges = sort {$a <=> $b;} $self->array_unique(@edges); #<- make items unique and sort numerically
+ push(@lines,sprintf("%s (%s) %s",$s,($#edges+1),join(' ',@edges)));
}
return sprintf("%s\n%s",($#states+1),join("\n",@lines));
}
Modified: trunk/perl-flat/lib/FLAT.pm
===================================================================
--- trunk/perl-flat/lib/FLAT.pm 2007-02-17 00:20:43 UTC (rev 96)
+++ trunk/perl-flat/lib/FLAT.pm 2007-02-17 19:28:55 UTC (rev 97)
@@ -67,9 +67,9 @@
dfa2gv
nfa2gv
pfa2gv
- dfa2directed
- nfa2directed
- pfa2directed
+ dfa2digraph
+ nfa2digraph
+ pfa2digraph
dfa2undirected
nfa2undirected
pfa2undirected
@@ -115,12 +115,12 @@
"dfa2gv 're1'" # dumps graphviz graph desc | see note[1]
"nfa2gv 're1'" # dumps graphviz graph desc | see note[1]
"pfa2gv 're1'" # dumps graphviz graph desc | see note[1]
- dfa2directed # dumps directed graph without transitions
- nfa2directed # dumps directed graph without transitions
- pfa2directed # dumps directed graph without transitions
- dfa2undirected #broken # dumps undirected graph without transitions
- nfa2undirected #broken # dumps undirected graph without transitions
- pfa2undirected #broken # dumps undirected graph without transitions
+ dfa2digraph # dumps directed graph without transitions
+ nfa2digraph # dumps directed graph without transitions
+ pfa2digraph # dumps directed graph without transitions
+ dfa2undirected # dumps undirected graph without transitions
+ nfa2undirected # dumps undirected graph without transitions
+ pfa2undirected # dumps undirected graph without transitions
random_pre
random_re
help
@@ -250,7 +250,7 @@
# dumps directed graph using Kundu notation
# Usage:
# perl -MFLAT -e "dfa2directed('a&b&c&d*e*')"
-sub dfa2directed {
+sub dfa2digraph {
shift;
use FLAT::Regex::WithExtraOps;
use FLAT::DFA;
@@ -260,12 +260,12 @@
if (@_)
{ foreach (@_)
{ my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks();
- print $FA->as_directed;} }
+ print $FA->as_digraph;} }
else
{ while (<STDIN>)
{ chomp;
my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks();
- print $FA->as_directed;}
+ print $FA->as_digraph;}
}
print "\n";
}
@@ -273,7 +273,7 @@
# dumps directed graph using Kundu notation
# Usage:
# perl -MFLAT -e "nfa2directed('a&b&c&d*e*')"
-sub nfa2directed {
+sub nfa2digraph {
shift;
use FLAT::Regex::WithExtraOps;
use FLAT::DFA;
@@ -282,12 +282,12 @@
if (@_)
{ foreach (@_)
{ my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
- print $FA->as_directed;} }
+ print $FA->as_digraph;} }
else
{ while (<STDIN>)
{ chomp;
my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
- print $FA->as_directed;}
+ print $FA->as_digraph;}
}
print "\n";
}
@@ -295,19 +295,19 @@
# dumps directed graph using Kundu notation
# Usage:
# perl -MFLAT -e "pfa2directed('a&b&c&d*e*')"
-sub pfa2directed {
+sub pfa2digraph {
shift;
use FLAT::Regex::WithExtraOps;
use FLAT::PFA;
if (@_)
{ foreach (@_)
{ my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
- print $FA->as_directed;} }
+ print $FA->as_digraph;} }
else
{ while (<STDIN>)
{ chomp;
my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
- print $FA->as_directed;}
+ print $FA->as_digraph;}
}
print "\n";
}
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-02-17 00:20:43
|
Revision: 96
http://svn.sourceforge.net/perl-flat/?rev=96&view=rev
Author: estrabd
Date: 2007-02-16 16:20:43 -0800 (Fri, 16 Feb 2007)
Log Message:
-----------
fixed issue; had to comment out DFA::unset_starting bc it caused a self reference issue; did some had verifications for directed and undirected - probably need to do more testing, though
Modified Paths:
--------------
trunk/perl-flat/bin/util-put.pl
trunk/perl-flat/dev-scripts/bdetest.pl
trunk/perl-flat/lib/FLAT/DFA.pm
trunk/perl-flat/lib/FLAT/FA.pm
trunk/perl-flat/lib/FLAT/NFA.pm
trunk/perl-flat/lib/FLAT.pm
trunk/perl-flat/t/03-pregex-pfa.t
Modified: trunk/perl-flat/bin/util-put.pl
===================================================================
--- trunk/perl-flat/bin/util-put.pl 2007-02-16 22:06:13 UTC (rev 95)
+++ trunk/perl-flat/bin/util-put.pl 2007-02-17 00:20:43 UTC (rev 96)
@@ -5,14 +5,14 @@
use Config;
use File::Copy;
-# copys bin/f@sh to system bin directory and ensures its is 755
+# copys bin/fash to system bin directory and ensures its is 755
if (-w $Config{installbin})
- { print "Installing f\@sh utility in $Config{installbin}\n";
+ { print "Installing fash utility in $Config{installbin}\n";
copy('bin/fash',"$Config{installbin}/fash") || die $!;
chmod 0755,"$Config{installbin}/fash";}
else
{ print "You do not have permission to write to $Config{installbin}\n";
- print "Warn: bin/f\@sh not installed to $Config{installbin}\n";}
+ print "Warn: bin/fash not installed to $Config{installbin}\n";}
1;
Modified: trunk/perl-flat/dev-scripts/bdetest.pl
===================================================================
--- trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-16 22:06:13 UTC (rev 95)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-17 00:20:43 UTC (rev 96)
@@ -2,6 +2,9 @@
use strict;
use lib qw(../lib);
+use FLAT::DFA;
+use FLAT::NFA;
+use FLAT::PFA;
use FLAT::Regex::WithExtraOps;
-print FLAT::Regex->new($ARGV[0])->as_nfa->as_dfa->as_min_dfa->trim_sinks->as_undirected;
+print FLAT::Regex->new($ARGV[0])->as_nfa->as_dfa->as_min_dfa->trim_sinks->as_undirected;
Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-16 22:06:13 UTC (rev 95)
+++ trunk/perl-flat/lib/FLAT/DFA.pm 2007-02-17 00:20:43 UTC (rev 96)
@@ -70,14 +70,15 @@
return $return;
}
-sub unset_starting {
- my $self = shift;
- $self->SUPER::unset_starting(@_);
-
- my $num = () = $self->unset_starting;
- croak "DFA must have exactly one starting state"
- if $num != 1;
-}
+# this is meant to enforce 1 starting state for a DFA, but it is getting us into trouble
+# when a DFA object calls unset_starting
+#sub unset_starting {
+# my $self = shift;
+# $self->SUPER::unset_starting(@_);
+# my $num = () = $self->unset_starting;
+# croak "DFA must have exactly one starting state"
+# if $num != 1;
+#}
sub trim_sinks {
my $self = shift;
Modified: trunk/perl-flat/lib/FLAT/FA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/FA.pm 2007-02-16 22:06:13 UTC (rev 95)
+++ trunk/perl-flat/lib/FLAT/FA.pm 2007-02-17 00:20:43 UTC (rev 96)
@@ -206,8 +206,7 @@
sub predecessors {
my $self = shift;
- #$self->clone->reverse->successors(@_);
- $self->clone->successors(@_);
+ $self->clone->reverse->successors(@_);
}
# reverse - no change from NFA
Modified: trunk/perl-flat/lib/FLAT/NFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/NFA.pm 2007-02-16 22:06:13 UTC (rev 95)
+++ trunk/perl-flat/lib/FLAT/NFA.pm 2007-02-17 00:20:43 UTC (rev 96)
@@ -211,25 +211,25 @@
# This format is just a undirected graph - so transition and state info is lost
sub as_undirected {
- return "This function is not implemented yet because of weird problem...";
-# my $self = shift;
-# my @symbols = $self->alphabet();
-# my @states = $self->get_states();
-# my @lines = ();
-# foreach (@states) {
-# my $s = $_;
-# my @conns = ();
-# foreach (@symbols) {
-# my $a = $_;
-# # foreach state, get all nodes connected to it; ignore symbols and
-# # treat transitions simply as directed
-# push(@conns,$self->successors($s,$a));
-# push(@conns,$self->predecessors($s,$a)); #<-- something terribly wrong is going on here
-# }
-# @conns = $self->array_unique(@conns);
-# push(@lines,sprintf("%s (%s) %s",$s,($#conns+1),join(' ',@conns)));
-# }
-# return sprintf("%s\n%s",($#states+1),join("\n",@lines));
+# return "This function is not implemented yet because of weird problem...";
+ my $self = shift;
+ my @symbols = $self->alphabet();
+ my @states = $self->get_states();
+ my @lines = ();
+ foreach (@states) {
+ my $s = $_;
+ my @conns = ();
+ foreach (@symbols) {
+ my $a = $_;
+ # foreach state, get all nodes connected to it; ignore symbols and
+ # treat transitions simply as directed
+ push(@conns,$self->successors($s,$a));
+ push(@conns,$self->predecessors($s,$a)); #<-- something terribly wrong is going on here
+ }
+ @conns = $self->array_unique(@conns);
+ push(@lines,sprintf("%s (%s) %s",$s,($#conns+1),join(' ',@conns)));
+ }
+ return sprintf("%s\n%s",($#states+1),join("\n",@lines));
}
# Format that Dr. Sukhamay KUNDU likes to use in his assignments :)
Modified: trunk/perl-flat/lib/FLAT.pm
===================================================================
--- trunk/perl-flat/lib/FLAT.pm 2007-02-16 22:06:13 UTC (rev 95)
+++ trunk/perl-flat/lib/FLAT.pm 2007-02-17 00:20:43 UTC (rev 96)
@@ -70,6 +70,9 @@
dfa2directed
nfa2directed
pfa2directed
+ dfa2undirected
+ nfa2undirected
+ pfa2undirected
random_pre
random_re
help
@@ -194,12 +197,12 @@
use FLAT::PFA;
if (@_)
{ foreach (@_)
- { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa();
+ { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa()->as_min_dfa()->trim_sinks();
print $FA->as_graphviz;} }
else
{ while (<STDIN>)
{ chomp;
- my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa();
+ my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa()->trim_sinks();
print $FA->as_graphviz;}
}
}
Modified: trunk/perl-flat/t/03-pregex-pfa.t
===================================================================
--- trunk/perl-flat/t/03-pregex-pfa.t 2007-02-16 22:06:13 UTC (rev 95)
+++ trunk/perl-flat/t/03-pregex-pfa.t 2007-02-17 00:20:43 UTC (rev 96)
@@ -22,6 +22,7 @@
is( ($DFA1->equals($DFA2)), 1 );
# w&w*
+diag("");
diag("w&v*..");
# w&v*
$PFA1 = FLAT::Regex::WithExtraOps->new('abc&(def)*')->as_pfa();
@@ -31,6 +32,8 @@
d((efd)*&(abc))ef
)')->as_pfa();
+__END__ #<-- uncomment for more intensive and time consuming tests
+
$DFA1 = $PFA1->as_nfa->as_min_dfa;
$DFA2 = $PFA2->as_nfa->as_min_dfa;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
