Логин: Пароль:    Регистрация Всеми возможностями сайта можно пользоваться
только после авторизации.
   Забыли пароль?

Поиск
L



Статистика
u
Пользователи онлайн: нет
Гостей онлайн: 1
Всего онлайн: 1
Зарегистрировано юзеров: 6943
Комментариев на сайте: 654
Новый юзер: MatthewMat



Последние комментарии
c
Davidpab прокомментировал "Урок 24 - Изучаем компонент PaintBox":
&#1047;&#1072;&#1082;&#1072;&#1079;&#1072;&#1090;&#1100; seo &#1087;&#1086;&#1080;&#1089;&#1082;&#1086;&#1074;&#1091;&#1102; &#1086;&#1087;&#1090;&#1080;&#1084;&#1080;&#1079;&#1072;&#1094;&#1080;&#1102; &#1089;&#1072;&#1081;&#1090;&#1072;, <a href=http://seoprofisional.ru/bazy>базы для xrumer</a> &#1047;&#1072;&#1082;&#1072;&#1079;&#1072;&#1090;&#1100; &#1091;&#1089;&#1083;&#1091;&#1075;&#1080; &#1087;&#1086; &#1087;&#1088;&#1086;&#1076;&#1074;&#1080;&#1078;&#1077;&#1085;&#1080;&#1102; &#1089;&#1072;&#1081;&#1090;&#1072; &#1055;&#1086; &#1074;&#1089;&#1077;&#1084; &#1074;&#1086;&#1079;&#1085;&#1080;&#1082;&#1096;&#1080;&#1084; &#1074;&#1086;&#1087;&#1088;&#1086;&#1089;&#1072;&#1084; &#1042;&#1099; &#1084;&#1086;&#1078;&#1077;&#1090;&#1077; &#1086;&#1073;&#1088;&#1072;&#1090;&#1080;&#1090;&#1100;&#1089;&#1103; &#1074; &#1089;&#1082;&#1072;&#1081;&#1087; &#1083;&#1086;&#1075;&#1080;&#1085; [b]pokras7777[/b] &#1056;&#1072;&#1089;&#1082;&#1088;&#1091;&#1090;&#1082;&#1072; &#1089;&#1072;&#1081;&#1090;&#1072; &#1087;&#1086;&#1076; &#1082;&#1083;&#1102;&#1095; fhdxxxxxd
Everettrof прокомментировал "Урок 53 - Потоки в Delphi, (часть 1/3)":
Как быть не могу разобраться или тут хочу заказать металлоизделия Делается тут или в другом месте искать навесы из полекарбоната Такие фирмы это делают или я не правильно понимаю, нужно сделать а я вот выбираю и не могу понять,,, сварка металла это же они могут сделать??? https://steelcentury.ru пока на них смотрю

Пирамидальная сортировка

Алгоритм пирамидальной сортировки (heapsort) — один из самых быстрых алгоритмов сортировки.

Program heapsort; 
 
{$APPTYPE CONSOLE} 
 
type 
  tkey = integer; 
  int = integer; 
 
const N = 10;   
 
var a,b : array [0..N+1] of tkey; 
 
function parent(x : int) : int; 
begin 
  result:=x shr 1; 
end; 
 
function left(x : int) : int; 
begin 
  result := x shl 1; 
  if result > a[0] then result := N+1; 
end; 
 
function right(x:int):int; 
begin 
  result := x shl 1 + 1; 
  if result > a[0] then result := N+1; 
end; 
 
procedure swap(i,j : int); 
var temp : tkey; 
begin 
  temp := a[i]; 
  a[i] := a[j]; 
  a[j] := temp; 
end; 
 
procedure moveup(x : int); 
begin 
  while (a[x] > a[parent(x)]) and (parent(x) > 0)  do begin 
    swap(x, parent(x)); 
    x := parent(x); 
  end; 
end; 
 
procedure movedown(x : int); 
var max : integer; 
begin 
  if a[left(x)] > a[right(x)] then max := left(x) 
  else max := right(x); 
  while (a[max] > a[x]) and (max <= a[0]) do begin 
    swap(max, x); 
    x := max; 
    if a[left(x)] > a[right(x)] then max := left(x) 
    else max := right(x); 
  end; 
end; 
 
 
procedure update(x : int; k : tkey); 
begin 
  a[x] := k; 
  moveup(x); 
  movedown(x); 
end; 
 
procedure add(k : tkey); 
begin 
  inc(a[0]); 
  update(a[0], k); 
end; 
 
procedure delete(x : int); 
begin 
  swap(x, a[0]); 
  dec(a[0]); 
  update(x, a[x]); 
end; 
 
procedure hsort; 
var i:int; 
begin 
  a[0] := 1; 
  a[1] := b[1]; 
  for i := 2 to N do 
    add(b[i]); 
  for i := 1 to N do 
    delete(1); 
end; 
 
var i : int; 
 
begin 
  randomize; 
  fillchar(a, sizeof(a), 0); 
  fillchar(b, sizeof(b), 0);   
 
  for i := 1 to N do 
    b[i] := random(10); 
 
  writeln('Non-sorted elements'); 
  for i := 1 to N do 
    write(b[i], ' '); 
  writeln; 
 
  hsort; 
 
  writeln('Sorted elements'); 
  for i := 1 to N do 
    write(a[i], ' '); 
  readln; 
end.

Вот и всё, Удачи!

Источник: www.thedelphi.ru
Автор: Савельев Александр
Опубликовано: 04 Октября 2014
Просмотров: 5467


Зарегистрируйтесь или авторизуйтесь, чтобы добавлять комментарии.