API tools faq
paste
Advertisement
Guest User

Untitled

a guest
May 29th, 2019
91
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Prolog 9.81 KB | None | 0 0
raw download clone embed print report
  1. /***** Struktura programu wzorowana
  2.   na implementacji algorytmu indukcji reguł
  3.   W WERSJI DLA ZADANIA KLASYFIKACJI OBIEKTÓW
  4.   OPISANYCH WARTOŚCIAMI ATRYBUTÓW według
  5.  
  6.       Bratko    Prolog Programming for Artificial Intelligence
  7.                 ed. 3   Pearson Education / Addison-Wesley  2001
  8.  
  9. *******************************************************************/
  10.  
  11.  
  12.  
  13. /****Do testowych wykonań programu w ramach etapu 1
  14.    -a więc przed skonstruowaniem procedury inicjalizującej learn-
  15.     nalezy podać w wywołaniu procedury learn_rules :
  16.  
  17. --jako przykłady pozytywne listę struktur o funktorze pos
  18. --jako przykłady negatywne listę struktur o funktorze neg
  19. --strukturę reprezentującą następnik właściwy dla predykatu,
  20.   którego definicji ma uczyć się program w tym przebiegu
  21.     --np. wuj(x,y), jeśli przedmiotem uczenia ma być predykat wuj
  22. --indeks wykorzystania zmiennych w następniku (w powyzszym przykładzie: 2).
  23.  
  24. Nalezy tez pamiętać o wprowadzeniu do programu w postaci faktów:
  25.  
  26. --bazy faktów operacyjnych - fakty known_fact
  27. --predykatów występujących w faktach bazy wiedzy - fakty predicate
  28. --listy symboli do wykorzystania jako zmienne - fakt variables
  29.  
  30. *******************************************************************/
  31.  
  32. variables([a,b,c,d,e]).
  33.  
  34. % przyklady pozytywne dla predykatu babcia:
  35. known_fact(babcia(babcia_bogunia, jakub)).
  36. known_fact(babcia(babcia_regina, jakub)).
  37. known_fact(babcia(babcia_bogunia, monika)).
  38. known_fact(babcia(babcia_regina, monika)).
  39.  
  40. known_fact(ojciec(dziadek_zbyszek, zbigniew)).
  41. known_fact(ojciec(dziadek_zygmunt, iwona)).
  42. known_fact(matka(babcia_bogunia, zbigniew)).
  43. known_fact(matka(babcia_regina, iwona)).
  44. known_fact(ojciec(zbigniew, jakub)).
  45. known_fact(matka(iwona, jakub)).
  46. known_fact(ojciec(zbigniew, monika)).
  47. known_fact(matka(iwona, monika)).
  48. predicate(matka, 2).
  49. predicate(ojciec, 2).
  50. predicate(babcia, 2).
  51.  
  52.  
  53. %% known_fact(parent(dziadek_zbyszek,ojciec)).
  54. %% known_fact(parent(babcia_bogunia,ojciec)).
  55. %% known_fact(parent(dziadek_zygmunt,mama)).
  56. %% known_fact(parent(babcia_regina,mama)).
  57. %% known_fact(parent(ojciec,jakub)).
  58. %% known_fact(parent(ojciec,monika)).
  59. %% known_fact(parent(mama,jakub)).
  60. %% known_fact(parent(mama,monika)).
  61. %% predicate(parent,2).
  62.  
  63.  
  64. learn_rules_wrapper(PosExamples, NegExamples, Conseq, VarsIndex, Limit, Rules):-
  65.     learn_rules(PosExamples, NegExamples, Conseq, VarsIndex, Limit, Rules), !.
  66.  
  67. learn_rules_wrapper(PosExamples, NegExamples, Conseq, VarsIndex, Limit, Rules):-
  68.     NewLimit is Limit + 1,
  69.     write('New limit is: '),
  70.     write(NewLimit),
  71.     write('\n'),
  72.     NewLimit < 10,
  73.     learn_rules_wrapper(PosExamples, NegExamples, Conseq, VarsIndex, NewLimit, Rules).
  74.  
  75. learn_rules([ ] , _ , _ , _ , _ , [ ]).
  76.  
  77. learn_rules(PosExamples, NegExamples, Conseq, VarsIndex, Limit, [Rule | RestRules])  :-
  78.     learn_one_rule(PosExamples, NegExamples, rule(Conseq, [ ]), VarsIndex, Rule, Limit),
  79.     remove(PosExamples, Rule, RestPosExamples),
  80.     learn_rules(RestPosExamples, NegExamples, Conseq, VarsIndex, Limit, RestRules).
  81.  
  82. learn_one_rule( _ , [ ] , Rule, _, Rule, _).
  83.  
  84. learn_one_rule(PosExamples, NegExamples, PartialRule, LastUsed, Rule, Limit):-
  85.     new_partial_rule(PosExamples, NegExamples, PartialRule, LastUsed, NewPartialRule, NewLastUsed),
  86.     size_of_antecedent(NewPartialRule, Size),
  87.     Limit >= Size,
  88.     filter(PosExamples, NewPartialRule, PosExamples1),
  89.     filter(NegExamples, NewPartialRule, NegExamples1),
  90.     learn_one_rule(PosExamples1, NegExamples1, NewPartialRule, NewLastUsed, Rule, Limit).
  91.  
  92. new_partial_rule(PosExamples, NegExamples, PartialRule, LastUsed, Rule, RetLastUsed) :-
  93.     my_findall(NewRuleDescr,scored_rule(PosExamples, NegExamples, PartialRule, LastUsed, NewRuleDescr),Rules),
  94.     bubblesort(Rules, SortedRules), !,
  95.     get_elem_from_list(SortedRules, Rule, RetLastUsed, 0).
  96.     %choose_best(SortedRules, Rule, RetLastUsed).
  97.  
  98.  
  99. scored_rule(PosExamples, NegExamples, PartialRule, LastUsed,rule_descr(CandPartialRule, Score, RetLastUsed) ) :-
  100.     candidate_rule(PartialRule, PosExamples, NegExamples, LastUsed,CandPartialRule, RetLastUsed) ,
  101.     filter(PosExamples, CandPartialRule, PosExamples1),
  102.     filter(NegExamples, CandPartialRule, NegExamples1),
  103.     length(PosExamples1, NPos),
  104.     length(NegExamples1, NNeg),
  105.     NPos > 0,
  106.     Score is NPos - NNeg.
  107.  
  108.  
  109. candidate_rule(rule(Conseq, Anteced), _ , NegExamples, LastUsed, rule(Conseq, [Expr|Anteced]), RetLastUsed) :-
  110.     build_expr(LastUsed, Expr, RetLastUsed),
  111.     suitable(rule(Conseq, [Expr|Anteced]), NegExamples) .
  112.  
  113.  
  114.  
  115. build_expr(LastUsed,Expr,RetLastUsed) :-
  116.     predicate(Pred, N),
  117.     build_arg_list(N, vars(LastUsed, LastUsed), false, ArgList, RetLastUsed),
  118.     Expr =.. [Pred|ArgList] .
  119.  
  120.  
  121.  
  122. build_arg_list(1, vars(LastUsed, LastLocal), true, [Arg], RetLastLocal) :-
  123.     insert_arg(LastUsed, LastLocal,true, Arg, RetLastLocal, _).
  124.  
  125.  
  126. build_arg_list(1, vars(LastUsed, LastLocal), false, [Arg], LastLocal) :-
  127.     insert_used(LastUsed, Arg).
  128.  
  129.  
  130.  
  131. build_arg_list(N, vars(LastUsed, LastLocal), FlagIn, [Arg|RestArgs], RetLastLocal) :-
  132.     N>1,
  133.     insert_arg(LastUsed, LastLocal,FlagIn, Arg, NewLastLocal, FlagOut),
  134.     N1  is N-1,
  135.     build_arg_list(N1, vars(LastUsed, NewLastLocal), FlagOut, RestArgs, RetLastLocal).
  136.  
  137.  
  138.  
  139. insert_arg(LastUsed, LastLocal, FlagIn, Arg, RetLastLocal, FlagOut) :-
  140.     choose_var_index(LastUsed, LastLocal, FlagIn,Index,RetLastLocal, FlagOut),
  141.     variables(Vars),
  142.     take_var(Index, Vars, Arg).
  143.  
  144.  
  145. insert_used(LastUsed, Arg) :-
  146.     generate_number(1, LastUsed, Index),
  147.     variables(Vars),
  148.     take_var(Index, Vars, Arg).
  149.  
  150.  
  151. take_var(1,[Var|_], Var).
  152.  
  153. take_var(Index,[_|Rest], Arg) :-
  154.     Index>1,
  155.     Index1  is  Index-1,
  156.     take_var(Index1,Rest, Arg).
  157.  
  158.  
  159. choose_var_index(LastUsed, LastLocal,_,N,LastLocal, true) :-
  160.     generate_number(1, LastUsed, N).
  161.  
  162. choose_var_index(LastUsed, LastLocal, FlagIn,N,LastLocal, FlagIn) :-
  163.     Min is  LastUsed+1,
  164.     generate_number(Min, LastLocal, N).
  165.  
  166. choose_var_index(_, LastLocal,FlagIn,N,N,FlagIn) :-
  167.     N  is  LastLocal+1.
  168.  
  169.  
  170. generate_number(Min,Max,Min):-
  171.     Min=<Max.
  172.  
  173. generate_number(Min,Max,N):-
  174.     Min<Max,
  175.     NewMin is Min+1,
  176.     generate_number(NewMin,Max,N).
  177.  
  178.  
  179.  
  180. filter(Examples, Rule, Examples1) :-
  181.                findall(Example,(member1(Example, Examples), covers(Rule, Example)),Examples1).
  182.  
  183.  
  184.  
  185. remove([ ],_ ,[ ]).
  186.  
  187. remove([Example|Rest], Rule, Rest1) :-
  188.     covers(Rule, Example), ! ,
  189.     remove(Rest, Rule, Rest1).
  190.  
  191. remove([Example|Rest], Rule, [Example|Rest1]) :-
  192.     remove(Rest, Rule, Rest1).
  193.  
  194.  
  195. suitable(PartialRule, NegExamples) :-
  196.    member1(NegEx, NegExamples),
  197.    \+covers(PartialRule, NegEx), !.
  198.  
  199.  
  200. covers(rule(Conseq, Anteced), Example) :-
  201.      match_conseq(Conseq, Example, Bindings),
  202.      match_anteced(Anteced, Bindings, _ ) .
  203.  
  204.  
  205. match_conseq(Conseq, Example, BindingsOut) :-
  206.     Conseq =.. [_|ArgList1],
  207.     Example =.. [_|ArgList2],
  208.     match_arg_lists(ArgList1,ArgList2,[],BindingsOut) .
  209.  
  210. match_anteced([ ], Bindings, Bindings) .
  211.  
  212. match_anteced([A|RestAnteced], BindingsIn, BindingsOut) :-
  213.     match_expr(A, BindingsIn, Bindings1),
  214.     match_anteced(RestAnteced, Bindings1, BindingsOut) .
  215.  
  216. match_expr(Expr,BindingsIn,BindingsOut) :-
  217.     known_fact(Fact),
  218.     functor(Expr,Functor,N),
  219.     functor(Fact,Functor,N),
  220.     Expr =.. [_|ArgList1],
  221.     Fact =.. [_|ArgList2],
  222.     match_arg_lists(ArgList1,ArgList2,BindingsIn,BindingsOut) .
  223.  
  224. match_arg_lists([ ] ,[ ], Bindings, Bindings) .
  225.  
  226. match_arg_lists([Arg1|Rest1], [Arg2|Rest2], BindingsIn, BindingsOut) :-
  227.     match_args(Arg1, Arg2, BindingsIn, Bindings1),
  228.     match_arg_lists(Rest1, Rest2, Bindings1, BindingsOut) .
  229.  
  230.  
  231. match_args(Var,Val,[],[b(Var,Val)]).
  232.  
  233. match_args(Var,Val,[b(Var,Val)|RestBindings],[b(Var,Val)|RestBindings]).
  234.  
  235. match_args(Var,Val,[b(Var1,Val1)|RestBindings],[b(Var1,Val1)|RestBindings1]) :-
  236.     Var\=Var1,  Val\=Val1,
  237.     match_args(Var,Val,RestBindings,RestBindings1).
  238.  
  239.  
  240.  
  241. member1(X,[X|_]).
  242. member1(X,[_|R]):-
  243.     member1(X,R).
  244.  
  245.  
  246. length1([ ], 0).
  247.  
  248. length1([_|Rest], N)  :-
  249.     length1(Rest, NRest) ,
  250.     N  is  NRest + 1 .
  251.  
  252. /* generuj liste argumentow */
  253. gen_arg_lists(ListaWe, Size, Result):-
  254.     bagof(OneArgList, gen_one_arg_list(ListaWe, Size, OneArgList), Result).
  255.  
  256. gen_one_arg_list(_, 0, []).
  257.  
  258. gen_one_arg_list(ListaWe, Size, [Elem | Rest]):-
  259.     member1(Elem, ListaWe),
  260.     Size > 0,
  261.     NewSize is Size - 1,
  262.     gen_one_arg_list(ListaWe, NewSize, Rest).
  263.  
  264.  
  265. /* koniec generuj liste argumentow */
  266.  
  267. /* my findall */
  268. my_findall(X, Goal, Xlist) :-
  269.     call(Goal),                 % Find a solution
  270.     assertz(queue(X)),          % Assert it
  271.     fail;                       % Try to find another solution
  272.     assertz(queue(bottom)),     % Mark end of solutions
  273.     collect(Xlist).             % Collect found solutions
  274.  
  275. collect(L) :-
  276.     retract(queue(X)), !,       % Retract next solution
  277.     (X == bottom, !, L = []     % End of solutions?
  278.     ;
  279.     L = [X | Rest], collect(Rest)). % Otherwise collect the rest
  280. /* koniec my findall */
  281.  
  282. /* sortowanie babelkowe listy regul czastkowych - score malejaco*/
  283. bubblesort(ListaWe, Wynik):-
  284.     swap(ListaWe, NowaLista), !,
  285.     bubblesort(NowaLista, Wynik).
  286.  
  287. bubblesort(ListaWe, ListaWe).
  288.  
  289. swap([rule_descr(Rule1, Score1, RetLastUsed1), rule_descr(Rule2, Score2, RetLastUsed2) | R], [rule_descr(Rule2, Score2, RetLastUsed2), rule_descr(Rule1, Score1, RetLastUsed1) | R]):-
  290.     Score1 < Score2, !.
  291.  
  292. swap([rule_descr(Rule1, Score1, RetLastUsed1), rule_descr(Rule2, Score2, RetLastUsed2) | R], [rule_descr(Rule1, Score1, RetLastUsed1) | RW]):-
  293.     swap([rule_descr(Rule2, Score2, RetLastUsed2)|R], RW).
  294. /* Koniec sortowania */
  295.  
  296. /* Niedeterministyczny wybor elementow z listy regul czastkowych*/
  297. get_elem_from_list([rule_descr(Rule, _, LastUsed)|_], Rule, LastUsed, Limit):-
  298.     Limit < 2.
  299.  
  300. get_elem_from_list([rule_descr(_,_,_)|Rest], Rule, LastUsed, Limit):-
  301.     NewLimit is Limit +1,
  302.     get_elem_from_list(Rest, Rule, LastUsed, NewLimit).
  303. /* Koniec */
  304.  
  305. /* Zliczanie czlonów poprzednika */
  306. size_of_antecedent(rule(_, Antecedent), Size):-
  307.     length1(Antecedent, Size).
  308. /* Koniec*/
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!