На 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.