diff variant_effect_predictor/Bio/Tools/StateMachine/AbstractStateMachine.pm @ 0:1f6dce3d34e0

Uploaded

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/Tools/StateMachine/AbstractStateMachine.pm	Thu Apr 11 02:01:53 2013 -0400
@@ -0,0 +1,616 @@
+#-----------------------------------------------------------------
+# $Id: AbstractStateMachine.pm,v 1.9 2002/10/22 07:38:49 lapp Exp $
+#
+# BioPerl module Bio::Tools::StateMachine::AbstractStateMachine
+#
+# Cared for by Steve Chervitz <[e-mail]>
+#
+# You may distribute this module under the same terms as perl itself
+#-----------------------------------------------------------------
+
+=head1 NAME
+
+Bio::Tools::StateMachine::AbstractStateMachine - Abstract state machine object
+
+=head1 SYNOPSIS
+
+Here is a portion of an implementation. For the full example, see
+examples/state-machine.pl in the Bioperl distribution.
+
+    package SimpleStateMachine;
+
+    use Bio::Root::Root;
+    use Bio::Tools::StateMachine::AbstractStateMachine qw($INITIAL_STATE 
+    							  $FINAL_STATE);
+    use vars qw( @ISA );
+
+    @ISA = qw( Bio::Root::Root
+    	   Bio::Tools::StateMachine::AbstractStateMachine );
+
+    my @state_transitions = (  [ $INITIAL_STATE, 'State1'],
+    			       [ 'State1', 'State2' ],
+    			       [ 'State2', $FINAL_STATE]
+    				);
+    sub new {
+       my($caller,@args) = @_;
+       my $self = $caller->SUPER::new( @args);
+       $self->_init_state_machine( -transition_table => \@state_transitions );
+       return $self;
+    }
+
+
+
+=head1 DESCRIPTION
+
+B<AbstractStateMachine> provides a generic framework for representing a
+state machine. This is not an event-based framework where you register
+handlers to be called when certain events occur. Instead, it provides
+a set of methods that define the basic logic of an object that has
+state behavior, that logic being:
+
+=over 4
+
+=item 1. Check for whether or not a new state has occurred in the external world.
+
+=item 2. If so, change the state of the machine to the new state.
+
+=item 3. Otherwise, keep checking current conditions for a new state.
+
+=item 4. Stop checking for new states if we reach the final state, or if an error occurs.
+
+=back
+
+A B<state> is just a string representing the name of the state.  A
+state machine is initialized with a B<state transition table>
+consisting of a set of allowable transitions, where each B<transition>
+is a two-element array in which the first element is the B<from
+state>, and the second element is the B<to state>.  This table permits
+the AbstractStateMachine to determine if a requested transition is
+valid.
+
+This module is flexible enough to represent both deterministic and
+non-deterministic finite automata (DFAs and NFAs), but it is fairly
+new and should be considered experimental.
+
+The key methods in AbstractStateMachine that define this logic of
+operation are:
+
+=over 4
+
+=item check_for_new_state().
+
+Does whatever checking is necessary to determine if a state transition
+should occur (for example, read a line of input from STDIN). If a
+transition should occur, a string is returned containing the name of
+the new state. Otherwise, it returns C<undef>.
+
+This method B<must be implemented> as AbstractStateMachine does not
+define it (and in fact will throw a NotImplemented exception if you
+fail to implement it).
+
+=item change_state( C<new_state> )
+
+Causes the machine to change its state to the state specified in the
+argument. change_state() allows you to mapping a state transition to a
+particular handler method that does whatever processing is needed to
+deal with the state transition.
+
+=item run()
+
+This method keeps calling check_for_new_state() and if that method
+returns a defined value (the name of the state to change to), it then
+calls change_state( $state ), where $state is the value returned by
+check_for_new_state().
+
+Before calling check_for_new_state(), the run() method checks the
+current state of the machine and exits the loop if the current state
+ever becomes $PAUSE_STATE, $ERROR_STATE, or $FINAL_STATE.
+
+=item append_input_cache( C<data> )
+
+Adds data to a buffer for processing at the next state
+transition. check_for_new_state() should call
+append_input_cache() passing it any data it receives while checking
+for a new state that should be processed later.
+
+=item get_input_cache()
+
+Retrieves the data stored by calling
+append_input_cache(). change_state() should call get_input_cache() to
+obtain the data to be processed for the current transition.
+
+=back
+
+This object defines an abstract class, meaning that some but not all methods 
+have been implemented. Subclasses must define the methods not implemented here.
+These include at a minimum:
+
+=over 4
+
+=item check_for_new_state()
+
+=item change_state()
+
+A default simple implementation of change_state() is provided, but
+subclasses of AbstractStateMachine most likely will want to override
+this method to do something useful according to the particular state
+change.
+
+=back
+
+If your state machine needs to cache input while processing, you will
+also need to provide implementations of these methods (which are no-op
+in AbstractStateMachine):
+
+=over 3
+
+=item append_input_cache
+
+=item get_input_cache
+
+=item clear_input_cache
+
+=back
+
+There are some other nuances provided by AbstractStateMachine, such as
+the ability to pause() and resume() the running of the machine.
+
+
+=head1 EXAMPLES
+
+To get a feel for how to use this, have look at scripts in the
+examples/state-machine directory of the Bioperl distribution. Also
+have a look at Bio::Tools::StateMachine::IOStateMachine which provides
+a Bio::Root::IO-based implementation of
+AbstractStateMachine. Bio::SearchIO::psiblast subclasses
+IOStateMachine.
+
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists 
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules.  Send your comments and suggestions preferably to one
+of the Bioperl mailing lists.  Your participation is much appreciated.
+
+    [e-mail]              - General discussion
+    http://bio.perl.org/MailList.html  - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+the bugs and their resolution. Bug reports can be submitted via email
+or the web:
+
+    [e-mail]                   
+    http://bugzilla.bioperl.org/           
+
+=head1 AUTHOR 
+
+Steve Chervitz, E<lt>[e-mail]<gt>
+
+See the L<FEEDBACK | FEEDBACK> section for where to send bug reports and comments.
+
+=head1 ACKNOWLEDGEMENTS
+
+I would like to acknowledge my colleagues at Affymetrix for useful
+feedback.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2001 Steve Chervitz. All Rights Reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+=head1 DISCLAIMER
+
+This software is provided "as is" without warranty of any kind.
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods.
+Internal methods are usually preceded with a _
+
+=cut
+
+
+# Let the code begin...
+
+package Bio::Tools::StateMachine::AbstractStateMachine;
+
+use strict;
+use Bio::Root::RootI;
+use Exporter ();
+
+use vars qw( @ISA @EXPORT_OK $INITIAL_STATE $FINAL_STATE $PAUSE_STATE $ERROR_STATE );
+@ISA = qw( Bio::Root::RootI  Exporter );
+@EXPORT_OK = qw( $INITIAL_STATE $FINAL_STATE $PAUSE_STATE $ERROR_STATE );
+
+@Bio::Tools::StateMachine::StateException::ISA = qw( Bio::Root::Exception );
+
+$INITIAL_STATE = 'Initial';
+$FINAL_STATE = 'Final';
+$PAUSE_STATE = 'Pause';
+$ERROR_STATE = 'Error';
+
+sub _init_state_machine {
+    my  ($self, @args ) = @_;
+    my ($transition_table) = $self->_rearrange( [qw(TRANSITION_TABLE)], @args);
+
+    $self->verbose and print STDERR "Initializing State Machine...\n";
+
+    if($transition_table) {
+        $self->_set_transition_table( $transition_table );
+    }
+
+    $self->add_transition( $INITIAL_STATE, $FINAL_STATE );
+    $self->_set_current_state( $INITIAL_STATE );
+}
+
+sub reset {
+    my $self = shift;
+    $self->verbose and print STDERR "Resetting state machine\n";
+    $self->_set_current_state( $INITIAL_STATE );
+}
+
+sub _set_current_state {
+    my ($self, $state) = @_;
+    if( defined $state) {
+	$self->verbose and print STDERR "  setting current state to $state\n";
+	$self->{'_current_state'} = $state;
+    }
+}
+
+sub current_state { shift->{'_current_state'} }
+
+sub initial_state { $INITIAL_STATE }
+
+sub final_state { $FINAL_STATE }
+
+sub pause_state { $PAUSE_STATE }
+
+sub error_state { $ERROR_STATE }
+
+sub resume_state {
+    my ($self, $state) = @_;
+    if( $state ) {
+      $self->{'_resume_state'} = $state;
+    }
+    $self->{'_resume_state'};
+}
+
+sub _clear_resume_state {
+    my $self = shift;
+    undef $self->{'_resume_state'};
+}
+
+=head2 running
+
+The machine is either running or not running. 
+Once the machine has stopped running, it cannot be re-started.
+Use pause() to temporarily halt a machine without exiting the run state.
+
+=cut 
+
+sub running { shift->{'_running'} }
+
+sub _set_running {
+    my $self = shift;
+    $self->{'_running'} = shift;
+}
+
+sub run {
+    my ($self, @args) = @_;
+
+    my $verbose = $self->verbose;
+    my $curr_state = $self->current_state;
+    $self->_set_running( 1 );
+
+    while( not ($curr_state eq $PAUSE_STATE ||
+                $curr_state eq $ERROR_STATE ||
+                $curr_state eq $FINAL_STATE )) {
+
+	$verbose and print STDERR "Current state (run): ${\$self->current_state}\n";
+
+        if( my $state = $self->check_for_new_state()) {
+            $self->change_state( $state );
+        }
+
+        $curr_state = $self->current_state;
+    }
+
+    # Handle EOF situations
+    if( not ($curr_state eq $PAUSE_STATE ||
+             $curr_state eq $FINAL_STATE )) {
+
+        $self->change_state( $FINAL_STATE );
+	$self->_set_running( 0 );
+    }
+
+    $verbose and print STDERR "StateMachine Run complete ($curr_state).\n";
+}
+
+# The pause() and resume() methods don't go through change_state()
+sub pause {
+    my ($self) = @_;
+#    print "PAUSING...\n";
+    $self->resume_state( $self->current_state );
+    $self->_set_current_state( $PAUSE_STATE );
+#    print "After pause(): Current state: ${\$self->current_state}\n";
+}
+
+sub paused {
+    my ($self) = @_;
+    return $self->current_state eq $PAUSE_STATE;
+}
+
+sub throw{
+   my ($self,@args) = @_;
+   $self->_set_current_state( $ERROR_STATE );
+   $self->_set_running( 0 );
+   $self->SUPER::throw( @args );
+}
+
+sub error {
+    my ($self, $err) = @_;
+    return $self->current_state eq $ERROR_STATE;
+}
+
+sub resume {
+    my ($self) = @_;
+
+    # Don't resume if we're done.
+    return if $self->current_state eq $FINAL_STATE;
+
+#    print "RESUMING...\n";
+    $self->_set_current_state( $self->resume_state );
+    $self->_clear_resume_state;
+    $self->run();
+}
+
+=head2 transition_table
+
+ Arg      : n/a
+ Returns  : An array of array references to two-element arrays.
+            Each array ref defines a single transition where
+            the first element is the name of the "from" state and
+            the second element is the name of the "to" state.
+
+ Example  : $sm->transition_table( [ $INITIAL_STATE, 'State1'],
+				   [ 'State1', 'State2' ],
+				   [ 'State2', 'State3' ],
+				   [ 'State3', $FINAL_STATE]
+				 );
+
+=cut
+
+sub transition_table {
+    my ($self) = @_;
+
+    return @{$self->{'_transition_table'}};
+}
+
+sub _set_transition_table {
+    my ($self, $table_ref) = @_;
+
+    my $verbose = $self->verbose;
+    $verbose and print STDERR "Setting state transition table:\n";
+
+    if( not ref($table_ref) eq 'ARRAY') {
+	$self->throw( -class => 'Bio::Root::BadParameter',
+                      -text => "Can't set state transition table: Arg wasn't an array reference."
+                    );
+    }
+
+    foreach my $t (@$table_ref) {
+        if( ref($t) and scalar(@$t) == 2 ) {
+            push @{$self->{'_transition_table'}->{$t->[0]}}, $t->[1];
+            $verbose and print STDERR "  adding: $t->[0] -> $t->[1]\n";
+        }
+        else {
+            $self->throw( -class => 'Bio::Root::BadParameter',
+                          -text => "Can't add state transition from table: Not a 2-element array reference ($t)"
+                        );
+        }
+    }
+}
+
+=head2 add_transition
+
+ Arg      : Two string arguments where:
+            First string = name of the "from" state.
+            Second string = name of the "to" state.
+ Throws   : A Bio::Root::BadParameter exception if two arguments
+            are not provided.
+
+=cut
+
+sub add_transition {
+    my ($self, $from, $to) = @_;
+
+    if( defined($from) and defined($to) ) {
+	push @{$self->{'_transition_table'}->{$from}}, $to;
+    }
+    else {
+	$self->throw( -class => 'Bio::Root::BadParameter',
+                      -text => "Can't add state transition: Insufficient arguments."
+                    );
+    }
+}
+
+
+=head2 change_state
+
+ Purpose  : To cause the machine to change its state.
+ Argument : A String containing the name of the the new state.
+ Returns  : n/a
+ Throws   : A Bio::Tools::StateMachine::StateException exception if the
+            state transition cannot be carried out.
+
+This is a default implementation that simply validates the state change
+(by calling  validate_transition) and then calls finalize_state_change()
+if the transition is valid.
+
+Subclasses of AbstractStateMachine most likely will want to override this 
+method to do something useful according to the particular state change.
+
+=cut
+
+sub change_state {
+    my ($self, $new_state) = @_;
+
+    $self->verbose and print STDERR "  changing state to $new_state\n";
+
+    if ( $self->validate_transition( $self->current_state, $new_state, 1 ) ) {
+      $self->finalize_state_change( $new_state, 1 );
+    }
+
+}
+
+
+=head2 get_transitions_from
+
+ Purpose  : Returns a list array references that have the indicated state
+            in their 'from' slot.
+
+=cut
+
+sub get_transitions_from {
+    my ($self, $state) = @_;
+
+    my @trans = ();
+    if( ref $self->{'_transition_table'}->{$state}) {
+        @trans = @{$self->{'_transition_table'}->{$state}};
+    }
+
+    return @trans;
+}
+
+=head2 validate_transition
+
+ Purpose  : Determines if the desired state change is defined within 
+            the set of registered transitions for this StateMachine.
+ Arg      : Two required arguments:
+            [0] string defining the name of the "from" state (case sensitive)
+            [1] string defining the name of the "to" state (case sensitive)
+ Returns  : True if the transition is valid.
+            If not valid, throws an exception.
+ Throws   : A Bio::Tools::StateMachine::StateException if the desired 
+            transition does not exist with the registered transitions
+            for this machine.
+ Throws   : A Bio::Root::BadParameter if insufficient arguments are given.
+
+=cut
+
+sub validate_transition {
+    my ($self, $from_state, $to_state ) = @_;
+
+    #print STDERR "  validating transition $from_state -> $to_state\n";
+
+    if( not( defined($from_state) and defined($to_state))) {
+        $self->throw( -class => 'Bio::Root::BadParameter',
+                      -text => "Can't validate state transition: Insufficient arguments.");
+    }
+
+    my $is_valid = 0;
+
+    foreach my $t ( $self->get_transitions_from( $from_state ) ) {
+        if( $t eq $to_state ) {
+#        if( $t->[1] eq $to_state ) {
+            $is_valid = 1;
+            last;
+        }
+    }
+
+    if( not $is_valid ) {
+        $self->throw( -class => 'Bio::Tools::StateMachine::StateException',
+                      -text => "The desired state change is not valid for this machine: $from_state -> $to_state");
+    }
+
+    #print STDERR "  valid!\n";
+
+    return $to_state;
+}
+
+=head2 check_for_new_state
+
+ Purpose : To do whatever checking is necessary to determine if 
+            a state transition should occur. 
+ Argument : Any necessary data required to determine if the state 
+            machine should change to a new state.
+ Returns  : A string containing the name of the new state if the 
+            state machine should change to a new state. 
+            Otherwise returns undef.
+
+This is a virtual method and must be implemented by a subclass to do 
+whatever checking is necessary to determine if a state transition should occur.
+If not implemented, calling this method will result in a 
+Bio::Root::NotImplemented exception.
+
+=cut
+
+sub check_for_new_state {
+    my ($self, $data) = @_;
+    $self->throw_not_implemented;
+}
+
+sub append_input_cache {
+    my ($self, $data) = @_;
+}
+
+sub get_input_cache {
+    my $self = shift;
+}
+
+sub clear_input_cache {
+    my $self = shift;
+}
+
+sub state_change_cache {
+    my ($self, $data) = @_;
+    if( defined $data ) {
+        $self->{'_state_change_cache'} = $data;
+    }
+    return $self->{'_state_change_cache'};
+}
+
+sub clear_state_change_cache {
+    my ($self, $data) = @_;
+    $self->{'_state_change_cache'} = undef;
+}
+
+
+=head2 finalize_state_change
+
+ Purpose  : Performs routine operations to finish changing state.
+            This method should be called at the end of change_state().
+ Usage    : finalize_state_change( $new_state, $clear_input_cache );
+ Argument : $new_state = the name of the state to change to.
+            $clear_input_cache = boolean whether or not to zap whatever 
+                                 was in the input cache. Depends on 
+                                 the logic of your state machine.
+
+=cut
+
+sub finalize_state_change {
+    my ($self, $to_state, $clear_input_cache ) = @_;
+
+    if( $self->paused ) {
+        $self->resume_state( $to_state );
+    }
+    else {
+        $self->_set_current_state( $to_state );
+    }
+    $self->clear_input_cache() if $clear_input_cache;
+    $self->append_input_cache( $self->state_change_cache );
+    $self->clear_state_change_cache();
+}
+
+
+1;
+
+