Menu
▾
▴
perl-flat-cvs-notify
|
From: notifies s. of c. c. <per...@li...> - 2006-09-12 14:37:16
|
Revision: 70
http://svn.sourceforge.net/perl-flat/?rev=70&view=rev
Author: estrabd
Date: 2006-09-12 07:37:09 -0700 (Tue, 12 Sep 2006)
Log Message:
-----------
...
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/pregex-to-pfa.pl
trunk/perl-flat/lib/FLAT/PFA.pm
Modified: trunk/perl-flat/dev-scripts/pregex-to-pfa.pl
===================================================================
--- trunk/perl-flat/dev-scripts/pregex-to-pfa.pl 2006-08-08 03:36:18 UTC (rev 69)
+++ trunk/perl-flat/dev-scripts/pregex-to-pfa.pl 2006-09-12 14:37:09 UTC (rev 70)
@@ -12,13 +12,16 @@
my $PFA = $PRE->as_pfa();
-my $dot = $PFA->as_graphviz;
+my $graphviz = $PFA->as_graphviz;
my $summary = $PFA->as_summary;
print "$summary\n";
-open my $fh, "|-", "dot -Tpng -o output.png"
- or die "Couldn't run dot: $!\n";
+open my $fh, "|-", "circo -Tpng -o output.png"
+ or die "Couldn't run graphviz: $!\n";
-print $fh $dot;
+print $fh $graphviz;
close $fh;
+
+my $NFA = $PFA->as_nfa();
+print Dumper($NFA);
Modified: trunk/perl-flat/lib/FLAT/PFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/PFA.pm 2006-08-08 03:36:18 UTC (rev 69)
+++ trunk/perl-flat/lib/FLAT/PFA.pm 2006-09-12 14:37:09 UTC (rev 70)
@@ -167,15 +167,25 @@
1;
-# stretching my legs after a few months being gone..
+# stretching my legs after a few months being gone ... see if the legacy conversion
+# can be modified to work
sub as_nfa {
my $self = shift;
-
- my $result = FLAT::DFA->new;
- my %subset;
-
- $result;
+ my @Dstates = $self->get_states();
+ my %Dtran =(); # hash of serialized state names that have been searched
+ # New NFA object reference
+ my $result = FLAT::NFA->new();
+
+ print Dumper(@Dstates);
+
+# while (@Dstates) {
+# foreach ($self->alphabet()) {
+
+# }
+# }
+
+ return $result;
}
__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...> - 2006-09-26 13:23:04
|
Revision: 71
http://svn.sourceforge.net/perl-flat/?rev=71&view=rev
Author: estrabd
Date: 2006-09-26 06:22:54 -0700 (Tue, 26 Sep 2006)
Log Message:
-----------
added some psuedo code to PFA.pm for the PFA->NFA conversion; updated TODO
Modified Paths:
--------------
trunk/perl-flat/TODO
trunk/perl-flat/dev-scripts/pregex-to-pfa.pl
trunk/perl-flat/lib/FLAT/PFA.pm
Modified: trunk/perl-flat/TODO
===================================================================
--- trunk/perl-flat/TODO 2006-09-12 14:37:09 UTC (rev 70)
+++ trunk/perl-flat/TODO 2006-09-26 13:22:54 UTC (rev 71)
@@ -7,3 +7,7 @@
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
+
+
Modified: trunk/perl-flat/dev-scripts/pregex-to-pfa.pl
===================================================================
--- trunk/perl-flat/dev-scripts/pregex-to-pfa.pl 2006-09-12 14:37:09 UTC (rev 70)
+++ trunk/perl-flat/dev-scripts/pregex-to-pfa.pl 2006-09-26 13:22:54 UTC (rev 71)
@@ -3,7 +3,6 @@
use lib qw(../lib);
use FLAT::Regex::WithExtraOps;
-use Data::Dumper;
use FLAT::PFA;
# This is mainly my test script for FLAT::FA::PFA.pm
@@ -24,4 +23,3 @@
close $fh;
my $NFA = $PFA->as_nfa();
-print Dumper($NFA);
Modified: trunk/perl-flat/lib/FLAT/PFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/PFA.pm 2006-09-12 14:37:09 UTC (rev 70)
+++ trunk/perl-flat/lib/FLAT/PFA.pm 2006-09-26 13:22:54 UTC (rev 71)
@@ -61,7 +61,7 @@
}
# will implement the joining of two PFAs with lambda transitions
-# need to fix
+# need to fix <-- still broken? need to check!!
sub shuffle {
my @pfas = map { $_->as_pfa } @_;
my $result = $pfas[0]->clone;
@@ -170,6 +170,33 @@
# stretching my legs after a few months being gone ... see if the legacy conversion
# can be modified to work
+# See FLAT::Legacy::PFA for the initialization stuff - I am sure it can be refined a lot!
+# PSUEDO CODE
+# my @Dstates = get_starting();
+# while (@Dstates)
+# { my @T = @{pop (@Dstates)}; !!remember that states are made up of 1 or more nodes
+# my $current = $self->serialize_name(@T)
+# add $current (or @T) to @DONE stack
+# foreach my $symbol ($self->alphabet)
+# { if ($symbol eq $LAMBDA)
+# { foreach my $L ($self->get_tied_from($current))
+# { foreach my $U ($self->move($L,$LAMBDA) push(@N,unique($U)); }
+# }
+# else
+# { foreach my $t (@T)
+# { foreach my $U ($self->move($U,$symbol))
+# { push(@N,$self->complement(@T,$t)) };
+# }
+# }
+# Ndtran [N,$symbol] := N !!add new transition
+# if N unmarked, add N to Dstates
+# }
+# }
+
+#1. make sure psuedo code is correct
+#2. implement it, including any require initializations
+#3. refine, refactor
+
sub as_nfa {
my $self = shift;
my @Dstates = $self->get_states();
@@ -177,14 +204,6 @@
# New NFA object reference
my $result = FLAT::NFA->new();
- print Dumper(@Dstates);
-
-# while (@Dstates) {
-# foreach ($self->alphabet()) {
-
-# }
-# }
-
return $result;
}
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...> - 2006-10-07 12:52:11
|
Revision: 82
http://svn.sourceforge.net/perl-flat/?rev=82&view=rev
Author: estrabd
Date: 2006-10-07 05:52:05 -0700 (Sat, 07 Oct 2006)
Log Message:
-----------
just in case I missed something
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/pre_compare.pl
trunk/perl-flat/dev-scripts/pregex-to-pfa.pl
trunk/perl-flat/t/03-pregex-pfa.t
Modified: trunk/perl-flat/dev-scripts/pre_compare.pl
===================================================================
--- trunk/perl-flat/dev-scripts/pre_compare.pl 2006-10-03 22:40:35 UTC (rev 81)
+++ trunk/perl-flat/dev-scripts/pre_compare.pl 2006-10-07 12:52:05 UTC (rev 82)
@@ -14,7 +14,11 @@
my $DFA1 = $PFA1->as_nfa->as_min_dfa;
my $DFA2 = $PFA2->as_nfa->as_min_dfa;
-print "Match!" if ($DFA1->equals($DFA2));
+if ($DFA1->equals($DFA2)) {
+ print "MATCH!";
+} else {
+ print "No Match";
+}
__END__
open(GDL,">pfa.gdl");
Modified: trunk/perl-flat/dev-scripts/pregex-to-pfa.pl
===================================================================
--- trunk/perl-flat/dev-scripts/pregex-to-pfa.pl 2006-10-03 22:40:35 UTC (rev 81)
+++ trunk/perl-flat/dev-scripts/pregex-to-pfa.pl 2006-10-07 12:52:05 UTC (rev 82)
@@ -30,7 +30,7 @@
print GDL $DFA->as_min_dfa->trim_sinks->as_gdl,"\n";
close(GDL);
-my $dot = $DFA->as_min_dfa->as_graphviz;
+my $dot = $DFA->as_min_dfa->trim_sinks->as_graphviz;
open my $fh, "|-", "circo -Tpng -o output.png"
or die "Couldn't run dot: $!\n";
Modified: trunk/perl-flat/t/03-pregex-pfa.t
===================================================================
--- trunk/perl-flat/t/03-pregex-pfa.t 2006-10-03 22:40:35 UTC (rev 81)
+++ trunk/perl-flat/t/03-pregex-pfa.t 2006-10-07 12:52:05 UTC (rev 82)
@@ -1,4 +1,4 @@
-use Test::More tests => 3;
+use Test::More tests => 2;
use FLAT;
use FLAT::NFA;
use FLAT::PFA;
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-14 06:37:24
|
Revision: 87
http://svn.sourceforge.net/perl-flat/?rev=87&view=rev
Author: estrabd
Date: 2007-02-13 22:37:25 -0800 (Tue, 13 Feb 2007)
Log Message:
-----------
added preliminary support for one liners such as: perl -MFLAT "pfa2dot('a&b&c') | dot -Tpng > test.png"
Modified Paths:
--------------
trunk/perl-flat/MANIFEST
trunk/perl-flat/lib/FLAT.pm
trunk/perl-flat/t/03-pregex-pfa.t
Added Paths:
-----------
trunk/perl-flat/lib/FLAT/Regex/Transform/
trunk/perl-flat/t/04-transform.t
Modified: trunk/perl-flat/MANIFEST
===================================================================
--- trunk/perl-flat/MANIFEST 2007-02-13 15:20:36 UTC (rev 86)
+++ trunk/perl-flat/MANIFEST 2007-02-14 06:37:25 UTC (rev 87)
@@ -1,9 +1,13 @@
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
Modified: trunk/perl-flat/lib/FLAT.pm
===================================================================
--- trunk/perl-flat/lib/FLAT.pm 2007-02-13 15:20:36 UTC (rev 86)
+++ trunk/perl-flat/lib/FLAT.pm 2007-02-14 06:37:25 UTC (rev 87)
@@ -58,6 +58,214 @@
}
}
+# Support for perl one liners - like what CPAN.pm uses
+use Exporter ();
+@ISA = 'Exporter';
+use vars qw(@EXPORT $AUTOLOAD);
+
+@EXPORT = qw(compare
+ dump
+ dfa2dot
+ nfa2dot
+ pfa2dot
+ random_pre
+ random_re
+ );
+
+# Todo: validate, test (string against re), validate (re),
+# alternate (give re, list some alternates), getstrings (gen strings give re)
+
+sub AUTOLOAD {
+ my($l) = $AUTOLOAD;
+ $l =~ s/.*:://;
+ my(%EXPORT);
+ @EXPORT{@EXPORT} = '';
+ if (exists $EXPORT{$l}){
+ FLAT::OneLiners->$l(@_);
+ }
+}
+
+package FLAT::OneLiners;
+
+# dumps parse tree
+# Usage:
+# perl -MFLAT -e "dump('a&b&c&d*e*')"
+sub dump {
+ shift;
+ use FLAT::Regex::WithExtraOps;
+ use Data::Dumper;
+ my $PRE = FLAT::Regex::WithExtraOps->new(shift);
+ print Dumper($PRE);
+}
+
+# dumps graphviz notation
+# Usage:
+# perl -MFLAT -e "dfa2dot('a&b&c&d*e*')"
+sub dfa2dot {
+ shift;
+ use FLAT::Regex::WithExtraOps;
+ use FLAT::DFA;
+ my $DFA1 = FLAT::Regex::WithExtraOps->new(shift)->as_nfa()->as_dfa->as_min_dfa();
+ print $DFA1->as_graphviz;
+}
+
+# dumps graphviz notation
+# Usage:
+# perl -MFLAT -e "nfa2dot('a&b&c&d*e*')"
+sub nfa2dot {
+ shift;
+ use FLAT::Regex::WithExtraOps;
+ use FLAT::NFA;
+ my $NFA1 = FLAT::Regex::WithExtraOps->new(shift)->as_nfa();
+ print $NFA1->as_graphviz;
+}
+
+# dumps graphviz notation
+# Usage:
+# perl -MFLAT -e "pfa2dot('a&b&c&d*e*')"
+sub pfa2dot {
+ shift;
+ use FLAT::Regex::WithExtraOps;
+ use FLAT::PFA;
+ my $PFA1 = FLAT::Regex::WithExtraOps->new(shift)->as_pfa();
+ print $PFA1->as_graphviz;
+}
+
+# compares 2 give PREs
+# Usage:
+# perl -MFLAT -e "compare('a','a&b&c&d*e*')" #<-- no match, btw
+sub compare {
+ shift;
+ use FLAT::Regex::WithExtraOps;
+ use FLAT::DFA;
+ use FLAT::PFA;
+ my $PFA1 = FLAT::Regex::WithExtraOps->new(shift)->as_pfa();
+ my $PFA2 = FLAT::Regex::WithExtraOps->new(shift)->as_pfa();
+ my $DFA1 = $PFA1->as_nfa->as_min_dfa;
+ my $DFA2 = $PFA2->as_nfa->as_min_dfa;
+ if ($DFA1->equals($DFA2)) {
+ print "Yes\n";
+ } else {
+ print "No\n";
+ }
+}
+
+# prints random PRE
+# Usage:
+# perl -MFLAT -e random_pre
+sub random_pre {
+ shift;
+ # skirt around deep recursion warning annoyance
+ local $SIG{__WARN__} = sub { $_[0] =~ /^Deep recursion/ or warn $_[0] };
+ srand $$;
+ my %CMDLINEOPTS = ();
+ # Percent chance of each operator occuring
+ $CMDLINEOPTS{LENGTH} = 32;
+ $CMDLINEOPTS{AND} = 10;
+ $CMDLINEOPTS{OR} = 6;
+ $CMDLINEOPTS{STAR} = 10;
+ $CMDLINEOPTS{OPEN} = 5;
+ $CMDLINEOPTS{CLOSE} = 0;
+ $CMDLINEOPTS{n} = 1;
+
+ my $getRandomChar = sub {
+ my $ch = '';
+ # Get a random character between 0 and 127.
+ do {
+ $ch = int(rand 2);
+ } while ($ch !~ m/[a-zA-Z0-9]/);
+ return $ch;
+ };
+
+ my $getRandomRE = sub {
+ my $str = '';
+ my @closeparens = ();
+ for (1..$CMDLINEOPTS{LENGTH}) {
+ $str .= $getRandomChar->();
+ # % chance of an "or"
+ if (int(rand 100) < $CMDLINEOPTS{OR}) {
+ $str .= "|1";
+ } elsif (int(rand 100) < $CMDLINEOPTS{AND}) {
+ $str .= "&0";
+ } elsif (int(rand 100) < $CMDLINEOPTS{STAR}) {
+ $str .= "*1";
+ } elsif (int(rand 100) < $CMDLINEOPTS{OPEN}) {
+ $str .= "(";
+ push(@closeparens,'0101)');
+ } elsif (int(rand 100) < $CMDLINEOPTS{CLOSE} && @closeparens) {
+ $str .= pop(@closeparens);
+ }
+ }
+ # empty out @closeparens if there are still some left
+ if (@closeparens) {
+ $str .= join('',@closeparens);
+ }
+ return $str;
+ };
+
+ for (1..$CMDLINEOPTS{n}) {
+ print $getRandomRE->(),"\n";
+ }
+}
+
+# prints random RE (no & operator)
+# Usage:
+# perl -MFLAT -e random_re
+sub random_re {
+ shift;
+ # skirt around deep recursion warning annoyance
+ local $SIG{__WARN__} = sub { $_[0] =~ /^Deep recursion/ or warn $_[0] };
+ srand $$;
+ my %CMDLINEOPTS = ();
+ # Percent chance of each operator occuring
+ $CMDLINEOPTS{LENGTH} = 32;
+ $CMDLINEOPTS{AND} = 0; #<-- turns off & operator
+ $CMDLINEOPTS{OR} = 6;
+ $CMDLINEOPTS{STAR} = 10;
+ $CMDLINEOPTS{OPEN} = 5;
+ $CMDLINEOPTS{CLOSE} = 0;
+ $CMDLINEOPTS{n} = 1;
+
+ my $getRandomChar = sub {
+ my $ch = '';
+ # Get a random character between 0 and 127.
+ do {
+ $ch = int(rand 2);
+ } while ($ch !~ m/[a-zA-Z0-9]/);
+ return $ch;
+ };
+
+ my $getRandomRE = sub {
+ my $str = '';
+ my @closeparens = ();
+ for (1..$CMDLINEOPTS{LENGTH}) {
+ $str .= $getRandomChar->();
+ # % chance of an "or"
+ if (int(rand 100) < $CMDLINEOPTS{OR}) {
+ $str .= "|1";
+ } elsif (int(rand 100) < $CMDLINEOPTS{AND}) {
+ $str .= "&0";
+ } elsif (int(rand 100) < $CMDLINEOPTS{STAR}) {
+ $str .= "*1";
+ } elsif (int(rand 100) < $CMDLINEOPTS{OPEN}) {
+ $str .= "(";
+ push(@closeparens,'0101)');
+ } elsif (int(rand 100) < $CMDLINEOPTS{CLOSE} && @closeparens) {
+ $str .= pop(@closeparens);
+ }
+ }
+ # empty out @closeparens if there are still some left
+ if (@closeparens) {
+ $str .= join('',@closeparens);
+ }
+ return $str;
+ };
+
+ for (1..$CMDLINEOPTS{n}) {
+ print $getRandomRE->(),"\n";
+ }
+}
+
1;
__END__
Modified: trunk/perl-flat/t/03-pregex-pfa.t
===================================================================
--- trunk/perl-flat/t/03-pregex-pfa.t 2007-02-13 15:20:36 UTC (rev 86)
+++ trunk/perl-flat/t/03-pregex-pfa.t 2007-02-14 06:37:25 UTC (rev 87)
@@ -9,7 +9,7 @@
use FLAT::PFA;
use FLAT::Regex::WithExtraOps;
-diag("This test will take a while..");
+diag("This test might take a while..");
diag("w&v..");
# w&w
@@ -20,8 +20,14 @@
is( ($DFA1->equals($DFA2)), 1 );
+<<<<<<< .mine
+__END__ #<-- comment out if you wish to conduct the time consuming tests
+_
+# w&w*
+=======
diag("w&v*..");
# w&v*
+>>>>>>> .r86
$PFA1 = FLAT::Regex::WithExtraOps->new('abc&(def)*')->as_pfa();
$PFA2 = FLAT::Regex::WithExtraOps->new('(def)*(
a(bc&(def)*)+
Added: trunk/perl-flat/t/04-transform.t
===================================================================
--- trunk/perl-flat/t/04-transform.t (rev 0)
+++ trunk/perl-flat/t/04-transform.t 2007-02-14 06:37:25 UTC (rev 87)
@@ -0,0 +1,19 @@
+use Test::More 'no_plan';
+
+use strict;
+
+use lib qw(../lib);
+use FLAT;
+
+is (1,1);
+
+SKIP:
+{ eval{ require Math::Symbolic::Transform }
+ # will contain tests for FLAT::Regex::Transform if
+ # Math::Symbolic::Transform is installed, if not
+ # no worries - we don't want Math::Symbolic::Transform
+ # to become a pre-requisite for FLAT in general.
+ # -- Begin tests below -- #
+}
+
+__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-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.
|
|
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...> - 2006-09-26 23:27:10
|
Revision: 73
http://svn.sourceforge.net/perl-flat/?rev=73&view=rev
Author: estrabd
Date: 2006-09-26 16:27:06 -0700 (Tue, 26 Sep 2006)
Log Message:
-----------
..
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/regex-to-nfa.pl
trunk/perl-flat/lib/FLAT/PFA.pm
Modified: trunk/perl-flat/dev-scripts/regex-to-nfa.pl
===================================================================
--- trunk/perl-flat/dev-scripts/regex-to-nfa.pl 2006-09-26 23:17:12 UTC (rev 72)
+++ trunk/perl-flat/dev-scripts/regex-to-nfa.pl 2006-09-26 23:27:06 UTC (rev 73)
@@ -10,7 +10,7 @@
my $nfa = FLAT::Regex->new($regex)->as_nfa;
my $dot = $nfa->as_graphviz;
-my $summary = $nfa->as_summary;
+zmy $summary = $nfa->as_summary;
print "$summary\n";
Modified: trunk/perl-flat/lib/FLAT/PFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/PFA.pm 2006-09-26 23:17:12 UTC (rev 72)
+++ trunk/perl-flat/lib/FLAT/PFA.pm 2006-09-26 23:27:06 UTC (rev 73)
@@ -165,8 +165,6 @@
$self;
}
-1;
-
# stretching my legs after a few months being gone ... see if the legacy conversion
# can be modified to work
@@ -174,7 +172,8 @@
# PSUEDO CODE
# my @Dstates = get_starting();
# while (@Dstates)
-# { my @T = @{pop (@Dstates)}; !!remember that states are made up of 1 or more nodes
+# { my @T = @{pop (@Dstates)};
+# #remember that states are made up of 1 or more nodes
# my $current = $self->serialize_name(@T)
# add $current (or @T) to @DONE stack
# foreach my $symbol ($self->alphabet)
@@ -207,6 +206,8 @@
return $result;
}
+1;
+
__END__
=head1 NAME
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...> - 2006-09-27 03:38:22
|
Revision: 74
http://svn.sourceforge.net/perl-flat/?rev=74&view=rev
Author: estrabd
Date: 2006-09-26 20:38:17 -0700 (Tue, 26 Sep 2006)
Log Message:
-----------
added NFA->as_gdl, which outputs to the graph description language; sub routine basically identical to as_graphviz, but with different formatting
Modified Paths:
--------------
trunk/perl-flat/TODO
trunk/perl-flat/dev-scripts/pregex-to-pfa.pl
trunk/perl-flat/lib/FLAT/NFA.pm
trunk/perl-flat/lib/FLAT/PFA.pm
Modified: trunk/perl-flat/TODO
===================================================================
--- trunk/perl-flat/TODO 2006-09-26 23:27:06 UTC (rev 73)
+++ trunk/perl-flat/TODO 2006-09-27 03:38:17 UTC (rev 74)
@@ -10,4 +10,4 @@
input and output options and formats
-
+look at creating a 'drop in' regex/pregex parser using the custom recdesc one build for FLAT::Legacy
Modified: trunk/perl-flat/dev-scripts/pregex-to-pfa.pl
===================================================================
--- trunk/perl-flat/dev-scripts/pregex-to-pfa.pl 2006-09-26 23:27:06 UTC (rev 73)
+++ trunk/perl-flat/dev-scripts/pregex-to-pfa.pl 2006-09-27 03:38:17 UTC (rev 74)
@@ -11,10 +11,11 @@
my $PFA = $PRE->as_pfa();
+my $gdl = $PFA->as_gdl;
my $graphviz = $PFA->as_graphviz;
my $summary = $PFA->as_summary;
-print "$summary\n";
+print "$gdl\n";
open my $fh, "|-", "circo -Tpng -o output.png"
or die "Couldn't run graphviz: $!\n";
Modified: trunk/perl-flat/lib/FLAT/NFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/NFA.pm 2006-09-26 23:27:06 UTC (rev 73)
+++ trunk/perl-flat/lib/FLAT/NFA.pm 2006-09-27 03:38:17 UTC (rev 74)
@@ -222,8 +222,36 @@
$self->add_transition($trash, $trash, $self->alphabet);
}
-############
+############ Formatted output
+
+# Graph Description Language, aiSee, etc
+sub as_gdl {
+ my $self = shift;
+
+ my @states = map {
+ sprintf qq{node: { title:"%s" shape:circle borderstyle: %s}\n},
+ $_,
+ ($self->is_accepting($_) ? "double bordercolor: red" : "solid")
+ } $self->get_states;
+
+ my @trans;
+ for my $s1 ($self->get_states) {
+ for my $s2 ($self->get_states) {
+ my $t = $self->get_transition($s1, $s2);
+
+ if (defined $t) {
+ push @trans, sprintf qq[edge: { source: "%s" target: "%s" label: "%s" arrowstyle: line }\n],
+ $s1, $s2, $t->as_string;
+ }
+ }}
+
+ return sprintf "graph: {\ndisplay_edge_labels: yes\n\n%s\n%s}\n",
+ join("", @states),
+ join("", @trans);
+}
+
+# Graphviz: dot, etc
sub as_graphviz {
my $self = shift;
Modified: trunk/perl-flat/lib/FLAT/PFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/PFA.pm 2006-09-26 23:27:06 UTC (rev 73)
+++ trunk/perl-flat/lib/FLAT/PFA.pm 2006-09-27 03:38:17 UTC (rev 74)
@@ -193,8 +193,9 @@
# }
#1. make sure psuedo code is correct
-#2. implement it, including any require initializations
-#3. refine, refactor
+#2 translate using the current PFA data structure
+#3. implement it, including any require initializations
+#4. refine, refactor
sub as_nfa {
my $self = shift;
@@ -202,7 +203,7 @@
my %Dtran =(); # hash of serialized state names that have been searched
# New NFA object reference
my $result = FLAT::NFA->new();
-
+
return $result;
}
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...> - 2006-10-04 05:40:27
|
Revision: 79
http://svn.sourceforge.net/perl-flat/?rev=79&view=rev
Author: estrabd
Date: 2006-10-03 12:04:14 -0700 (Tue, 03 Oct 2006)
Log Message:
-----------
working on pre tests
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/pregex-stress.pl
trunk/perl-flat/dev-scripts/pregex-to-pfa.pl
trunk/perl-flat/lib/FLAT/DFA.pm
trunk/perl-flat/lib/FLAT/PFA.pm
Added Paths:
-----------
trunk/perl-flat/dev-scripts/pre_compare.pl
Added: trunk/perl-flat/dev-scripts/pre_compare.pl
===================================================================
--- trunk/perl-flat/dev-scripts/pre_compare.pl (rev 0)
+++ trunk/perl-flat/dev-scripts/pre_compare.pl 2006-10-03 19:04:14 UTC (rev 79)
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl -l
+use strict;
+
+use lib qw(../lib);
+use FLAT::Regex::WithExtraOps;
+use FLAT::PFA;
+use Data::Dumper;
+
+# This is mainly my test script for FLAT::FA::PFA.pm
+
+my $PFA1 = FLAT::Regex::WithExtraOps->new($ARGV[0])->as_pfa();
+my $PFA2 = FLAT::Regex::WithExtraOps->new($ARGV[1])->as_pfa();
+
+my $DFA1 = $PFA1->as_nfa->as_min_dfa;
+my $DFA2 = $PFA2->as_nfa->as_min_dfa;
+
+print "Match!" if ($DFA1->equals($DFA2));
+
+__END__
+open(GDL,">pfa.gdl");
+ print GDL $PFA->as_gdl,"\n";
+close(GDL);
+
+my $NFA = $PFA->as_nfa();
+
+open(GDL,">nfa.gdl");
+ print GDL $NFA->as_gdl,"\n";
+close(GDL);
+
+my $DFA = $NFA->as_dfa();
+
+open(GDL,">dfa.gdl");
+ print GDL $DFA->as_gdl,"\n";
+close(GDL);
+
+open(GDL,">mindfa.gdl");
+ print GDL $DFA->as_min_dfa->trim_sinks->as_gdl,"\n";
+close(GDL);
+
+my $dot = $DFA->as_min_dfa->as_graphviz;
+open my $fh, "|-", "circo -Tpng -o output.png"
+ or die "Couldn't run dot: $!\n";
+
+print $fh $dot;
+close $fh;
Modified: trunk/perl-flat/dev-scripts/pregex-stress.pl
===================================================================
--- trunk/perl-flat/dev-scripts/pregex-stress.pl 2006-10-03 13:41:20 UTC (rev 78)
+++ trunk/perl-flat/dev-scripts/pregex-stress.pl 2006-10-03 19:04:14 UTC (rev 79)
@@ -4,6 +4,7 @@
use lib qw(../lib);
use FLAT;
use FLAT::Regex::WithExtraOps;
+use FLAT::PFA;
use Data::Dumper;
use Getopt::Long; # used to process commandline options
$|++;
@@ -18,7 +19,6 @@
$CMDLINEOPTS{AND} = 10;
$CMDLINEOPTS{OR} = 6;
$CMDLINEOPTS{STAR} = 10;
-$CMDLINEOPTS{NEGATE} = 0;
$CMDLINEOPTS{OPEN} = 5;
$CMDLINEOPTS{CLOSE} = 0;
$CMDLINEOPTS{n} = 100;
@@ -49,16 +49,14 @@
$str .= getRandomChar();
# % chance of an "or"
if (int(rand 100) < $CMDLINEOPTS{OR}) {
- $str .= "|[]";
+ $str .= "|1";
} elsif (int(rand 100) < $CMDLINEOPTS{AND}) {
- $str .= "&[]";
+ $str .= "&0";
} elsif (int(rand 100) < $CMDLINEOPTS{STAR}) {
- $str .= "*";
- } elsif (int(rand 100) < $CMDLINEOPTS{NEGATE}) {
- $str .= "~".getRandomChar();
+ $str .= "*1";
} elsif (int(rand 100) < $CMDLINEOPTS{OPEN}) {
$str .= "(";
- push(@closeparens,'[])');
+ push(@closeparens,'0101)');
} elsif (int(rand 100) < $CMDLINEOPTS{CLOSE} && @closeparens) {
$str .= pop(@closeparens);
}
@@ -72,6 +70,7 @@
for (1..$CMDLINEOPTS{n}) {
my $str = getRandomRE();
- my $RE = FLAT::Regex::WithExtraOps->new($str);
- print "$str : ".$RE->as_string;
+ my $PRE = FLAT::Regex::WithExtraOps->new($str);
+ print $PRE->as_string;
+ my $minDFA = $PRE->as_pfa->as_nfa->as_min_dfa();
}
Modified: trunk/perl-flat/dev-scripts/pregex-to-pfa.pl
===================================================================
--- trunk/perl-flat/dev-scripts/pregex-to-pfa.pl 2006-10-03 13:41:20 UTC (rev 78)
+++ trunk/perl-flat/dev-scripts/pregex-to-pfa.pl 2006-10-03 19:04:14 UTC (rev 79)
@@ -29,3 +29,10 @@
open(GDL,">mindfa.gdl");
print GDL $DFA->as_min_dfa->trim_sinks->as_gdl,"\n";
close(GDL);
+
+my $dot = $DFA->as_min_dfa->as_graphviz;
+open my $fh, "|-", "circo -Tpng -o output.png"
+ or die "Couldn't run dot: $!\n";
+
+print $fh $dot;
+close $fh;
Modified: trunk/perl-flat/lib/FLAT/DFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/DFA.pm 2006-10-03 13:41:20 UTC (rev 78)
+++ trunk/perl-flat/lib/FLAT/DFA.pm 2006-10-03 19:04:14 UTC (rev 79)
@@ -52,7 +52,7 @@
my @next = map { $dfas[$_]->successors( $tuple[$_], $char ) }
0 .. $#dfas;
- warn "[@tuple] --> [@next] via $char\n";
+ #warn "[@tuple] --> [@next] via $char\n";
if (not exists $newstates{ _TUPLE_ID(@next) }) {
my $s = $newstates{ _TUPLE_ID(@next) } = $return->add_states(1);
Modified: trunk/perl-flat/lib/FLAT/PFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/PFA.pm 2006-10-03 13:41:20 UTC (rev 78)
+++ trunk/perl-flat/lib/FLAT/PFA.pm 2006-10-03 19:04:14 UTC (rev 79)
@@ -205,7 +205,6 @@
if (!exists($NEW{$currentid})) {$NEW{$currentid} = $result->add_states(1)};
if (!exists($NEW{$nextid})) {$NEW{$nextid} = $result->add_states(1) };
$result->add_transition($NEW{$currentid},$NEW{$nextid},'');
- print STDERR "$currentid ($NEW{$currentid}) on '$symbol' -> $nextid ($NEW{$nextid})";
}
}
} else {
@@ -221,7 +220,6 @@
if (!exists($NEW{$currentid})) {$NEW{$currentid} = $result->add_states(1)};
if (!exists($NEW{$nextid})) {$NEW{$nextid} = $result->add_states(1) };
$result->add_transition($NEW{$currentid},$NEW{$nextid},$symbol);
- print STDERR "$currentid ($NEW{$currentid}) on '$symbol' -> $nextid ($NEW{$nextid})";
}
}
}
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...> - 2006-12-14 01:54:48
|
Revision: 83
http://svn.sourceforge.net/perl-flat/?rev=83&view=rev
Author: estrabd
Date: 2006-12-13 17:54:44 -0800 (Wed, 13 Dec 2006)
Log Message:
-----------
added some tests
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/bdetest.pl
trunk/perl-flat/dev-scripts/pre_compare.pl
trunk/perl-flat/dev-scripts/test.sh
trunk/perl-flat/t/03-pregex-pfa.t
Modified: trunk/perl-flat/dev-scripts/bdetest.pl
===================================================================
--- trunk/perl-flat/dev-scripts/bdetest.pl 2006-10-07 12:52:05 UTC (rev 82)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2006-12-14 01:54:44 UTC (rev 83)
@@ -4,11 +4,26 @@
use lib qw(../lib);
use FLAT;
use FLAT::NFA;
-use FLAT::Regex;
+use FLAT::PFA;
+use FLAT::Regex::WithExtraOps;
use Data::Dumper;
# This is mainly my test script for FLAT::FA::PFA.pm
-my $DFA = FLAT::Regex->new('ab+ba')->as_nfa->as_min_dfa;
+#my $DFA = FLAT::Regex->new('ab+ba')->as_nfa->as_min_dfa;
+#print $DFA->as_gdl;
-print $DFA->as_gdl;
+my $PFA1 = FLAT::Regex::WithExtraOps->new('(abc)*dx&(efg)*hy')->as_pfa(); #<--!
+my $PFA2 = FLAT::Regex::WithExtraOps->new('(abc+efg)*(
+ dx&(efg)*hy+
+ hy&(abc)*dx+
+ a(((bca)*bcdx)&((efg)*hy))+
+ a(((bca)*)&((efg)*hy))bcdx+
+ e(((fge)*fghy)&((abc)*dx))+
+ e(((fge)*)&((abc)*dx))fghy
+ )')->as_pfa();
+
+my $DFA1 = $PFA1->as_nfa->as_min_dfa;
+my $DFA2 = $PFA2->as_nfa->as_min_dfa;
+
+print $DFA1->equals($DFA2);
Modified: trunk/perl-flat/dev-scripts/pre_compare.pl
===================================================================
--- trunk/perl-flat/dev-scripts/pre_compare.pl 2006-10-07 12:52:05 UTC (rev 82)
+++ trunk/perl-flat/dev-scripts/pre_compare.pl 2006-12-14 01:54:44 UTC (rev 83)
@@ -19,31 +19,3 @@
} else {
print "No Match";
}
-
-__END__
-open(GDL,">pfa.gdl");
- print GDL $PFA->as_gdl,"\n";
-close(GDL);
-
-my $NFA = $PFA->as_nfa();
-
-open(GDL,">nfa.gdl");
- print GDL $NFA->as_gdl,"\n";
-close(GDL);
-
-my $DFA = $NFA->as_dfa();
-
-open(GDL,">dfa.gdl");
- print GDL $DFA->as_gdl,"\n";
-close(GDL);
-
-open(GDL,">mindfa.gdl");
- print GDL $DFA->as_min_dfa->trim_sinks->as_gdl,"\n";
-close(GDL);
-
-my $dot = $DFA->as_min_dfa->as_graphviz;
-open my $fh, "|-", "circo -Tpng -o output.png"
- or die "Couldn't run dot: $!\n";
-
-print $fh $dot;
-close $fh;
Modified: trunk/perl-flat/dev-scripts/test.sh
===================================================================
--- trunk/perl-flat/dev-scripts/test.sh 2006-10-07 12:52:05 UTC (rev 82)
+++ trunk/perl-flat/dev-scripts/test.sh 2006-12-14 01:54:44 UTC (rev 83)
@@ -1,10 +1,5 @@
perl pregex-to-pfa.pl "${1}"
-rm *.gdl *.png
~/distfiles/aiSee/bin/aisee.bin -pngoutput pfa.png pfa.gdl
~/distfiles/aiSee/bin/aisee.bin -pngoutput nfa.png nfa.gdl
~/distfiles/aiSee/bin/aisee.bin -pngoutput dfa.png dfa.gdl
~/distfiles/aiSee/bin/aisee.bin -pngoutput mindfa.png mindfa.gdl
-#qiv pfa.png&
-#qiv nfa.png&
-#qiv dfa.png&
-qiv mindfa.png&
Modified: trunk/perl-flat/t/03-pregex-pfa.t
===================================================================
--- trunk/perl-flat/t/03-pregex-pfa.t 2006-10-07 12:52:05 UTC (rev 82)
+++ trunk/perl-flat/t/03-pregex-pfa.t 2006-12-14 01:54:44 UTC (rev 83)
@@ -1,10 +1,16 @@
-use Test::More tests => 2;
+use Test::More 'no_plan';
+
+use strict;
+
+use lib qw(../lib);
use FLAT;
+use FLAT::DFA;
use FLAT::NFA;
use FLAT::PFA;
-use FLAT::DFA;
use FLAT::Regex::WithExtraOps;
+diag("This test will take a while..");
+
# w&w
my $PFA1 = FLAT::Regex::WithExtraOps->new('abc&def')->as_pfa();
my $PFA2 = FLAT::Regex::WithExtraOps->new('a(b(c&def)+d(ef&bc))+d(ef&abc)')->as_pfa();
@@ -12,24 +18,49 @@
my $DFA1 = $PFA1->as_nfa->as_min_dfa;
my $DFA2 = $PFA2->as_nfa->as_min_dfa;
-ok( ($DFA1->equals($DFA2)) );
+is( ($DFA1->equals($DFA2)), 1 );
# w&w*
$PFA1 = FLAT::Regex::WithExtraOps->new('abc&(def)*')->as_pfa();
-$PFA2 = FLAT::Regex::WithExtraOps->new('(def)*(a(bc&(def)*)+d((efd)*ef&(abc))+d((efd)*&(abc))ef)')->as_pfa();
+$PFA2 = FLAT::Regex::WithExtraOps->new('(def)*(
+ a(bc&(def)*)+
+ d((efd)*ef&(abc))+
+ d((efd)*&(abc))ef
+ )')->as_pfa();
$DFA1 = $PFA1->as_nfa->as_min_dfa;
$DFA2 = $PFA2->as_nfa->as_min_dfa;
-ok( ($DFA1->equals($DFA2)) );
+is( ($DFA1->equals($DFA2)), 1);
-__END__
# w*&w*
-# throws some weird warning from FA.pm, but passes still
-$PFA1 = FLAT::Regex::WithExtraOps->new('(abc)*&(def)*')->as_pfa();
-$PFA2 = FLAT::Regex::WithExtraOps->new('((abc+def)*(a((bca)*bc&(def)*)+a((bca)*&(def)*)bc+d((efd)*ef&(abc)*)+d((efd)*&(abc)*)ef)*)*')->as_pfa();
+# throws some weird warning from FA.pm when mimimizing, but passes still
+#$PFA1 = FLAT::Regex::WithExtraOps->new('(abc)*&(def)*')->as_pfa();
+#$PFA2 = FLAT::Regex::WithExtraOps->new('((abc+def)*(
+# a((bca)*bc&(def)*)+
+# a((bca)*&(def)*)bc+
+# d((efd)*ef&(abc)*)+
+# d((efd)*&(abc)*)ef
+# )*)*')->as_pfa();
+#$DFA1 = $PFA1->as_nfa->as_min_dfa;
+#$DFA2 = $PFA2->as_nfa->as_min_dfa;
+# is( ($DFA1->equals($DFA2)), 1);
+
+# w*x&w*y
+$PFA1 = FLAT::Regex::WithExtraOps->new('(abc)*dx&(efg)*hy')->as_pfa(); #<--!
+$PFA2 = FLAT::Regex::WithExtraOps->new('(abc+efg)*(
+ dx&(efg)*hy+
+ hy&(abc)*dx+
+ a(((bca)*bcdx)&((efg)*hy))+
+ a(((bca)*)&((efg)*hy))bcdx+
+ e(((fge)*fghy)&((abc)*dx))+
+ e(((fge)*)&((abc)*dx))fghy
+ )')->as_pfa();
+
$DFA1 = $PFA1->as_nfa->as_min_dfa;
$DFA2 = $PFA2->as_nfa->as_min_dfa;
-ok( ($DFA1->equals($DFA2)) );
+is( ($DFA1->equals($DFA2)), 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-09 17:25:12
|
Revision: 84
http://svn.sourceforge.net/perl-flat/?rev=84&view=rev
Author: estrabd
Date: 2007-02-09 09:16:21 -0800 (Fri, 09 Feb 2007)
Log Message:
-----------
added another pfa test
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/test.sh
trunk/perl-flat/t/03-pregex-pfa.t
Added Paths:
-----------
trunk/perl-flat/dev-scripts/dfa.gdl
trunk/perl-flat/dev-scripts/dfa.png
trunk/perl-flat/dev-scripts/mindfa.gdl
trunk/perl-flat/dev-scripts/mindfa.png
trunk/perl-flat/dev-scripts/nfa.gdl
trunk/perl-flat/dev-scripts/nfa.png
trunk/perl-flat/dev-scripts/output.png
trunk/perl-flat/dev-scripts/pfa.gdl
trunk/perl-flat/dev-scripts/pfa.png
Added: trunk/perl-flat/dev-scripts/dfa.gdl
===================================================================
--- trunk/perl-flat/dev-scripts/dfa.gdl (rev 0)
+++ trunk/perl-flat/dev-scripts/dfa.gdl 2007-02-09 17:16:21 UTC (rev 84)
@@ -0,0 +1,72 @@
+graph: {
+display_edge_labels: yes
+
+node: { title:"0" shape:circle borderstyle: solid}
+node: { title:"1" shape:circle borderstyle: solid}
+node: { title:"2" shape:circle borderstyle: solid}
+node: { title:"3" shape:circle borderstyle: solid}
+node: { title:"4" shape:circle borderstyle: solid}
+node: { title:"5" shape:circle borderstyle: solid}
+node: { title:"6" shape:circle borderstyle: solid}
+node: { title:"7" shape:circle borderstyle: solid}
+node: { title:"8" shape:circle borderstyle: solid}
+node: { title:"9" shape:circle borderstyle: solid}
+node: { title:"10" shape:circle borderstyle: solid}
+node: { title:"11" shape:circle borderstyle: solid}
+node: { title:"12" shape:circle borderstyle: solid}
+node: { title:"13" shape:circle borderstyle: solid}
+node: { title:"14" shape:circle borderstyle: solid}
+node: { title:"15" shape:circle borderstyle: solid}
+node: { title:"16" shape:circle borderstyle: double bordercolor: red}
+
+edge: { source: "0" target: "1" label: "c" arrowstyle: line }
+edge: { source: "0" target: "2" label: "a" arrowstyle: line }
+edge: { source: "0" target: "3" label: "b" arrowstyle: line }
+edge: { source: "0" target: "4" label: "d" arrowstyle: line }
+edge: { source: "1" target: "5" label: "c" arrowstyle: line }
+edge: { source: "1" target: "6" label: "a" arrowstyle: line }
+edge: { source: "1" target: "7" label: "b" arrowstyle: line }
+edge: { source: "1" target: "8" label: "d" arrowstyle: line }
+edge: { source: "2" target: "5" label: "a" arrowstyle: line }
+edge: { source: "2" target: "6" label: "c" arrowstyle: line }
+edge: { source: "2" target: "9" label: "b" arrowstyle: line }
+edge: { source: "2" target: "10" label: "d" arrowstyle: line }
+edge: { source: "3" target: "5" label: "b" arrowstyle: line }
+edge: { source: "3" target: "7" label: "c" arrowstyle: line }
+edge: { source: "3" target: "9" label: "a" arrowstyle: line }
+edge: { source: "3" target: "11" label: "d" arrowstyle: line }
+edge: { source: "4" target: "5" label: "d" arrowstyle: line }
+edge: { source: "4" target: "8" label: "c" arrowstyle: line }
+edge: { source: "4" target: "10" label: "a" arrowstyle: line }
+edge: { source: "4" target: "11" label: "b" arrowstyle: line }
+edge: { source: "5" target: "5" label: "a,b,c,d" arrowstyle: line }
+edge: { source: "6" target: "5" label: "a,c" arrowstyle: line }
+edge: { source: "6" target: "12" label: "b" arrowstyle: line }
+edge: { source: "6" target: "13" label: "d" arrowstyle: line }
+edge: { source: "7" target: "5" label: "b,c" arrowstyle: line }
+edge: { source: "7" target: "12" label: "a" arrowstyle: line }
+edge: { source: "7" target: "14" label: "d" arrowstyle: line }
+edge: { source: "8" target: "5" label: "c,d" arrowstyle: line }
+edge: { source: "8" target: "13" label: "a" arrowstyle: line }
+edge: { source: "8" target: "14" label: "b" arrowstyle: line }
+edge: { source: "9" target: "5" label: "a,b" arrowstyle: line }
+edge: { source: "9" target: "12" label: "c" arrowstyle: line }
+edge: { source: "9" target: "15" label: "d" arrowstyle: line }
+edge: { source: "10" target: "5" label: "a,d" arrowstyle: line }
+edge: { source: "10" target: "13" label: "c" arrowstyle: line }
+edge: { source: "10" target: "15" label: "b" arrowstyle: line }
+edge: { source: "11" target: "5" label: "b,d" arrowstyle: line }
+edge: { source: "11" target: "14" label: "c" arrowstyle: line }
+edge: { source: "11" target: "15" label: "a" arrowstyle: line }
+edge: { source: "12" target: "5" label: "a,b,c" arrowstyle: line }
+edge: { source: "12" target: "16" label: "d" arrowstyle: line }
+edge: { source: "13" target: "5" label: "a,c,d" arrowstyle: line }
+edge: { source: "13" target: "16" label: "b" arrowstyle: line }
+edge: { source: "14" target: "5" label: "b,c,d" arrowstyle: line }
+edge: { source: "14" target: "16" label: "a" arrowstyle: line }
+edge: { source: "15" target: "5" label: "a,b,d" arrowstyle: line }
+edge: { source: "15" target: "16" label: "c" arrowstyle: line }
+edge: { source: "16" target: "5" label: "a,b,c,d" arrowstyle: line }
+}
+
+
Added: trunk/perl-flat/dev-scripts/dfa.png
===================================================================
(Binary files differ)
Property changes on: trunk/perl-flat/dev-scripts/dfa.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/perl-flat/dev-scripts/mindfa.gdl
===================================================================
--- trunk/perl-flat/dev-scripts/mindfa.gdl (rev 0)
+++ trunk/perl-flat/dev-scripts/mindfa.gdl 2007-02-09 17:16:21 UTC (rev 84)
@@ -0,0 +1,55 @@
+graph: {
+display_edge_labels: yes
+
+node: { title:"0" shape:circle borderstyle: solid}
+node: { title:"1" shape:circle borderstyle: solid}
+node: { title:"2" shape:circle borderstyle: solid}
+node: { title:"3" shape:circle borderstyle: solid}
+node: { title:"4" shape:circle borderstyle: solid}
+node: { title:"5" shape:circle borderstyle: solid}
+node: { title:"6" shape:circle borderstyle: solid}
+node: { title:"7" shape:circle borderstyle: solid}
+node: { title:"8" shape:circle borderstyle: solid}
+node: { title:"9" shape:circle borderstyle: solid}
+node: { title:"10" shape:circle borderstyle: solid}
+node: { title:"11" shape:circle borderstyle: solid}
+node: { title:"12" shape:circle borderstyle: solid}
+node: { title:"13" shape:circle borderstyle: solid}
+node: { title:"14" shape:circle borderstyle: solid}
+node: { title:"15" shape:circle borderstyle: double bordercolor: red}
+
+edge: { source: "0" target: "1" label: "c" arrowstyle: line }
+edge: { source: "0" target: "2" label: "a" arrowstyle: line }
+edge: { source: "0" target: "3" label: "b" arrowstyle: line }
+edge: { source: "0" target: "4" label: "d" arrowstyle: line }
+edge: { source: "1" target: "5" label: "a" arrowstyle: line }
+edge: { source: "1" target: "6" label: "b" arrowstyle: line }
+edge: { source: "1" target: "7" label: "d" arrowstyle: line }
+edge: { source: "2" target: "5" label: "c" arrowstyle: line }
+edge: { source: "2" target: "8" label: "b" arrowstyle: line }
+edge: { source: "2" target: "9" label: "d" arrowstyle: line }
+edge: { source: "3" target: "6" label: "c" arrowstyle: line }
+edge: { source: "3" target: "8" label: "a" arrowstyle: line }
+edge: { source: "3" target: "10" label: "d" arrowstyle: line }
+edge: { source: "4" target: "7" label: "c" arrowstyle: line }
+edge: { source: "4" target: "9" label: "a" arrowstyle: line }
+edge: { source: "4" target: "10" label: "b" arrowstyle: line }
+edge: { source: "5" target: "11" label: "b" arrowstyle: line }
+edge: { source: "5" target: "12" label: "d" arrowstyle: line }
+edge: { source: "6" target: "11" label: "a" arrowstyle: line }
+edge: { source: "6" target: "13" label: "d" arrowstyle: line }
+edge: { source: "7" target: "12" label: "a" arrowstyle: line }
+edge: { source: "7" target: "13" label: "b" arrowstyle: line }
+edge: { source: "8" target: "11" label: "c" arrowstyle: line }
+edge: { source: "8" target: "14" label: "d" arrowstyle: line }
+edge: { source: "9" target: "12" label: "c" arrowstyle: line }
+edge: { source: "9" target: "14" label: "b" arrowstyle: line }
+edge: { source: "10" target: "13" label: "c" arrowstyle: line }
+edge: { source: "10" target: "14" label: "a" arrowstyle: line }
+edge: { source: "11" target: "15" label: "d" arrowstyle: line }
+edge: { source: "12" target: "15" label: "b" arrowstyle: line }
+edge: { source: "13" target: "15" label: "a" arrowstyle: line }
+edge: { source: "14" target: "15" label: "c" arrowstyle: line }
+}
+
+
Added: trunk/perl-flat/dev-scripts/mindfa.png
===================================================================
(Binary files differ)
Property changes on: trunk/perl-flat/dev-scripts/mindfa.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/perl-flat/dev-scripts/nfa.gdl
===================================================================
--- trunk/perl-flat/dev-scripts/nfa.gdl (rev 0)
+++ trunk/perl-flat/dev-scripts/nfa.gdl 2007-02-09 17:16:21 UTC (rev 84)
@@ -0,0 +1,59 @@
+graph: {
+display_edge_labels: yes
+
+node: { title:"0" shape:circle borderstyle: solid}
+node: { title:"1" shape:circle borderstyle: solid}
+node: { title:"2" shape:circle borderstyle: solid}
+node: { title:"3" shape:circle borderstyle: solid}
+node: { title:"4" shape:circle borderstyle: solid}
+node: { title:"5" shape:circle borderstyle: solid}
+node: { title:"6" shape:circle borderstyle: solid}
+node: { title:"7" shape:circle borderstyle: solid}
+node: { title:"8" shape:circle borderstyle: solid}
+node: { title:"9" shape:circle borderstyle: solid}
+node: { title:"10" shape:circle borderstyle: solid}
+node: { title:"11" shape:circle borderstyle: solid}
+node: { title:"12" shape:circle borderstyle: double bordercolor: red}
+node: { title:"13" shape:circle borderstyle: solid}
+node: { title:"14" shape:circle borderstyle: solid}
+node: { title:"15" shape:circle borderstyle: solid}
+node: { title:"16" shape:circle borderstyle: solid}
+node: { title:"17" shape:circle borderstyle: solid}
+
+edge: { source: "0" target: "1" label: "epsilon" arrowstyle: line }
+edge: { source: "1" target: "2" label: "c" arrowstyle: line }
+edge: { source: "1" target: "3" label: "a" arrowstyle: line }
+edge: { source: "1" target: "4" label: "b" arrowstyle: line }
+edge: { source: "1" target: "5" label: "d" arrowstyle: line }
+edge: { source: "2" target: "6" label: "d" arrowstyle: line }
+edge: { source: "2" target: "14" label: "b" arrowstyle: line }
+edge: { source: "2" target: "17" label: "a" arrowstyle: line }
+edge: { source: "3" target: "7" label: "d" arrowstyle: line }
+edge: { source: "3" target: "15" label: "b" arrowstyle: line }
+edge: { source: "3" target: "17" label: "c" arrowstyle: line }
+edge: { source: "4" target: "8" label: "d" arrowstyle: line }
+edge: { source: "4" target: "14" label: "c" arrowstyle: line }
+edge: { source: "4" target: "15" label: "a" arrowstyle: line }
+edge: { source: "5" target: "6" label: "c" arrowstyle: line }
+edge: { source: "5" target: "7" label: "a" arrowstyle: line }
+edge: { source: "5" target: "8" label: "b" arrowstyle: line }
+edge: { source: "6" target: "9" label: "b" arrowstyle: line }
+edge: { source: "6" target: "13" label: "a" arrowstyle: line }
+edge: { source: "7" target: "10" label: "b" arrowstyle: line }
+edge: { source: "7" target: "13" label: "c" arrowstyle: line }
+edge: { source: "8" target: "9" label: "c" arrowstyle: line }
+edge: { source: "8" target: "10" label: "a" arrowstyle: line }
+edge: { source: "9" target: "11" label: "a" arrowstyle: line }
+edge: { source: "10" target: "11" label: "c" arrowstyle: line }
+edge: { source: "11" target: "12" label: "epsilon" arrowstyle: line }
+edge: { source: "13" target: "11" label: "b" arrowstyle: line }
+edge: { source: "14" target: "9" label: "d" arrowstyle: line }
+edge: { source: "14" target: "16" label: "a" arrowstyle: line }
+edge: { source: "15" target: "10" label: "d" arrowstyle: line }
+edge: { source: "15" target: "16" label: "c" arrowstyle: line }
+edge: { source: "16" target: "11" label: "d" arrowstyle: line }
+edge: { source: "17" target: "13" label: "d" arrowstyle: line }
+edge: { source: "17" target: "16" label: "b" arrowstyle: line }
+}
+
+
Added: trunk/perl-flat/dev-scripts/nfa.png
===================================================================
(Binary files differ)
Property changes on: trunk/perl-flat/dev-scripts/nfa.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/perl-flat/dev-scripts/output.png
===================================================================
(Binary files differ)
Property changes on: trunk/perl-flat/dev-scripts/output.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/perl-flat/dev-scripts/pfa.gdl
===================================================================
--- trunk/perl-flat/dev-scripts/pfa.gdl (rev 0)
+++ trunk/perl-flat/dev-scripts/pfa.gdl 2007-02-09 17:16:21 UTC (rev 84)
@@ -0,0 +1,29 @@
+graph: {
+display_edge_labels: yes
+
+node: { title:"0" shape:circle borderstyle: solid}
+node: { title:"1" shape:circle borderstyle: solid}
+node: { title:"2" shape:circle borderstyle: solid}
+node: { title:"3" shape:circle borderstyle: solid}
+node: { title:"4" shape:circle borderstyle: solid}
+node: { title:"5" shape:circle borderstyle: solid}
+node: { title:"6" shape:circle borderstyle: solid}
+node: { title:"7" shape:circle borderstyle: solid}
+node: { title:"8" shape:circle borderstyle: solid}
+node: { title:"9" shape:circle borderstyle: double bordercolor: red}
+
+edge: { source: "0" target: "1" label: "a" arrowstyle: line }
+edge: { source: "1" target: "9" label: "#lambda" arrowstyle: line }
+edge: { source: "2" target: "3" label: "b" arrowstyle: line }
+edge: { source: "3" target: "9" label: "#lambda" arrowstyle: line }
+edge: { source: "4" target: "5" label: "c" arrowstyle: line }
+edge: { source: "5" target: "9" label: "#lambda" arrowstyle: line }
+edge: { source: "6" target: "7" label: "d" arrowstyle: line }
+edge: { source: "7" target: "9" label: "#lambda" arrowstyle: line }
+edge: { source: "8" target: "0" label: "#lambda" arrowstyle: line }
+edge: { source: "8" target: "2" label: "#lambda" arrowstyle: line }
+edge: { source: "8" target: "4" label: "#lambda" arrowstyle: line }
+edge: { source: "8" target: "6" label: "#lambda" arrowstyle: line }
+}
+
+
Added: trunk/perl-flat/dev-scripts/pfa.png
===================================================================
(Binary files differ)
Property changes on: trunk/perl-flat/dev-scripts/pfa.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Modified: trunk/perl-flat/dev-scripts/test.sh
===================================================================
--- trunk/perl-flat/dev-scripts/test.sh 2006-12-14 01:54:44 UTC (rev 83)
+++ trunk/perl-flat/dev-scripts/test.sh 2007-02-09 17:16:21 UTC (rev 84)
@@ -1,5 +1 @@
-perl pregex-to-pfa.pl "${1}"
-~/distfiles/aiSee/bin/aisee.bin -pngoutput pfa.png pfa.gdl
-~/distfiles/aiSee/bin/aisee.bin -pngoutput nfa.png nfa.gdl
-~/distfiles/aiSee/bin/aisee.bin -pngoutput dfa.png dfa.gdl
-~/distfiles/aiSee/bin/aisee.bin -pngoutput mindfa.png mindfa.gdl
+perl pre_compare.pl 'nop(abc)*hij&qrs(def)*klm' 'n(op(abc)*hij&qrs(def)*klm)+q(rs(def)*klm&nop(abc)*hij)'
Modified: trunk/perl-flat/t/03-pregex-pfa.t
===================================================================
--- trunk/perl-flat/t/03-pregex-pfa.t 2006-12-14 01:54:44 UTC (rev 83)
+++ trunk/perl-flat/t/03-pregex-pfa.t 2007-02-09 17:16:21 UTC (rev 84)
@@ -11,29 +11,30 @@
diag("This test will take a while..");
+diag("w&v..");
# w&w
my $PFA1 = FLAT::Regex::WithExtraOps->new('abc&def')->as_pfa();
my $PFA2 = FLAT::Regex::WithExtraOps->new('a(b(c&def)+d(ef&bc))+d(ef&abc)')->as_pfa();
-
my $DFA1 = $PFA1->as_nfa->as_min_dfa;
my $DFA2 = $PFA2->as_nfa->as_min_dfa;
is( ($DFA1->equals($DFA2)), 1 );
-# w&w*
+diag("w&v*..");
+# w&v*
$PFA1 = FLAT::Regex::WithExtraOps->new('abc&(def)*')->as_pfa();
$PFA2 = FLAT::Regex::WithExtraOps->new('(def)*(
- a(bc&(def)*)+
- d((efd)*ef&(abc))+
- d((efd)*&(abc))ef
- )')->as_pfa();
+ a(bc&(def)*)+
+ d((efd)*ef&(abc))+
+ d((efd)*&(abc))ef
+ )')->as_pfa();
$DFA1 = $PFA1->as_nfa->as_min_dfa;
$DFA2 = $PFA2->as_nfa->as_min_dfa;
is( ($DFA1->equals($DFA2)), 1);
-# w*&w*
+# w*&v*
# throws some weird warning from FA.pm when mimimizing, but passes still
#$PFA1 = FLAT::Regex::WithExtraOps->new('(abc)*&(def)*')->as_pfa();
#$PFA2 = FLAT::Regex::WithExtraOps->new('((abc+def)*(
@@ -43,24 +44,28 @@
# d((efd)*&(abc)*)ef
# )*)*')->as_pfa();
-#$DFA1 = $PFA1->as_nfa->as_min_dfa;
-#$DFA2 = $PFA2->as_nfa->as_min_dfa;
-# is( ($DFA1->equals($DFA2)), 1);
+$DFA1 = $PFA1->as_nfa->as_min_dfa;
+$DFA2 = $PFA2->as_nfa->as_min_dfa;
+ is( ($DFA1->equals($DFA2)), 1);
-# w*x&w*y
-$PFA1 = FLAT::Regex::WithExtraOps->new('(abc)*dx&(efg)*hy')->as_pfa(); #<--!
-$PFA2 = FLAT::Regex::WithExtraOps->new('(abc+efg)*(
- dx&(efg)*hy+
- hy&(abc)*dx+
- a(((bca)*bcdx)&((efg)*hy))+
- a(((bca)*)&((efg)*hy))bcdx+
- e(((fge)*fghy)&((abc)*dx))+
- e(((fge)*)&((abc)*dx))fghy
- )')->as_pfa();
+diag("w*x&v*y..");
+# w*x&v*y
+$PFA1 = FLAT::Regex::WithExtraOps->new('(abc)*dx&(efg)*hy')->as_pfa();
+$PFA2 = FLAT::Regex::WithExtraOps->new('(abc+efg)*( dx&(efg)*hy+
+ hy&(abc)*dx+
+ a(((bca)*bcdx)&((efg)*hy))+
+ a(((bca)*)&((efg)*hy))bcdx+
+ e(((fge)*fghy)&((abc)*dx))+
+ e(((fge)*)&((abc)*dx))fghy
+ )')->as_pfa();
$DFA1 = $PFA1->as_nfa->as_min_dfa;
$DFA2 = $PFA2->as_nfa->as_min_dfa;
+is( ($DFA1->equals($DFA2)), 1);
+$PFA1 = FLAT::Regex::WithExtraOps->new('nop(abc)*hij&qrs(def)*klm')->as_pfa();
+$PFA2 = FLAT::Regex::WithExtraOps->new('n(op(abc)*hij&qrs(def)*klm)+q(rs(def)*klm&nop(abc)*hij)')->as_pfa();
+
+$DFA1 = $PFA1->as_nfa->as_min_dfa;
+$DFA2 = $PFA2->as_nfa->as_min_dfa;
is( ($DFA1->equals($DFA2)), 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-13 15:22:08
|
Revision: 86
http://svn.sourceforge.net/perl-flat/?rev=86&view=rev
Author: estrabd
Date: 2007-02-13 07:20:36 -0800 (Tue, 13 Feb 2007)
Log Message:
-----------
getting ready for transform
Modified Paths:
--------------
trunk/perl-flat/MANIFEST
trunk/perl-flat/dev-scripts/bdetest.pl
Added Paths:
-----------
trunk/perl-flat/lib/FLAT/Regex/Transform.pm
Modified: trunk/perl-flat/MANIFEST
===================================================================
--- trunk/perl-flat/MANIFEST 2007-02-09 17:17:25 UTC (rev 85)
+++ trunk/perl-flat/MANIFEST 2007-02-13 15:20:36 UTC (rev 86)
@@ -2,6 +2,7 @@
MANIFEST
lib/FLAT/Regex/Op.pm
lib/FLAT/Regex/Parser.pm
+lib/FLAT/Regex/Transform.pm
lib/FLAT/Regex/WithNegations.pm
lib/FLAT/Regex.pm
lib/FLAT/FA.pm
Modified: trunk/perl-flat/dev-scripts/bdetest.pl
===================================================================
--- trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-09 17:17:25 UTC (rev 85)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-13 15:20:36 UTC (rev 86)
@@ -2,28 +2,8 @@
use strict;
use lib qw(../lib);
-use FLAT;
-use FLAT::NFA;
-use FLAT::PFA;
-use FLAT::Regex::WithExtraOps;
+use FLAT::Regex::Transform;
use Data::Dumper;
-# This is mainly my test script for FLAT::FA::PFA.pm
-
-#my $DFA = FLAT::Regex->new('ab+ba')->as_nfa->as_min_dfa;
-#print $DFA->as_gdl;
-
-my $PFA1 = FLAT::Regex::WithExtraOps->new('(abc)*dx&(efg)*hy')->as_pfa(); #<--!
-my $PFA2 = FLAT::Regex::WithExtraOps->new('(abc+efg)*(
- dx&(efg)*hy+
- hy&(abc)*dx+
- a(((bca)*bcdx)&((efg)*hy))+
- a(((bca)*)&((efg)*hy))bcdx+
- e(((fge)*fghy)&((abc)*dx))+
- e(((fge)*)&((abc)*dx))fghy
- )')->as_pfa();
-
-my $DFA1 = $PFA1->as_nfa->as_min_dfa;
-my $DFA2 = $PFA2->as_nfa->as_min_dfa;
-
-print $DFA1->equals($DFA2);
+my $trans = FLAT::Regex::Transform->new('abc&efg+hi');
+print Dumper($trans);
Added: trunk/perl-flat/lib/FLAT/Regex/Transform.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/Regex/Transform.pm (rev 0)
+++ trunk/perl-flat/lib/FLAT/Regex/Transform.pm 2007-02-13 15:20:36 UTC (rev 86)
@@ -0,0 +1,18 @@
+package FLAT::Regex::Transform;
+
+# Extends FLAT::Regex::WithExtraOps with PRegex transformations
+# (i.e., reductions based on: w*v & a*b
+
+use base 'FLAT::Regex::WithExtraOps';
+
+sub new {
+ my $pkg = shift;
+ my $self = $pkg->SUPER::new(@_);
+ return $self;
+}
+
+# Ideally, the transformation should be implemented as an iterator. This
+# approach will be finite for shuffles with NO closed strings, but will carry on
+# indefinitely for the shuffle of strings where at least one of the strings is closed
+
+1;
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-15 05:45:37
|
Revision: 90
http://svn.sourceforge.net/perl-flat/?rev=90&view=rev
Author: estrabd
Date: 2007-02-14 21:45:35 -0800 (Wed, 14 Feb 2007)
Log Message:
-----------
pimped out the one liner interface!
Modified Paths:
--------------
trunk/perl-flat/lib/FLAT.pm
trunk/perl-flat/t/03-pregex-pfa.t
Modified: trunk/perl-flat/lib/FLAT.pm
===================================================================
--- trunk/perl-flat/lib/FLAT.pm 2007-02-14 22:53:19 UTC (rev 89)
+++ trunk/perl-flat/lib/FLAT.pm 2007-02-15 05:45:35 UTC (rev 90)
@@ -89,30 +89,81 @@
sub help {
print <<END
+__________ .__ ___________.____ ___________
+\______ \ ___________| | \_ _____/| | _____\__ ___/
+ | ___// __ \_ __ \ | | __) | | \__ \ | |
+ | | \ ___/| | \/ |__ | \ | |___ / __ \| |
+ |____| \___ >__| |____/ \___ / |_______ (____ /____|
+ \/ \/ \/ \/
+
+ 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
+ NB: detected as an operator.
+
+COMMANDS:
%perl -MFLAT -e
- "compare 're1','re2'"
- "dump 're1'"
- "dfa2dot 're1'"
- "nfa2dot 're1'"
- "pfa2dot 're1'"
- random_pre
- random_re
- help
- To Do:
- "getstrings 're1' [opts...]" # given regex, pump strings based on options
- "variations 're1' [opts...]" # given regex will provide equivalents
+ "compare 're1','re2'" # comares 2 regexs | see note [2]
+ "dump 're1'" # dumps parse trees | see note[1]
+ "dfa2dot 're1'" # dumps graphviz graph desc | see note[1]
+ "nfa2dot 're1'" # dumps graphviz graph desc | see note[1]
+ "pfa2dot 're1'" # dumps graphviz graph desc | see note[1]
+ random_pre
+ random_re
+ help
+
+NOTES:
+[1] This means you could presumably do something like the following:
+ %perl -MFLAT -e command < text_file_with_1_regex_per_line.txt
+ ^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+[2] This command compares the minimal DFAs of each regular expression;
+ if there exists a exact 1-1 mapping of symbols, states, and
+ transitions then the DFAs are considered equal. This means that
+ "abc" will be equal to "def" To make matters more confusing, "ab+ac"
+ would be equivalent to "xy+xz"; or worse yet, "z(x+y)". So to the
+ 'compare' command, "ab+ac" == "xy+xz" == "z(x+y)". This however
+ does not translate into the situation where "ab+ac" will accept
+ the same LITERAL strings as "z(x+y)" because the symbols are obviously
+ different. Once we implement the "test" command, used to test strings
+ against a regular expression, a concrete example will be provided.
+
+TO DO:
+ "getstrings 're1' [opts...]" # given regex, pump strings based on options
+ "variations 're1' [opts...]" # given regex will provide equivalents
+
+CREDITS:
+Blockhead, CPAN.pm (for the example of how to implement these one liners),
+and #perl on irc.freenode.net for pointing out something I missed when
+trying to copy CPAN's majik.
+
+Perl FLAT and all included modules are released under the same terms as Perl
+itself. Cheers.
+
+SEE:
+http://perl-flat.sourceforge.net
+
END
}
# dumps parse tree
# Usage:
-# perl -MFLAT -e "dump('a&b&c&d*e*')"
+# perl -MFLAT -e "dump('re1','re2',...,'reN')"
+# perl -MFLAT -e dump < list_of_regexes.dat
sub dump {
shift;
use FLAT::Regex::WithExtraOps;
use Data::Dumper;
- my $PRE = FLAT::Regex::WithExtraOps->new(shift);
- print Dumper($PRE);
+ if (@_)
+ { foreach (@_)
+ { my $PRE = FLAT::Regex::WithExtraOps->new($_);
+ print Dumper($PRE); }}
+ else
+ { while (<STDIN>)
+ { chomp;
+ my $PRE = FLAT::Regex::WithExtraOps->new($_);
+ print Dumper($PRE); }
+ }
}
# dumps graphviz notation
@@ -124,8 +175,16 @@
use FLAT::DFA;
use FLAT::NFA;
use FLAT::PFA;
- my $DFA1 = FLAT::Regex::WithExtraOps->new(shift)->as_pfa()->as_nfa()->as_dfa->as_min_dfa();
- print $DFA1->as_graphviz;
+ if (@_)
+ { foreach (@_)
+ { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa();
+ print $FA->as_graphviz;} }
+ else
+ { while (<STDIN>)
+ { chomp;
+ my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa();
+ print $FA->as_graphviz;}
+ }
}
# dumps graphviz notation
@@ -137,8 +196,16 @@
use FLAT::DFA;
use FLAT::NFA;
use FLAT::PFA;
- my $NFA1 = FLAT::Regex::WithExtraOps->new(shift)->as_pfa()->as_nfa();
- print $NFA1->as_graphviz;
+ if (@_)
+ { foreach (@_)
+ { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
+ print $FA->as_graphviz;} }
+ else
+ { while (<STDIN>)
+ { chomp;
+ my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
+ print $FA->as_graphviz;}
+ }
}
# dumps graphviz notation
@@ -148,8 +215,16 @@
shift;
use FLAT::Regex::WithExtraOps;
use FLAT::PFA;
- my $PFA1 = FLAT::Regex::WithExtraOps->new(shift)->as_pfa();
- print $PFA1->as_graphviz;
+ if (@_)
+ { foreach (@_)
+ { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
+ print $FA->as_graphviz;} }
+ else
+ { while (<STDIN>)
+ { chomp;
+ my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
+ print $FA->as_graphviz;}
+ }
}
# compares 2 give PREs
@@ -176,18 +251,21 @@
# perl -MFLAT -e random_pre
sub random_pre {
shift;
+ my $and_chance = shift;
# skirt around deep recursion warning annoyance
local $SIG{__WARN__} = sub { $_[0] =~ /^Deep recursion/ or warn $_[0] };
srand $$;
my %CMDLINEOPTS = ();
# Percent chance of each operator occuring
$CMDLINEOPTS{LENGTH} = 32;
- $CMDLINEOPTS{AND} = 10;
$CMDLINEOPTS{OR} = 6;
$CMDLINEOPTS{STAR} = 10;
$CMDLINEOPTS{OPEN} = 5;
$CMDLINEOPTS{CLOSE} = 0;
$CMDLINEOPTS{n} = 1;
+ $CMDLINEOPTS{AND} = 10; #<-- default
+ $CMDLINEOPTS{AND} = $and_chance if ($and_chance == 0); #<-- to make it just an re (no shuffle)
+
my $getRandomChar = sub {
my $ch = '';
@@ -233,58 +311,7 @@
# Usage:
# perl -MFLAT -e random_re
sub random_re {
- shift;
- # skirt around deep recursion warning annoyance
- local $SIG{__WARN__} = sub { $_[0] =~ /^Deep recursion/ or warn $_[0] };
- srand $$;
- my %CMDLINEOPTS = ();
- # Percent chance of each operator occuring
- $CMDLINEOPTS{LENGTH} = 32;
- $CMDLINEOPTS{AND} = 0; #<-- turns off & operator
- $CMDLINEOPTS{OR} = 6;
- $CMDLINEOPTS{STAR} = 10;
- $CMDLINEOPTS{OPEN} = 5;
- $CMDLINEOPTS{CLOSE} = 0;
- $CMDLINEOPTS{n} = 1;
-
- my $getRandomChar = sub {
- my $ch = '';
- # Get a random character between 0 and 127.
- do {
- $ch = int(rand 2);
- } while ($ch !~ m/[a-zA-Z0-9]/);
- return $ch;
- };
-
- my $getRandomRE = sub {
- my $str = '';
- my @closeparens = ();
- for (1..$CMDLINEOPTS{LENGTH}) {
- $str .= $getRandomChar->();
- # % chance of an "or"
- if (int(rand 100) < $CMDLINEOPTS{OR}) {
- $str .= "|1";
- } elsif (int(rand 100) < $CMDLINEOPTS{AND}) {
- $str .= "&0";
- } elsif (int(rand 100) < $CMDLINEOPTS{STAR}) {
- $str .= "*1";
- } elsif (int(rand 100) < $CMDLINEOPTS{OPEN}) {
- $str .= "(";
- push(@closeparens,'0101)');
- } elsif (int(rand 100) < $CMDLINEOPTS{CLOSE} && @closeparens) {
- $str .= pop(@closeparens);
- }
- }
- # empty out @closeparens if there are still some left
- if (@closeparens) {
- $str .= join('',@closeparens);
- }
- return $str;
- };
-
- for (1..$CMDLINEOPTS{n}) {
- print $getRandomRE->(),"\n";
- }
+ shift->random_pre(0);
}
1;
Modified: trunk/perl-flat/t/03-pregex-pfa.t
===================================================================
--- trunk/perl-flat/t/03-pregex-pfa.t 2007-02-14 22:53:19 UTC (rev 89)
+++ trunk/perl-flat/t/03-pregex-pfa.t 2007-02-15 05:45:35 UTC (rev 90)
@@ -8,6 +8,7 @@
use FLAT::NFA;
use FLAT::PFA;
use FLAT::Regex::WithExtraOps;
+use Memoize;
diag("This test might take a while..");
@@ -20,14 +21,9 @@
is( ($DFA1->equals($DFA2)), 1 );
-<<<<<<< .mine
-__END__ #<-- comment out if you wish to conduct the time consuming tests
-_
# w&w*
-=======
diag("w&v*..");
# w&v*
->>>>>>> .r86
$PFA1 = FLAT::Regex::WithExtraOps->new('abc&(def)*')->as_pfa();
$PFA2 = FLAT::Regex::WithExtraOps->new('(def)*(
a(bc&(def)*)+
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-15 17:53:12
|
Revision: 92
http://svn.sourceforge.net/perl-flat/?rev=92&view=rev
Author: estrabd
Date: 2007-02-15 09:53:10 -0800 (Thu, 15 Feb 2007)
Log Message:
-----------
added /usr/bin/local/fash utility stub and added ExtUtils::MakeMaker run script to install it
Modified Paths:
--------------
trunk/perl-flat/MANIFEST
trunk/perl-flat/Makefile.PL
trunk/perl-flat/lib/FLAT/Symbol.pm
Added Paths:
-----------
trunk/perl-flat/bin/
trunk/perl-flat/bin/fash
trunk/perl-flat/bin/util-put.pl
Modified: trunk/perl-flat/MANIFEST
===================================================================
--- trunk/perl-flat/MANIFEST 2007-02-15 05:56:19 UTC (rev 91)
+++ trunk/perl-flat/MANIFEST 2007-02-15 17:53:10 UTC (rev 92)
@@ -14,5 +14,7 @@
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)
Modified: trunk/perl-flat/Makefile.PL
===================================================================
--- trunk/perl-flat/Makefile.PL 2007-02-15 05:56:19 UTC (rev 91)
+++ trunk/perl-flat/Makefile.PL 2007-02-15 17:53:10 UTC (rev 92)
@@ -6,6 +6,7 @@
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')
: ()),
Added: trunk/perl-flat/bin/fash
===================================================================
--- trunk/perl-flat/bin/fash (rev 0)
+++ trunk/perl-flat/bin/fash 2007-02-15 17:53:10 UTC (rev 92)
@@ -0,0 +1,5 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
Added: trunk/perl-flat/bin/util-put.pl
===================================================================
--- trunk/perl-flat/bin/util-put.pl (rev 0)
+++ trunk/perl-flat/bin/util-put.pl 2007-02-15 17:53:10 UTC (rev 92)
@@ -0,0 +1,18 @@
+#! perl
+
+use strict;
+use warnings;
+use Config;
+use File::Copy;
+
+# copys bin/f@sh to system bin directory and ensures its is 755
+
+if (-w $Config{installbin})
+ { print "Installing f\@sh 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";}
+
+1;
Modified: trunk/perl-flat/lib/FLAT/Symbol.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/Symbol.pm 2007-02-15 05:56:19 UTC (rev 91)
+++ trunk/perl-flat/lib/FLAT/Symbol.pm 2007-02-15 17:53:10 UTC (rev 92)
@@ -81,5 +81,3 @@
A super class that is intended to provide a simple mechanism for storing a symbol that might be
in conflict with another symbol in string form. TYPE is used to distinguish. Currenly this neither
this, nor its current sub classes, Regular and Special, are used.
-
-=back
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-16 19:59:25
|
Revision: 94
http://svn.sourceforge.net/perl-flat/?rev=94&view=rev
Author: estrabd
Date: 2007-02-16 11:59:22 -0800 (Fri, 16 Feb 2007)
Log Message:
-----------
committing, but think I found a weird bug
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/bdetest.pl
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-15 17:54:42 UTC (rev 93)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-16 19:59:22 UTC (rev 94)
@@ -2,8 +2,6 @@
use strict;
use lib qw(../lib);
-use FLAT::Regex::Transform;
-use Data::Dumper;
+use FLAT::Regex::WithExtraOps;
-my $trans = FLAT::Regex::Transform->new('abc&efg+hi');
-print Dumper($trans);
+print FLAT::Regex->new('a')->as_nfa->as_dfa->as_min_dfa->as_undirected;
Modified: trunk/perl-flat/lib/FLAT/NFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/NFA.pm 2007-02-15 17:54:42 UTC (rev 93)
+++ trunk/perl-flat/lib/FLAT/NFA.pm 2007-02-16 19:59:22 UTC (rev 94)
@@ -207,7 +207,54 @@
############ Formatted output
+# Format that Dr. Sukhamay KUNDU likes to use in his assignments :)
+# This format is just a undirected graph - so transition and state info is lost
+sub as_undirected {
+ 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 :)
+# This format is just a directed graph - so transition and state info is lost
+
+sub as_directed {
+ 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));
+ }
+ @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));
+}
+
+
# Graph Description Language, aiSee, etc
sub as_gdl {
my $self = shift;
Modified: trunk/perl-flat/lib/FLAT.pm
===================================================================
--- trunk/perl-flat/lib/FLAT.pm 2007-02-15 17:54:42 UTC (rev 93)
+++ trunk/perl-flat/lib/FLAT.pm 2007-02-16 19:59:22 UTC (rev 94)
@@ -64,9 +64,12 @@
@EXPORT = qw(compare
dump
- dfa2dot
- nfa2dot
- pfa2dot
+ dfa2gv
+ nfa2gv
+ pfa2gv
+ dfa2directed
+ nfa2directed
+ pfa2directed
random_pre
random_re
help
@@ -106,9 +109,15 @@
%perl -MFLAT -e
"compare 're1','re2'" # comares 2 regexs | see note [2]
"dump 're1'" # dumps parse trees | see note[1]
- "dfa2dot 're1'" # dumps graphviz graph desc | see note[1]
- "nfa2dot 're1'" # dumps graphviz graph desc | see note[1]
- "pfa2dot 're1'" # dumps graphviz graph desc | 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]
+ dfa2directed
+ nfa2directed
+ pfa2directed
+ dfa2undirected
+ nfa2undirected
+ pfa2undirected
random_pre
random_re
help
@@ -176,8 +185,8 @@
# dumps graphviz notation
# Usage:
-# perl -MFLAT -e "dfa2dot('a&b&c&d*e*')"
-sub dfa2dot {
+# perl -MFLAT -e "dfa2gv('a&b&c&d*e*')"
+sub dfa2gv {
shift;
use FLAT::Regex::WithExtraOps;
use FLAT::DFA;
@@ -197,8 +206,8 @@
# dumps graphviz notation
# Usage:
-# perl -MFLAT -e "nfa2dot('a&b&c&d*e*')"
-sub nfa2dot {
+# perl -MFLAT -e "nfa2gv('a&b&c&d*e*')"
+sub nfa2gv {
shift;
use FLAT::Regex::WithExtraOps;
use FLAT::DFA;
@@ -218,8 +227,8 @@
# dumps graphviz notation
# Usage:
-# perl -MFLAT -e "pfa2dot('a&b&c&d*e*')"
-sub pfa2dot {
+# perl -MFLAT -e "pfa2gv('a&b&c&d*e*')"
+sub pfa2gv {
shift;
use FLAT::Regex::WithExtraOps;
use FLAT::PFA;
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-16 22:06:15
|
Revision: 95
http://svn.sourceforge.net/perl-flat/?rev=95&view=rev
Author: estrabd
Date: 2007-02-16 14:06:13 -0800 (Fri, 16 Feb 2007)
Log Message:
-----------
found bug in FA->predecessors, but not sure what it really is; need to test FA::as_directed, etc
Modified Paths:
--------------
trunk/perl-flat/dev-scripts/bdetest.pl
trunk/perl-flat/lib/FLAT/FA.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-16 19:59:22 UTC (rev 94)
+++ trunk/perl-flat/dev-scripts/bdetest.pl 2007-02-16 22:06:13 UTC (rev 95)
@@ -4,4 +4,4 @@
use lib qw(../lib);
use FLAT::Regex::WithExtraOps;
-print FLAT::Regex->new('a')->as_nfa->as_dfa->as_min_dfa->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/FA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/FA.pm 2007-02-16 19:59:22 UTC (rev 94)
+++ trunk/perl-flat/lib/FLAT/FA.pm 2007-02-16 22:06:13 UTC (rev 95)
@@ -205,7 +205,9 @@
}
sub predecessors {
- shift->clone->reverse->successors(@_);
+ my $self = shift;
+ #$self->clone->reverse->successors(@_);
+ $self->clone->successors(@_);
}
# reverse - no change from NFA
Modified: trunk/perl-flat/lib/FLAT/NFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/NFA.pm 2007-02-16 19:59:22 UTC (rev 94)
+++ trunk/perl-flat/lib/FLAT/NFA.pm 2007-02-16 22:06:13 UTC (rev 95)
@@ -211,24 +211,25 @@
# This format is just a undirected graph - so transition and state info is lost
sub as_undirected {
- 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 19:59:22 UTC (rev 94)
+++ trunk/perl-flat/lib/FLAT.pm 2007-02-16 22:06:13 UTC (rev 95)
@@ -107,17 +107,17 @@
COMMANDS:
%perl -MFLAT -e
- "compare 're1','re2'" # comares 2 regexs | see note [2]
- "dump 're1'" # dumps parse trees | see note[1]
+ "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]
- dfa2directed
- nfa2directed
- pfa2directed
- dfa2undirected
- nfa2undirected
- pfa2undirected
+ 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
random_pre
random_re
help
@@ -244,6 +244,136 @@
}
}
+# dumps directed graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "dfa2directed('a&b&c&d*e*')"
+sub dfa2directed {
+ shift;
+ use FLAT::Regex::WithExtraOps;
+ use FLAT::DFA;
+ use FLAT::NFA;
+ use FLAT::PFA;
+ # trims sink states from min-dfa since transitions are gone
+ if (@_)
+ { foreach (@_)
+ { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks();
+ print $FA->as_directed;} }
+ 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 "\n";
+}
+
+# dumps directed graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "nfa2directed('a&b&c&d*e*')"
+sub nfa2directed {
+ shift;
+ use FLAT::Regex::WithExtraOps;
+ use FLAT::DFA;
+ use FLAT::NFA;
+ use FLAT::PFA;
+ if (@_)
+ { foreach (@_)
+ { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
+ print $FA->as_directed;} }
+ else
+ { while (<STDIN>)
+ { chomp;
+ my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
+ print $FA->as_directed;}
+ }
+ print "\n";
+}
+
+# dumps directed graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "pfa2directed('a&b&c&d*e*')"
+sub pfa2directed {
+ shift;
+ use FLAT::Regex::WithExtraOps;
+ use FLAT::PFA;
+ if (@_)
+ { foreach (@_)
+ { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
+ print $FA->as_directed;} }
+ else
+ { while (<STDIN>)
+ { chomp;
+ my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
+ print $FA->as_directed;}
+ }
+ print "\n";
+}
+
+# dumps undirected graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "dfa2undirected('a&b&c&d*e*')"
+sub dfa2undirected {
+ shift;
+ use FLAT::Regex::WithExtraOps;
+ use FLAT::DFA;
+ use FLAT::NFA;
+ use FLAT::PFA;
+ # trims sink states from min-dfa since transitions are gone
+ if (@_)
+ { foreach (@_)
+ { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks();
+ print $FA->as_undirected;} }
+ else
+ { while (<STDIN>)
+ { chomp;
+ my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa()->as_dfa->as_min_dfa->trim_sinks();
+ print $FA->as_undirected;}
+ }
+ print "\n";
+}
+
+# dumps undirected graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "nfa2undirected('a&b&c&d*e*')"
+sub nfa2undirected {
+ shift;
+ use FLAT::Regex::WithExtraOps;
+ use FLAT::DFA;
+ use FLAT::NFA;
+ use FLAT::PFA;
+ if (@_)
+ { foreach (@_)
+ { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
+ print $FA->as_undirected;} }
+ else
+ { while (<STDIN>)
+ { chomp;
+ my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa()->as_nfa();
+ print $FA->as_undirected;}
+ }
+ print "\n";
+}
+
+# dumps undirected graph using Kundu notation
+# Usage:
+# perl -MFLAT -e "pfa2undirected('a&b&c&d*e*')"
+sub pfa2undirected {
+ shift;
+ use FLAT::Regex::WithExtraOps;
+ use FLAT::PFA;
+ if (@_)
+ { foreach (@_)
+ { my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
+ print $FA->as_undirected;} }
+ else
+ { while (<STDIN>)
+ { chomp;
+ my $FA = FLAT::Regex::WithExtraOps->new($_)->as_pfa();
+ print $FA->as_undirected;}
+ }
+ print "\n";
+}
+
# compares 2 give PREs
# Usage:
# perl -MFLAT -e "compare('a','a&b&c&d*e*')" #<-- no match, btw
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-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-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-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-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-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-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-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-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.
|
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X