Правила форума
Прочтите прежде чем задавать вопрос!
uses Crt;
const
Nmax = 100; { Максемальное колличество элементов множества }
type
T = Char; {тип элемента множества}
TSet = Array[1..Nmax] of T; { Множество}
procedure Sort(var A: TSet; const N: Integer);
var
i, j, k: Integer;
tmp: T;
begin
for i := 1 to N - 1 do begin
k := i;
for j := i + 1 to N do
if A[j] < A[k] then k := j;
tmp := A[i];
A[i] := A[k];
A[k] := tmp;
end;
end;
{ Ввести множество }
procedure Set_Input(var A: TSet; var N: Integer);
var
i, j: Integer;
tmp: T;
F: Boolean;
begin
N := 0;
while not SeekEoLn (Input) do begin
Inc(N);
Read(Input, A[N]);
end;
Sort(A, N);
F := False;
i := 1;
while i < N do begin
if A[i] = A[i + 1] then begin
F := True;
Dec(N);
for j := i + 1 to N do
A[j] := A[j + 1];
end
else
Inc(i);
end;
if F then WriteLn('Повторяющийся элемент удален');
end;
procedure Print(const A: TSet; const N: Integer);{Вывод множества}
var
i: Integer;
begin
for i := 1 to N do
Write(A[i], ' ');
if N = 0 then Write('Пустое множество');
WriteLn;
end;
procedure Print_Sets(const A, B: TSet; const N, M: Integer);
var
i: Integer;
begin
WriteLn;
Write('Множество A: ');
for i := 1 to N do
Write(A[i], ' ');
WriteLn;
Write('Множество B: ');
for i := 1 to M do
Write(B[i], ' ');
WriteLn;
end;
procedure Union(var U: TSet; var k: Integer; const A, B: TSet; const N, M: Integer);
{Определение множества A и B }
var
i, j: Integer;
begin
i := 1;
j := 1;
k := 0;
while (i <= N) or (j <= M) do
if (j <= M) and (i <= N) and (A[i] = B[j]) then begin
Inc(k);
U[k] := A[i];
Inc(i);
Inc(j);
end
else if (j > M) or (i <= N) and (A[i] < B[j]) then begin
Inc(k);
U[k] := A[i];
Inc(i);
end
else begin
Inc(k);
U[k] := B[j];
Inc(j);
end;
end;
procedure Product(var P: TSet; var k: Integer; const A, B: TSet; const N, M: Integer);
{Пересечение множеств A и B }
var
i, j, W: Integer;
begin
i := 1;
j := 1;
k := 0;
while (i <= N) and (j <= M) do
if (A[i] = B[j]) then begin
Inc(k);
P[k] := A[i];
Inc(i);
Inc(j);
end
else if A[i] < B[j] then
Inc(i)
else
Inc(j);
end;
procedure Diff(var D: TSet; var k: Integer; const A, B: TSet; const N, M: Integer);
{Разность множеств A и B}
var
i, j: Integer;
begin
i := 1;
j := 1;
k := 0;
while (i <= N) and (j <= M) do
if A[i] = B[j] then begin
Inc(i);
Inc(j);
end
else if A[i] < B[j] then begin
Inc(k);
D[k] := A[i];
Inc(i);
end
else if A[i] > B[j] then
Inc(j);
while (i <= N) and (j > M) do begin
Inc(k);
D[k] := A[i];
Inc(i);
end;
end;
function Incl(const A, B: TSet; const N, M: Integer): Boolean; {Проверка на вхождение A в B}
var
i, j: Integer;
begin
Incl := False;
if N > M then Exit;
i := 1;
j := 1;
while (i <= N) and (j <= M) and (A[i] >= B[j]) do
if A[i] > B[j] then
Inc(j)
else if A[i] = B[j] then begin
Inc(i);
Inc(j);
end;
Incl := i - 1 = N;
end;
procedure Keys; {Вывод клавиш}
begin
ClrScr;
WriteLn('Введите номер желаемого действия:');
WriteLn;
WriteLn('1 - Ввод множества A');
WriteLn('2 - Ввод множества B');
WriteLn('3 - Проверка вхождения A в B');
WriteLn('4 - вывести обьеденение множеств A и B');
WriteLn('5 - Вывести пересечение множиств A и B');
WriteLn('6 - Вывести азность A \ B');
WriteLn('0 - Очистка');
WriteLn('Esc - ВЫХОД');
WriteLn;
end;
var
N, M, K: Integer;
A, B, C: TSet;
v: Char;
begin
Keys;
N := 0;
M := 0;
repeat
v := ReadKey;
if v in ['3'..'6'] then Print_Sets(A, B, N, M);
case v of
'1':
begin
WriteLn('Введите множество A:');
Set_Input(A, N);
WriteLn('Готово');
WriteLn;
end;
'2':
begin
WriteLn('Введите множество B:');
Set_Input(B, M);
WriteLn('Complet');
WriteLn;
end;
'3': if Incl(A, B, N, M) then WriteLn('A входит в B') else WriteLn('A Не входит в B');
'4':
begin
WriteLn('Объеденение A и B:');
Union(C, K, A, B, N, M);
Print(C, K);
end;
'5':
begin
WriteLn('Пересечение множеств A and B:');
Product(C, K, A, B, N, M);
Print(C, K);
end;
'6':
begin
WriteLn('Разность множеств A \ B:');
Diff(C, K, A, B, N, M);
Print(C, K);
end;
'0': Keys;
end;
until v = #27;
end.
Сообщение отредактировано: Bajiaoxing -
