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

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

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.