Помощь - Поиск - Пользователи - Календарь
Полная версия: Разрядная сортировка
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
ganibal
Разрядная сортировка для delphi, может у кого-то уже есть, выложите пожалуйста по возможности.
volvo
Может и есть... Смотря что имеется в виду под "разрядной". Если это поразрядная (она же цифровая, она же распределяющая, она же известно под кличкой "Radix Sort") - то даже в FAQ есть:
Методы сортировок

Если нет - то приводи ссылку на алгоритм что-ли, кто его знает, что там подразумевается под этим названием...
ganibal
Сортировка такая- все числа которые нужно сортировать переводятся в бинарный код одинаковой длины и потом сортируются по разрядам, то есть сначала 1 разряд разделяют на 0 и 1 , нули в начале все единицы после и тоже самое теперь с каждым делать разрядом. так это звучит, наверное , это все-таки поразрядная.
ganibal
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, Buttons, ExtCtrls, TeEngine, Series, TeeProcs,
Chart;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N_sort: TMenuItem;
N_graph: TMenuItem;
N_close: TMenuItem;
Memo1: TMemo;
Panel1: TPanel;
Label1: TLabel;
Ed_Count: TEdit;
BB_ok: TBitBtn;
Chart1: TChart;
Series1: TLineSeries;
procedure N_closeClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure N_sortClick(Sender: TObject);
procedure BB_okClick(Sender: TObject);
procedure N_graphClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
type
Tlist=^Ltelem;
Ltelem=record
Data:integer;
Next:Tlist
end;
Telem=record
key:integer;
other:char;
end;
PtrElem=^telem;
Tvector=array of ptrElem;
Var n:integer;
b:Tvector;
procedure ClearVector(var B:Tvector);
var i:integer;
begin
for i:=1 to length(b)-1 do
dispose(b[i]);
b:=nil
end;

procedure TForm1.N_closeClick(Sender: TObject);
begin
if b<>nil then ClearVector(B);
close
end;
Procedure All_not_visible ;
begin
with Form1 do
begin
memo1.Visible:=False;
Panel1.Visible:=False;
chart1.Visible:=false
end
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
All_not_visible;
end;

procedure TForm1.N_sortClick(Sender: TObject);
begin
all_not_visible;
panel1.Visible:=true;
Ed_count.SetFocus;
Ed_count.Text:='';
end;

procedure Print_to_file(b:Tvector;var t:TextFile);
var i:integer;
begin
for i:=1 to N do
write(t,B[i]^.key,' ');
writeln(t)
end;

procedure SortVector(var B:TVector;N:Integer);
const m=256 ;
Var
source, distr, index: TVector;

i: integer;
begin
for i:=1 to n do
source[i]^.key:=b[i]^.key;
fillchar(distr, sizeof(distr), 0);
for i := 0 to n do
inc(distr[source[i]^.key]);

index[0]^.key := 0;
for i := 1 to m do
index[i]^.key := index[i]^.key + distr[i]^.key;

for i := 0 to n do
begin
b[ index[source[i]^.key]^.key ]^.key := source[i]^.key;
index[source[i]^.key]^.key := index[source[i]^.key]^.key+1;
end;
end;




Procedure Createvector (var B:Tvector;n:integer);
var i:integer;
begin
setLength(b,n+1);
randomize;
For i:=1 to n do
begin
new(b[i]);
b[i]^.key:=Random(100)
end;
end;

procedure TForm1.BB_okClick(Sender: TObject);
Var code:integer;
t:textfile;
begin
val(ed_count.Text,n,code);

if (code<>0) or (n<1) then
messagedlg('Îøèáêà ââîäà',mtError,[mbok],0)
else
begin
All_not_visible;
Memo1.Visible:=true;
assignFile(t,'tmp');
rewrite(t);
CreateVector(b,N);
writeln(t,'Èñõîäíûé ìàññèâ');
Print_to_File(B,t);
SortVector(B,N);
writeln(t,#10,'Óïîðÿäî÷åííûé ìàññèâ');
Print_to_file(b,t);
closeFile(t);
Memo1.Lines.Loadfromfile('tmp');
Erase(t)
end
end;

procedure TForm1.N_graphClick(Sender: TObject);
var t1,t2:integer;
begin
all_not_visible;
chart1.Visible:=true; series1.clear;
n:=100;
while n<=4000 do
begin
createVector(b,n);
t1:=GetTickCount;
sortVector(b,n);
t2:=GetTickCount;
Series1.AddXY(n,(t2-t1)/10,'',clRed);
n:=n+100
end;
end;
end.

Процедура, которую нужно сделать называется SortVector. Я попытался понять что и как надо переделать, но что-то не получается.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.