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

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Разрядная сортировка
сообщение
Сообщение #1


Новичок
*

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

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


Разрядная сортировка для delphi, может у кого-то уже есть, выложите пожалуйста по возможности.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Может и есть... Смотря что имеется в виду под "разрядной". Если это поразрядная (она же цифровая, она же распределяющая, она же известно под кличкой "Radix Sort") - то даже в FAQ есть:
Методы сортировок

Если нет - то приводи ссылку на алгоритм что-ли, кто его знает, что там подразумевается под этим названием...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

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

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


Сортировка такая- все числа которые нужно сортировать переводятся в бинарный код одинаковой длины и потом сортируются по разрядам, то есть сначала 1 разряд разделяют на 0 и 1 , нули в начале все единицы после и тоже самое теперь с каждым делать разрядом. так это звучит, наверное , это все-таки поразрядная.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

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

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


 
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. Я попытался понять что и как надо переделать, но что-то не получается.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 27.10.2020 11:10
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name