HOME

Několik příkladů v jazyce Prolog

Při mém studiu programovacích jazyků a programování obecně jsem se často setkával s problémem, že jsem neměl k dispozici příklady, které by byly "těžké tak akorát". Proto jsem se vlastně rozhodl vytvořit tyhle stránky. Příklady, které sem budu postupně dávat jsou převážně moje přípravy na písemky. Jsou obtížností takové, aby Šli snadno pochopit, a zároveň aby nebyly zcela triviální (teda alespoň pro mě :-). Užijte si to.

Nalezení následující permutace

   
     %Nalezeni nasledujici permutace
     %===============================================================
     %np([4,7,5,6,1,2,3],Vys). => Vys =[4,7,5,1,2,3,6]



     rew(A,B):-rw(A,[],B).
     rw([],X,X).
     rw([X|T],Neco,Vys):-rw(T,[X|Neco],Vys).

     conc([],B,B).
     conc([X|T],B,[X|Vys]):-conc(T,B,Vys).

     %klesajici(Sez,Kles,Zbyt).
     %najde v posloupnosti klesajici zacatek a ten da do Kles, Zbytek je zbyl
     %konec posloupnosti

     klesajici([],[],[]).
     klesajici([X],[X],[]).
     klesajici([X,Y|T],[X|R],Zbyt):- X > Y,klesajici([Y|T],R,Zbyt).
     klesajici([X,Y|T],[X],[Y|T]):-X > Y.

     np(Perm,NextPerm):-rew(Perm,RewPerm),klesajici(RewPerm,[Y|Rost],[X|Zbyt]),
                conc([X|Rost],[Y|Zbyt],RewNextPerm),rew(RewNextPerm,NextPerm).


     test:-data(X,[4,7,5,6,1,2,3]),np(X,Vys),write('Nasledujici permutace k '),nl,
	       write(X),write('je '),
	       write(Vys).
   
   Mimochodem v tomhle mě nekdo řikal, že je chyba.. asi jo, kdyz na to tak koukam, to co tam je není nasledující permutace..
   Ale myšlenka v tom je, nebylo by težké to předělat...
   Pokud to někdo opravíte, budu vděčný za řešení...
  

Aritmetika binárních čísel zadaných jako seznam {0,1}.. Vcelku nic nového, taková etida na procvičení práce se seznamy.

   
   %scitani dvou binarnich cisel
   %==============================================================================
   %secti(Sez1,Sez2,Vys)
   secti(A,B,Vys):-rew(A,RewA),rew(B,RewB),sec(0,RewA,RewB,[],Vys).

   %otoceni seznamu
   rew(A,RewA):-rewerse(A,[],RewA).
   rewerse([],Vys,Vys).
   rewerse([X|T],S,Vys):-rewerse(T,[X|S],Vys).

   %pomocny predikat pro scitani..skolni metoda scitani dvou binarnich cisel
   %dostane otocena cisla a prechod z nizsiho radu a realizuje scitani
   sec(0,[],[],X,X).
   sec(1,[],[],X,[1|X]).
   sec(1,[],X,A,Vys):-sec(0,[1],X,A,Vys).
   sec(1,X,[],A,Vys):-sec(0,X,[1],A,Vys).
   sec(0,[],[X|T],A,Vys):-sec(0,[],T,[X|A],Vys).
   sec(0,[X|T],[],A,Vys):-sec(0,T,[],[X|A],Vys).
   sec(0,[0|T],[0|R],A,Vys):-sec(0,T,R,[0|A],Vys).
   sec(0,[0|T],[1|R],A,Vys):-sec(0,T,R,[1|A],Vys).
   sec(0,[1|T],[0|R],A,Vys):-sec(0,T,R,[1|A],Vys).
   sec(0,[1|T],[1|R],A,Vys):-sec(1,T,R,[0|A],Vys).
   sec(1,[0|T],[0|R],A,Vys):-sec(0,T,R,[1|A],Vys).
   sec(1,[0|T],[1|R],A,Vys):-sec(1,T,R,[0|A],Vys).
   sec(1,[1|T],[0|R],A,Vys):-sec(1,T,R,[0|A],Vys).
   sec(1,[1|T],[1|R],A,Vys):-sec(1,T,R,[1|A],Vys).

   %nasobeni dvou cisel v binarnim tvaru.
   %nasob(Sez1,Sez2,Vys)

   %posun doleva
   %shl(Sez, Vys)
   %shl(
   shl([],[0]).
   shl([X|Xs],[X|Vys]):-shl(Xs,Vys).

   %nasob(A,B,C)  ma vyznam C = A * B
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   nasob(A,B,Vys):-rew(B,RewB),nas(A,RewB,[],Vys).
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

   nas(_,[],Vys,Vys).
   nas(A,[0|T],Akum,Vys):-shl(A,NewA),nas(NewA,T,Akum,Vys).
   nas(A,[1|T],Akum,Vys):-secti(Akum,A,NewAkum),shl(A,NewA),nas(NewA,T,NewAkum,Vys).

   %umocnovani cisel v binarnim tvaru
   %umocni(A,B,C) ma vyznam C = A^B
   %procedure je napsana zpusobem (A^n = A^(n/2), pro n sude, A^n =A*A^(n-1) pro a liche

   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   exp(A,B,Vys):-rew(B,RewB),expon(A,RewB,[1],Vys).
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   expon(_,[],Vys,Vys).
   expon(A,[0|T],Akum,Vys):-nasob(A,A,SqrA),expon(SqrA,T,Akum,Vys).
   expon(A,[1|T],Akum,Vys):-nasob(A,Akum,NewAkum),nasob(A,A,SqrA),expon(SqrA,T,NewAkum,Vys).

   %conc (A,B,C) zretezi seznamy A,B do C
   conc([],L,L).
   conc([X|T],L,[X|Vys]):-conc(T,L,Vys).


   %deleni se zbytkem v binarnim tvaru.
   % ma vyznam C = A/B
   % ma vyznam D = A mod B
   %del(A,B,C,D)
   %procedura pracuje zcela primocare, jde ji udelat i efektivneji s obracenymi cisly!!
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   del(A,B,Vys,Zbyt):-d(A,B,[],[],RewVys,Zbyt_),rew(RewVys,Vys_),trimZero(Vys_,Vys),trimZero(Zbyt_,Zbyt).
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   d([],_,Zacatek,Akum,Akum,Zacatek).
   d([X|T],B,Zacatek,Akum,RewVys,Zbyt):-write(Akum),write(Zacatek),nl,odecti(Zacatek,B,Status,NewZacatek),conc(NewZacatek,[X],NewNewZacatek),d(T,B,NewNewZacatek,[Status|Akum],RewVys,Zbyt).

   %"specielni odecti "pro ucely deleni,do  vraci vysledek, do Status vraci{0,1},podle toho, jestli A>B"
   %nimje Zbytek je vlastne vysledek odecitani nebo puvodni cislo pred odecita
   odecti(A,B,Status,Zbyt):-rew(A,RewA),rew(B,RewB),od(A,RewA,RewB,0,[],Status,Zbyt_),trimZero(Zbyt_,Zbyt).

   od(A,[],[_|_],0,_,0,A).
   od(_,[],[],0,Akum,1,Akum).
   od(_,[K|L],[],0,Akum,Stat,Vys):-od(_,[K|L],[0],0,Akum,Stat,Vys).
   od(_,[K|L],[],1,Akum,Stat,Vys):-od(_,[K|L],[1],0,Akum,Stat,Vys).
   od(A,[0|T],[0|L],0,Akum,Stat,Vys):-od(A,T,L,0,[0|Akum],Stat,Vys).
   od(A,[1|T],[0|L],0,Akum,Stat,Vys):-od(A,T,L,0,[1|Akum],Stat,Vys).
   od(A,[0|T],[1|L],0,Akum,Stat,Vys):-od(A,T,L,1,[1|Akum],Stat,Vys).
   od(A,[1|T],[1|L],0,Akum,Stat,Vys):-od(A,T,L,0,[0|Akum],Stat,Vys).
   od(A,[1|T],[1|L],1,Akum,Stat,Vys):-od(A,T,L,1,[1|Akum],Stat,Vys).
   od(A,[1|T],[0|L],1,Akum,Stat,Vys):-od(A,T,L,0,[0|Akum],Stat,Vys).
   od(A,[0|T],[1|L],1,Akum,Stat,Vys):-od(A,T,L,1,[0|Akum],Stat,Vys).
   od(A,[0|T],[0|L],1,Akum,Stat,Vys):-od(A,T,L,1,[1|Akum],Stat,Vys).


   %oreze nuly ze zacatku seznamu.
   trimZero([],[]).
   trimZero([0|X],L):-trimZero(X,L).
   trimZero([1|X],[1|X]):-!.


   
  

Vyhodnoceovani aritmetického vyrazu s proměnnými

   

   %vyhodnocovani vyrazu s promennymi.
   %===========================================================================
   %promenne jsou zadane v seznamu Vars v tvaru variable#value

   %nejdrive si nadefinujeme operator # pro pojeni v seznamu promennych
   :-op(800,xfx,#).

   eval2(X+Y,Vys,Vars):-eval2(X,XVys,Vars),eval2(Y,YVys,Vars),Vys is XVys+YVys.
   eval2(X-Y,Vys,Vars):-eval2(X,XVys,Vars),eval2(Y,YVys,Vars),Vys is XVys-YVys.
   eval2(X*Y,Vys,Vars):-eval2(X,XVys,Vars),eval2(Y,YVys,Vars),Vys is XVys*YVys.
   eval2(X/Y,Vys,Vars):-eval2(X,XVys,Vars),eval2(Y,YVys,Vars),Vys is XVys/YVys.

   eval2(Vys,Vys,_):-number(Vys).
   eval2(Var,Value,Vars):- atom(Var),member(Var#Value,Vars).

   %pomocny predikat member
   %uspeje, pokud je Prv prvkem seznamu Sez.
   %member(Prv,Sez)
   member(X,[X|_]).
   member(X,[_|T]):-member(X,T).

   data(X,X).

   test:- data(5*3+6*x+3*y,X),data(Vars, [x#3,y#8]),write('Vyraz '),write(X),write(' ma pro promenne '),write(Vars),write('hodnotu'),eval2(X,Val,Vars),write(Val).


   
  

Dijkstrův algoritmus

Je,spolu s mnoha dalšími pěknými příklady, na stránkách RNDr. Romana Bartáka(anglicky)
Je zbytečné opisovat sem cizí kód.

Obarveni grafu

   
   %program na hledani obarveni grafu
   %pouzita metoda je generuj a testuj
   %====================================================================
   %obarvi(Graf,MozneBarvy,Obarveni)
   obarvi(g(V,E),MozneBarvy,Obarveni):-
   ob(V,E,MozneBarvy,[],Obarveni).

   %ob(Vertices,Edges,PossibleColors,TmpColoring,FinalColoring).
   %ob(Vrcholy,Hrany,MozneBarvy,ObarveneVrcholy,KonecneObarveni).
   ob([],_,_,Obarveni,Obarveni).
   ob([V|Vs],Hrany,Barvy,Akumulator,Obarveni):-
	   member(C,Barvy),write(V),nl, test(Hrany,V,C,Akumulator),ob(Vs,Hrany,Barvy,[V-C|Akumulator],Obarveni).
   %kontroluje jestli obarveni vrcholu sedne k souccastnemu obarveni.
   %test(Hrany,Vrchol,Barva,Obarveni).

   test([],_,_,_).
   test([V1-V2|T],V,C,Ob):-write(T),
	   (V=V1,member(V2-C2,Ob),C=C2,!,fail)
	   ;
	   (V=V2,member(V1-C2,Ob),C=C2,!,fail)
	   ;
	   test(T,V,C,Ob).


   data(X,X).

   showGraph(g(A,B)):-write('vrcholy: '),write(A),write('hrany: '),write(B).

   test_:-data(Graf,g([1,2,3,4,5],[1-2,1-3,2-4,2-5])),data(Barvy ,[cervena,zelena,modra,zluta]),
   write('Obarveni grafu: '),showGraph(Graf),nl,write('barvami: '),write(Barvy),
   nl,write(' je: '),obarvi(Graf,Barvy,Obarveni), write(Obarveni).

   
  

Predikat flatten

Rozvine seznam, nehlede na hloubku zanoreni prvku do podseznamu.

    
   %flatten
   %z mnohane vnoreneho seznamu udela obycejny
   %=======================================================================================
   flatten([],[]).
   flatten([H|T],V):-flatten(H,VH),flatten(T,VT),append(VH,VT,V).
   flatten(A,[A]):-A \= [],A \=[_|_].

   data(X,X).

   test:-data([[1,2],[a,b,[3,7]],modra,zluta],X),write('Flatten na seznam'),
   write(X),write('je: '),nl,flatten(X,Vys),write(Vys).
    
   

Pascalův trojúhelník

    
   %paskal
   %vraci do vys N-ty radek pascalova trojuhelnika.
   paskal(N,Vys):-pas(2,N,[1],Vys).
   pas(N,N,Predch,Vys):-secti(Predch,[0|Predch],Vys),!.
   pas(K,N,Predch,Vys):-K1 is K+1,secti(Predch,[0|Predch],Predch1),pas(K1,N,Predch1,Vys).


   %vys vznikne sectenim prvniho a druheho seznamu.
   %pokud je nektery radek kratsi nez druhy, je do vysledku dokopirovan
   %secti(Sez1,Sez2,Vys)
   secti([],Sez2,Sez2).
   secti(Sez1,[],Sez1).
   secti([X|T],[B|R],[K|L]):- K is X+B,secti(T,R,L).


    
   

Vypouštění vrcholů binárního vyhledávacího stromu z daného intervalu

    
   %del_int(A,B,Strom,Vysledek)
   %vypusti vsechny vrcholy z intervalu <A,B> ve strome Strom
   %%==========================================================
   %Strom je reprezentovan jako t(L,A,P), L,P jsou levy a pravy podstrom
   %prazdny strom je konstanta nil
   del_int(_,_,nil,nil).
   del_int(A,B,t(L,X,P),t(L1,X,P)):-X < A,del_int(A,B,L,L1).
   del_int(A,B,t(L,X,P),t(L,X,P1)):- X >B,del_int(A,B,P,P1).
   del_int(A,B,t(nil,X,P),P1):-X>=A,X=<B,del_int(A,B,P,P1).
   del_int(A,B,t(L,X,nil),L1):-X>=A,X=<B,del_int(A,B,L,L1).
   del_int(A,B,t(nil,X,nil),nil):-X>=A,X=<B.
   del_int(A,B,t(L,X,P),Ntree):-X>=A,X=<B,
	   del_int(A,B,L,L1),del_int(A,B,P,PX),
	   ((PX \=nil,nejlevejsi(PX,Y,P1),data(Ntree,t(L1,Y,P1)));data(Ntree,L1)).

   %nejlevejsi(Strom,NejLevPrvek,Zbytek)
   %Zbytek Vznikne ze stromu Strom odebranim nejlevejsiho prvku

   nejlevejsi(nil,nil,nil).
   nejlevejsi(t(nil,X,P),X,P).
   nejlevejsi(t(L,X,P),Prv,t(L1,X,P)):-nejlevejsi(L,Prv,L1).

   data(X,X).

   test:-  data(A,10),
	   data(B,20),
	   data(Strom,t(t(t(nil,8,nil),12,t(nil,13,nil)),15 ,t(t(nil,16,nil),17,t(nil,25,nil)))),
	   write('Vypusteni intervalu: '),write(A),write(', '),write(B),nl,
	   write('ze stromu '),write(Strom),write('je:'),nl,
	   del_int(A,B,Strom,Vys),write(Vys).

   nejlev:-data(Strom,t(t(t(nil,8,nil),12,t(nil,13,nil)),15 ,t(t(nil,16,nil),17,t(nil,25,nil)))),nejlevejsi(Strom,P,Vys),write(Vys).


    
   

Sranddičky s maticema...

   %--------------------------------------------------------------
   % diag(+Matice,?HlavniDiagonala).
   % Matice je seznam radku obdelnikove matice.
   %?-diag([[1,2],[3,4],[5,6],X).
   %X=[1,4]

   diag([],[]).
   diag([[]|_],[]).
   diag([[X|_]|Zbytek],[X|ZbytekDiag]):-orez(Zbytek,Zbytek1),
                    diag(Zbytek1,ZbytekDiag).

   orez([[X|Radek]|Zbytek],[Radek|Zbytek1]):-orez(Zbytek,Zbytek1).
   orez([],[]).

   % spirala(+Matice,-Seznam)
   % Do seznamu posklada prvky Matice tak, jak lezi na spirale.
   %?-spirala([[1,2,3],[4,5,6],[7,8,9]],X).
   %    X=[1,4,7,8,9,6,3,2,5]


   spirala([],[]).
   spirala(Mat,Sez) :- otoc(Mat,[Radek1|Zbytek]),
   reverse(Radek1,ZacatekSpiraly),
   spirala(Zbytek,S),
   append(ZacatekSpiraly,S,Sez).

   % otoc(+Matice,-Matice otocena o 90 vpravo)
   otoc([],[]).
   otoc([[]|_],[]).
   otoc(Mat,[H|T]) :- sloupec1(Mat,H1,Mat1),
   reverse(H1,H),
   otoc(Mat1,T).

   % sloupec1(+Matice,-1.sloupec,-Matice bez 1.sloupce)
   sloupec1([],[],[]).
   sloupec1([[H|T]|TM],[H|T1],[T|T2]) :- sloupec1(TM,T1,T2).


   % matice(+M,+N,+VektSpiraly,-Matice).
   % Inverzni predikat k predikatu spirala/2.
   % Prvky seznamu VektSpiraly posklada po spirale do Matice typu MxN.

   matice(+M,+N,+VektSpiraly,-Matice):-
   matProm(M,N,MP), spirala(MP,VP), VektSpiraly=VP, Matice=MP.