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

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

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

> Разрядная сортировка
ganibal
сообщение 24.12.2010 21:51
Сообщение #1


Новичок
*

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

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


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


Гость






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

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


Новичок
*

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

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


Сортировка такая- все числа которые нужно сортировать переводятся в бинарный код одинаковой длины и потом сортируются по разрядам, то есть сначала 1 разряд разделяют на 0 и 1 , нули в начале все единицы после и тоже самое теперь с каждым делать разрядом. так это звучит, наверное , это все-таки поразрядная.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
ganibal
сообщение 27.12.2010 2:31
Сообщение #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

 

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