Commit 517867fa authored by Vít Novotný's avatar Vít Novotný
Browse files

added all the remaining prolog files

parent 3e7daacc
% nacteni:
/* ['10.1_16.pl']. */
%:-consult('10.1_16_pocasi_golf.pl').
%:-consult('10.1_16_naradi.pl').
:-consult('10.1_16_restaurace.pl').
% převod z faktů na parametry
induce_tree( Tree) :-
findall( example( Class, Obj), example( Class, Obj), Examples),
findall( Att, attribute( Att, _ ), Attributes),
induce_tree( Attributes, Examples, Tree).
% induce_tree( Attributes , Examples, Tree)
induce_tree(_,[], null ) :- !.
induce_tree(_,[example( Class,_) | Examples], leaf( Class)) :-
\+ ((member(example( ClassX,_), Examples), ClassX \== Class)), !. % priklady stejne klasifikace
induce_tree(Attributes , Examples, tree( Attribute , SubTrees)) :-
choose_attribute( Attributes , Examples, Attribute/_), ! ,
del( Attribute , Attributes , RestAtts),
attribute( Attribute , Values),
induce_trees( Attribute , Values, RestAtts, Examples, SubTrees).
induce_tree(_, Examples, leaf( ExClasses)) :- % zadny uzitecny atribut, list s stribuci klasifikaci
findall(Class, member( example( Class, _), Examples), ExClasses).
% induce_trees( Att, Values, RestAtts, Examples, SubTrees):
% najdi podstromy SubTrees pro podmnoziny prikladu Examples podle hodnot (Values) atributu Att
induce_trees(_, [],_,_, [] ). % No attributes, no subtrees
induce_trees( Att , [Val1 | Vals ], RestAtts, Exs, [Val1 : Tree1 | Trees]) :-
attval_subset( Att = Val1, Exs, ExampleSubset),
induce_tree( RestAtts, ExampleSubset, Tree1),
induce_trees( Att , Vals, RestAtts, Exs, Trees).
% attval_subset(Attribute = Value, Examples, Subset):
% Subset je podmnozina prikladu z Examples, ktere splnuji podminku Attribute = Value
attval_subset( AttributeValue, Examples, ExampleSubset) :-
findall(example(Class, Obj),
(member( example( Class, Obj), Examples), satisfy( Obj, [ AttributeValue ])),
ExampleSubset).
% slide 17
% satisfy( Object, Description)
satisfy( Object, Conj) :- \+ ((member( Att = Val, Conj), member( Att = ValX, Object), ValX \== Val)).
% choose_attribute( +Atts, +Examples, -BestAtt/BestGain) - vybirame atribut podle informacniho zisku
choose_attribute([], _, 0/0).
choose_attribute([Att], Examples, Att/Gain):-!, gain(Examples, Att, Gain).
choose_attribute([Att|Atts], Examples, BestAtt/BestGain):-
choose_attribute(Atts,Examples,BestAtt1/BestGain1),
gain(Examples, Att, Gain),
(Gain>BestGain1,!,BestAtt=Att,BestGain=Gain;
BestAtt=BestAtt1,BestGain=BestGain1).
% gain( +Examples, +Attribute, -Gain) - zisk atributu
gain( Exs, Att , Gain) :- attribute( Att , AttVals ),
length(Exs, Total),
setof(Class, X^example(Class,X), Classes), % množina vsech Class, viz 'help(setof)'
findall(Nc, (member(C,Classes), cntclass(C,Exs,Nc)), CCnts),
info(CCnts,Total,I),
rem(Att, AttVals,Exs,Classes,Total,Rem),
Gain is I-Rem.
% info(+ValueCounts, +Total, -I) - míra informace
info([], _, 0).
info([VC|ValueCounts], Total, I) :-
info(ValueCounts,Total,I1),
(VC = 0, !, I is I1;
Pvi is VC / Total,
log2(Pvi, LogPvi), I is - Pvi * LogPvi + I1).
% rem( +Att, +AttVals, +Exs, +Classes, +Total, -Rem) - "zbytková informace" po testu na vsechny hodnoty atributu Att
rem( _, [], _, _, _, 0).
rem( Att, [V | Vs], Exs, Classes, Total, Rem) :-
findall(1, (member(example(_, AVs),Exs), member(Att = V, AVs)), L1), length(L1, Nv),
findall(Ni, (member(C, Classes), cntclassattv(Att,V,C,Exs,Ni)), VCnts),
Pv is Nv / Total, % P(v)
info(VCnts,Nv,I),
rem(Att,Vs,Exs,Classes,Total,Rem1),
Rem is Pv * I + Rem1.
% cntclass( +Class, +Exs, -Cnt) - pocet prikladu tridy Class
cntclass( Class, Exs, Cnt) :-
findall(1, member(example(Class,_),Exs), L), length(L, Cnt).
% cntclass( +Att, +Val, +Class, +Exs, -Cnt) - pocet prikladu tridy Class pro hodnotu Val atributu Att
cntclassattv( Att, Val, Class, Exs, Cnt) :-
findall(1, (member(example(Class,AVs),Exs), member(Att = Val, AVs)), L), length(L, Cnt).
% log2(+X, -Y)
log2(X, Y) :- Y is log(X) / log(2).
% ===================================================================
% show(+X,+L,-L1)
del(A,[A|T],T).
del(A,[H|T1],[H|T2]) :- del(A,T1,T2).
% show(+Tree)
show(Tree) :-
show(Tree, 0).
% show(+Tree, +Ind)
show(leaf(Class), Ind) :-
tab(Ind), write(Class), nl.
show(tree(A, SubTrees), Ind) :-
tab(Ind), write(A), write('?'), nl,
NI is Ind+2, show(SubTrees, NI).
show([], _).
show([_ : null | SubTrees], Ind) :- !, show(SubTrees, Ind).
show([V1 : ST1 | SubTrees], Ind) :-
tab(Ind), write('= '), write(V1), nl,
NI is Ind+2, show(ST1, NI),
show(SubTrees, Ind).
:-induce_tree(T),show(T).
% pklad na klasifikaci pedmt podle jejich obrysu
attribute( velikost, [ mala, velka]).
attribute( tvar, [ podlouhly, kompaktni, jiny]).
attribute( diry, [ zadne, 1, 2, 3, hodne]).
% Rozpoznvn pedmt
example( matice, [ velikost = mala, tvar = kompaktni, diry = 1]).
example( sroub, [ velikost = mala, tvar = podlouhly, diry = zadne]).
example( klic, [ velikost = mala, tvar = podlouhly, diry = 1]).
example( matice, [ velikost = mala, tvar = kompaktni, diry = 1]).
example( klic, [ velikost = velka, tvar = podlouhly, diry = 1]).
example( sroub, [ velikost = mala, tvar = kompaktni, diry = zadne]).
example( matice, [ velikost = mala, tvar = kompaktni, diry = 1]).
example( tuzka, [ velikost = velka, tvar = podlouhly, diry = zadne]).
example( nuzky, [ velikost = velka, tvar = podlouhly, diry = 2]).
example( tuzka, [ velikost = velka, tvar = podlouhly, diry = zadne]).
example( nuzky, [ velikost = velka, tvar = jiny, diry = 2]).
example( klic, [ velikost = mala, tvar = jiny, diry = 2]).
% vim: set ft=prolog:
% pklad na klasifikaci poas
attribute(obloha, [slunecno, zamraceno, dest]).
attribute(teplota, [teplo, mirna, chladno]).
attribute(vlhkost, [vysoka, normalni]).
attribute(vitr, [slaby, silny]).
% Kdy je dobre pocasi pro hru golfu?
example(spatne_pocasi, [obloha = slunecno, teplota = teplo, vlhkost = vysoka, vitr = slaby]).
example(spatne_pocasi, [obloha = slunecno, teplota = teplo, vlhkost = vysoka, vitr = silny]).
example(dobre_pocasi, [obloha = oblacno, teplota = teplo, vlhkost = vysoka, vitr = slaby]).
example(dobre_pocasi, [obloha = dest, teploty = mirna, vlhkost = vysoka, vitr = slaby]).
example(dobre_pocasi, [obloha = dest, teploty = chladno, vlhkost = normalni, vitr = slaby]).
example(spatne_pocasi, [obloha = dest, teploty = chladno, vlhkost = normalni, vitr = silny]).
example(dobre_pocasi, [obloha = oblacno, teplota = chladno, vlhkost = normalni, vitr = silny]).
example(spatne_pocasi, [obloha = slunecno, teplota = mirna, vlhkost = vysoka, vitr = slaby]).
example(dobre_pocasi, [obloha = slunecno, teplota = chladno, vlhkost = normalni, vitr = slaby]).
example(dobre_pocasi, [obloha = dest, teploty = mirna, vlhkost = normalni, vitr = slaby]).
example(dobre_pocasi, [obloha = slunecno, teplota = mirna, vlhkost = normalni, vitr = silny]).
example(dobre_pocasi, [obloha = oblacno, teplota = mirna, vlhkost = vysoka, vitr = silny]).
example(dobre_pocasi, [obloha = oblacno, teplota = teplo, vlhkost = normalni, vitr = slaby]).
example(spatne_pocasi, [obloha = dest, teploty = mirna, vlhkost = vysoka, vitr = silny]).
% vim: set ft=prolog:
% pklad na rozhodnut, jestli pokat na stl v restauraci
%
attribute( alt, [ano, ne]).
attribute( bar, [ano, ne]).
attribute( paso, [ano, ne]).
attribute( hlad, [ano, ne]).
attribute( stam, [nikdo, cast, plno]).
attribute( cen, ['$', '$$', '$$$']).
attribute( dest, [ano, ne]).
attribute( rez, [ano, ne]).
attribute( typ, [mexicka, asijska, bufet, pizzerie]).
example(pockat, [alt=ano, bar=ne, paso=ne, hlad=ano, stam=cast, cen='$$$', dest=ne, rez=ano, typ=mexicka ]).
example(necekat, [alt=ano, bar=ne, paso=ne, hlad=ano, stam=plno, cen='$', dest=ne, rez=ne, typ=asijska ]).
example(pockat, [alt=ne, bar=ano, paso=ne, hlad=ne, stam=cast, cen='$', dest=ne, rez=ne, typ=bufet ]).
example(pockat, [alt=ano, bar=ne, paso=ano, hlad=ano, stam=plno, cen='$', dest=ne, rez=ne, typ=asijska ]).
example(necekat, [alt=ano, bar=ne, paso=ano, hlad=ne, stam=plno, cen='$$$', dest=ne, rez=ano, typ=mexicka ]).
example(pockat, [alt=ne, bar=ano, paso=ne, hlad=ano, stam=cast, cen='$$', dest=ano, rez=ano, typ=pizzerie]).
example(necekat, [alt=ne, bar=ano, paso=ne, hlad=ne, stam=nikdo, cen='$', dest=ano, rez=ne, typ=bufet ]).
example(pockat, [alt=ne, bar=ne, paso=ne, hlad=ano, stam=cast, cen='$$', dest=ano, rez=ano, typ=asijska ]).
example(necekat, [alt=ne, bar=ano, paso=ano, hlad=ne, stam=plno, cen='$', dest=ano, rez=ne, typ=bufet ]).
example(necekat, [alt=ano, bar=ano, paso=ano, hlad=ano, stam=plno, cen='$$$', dest=ne, rez=ano, typ=pizzerie]).
example(necekat, [alt=ne, bar=ne, paso=ne, hlad=ne, stam=nikdo, cen='$', dest=ne, rez=ne, typ=asijska ]).
example(pockat, [alt=ano, bar=ano, paso=ano, hlad=ano, stam=plno, cen='$', dest=ne, rez=ne, typ=bufet ]).
% vim: set ft=prolog:
% nacteni:
/* ['12.1_11.pl']. */
% 1. cast -- pravidla
sentence --> noun_phrase, verb_phrase.
noun_phrase --> determiner, noun_phrase2.
noun_phrase --> noun_phrase2.
noun_phrase2 --> adjective, noun_phrase2.
noun_phrase2 --> noun.
verb_phrase --> verb.
verb_phrase --> verb, noun_phrase.
% 2. cast -- lexikon
determiner --> [the].
determiner --> [a].
noun --> [boy].
noun --> [song].
verb --> [sings].
adjective --> [young].
% nacteni:
/* ['12.2_12.pl']. */
% vetu reprezentujeme seznamem slov [the,young,boy,sings,a,song]
% pravidlova cast
sentence(S) :- append(NP,VP,S),
noun_phrase(NP), verb_phrase(VP).
% ...
% slovnikova cast, lexikon zapisujeme pomoci faktu:
determiner([the]).
determiner([a]).
noun([boy]).
% ...
% nacteni:
/* ['12.3_13.pl']. */
sentence(S,S0) :- noun_phrase(S,S1), verb_phrase(S1,S0).
noun_phrase(S,S0) :- determiner(S,S1), noun_phrase2(S1,S0).
noun_phrase(S,S0) :- noun_phrase2(S,S0).
noun_phrase2(S,S0) :- adjective(S,S1), noun_phrase2(S1,S0).
noun_phrase2(S,S0) :- noun(S,S0).
verb_phrase(S,S0) :- verb(S,S0).
verb_phrase(S,S0) :- verb(S,S1), noun_phrase(S1,S0).
determiner([the|S],S).
determiner([a|S],S).
verb([sings|S],S).
noun([boy|S],S).
noun([song|S],S).
adjective([ young|S],S).
start:-
write('Gramatiky - rozdilove seznamy'),nl,nl,
write('Zkuste si zadat dotaz "sentence([the,young,boy,sings,a,song],[])"').
?-start.
:- retractall(start/0).
% nacteni:
/* ['12.4_18.pl']. */
sentence(s(N,V)) --> noun_phrase(N), verb_phrase(V).
noun_phrase(np(D,N)) --> determiner(D), noun_phrase2(N).
noun_phrase(np(N)) --> noun_phrase2(N).
noun_phrase2(np2(A,N)) --> adjective(A), noun_phrase2(N).
noun_phrase2(np2(N)) --> noun(N).
verb_phrase(vp(V)) --> verb(V).
verb_phrase(vp(V,N)) --> verb(V), noun_phrase(N).
determiner(det(the)) --> [the].
determiner(det(a)) --> [a].
adjective(adj(young)) --> [young].
noun(noun(boy)) --> [boy].
noun(noun(song)) --> [song].
verb(verb(sings)) --> [sings].
% demonstracni vypis
% abychom se vyhli varovanim "Redefined static procedure ..."
:- dynamic
write_all_X/3,
start/0.
write_all_X(Goal,X,Name):-
call(Goal),write(' '),write(Name),write(' = '),write(X),nl,fail.
write_all_X(_,_,_).
start:-
write('DC GRAMATIKA S KONSTRUKCI STROMU ANALYZY'),nl,nl,
write('Dotaz "sentence(Tree, [the,young,boy,sings,a,song],[])" :'),nl,
write_all_X(sentence(Tree, [the,young,boy,sings,a,song],[]), Tree, 'Tree').
?-start.
:- retractall(start/0).
:- retractall(write_all_X/3).
% nacteni:
/* ['12.5_22.pl']. */
sentence(sentence(N,V)) --> noun_phrase(N,Num), verb_phrase(V,Num).
noun_phrase(np(D,N),Num) --> determiner(D,Num), noun_phrase2(N,Num).
noun_phrase(np(N),Num) --> noun_phrase2(N,Num).
noun_phrase2(np2(A,N),Num) --> adjective(A), noun_phrase2(N,Num).
noun_phrase2(np2(N),Num) --> noun(N,Num).
verb_phrase(vp(V),Num) --> verb(V,Num).
verb_phrase(vp(V,N),Num) --> verb(V,Num), noun_phrase(N,_Num1).
determiner(det(the),_) --> [the].
determiner(det(a),sg) --> [a].
verb(verb(sings),sg) --> [sings].
verb(verb(sing),pl ) --> [sing].
adjective(adj(young)) --> [young].
noun(noun(boy),sg) --> [boy].
noun(noun(song),sg) --> [song].
noun(noun(boys),pl) --> [boys].
noun(noun(songs),pl) --> [songs].
:- dynamic
start/0,
start2/0,
start3/0.
start:-
write('DC GRAMATIKA S TESTY NA SHODU'),nl,nl,
write('Dotaz "sentence(_ ,[a, young, boys, sings ],[])" vrati:'),nl,
sentence(_ ,[a, young, boys, sings ],[]).
?-start.
start2:-
write('/* No */)'),nl,
nl,write('Dotaz "ssentence(_,[the,boys,sings,a,song ],[])" vrati:'),nl,
sentence(_,[the,boys,sings,a,song ],[]).
?-start2.
start3:-
write('/* No */'),nl,
nl,write('Dotaz "sentence(_,[the,boys,sing,a,song ],[])" vrati:'),nl,
sentence(_,[the,boys,sing,a,song ],[]),
write('/* Yes */').
?-start3.
:- retractall(start/0).
:- retractall(start2/0).
:- retractall(start3/0).
% nacteni:
/* ['12.6_23.pl']. */
expr(X) --> term(Y), [+], expr(Z), {X is Y+Z}.
expr(X) --> term(Y), [-], expr(Z), {X is Y-Z}.
expr(X) --> term(X).
term(X) --> factor(Y), [*], term(Z), {X is Y*Z}.
term(X) --> factor(Y), [/], term(Z), {X is Y/Z}.
term(X) --> factor(X).
factor(X) --> ['('], expr(X), [')'].
factor(X) --> [X], {integer(X)}.
% demonstracni vypis
:- dynamic
write_all_X/3,
start/0.
write_all_X(Goal,X,Name):-
call(Goal),write(' '),write(Name),write(' = '),write(X),nl,fail.
write_all_X(_,_,_).
start:-
write('Vyhodnoceni aritmetickeho vyrazu'),nl,nl,
write('Dotaz "expr(X,[3,+,4,/,2,-, \'(\' ,2,*,6,/,3,+,2, \')\' ],[])" vrati:'),nl,
write_all_X(expr(X,[3,+,4,/,2,-, '(' ,2,*,6,/,3,+,2, ')' ],[]), X, 'X').
?-start.
:- retractall(write_all_X/3).
:- retractall(start/0).
% nacteni:
/* ['12.7_24.pl']. */
abc --> a(N), b(N), c(N).
a(0) --> [].
a(s(N)) --> [a], a(N).
b(0) --> [].
b(s(N)) --> [b], b(N).
c(0) --> [].
c(s(N)) --> [c], c(N).
% demonstracni vypis
:- dynamic
write_all_X/3,
start/0.
write_all_X(Goal,X,Name):-
call(Goal),write(' '),write(Name),write(' = '),write(X),nl,fail.
write_all_X(_,_,_).
start:-
write('Generativni sila DCG'),nl,nl,
write('jazyk a^n b^n c^n'),nl,
write('Zkuste si zadat dotaz "abc(X,[])" (dalsi reseni si vyzadate '),
write('stiskem ";").'),nl.
?-start.
:- retractall(write_all_X/3).
:- retractall(start/0).
% nacteni:
/* ['2.1.1_3.pl']. */
% vymaz predchozi deklarace member
:- retractall(member/2).
:- dynamic member/2.
member(X,[X|_]).
member(X,[_|T]) :- member(X,T).
% demonstracni vypis
% abychom se vyhli varovanim "Redefined static procedure ..."
:- dynamic
write_all_X/3,
start/0.
write_all_X(Goal,X,Name):-
call(Goal),write(' '),write(Name),write(' = '),write(X),nl,fail.
write_all_X(_,_,_).
start:-
write('Member - 1. varianta'),nl,
write('Vysledek volani "member(a,[X,b,c])" je:'),nl,
write_all_X(member(a,[X,b,c]), X, 'X').
?-start.
:- retractall(write_all_X/3).
:- retractall(start/0).
% nacteni:
/* ['2.1.2_3.pl']. */
% vymaz predchozi deklarace member
:- retractall(member/2).
:- dynamic member/2.
member(X,[Y|_]) :- X == Y.
member(X,[_|T]) :- member(X,T).
% demonstracni vypis
% abychom se vyhli varovanim "Redefined static procedure ..."
:- dynamic
write_all_X/3,
start/0.
write_all_X(Goal,X,Name):-
call(Goal),write(' '),write(Name),write(' = '),write(X),nl,fail.
write_all_X(_,_,_).
start:-
write('Member - 2. varianta (efektivnejsi, ne obousmerna),'), nl, nl,
write('Vysledek volani "member(a,[X,b,c])" je:'),nl,
write_all_X(member(a,[X,b,c]), X, 'X'),
write('No'), nl, nl,
write('Vysledek volani "member(a,[a,b,a]),write(ok),nl,fail" je:'),nl.
?-start.
?-member(a,[a,b,a]),write(ok),nl,fail.
:- retractall(write_all_X/3).
:- retractall(start/0).
% nacteni:
/* ['2.4.2_8.pl']. */
append_dl(A-B,B-C,A-C).
% demonstracni vypis
% abychom se vyhli varovanim "Redefined static procedure ..."
:- dynamic
start/0.
start:-
write('Prace se seznamy - efektivita append'),nl,nl,
write('Zkuste si zadat dotaz "append_dl([a,b|X]-X,[c,d|Y]-Y,Z)":'),nl.
?-start.
:- retractall(start/0).
% nacteni:
/* ['2.5.2_11.pl']. */
:- retractall(start/0).
:- retractall(qsort/2).
:- retractall(divide/4).
:- dynamic
qsort/2,
divide/4.
qsort(L,S):- qsort_dl(L,S-[]).
qsort_dl([], A-A).
qsort_dl([H|T],A-B):- divide(H,T,L1,L2),
qsort_dl(L2,A1-B),
qsort_dl(L1,A-[H|A1]).
divide(_,[],[],[]) :- ! .
divide(H,[K|T],[K|M],V):- K=<H, !, divide(H,T,M,V).
divide(H,[K|T],M,[K|V]):- K>H, divide(H,T,M,V).
% demonstracni vypis
:- dynamic
start/0.
start:-
write('Radici algoritmus QuickSort - efektivnejsi varianta'),
write(' s rozdilovymi seznamy'),nl,nl,
write('Vysledek volani "qsort([5, 2, 8, 2, 654, 8, 3, 4], L)":'),nl,
qsort([5, 2, 8, 2, 654, 8, 3, 4], L), write('L = '),write(L),nl.
?-start.
:- retractall(start/0).
Prohledavani AND/OR grafu
Graf:
a ---> or:[b/1,c/3].
b ---> and:[d/1,e/1].
c ---> and:[f/2,g/1].
e ---> or:[h/6].
f ---> or:[h/2,i/3].
h(X,0).
goal(d).
goal(g).
goal(h).
Vysledky dotazu andor("a"):
('solved_tree', 'a', 8, ('or_result', ('solved_tree', 'c', 8, ('and_result', [('solved_tree', 'f', 4, ('or_result', ('solved_leaf', 'h', 2))), ('solved_leaf', 'g', 1)]))))
% nacteni:
/* ['6.1_9.pl']. */
:- retractall(start/0).
:- use_module(library(clpfd)). % clpq , clpr
:- dynamic
start/0.
start:-
write('CLP - Constraing Logic Programming'),nl,nl,
write('vyzkousejte si zadat dotazy:'),nl,
write('X in 1..5, Y in 2..8, X+Y #= T.'),nl,
write('X in 1..5, Y in 2..8, X+Y #= T, labeling([],[ X,Y,T]).'),nl,
write('X #< 4, [X,Y] ins 0..5.'),nl,
write('X #< 4, indomain(X).'),nl,
write('X #> 3, X #< 6, indomain(X).'),nl,
write('X in 4..sup, X #\= 17, fd_dom(X,F).'),nl.
?-start.
% nacteni:
/* ['8.1_3.pl']. */
% kb_agent_action(+KB,+ATime,+Percept,-Action,-NewATime)
kb_agent_action(KB,ATime,Percept,Action,NewATime):-
make_percept_sentence(Percept,ATime,Sentence),
tell(KB,Sentence), % pridame vysledky pozorovani do KB
make_action_query(ATime,Query),
ask(KB,Query,Action), % zeptame se na dalsi postup
make_action_sentence(Action,ATime,ASentence),
tell(KB,ASentence), % pridame informace o akci do KB
NewATime is ATime + 1.
% nacteni:
/* ['8.3_27.pl']. */
:- op( 800, fx , if ),
op( 700, xfx, then