view release on metacpan or  search on metacpan

examples/diagnosis.pl  view on Meta::CPAN

package Chorus::Sample::Diagnosis;

use 5.006;
use strict;
use warnings;

our $VERSION = '1.00';

=head1 NAME

Chorus::Sample::Diagnosis - Medical diagnosis illustrating _NEEDED (deep), _LOCK_UNTIL_STABLE, and replay_all()

=head1 DESCRIPTION

A simplified medical diagnosis pipeline with two agents and a patient frame
whose symptom slots are intentionally incomplete.

  Patient frame slots
  -------------------
  temperature      : numeric value in °C  (may be absent → inferred from skin_temp)
  skin_temp        : 'hot' | 'normal' | 'cold'  (proxy when thermometer unavailable)
  cough            : 1/0
  sore_throat      : 1/0
  fatigue          : 1/0
  rash             : 1/0

  Derived slots (set by the pipeline)
  ------------------------------------
  fever_grade      : 'none' | 'low' | 'high'   (computed from temperature)
  hypothesis       : the current diagnostic hypothesis
  confidence       : 0..1

Mechanisms illustrated:
  _NEEDED (2 levels)    temperature → infer from skin_temp (backward chaining).
                        fever_grade → infer from temperature (second _NEEDED level).
  _LOCK_UNTIL_STABLE    Agent 2 (Diagnose) is blocked while Agent 1 (Collect)
                        is still making progress.
  replay_all()          When Diagnose finds a hypothesis that unlocks new
                        symptom checks, it calls replay_all() so Collect
                        can complete the missing slots before Diagnose
                        re-evaluates.
  solved()              Called when confidence > 0.8.

=cut

use FindBin qw($Bin);
use Chorus::Frame;
use Chorus::Engine;
use Chorus::Expert;

# ---------------------------------------------------------------------------
# Patient — temperature deliberately absent (must be inferred)
# ---------------------------------------------------------------------------

my $patient = Chorus::Frame->new(
    id         => 'patient-01',

    # skin_temp is available; temperature is not — triggers _NEEDED
    skin_temp  => 'hot',
    # temperature intentionally missing

    cough      => 1,
    sore_throat => 1,
    fatigue    => 1,
    rash       => 0,

    # temperature: inferred from skin_temp via _NEEDED (level 1)
    temperature => {
        _NEEDED => sub {
            my $st = $SELF->skin_temp;
            return 39.5 if defined $st && $st eq 'hot';
            return 36.6 if defined $st && $st eq 'normal';
            return 35.5 if defined $st && $st eq 'cold';
            return undef;
        },
    },

    # fever_grade: inferred from temperature via _NEEDED (level 2)
    fever_grade => {
        _NEEDED => sub {
            my $t = $SELF->temperature;   # may itself trigger level-1 _NEEDED
            return undef unless defined $t;
            return 'high' if $t >= 39.0;
            return 'low'  if $t >= 37.5;
            return 'none';
        },
    },
);

# ---------------------------------------------------------------------------
# Agent 1 — Collect
# Ensures derived slots are materialised on the patient frame.
# Rules load from YAML; each rule sets one derived slot if absent.
# Tagged _LOCK_UNTIL_STABLE: Agent 2 is skipped while this agent succeeds.
# ---------------------------------------------------------------------------