IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

> Пирамидальная сортировка, работает только с маленьким кол-вом элементов
cooler
сообщение 9.03.2009 20:57
Сообщение #1


Бывалый
***

Группа: Пользователи
Сообщений: 178
Пол: Мужской

Репутация: -  0  +


Сделал сортировку, работает только с маленьким кол-вом элементов, т.е до 30 примерно
Нужна помощь, уверен что ошибка глупая, где-то видно переменная не передалась, хотя может и в другом
Выкладываю программу архивом и сам текст.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
	Memo1: TMemo;
	Memo2: TMemo;
	Button1: TButton;
	Edit1: TEdit;
	procedure Button1Click(Sender: TObject);
  private
	{ Private declarations }
  public
	{ Public declarations }
  end;

  TSortArray = array[1..255] of byte;
			  Tsorttype=byte;
var
  Form1: TForm1;

  max: integer;

  reserv:	Tsorttype;




  b,a: TSortArray;
implementation
{$R *.dfm}


procedure spusk (var k: TSortArray; j,n : integer);
var

i,m : integer;
t:Tsorttype;

found: boolean;

Begin
//k:=a;
found:=false;
i:=j;
t:=k[i];
m:=i*2;
while (m<=n) and not found do
 begin
  if m<n then
   if k[m+1]>k[m] then inc(m);

  if k[m]>t then
  begin
	k[i]:=k[m];
	i:=m;
	m:=i*2;
  end
  else found:=true
 end;


 k[i]:=t;
 end;

 procedure sort(var k: TSortarray; n:integer);
 var j:integer;
 begin
 n:=max;
 j:=n div 2;
 while j>0 do
  begin
  // k:=a;
   spusk(k,j,n);
   dec(j);
  end;
 //
 j:=n;
  while j>1 do
   begin
	//swap(k[1], k[j]);
	reserv:=k[j];
	k[j]:=k[1];
	k[1]:=reserv;
	dec(j);
	spusk(k,1,j);
   end;
  end;


procedure TForm1.Button1Click(Sender: TObject);
var i:byte;
begin
 randomize;
 max:=strtoint(Edit1.Text);
 for i:=1 to max do
   begin
	b[i]:=random({(}255{+max) div 2});
   end;
 a:=b;
// trigger:=0;
 //mergeSort(1,max);


 sort(a,max);
 Memo1.Lines.Clear;
 Memo2.Lines.Clear;
 for i:=1 to max do
   Memo1.lines[0]:=Memo1.lines[0]+inttostr(B[i])+'; ';
   
 for i:=1 to max do
   Memo2.lines[0]:=Memo2.lines[0]+inttostr(A[i])+'; ';
 //Memo3.Lines.Clear;
 //Memo3.lines[0]:=inttostr(trigger);
end;

end.



http://ifolder.ru/10948874
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 28.07.2025 9:47
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"