OberonCore https://forum.oberoncore.ru/ |
|
Задачка с ACM https://forum.oberoncore.ru/viewtopic.php?f=8&t=409 |
Страница 1 из 1 |
Автор: | Илья Ермаков [ Суббота, 17 Март, 2007 21:37 ] |
Заголовок сообщения: | Задачка с ACM |
На 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. |
Страница 1 из 1 | Часовой пояс: UTC + 3 часа |
Powered by phpBB® Forum Software © phpBB Group https://www.phpbb.com/ |