% cv. 7 ; na 5.4.2017 (St) ; Jan Hric
% v. 1.1

% Obsah: cv7

% z minula: 
% - (tok dat: asynchronni odebirani ze seznamu)
% 	naCasti/3
% - heapsort - bylo
%   - rozbor - bylo
%   - vyroba tvaru haldy, 2x
%   - CV: heap2srt/2 a slucHaldy/3 
%   DCv: zhalduj/2  ; DC
% - vlozene operace
%   - idiom: generuj a testuj

% nove:
% - poznamky: 
%   - univ =.. , functor/3, arg/3
%   - v prikladu: setof, call
% - barveni grafu
% - derivace RV
% - zjednodusovani RV: idea

%%%%%%%%%% 
% z prednasky: 
% - univ =.. , podobne funktor/3 a arg/3
%   - term v PL 1. radu je elementarni nebo se znamym funktorem, nelze 
%	zapsat F(term1, term2) s promennou na miste funktoru
%    -> jednotlive funktory musime (po unifikaci) osetrit zvlastni klauzuli
%   - pouzivame, kdyz nezname funktory, pripadne program ma fungovat pro libovolne funktory
%     - priklady: pozbirani (prologovskych) promennych, pozbirani a frekvence konstant a funktoru
% ...
% - setof, bagof, findall


%%%%%%%%%%%%%%%%%%
% 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, ...


%%%%%%%%%%%%%%%%%%%%%%%%%%
% heapSort: rozbor:
% heapsort (s binarni haldou)
% - postav tvar heapu, zhalduj, vybirej
%   - vyuziva rozdel/3
%   - stavba: prvek pro vrchol utrhnu hned
% - stavba: doleva 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) asi
% - kapitansky krok: hloubka je porad logaritmicka
%   - (ani) pri vybirani nemusim udrzovat vyvazenou haldu
%     - posledni halda je neuplna 
%   - vybirani v O(n log n)


%%%%%%%%%%%%%%%%%
% heapsort
% CV: slucovani hald

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), Vs):- 
  true,
  halda2srt(_,Vs).

%%%%%%%%%  CV
% slucHaldy(L,P,V) :- slouci haldy L a P do V
slucHaldy(nil, P,   P).
slucHaldy(L  , nil, L).
slucHaldy(t(_LL,LX,_LP), t(_PL,PX,_PP), V) :-
  LX =< PX ->	V = t(_,_,_),
		slucHaldy(L, P, VV)
           ;	V = t(_,_,_),
		slucHaldy(L, P, VV) . 

% 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

%%%%%%%%%%%%%%%%%%
% - 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 ("jako stream"), nepotrebuje vedet velikost dat

%%%%%%%%%%%%%%%%%%
% mkHaldaKK(+D,+Ls,-Ls0,+H1,-Heap) :- z Ls vyrabi haldu Heap hloubky D kapitanskym krokem, 
%	H1 je prubezne vyrobena, Ls0 jsou zbyle prvky
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) :- vyrobi haldu 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).

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:
% vlozeni(Xs, Strom, V) :- doplnit mezi cifry aritmeticke operace +, -, *, / 
%	a spojeni cifer do cisla, aby vysel pozadovany vysledek V.
vlozeni(Xs,Xs,V) :- sezNaCislo(Xs,0,V).
  % vlozeni(Xs,cislo(Xs),V) :- sezNaCislo(Xs,0,V).  % pokud chceme odlisovat cisla tagem
vlozeni(Xs,Strom,V):-
  Strom = op(A1,Op,A2), % var s ops2/5: zakomentovat
  append(Xs1,Xs2,Xs), Xs1\=[], Xs2\=[],
  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

% varianta s ops2/5
vlozeni2(Xs,Xs,V) :- sezNaCislo(Xs,0,V).
  % vlozeni2(Xs,cislo(Xs),V) :- sezNaCislo(Xs,0,V).  % pokud chceme odlisovat cisla tagem
vlozeni2(Xs,Strom,V):-
  % Strom = op(A1,Op,A2), % var s ops2/5: zakomentovat
  append(Xs1,Xs2,Xs), Xs1\=[], Xs2\=[],
  vlozeni2(Xs1,A1,V1),
  vlozeni2(Xs2,A2,V2),
  % ops(Op,V1,V2,V).	% povolene operace, vcetne semantiky (4.arg) 
  ops2(_Op,V1-A1,V2-A2,V,Strom). % pridani vystupni stromove syntaxe, podstromy si musime predavat
	% v A1, A2.

% 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

ops2(+,V1-A1,V2-A2,V,A1+A2) :- V is V1+V2.
ops2(*,V1-A1,V2-A2,V,A1*A2) :- V is V1*V2.
ops2(-,V1-A1,V2-A2,V,A1-A2) :- V is V1-V2, V >= 0.
ops2(/,V1-A1,V2-A2,V,A1/A2) :- V2>0, V is V1 // V2, V1 mod V2 =:= 0. % vcetne testu

% ops/4, resp. ops2/5 dava do vztahu syntax (1. arg, resp. 1. a 5. arg) 
%	a semantiku (4. arg pocitany v tele)
% - v porovnani s eval/3 a propagNon/2 je struktura rekurze stejna pro vsechny funktory.
%   Muzeme proto napsat rekurzivni klauzuli spolecnou a odlisnosti (ve vystupu) schovat 
%   do ops/4 a ops2/5.

% testy:
% vlozeni([4,4,4,4],V,7).
% vlozeni2([4,4,4,4],V,7).

% na rozmysleni: prevest na seznam vysledku


%%%%%%%%%% 
% DCv: zhalduj(+Neheap, -Heap) :- vytvorena Heap zachova tvar Neheap, 
%	ale zajisti haldovou podminku (predek < potomek)
zhalduj(_,_).	% kvuli varovanim.


/* %%%%%%%%%% 
  dalsi:
  - na asynchronni odebirani 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.
    - analyza operatoru s ruznymi prioritami
    - analyza postfixniho vyrazu (hm, spis odebirani ze zasobniku)
*/ 

%%%%%%%%%%%
% barveni grafu: generuj a testuj
% - uplne prohledavani vs. heuristika 
%   - chci nejhure obarvitelne vrcholy nejdriv
% moznosti:
%   - barvime ve vstupnim poradi 
%   - staticky vyber vrcholu: primocare a chytreji
%   - dynamicky vyber vrcholu: 
%     - a druhotne kriterium
%   (- init: pro heuristiku, pro paralelni vypocet, pro odstraneni symetrii)

% testovaci grafy
g(trojuh, [a-b,a-c,b-c]).
g(gpetersen, [a0-b0,b0-c0,c0-d0,d0-e0,e0-a0, a0-a1,b0-b1,c0-c1,d0-d1,e0-e1,
	a1-c1,a1-d1,b1-d1,b1-e1,c1-e1 ]).
g(gchvatal, [a0-b0,b0-c0,c0-d0,d0-a0, a0-a1,a0-a2,b0-b1,b0-b2, c0-c1,c0-c2,d0-d1,d0-d2,
	a2-b1,b2-c1,c2-d1,d2-a1, a1-c1,a1-c2,a2-c1,a2-c2, b1-d1,b1-d2,b2-d1,b2-d2 ]).

% pomocne predikaty
% vrcholy z hran ; setof
vrcholy(Hrany,Vs) :- setof(V,U^(member(V-U,Hrany) ; member(U-V,Hrany)),Vs).
% vrcholy na tabulku [V-BarvaB]
vr2tab(Vrcholy,Tab) :- map(pridejVolnouProm,Vrcholy,Tab).
pridejVolnouProm(V,V-_BarvaV).
% map pouziva call/n

% vyroba cile pro call
% Hl je hloubka (pro vypisy), Tab je predavany stav, posledni cil je osetren specialne
hrany2cil(_Hl,_Tab, [] ,true) :-!.
hrany2cil( Hl, Tab, [X],obarviHr(Hl,Tab,X)) :- !. % posledni
hrany2cil( Hl, Tab, [X|Xs], (obarviHr(Hl,Tab,X),C0)):- 
  Hl1 is Hl+1, 
  hrany2cil( Hl1,Tab, Xs,C0).

% obarveni grafu, s pouzitim call/1
% barvy jsou v databazi
obarveni1(G,_Barvy,Init,Tab) :- 
  vrcholy(G,VG),          % write(VG), nl,
  vr2tab(VG,Tab),         % write(Tab),nl,
  initBarev(Init,Tab),    % write(Tab),nl, % inicializace  obarveni, pro rozklady
  hrany2cil(1,Tab,G,Cil), % write(Cil),nl,
  call(Cil),
  write(Tab),nl.

/* Tab: [a-_G610, b-_G616, c-_G622]	% pocatecni
   Cil: obarviHr(1, [a-_G610, b-_G616, c-_G622], a-b), 
 	obarviHr(2, [a-_G610, b-_G616, c-_G622], a-c), 
 	obarviHr(3, [a-_G610, b-_G616, c-_G622], b-c)
   Tab: [a-1, b-2, c-3] % koncova
*/

% obarveni jedne hrany, nedeterministicky
obarviHr(_Hl,Tab,U-V) :- 
  member(U-BU,Tab),
  member(V-BV,Tab), !, % deterministicke vybrani vrcholu
  barva(BU), barva(BV), % backtrackujeme pres barvy
  BU\=BV.

initBarev([],_Tab). % [vrchol-barva],Tab
initBarev([Par|Ps],Tab):-
  member(Par,Tab),
  initBarev(Ps,Tab).

% povolene barvy v databazi
barva(1).
barva(2).
barva(3).
barva(4).

% jine moznosti: predavat povolene barvy: [V-[BarvyV]]
%   pr: [a-[1,2],b-[2,3],c-[1,2,3]]
%   a) globalni seznam, 
%   b) vycet barev pro vrchol (muzou se lisit)
% impl.: barva2/3 (+TabulkaBarev, +Vrchol, -BarvaVrcholu), nedet.
barva2(TabB,U,BU) :-
  member(U-Bs,TabB),	% Bs: povolene barvy pro U
  member(BU,Bs).	% nedet. vyber
% ?- barva2([a-[1,2],b-[2,3],c-[1,2,3]], a, BU)
% BU = 1;
% BU = 2


% upravit # barev
th1(Tab):- g(gpetersen,Hr), obarveni1(Hr,_,[],Tab).
th2(Tab):- g(gchvatal,Hr), obarveni1(Hr,_,[],Tab).
% na testy
th1a(Tab):- g(gpetersen,Hr), obarveni1(Hr,_,[],Tab).
th2a(Tab):- g(gchvatal,Hr), obarveni1(Hr,_,[a0-1,a1-2,a2-3],Tab).
th1b(Tab):- g(trojuh,Hr), obarveni1(Hr,_,[],Tab).

%%%%%%%%%%%
% Cv: prelevani vody: nadoby 8l,5l,3l bez rysek; 8l je plna, ostatni prazdne, 
% 	chceme odmerit 4l vody v nektere nadobe.
% 	Povolene "tahy": preliti vody do vyprazdneni nebo naplneni nadoby.
%	vstup: [Objem-Naplneni]
%       popis: prelej(Odkud,Kam)-[NoveNaplneni]
% ?- prelevani([8-8,5-0,3-0],Cesta) % kdybychom chteli 2l
%   Cesta = [prelej(8,3)-[5,0,3], prelej(3,5)-[5,3,0], prelej(8,3)-[2,3,3]]


%%%%%%%%%%%
% reg. vyrazy:
% struktura: p/1, lambda/0, empty/0, seq/2, */1, +/2 

% cv: obsahujeL(+RV) :- uspeje, pokud RV prijima lambda
%   varianta: vraci true/false
% cv: derivace vyrazu podle pismena (a/nebo slova), nezjednodusene
%     derRV(+RV,+P,-D) :- D je derivace RV podle pismena P

%%%%%%
% derivace RV podle slova S vyda D: 
% derSlRV(+RV,+S,-D) ; standardne rekurzi po pismenkach
derSlRV(RV,[],RV).
derSlRV(RV1,[P|Ps],RV0) :-
  derRV(RV1,P,RV2),
  derSlRV(RV2,Ps,RV0).

/*
Reg. vyrazy. 
Cv: derivace RV podle pismena
struktura RV: 
+/2, 
* / 1, 
seq/2, 
p/1 pismeno, 
lambda/0 prazdne slovo, 
empty/0 prazdny jazyk
pr: p(b) seq (p(a)+ *(p(c)))
  - nacteni vyrazu ho prevede do interniho (stromoveho/naparsovaneho) tvaru
Pozn: zavorky jsou pomocne symboly a v popisu struktury se nevyskytuji

derivace RV podle (jednoho) pismena, bez zjednodusovani: derRV(RV,Pism,DerRV)/3
Cv: zobecnete na derivaci podle slova
Cv: zjednodusovani, aspon trochu
Cv: prevod bohatsiho RV (any/0, +/1, opt/1 0-1) na chudy tvar, pro "any" potrebuju abecedu 
*/

% definice pouzitych operatoru, */1 spis prefixni nez postfixni, a s malou precedenci
:- op(250,xfy,seq).

derRV(lambda,_,empty).	% vzdy chceme vydat nejaky jazyk, pripadne prazdny :-)
derRV(empty ,_,empty).
derRV(RV1+RV2, P, D1+D2) :-
  derRV(RV1,P,D1), derRV(RV2,P,D2).
derRV(*(RV1), P, seq(D1,*(RV1)) ) :-
  derRV(RV1,P,D1).
derRV(p(P),P,lambda) :- !.
derRV(p(_P1),_P,empty). % jine pismeno, nedeklarativni, kvuli rezu
  % idiom: p/1 mi umoznuje vyhnout se zachytne (catch-all) klauzuli pro "ostatni" znaky
derRV(seq(RV1,RV2), P, D0) :-
  derRV(RV1,P,D1), derRV(RV2,P,D2), % nelze dat do podminky, 
		% protoze potrebujeme v else vetvi
  ( obsahujeL(RV1) -> 		% obecne: first(RV1,First), member(lambda,First) ->
      D0 = seq(D1, RV2) + D2
  ;   D0 = seq(D1, RV2)
  ).
/* Pozn: RV v _zavorkach_ v programu neosetrujeme
 - zavorky se zpracuji pri syntakticke analyze a v internim tvaru se proto nevyskytuji
 - klauzule pro "obsluhu" zavorek by zpusobila zacykleni:
    derRV( (RV1), P, D1) :- derRV(RV1,P,D). 
*/

% obsahujeL(RV) :- RV prijme lambda
% obsahujeL(empty).	% empty neobsahuje lambda -> nechceme konc. podm
% obsahujeL(p(_)).	% dtto
obsahujeL(lambda).
obsahujeL(*(_)).
obsahujeL(RV1+RV2) :- obsahujeL(RV1) ; obsahujeL(RV2). % pripadne se splni 2x: once/1 nize
obsahujeL(seq(RV1, RV2)) :- obsahujeL(RV1), obsahujeL(RV2).

% testy:
% obsahujeL(lambda seq p(a)).
% obsahujeL(lambda seq *(p(a))).
% obsahujeL(lambda + *(p(a))).	% je nedeterministicke, bohuzel :-(

% Cv: naprogramujte first/2: first(RV,First), First je seznam (reprezentujici mnozinu) 
% moznych prvnich pismen a pripadne lambda ; pokud jste meli first

% hacker's corner:
%once(Pred) :- call(Pred),!.	% splni se jednou
% omezene kvantifikace: forall z prednasky TD

%%%%%%%
% zjednodusovani (nejen RV): idea:
% - strukturalni rekurze, rozbor pripadu
% - neuplne 
zjedn(RV1 + RV2, V) :-
  zjedn(RV1,V1),
  zjedn(RV2,V2),
  zjedn1krok(V1+V2,V), !.
% ...
zjedn(RV1,RV1).	% catch-all klauzule, zde osetreni koncovych pripadu rekurze

% chceme pouze 1. reseni
zjedn1krok(empty+V2,     V2).
zjedn1krok(   V1+empty,  V1).
zjedn1krok(lambda+ *(V2), *(V2)).
zjedn1krok( *(V1)+lambda,*(V1)).
zjedn1krok( *(*(RV)),    *(RV)).
% ...
zjedn1krok(RV,           RV). % catch-all klauzule, na konci

% pr: zjedn(lambda+empty+p(a),V).
% pr: zjedn(lambda+empty+ *(p(a)),V).

%%%%%%%%%%%%%%%%%%%%
% souhrn: co jste si vyzkouseli (nebo meli zvladnout):
% - (rozdilove seznamy a) asynchronni odebirani vstupu, predavani zbytku stavem
% - generuj a testuj
%   - struktury na vystupu
%   - prohledavani
% - setof a spol.
% - 


%%%%%%%%%%%%%
/*  * /
/ *
*/

%%%%%%%%%%%%%%%%%%%%
% souhrn: co jste si vyzkouseli:
% -

%%%%%%%%%%%%%%%%%%%%%%%%%%%
% runtime

% map(+P,+Ins,-Outs) 
map(_P,[],[]).
map( P,[I|Is],[O|Os]) :- 
  call(P,I,O), 	% rozsireny call/n, misto call/1
    % call/n: I a O se pridaji jako posledni dva argumenty P, i pokud P uz argumenty ma
  map( P,Is,Os).


check(Tested,=,Pattern) :- 
  Tested = Pattern -> write(passed),nl
                   ;  write(error),nl, 
		      write(value__(Tested)),nl, 
		      write(expected(Pattern)),nl.

%----------------

% k.
