написала программу в паскаль турбо. перенесла в паскаль авс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; 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.
Федосеев Павел
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; while not SeekEoLn(Input) do begin Inc(N); Read(Input, A[N]); end; readln(input); 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;
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.