% cv. 6 ; na 29.3.2017 (St) ; Jan Hric
% v. 1.3.4	29.3.2019
% 	19.4.2021

% Obsah: cv6

% v navaznosti na minule: 
% - operatory a vyrokove formule
%   - pomoci minuleho src: eval 
%   - CV: propagace non/1 dolu
% - tok dat: asynchronni odebirani ze seznamu  
% 	naCasti/3
% - heapsort
%   - rozbor
%   - vyroba tvaru haldy, 2x
%   - CV: heap2srt/2 a slucHaldy/3
%   DCv: zhalduj/2
% - vlozene operace
%   - idiom: generuj a testuj
% - priklady na setof/3, bagof/3


%%%%%%%%%% z minula: explicitni vysledky:
%
% compare/3: na prednasce
% ?- compare( < , 3, 5). % 1.arg je '<', '=', '>'
%
% - idiom: vysledky jako data
%   - nebo taky: vstupy jako data
% podobne pouziti: v Prologu pouzivane uspeje/neuspeje jsme v eval/3 (pro VF)
%   nahradili explicitnim true/false (a eval/3 vzdy uspeje)
% podobne pouziti: vysledky misto backtrackingu vracime jako seznam reseni


%%%%%%%%
:- op(210, xfy, [and]).  % def. operatoru and/2
:- op(220, xfy, or).  % def. operatoru 
:- op(200, fy, non).  % def. operatoru 
% - non/1 umozni display(non non a)).

%%%%%%%%%%%%%%%%%%%%%%%
% CV: propagace non/1 dolu pres non, and, or, a p/1 true/0, false/0
% zpracovavame i dve urovne dat.strukt, kdyz je potreba ...
propagNon(VF,VF) :- elementarniVF(VF).
propagNon(VF1 and VF2, V1 and V2) :- % nezjednodusujeme
  propagNon(VF1, V1),
  propagNon(VF2, V2).
propagNon(VF1 or VF2, V1 or V2) :-
  propagNon(VF1, V1),
  propagNon(VF2, V2).
% pri non/1 potrebujeme rozebrat dalsi uroven rekurze
propagNon(non VF, non VF) :- elementarniVF(VF). % konst. lze zjednodusovat
propagNon(non non VF, V) :- 
  propagNon(VF,V).	% vnorena VF je libovolna
propagNon(non (VF1 and VF2), V1 or V2) :- % 1. moznost: explitne
	% hlavni funktor a nasledne rekurze na args.
  propagNon( non VF1, V1),
  propagNon( non VF2, V2).
propagNon(non (VF1 or VF2), V) :- 	% 2. moznost: 1 krok 
	% na nejvyssi urovni a rekurze na celek
  propagNon( non VF1 and non VF2, V).
% ... rozbor případů u non/1

elementarniVF(VF):- 
  VF = p(_) ; 
  VF = true ;
  VF = false .

% pozn: tento priklad je zjednodusovani vyrazu podle pravidel, tj. 
%   interpret konkretnich funkcionalnich pravidel

tg1(V) :- propagNon( non(p(a) or non(p(b) or non(true))), V).

% cv: chceme zjednodusovat VF: zbavit se konstant
% non(true), true and p(X) ...


%%%%%%%%%%%%%%%%%%
% rozdel na casti: dualni k rozdilovym seznamum
%
% naCasti(+[Delky],+[Prvky],-[[Casti]]) :- ze seznamu Prvky ubere casti pozadovane Delky
%   Chceme: Delky se musi dat odebrat, prvků musi byt dost.
% priklad na tok dat

naCasti([],_,[]).
% naCasti([_|_],[],[]).  % jina okrajova podminka
naCasti([D|Ds],Xs,[V|Vs]):-
  uberCast1(D,Xs,V,Xs1),
  !, 	% mame reseni
  naCasti(Ds,Xs1,Vs).
% varianta: v dalsim argumentu zbyle prvky 

uberCast(D,Xs,V,Xs1) :-
  length(V,D),  % vyrobi seznam volnych promennych 
  append(V,Xs1,Xs).	% naplni ho
% length/2 nejdriv je ponekud efektivnejsi nez (opakovane) kontrolovani odebrane delky

% varianta, syntakticka 
uberCast1(0,Xs,[],Xs).	% to same, explicitni rekurze
uberCast1(D,[X|Xs],[X|V],Xs1) :-
  D>0, D1 is D-1,
  uberCast1(D1,Xs,V,Xs1).

% volani:
% ?- naCasti([1,2,3],[a,b,c,d,e,f,g,h,i],V]).
%  V=[[a],[b,c],[d,e,f]]
% ! tok dat:
% naCasti([1,2,3],Xs,[V1,V2,V3]) :-
%   uberCast(1,Xs,V1,Xs1), uberCast(2,Xs1,V2,Xs2), uberCast(3,Xs2,V3,_Xs3).
% vstupni seznam Xs se postupne zkracuje na Xs1, Xs2, ...

%%%%%%%%%%%
% between1(D,H,X) :- X je cele cislo mezi D a H vcetne, backtrackingem
% betweenL1(D,H,Xs) :- Xs je seznam reseni z predchazejiciho predikatu
% Vraci fail, resp. [], pokud D>H.
between1(D,H,D) :- D=H.
between1(D,H,X) :- 
  D<H, 	% test potrebujeme, jinak cykli
  D1 is D+1, between1(D1,H,X).

betweenL1(D,H,[]) :- D>H.
betweenL1(D,H,[D|Xs]) :- 
  D=<H, 
  D1 is D+1, betweenL1(D1,H,Xs).

% Q: jaky je rozumny/mozny interface, pokud chceme i klesajici posloupnosti?


%%%%%%%%%%%%%%%%%%%%%%%%%%
% heapSort: rozbor:
% heapsort (s binarni haldou)
% - postav tvar heapu, zhalduj, vybirej
%   - vyuziva rozdel/3
%   - stavba: prvek pro vrchol utrhnu hned
% - stavba: mozna impl.: stridat doleva a doprava
% - hned stavet haldu (rozdel a panuj)
%   - minimum do korene a zbytek rozdelit
%   - stavba v O(n log n)
%   - klasika je postavit 2 subhaldy a potom 1 prvek vlozit, O(n)
% - kapitansky krok (:navrhová technika): hloubka je porad logaritmicka
%   - (ani) pri vybirani nemusim udrzovat vyvazenou haldu
%     - posledni halda je neuplna 
%   - vybirani v O(n log n) celkem

% Pozn
% 1. Porad se tvori nove struktury, proto celkova spotreba pameti je O(n log n)
%    Maximalni spotreba (tj. velikost haldy) v nejakem okamziku je O(n)
%   - i jine alg. trideni se chovaji podobne 
% 2. V imperativnim programovani se pouziva reprezentace haldy v poli.
% Tuto *implementaci* zde nemuzeme pouzit (A1,A2), protoze nemame pole.
% Ale jsou jine implementace, ktere zachovaji asymptotickou slozitost O(n log n).
% (A1) Nemuzeme pouzit ani jine triky, ktere pouzivaji pole (napr. hasovani)
% (A2) LP/FP ma svoje triky/idiomy, kterymi napr. zachranite slozitost.
%   - pr: fronta amortizovane v O(1) (vlastne 2 impl.: neuplne seznamy a davkove obraceni),
%   - i oboustranna fronta amortizovane v O(1): neuplne seznamy uz nepomuzou 


%%%%%%%%%%%%%%%%%
% heapsort
% CV: slucovani hald
% (cv: postavHaldu(Ls,Heap) :- z +Ls vyrobi min-usporadanou -Heap)

heapsort(Ls,Vs):-
  mkHaldaKK(0,Ls,[],nil,Neheap), % vyrobi tvar haldy
  zhalduj(Neheap, Heap), % zajisti splneni haldovych podminek
  halda2srt(Heap,Vs).

%%%%%%%%%%
% CV , prevod haldy na usporadany seznam
halda2srt(nil,[]).
halda2srt(t(L,X,P), [X|Vs]):- 
  slucHaldy(L,P,H),
  halda2srt(H,Vs).

%%%%%%%%%  CV
% slucHaldy(L,P,V) :- slouci haldy L a P do V
% chybejici koren nereprezentujeme: 
%   - v podstate piseme specializovany alg. pro tuto situaci (:v koreni je tezky prvek)
%   - jina moznost: reprezentovat explicitne (napr. pomoci konstanty tezky/0)
%	a probublavat dolu s rozsirenym porovnavanim (zahrnujicim tezky/0)
%   - obecne: z rozebrane struktury posilame do rekurze podcasti
slucHaldy(nil, P,   P) :- !. % (A)
slucHaldy(L  , nil, L).  
  % :- L \= nil. % uprava pro neprekryvani podminek
slucHaldy(t(LL,LX,LP), t(PL,PX,PP), V) :-
  LX =< PX ->	V = t(VL,LX,t(PL,PX,PP)),	% bereme LX zleva
		slucHaldy(LL, LP, VL)
           ;	V = t(t(LL,LX,LP),PX,VP),	% bereme PX zleva
		slucHaldy(PL, PP, VP) .
% - (A) koncove podminky se bez rezu prekryvaji (pro slucHaldy(nil,nil,nil)); 
%	ale jsou deklarativne spravne i bez rezu.

% varianta: mame L a P vcelku, nejvyssi uroven struktury se nebuduje znova
% slucHaldy(L,P,V) :- 
%    L = t(LL,LX,LP), P = t(PL,PX,PP), 
%    ( LX <= PX  -> V = t(VL,LX,P), % P vcelku
%		    slucHaldy(_,_,VL)
%    ; ... )	% symetricky 
% - zavorky okolo if->then;else potrebujeme

%%%%%%%%%%%%%%%%%%
% - kapitansky krok: postupne zvetsovani hranice, exponencialne (tj. nasobne v kazdem kroku)
% - pro heapsort neprodukuje vyvazenou haldu, ale log. hloubka staci
% - cte data ve vstupnim poradi 

%%%%%%%%%%%%%%%%%%
% mkHaldaKK(+D,+Ls,-Ls0,+H1,-Heap) :- z Ls vyrabi haldu Heap hloubky D kapitanskym krokem, 
%	H1 je prubezne vyrobena, Ls0 jsou zbyle prvky
%  - přesněji: vyrobí pouze tvar haldy s log. hloubkou (haldová podmínka je ošetřena samostatně)
%  - progr.idiom: postupné (asynchronní) zpracování vstupu (v Ls, Ls0)
mkHaldaKK(_D,[],[],Heap,Heap).
mkHaldaKK(D ,[X|Ls1],Ls0,Heap1,Heap0) :-
  mkHaldaD(D,Ls1,Ls2,Heap2),
  D1 is D+1,
  mkHaldaKK(D1,Ls2,Ls0,t(Heap1,X,Heap2),Heap0).

% mkHaldaD(+D,+Ls1,-Ls0,-Heap) :- vyrobí tvar úplné haldy hloubky D, zbyle prvky v Ls0
mkHaldaD(0,Ls,Ls,nil) :- !. % rez kvuli druhe koncove podmince
mkHaldaD(_D,[],[],nil).     % dosly prvky
mkHaldaD(D,[X|Ls1],Ls0,t(H1,X,H2)):-
  D>0, D1 is D-1,
  mkHaldaD(D1,Ls1,Ls2,H1),
  mkHaldaD(D1,Ls2,Ls0,H2).
  % zahalduj(t(H1,X,H2),V).  % pri tvorbě haldy bychom ještě zahaldovali X 

tg2(Xs-V):- mkHaldaD(3,[e,d,c,b,a],Xs,V).
tg3(V):- mkHaldaKK(0,[e,d,c,b,a],[],nil,V).

/* mkHaldaD		mkHaldaKK
    e			    b
   / \			   / \
  d   a			  d   a
 / \			 / \
c   b			e   c

*/



%%%%%%%%%%%%%%
% vlozene operace: 
% - priklad na "generuj a testuj"
% vlozeni(Xs, Strom, V) :- doplnit mezi cifry aritmeticke operace +, -, *, / 
%	a spojeni cifer do cisla, aby vysel pozadovany vysledek.
vlozeni(Xs,Xs,V) :- sezNaCislo(Xs,0,V).
  % vlozeni(Xs,cislo(Xs),V) :- ...  % pokud chceme odlisovat cisla tagem
vlozeni(Xs,Strom,V):-
  % Strom = op(A1,Op,A2), % var s ops1/5: zakomentovat
  append(Xs1,Xs2,Xs), Xs1\=[], Xs2\=[], % (A)
  vlozeni(Xs1,A1,V1),
  vlozeni(Xs2,A2,V2),
  % ops(Op,V1,V2,V).	% povolene operace, vcetne semantiky (4.arg) 
  % ops1(Op,V1-A1,V2-A2,V,Strom). % pridani vystupni stromove syntaxe
  ops2(Op,V1-A1,V2-A2,V,Strom). % pridani vystupni stromove syntaxe; dovoluje i zaporne (mezi)vysledky

% Q: Proc jsou na (A) podminky na neprazdny seznam?

% vypocet hodnoty z cifer (desitkove) pozicni soustavy
sezNaCislo([],V,V).
sezNaCislo([X|Xs],V1,V0) :-
  V2 is V1*10+X,
  sezNaCislo(Xs,V2,V0).

ops(+,V1,V2,V) :- V is V1+V2.
ops(*,V1,V2,V) :- V is V1*V2.
ops(-,V1,V2,V) :- V is V1-V2, V >= 0.
ops(/,V1,V2,V) :- V2>0, V is V1 // V2, V1 mod V2 =:= 0. % vcetne testu

% pokud jsou operace známe, tak nepotřebujeme univ (=..), pro porovnání s ops2
ops1(+,V1-A1,V2-A2,V,A1+A2) :- V is V1+V2.
ops1(*,V1-A1,V2-A2,V,A1*A2) :- V is V1*V2.
ops1(-,V1-A1,V2-A2,V,A1-A2) :- V is V1-V2, V >= 0.
ops1(/,V1-A1,V2-A2,V,A1/A2) :- V2>0, V is V1 // V2, V1 mod V2 =:= 0. % vcetne testu

% varianta: "syntakticky" strom -[5arg] muzeme vyrobit pomoci =..
% ale vlastni vykonnou operaci pocitame samostatne pro ruzne funktory 
ops2(Fn,V1-A1,V2-A2,V,SStrom) :- 
  (Fn= +,V is V1+V2;Fn= *,V is V1*V2;Fn= -,V is V1-V2;Fn= /,V2\=0,V is V1//V2,V1 mod V2=:=0; fail),
  SStrom =.. [Fn,A1,A2].

% na rozmysleni: prevest vlozeni/3 na seznam vysledku

tg4(Strom):- vlozeni([4,4,4,4],Strom, 7).
tg5(Ns,Vysl):- vlozeni(Ns,_Strom, Vysl).


%%%%%%%%%% 
% priklady chovani
% setof, bagof,  - priklad
data(d1,[a1-b1-c1,a2-b1-c1,a2-b2-c1,a3-b2-c1,a3-b2-c2]).

tg10(V):-data(d1,Tab),setof(A, member(A-B-C,Tab), V).	% backtrackuje pres B,C
tg11(V):-data(d1,Tab),setof(A, B^member(A-B-C,Tab), V).	% backtrackuje pres C, prom. B je existencni
tg12(V):-data(d1,Tab),setof(A, B^C^member(A-B-C,Tab), V).	% nebacktrackuje, 1 vysl
tg13(V):-data(d1,Tab),setof(A, B^C^member(A-B-c3,Tab), V).	% fail, misto prazdneho seznamu
 
tg14(V):-data(d1,Tab),bagof(A, B^C^member(A-B-C,Tab), V).	% bagof: s opakovanim, 1 vysl

tg15(V):-data(d1,Tab),findall(A, member(A-B-C,Tab), V).	% findall, 1 vysl, s opakovanim


%%%%%%%%%%
% DCv: zhalduj(+Neheap, -Heap) :- vytvorena Heap zachova tvar Neheap, 
%	ale zajisti haldovou podminku (predek < potomek)

/* %%%%%%%%%% 
  dalsi:
  - na asynchronni odbirani vstupu:
    - minimovy strom, z ADS1
 	Vstup a_1 az a_n. Stavime binarni strom. V koreni je minimum posloupnosti, 
 	necht je to a_j. Pak levy podstrom je minimovy strom z a_1 az a_(j-1) a pravy 
	podstrom minimovy strom z a_(j+1) az a_n. Konstrukce v O(n), klasicky. Urcen jednoznacne.
  - varianty implementace:
    - rozdel a panuj
    - 1 pruchod (vime, ze to je deterministicke)
  - myslenka je podobna (jednopruchodove) *syntakticke* analyze vyrazu s operatory; 
*/ 

%%%%%%%%%%%%%%%%%%%%
% souhrn: co jste si vyzkouseli (nebo meli zvladnout):
% - operatory (opet)
% - zpracovani strukturovaneho vstupu (formuli VL)
% - (rozdilove seznamy a) asynchronni odebirani vstupu, predavani zbytku stavem
% - zexplicitneni dat
% - zpracovani termovych (tj. stromovych) struktur (opet)
% - generuj a testuj
% - chovani =../3 , arg/3, functor/3
%   - a setof/3, bagof/3 


%%%%%%%%%%%%%


%%%%%%%%%%%%%%%
% stromy, binarni: funktory: t/3, nil/0
% proc. prohledani/2, vyda casy otevreni a uzavreni vrcholů, v seznamu

/*  * /
/ *
*/

%%%%%%%%%%%%%%%%%%%%
% souhrn: co jste si vyzkouseli:
% -
% -
% -
% -
% -
% -
% -
% -

%%%%%%%%%%%%%%%%%%%%%%%%%%%
% runtime
check(Tested,=,Pattern) :- 
  Tested = Pattern -> write(passed),nl
                   ;  write(error),nl, 
		      write(value__(Tested)),nl, 
		      write(expected(Pattern)),nl.

%----------------

% k.
