HOME ПРИМЕРЫ THANKS НОВИЧКАМ ДОКИ LINKS JavaScript Mail


 
В этот день много лет назад...
7 декабря. В 1976 году (48 лет назад) - Бывший кремлевский вождь пенсионер Вячеслав Молотов в разговоре со своим почитателем поэтом Феликсом Чуевым говорит: "...У нас нет социализма. Унас взятки, у нас хищения, у нас всякие безобразия..."
 
 

Turbo Pascal Examples

Графика:
Построение графика функции
Прыгающий по экрану мячик.
Качание маятника.
Вложенные цветные круги.
Броуновское движение. Использование объектов.
Матрицы и массивы:
Сортировка элементов массива.
Удаление одинаковых элементов.
Простой пример на поворот матрицы.
Сортировка методом Шелла. +функции измерения временных интервалов.
Проверка выпуклости многоугольника.
Перемоножение матриц
Вычисление определителя матрицы. Рекурсия.
Нахождение обратной матрицы.
Задача об автостоянке.
Рекурсия. Подземелье сокровищ.
Численные методы:
Задачка на определение угла между стрелками часов.
Проверка на принадлежность точки многоугольнику.
Нахождение точки пересечения двух отрезков на плоскости.
Сортировка методом Шелла. +функции измерения временных интервалов.
Сортировка методом "пузырька". Пример на динамические структуры данных. Связанные списки.
Нахождение корня функции методом половинного деления.
Вычисление арккосинуса
Нахождение суммы цифр натурального числа.
Работа с фалами:
Рекурсивное сканирование директорий.
Работа со строками:
Работа со словами в предложении с разделителями.
Простейший синтаксический анализатор для распознавания и вычисления многчлена.
Синтаксический анализатор для распознавания и вычисления многчлена.
Работа со строками: смена кодировки, удаление тегов из HTML текста, обработка
Переименование файлов из кириллицы в латиницу.
Выдача контекстной подсказки.
Частотный словарь символов.
Подсчет повторяющихся символов в строке.
Ссылочные переменные:
Моделирование стека.
Пасьянс "Косынка".
Игры:
Пасьянс "Косынка".
Игра "Питон"
Игра "Анацефал". Пример использования объектов.
Игра "Минное поле"
Большие проекты:
Электронная картотека (без исходника)


 
Сортировка методом Шелла.
Чтобы понять, как работает метод Шелла, необходимо разобраться в механизме работы метода вставки. Суть метода вставки состоит в следующем. Рассмотрим набор А[i], i=1,n.
Предположим, что первые k-1 элементов набора уже отсортированы. Тогда для k-того элемента необходимо найти такой индекс m (1<=m<=k-1) для которого бы выполнялось условие
A[m-1]<A[k]<A[m],
то есть найти место k-того элемента в уже отсортированном списке. (Если такого индекса нет, то это означает, что A[k]>A[k-1] и k-тый элемент уже стоит на своем месте.) Если такое место найдено, то необходимо переместить туда k-тый элемент.
В реальности это означает, что все элементы с m-того до k-1-го должны быть перемещены на позицию вправа, а на место m-того элемента поместить k-тый. Рассмотрим следующий набор.
-5 -3 1 12 14 9 17
В нашем случае: n=7, k=6, m=4. Действительно, первые 5 элементов уже отсортированы, а шестой элемент (9) надо поместить на четвертую позицию между 1 и 12.
На деле алгоритм работает следующим образом. На k-том шаге имеем k-1 отсортированных элементов. Берем k-тый элемент и начинаем его менять с соседним слева j-тым элементом до тех пор, пока он будет меньше соседнего слева элемента. j=k-1,k-2,..,m
Как только мы совершим k-m перестановок, k-тый шаг закончен и мы имеем k отсортированных элементов.
Описанный алгоритм выполняется для k=2,n.

Теперь рассмотрим метод Шелла. Предлагается рассматривать не весь набор, а разбить его на части. Как? Возьмем некое число t и будем рассматривать только те элементы начального набора, индекс которых кратен t: i=t,2t,3t...
Очевидно, что начальный набор будет разбит на t наборов*. В самом деле, для t=3 и описанного выше набора имеем
1-й набор: i=3,6 (A: 1,9)
2-й набор: i=1,4,7 (A: -5,12,17)
3-й набор: i=2,5 (A: -3,14)
Для каждого из наборов произведем сортировку по методу вставки. А затем уменьшим число t и рассмотрим уже другое разбиение А на наборы. Для получения отсортированного исходного набора необходимо, чтобы последнее значение t было 1. Например, последовательность значений t может быть такова: 3,2,1. Для быстрой сходимости хорошо зарекомендовала себя последовательность 9,5,3,2,1.
Необходимо отметить, что разбиение на наборы - условное, мы не рассматриваем полученные наборы совершенно отдельно, просто при сортировке мы работаем с элементами исходного набора, отстоящими друг от друга на расстояние t. Может возникнуть вопрос, зачем такие сложности, если в итоге мы все равно пришли к методу вставки при t=1? Однако использование наборов позволяет минимизировать число перестановок элементов, поскольку при больших t мы перемещаем элементы на большие расстояния.
* Если 2t>n, то число наборов будет меньше.
Рассмотрим сортировку по шагам.
Nt (gap)Typea[1]a[2]a[3]a[4]a[5]a[6]a[7]Примечание
00b 1621214-512-2Начальный вывод
15j 1621214-516-2Первый элемент идет на место шестого...
25i 1221214-516-2...а шестой на место первого
35j 1221214-5162Аналогично меняются местами второй и седьмой
45i 12-21214-5162
Уменьшаем t (gap) с 5 до 3
53i 12-21214-5162Первый с четвертым менять не надо
63j 12-21214-2162Второй и пятый меняем местами
73i 12-51214-2162
83i 12-51214-2162Третий с шестым менять не надо
93j 12-51214-21614Четвертый на место седьмого. По идее седмой (это двойка) должен идти на место четвертого, но седьмой меньше первого, посему на место четвертого идет первый... ...а седьмой отправляется на первое место.
103j 12-51212-21614
113i 2-51212-21614
Уменьшаем t (gap) с 3 до 2
122i 2-51212-21614Первый с третьим и второй с четвертым менять не надо
132i 2-51212-21614
142j 2-51212121614Третий идет на место пятого, первый на место третьго, а пятый идет на место первого.
152j 2-5212121614
162i -2-5212121614
172i -2-5212121614Четвертый с шетсым и пятый с седьмым менять не надо.
182i -2-5212121614
Уменьшаем t (gap) с 2 до 1
191j -2-2212121614Меняем первый со вторым
201i -5-2212121614
211i -5-2212121614
221i -5-2212121614
231i -5-2212121614
241i -5-2212121614
251j -5-2212121616Меняем шестой с седьмым
261i -5-2212121416
270= -5-2212121416Окончательный отсортированный набор
Итак, ниже приведен текст программы. Я специально не удалял отладочные комментарии, осуществлявшие вывод промежуточных результатов. Вообще говоря, я писал программу сортировки по Шеллу лет 15 назад, но следов ее у меня не осталось и мне поэтому пришлось писать сейчас ее заново. Полез в интернет посмотреть описание алгоритма, но они показались мне достаточно туманными, по крайней мере по тем описаниям написать программу не получилось. Чтобы разобраться взял готовый паскалевский текст (процедуру) и попробовал запустить... Не заработало... Текст этой неработающей процедуры приведен в самом низу. Тогда я взял текст процедуры на С и переписал это на Паскале. Это привело к успеху. И уже изучив промежуточные результаты я смог понять как это все работает. Я постарался изложить описание алгоритма доступно, чтобы было понятно, но, возможно, вам будет более понятно в другом изложении. Вариант на С был взят отсюда.
Чтобы сравнить время исполнения сортировки различными методами, включена процедура подсчета времени выполнения. Я сравнил сортировку по Шеллу с сортировкой методом вставки для n=7000. Шелл выполнился за 0.29 сек, а вставки - за 3.24 сек. Так что делайте выводы. Кстати, а что надо исправить в программе, чтобы из метода Шелла вышел метод вставки? ;-)

{ сортировка Шелла }
uses crt,timeunit;
const n=7000;
type DataItem=integer;
     DataArray=array[0..n-1] of DataItem;
var a:DataArray;
    i,nit:word;
    f:text;
    h, m, s, hund : Word;
Procedure PrintArr(a:DataArray);
  begin
  for i:=0 to n-1 do
    write(a[i]:4);
  end;
Procedure PrintArrF(s:string;k:integer;a:DataArray);
  begin
  write(f,nit:4,' h=',k,' ',s); nit:=nit+1;
  for i:=0 to n-1 do
    write(f,a[i]:4);
  writeln(f);
  end;
procedure Shell(var item: DataArray; n:integer);
const a:array[1..5] of byte = (9,5,3,2,1);
var i,j,k,gap:integer;
    temp:DataItem;
  begin
  for k:=1 to 5 do
    begin
    gap:=a[k];
    for i:=gap to n-1 do
      begin
      temp:=item[i];
      j:=i-gap;
      while (temp<item[j]) and (j>=0) do
        begin
        item[j+gap]:=item[j];
        j:=j-gap;
        {PrintArrF('j ',gap,item);}
        end;
      item[j+gap]:=temp;
      {PrintArrF('i ',gap,item);}
      end;
    end;
  end;
begin
writeln;
randomize;
for i:=0 to n-1 do
  begin
  a[i]:=random(30)-10;
  end;
assign(f,'shell_rs.txt');
rewrite(f);
nit:=0;
PrintArrF('b ',0,a);
{PrintArr(a);}
ResetTimePoint;    { Отметить начало отсчета времени }
Shell(a,n);
GetTimePoint(h,m,s,hund);
writeln(' Сортировка заняла ',h,' часов ',m,' минут ',s,'.',hund,' секунд.');
writeln;
{PrintArr(a);}
PrintArrF('= ',0,a);
close(f);
end.
(******************************)

{ Этот текст нужно скопировать в одтельный файл timeunit.pas }

unit timeunit;
interface
Procedure ResetTimePoint;    { Отметить начало отсчета времени }
Procedure GetTimePoint(var dh, dm, ds, dhund : Word);
{ Выдать время от начала отсчета. См. процедуру SetTimePoint  }
implementation
uses Dos;
type mytime=record
   h, m, s, hund : Word; end;
var timebeg,timecurr:mytime;
Procedure ResetTimePoint;    { Отметить начало отсчета времени }
  begin
  with timebeg do
    GetTime(h,m,s,hund);
  end;
Procedure GetTimePoint(var dh, dm, ds, dhund : Word);
Procedure DecHour(var t:mytime;dt:byte);
  begin
  if t.h>0 then dec(t.h);
  end;
Procedure DecMin(var t:mytime;dt:byte);
  begin
  if t.m>dt-1 then dec(t.m,dt) else
    begin
    t.m:=60+t.m-dt;
    DecHour(t,1);
    end;
  end;
Procedure DecSec(var t:mytime;dt:byte);
  begin
  if t.s>dt-1 then dec(t.s,dt) else
    begin
    t.s:=60+t.s-dt;
    DecMin(t,1);
    end;
  end;
Procedure DecDSec(var t:mytime;dt:byte);
  begin
  if t.hund>dt-1 then dec(t.hund,dt) else
    begin
    t.hund:=60+t.hund-dt;
    DecSec(t,1);
    end;
  end;
{ Выдать время от начала отсчета. См. процедуру SetTimePoint  }
  begin
  with timecurr do
    begin
    GetTime(h,m,s,hund);
    if hund>=timebeg.hund then dhund:=hund-timebeg.hund
      else begin dhund:=100+hund-timebeg.hund; DecSec(timecurr,1) end;
    if s>=timebeg.s then ds:=s-timebeg.s
      else begin ds:=60+s-timebeg.s; DecMin(timecurr,1) end;
    if m>=timebeg.m then dm:=m-timebeg.m
      else begin dm:=60+m-timebeg.m; DecHour(timecurr,1) end;
    if h>=timebeg.h then dh:=h-timebeg.h
                   else dh:=24+h-timebeg.h;
    end;
  end;
begin
ResetTimePoint
end.


{Все. Дальше пошли справочные материалы. Сначала текст на С, а потом неработающий на Паскале }
(*
void shall_sort(int *array, int n)
{
int i, j, k, gap, temp;
int a[] = {9, 5, 3, 2, 1};
for (k = 0; k < 5; k++) {
     gap = a[k];
     for (i = gap; i < n; i++) {
         temp = array[i];
         for (j = i-gap; temp < array[j] && j >= 0; j-=gap)
             array[j+gap] = array[j];
         array[j+gap] = temp;
     }
}
}
*)
procedure Shell1(var item: DataArray; count:integer);
{ doesn't work }
const t = 5;
var i, j, k, s, m: integer;
    h: array[1..t] of integer;
    x: DataItem;
  begin
  h[1]:=9; h[2]:=5; h[3]:=3; h[4]:=2; h[5]:=1;
  for m := 1 to t do
    begin
    k:=h[m];
    s:=-k;
    for i := k+1 to count do
      begin
      x := item[i];
      j := i-k;
      if s=0 then
        begin
        s := -k;
        s := s+1;
        item[s] := x;
        end;
      while (x<item[j]) and (j<count) do
        begin
        item[j+k] := item[j];
        j := j-k;
        end;
      item[j+k] := x;
      end;
    end;
  end; { конец сортировки Шелла }

 

 

 

 

 

 

 


HOME