INFOMAN брой 2

(* This is the input data:

LET A={500,499,488}
LET B={300,301,302}
LET C={1,2,3,4,5}
LET D={300,500,100}
FIND (D*(A+B))+C
FIND -(-C+(D*(A+B)))
FIND -A
FIND -((D*(A+B))+C)
STOP

                          ОПЕРАЦИИ С МНОЖЕСТВА
                          --------------------

  С главните латински букви A,B,...,Z означаваме подмножества на множеството
 Ф = {1,2,3,...,500}. Едно множество се записва като списък от елементите му,
 заградени между скобите '{' и '}', разделени със запетаи.  С A+B означаваме
 обединението на мноижествата A и B, с A*B означаваме сечението на множества-
 та A и B,а с -A означаваме допълнението на множеството A до Ф. С помощта на
 дадените операции и  означенията на някои подмножества 'A'..'Z' могат да се
 съставят изрази,в които редът на извършване на операциите се задава със ско-
 би.  Унарната операция '-' се отнася  за следващия я символ или за израза в
 скобите, ако я следва скоба.За работа с подмножествата и изразите са дадени
 следните оператори:
     LET <множество>=<списък на елементите>
 определя стойността на множеството <множество>, което е буква от 'A' до 'Z'
 като състоящо се от елементите посочени в списъка <списък на елементите>;
     FIND <израз>
 предизвиква пресмятане и отпечатване на броя на елементите на израза <израз>
 по определените по-горе правила при текущите съдържания на множествата, чий-
 то имена се съдържат в израза;
     STOP
 предизвиква завършване на програмата.
  При зададен текстов файл, съдържащ на всеки ред по един оператор, да се из-
 пълне дадената последователност от оператори.

  РЕШЕНИЕ: След като дефинираме типа 'множество' и дефинираме функции за три-
 те гореописани операции, остава само да напишем функция, която изчислява из-
 раз.Ще използваме стандартния алгоритъм за изчисляване на аритметичен израз
 със скоби чрез рекурсивно изчисление.  За целта трябва да дефинираме правил-
 но чрез рекурсивни процедури понятието <Izraz>. Ето една възможна граматика,
 която описва правилно понятието <Izraz>:

      <Izraz>  =  Cislo + ')'
             или  Cislo * Izraz
             или  Cislo + Izraz

      <Cislo>  =  'A'..'Z'
             или  -Cislo
             или  (Izraz)

 Не е трудно да се напише програма, която реализира двете взаимно рекурсивни
 функции Izraz и Cislo, както са описани по-горе.  Предварително към края на
 израза, който трябва да се изчисли се добавя ')', за да се опрости програма-
 та.  Когато се изчислява Cislo и стойността трябва да е стойността на някоя
 променлива 'A'..'Z', се заделя в динамичната памет място за 1 множество,там
 се записва стойността на съответната променлива  и това динамично множество
 се връща като резултат.  Когато се извършва операция обединение или сечение,
 понеже от две множества като резултат се получава едно, паметта,заета от ед-
 ното множество се освобождава,а в другото се записва резултатът от операция-
 та и то се връща като резултат от функцията (обединение или сечение). Изчис-
 ляването на израз с рекурсия не е най-добрият начин,  защото не се справя с
 изрази, в които операциите има приоритет.  Освен това когато няма скоби, ко-
 ито да указват реда на операциите, изразът се изчислява отдясно наляво вмес-
 то отляво надясно. Т.е. A*B+C се изчислява като A*(B+C), а не както би тряб-
 вало (A*B)+C. Това се дължи на граматиката, по която е дефинирано понятието
 <Izraz>. При рекурсивното изчисляване, когато имаме да извършим някаква опе-
 рация A @ B се изчислява първо B и после се извършва операцията @ над A и B.
 Ето защо изчисляването на израз се препоръчва да се прави по калсическия ал-
 горитъм с обратен полски запис.

*)

CONST InFileName  = 'P2-2.PAS';
      OutFileName = '';
      MaxN = 500;

TYPE TSet = array[1..MaxN] of boolean;
     PSet = ^TSet;

VAR Sets: array['A'..'Z'] of TSet;


Procedure RemoveSpaces(var S: string);
Begin
  while Pos(' ',S)<>0 do
    Delete(S,Pos(' ',S),1);
End;

Function Dopalnenie(A:PSet): PSet;
Var I: integer; {Извършва операцията допълнение над операнда A}
Begin
  for I:= 1 to MaxN do
    A^[I]:= not A^[I];
  Dopalnenie:=A;
End;

Function Obedinenie(A,B:PSet): PSet; {Извършва операцията обединение}
Var I: integer; {на множествата A и B. Резултатът остава и в A}
Begin
  for I:= 1 to MaxN do
    A^[I]:= A^[I] or B^[I];
  Obedinenie:=A; Dispose(B);
End;

Function Sechenie(A,B:PSet): PSet; {Извършва операцията сечение}
Var I: integer;  {на множествата A и B. Резултатът остава и в A}
Begin
  for I:= 1 to MaxN do
    A^[I]:= A^[I] and B^[I];
  Sechenie:=A; Dispose(B);
End;

Procedure SetValue(TheSet:char; S:string); {Присвоява на променливата TheSet}
Var v: integer; {множеството което е записано в S като списък от числа}
Begin
  FillChar(Sets[TheSet],SizeOf(Sets[TheSet]),false);
  if S = '}' then Exit;
  repeat
    v:=0; while S[1] in['0'..'9'] do
      begin v:= v*10 + ord(S[1])-ord('0'); delete(S,1,1); end;
    delete(s,1,1);
    Sets[TheSet][v]:=true;
  until S = '';
End;

Function GetCountSet(A:PSet): integer;
Var I,Count: integer; {Връща броя на елементите в A}
Begin
  Count:=0;
  for I:= 1 to 500 do
    if A^[I] then Inc(Count);
  GetCountSet:=Count;
End;

Function CalculateIzraz(S:string): PSet; {Изчислява аритметичния израз S}
Var Poz: integer;

  Function Izraz: PSet; forward;

  Function Cislo: PSet;
  Var Rez: PSet;
  Begin
    Inc(Poz);
    case S[Poz] of
      '(': Cislo:= Izraz;
      '-': Cislo:= Dopalnenie(Cislo);
      'A'..'Z':
        begin New(Rez); Rez^:=Sets[S[Poz]]; Cislo:=Rez; end;
    end;
  End;

  Function Izraz: PSet;
  Var Rez: PSet;
  Begin
    Rez:=Cislo; Inc(Poz);
    case S[Poz] of
      ')': Izraz:= Rez;
      '+': Izraz:= Obedinenie(Rez,Izraz);
      '*': Izraz:= Sechenie(Rez,Izraz);
    end;
  End;

Begin
  Poz:=0; S:=S+')';
  CalculateIzraz:=Izraz;
End;


VAR InF,OutF: Text;
    Rezult: PSet;
    S: string;

BEGIN
  Assign(InF,InFileName); Reset(InF); ReadLn(InF); ReadLn(InF);{}
  Assign(OutF,OutFileName); Rewrite(OutF);
  while not SeekEOF(InF) do
    begin
      ReadLn(InF,S); RemoveSpaces(S);
      if S[1] = 'L' then
        SetValue(S[4],copy(S,7,length(S)-1));
      if S[1] = 'F' then
        begin
          Rezult:= CalculateIzraz(copy(S,5,length(S)));
          WriteLn(OutF,GetCountSet(Rezult));
          Dispose(Rezult);
        end;
      if S[1] = 'S' then Break;
    end;
  WriteLn(OutF);
  Close(InF); Close(OutF);
END.