File Coverage

blib/lib/Decision/Markov.pm

Criterion	Covered	Total	%
statement	96	97	98.9
branch	21	28	75.0
condition	3	6	50.0
subroutine	19	19	100.0
pod	9	13	69.2
total	148	163	90.8

package Decision::Markov;

#
# Copyright (c) 1998-2002 Alan Schwartz . All rights
# reserved. This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#

require 5.000;
use strict;
use diagnostics;
use Carp;
use Decision::Markov::State;
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 $self = {};
    bless $self, $class;
    $self->{'states'} = [];		# List of states
    $self->DiscountRate(0);
    $self->Reset;
    return $self;
}

sub AddState {
     my $self = shift;
     my $name = shift;
     my $utility = shift;
     my $state = new Decision::Markov::State($name,$utility);
     push(@{ $self->{'states'} }, $state);
     return $state;
}

sub States { @{ $_[0]->{'states'} } };
sub CurrentState {
  my $self = shift;
  @_ ? $self->{'currentstate'} = shift : $self->{'currentstate'}
};
sub CumUtility {
  my $self = shift;
  @_ ? $self->{'cumutility'} = shift : $self->{'cumutility'}
};
sub PatientsLeft {
  my $self = shift;
  @_ ? $self->{'patientsleft'} = shift : $self->{'patientsleft'}
};
sub DiscountRate {
  my $self = shift;
  @_ ? $self->{'discount'} = shift : $self->{'discount'}
};

sub AddPath {
     my $self = shift;
     my $from = shift;		# source state
     my $to = shift;		# destination state
     my $prob = shift;		# transition probability/function
     return "AddPath: From state '$from' isn't a State object" unless ref($from);
     return "AddPath: To state '$to' isn't a State object" unless ref($to);
     return $from->AddTransition($to,$prob);
}

# Check that transition probabilities for every node add up to 1.
# If the probabilities are functions of time, try calling them
# for t = 3 and make sure that works. Return undef if no good, otherwise 1.
sub Check {
  my $self = shift;
  foreach my $state ($self->States) {
    my $total = $state->SumProbs;
    return "Check: " . $state->Name . " has probabilities totalling $total, not 1"
       unless ($total == 1);
  }
  return undef;
}


sub Reset {
  my $self = shift;
  $self->CurrentState("");
  $self->CumUtility(0);
  $self->PatientsLeft(0);
  foreach my $state ($self->States) {
    $state->Reset;
  }
  $self->StartingState(@_) if @_;
}

sub StartingState {
  my $self = shift;
  my $initial_state = shift;
  my $numpatients = shift;
  return "StartingState: Initial state '$initial_state' isn't a State object"
       unless ref($initial_state);
  return "StartingState: Invalid number of patients: $numpatients"
       if ($numpatients && ($numpatients < 0));
  $self->CurrentState($initial_state);
  if ($numpatients) {
    $self->PatientsLeft($numpatients);
    $initial_state->NumPatients($numpatients);
  }
  return undef;
}


1;
__END__