INFOMAN брой 5

{ This is then input data /an IFTHENELSE program/ :
100 IF a=b THEN 100 ELSE 101
101 IF h=s THEN 102 ELSE 103
102 IF c=d THEN 103 ELSE 104
103 IF e=f THEN 104 ELSE 105
104 IF g=h THEN 105 ELSE 106
105 IF i=j THEN 106 ELSE 113
106 IF k=l THEN 107 ELSE 112
107 IF m=n THEN 108 ELSE 111
108 IF o=p THEN 109 ELSE 110
109 RETURN(109)
110 RETURN(-110)
111 RETURN(111)
112 RETURN(-112)
113 IF x=a then 100 ELSE 114
114 RETURN(114)

                           ЕЗИКЪТ IFTHENELSE
                           -----------------

  В програмния език IFTHENELSE всеки ред представлява една от следните конст-
 рукции:
    <ред> IF <променлива>=<променлива> THEN <ред> ELSE <ред>
    <ред> RETURN(<цяло число>)
 където <ред> е номер на ред (цяло положително число),  <променлива> е малка
 латинска буква. Всеки ред на програма в езика IFTHENELSE започва с номер на
 реда и всички променливи са целочислени. Конструкцията IF ... THEN ... ELSE
 предизвиква преход към реда след думата THEN, ако е изпълнено условието или
 към реда след думата ELSE ако не е.  Командата RETURN прекратява програмата
 и връща като резултат числото в скобите. Програмата започва да се изпълнява
 от първия й ред и съдържа общо не повече от 20 реда.
  Входния файл съдържа произволна програма написана на този език. В изходния
 файл да се изведат всички възможни различни резултати от изпълнение на даде-
 ната програма.Към всеки резултат трябва да се запишат и стойностите на всич-
 ки променливи, участващи в програмата,при които се получава изведения резул-
 тат. Ако при някои стойности на променливите се получи зацикляне, вместо ре-
 зултат да се изведе "cycling".

  РЕШЕНИЕ: Ще решим задачата като трасираме дадената програма. При всяка кон-
 струкция IF a=b THEN .. ELSE .. ще проверяваме текущите отношения между про-
 менливите a и b. Ако променливите са равни, преминаваме към реда следващ ду-
 мата "THEN". Ако са различни, преминаваме към реда след думата "ELSE".  Ако
 за променливите не е дефинирано никакво отношение  (не равни и не са различ-
 ни), се пробват и двата варианта.  При първия те се правят равни (а това во-
 ди и до изравняване на всички променливи които са равни на едната с тези ко-
 ито са равни на другата) и се преминава рекурсивно към "THEN" реда. След то-
 ва се изследва и вторият вариант.  Променливите се отбелязват като различни
 и се изпълнява рекурсивно "ELSE" реда.  Когато при трасирането се стигне до
 ред с команда "RETURN", се проверява дали стойността,която трябва да се вър-
 не вече не е отпечатана.  Ако не е, тя се добавя в списъка на възможните ре-
 зултати от програмата и се отпечатва в резултатния файл.  Когато се трасира
 един ред, той се отбелязва като Used и ако при трасиране на програмата, про-
 дължило от този ред той пак се достигне,значи е намерен цикъл и ако вече не
 е намерен някакъв друг цикъл, той трябва да се отпечата.  Ако се попадне на
 ред, който не съществува в дадената програма, се отпечатва, че този ред лип-
 сва. За представяне на дадената програма в паметта се използва насочен граф.
 Върхове в този граф са всички редове, а ребра са всички възможни преходи от
 един ред към друг. Програмата на практика извършва почти пълно обхождане на
 графа в дълбочина по стандартния рекурсивен алгоритъм. Алгоритъмът не е пъл-
 но изчерпване, а някаква форма на Backtracking,защото на всяка стъпка не ви-
 наги се вземат двете възможни продължения,а само ако текущите отношения меж-
 ду променливите го позволяват. Понеже редовете в програмата са най-много 20,
 този алгоритъм решава задачата.  Освен това няма начин да се намерят всички
 възможни резултати без изчерпващ алгоритъм.  Отношенията между променливите
 са два вида - различност и еднаквост.  Това дали две променливи са различни
 може да се представи много лесно - с булева таблица. Промяната на такова от-
 ношение представлява само промяна на съответния елемент от таблицата. Обаче
 това дали две променливи са еднакви не може да се съхранява в таблица, защо-
 то когато се уеднакват две променливи,трябва да се уеднакват и всички равни
 на едната и на другата, а когато релацията еднаквост между тях трябва да из-
 чезне (тя се слага временно по време на рекурсивното трасиране), е нужно да
 се възстановят старите отношения такива, каквито са били преди уеднаквяване-
 то. Затова за представяне на отношението еднаквост строим насочена гора.  С
 Prev[v] отбелязваме предшественика на v или 0 ако няма.Две променливи са ед-
 накви, ако са в едно дърво от дадената гора.  Когато трябва да се уеднаквят
 две променливи, корена на дървото на едната става клон на корена на дървото
 на другата. Правилото,че две променливи са еднакви ако са в едно и също дър-
 во си остава.  Две променливи са в едно и също дърво ако имат един и същ ко-
 рен. Ако една променлива няма предшественик в така дефинираната гора, то ко-
 ренът й е същата променлива. Премахването на уеднаквяването на две променли-
 ви става също лесно  - чрез разделяне на двете дървета, които са били преди
 това обединени в едно. След като намерим даден резултат от програмата и тър-
 сим стойностите на променливите, при които той се получава, можем да използ-
 ваме следното правило: Ако две променливи са в едно дърво,трябва да имат ед-
 наква стойност, а иначе трябва да имат различна стойност. С това правило са-
 мо с един цикъл може да немерим примерни стойности на променливите, при кои-
 то се получава намереният резултат.  Програмата работи ако номерата на редо-
 вете са числа в диапазона 1..5000.  При необходимост те могат да се преноме-
 рират.
}

CONST InFileName  = 'BASIC.PAS';
      OutFileName = '';
      MaxRows     = 5000;
      MaxRezults  = 100;
      rezError    = 32766;
      rezCycling  = 32767;

TYPE TRow = record
              Typ: (aNumber,aIfThenElse);
              Number: integer;
              op1,op2: char;
              ThenRow,ElseRow: integer;
              Used: boolean;
            end;
     Table = array[#0..#128,#0..#128] of boolean;

VAR R: array[0..MaxRows] of TRow;
    FirstRow: integer;
    UsedVariables: array[#0..#128] of boolean;
    BrRezults: integer;
    Rezults: array[1..MaxRezults] of integer;
    Prev: array[#0..#128] of char;
    Unequal: ^Table;
    OutF: Text;

Procedure ReadData; {Read R[], FirstRow}
Var F: Text;
    S: string;
    RowNumber,i: integer;
  Function GetNumber: integer;
  Var i,Rez: integer;
      C: string;
  Begin
    C:='';
    while S[1] in ['0'..'9','-'] do
      begin C:=C+S[1]; Delete(S,1,1); end;
    Val(C,Rez,i);
    GetNumber:=Rez;
  End;
Begin
  Assign(F,InFileName); Reset(F); ReadLn(F);
  FillChar(UsedVariables,SizeOf(UsedVariables),false);
  FillChar(R,SizeOf(R),0); FirstRow:=MaxInt;
  for i:= 0 to MaxRows do {Clear all rows}
    begin R[i].Typ:=aNumber; R[i].Number:=rezError; end;
  repeat
    ReadLn(F,S);
    if S = '' then Break;
    S:=S+'@'; while Pos(' ',S)<>0 do Delete(S,Pos(' ',S),1);
    RowNumber:=GetNumber;
    if FirstRow = MaxInt then FirstRow:=RowNumber;
    with R[RowNumber] do
      if S[1] = 'R' then
        begin {"RETURN(...)" command found}
          Typ:= aNumber;
          Delete(S,1,7);
          Number:= GetNumber;
        end
    else
      begin {"IF ...=... THEN ... ELSE ..." command found}
        Typ:=aIfThenElse;
        op1:=S[3]; op2:=S[5];
        Delete(S,1,9); ThenRow:= GetNumber;
        Delete(S,1,4); ElseRow:= GetNumber;
        UsedVariables[op1]:=true; UsedVariables[op2]:=true;
      end;
  until EOF(F);
  Close(F);
End;

Function Root(V:char): char;
Begin {Return the root of V in the forest Prev[]. If V has no root, return V}
  while Prev[V] <> #0 do V:=Prev[V];
  Root:=V;
End;

Procedure TraceProgram(Row:integer); {Trace the program row Row}

  Procedure WriteRezult(Number:integer); {if Number is not already}
  Var i,Counter: integer; {printed print it and all variables values}
      Value: array[#0..#128] of integer;
      V,RootV: char;
      First: boolean;
  Begin
    for i:= 1 to BrRezults do {Check if Number is not already displayed}
      if Rezults[i] = Number then Exit;
    inc(BrRezults); Rezults[BrRezults]:=Number;
    if Number= rezError then
      WriteLn(OutF,'Row ',Row,' not found!')
    else if Number= rezCycling then
      WriteLn(OutF,'cycling:')
    else WriteLn(OutF,Number);
    {Find variable values. Variables in the same tree must have equal values}
    FillChar(Value,SizeOf(Value),0);
    Counter:=0; First:=true;
    for V:= #0 to #128 do
      if UsedVariables[V] then
        begin
          RootV:=Root(V);
          Value[V]:=Value[RootV];
          if Value[V] = 0 then
	    begin Inc(Counter); Value[V]:= Counter; Value[RootV]:=Counter; end;
          if not First then Write(OutF,',');
          Write(OutF,V,'=',Value[V]);
          First:=false;
	end;
    WriteLn(OutF);
  End;

Var V1: char;
    Old1,Old2: boolean;
Begin
  with R[Row] do
    begin
      if Used then {A cycle detected in the program}
        begin WriteRezult(rezCycling); Exit; end;
      Used:=true;
      if Typ = aNumber then {"RETURN(...)" row found}
        WriteRezult(Number)
      else
        if Root(op1) = Root(op2) then
          TraceProgram(ThenRow) {op1 = o2}
        else if Unequal^[op1,op2] then
          TraceProgram(ElseRow) {op1 <> o2}
        else
          begin  {op1 ? op2}
            {Try recursively the case when op1 = op2}
            V1:=Root(op1); Prev[V1]:=Root(op2);
            TraceProgram(ThenRow);
            Prev[V1]:=#0;
            {Try recursively the case when op1 <> op2}
            Unequal^[op1,op2]:=true; Unequal^[op2,op1]:=true;
            TraceProgram(ElseRow);
            Unequal^[op1,op2]:=false; Unequal^[op2,op1]:=false;
          end;
      Used:=false;
    end;
End;

BEGIN
  WriteLn; WriteLn; WriteLn;
  ReadData;
  Assign(OutF,OutFileName); Rewrite(OutF);
  BrRezults:=0;
  FillChar(Prev,SizeOf(Prev),#0);
  New(Unequal); FillChar(Unequal^,SizeOf(Unequal^),false);
   TraceProgram(FirstRow);
  Close(OutF);
END.