fork download
copy 
  1. :- use_module(library(lists)).
  2.  
  3. % ----------------------------
  4. % задание 1: шелл (седжвик)
  5. % ----------------------------
  6.  
  7. % shs(+l, -s)
  8. shs(L, S) :-
  9.     length(L, N),
  10.     sg(N, Gs),
  11.     sp(Gs, L, S).
  12.  
  13. % sg(+n, -gs)
  14. sg(N, Gs) :-
  15.     ( N =< 1 -> Gs = [1]
  16.     ; sgk(N, 0, [], Rs),
  17.       reverse(Rs, Gs)
  18.     ).
  19.  
  20. sgk(N, K, A, Rs) :-
  21.     hk(K, H),
  22.     K1 is K + 1,
  23.     hk(K1, H1),
  24.     ( 3*H1 > N ->
  25.         Rs = [H|A]
  26.     ;   sgk(N, K1, [H|A], Rs)
  27.     ).
  28.  
  29. % hk(+k,-h)
  30. hk(K, H) :-
  31.     ( 0 is K mod 2 ->
  32.         P2k  is 1 << K,
  33.         K2   is K // 2,
  34.         P2k2 is 1 << K2,
  35.         H is 9*P2k - 9*P2k2 + 1
  36.     ;   P2k  is 1 << K,
  37.         K2   is (K + 1) // 2,
  38.         P2k2 is 1 << K2,
  39.         H is 8*P2k - 6*P2k2 + 1
  40.     ).
  41.  
  42. sp([], L, L).
  43. sp([G|Gs], L, S) :-
  44.     gp(G, L, L1),
  45.     sp(Gs, L1, S).
  46.  
  47. % gp(+g,+l,-s)
  48. gp(G, L, S) :-
  49.     en(L, 0, Ps),
  50.     G1 is G - 1,
  51.     findall(Ns, (between(0, G1, R), cls(Ps, G, R, Ns)), Bs),
  52.     append(Bs, All),
  53.     keysort(All, Ss),
  54.     vs(Ss, S).
  55.  
  56. cls(Ps, G, R, Ns) :-
  57.     include(pr(G, R), Ps, Cs),
  58.     iv(Cs, Vs1, Is1),
  59.     ins(Vs1, Vs2),
  60.     pi(Is1, Vs2, Ns).
  61.  
  62. pr(G, R, I-_) :- 0 is (I - R) mod G.
  63.  
  64. en([], _, []).
  65. en([X|Xs], I, [I-X|Ps]) :-
  66.     I1 is I + 1,
  67.     en(Xs, I1, Ps).
  68.  
  69. iv([], [], []).
  70. iv([I-V|T], [V|Vs], [I|Is]) :- iv(T, Vs, Is).
  71.  
  72. pi([], [], []).
  73. pi([I|Is], [V|Vs], [I-V|T]) :- pi(Is, Vs, T).
  74.  
  75. vs([], []).
  76. vs([_-V|T], [V|Vs]) :- vs(T, Vs).
  77.  
  78. % ins(+l,-s)
  79. ins([], []).
  80. ins([X|Xs], S) :- ins(Xs, S1), is1(X, S1, S).
  81.  
  82. % ----------------------------
  83. % Аналитическая оценка сложности сортировки Шелла (Sedgewick's sequence)
  84. % ----------------------------
  85.  
  86. % В среднем, для последовательности Седжвика, оценка O(N^(4/3)).  Это эмпирически полученная оценка.
  87. % В худшем случае (для других шагов) может быть O(N^(3/2)).
  88.  
  89. shellsort_complexity_analysis(Complexity) :-
  90.     Complexity = 'В среднем O(N^(4/3)). В худшем случае (для других шагов) O(N^(3/2)).'.
  91.  
  92. % Пример использования сортировки Шелла
  93.  
  94. % ----------------------------
  95. % задание 2: бинарные включения
  96. % ----------------------------
  97.  
  98. % bis(+l,-s)
  99. bis(L, S) :- bis1(L, [], S).
  100.  
  101. bis1([], A, A).
  102. bis1([X|Xs], A, S) :-
  103.     bin_ins(X, A, A1),
  104.     bis1(Xs, A1, S).
  105.  
  106. % bin_ins(+x,+l,-r)
  107. bin_ins(X, L, R) :-
  108.     length(L, N),
  109.     bin_pos(X, L, 0, N, P),
  110.     sp2(P, L, A, B),
  111.     append(A, [X|B], R).
  112.  
  113. % bin_pos(+x,+l,+lo,+hi,-p)
  114. bin_pos(X, L, Lo, Hi, P) :-
  115.     ( Lo >= Hi ->
  116.         P = Lo
  117.     ; M is (Lo + Hi) // 2,
  118.       nth0(M, L, V),
  119.       ( X =< V ->
  120.           bin_pos(X, L, Lo, M, P)
  121.       ; M1 is M + 1,
  122.         bin_pos(X, L, M1, Hi, P)
  123.       )
  124.     ).
  125.  
  126. % sp2(+k,+l,-a,-b)
  127. sp2(0, L, [], L) :- !.
  128. sp2(K, [X|Xs], [X|A], B) :-
  129.     K > 0,
  130.     K1 is K - 1,
  131.     sp2(K1, Xs, A, B).
  132.  
  133. % ----------------------------
  134. % Аналитическая оценка сложности бинарной вставки
  135. % ----------------------------
  136.  
  137. %  Общая сложность:  N * (O(log N) + O(N)) = O(N log N + N^2) = O(N^2)
  138.  
  139. binary_insertion_complexity_analysis(Complexity) :-
  140.     Complexity = 'O(N^2) в худшем и среднем случаях.'.
  141.  
  142. % ----------------------------
  143. % Сравнение алгоритмов
  144. % ----------------------------
  145.  
  146. compare_sort_algorithms :-
  147.     shellsort_complexity_analysis(ShellComplexity),
  148.     binary_insertion_complexity_analysis(BinaryComplexity),
  149.     format('Сравнение алгоритмов сортировки:~n', []),
  150.     format('  Сортировка Шелла (Sedgewick): ~w~n', [ShellComplexity]),
  151.     format('  Сортировка бинарными включениями: ~w~n', [BinaryComplexity]),
  152.     format('~n',[]),
  153.     format('  Для больших списков, сортировка Шелла (в среднем) более эффективна, чем сортировка бинарными включениями.~n',[]),
  154.     format('  Для небольших списков, константы, скрытые в O-нотации, могут сделать бинарные включения быстрее.~n',[]),
  155.     format('~n',[]),
  156.        format('Пример использования для списка L = [5, 2, 8, 1, 9, 4]:~n', []),   % Добавляем пример
  157.     L = [5, 2, 8, 1, 9, 4],
  158.     shs(L, SortedShell),
  159.     bis(L, SortedBinary),
  160.     format('  Исходный список: ~w~n', [L]),
  161.     format('  Сортировка Шелла дает: ~w~n', [SortedShell]),
  162.     format('  Бинарные включения дают: ~w~n', [SortedBinary]),
  163.      format('Сортировки дают одинаковый результат, но сложность алгоритмов разная. Для больших списков сортировка Шелла будет работать быстрее.~n',[]).
  164.  
  165. % Запуск сравнения
  166. start :-
  167.     compare_sort_algorithms.
Success #stdin #stdout #stderr 0.04s 7156KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
stderr
copy 
ERROR: '$runtoplevel'/0: Undefined procedure: program/0
   Exception: (3) program ? EOF: exit
https://ideone.com/dSfmTM
language:
Prolog (swi 7.6.4)
created:
3 days 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!