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. is1(X, [], [X]).
  83. is1(X, [Y|Ys], [X,Y|Ys]) :- X =< Y, !.
  84. is1(X, [Y|Ys], [Y|Zs]) :- is1(X, Ys, Zs).
  85.  
  86. % Оценка сложности сортировки Шелла (Sedgewick's sequence): O(N^(4/3)) в среднем, до O(N^(3/2))  в худшем случае
  87. shellsort_complexity(N, Complexity) :-
  88.     Complexity is N**(4/3).  % Средняя сложность
  89.  
  90. % Предикат для измерения времени выполнения
  91. time_sort(Predicate, InputList, SortedList, Time) :-
  92.     statistics(runtime, [T1, _]),
  93.     call(Predicate, InputList, SortedList),
  94.     statistics(runtime, [T2, _]),
  95.     Time is T2 - T1.
  96.  
  97.  
  98. % Пример использования сортировки Шелла
  99. ex_shs :-
  100.     L = [3, 1, 4, 1, 5, 9, 2, 6, 5, 3, 5],
  101.     time_sort(shs, L, S, Time),
  102.     length(L, N),
  103.     shellsort_complexity(N, Complexity),
  104.     format('Сортировка Шелла:~n'),
  105.     format('  Исходный список: ~w~n', [L]),
  106.     format('  Отсортированный список: ~w~n', [S]),
  107.    format('  Время выполнения: ~w мс~n', [Time]),
  108.     format('  Оценка сложности (O(N^(4/3))): ~w для N = ~w~n', [Complexity, N]).
  109.  
  110.  
  111. % ----------------------------
  112. % задание 2: бинарные включения
  113. % ----------------------------
  114.  
  115. % bis(+l,-s)
  116. bis(L, S) :- bis1(L, [], S).
  117.  
  118. bis1([], A, A).
  119. bis1([X|Xs], A, S) :-
  120.     bin_ins(X, A, A1),
  121.     bis1(Xs, A1, S).
  122.  
  123. % bin_ins(+x,+l,-r)
  124. bin_ins(X, L, R) :-
  125.     length(L, N),
  126.     bin_pos(X, L, 0, N, P),
  127.     sp2(P, L, A, B),
  128.     append(A, [X|B], R).
  129.  
  130. % bin_pos(+x,+l,+lo,+hi,-p)
  131. bin_pos(X, L, Lo, Hi, P) :-
  132.     ( Lo >= Hi ->
  133.         P = Lo
  134.     ; M is (Lo + Hi) // 2,
  135.       nth0(M, L, V),
  136.       ( X =< V ->
  137.           bin_pos(X, L, Lo, M, P)
  138.       ; M1 is M + 1,
  139.         bin_pos(X, L, M1, Hi, P)
  140.       )
  141.     ).
  142.  
  143. % sp2(+k,+l,-a,-b)
  144. sp2(0, L, [], L) :- !.
  145. sp2(K, [X|Xs], [X|A], B) :-
  146.     K > 0,
  147.     K1 is K - 1,
  148.     sp2(K1, Xs, A, B).
  149.  
  150. % Оценка сложности бинарной вставки: O(N^2) в худшем случае, O(N log N) в среднем (благодаря бинарному поиску)
  151. binary_insertion_complexity(N, Complexity) :-
  152.     Complexity is N*N.  % Или N * log(N) для среднего случая
  153.  
  154. % Пример использования бинарных включений
  155. ex_bis :-
  156.     L = [3, 1, 4, 1, 5, 9, 2, 6, 5, 3, 5],
  157.     time_sort(bis, L, S, Time),
  158.     length(L, N),
  159.     binary_insertion_complexity(N, Complexity),
  160.     format('Бинарные включения:~n'),
  161.     format('  Исходный список: ~w~n', [L]),
  162.     format('  Отсортированный список: ~w~n', [S]),
  163.         format('  Время выполнения: ~w мс~n', [Time]),
  164.     format('  Оценка сложности (O(N^2)): ~w для N = ~w~n', [Complexity, N]).
  165.  
  166. % Сравнение эффективности
  167. compare_sorts(List) :-
  168.     time_sort(shs, List, _, ShellSortTime),
  169.     time_sort(bis, List, _, BinaryInsertionTime),
  170.     length(List, N),
  171.     shellsort_complexity(N, ShellsortComplexity),
  172.     binary_insertion_complexity(N, BinaryInsertionComplexity),
  173.  
  174.     format('Сравнение сортировок:~n'),
  175.     format('  Список для сортировки: ~w~n', [List]),
  176.     format('  Длина списка (N): ~w~n', [N]),
  177.  
  178.     format('  Сортировка Шелла (Sedgewick):~n'),
  179.     format('    Время выполнения: ~w мс~n', [ShellSortTime]),
  180.     format('    Оценка сложности (O(N^(4/3))): ~w~n', [ShellsortComplexity]),
  181.  
  182.     format('  Сортировка бинарными включениями:~n'),
  183.     format('    Время выполнения: ~w мс~n', [BinaryInsertionTime]),
  184.     format('    Оценка сложности (O(N^2)): ~w~n', [BinaryInsertionComplexity]),
  185.  
  186.     (ShellSortTime < BinaryInsertionTime ->
  187.         format('  Вывод: Сортировка Шелла быстрее для данного списка.~n')
  188.     ;   format('  Вывод: Сортировка бинарными включениями быстрее для данного списка.~n')
  189.     ).
  190.  
  191.  
  192.  
  193. % ----------------------------
  194. % задание 3: "слово из домино" (игра)
  195. % ----------------------------
  196.  
  197. % igra(-w)
  198. igra(w(I, G, R, A)) :-
  199.     ds(Ts),
  200.     gr(Ts, 7, 42, Ti, T1), ch(Ti, I),
  201.     gr(T1, 7, 42, Tg, T2), ch(Tg, G),
  202.     gr(T2, 7, 42, Tr, T3), ch(Tr, R),
  203.     T3 = Ta, sm(Ta, 42), ch(Ta, A).
  204.  
  205. % ds(-ts)
  206. ds(Ts) :- findall(A-B, (between(0,6,A), between(A,6,B)), Ts).
  207.  
  208. % sm(+ts,-s)
  209. sm([], 0).
  210. sm([A-B|T], S) :-
  211.     sm(T, S1),
  212.     S is S1 + A + B.
  213.  
  214. % gr(+ts,+k,+s,-g,-r)
  215. gr(Ts, 0, 0, [], Ts) :- !.
  216. gr(Ts, K, S, [X|G], R) :-
  217.     K > 0, S >= 0,
  218.     select(X, Ts, T1),
  219.     X = A-B,
  220.     S1 is S - (A + B),
  221.     K1 is K - 1,
  222.     gr(T1, K1, S1, G, R).
  223.  
  224. % ch(+ts,-c)
  225. ch(Ts, C) :-
  226.     select(T, Ts, R),
  227.     or(T, A-B),
  228.     ch1(R, B, [A-B], C).
  229.  
  230. ch1([], _, A, C) :- reverse(A, C).
  231. ch1(Ts, X, A, C) :-
  232.     select(T, Ts, R),
  233.     or1(T, X-Y),
  234.     ch1(R, Y, [X-Y|A], C).
  235.  
  236. or(A-B, A-B).
  237. or(A-B, B-A).
  238.  
  239. or1(A-B, X-Y) :- (X=A, Y=B ; X=B, Y=A).
  240.  
  241. % Пример использования игры в домино
  242. ex_igra :-
  243.     igra(W),
  244.     format('Игра "Слово из домино":~n'),
  245.     format('  Решение: ~w~n', [W]).
  246.  
  247. % ----------------------------
  248. % задание 4 (вариант 2): вставка подсписка с i-го элемента
  249. % ----------------------------
  250.  
  251. % ins_sub(+sub,+l,+i,-r)
  252. ins_sub(Sub, L, I, R) :-
  253.     I >= 1,
  254.     K is I - 1,
  255.     sp2(K, L, P, S),
  256.     append(P, Sub, T),
  257.     append(T, S, R).
  258.  
  259. % Пример использования вставки подсписка
  260. ex_ins_sub :-
  261.     Sub = [7, 8, 9],
  262.     L = [1, 2, 3, 4, 5, 6],
  263.     I = 3,
  264.     ins_sub(Sub, L, I, R),
  265.     format('Вставка подсписка:~n'),
  266.     format('  Исходный список: ~w~n', [L]),
  267.     format('  Подсписок: ~w~n', [Sub]),
  268.     format('  Индекс вставки: ~w~n', [I]),
  269.     format('  Результат: ~w~n', [R]).
  270.  
  271. % Запуск всех примеров
  272. run_examples :-
  273.     ex_shs,
  274.     ex_bis,
  275.     List = [5, 2, 8, 1, 9, 4, 7, 3, 6, 0, 5, 2, 8, 1, 9, 4, 7, 3, 6, 0], % Пример списка для сравнения
  276.     compare_sorts(List),
  277.      ex_igra,
  278.     ex_ins_sub.
  279.  
  280.     ?- run_examples.
Success #stdin #stdout #stderr 0.15s 7360KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Сортировка Шелла:
  Исходный список: [3,1,4,1,5,9,2,6,5,3,5]
  Отсортированный список: [1,1,2,3,3,4,5,5,5,6,9]
  Время выполнения: 15 мс
  Оценка сложности (O(N^(4/3))): 24.463780996262468 для N = 11
Бинарные включения:
  Исходный список: [3,1,4,1,5,9,2,6,5,3,5]
  Отсортированный список: [1,1,2,3,3,4,5,5,5,6,9]
  Время выполнения: 0 мс
  Оценка сложности (O(N^2)): 121 для N = 11
Сравнение сортировок:
  Список для сортировки: [5,2,8,1,9,4,7,3,6,0,5,2,8,1,9,4,7,3,6,0]
  Длина списка (N): 20
  Сортировка Шелла (Sedgewick):
    Время выполнения: 0 мс
    Оценка сложности (O(N^(4/3))): 54.28835233189812
  Сортировка бинарными включениями:
    Время выполнения: 0 мс
    Оценка сложности (O(N^2)): 400
  Вывод: Сортировка бинарными включениями быстрее для данного списка.
Игра "Слово из домино":
  Решение: w([2-0,0-0,0-1,1-5,5-6,6-6,6-4],[1-4,4-0,0-3,3-6,6-0,0-5,5-5],[2-1,1-1,1-6,6-2,2-3,3-5,5-4],[1-3,3-3,3-4,4-4,4-2,2-2,2-5])
Вставка подсписка:
  Исходный список: [1,2,3,4,5,6]
  Подсписок: [7,8,9]
  Индекс вставки: 3
  Результат: [1,2,7,8,9,3,4,5,6]
stderr
copy 
ERROR: '$runtoplevel'/0: Undefined procedure: program/0
   Exception: (3) program ? EOF: exit
https://ideone.com/A56Wul
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!