program BiddingProbabilities(output);

const
  MaxBranch = 4; MaxNode = 6; NumSVariables = 4;
  BID = 1; CBID = 2; MANUFACTURE = 3; COST = 4;
  CHANCE = 1; DECISION = 2; ENDPOINT = 3; AUXILIARY = 4;
  Ns = 10; Xl = -10000000.0; Xh = 40000000.0;
  INFINITY = 1.0e30;

type
  State = array[1 .. NumSVariables] of real;
  ProbArray = array[0 .. Ns] of real;

var
  j  : integer;
  b, t, v  : array[1 .. MaxNode] of integer;
  s  : State;

function u(x : real) : real; begin
  u := x
end;

function f(i, j : integer; var s : State) : real; begin
  case i of
    1 : case j of
          1 : f := 9500.0;
          2 : f := 8500.0;
          3 : f := 7500.0;
          4 : f :=    0.0;
        end;
    2 : case j of
          1 : f := 10000.0;
          2 : f :=  9000.0;
          3 : f :=  8000.0;
        end;
    3 : f := j;
    4 : case j of
          1 : f := 8500.0;
          2 : f := 7500.0;
          3 : f := 5000.0;
        end;
    5 : f := 8000.0;
    6 : if s[BID] = 0.0 then f := 0.0
        else if s[BID] < s[CBID]
          then f := 10000.0 * (s[BID] - s[COST]) - 1000000.0
        else f := -1000000.0
  end
end;

function n(i, j : integer; var s : State) : integer; begin
  case i of
    1    : if j <= 3 then n := 2 else n := 6;
    2    : if s[BID] < s[CBID] then n := 3 else n := 6;
    3    : if j = 1 then n := 4 else n := 5;
    4, 5 : n := 6
  end
end;

function p(i, j : integer; var s : State) : real; begin
  case i of
    2 : p := 1.0/3.0;
    4 : case j of
          1, 3 : p := 0.25;
          2    : p := 0.50;
        end
  end
end;

function EU(i : integer; var Prob : ProbArray; var s : State) : real;
  var
    j, k : integer;
    NewEU, TryEU : real;
    branchP, x : real;
    Pnext : ProbArray;
  begin
    case t[i] of
      CHANCE : begin
                 NewEU := 0.0;
                 for k := 0 to Ns do Prob[k] := 0.0;
                 for j := 1 to b[i] do begin
                   s[v[i]] := f(i, j, s);
                   branchP := p(i, j, s);
                   NewEU := NewEU + branchP * EU(n(i, j, s), Pnext, s);
                   for k := 0 to Ns do 
                     Prob[k] := Prob[k] + branchP * Pnext[k]
                 end;
                 EU := NewEU
               end;
      DECISION : begin
                   NewEU := -INFINITY;
                   for j := 1 to b[i] do begin
                     s[v[i]] := f(i, j, s);
                     TryEU := EU(n(i, j, s), Pnext, s);
                     if TryEU > NewEU then begin
                       NewEU := TryEU;
                       for k := 0 to Ns do Prob[k] := Pnext[k]
                     end;
                   end;
                   EU := NewEU
                 end;
      ENDPOINT : begin
                   for k := 0 to Ns do Prob[k] := 0.0;
                   x := f(i, 1, s);
                   k := trunc(Ns * (x - Xl) / (Xh - Xl));
                   if k < 0 then k := 0
                   else if k > Ns then k := Ns;
                   Prob[k] := 1.0;
                   EU := u(x)
                 end;
      AUXILIARY : begin
                    s[v[i]] := f(i, 1, s);
                    NewEU := EU(n(i, 1, s), Pnext, s);
                    for k := 0 to Ns do Prob[k] := Pnext[k];
                    EU := NewEU
                  end
    end
end;

procedure EvalDecNode(i : integer; var s : State);
  var
    j, k : integer;
    MaxEU : real;
    HoldEU : array[1 .. MaxBranch] of real;
    x : real;
    Prob, Pnext : ProbArray;
  begin
    MaxEU := -INFINITY;
    for j := 1 to b[i] do begin
      s[v[i]] := f(i, j, s);
      HoldEU[j]  := EU(n(i, j, s), Pnext, s);
      if HoldEU[j] > MaxEU then begin
        MaxEU := HoldEU[j];
        for k := 0 to Ns do Prob[k] := Pnext[k]
      end;
    end;
    writeln('Exp. Utility = ', MaxEU:12:3);
    writeln('Branch  Exp. Utility');
    for j := 1 to b[i] do begin
      write(j:4, HoldEU[j]:16:3);
      if HoldEU[j] = MaxEU then writeln(' <--') else writeln
    end;
    writeln;
    writeln('           Level      Probability');
    for k := 0 to Ns do begin
      x := k * (Xh - Xl) / Ns + Xl;
      writeln(x:20:3, Prob[k]:10:3)
    end
end;

begin {main program}
  b[1] := 4; b[2] := 3; b[3] := 2; b[4] := 3;
  t[1] := DECISION; t[2] := CHANCE; t[3] := DECISION;
    t[4] := CHANCE; t[5] := AUXILIARY; t[6] := ENDPOINT;
  v[1] := BID; v[2] := CBID; v[3] := MANUFACTURE;
    v[4] := COST; v[5] := COST;
  EvalDecNode(1, s)
end.