denysd
@denysd
Мимо проходящий

Как вставить элементы несортированного массива в сортированный на Pascal?

Я студент. Уже 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.


Помогите написать работающую программу, или укажите но ошибку в коде. Какой код лучше, ближе к истине?
Буду благодарен!
  • Вопрос задан
  • 2645 просмотров
Решения вопроса 1
@Sumor
Вы путаетесь с началом и концом массивов.
В паскале принято нумеровать элементы массивов с 1. SetLength создаёт массив, который нумеруется с 0.
У вас есть цикл где вы читаете с 0 — проверьте всегда ли правильно вы указываете нижнюю границу массива.
Для универсальности нужно применять функции High и Low, которые указывают нижний и верхний элементы массива:
For i := Low(Arr) to High(Arr) do
Begin
    write(Arr[i]:4);
End;


Дальше конечно много ещё замечаний к стилю и к коду.
Например, в задании сказано, что n<=300, а вы проверяете n<300. Есть места, где вы лишний раз инициализируете переменные.
В целом, задание не просто на программирование, а на алгоритмы.
Ваш способ работающий, но сильно не оптимальный. Например, для решения задачи достаточно просто приписать массив B в конец массива A, а затем всё отсортировать.
Задание в такой постановке как-бы намекает на изучение алгоритма сортировки слиянием.
Ответ написан
Пригласить эксперта
Ответы на вопрос 1
jcmvbkbc
@jcmvbkbc
"I'm here to consult you" © Dogbert
Уже 5 недель не могу сдать лабораторную по Delphi из-за постоянно всплывающих ошибок.

Значит не судьба.
Ответ написан
Ваш ответ на вопрос

Войдите, чтобы написать ответ

Похожие вопросы