$ include "seed7_05.s7i";

const type: preferences is hash [string] array string;
const type: engaged is hash [string] string;

const func integer: pos (in array string: area, in string: searched) is func
  result
    var integer: pos is 1;
  begin
    while pos <= length(area) and area[pos] <> searched do
      incr(pos);
    end while;
    if pos > length(area) then
      pos := 0;
    end if;
  end func;

const func engaged: matchmaker (in preferences: guyPrefers, in preferences: girlPrefers) is func
  result
    var engaged: engagedTo is engaged.value;
  local
    var array string: freeGuys is 0 times "";
    var string: guy is "";
    var string: girl is "";
    var string: fiance is "";
    var array string: guyPreferencList is 0 times "";
    var array string: girlPreferenceList is 0 times "";
    var boolean: searching is TRUE;
  begin
    freeGuys := sort(keys(guyPrefers));
    while length(freeGuys) <> 0 do
      guy := freeGuys[1];
      freeGuys := freeGuys[2 ..];
      guyPreferencList := guyPrefers[guy];
      searching := TRUE;
      while searching and length(guyPreferencList) <> 0 do
        girl := guyPreferencList[1];
        guyPreferencList := guyPreferencList[2 ..];
        if girl not in engagedTo then
          engagedTo @:= [girl] guy;
          writeln("  " <& girl <& " and " <& guy);
          searching := FALSE;
        else
          fiance := engagedTo[girl];
          girlPreferenceList := girlPrefers[girl];
          if pos(girlPreferenceList, guy) < pos(girlPreferenceList, fiance) then
            # She prefers new guy
            engagedTo @:= [girl] guy;
            freeGuys &:= fiance;
            writeln("  " <& girl <& " dumped " <& fiance <& " for " <& guy);
            searching := FALSE;
          end if;
        end if;
      end while;
    end while;
  end func;

const func boolean: check (in engaged: engagedTo,
    in preferences: guyPrefers, in preferences: girlPrefers) is func
  result
    var boolean: stable is TRUE;
  local
    var string: he is "";
    var string: she is "";
    var string: guy is "";
    var string: girl is "";
    var engaged: inverseEngaged is engaged.value;
    var array string: sheLikes is 0 times "";
    var array string: sheLikesBetter is 0 times "";
    var array string: heLikes is 0 times "";
    var array string: heLikesBetter is 0 times "";
    var string: guysGirl is "";
    var array string: guyLikes is 0 times "";
    var string: girlsGuy is "";
    var array string: girlLikes is 0 times "";
  begin
    for he key she range engagedTo do
      inverseEngaged @:= [he] she;
    end for;
    for he key she range engagedTo do
      sheLikes := girlPrefers[she];
      sheLikesBetter := sheLikes[.. pred(pos(sheLikes, he))];
      heLikes := guyPrefers[he];
      heLikesBetter := heLikes[.. pred(pos(heLikes, she))];
      for guy range sheLikesBetter do
        guysGirl := inverseEngaged[guy];
        guyLikes := guyPrefers[guy];
        if pos(guyLikes, guysGirl) > pos(guyLikes, she) and stable then
          writeln(she <& " likes " <& guy <& " better than " <& he <& " and " <&
                  guy <& " likes " <& she <& " better than their current partner");
          stable := FALSE;
        end if;
      end for;
      for girl range heLikesBetter do
        girlsGuy := engagedTo[girl];
        girlLikes := girlPrefers[girl];
        if pos(girlLikes, girlsGuy) > pos(girlLikes, he) and stable then
          writeln(he <& " likes " <& girl <& " better than " <& she <& " and " <&
                  girl <& " likes " <& he <& " better than their current partner");
          stable := FALSE;
        end if;
      end for;
    end for;
  end func;

var preferences: guyPrefers is preferences.value;
var preferences: girlPrefers is preferences.value;
guyPrefers @:= ["abe"]  [] ("abi", "eve", "cath", "ivy", "jan", "dee", "fay", "bea", "hope", "gay");
guyPrefers @:= ["bob"]  [] ("cath", "hope", "abi", "dee", "eve", "fay", "bea", "jan", "ivy", "gay");
guyPrefers @:= ["col"]  [] ("hope", "eve", "abi", "dee", "bea", "fay", "ivy", "gay", "cath", "jan");
guyPrefers @:= ["dan"]  [] ("ivy", "fay", "dee", "gay", "hope", "eve", "jan", "bea", "cath", "abi");
guyPrefers @:= ["ed"]   [] ("jan", "dee", "bea", "cath", "fay", "eve", "abi", "ivy", "hope", "gay");
guyPrefers @:= ["fred"] [] ("bea", "abi", "dee", "gay", "eve", "ivy", "cath", "jan", "hope", "fay");
guyPrefers @:= ["gav"]  [] ("gay", "eve", "ivy", "bea", "cath", "abi", "dee", "hope", "jan", "fay");
guyPrefers @:= ["hal"]  [] ("abi", "eve", "hope", "fay", "ivy", "cath", "jan", "bea", "gay", "dee");
guyPrefers @:= ["ian"]  [] ("hope", "cath", "dee", "gay", "bea", "abi", "fay", "ivy", "jan", "eve");
guyPrefers @:= ["jon"]  [] ("abi", "fay", "jan", "gay", "eve", "bea", "dee", "cath", "ivy", "hope");
girlPrefers @:= ["abi"]  [] ("bob", "fred", "jon", "gav", "ian", "abe", "dan", "ed", "col", "hal");
girlPrefers @:= ["bea"]  [] ("bob", "abe", "col", "fred", "gav", "dan", "ian", "ed", "jon", "hal");
girlPrefers @:= ["cath"] [] ("fred", "bob", "ed", "gav", "hal", "col", "ian", "abe", "dan", "jon");
girlPrefers @:= ["dee"]  [] ("fred", "jon", "col", "abe", "ian", "hal", "gav", "dan", "bob", "ed");
girlPrefers @:= ["eve"]  [] ("jon", "hal", "fred", "dan", "abe", "gav", "col", "ed", "ian", "bob");
girlPrefers @:= ["fay"]  [] ("bob", "abe", "ed", "ian", "jon", "dan", "fred", "gav", "col", "hal");
girlPrefers @:= ["gay"]  [] ("jon", "gav", "hal", "fred", "bob", "abe", "col", "ed", "dan", "ian");
girlPrefers @:= ["hope"] [] ("gav", "jon", "bob", "abe", "ian", "dan", "hal", "ed", "col", "fred");
girlPrefers @:= ["ivy"]  [] ("ian", "col", "hal", "gav", "fred", "bob", "abe", "ed", "jon", "dan");
girlPrefers @:= ["jan"]  [] ("ed", "hal", "gav", "abe", "bob", "jon", "col", "ian", "fred", "dan");

const proc: main is func
  local
    var engaged: engagedTo is engaged.value;
    var string: girl is "";
  begin
    writeln("Matchmaking:");
    engagedTo := matchmaker(guyPrefers, girlPrefers);
    writeln;
    writeln("Engagements:");
    for girl range sort(keys(engagedTo)) do
      writeln("  " <& girl <& " and " <& engagedTo[girl]);
    end for;
    writeln;
    writeln("Marriages are " <& [] ("unstable", "stable") [succ(ord(check(engagedTo, guyPrefers, girlPrefers)))]);
    writeln;
    writeln("Perturb:");
    engagedTo @:= ["abi"] "fred";
    engagedTo @:= ["bea"] "jon";
    writeln("engage abi with fred and bea with jon");
    writeln;
    writeln("Marriages are " <& [] ("unstable", "stable") [succ(ord(check(engagedTo, guyPrefers, girlPrefers)))]);
  end func;