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 -(-C+(D*(A+B)))
FIND (D*(A+B))+C
FIND -A
FIND A+B*D+C
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
предизвиква завършване на програмата.
При зададен текстов файл, съдържащ на всеки ред по един оператор, да се из-
пълне дадената последователност от оператори.
РЕШЕНИЕ: След като дефинираме типа 'множество' и дефинираме функции за три-
те гореописани операции, остава само да напишем функция, която изчислява из-
раз.Ще използваме стандартния алгоритъм за изчисляване на аритметичен израз
с обратен полски запис (ОПЗ).Ще преобразуваме в ОПЗ и едновременно ще изчис-
ляваме дадения израз. Алгоритъма се реализира с два стека - един за операци-
ите и един за множествата. Елементите на стека с множествата ще съдържат са-
мо указател към съответните множества, а те ще се пазят в динамичната памет.
В най-общи линии алгоритъма за изчисляване на израз е такъв:
Изпълнявай докато не е свършил израза следното:
ако следващия символ S е:
'A'..'Z' - пъхни в стека с множествата стойността на множеството S
'(' - пъхни в стека със знаците '('
')' - докато от стека със знаците не излезе ')', викай Deistvie
'*','+','-' - докато приоритета на операцията S е по-малък или равен
на приоритета на операцията на върха на стека със знаците, изпъл-
нявай Deistvie
Докато в стека със знаци има нещо, изпълнявай Deistvie
Резултатът от изчисляването на израза остава на върха на стека с множест-
вата.
Deistvie: Ако на върха на стека със знаци има унарна операция, извърши
операцията над елемента на върха на стека с множествата. Ако на
върха на стека със знаците има бинарна операция,извади от стека
най-горните два елемента, извърши операцията над тях и резулта-
тът пъхни в стека
Алгоритъма се реализира чрез процедурата CalculateIzraz. Когато се пъха в
стека стойността на някое множество /A..Z/, предварително се заделя дина-
мична памет,записва се там стойността и в стека се пъха указател към тази
памет. Когато се извършва действие над двата операнда на върха на стека,
понеже като резултат се получава само 1 множество, паметта, заета от вто-
рото /втория операнд/ се освобождава. Алгоритъма следва плътно очертаната
по-горе схема. Приорететът на унарната операция '-' е най-голям.
*)
CONST InFileName = 'p2.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;
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;
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}
Const StackSize = 500;
Var Stack: array[0..StackSize] of char; {Стек за аритметичните знаци}
StackSet: array[1..StackSize] of PSet; {Стек за числата}
SP,SPset: integer;
Procedure PushZnak(Z:char); {Пъха знак в стека}
Begin Inc(SP); Stack[SP]:=Z; End;
Function PopZnak: char; {Вади знак от стека}
Begin PopZnak:=Stack[SP]; Dec(SP); End;
Procedure PushSet(A:PSet); {Пъха множество в стека}
Begin Inc(SPset); StackSet[SPset]:=A; End;
Procedure PushSet_A_Z(TheSet:char); {Пъха множество от 'A' до 'Z' в стека}
Var S: PSet;
Begin New(S); S^:=Sets[TheSet]; PushSet(S); End;
Function PopSet: PSet; {Вади множество от стека}
Begin PopSet:=StackSet[SPset]; Dec(SPset); End;
Function Prioritet(A:Char): byte; {Връща приоритета на аритмет.операция}
Begin
case A of
'(',#0: Prioritet:=1;
'+','*': Prioritet:=2;
'-': Prioritet:=3;
end;
End;
Procedure Deistvie(D:char); {Извършва аритметичното действие D над 1 или 2}
Var R1,R2: PSet;{операнда от стека StackSet и връща резултата в същия стек}
Begin
if D in ['(',#0] then Exit;
if D = '-' then {Унарна операция}
begin PushSet(Dopalnenie(PopSet)); Exit; end;
R1:=PopSet; R2:=PopSet;
case D of {Бинарна операция}
'+': R1:= Obedinenie(R1,R2);
'*': R1:= Sechenie(R1,R2);
end;
PushSet(R1);
Dispose(R2);
End;
Var Zn: char;
I: integer;
Begin
SP:=0; SPset:=0; Stack[0]:=#0;
for I:= 1 to length(S) do
if S[I] in ['A'..'Z'] then
PushSet_A_Z(S[I])
else if S[I] = '(' then PushZnak(S[I])
else if S[I] = ')' then
repeat
Zn:=PopZnak; Deistvie(Zn);
until Zn = '('
else if S[I] in ['+','-','*','/','^'] then
begin
while Prioritet(S[I]) <= Prioritet(Stack[SP]) do
Deistvie(PopZnak);
PushZnak(S[I]);
end;
while SP > 0 do Deistvie(PopZnak);
CalculateIzraz:=StackSet[1];
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.