написала программу в паскаль турбо. перенесла в паскаль авсNet /перестала работать что не так Подскажите?
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;
beginfor i := 1to N - 1dobegin
k := i;
for j := i + 1to N doif 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;
whilenot SeekEoLn (Input) dobegin
Inc(N);
Read(Input, A[N]);
end;
Sort(A, N);
F := False;
i := 1;
while i < N dobeginif A[i] = A[i + 1] thenbegin
F := True;
Dec(N);
for j := i + 1to N do
A[j] := A[j + 1];
endelse
Inc(i);
end;
if F then WriteLn('Повторяющийся элемент удален');
end;
procedure Print(const A: TSet; const N: Integer);{Вывод множества}var
i: Integer;
beginfor i := 1to N do
Write(A[i], ' ');
if N = 0then Write('Пустое множество');
WriteLn;
end;
procedure Print_Sets(const A, B: TSet; const N, M: Integer);
var
i: Integer;
begin
WriteLn;
Write('Множество A: ');
for i := 1to N do
Write(A[i], ' ');
WriteLn;
Write('Множество B: ');
for i := 1to 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) doif (j <= M) and (i <= N) and (A[i] = B[j]) thenbegin
Inc(k);
U[k] := A[i];
Inc(i);
Inc(j);
endelseif (j > M) or (i <= N) and (A[i] < B[j]) thenbegin
Inc(k);
U[k] := A[i];
Inc(i);
endelsebegin
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) doif (A[i] = B[j]) thenbegin
Inc(k);
P[k] := A[i];
Inc(i);
Inc(j);
endelseif 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) doif A[i] = B[j] thenbegin
Inc(i);
Inc(j);
endelseif A[i] < B[j] thenbegin
Inc(k);
D[k] := A[i];
Inc(i);
endelseif A[i] > B[j] then
Inc(j);
while (i <= N) and (j > M) dobegin
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]) doif A[i] > B[j] then
Inc(j)
elseif A[i] = B[j] thenbegin
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.
Федосеев Павел
9.12.2016 1:19
По крайней мере вы сюда скопировали с ошибкой - первой строкой ожидалось слово uses.
А так - непонятно, что такое перестала работать. Лучше уточняйте.
Dasha21
9.12.2016 10:32
Цитата(Федосеев Павел @ 9.12.2016 1:19)
По крайней мере вы сюда скопировали с ошибкой - первой строкой ожидалось слово uses.
А так - непонятно, что такое перестала работать. Лучше уточняйте.
все работает за исключением ввода А
Федосеев Павел
10.12.2016 1:41
Смотрите. Вы вводите элементы множества до символа EoLn. Причём, SeekEoLn. Но сам символ EoLn из буфера ввода (буфера клавиатуры) не извлекаете. Это приводит к тому, что после ввода одного множества, второе ввести невозможно - while not SeekEoLn (Input) do begin сразу завершает цикл, т.к. EoLn всё ещё в буфере клавиатуры.
Извлеките этот символ - readln(input) после завершения цикла ввода перед завершением процедуры.
И ещё. Пользуйтесь кнопкой CODE и закрывайте тэг кнопкой #. Код будет выглядеть аккуратнее. А также, воспользуйтесь программой для автоматического форматирования кода на Pascal - JCF. Здесь я описал вкратце, как его установить Форматтер кода
А так будет выглядеть ваша подпрограмма после исправления и форматирования
{ Ввести множество }procedure Set_Input(var A: TSet; var N: integer);
var
i, j: integer;
tmp: T;
F: boolean;
begin
N := 0;
whilenot SeekEoLn(Input) dobegin
Inc(N);
Read(Input, A[N]);
end;
readln(input);
Sort(A, N);
F := False;
i := 1;
while i < N dobeginif A[i] = A[i + 1] thenbegin
F := True;
Dec(N);
for j := i + 1to N do
A[j] := A[j + 1];
endelse
Inc(i);
end;
if F then
WriteLn('Повторяющийся элемент удален');
end;
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.