File Coverage

blib/lib/Decision/Markov/State.pm

Criterion	Covered	Total	%
statement	59	67	88.0
branch	14	22	63.6
condition	1	6	16.6
subroutine	13	14	92.8
pod	9	11	81.8
total	96	120	80.0

package Decision::Markov::State;

require 5.000;
use strict;
use diagnostics;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();
$VERSION = "0.03";

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $name = shift;
    my $utility = shift;
    my $self = {};
    bless $self, $class;
    $self->Name($name);			# State name
    $self->{'utility'} = $utility;	# State utility
    $self->{'transitions'} = {};	# Transitions to other nodes
    $self->Reset();			# Reset simulation parameters
    return $self;
}


sub Reset {
    my $self = shift;
    $self->NumPatients(0);
    $self->NewNumPatients(0);
}

sub Name {
  my $self = shift;
  @_ ? $self->{'name'} = shift : $self->{'name'};
}
sub NumPatients {
  my $self = shift;
  @_ ? $self->{'numpatients'} = shift : $self->{'numpatients'};
}
sub NewNumPatients {
  my $self = shift;
  @_ ? $self->{'newnumpatients'} = shift : $self->{'newnumpatients'};
}
sub Transitions { %{ $_[0]->{'transitions'} } }
sub Utility {
  my $self = shift;
  my $cycle = shift;
  my $utility = $self->{'utility'};
  $utility = &$utility($cycle) if (ref($utility));
  return $utility;
}

sub AddTransition {
  my $self = shift;
  my $to = shift;
  my $prob = shift;
  return "AddTransition: There's already a transition from " . $self->Name . " to " . $to->Name if defined($self->{'transitions'}->{$to->Name});
  $self->{'transitions'}->{$to->Name} = [ $to, $prob ];
  return undef;
}

sub TransitionProb {
  my $self = shift;
  my $to = shift;
  my $cycle = shift;
  my %transitions = $self->Transitions;
  return 0 unless $transitions{$to->Name};
  my $prob = $transitions{$to->Name}[1];
  return $prob unless (ref($prob) and defined($cycle));
  return &$prob($cycle);
}

sub SumProbs {
  my $self = shift;
  my $cycle = shift;
  $cycle = 3 unless defined($cycle);
  my $sum = 0;
  my %transitions = $self->Transitions;
  foreach my $listref (values %transitions) {
    my $prob = ${ $listref }[1];
    $prob = &$prob($cycle) if (ref($prob));
    $sum += $prob;
  }
  return $sum;
}

# Are we in a final state? A final state is a state that has only
# one transition path, leading back to the state itself.
sub FinalState {
  my $self = shift;
  my %transitions = $self->Transitions;
  my @transition_states = keys %transitions;
  # Not a final state if there are multiple transitions
  return 0 if (scalar(@transition_states) > 1);
  # Not a final state if the transition is to a different state
  return 0 if $transitions{$transition_states[0]}->[0] ne $self;
  return 1;
}


# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__