Описание
Алхимик Петя изобрел философский камень, с использованием которого можно проводить некоторое множество алхимических реакций по превращению одних веществ в другие. Масса вещества, которое подвергается превращению, и масса каждого образующегося в результате реакции вещества составляет ровно один грамм. Закон сохранения массы при этом может нарушаться, поскольку Пете он неизвестен

Изначально у Пети имеется один грамм свинца. С помощью философского камня Петя может превратить свой свинец в другие вещества, на которые он потом также сможет воздействовать философским камнем. Выполняя одну за другой алхимические реакции, Петя стремится получить как можно больше золота

Задание
Требуется написать программу, определяющую по заданному описанию алхимических реакций, выполняемых философским камнем, наибольшее количество золота, которое может получить Петя


Входные данные
В первой строке входного файла записано целое число К - количество различных веществ, участвующих и образующихся в алхимических реакциях (2
K100). Вторая строка содержит названия этих веществ, разделенные пробелом (в списке обязательно есть свинец и золото). Названия веществ не длиннее 10 букв. В третьей строке записано целое число L - количество типов реакций, выполняемых философским камнем (1L100). Далее идут L описаний этих реакций. Каждое описание реакции состоит из двух строк: первая строка содержит название вещества, которое подвергается превращению, вторая - названия веществ, получающихся в результате реакции

Выходные данные
Ваша программа должна вывести в выходной файл либо одно целое число - искомое количество граммов золота, либо сообщение "QUANTUM SATIS" (сколько нужно), если Петя может получить любое наперед заданное количество золота


Например:

GOLDRUSH.IN
4
свинец золото рога копыта
3
свинец
золото рога копыта
рога
золото копыта
копыта
золото

GOLDRUSH
.OUT
4





Идеи
Транзитивное замыкание, конденсация графа, обход в глубину, динамическое программирование

Комментарии
Построим ориентированный граф G, вершины которого соответствуют заданным веществам, а ребра - возможности получить из одного вещества другое с помощью какой-либо из реакций. Скажем, что из вещества А можно косвенно получить вещество В, если существует такая цепочка реакций, которая из одного грамма А производит какое-то количество вещества В (или, говоря в терминах графа G, существует путь из вершины А в вершину В). Назовем максимумом А максимальное количество грамм вещества А, которое Петя может получить из одного грамма свинца. Если максимум А равен нулю, будем называть вещество А нулевым. Наконец, вещество А будем называть бесконечным, если его максимум неограничен

Первым делом определим все нулевые и бесконечные вещества. Очевидно, что нулевыми веществами будут те, которые не могут быть косвенно получены из свинца. Утверждается, что вещество В может быть бесконечным только в следующих двух случаях:

  1. Существует такое бесконечное А, что В косвенно из него получается

  2. Существует такое ненулевое вещество А, что с помощью одной из реакций можно получить из него В и еще какие-то В1,B2,...,Вk и существует i такое, что из В, косвенно получается А

Таким образом, для нахождения всех нулевых и бесконечных веществ достаточно вычислить матрицу достижимостей графа G [Кристофидес 78, п.2.2] с помощью рефлексивного транзитивного замыкания его матрицы смежности [Липский 88, п.3.5]. Если золото оказалось среди нулевых или бесконечных веществ, то ответ на задачу найден. В противном случае выбросим из графа G все вершины, соответствующие таким веществам, и все ребра, им инцидентные. Теперь определим максимум для каждого из оставшихся веществ

Заметим, что если из вещества А можно косвенно получить вещество В, а из вещества В можно косвенно получить вещество А (или, в терминах графа G, если вершины А и В лежат в одной компоненте сильной связности), то максимумы А и В совпадают. Разобьем все оставшиеся вещества по этому признаку на классы эквивалентности. Построим конденсацию G1 графа G [Кристофидес 78, п.2.3], вершинами которой эти классы эквивалентности будут являться. При этом мы оставляем в рассмотрении лишь те реакции, которые приводят к получению веществ из других классов, нежели вещество, вступающее в реакцию.

Определим для каждой вершины Аi, конденсации G1 максимальное количество золота, которое можно получить из одного грамма Аi, т.е. из одного грамма любого из веществ этого класса. Тогда ответом на исходную задачу будет являться значение для класса, в котором содержится свинец

Если Аi - это класс, содержащий золото, то искомое значение равно единице. В противном случае оно может быть вычислено рекурсивно с использованием метода динамического программирования. А именно, перебираем все реакции Rij, которые можно провести с веществами из класса Ai;. Для каждой реакции Rij рекурсивно подсчитываем максимальное количество золота для каждого из веществ, получающегося в результате этой реакции, и вычисляем сумму этих количеств. Далее выбираем максимальную из найденных сумм по всем возможным j. Это число и будет искомым значением для класса Аi


Упражнение
Докажите самостоятельно утверждение о бесконечном веществе



 


Решение

{$A+,B-,D+,E-,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}

{$M 65520,0,655360}

program goldrush
;
Const

  MaxK=100;
  MaxL=100;
  MaxLen=12;
  FlagAdd=1000000000;
  MaxLong=16;
Type
  TReactArr=Array[1..MaxK]Of Record
    Src:Byte;
    Dst:Array[1..MaxK]Of Boolean;
  End;
  TLong=Array[1..MaxLong]Of Word;
Var
  Infinity:TLong;
  K:Byte;
  L:Byte;
  Name:Array[1..MaxK]Of String[MaxLen];
  React,RSave:TReactArr;
  HowMany:Array[1..MaxK]Of TLong;
  Was:Array[1..MaxK]Of Boolean;
  Plumbum,Aurum:Byte;
  Result:TLong;

Procedure
LongOne(Var L:TLong);
Begin
  FillChar(L,SizeOf(L),0);
  L[MaxLong]:=1;
End;

Procedure
LongZero(Var L:TLong);
Begin
  FillChar(L,SizeOf(L),0);
End;

Procedure
LongAdd(Var A,B:TLong);
Var
  R,P,I:LongInt;
Begin
  P:=0;
  For I:=MaxLong DownTo 1 Do Begin
    R:=A[I]+B[I]+P;
    If R>=10000 Then Begin
      A[I]:=R-10000;
      P:=1;
    End Else Begin
      A[I]:=R;
      P:=0;
    End;
  End;
End;

Function
Compare(Var A,B:TLong):ShortInt;
Var
  I:Byte;
Begin
  For I:=1 To MaxLong Do
    If A[I]Then Begin Compare:=-1; Exit; End Else If A[I]>B[I] Then Begin Compare:=1; Exit; End;
  Compare:=0;
End;

Function
GreaterZero(Var L:TLong):Boolean;
Var
  I:Byte;
Begin
  GreaterZero:=True;
  For I:=1 To MaxLong Do If L[I]>0 Then Exit;
  GreaterZero:=False;
End;

Procedure
WriteLong(Var L:TLong);
Var
  I:Byte;
Begin
  For I:=1 To MaxLong Do If L[I]>0 Then Break;
  Write(L[I]);
  For I:=I+1 To MaxLong Do Begin
    If L[I]<1000 Then Write('0');
    If L[I]<100 Then Write('0');
    If L[I]<10 Then Write('0');
    Write(L[I]);
  End;
  WriteLn;
End;

Function
UpCase(C:Char):Char;
Begin
  Case C Of
    ' '..'¯':Dec(C,32);
    'à'..'ï':Dec(C,80);
    'a'..'z':Dec(C,32);
  End;
  UpCase:=C;
End;

Function
SCompare(Var S1,S2:String):Boolean;
Var
  I:Byte;
Begin
  SCompare:=False;
  For I:=1 To Length(S1) Do If UpCase(S1[I])<>UpCase(S2[I]) Then Exit;
  SCompare:=True;
End;

Function
Which(S:String):Byte;
Var
  I:Byte;
Begin
  For I:=1 To K Do If SCompare(S,Name[I]) Then Begin Which:=I; Exit; End;
  Which:=0;
End;

Procedure
Load;
Var
  C:Char;
  S:String;
  I,J:Byte;
  Buf:Pointer;
Begin
  Assign(Input,'
goldrush.in');
  ReSet(Input);
  GetMem(Buf,65535);
  SetTextBuf(Input,Buf^,65534);
  ReadLn(K);
  J:=1;
  S:='';
  While Not EOLN Do Begin
    Read(C);
    If C=' ' Then Begin
      If S<>'' Then Begin
        Name[J]:=S;
        Inc(J);
        S:='';
      End;
    End Else S:=S+C;
  End;
  If S<>'' Then Name[J]:=S;
  ReadLn;
  ReadLn(L);
  For I:=1 To L Do Begin
    ReadLn(S);
    React[I].Src:=Which(S);
    FillChar(React[I].Dst,SizeOf(React[I].Dst),False);
    S:='';
    While Not EOLN Do Begin
      Read(C);
      If C=' ' Then Begin
        If S<>'' Then Begin
          React[I].Dst[Which(S)]:=True;
          S:='';
        End;
      End Else S:=S+C;
    End;
    If S<>'' Then React[I].Dst[Which(S)]:=True;
    ReadLn;
  End;
  Close(Input);
  FreeMem(Buf,65535);
  Plumbum:=Which('свинец');
  Aurum:=Which('золото');
End;

Procedure
Run;
Var
  Stack:Array[1..MaxK+1]Of Byte;
  CC,LL:TLong;
  F:Byte;

Procedure
Count(A,Gl:Byte; Var Result:TLong; Var Flag:Byte);
Var
  Max,Sum,Res:TLong;
  I,J,II,JJ:Byte;
  BadSet,CorrSet:Set Of Byte;
  Infin:Set Of Byte;
  BadNum:Byte;
  InMul:Boolean;
Label StartIt,DelCycle;
Begin
  Stack[Gl]:=A;
  Flag:=0;
  For I:=1 To Gl-1 Do If Stack[I]=A Then Begin
    Flag:=A;
    Exit;
  End;
  If (Gl>1) And Was[A] Then Result:=HowMany[A] Else Begin
    InMul:=False;
    Goto StartIt;
    DelCycle:
    BadSet:=[A];
    CorrSet:=[A];
    InFin:=[];
    For I:=Gl To K Do If Stack[I+1]=A Then Break Else Include(BadSet,Stack[I+1]);
    For II:=1 To L Do If React[II].Src In BadSet Then Begin
      BadNum:=0;
      For JJ:=1 To K Do If React[II].Dst[JJ] And (JJ In BadSet) Then Inc(BadNum);
      If BadNum>0 Then Begin
        For JJ:=1 To K Do If React[II].Dst[JJ] And (Not (JJ In BadSet) Or (BadNum>1)) Then Begin
          If JJ In BadSet Then InFin:=InFin+[A] Else InFin:=InFin+[JJ];
        End;
        If React[II].Src In CorrSet Then React[II].Src:=0 Else Begin
          FillChar(React[II].Dst,SizeOf(React[II].Dst),False);
          React[II].Dst[A]:=True;
          Include(CorrSet,React[II].Src);
        End;
      End Else React[II].Src:=A;
    End;
    If Aurum In BadSet Then Begin
      Aurum:=A;
      If A In InFin Then Begin Result:=Infinity; HowMany[A]:=Infinity; Exit; End;
      LongOne(HowMany[A]);
      LongOne(Result);
      Exit;
    End;
    For I:=1 To K Do If I In InFin Then
      If I=A Then InMul:=True Else Begin
        Count(I,Gl+1,Res,Flag);
        If (Flag=0) And GreaterZero(Res) Then Begin Result:=Infinity; HowMany[A]:=Infinity; Exit; End;
        Flag:=0;
      End;
    StartIt:
    Was[A]:=True;
    LongZero(Max);
    For I:=1 To L Do If React[I].Src=A Then Begin
      LongZero(Sum);
      For J:=1 To K Do If React[I].Dst[J] Then Begin
        Count(J,Gl+1,Res,Flag);
        If Compare(Res,Infinity)=0 Then Begin Result:=Infinity; HowMany[A]:=Infinity; Exit; End;
        If Flag>0 Then Begin
          If Flag=A Then Begin
            Goto DelCycle;
          End Else Begin Result:=Res; Exit; End;
        End;
        If GreaterZero(Res) And InMul Then Begin HowMany[A]:=Infinity; Result:=Infinity; Exit; End;
        LongAdd(Sum,Res);
      End;
      If Compare(Sum,Max)>0 Then Max:=Sum;
    End;
    HowMany[A]:=Max;
    Result:=Max;
  End;
End;

Begin

  FillChar(Infinity,SizeOf(Infinity),39);
  FillChar(HowMany,SizeOf(HowMany),0);
  FillChar(Was,SizeOf(Was),False);
  Was[Aurum]:=True;
  LongOne(HowMany[Aurum]);
  RSave:=React;
  Count(Aurum,1,CC,F);
  LongOne(LL);
  If Compare(CC,LL)>0 Then Begin
    FillChar(HowMany,SizeOf(HowMany),0);
    FillChar(Was,SizeOf(Was),False);
    Was[Aurum]:=True;
    LongOne(HowMany[Aurum]);
    React:=RSave;
    Count(Plumbum,1,Result,F);
    If GreaterZero(Result) Then Result:=Infinity;
  End Else Begin
    FillChar(HowMany,SizeOf(HowMany),0);
    FillChar(Was,SizeOf(Was),False);
    Was[Aurum]:=True;
    LongOne(HowMany[Aurum]);
    React:=RSave;
    Count(Plumbum,1,Result,F)
  End;
End;

Procedure
Save;
Begin
  Assign(Output,'
goldrush.out');
  ReWrite(Output);
  If Compare(Result,Infinity)=0 Then WriteLn('QUANTUM SATIS') Else WriteLong(Result);
  Close(Output);
End;

Begin

  Load;
  Run;
  Save;
End.


 


© Особенности национальных задач по информатике