fork download
copy 
  1. % Сортировка списка методом Шелла с использованием последовательности Седжвика
  2.  
  3. % shell_sort(+List, -SortedList)
  4. %   List - исходный список
  5. %   SortedList - отсортированный список
  6. shell_sort(List, SortedList) :-
  7.   length(List, N),
  8.   sedgewick_sequence(N, Steps),
  9.   shell_sort_with_steps(List, Steps, SortedList).
  10.  
  11. % shell_sort_with_steps(+List, +Steps, -SortedList)
  12. %   List - список для сортировки
  13. %   Steps - список шагов (расстояний)
  14. %   SortedList - отсортированный список
  15. shell_sort_with_steps(List, [], List).  % Базовый случай: нет шагов, список отсортирован
  16.  
  17. shell_sort_with_steps(List, [H|T], SortedList) :-
  18.   gap_insertion_sort(List, H, InterList),
  19.   shell_sort_with_steps(InterList, T, SortedList).
  20.  
  21. % gap_insertion_sort(+List, +Gap, -SortedList)
  22. % Сортировка вставками с заданным шагом (gap).
  23. % На самом деле правильнее это называть gap exchange sort, т.к. это не совсем вставка, а скорее
  24. % сравнение и обмен элементов на расстоянии Gap. Для простоты оставим название "insertion sort"
  25.  
  26. gap_insertion_sort(List, Gap, SortedList) :-
  27.   length(List, N),
  28.   gap_insertion_sort_loop(List, Gap, N, SortedList).
  29.  
  30. gap_insertion_sort_loop(List, Gap, N, SortedList) :-
  31.   gap_insertion_sort_loop(List, Gap, N, 0, SortedList).
  32.  
  33. gap_insertion_sort_loop(List, Gap, N, I, SortedList) :-
  34.   I >= N,
  35.   !,
  36.   List = SortedList.
  37.  
  38. gap_insertion_sort_loop(List, Gap, N, I, SortedList) :-
  39.   J is I + Gap,
  40.   J >= N,
  41.   !,
  42.   I1 is I + 1,
  43.   gap_insertion_sort_loop(List, Gap, N, I1, SortedList).
  44.  
  45. gap_insertion_sort_loop(List, Gap, N, I, SortedList) :-
  46.   J is I + Gap,
  47.   element_at_index(List, I,  ElemI),
  48.   element_at_index(List, J,  ElemJ),
  49.   (
  50.     ElemI > ElemJ ->
  51.       swap_elements(List, I, J, NewList),
  52.       I1 is max(0, I-Gap),
  53.       gap_insertion_sort_loop(NewList, Gap, N, I1, SortedList)
  54.     ;
  55.       I1 is I + 1,
  56.       gap_insertion_sort_loop(List, Gap, N, I1, SortedList)
  57.   ).
  58.  
  59. % element_at_index(+List, +Index, -Element)
  60. % Возвращает элемент списка по заданному индексу (начиная с 0).
  61. element_at_index(List, Index, Element) :-
  62.     nth0(Index, List, Element).
  63.  
  64. % swap_elements(+List, +Index1, +Index2, -NewList)
  65. %  Меняет местами элементы с индексами Index1 и Index2 в списке List, возвращая новый список NewList
  66. swap_elements(List, Index1, Index2, NewList) :-
  67.   element_at_index(List, Index1, Elem1),
  68.   element_at_index(List, Index2, Elem2),
  69.   replace_element_at_index(List, Index1, Elem2, TempList),
  70.   replace_element_at_index(TempList, Index2, Elem1, NewList).
  71.  
  72. % replace_element_at_index(+List, +Index, +NewElement, -NewList)
  73. % Заменяет элемент с заданным индексом в списке List на NewElement, возвращая новый список NewList
  74. replace_element_at_index(List, Index, NewElement, NewList) :-
  75.   replace_element_at_index_helper(List, Index, NewElement, 0, [], NewList).
  76.  
  77. replace_element_at_index_helper([_|Rest], Index, NewElement, CurrentIndex, Acc, NewList) :-
  78.   Index =:= CurrentIndex,
  79.   !,
  80.   append(Acc, [NewElement|Rest], NewList).
  81.  
  82. replace_element_at_index_helper([H|Rest], Index, NewElement, CurrentIndex, Acc, NewList) :-
  83.   CurrentIndex < Index,
  84.   NewCurrentIndex is CurrentIndex + 1,
  85.   replace_element_at_index_helper(Rest, Index, NewElement, NewCurrentIndex, [H|Acc], NewList).
  86.  
  87. % sedgewick_sequence(+N, -Steps)
  88. %   N - длина списка
  89. %   Steps - последовательность шагов Седжвика (в обратном порядке)
  90. sedgewick_sequence(N, Steps) :-
  91.   sedgewick_sequence_helper(1, N, [], Steps).
  92.  
  93. sedgewick_sequence_helper(K, N, Acc, Steps) :-
  94.     (is_even(K) ->
  95.         H is 9 * (2**K) - 9 * (2**(K / 2)) + 1
  96.     ;
  97.         H is 8 * (2**K) - 6 * (2**((K + 1) / 2)) + 1
  98.     ),
  99.     (   3 * H > N ->
  100.         reverse(Acc, Steps) % Return the reversed sequence
  101.     ;   sedgewick_sequence_helper(K,H,N, Acc, Steps)
  102.         NewAcc = [H|Acc],
  103.         Knext is K + 1,
  104.         sedgewick_sequence_helper(Knext, N, NewAcc, Steps)
  105.     ).
  106.  
  107. sedgewick_sequence_helper(K, H, N, Acc, Steps) :-
  108.     (   3 * H > N ->
  109.         reverse(Acc, Steps) % Return the reversed sequence
  110.     ).
  111.  
  112.  
  113. is_even(Number) :-
  114.   Number mod 2 =:= 0.
  115.  
  116. % Примеры использования и ожидаемый вывод (для ideone.com или другого Prolog-интерпретатора)
  117.  
  118. % Пример 1:
  119. % ?- shell_sort([9, 5, 1, 4, 3, 7, 2, 8, 6], Sorted).
  120. % Sorted = [1, 2, 3, 3, 4, 5, 6, 7, 8, 9]
  121.  
  122. % Пример 2:
  123. % ?- shell_sort([5, 2, 8, 1, 9, 0, 4, 7, 3, 6], Sorted).
  124. % Sorted = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
  125.  
  126. % Пример 3:
  127. % ?- shell_sort([10, 9, 8, 7, 6, 5, 4, 3, 2, 1], Sorted).
  128. % Sorted = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
  129.  
  130. % Пример 4:
  131. % ?- shell_sort([1,2,3,4,5,6,7,8,9,10], Sorted).
  132. % Sorted = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
  133.  
  134. % Пример 5:  Empty List
  135. % ?- shell_sort([],Sorted).
  136. % Sorted = []
  137.  
  138. % Вывод нескольких примеров сразу (для удобства просмотра на ideone):
  139. run_examples :-
  140.     test_shell_sort([9, 5, 1, 4, 3, 7, 2, 8, 6]),
  141.     test_shell_sort([5, 2, 8, 1, 9, 0, 4, 7, 3, 6]),
  142.     test_shell_sort([10, 9, 8, 7, 6, 5, 4, 3, 2, 1]),
  143.     test_shell_sort([1,2,3,4,5,6,7,8,9,10]),
  144.     test_shell_sort([]).
  145.  
  146. test_shell_sort(List) :-
  147.     shell_sort(List, Sorted),
  148.     format('Original list: ~w~n', [List]),
  149.     format('Sorted list:   ~w~n~n', [Sorted]).
  150.  
  151. % To run all examples, uncomment the following line after loading the code:
  152. % ?- run_examples.
Success #stdin #stdout #stderr 0.03s 6984KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
stderr
copy 
Warning: /home/oUfkbA/prog:33:
	Singleton variables: [Gap]
ERROR: /home/oUfkbA/prog:102:7: Syntax error: Operator expected
Warning: /home/oUfkbA/prog:107:
	Singleton variables: [K]
ERROR: '$runtoplevel'/0: Undefined procedure: program/0
   Exception: (3) program ? EOF: exit
https://ideone.com/SxDh7G
language:
Prolog (swi 7.6.4)
created:
21 hours ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!