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

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

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.