Я студент. Уже 5 недель не могу сдать лабораторную по Delphi из-за постоянно всплывающих ошибок.
Суть задачи:
Есть сортированный за убыванием массив целых чисел А(n+m) и несортированный масив В(m), n<=300, m<=200. Нужно написать прогу, которая элементы массива В вставит в массив А та, чтобы А остался упорядоченым.
У меня уже есть код, но он работает непредсказуемо: иногда работает, иногда нет.
Мой код (с обычными массивами):program Lab5Console;
{$APPTYPE CONSOLE}
uses
SysUtils;
const
N_const = 300;
M_const = 200;
var
A: array[1..N_const+M_const] of integer;
B: array[1..M_const] of integer;
n,m,i,j,last_greater: integer;
procedure sortA(len: integer);
var i,j,temp: integer;
begin
temp:=0;
for i := len+1 downto 1 do begin
for j:=0 to i-1 do
if A[j] < A[j+1] then begin
temp:=A[j];
A[j]:=a[j+1];
A[j+1]:=temp;
end;
end;
end;
procedure writeArray(Arr:array of integer; len:integer);
begin
for i := 0 to len-1 do begin
write(Arr[i]:4);
if (i mod 15 = 0) and not (i = 0) then writeln;
end;
end;
procedure insertIntoA(num, id, len: integer);
var i: integer;
begin
for i := len downto id do
A[i+1] := A[i];
A[id] := num;
end;
begin
try
writeln('Hello! Its Lab5Console.');
writeln('--- --- ---');
repeat
write('Insert N: '); readln(n);
until n<300;
repeat
write('Insert M: '); readln(m);
until m<200;
writeln('Array A:');
i:=1;
for i:=1 to n do begin
A[i]:=random(10);
end;
sortA(n);
writeArray(A,n);
writeln; writeln('Array B:');
i:=1;
for i:=1 to m do begin
B[i]:=random(10);
end;
writeArray(B, m);
for i := 1 to m do begin
last_greater := 1;
for j := 1 to n do begin
if A[j] >= B[i] then
last_greater := j+1;
end;
insertIntoA(B[i], last_greater, n+1);
end;
writeln; writeln('Result array:');
writeArray(A,n+m);
readln; readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Код с динамическими массивами:
program Lab5Console2;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
DArr = array of integer;
var
A,B: DArr;
n,m,i,j,last_greater: integer;
procedure WriteArr(Arr: DArr);
begin
for i := 0 to length(Arr)-1 do begin
write(Arr[i]:4);
if (i mod 15 = 0) and not (i=0) then writeln;
end;
writeln;
end;
function BubbleSort(Arr: DArr): DArr;
var i,j,temp: integer;
begin
for i := 0 to length(Arr)-2 do
for j := 0 to length(Arr)-i-1 do begin
if Arr[j] < Arr[j+1] then begin
temp := Arr[j];
Arr[j] := Arr[j+1];
Arr[j+1]:= temp;
end;
end;
BubbleSort:= Arr;
end;
function InsertAfter(Arr: DArr; number, id: integer): DArr;
var i: integer;
begin
for i := length(Arr)-1 downto id do
Arr[i+1]:= Arr[i];
Arr[id]:= number;
InsertAfter:= Arr;
end;
begin
try
writeln('Hello! Its Lab5Console.');
writeln('--- --- ---');
// Enter N and M - arrays length
repeat
write('Insert N: '); readln(n);
until n<300;
SetLength(A,n);
repeat
write('Insert M: '); readln(m);
until m<200;
SetLength(B, m);
// Generate A
writeln('Array A:');
for i := 0 to length(A)-1 do
A[i]:=random(10);
WriteArr(A);
writeln('Array A after sort:');
A:= BubbleSort(A); // Sort A
WriteArr(A);
// Generate B
writeln('Array B:');
for i := 0 to length(B)-1 do
B[i]:=random(10);
WriteArr(B);
SetLength(A, n+m);
for i := 0 to m-1 do begin
last_greater:=0;
for j := 0 to n-1 do
if A[j] >= B[i] then last_greater:= j+1;
A:= InsertAfter(A, B[i], last_greater);
end;
write('Result array:');
WriteArr(A);
readln;
readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Помогите написать работающую программу, или укажите но ошибку в коде. Какой код лучше, ближе к истине?
Буду благодарен!
Простой
