Помогите отладить програму

Общие вопросы: версии и диалекты, синтаксис языка, cтруктуры и типы данных (массивы, строки, списки...), обработка данных и т.д.
Ответить
PRoRocK
Сообщения: 2
Зарегистрирован: 22 дек 2009, 17:41

Помогите пожалуйста.

Нужно отсортировать двумерный массив (NxN) по неубыванию змейкой(http://s60.radikal.ru/i169/0912/0e/7d82f97e2fbb.png) через процедуру вывода следующего эллемента массива.

Ошибка в процедуре быстрой сортировки (переменная nom принимает не правильные значения) не могу исправить

Пример работы:
Вводится размер массива 3
Вводится 9 эллементов (9 1 8 2 7 3 4 6 5)
результат:
9 7 6
8 5 2
4 3 1


Процедуры nextl и nextp выводят следующий или соответственно предыдущий элемент массива.

Код: Выделить всё

program variant_83;
{$apptype console}

var 
     m,i,j,n,g,nom,nom1,v,r:integer;
      a:array[1..10,1..10] of integer;
      stroka,stroka2,end1:string;
      bool:boolean;




 procedure nextp (var t,p,nom:Integer);      {следующий элемент матрицы}
begin

      inc(nom);



  if (m mod 2=0) then  {четная матрица}
    begin
      if (t mod 2<>0) and (p mod 2<>0) then if t=1 then p:=p+1 else begin t:=t-1; p:=p+1; end else
      if (t mod 2=0) and (p mod 2=0) then if p=m then t:=t+1 else  begin t:=t-1; p:=p+1; end else
      if (t mod 2=0) and (p mod 2<>0) then if t=m then p:=p+1 else if p=1 then t:=t+1 else  begin t:=t+1; p:=p-1; end else
      if (t mod 2<>0) and (p mod 2=0) then begin t:=t+1; p:=p-1; end else
    end
  else                 {нечетная матрица}
    begin
      if (t mod 2<>0) and (p mod 2 <>0) then if p=m then t:=t+1 else if t=1 then p:=p+1 else begin t:=t-1; p:=p+1; end else
      if (t mod 2=0) and (p mod 2=0) then begin t:=t-1; p:=p+1; end else
      if (t mod 2=0) and (p mod 2<>0) then if p=1 then t:=t+1 else begin t:=t+1; p:=p-1; end else
      if (t mod 2<>0) and (p mod 2=0) then if t=m then p:=p+1 else begin t:=t+1; p:=p-1; end else
    end;



    end;

 procedure nextl (var t,p,nom1:Integer);     {предыдущий элемент матрицы}
begin
 dec(nom1);


     if (m mod 2=0) then  {четная матрица}
    begin
      if (t mod 2<>0) and (p mod 2<>0) then if p=1 then t:=t-1 else begin t:=t+1; p:=p-1; end else
      if (t mod 2=0) and (p mod 2=0) then if t=m then dec(p) else begin t:=t+1; p:=p-1; end else
      if (t mod 2=0) and (p mod 2<>0) then begin t:=t-1; p:=p+1;  end else
      if (t mod 2<>0) and (p mod 2=0) then if t=1 then p:=p-1 else if p=m then t:=t-1 else  begin t:=t-1; p:=p+1; end else
    end
  else                 {нечетная матрица}
    begin
      if (t mod 2<>0) and (p mod 2 <>0) then if p=1 then t:=t-1 else if t=m then p:=p-1 else begin p:=p-1; t:=t+1; end else
      if (t mod 2=0) and (p mod 2=0) then begin t:=t+1; p:=p-1; end else
      if (t mod 2=0) and (p mod 2<>0) then if p=m then t:=t-1 else begin t:=t-1; p:=p+1; end else
      if (t mod 2<>0) and (p mod 2=0) then if t=1 then p:=p-1 else begin t:=t-1; p:=p+1; end else
    end;

    end;






procedure Q1Sort( L, R : integer ); { Быстрая сортировка массива }
var i1,j1,x,y,y1,q,z,nomp :integer;
bool1:boolean;
begin

  i:=m;
  j:=m;
  y:=nom1; y1:=nom;
  nom:=1;
  nom1:=m*m;
  if bool=false then y:=0;
  if bool1=false then y1:=0;
  if bool=true then nom1:=y+nom   ;
  if bool1=true then nom:=y1-nom;
  bool:=false;
  bool1:=false;
  q:=1; z:=1;
  i1 := l; j1 := r;
  x := a[(i1+q) div 2, (j1+z) div 2];
  if  (((i1+q) div 2)=1) and (((j1+z) div 2)=1) then x:=a[1,2];
  nomp:=nom1;
  y:=0; y1:=0;
  repeat
    while (A[q,z]<x) do nextp(q,z,nom);
    while (x<A[i1,j1]) do nextl(i1,j1,nom1);

    if ( nom<=nom1 ) then
    begin
      y:=A[q,z]; a[q,z]:=a[i1,j1]; a[i1,j1]:=y;
      nextp(q,z,nom); nextl(i1,j1,nom1)
    end;
  until (nom1<nom);
  if (1<nom1) then begin  q1sort(i1,j1); bool:=true; end;
  if (nom<nomp) then begin  q1sort(q,z); bool1:=true; end;
end;

begin

writeln('Введите размер матрицы');
readln(m);

writeln('Введите через пробел ',m*m,' элементов массива:');
for i:=1 to m do begin;
for j:=1 to m do read(a[i,j]);end;
i:=m; j:=m;
bool:=false;

n:=a[(i+1) div 2, (j+1) div 2];
writeln(n);
writeln((i+1) div 2);
writeln(3 div 2);
  q1sort(i,j);     readln;

  for j:=1 to m do begin writeln;
  for i:=1 to m do write(a[i,j],' '); end;  readln; writeln;

         end.
        end.
        end.
Ответить