На DelphiKingdom разгорелся спор, можно ли решать олимпиадные задачи  на Хаскелле лучше, чем на Паскале.
Одна из задач с недавнего мирового первенства ACM была решена на Хаскелле.
http://delphikingdom.com/asp/talktopic. ... 54#msg3254
http://delphikingdom.com/asp/talktopic. ... 95#msg2095

"Наш ответ Чемберленам" не замедлил воспоследовать. Выкладываю решение здесь, т.к. там у форума проблемы с форматированием табуляцией...

Для ввода/вывода использовал подсистему Info21olimp.

## Код:
```
(*
Первая задача из списка задач олимпиады %url[ACM ICPC 2007 Final] http://icpc.baylor.edu/icpc/Finals/2007WorldFinalProblemSet.pdf
"Problem A+. Consanguine Calculations"

Задача А+


Анализ кровнородственности


Входной файл: blood.in


  Кровь любого человека имеет 2 маркера, называемых ABO-аллелями. Каждый маркер представляется одной из трёх букв: A, B или O. Это даёт шесть возможных комбинаций аллелей, которые могут быть у человека, каждая из которых может характеризовать группу крови ABO этого человека.

Комбинация    Группа крови ABO
~~~~~~~~~~    ~~~~~~~~~~~~~~~~
    AA                A
    AB                AB
    AO                A
    BB                B
    BO                B
    OO                O

  Также каждый человек имеет две аллели резус-фактора крови Rh, представленных символами + и -. У тех, у кого Rh-положительный (Rh+), имеется от одной до двух аллелей +. У тех, у кого Rh-отрицательный, обе аллели всегда -.

  Тип крови человека - это комбинация группы крови ABO и резус-фактора Rh. Тип крови записывается обозначением группы крови с суффиксом + или -, обозначающим резус-фактор, например, A+, AB-, O-.

  Типы крови наследуются - каждый биологический родитель передаёт своему ребёнку одну ABO-аллель (случайно выбираемую из его двух) и одну аллель резус-фактора. Таким образом, две ABO-аллели и две аллели резус-фактора родителей определяют тип крови ребёнка. Например, если оба родителя имеют тип крови А-, то ребёнок может иметь любой из двух типов: А- или О-. У родителей с типами А+ и В+ ребёнок может иметь любой тип крови.

  В этой задаче даются типы крови обоих родителей или одного из родителей и ребёнка; требуется получить (возможно пустое) множество типов крови, которые могут быть у ребёнка или у другого родителя.

  Примечание: прописная буква "О" используется в этой задаче для обозначения типа крови, а не цифры 0.

  Входные данные:
  ~~~~~~~~~~~~~~~

  Входные данные состоят из множества тестовых вариантов. Каждый вариант - это одна строка в таком формате: тип крови одного родителя, тип крови другого родителя и, наконец, тип крови ребёнка, за исключением того, что тип крови одного из родителей или ребёнка заменяется знаком вопроса. Для улучшения читаемости в любом месте строки может быть помещён пробел, за исключением спецификации типа крови.

  За последний тестовым вариантом следует строка с буквами "E", "N" и "D", разделёнными пробелами.

  Выходные данные:
  ~~~~~~~~~~~~~~~~

  Для каждого тестового варианта требуется распечатать номер теста (начинающегося с 1) и типы крови родителей и ребёнка. Если нет возможного для родителя типа крови, распечатать “IMPOSSIBLE”. Если для родителей или ребёнка возможны несколько вариантов типов крови, распечатать все возможные варианты в виде списка значения, разделённых запятыми, и заключённого в фигурные скобки.

  Пример вывода иллюстрирует несколько выходных форматов. Ваш формат вывода должен быть похожим.

  Sample Input        Output for the Sample Input
  ~~~~~~~~~~~~        ~~~~~~~~~~~~~~~~~~~~~~~~~~~

  O+ O- ?            Case 1: O+ O- {O+, O-}
  O+ ? O-            Case 2: O+ {A-, A+, B-, B+, O-, O+} O-
  AB- AB+ ?          Case 3: AB- AB+ {A+, A-, B+, B-, AB+, AB-}
  AB+ ? O+            Case 4: AB+ IMPOSSIBLE O+
  E N D

*)

MODULE OlimpBlood;

   IMPORT In := Info21olimpIn, Out := Info21olimpOut, Strings;

   CONST
      (* аллели *)
      aA = 0; aB = 1; aO = 2;
      (* группы крови *)
      gA = 0; gAB = 1; gB = 2; gO = 3;
      rP = 4; rM = 5;
   
   TYPE
      CorrelateMap = ARRAY 4, 4 OF SET;
   
   VAR
      directMap: CorrelateMap; (* карта решений в прямом направлении
         directMap[группаРод1, группаРод2] = множество возможностей для ребенка *)
      inverseMap: CorrelateMap; (* карта решений в обратном направлении
         inverseMap[группаРод1, группаРебенка] = множество возможностей для родителя2 *)
      strMap: ARRAY ORD({gA, gAB, gB, gO, rP, rM})+1 OF ARRAY 128 OF CHAR;
         (* карта отображения решений SET -> string *)
   
   PROCEDURE Alleles (group: INTEGER): SET;
      (* IN группа крови RETURN состав аллелей *)
   BEGIN
      CASE group OF gA: RETURN {aA, aO} | gAB: RETURN {aA, aB}
      | gB: RETURN {aB, aO} | gO: RETURN {aO}
      END
   END Alleles;
   
   PROCEDURE GroupAbilities (alleles1, alleles2: SET): SET;
      (* IN аллели род1, аллели род2 RETURN возможные типы крови ребенка *)
      VAR g: INTEGER;
            res: SET;
   BEGIN
      res := {};
      FOR g := gA TO gO DO
         CASE g OF
         | gA: IF (aA IN alleles1 * alleles2) OR (* AA *)
                  (aA IN alleles1) & (aO IN alleles2) OR (* AO *)
                  (aO IN alleles1) & (aA IN alleles2) (* OA *) THEN
                     INCL(res, gA)
               END
         | gAB: IF (aA IN alleles1) & (aB IN alleles2) OR (* AB *)
                  (aB IN alleles1) & (aA IN alleles2) (* BA *) THEN
                     INCL(res, gAB)
               END
         | gB: IF (aB IN alleles1 * alleles2) OR (* BB *)
                  (aB IN alleles1) & (aO IN alleles2) OR (* BO *)
                  (aO IN alleles1) & (aB IN alleles2) (* OB *) THEN
                     INCL(res, gB)
               END
         | gO: IF (aO IN alleles1 * alleles2) (* OO *) THEN
                  INCL(res, gO)
               END
         END
      END;
      RETURN res
   END GroupAbilities;
   
   PROCEDURE InitDirectMap;
      VAR g1, g2: INTEGER;
   BEGIN
      FOR g1 := gA TO gO DO
         FOR g2 := gA TO gO DO
            directMap[g1, g2] := GroupAbilities(Alleles(g1), Alleles(g2))
         END
      END
   END InitDirectMap;
   
   PROCEDURE InitInverseMap;
      VAR g1, gx: INTEGER;
      PROCEDURE FillCell;
         VAR g2: INTEGER;
      BEGIN
         FOR g2 := gA TO gO DO
            IF gx IN directMap[g1, g2] THEN
               INCL(inverseMap[g1, gx], g2)
            END
         END
      END FillCell;
   BEGIN
      FOR g1 := gA TO gO DO
         FOR gx := gA TO gO DO
            FillCell
         END
      END   
   END InitInverseMap;
   
   PROCEDURE ResusAbilities (r1, r2: INTEGER): SET;
      (* IN резус род1, резус род2 RETURN возможные резусы ребенка *)
   BEGIN
      IF (r1 = rM) & (r2 = rM) THEN RETURN {rM}
      ELSE RETURN {rP, rM}
      END
   END ResusAbilities;
   
   PROCEDURE ResusInverseAbilities (r1, rx: INTEGER): SET;
      (* IN резус род1 резус ребенка RETURN возможные резусы второго родителя *)
   BEGIN
      IF (rx = rP) & (r1 = rM) THEN RETURN {rP}
      ELSE RETURN {rM, rP}
      END
   END ResusInverseAbilities;
   
   PROCEDURE SolveDirect (g1, r1, g2, r2: INTEGER): SET;
      (* IN группа и резус каждого родителя RETURN возможные типы крови ребенка *)
   BEGIN
      RETURN directMap[g1, g2] + ResusAbilities(r1, r2)
   END SolveDirect;
   
   PROCEDURE SolveInverse (g1, r1, gx, rx: INTEGER): SET;
      (* IN группа и резус род1 группа и резус ребенка RETURN возможные типы крови второго родителя *)
   BEGIN
      RETURN inverseMap[g1, gx] + ResusInverseAbilities(r1, rx)
   END SolveInverse;
   
   PROCEDURE ExtractCase (IN s: ARRAY OF CHAR; OUT groups, resuses: ARRAY OF INTEGER);
      VAR i, j: INTEGER;
      PROCEDURE ReadElem;
      BEGIN
         CASE s[i] OF
         | '?': groups[j] := -1
         | 'A': IF s[i+1] = 'B' THEN groups[j] := gAB; INC(i, 2) ELSE groups[j] := gA; INC(i) END
         | 'B': groups[j] := gB; INC(i)
         | 'O': groups[j] := gO; INC(i)
         END;
         CASE s[i] OF
         | '?': resuses[j] := -1
         | '+': resuses[j] := rP
         | '-': resuses[j] := rM
         END;         
         INC(i); INC(j)
      END ReadElem;
   BEGIN
      i := 0; j := 0;
      WHILE s[i] = " " DO INC(i) END; ASSERT(s[i] # 0X, 20); ReadElem;
      WHILE s[i] = " " DO INC(i) END; ASSERT(s[i] # 0X, 20); ReadElem;
      WHILE s[i] = " " DO INC(i) END; ASSERT(s[i] # 0X, 20); ReadElem
   END ExtractCase;
   
   PROCEDURE BloodToStr (g, r: INTEGER; OUT str: ARRAY OF CHAR);
   BEGIN
      CASE g OF gA: str := "A" | gAB: str := "AB" | gB: str := "B" | gO: str := "O" END;
      CASE r OF rP: str := str + "+" | rM: str := str + "-" END
   END BloodToStr;
   
   PROCEDURE AbilitiesToStrEnd (ab: SET; OUT str: ARRAY OF CHAR);
      VAR i0, g, cnt: INTEGER;
            s: ARRAY 4 OF CHAR;
   BEGIN
      i0 := LEN(str$);
      cnt := 0;
      FOR g := gA TO gO DO
         IF g IN ab THEN
            IF rP IN ab THEN INC(cnt); BloodToStr(g, rP, s); str := str + ", " + s END;
            IF rM IN ab THEN INC(cnt); BloodToStr(g, rM, s); str := str + ", " + s END
         END
      END;
      IF cnt = 0 THEN
         str[i0] := 0X; str := str + "IMPOSSIBLE"
      ELSIF cnt = 1 THEN
         str[i0] := 0X; str := str + s
      ELSE
         str[i0] := "{"; str := str + "}"
      END
   END AbilitiesToStrEnd;
   
   PROCEDURE InitStrMap;
      VAR a: INTEGER;
   BEGIN
      FOR a := 0 TO ORD({gA, gAB, gB, gO, rP, rM}) DO
         AbilitiesToStrEnd(BITS(a), strMap[a])
      END
   END InitStrMap;
   
   PROCEDURE SolveCase (IN istr: ARRAY OF CHAR; OUT ostr: ARRAY OF CHAR);
      VAR groups: ARRAY 3 OF INTEGER;
            resuses: ARRAY 3 OF INTEGER;
            res: SET;
            s: ARRAY 4 OF CHAR;
   BEGIN
      ExtractCase(istr, groups, resuses);
      IF (groups[0] # -1) & (groups[1] # -1) THEN
         res := SolveDirect(groups[0], resuses[0], groups[1], resuses[1]);
         BloodToStr(groups[0], resuses[0], s);
         ostr := s$;
         BloodToStr(groups[1], resuses[1], s);
         ostr := ostr + " " + s + " ";
         AbilitiesToStrEnd(res, ostr)
      ELSIF groups[0] # -1 THEN
         res := SolveInverse(groups[0], resuses[0], groups[2], resuses[2]);
         BloodToStr(groups[0], resuses[0], s);
         ostr := s$ + " ";
         AbilitiesToStrEnd(res, ostr);
         BloodToStr(groups[2], resuses[2], s);
         ostr := ostr + " " + s
      ELSIF groups[1] # -1 THEN
         res := SolveInverse(groups[1], resuses[1], groups[2], resuses[2]);
         ostr := "";
         AbilitiesToStrEnd(res, ostr);
         BloodToStr(groups[1], resuses[1], s);
         ostr := ostr + " " + s;
         BloodToStr(groups[2], resuses[2], s);
         ostr := ostr + " " + s
      END
   END SolveCase;
   
   PROCEDURE Do;
      VAR s, outs: ARRAY 256 OF CHAR;
            line: INTEGER;
            end: BOOLEAN;
      PROCEDURE GetLine;
         VAR i: INTEGER;
      BEGIN
         IF ~In.done THEN
            end := TRUE
         ELSE
            INC(line);
            i := 0; In.Char(s[0]);
            WHILE In.done & (s[i] # 0DX) & (s[i] # "E") DO
               INC(i); In.Char(s[i])
            END;
            IF s[i] = "E" THEN
               end := TRUE
            END;
            s[i] := 0X; IF In.done THEN In.Char(s[i+1]) END
         END
      END GetLine;
   BEGIN
      end := FALSE; line := 0;
      GetLine;
      WHILE ~end DO
         Strings.IntToString(line, outs);
         outs := "Case " + outs + ":" + " ";
         Out.String(outs);
         SolveCase(s, outs);
         Out.String(outs); Out.Ln;
         GetLine
      END
   END Do;
   
   PROCEDURE Main* ;
   BEGIN
      In.Open('blood.in'); Out.Open('blood.out'); Do
   END Main;
   
   PROCEDURE Test* ;
   BEGIN
      In.Open("blood.in"); Out.Open(""); Do
   END Test;

BEGIN
   InitDirectMap;
   InitInverseMap;
   InitStrMap
END OlimpBlood.
```
