API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jun 5th, 2019
82
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Prolog 12.83 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.  
  33. % przyklady pozytywne dla predykatu babcia:
  34. known_fact(babcia(babcia_bogunia, jakub)).
  35. known_fact(babcia(babcia_regina, jakub)).
  36. known_fact(babcia(babcia_bogunia, monika)).
  37. known_fact(babcia(babcia_regina, monika)).
  38.  
  39. %fakty operacyjne
  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.  
  49.  
  50. /***********************************************************************/
  51.  
  52. /*% przyklady pozytywne dla predykatu wuj
  53. known_fact(wuj(jacek, jakub)).
  54. known_fact(wuj(jacek, monika)).
  55. known_fact(wuj(jacek, mateusz)).
  56.  
  57. % fakty operacyjne
  58. known_fact(ojciec(zbigniew, jakub)).
  59. known_fact(ojciec(zbigniew, monika)).
  60. known_fact(ojciec(zbigniew, mateusz)).
  61. known_fact(brat(zbigniew, jacek)).*/
  62.  
  63. /***********************************************************************/
  64.  
  65. learn_rules_wrapper(PosExamples, NegExamples, Conseq, VarsIndex, Limit, Rules):-
  66.     learn_rules(PosExamples, NegExamples, Conseq, VarsIndex, Limit, Rules), !.
  67.  
  68. learn_rules_wrapper(PosExamples, NegExamples, Conseq, VarsIndex, Limit, Rules):-
  69.     NewLimit is Limit + 1,
  70.     write('New limit is: '),
  71.     write(NewLimit),
  72.     write('\n'),
  73.     NewLimit < 10,
  74.     learn_rules_wrapper(PosExamples, NegExamples, Conseq, VarsIndex, NewLimit, Rules).
  75.  
  76. learn_rules([ ] , _ , _ , _ , _ , [ ]).
  77.  
  78. learn_rules(PosExamples, NegExamples, Conseq, VarsIndex, Limit, [Rule | RestRules])  :-
  79.     learn_one_rule(PosExamples, NegExamples, rule(Conseq, [ ]), VarsIndex, Rule, Limit),
  80.     remove(PosExamples, Rule, RestPosExamples),
  81.     learn_rules(RestPosExamples, NegExamples, Conseq, VarsIndex, Limit, RestRules).
  82.  
  83. learn_one_rule( _ , [ ] , Rule, _, Rule, _).
  84.  
  85. learn_one_rule(PosExamples, NegExamples, PartialRule, LastUsed, Rule, Limit):-
  86.     new_partial_rule(PosExamples, NegExamples, PartialRule, LastUsed, NewPartialRule, NewLastUsed),
  87.     size_of_antecedent(NewPartialRule, Size),
  88.     Limit >= Size,
  89.     filter(PosExamples, NewPartialRule, PosExamples1),
  90.     filter(NegExamples, NewPartialRule, NegExamples1),
  91.     learn_one_rule(PosExamples1, NegExamples1, NewPartialRule, NewLastUsed, Rule, Limit).
  92.  
  93. new_partial_rule(PosExamples, NegExamples, PartialRule, LastUsed, Rule, RetLastUsed) :-
  94.     my_findall(NewRuleDescr,scored_rule(PosExamples, NegExamples, PartialRule, LastUsed, NewRuleDescr),Rules),
  95.     bubblesort(Rules, SortedRules), !,
  96.     get_elem_from_list(SortedRules, Rule, RetLastUsed, 0).
  97.     %choose_best(SortedRules, Rule, RetLastUsed).
  98.  
  99.  
  100. scored_rule(PosExamples, NegExamples, PartialRule, LastUsed,rule_descr(CandPartialRule, Score, RetLastUsed) ) :-
  101.     candidate_rule(PartialRule, PosExamples, NegExamples, LastUsed,CandPartialRule, RetLastUsed) ,
  102.     filter(PosExamples, CandPartialRule, PosExamples1),
  103.     filter(NegExamples, CandPartialRule, NegExamples1),
  104.     length(PosExamples1, NPos),
  105.     length(NegExamples1, NNeg),
  106.     NPos > 0,
  107.     Score is NPos - NNeg.
  108.  
  109.  
  110. candidate_rule(rule(Conseq, Anteced), _ , NegExamples, LastUsed, rule(Conseq, [Expr|Anteced]), RetLastUsed) :-
  111.     build_expr(LastUsed, Expr, RetLastUsed),
  112.     suitable(rule(Conseq, [Expr|Anteced]), NegExamples) .
  113.  
  114.  
  115.  
  116. build_expr(LastUsed,Expr,RetLastUsed) :-
  117.     predicate(Pred, N),
  118.     build_arg_list(N, vars(LastUsed, LastUsed), false, ArgList, RetLastUsed),
  119.     Expr =.. [Pred|ArgList] .
  120.  
  121.  
  122.  
  123. build_arg_list(1, vars(LastUsed, LastLocal), true, [Arg], RetLastLocal) :-
  124.     insert_arg(LastUsed, LastLocal,true, Arg, RetLastLocal, _).
  125.  
  126.  
  127. build_arg_list(1, vars(LastUsed, LastLocal), false, [Arg], LastLocal) :-
  128.     insert_used(LastUsed, Arg).
  129.  
  130.  
  131.  
  132. build_arg_list(N, vars(LastUsed, LastLocal), FlagIn, [Arg|RestArgs], RetLastLocal) :-
  133.     N>1,
  134.     insert_arg(LastUsed, LastLocal,FlagIn, Arg, NewLastLocal, FlagOut),
  135.     N1  is N-1,
  136.     build_arg_list(N1, vars(LastUsed, NewLastLocal), FlagOut, RestArgs, RetLastLocal).
  137.  
  138.  
  139.  
  140. insert_arg(LastUsed, LastLocal, FlagIn, Arg, RetLastLocal, FlagOut) :-
  141.     choose_var_index(LastUsed, LastLocal, FlagIn,Index,RetLastLocal, FlagOut),
  142.     variables(Vars),
  143.     length1(Vars, Len),
  144.     Index > Len,
  145.     write('Input next variable: '),
  146.     write('\n'),
  147.     read(Var),
  148.     append(Vars, Var, NewVars),
  149.     retract(variables(_)),
  150.     assertz(variables(NewVars)),
  151.     take_var(Index, NewVars, Arg).
  152.  
  153. insert_arg(LastUsed, LastLocal, FlagIn, Arg, RetLastLocal, FlagOut) :-
  154.     choose_var_index(LastUsed, LastLocal, FlagIn,Index,RetLastLocal, FlagOut),
  155.     variables(Vars),
  156.     take_var(Index, Vars, Arg).
  157.  
  158.  
  159. insert_used(LastUsed, Arg) :-
  160.     generate_number(1, LastUsed, Index),
  161.     variables(Vars),
  162.     take_var(Index, Vars, Arg).
  163.  
  164.  
  165. take_var(1,[Var|_], Var).
  166.  
  167. take_var(Index,[_|Rest], Arg) :-
  168.     Index>1,
  169.     Index1  is  Index-1,
  170.     take_var(Index1,Rest, Arg).
  171.  
  172.  
  173. choose_var_index(LastUsed, LastLocal,_,N,LastLocal, true) :-
  174.     generate_number(1, LastUsed, N).
  175.  
  176. choose_var_index(LastUsed, LastLocal, FlagIn,N,LastLocal, FlagIn) :-
  177.     Min is  LastUsed+1,
  178.     generate_number(Min, LastLocal, N).
  179.  
  180. choose_var_index(_, LastLocal,FlagIn,N,N,FlagIn) :-
  181.     N  is  LastLocal+1.
  182.  
  183.  
  184. generate_number(Min,Max,Min):-
  185.     Min=<Max.
  186.  
  187. generate_number(Min,Max,N):-
  188.     Min<Max,
  189.     NewMin is Min+1,
  190.     generate_number(NewMin,Max,N).
  191.  
  192.  
  193. filter(Examples, Rule, Examples1) :-
  194.                findall(Example,(member1(Example, Examples), covers(Rule, Example)),Examples1).
  195.  
  196. remove([ ],_ ,[ ]).
  197.  
  198. remove([Example|Rest], Rule, Rest1) :-
  199.     covers(Rule, Example), ! ,
  200.     remove(Rest, Rule, Rest1).
  201.  
  202. remove([Example|Rest], Rule, [Example|Rest1]) :-
  203.     remove(Rest, Rule, Rest1).
  204.  
  205.  
  206. suitable(PartialRule, NegExamples) :-
  207.    member1(NegEx, NegExamples),
  208.    \+covers(PartialRule, NegEx), !.
  209.  
  210.  
  211. covers(rule(Conseq, Anteced), Example) :-
  212.      match_conseq(Conseq, Example, Bindings),
  213.      match_anteced(Anteced, Bindings, _ ) .
  214.  
  215.  
  216. match_conseq(Conseq, Example, BindingsOut) :-
  217.     Conseq =.. [_|ArgList1],
  218.     Example =.. [_|ArgList2],
  219.     match_arg_lists(ArgList1,ArgList2,[],BindingsOut) .
  220.  
  221. match_anteced([ ], Bindings, Bindings) .
  222.  
  223. match_anteced([A|RestAnteced], BindingsIn, BindingsOut) :-
  224.     match_expr(A, BindingsIn, Bindings1),
  225.     match_anteced(RestAnteced, Bindings1, BindingsOut) .
  226.  
  227. match_expr(Expr,BindingsIn,BindingsOut) :-
  228.     known_fact(Fact),
  229.     functor(Expr,Functor,N),
  230.     functor(Fact,Functor,N),
  231.     Expr =.. [_|ArgList1],
  232.     Fact =.. [_|ArgList2],
  233.     match_arg_lists(ArgList1,ArgList2,BindingsIn,BindingsOut) .
  234.  
  235. match_arg_lists([ ] ,[ ], Bindings, Bindings) .
  236.  
  237. match_arg_lists([Arg1|Rest1], [Arg2|Rest2], BindingsIn, BindingsOut) :-
  238.     match_args(Arg1, Arg2, BindingsIn, Bindings1),
  239.     match_arg_lists(Rest1, Rest2, Bindings1, BindingsOut) .
  240.  
  241.  
  242. match_args(Var,Val,[],[b(Var,Val)]).
  243.  
  244. match_args(Var,Val,[b(Var,Val)|RestBindings],[b(Var,Val)|RestBindings]).
  245.  
  246. match_args(Var,Val,[b(Var1,Val1)|RestBindings],[b(Var1,Val1)|RestBindings1]) :-
  247.     Var\=Var1,  Val\=Val1,
  248.     match_args(Var,Val,RestBindings,RestBindings1).
  249.  
  250.  
  251. member1(X,[X|_]).
  252. member1(X,[_|R]):-
  253.     member1(X,R).
  254.  
  255.  
  256. length1([ ], 0).
  257.  
  258. length1([_|Rest], N)  :-
  259.     length1(Rest, NRest) ,
  260.     N  is  NRest + 1.
  261.  
  262. append([], X, [X]).
  263. append([Y|List], X, [Y|Result]):-
  264.     append(List, X, Result).
  265.  
  266. /* learn */
  267. learn(Rules):-
  268.     retractall(variables(_)),
  269.     retractall(predicate(_,_)),
  270.     assertz(variables([a,b])),
  271.     assertz(predicate(ojciec, 2)),
  272.     assertz(predicate(babcia, 2)),
  273.     assertz(predicate(matka, 2)),
  274.     read(PredName),
  275.     predicate(PredName, Arity),
  276.     collect_neg_examples(PredName, Arity, NegExamples),
  277.     collect_pos_examples(PredName, Arity, PosExamples),
  278.     collect_conseq_args(Arity, ArgsList),
  279.     Conseq =.. [PredName| ArgsList],
  280.     PredToDel =.. [predicate, PredName, Arity],
  281.     retract(PredToDel),
  282.     write('POS:\n'),
  283.     write(PosExamples),
  284.     write('\n\n'),
  285.     write('NEG:\n'),
  286.     write(NegExamples),
  287.     write('\n\n'),
  288.     write('CONSEQ:\n'),
  289.     write(Conseq),
  290.     write('\n\n'),
  291.     write('ARITY:\n'),
  292.     write(Arity),
  293.     write('\n\n'),
  294.     learn_rules_wrapper(PosExamples, NegExamples, Conseq, Arity, 0, Rules).
  295. /* koniec learn */
  296.  
  297. /* zbierz argumenty nastepnika */
  298. collect_conseq_args(Arity, ArgsList):-
  299.     findall(Arg, insert_used(Arity, Arg), ArgsList).
  300. /* koniec zbierz argumenty nastepnika */
  301.  
  302. /* zbierz przykaldy negatywne */
  303. collect_neg_examples(PredName, Arity, NegExamples):-
  304.     findall(NegEx, get_one_neg_example(PredName, Arity, NegEx), NegExamples).
  305.  
  306. get_one_neg_example(PredName, Arity, NegEx):-
  307.     collect_args_from_known_facts_wrapper(ArgsSet),
  308.     permutate(ArgsSet, Arity, PermutatedArgs),
  309.     NegEx =.. [PredName|PermutatedArgs],
  310.     not(known_fact(NegEx)).
  311.  
  312. /* koniec zbierz przykaldy negatywne */
  313.  
  314. /* permutacja argumentow */
  315. permutate(_, 0, []).
  316.  
  317. permutate(ArgsSet, N, [Elem|Rest]):-
  318.     N > 0,
  319.     member1(Elem, ArgsSet),
  320.     delete(ArgsSet, Elem, NewArgsSet),
  321.     N1 is N - 1,
  322.     permutate(NewArgsSet, N1, Rest).
  323.  
  324. /* koniec permutacja argumentow */
  325.  
  326. /* zbierz argumenty z known_fact */
  327. collect_args_from_known_facts_wrapper(ArgsSet):-
  328.     findall(KnownFact, known_fact(KnownFact), KnownFactsList),
  329.     collect_args_from_known_facts([], KnownFactsList, ArgsSet).
  330.  
  331. collect_args_from_known_facts(Set, [], Set).
  332.  
  333. collect_args_from_known_facts(ArgsSetIn, [KnownFact|RestKnownFacts], ArgsSetOut):-
  334.     KnownFact =.. [_|ArgsList],
  335.     insert_list_into_set(ArgsSetIn, ArgsList, ArgsSetOut2),
  336.     collect_args_from_known_facts(ArgsSetOut2, RestKnownFacts, ArgsSetOut).
  337.  
  338. insert_list_into_set(Set, [], Set).
  339.  
  340. insert_list_into_set(Set, [Elem|RestList], [Elem|SetOut]):-
  341.     not(member1(Elem, Set)),
  342.     not(member1(Elem, RestList)),
  343.     insert_list_into_set(Set, RestList, SetOut).
  344.  
  345. insert_list_into_set(Set, [Elem|RestList], SetOut):-
  346.     member1(Elem, RestList),
  347.     insert_list_into_set(Set, RestList, SetOut).
  348.  
  349. insert_list_into_set(Set, [Elem|RestList], SetOut):-
  350.     member1(Elem, Set),
  351.     insert_list_into_set(Set, RestList, SetOut).
  352. /* koniec zbierz wszystkie argumenty z known_fact */
  353.  
  354. /* zbierz przyklady pozytywne */
  355. collect_pos_examples(PredName, Arity, PosExamples):-
  356.     findall(PosExample, get_one_pos_example(PredName, Arity, PosExample), PosExamples).
  357.  
  358. get_one_pos_example(PredName, Arity, PosEx):-
  359.     known_fact(PosEx),
  360.     PosEx =.. [PredName|Args],
  361.     length1(Args, N),
  362.     Arity is N.
  363. /* koniec zbierz przyklady pozytywne */
  364.  
  365. /* my findall */
  366. my_findall(X, Goal, Xlist) :-
  367.     call(Goal),                 % Find a solution
  368.     assertz(queue(X)),          % Assert it
  369.     fail;                       % Try to find another solution
  370.     assertz(queue(bottom)),     % Mark end of solutions
  371.     collect(Xlist).             % Collect found solutions
  372.  
  373. collect([X|L])  :-
  374.     retract(queue(X)),
  375.     X \= bottom, !,              
  376.     collect(L).
  377.  
  378. collect([]).
  379. /* koniec my findall */
  380.  
  381. /* sortowanie babelkowe listy regul czastkowych - score malejaco*/
  382. bubblesort(ListaWe, Wynik):-
  383.     swap(ListaWe, NowaLista), !,
  384.     bubblesort(NowaLista, Wynik).
  385.  
  386. bubblesort(ListaWe, ListaWe).
  387.  
  388. swap([rule_descr(Rule1, Score1, RetLastUsed1), rule_descr(Rule2, Score2, RetLastUsed2) | R], [rule_descr(Rule2, Score2, RetLastUsed2), rule_descr(Rule1, Score1, RetLastUsed1) | R]):-
  389.     Score1 < Score2, !.
  390.  
  391. swap([rule_descr(Rule1, Score1, RetLastUsed1), rule_descr(Rule2, Score2, RetLastUsed2) | R], [rule_descr(Rule1, Score1, RetLastUsed1) | RW]):-
  392.     swap([rule_descr(Rule2, Score2, RetLastUsed2)|R], RW).
  393. /* Koniec sortowania */
  394.  
  395. /* Niedeterministyczny wybor elementow z listy regul czastkowych*/
  396. get_elem_from_list([rule_descr(Rule, _, LastUsed)|_], Rule, LastUsed, Limit):-
  397.     Limit < 2.
  398.  
  399. get_elem_from_list([rule_descr(_,_,_)|Rest], Rule, LastUsed, Limit):-
  400.     NewLimit is Limit +1,
  401.     get_elem_from_list(Rest, Rule, LastUsed, NewLimit).
  402. /* Koniec */
  403.  
  404. /* Zliczanie czlonów poprzednika */
  405. size_of_antecedent(rule(_, Antecedent), Size):-
  406.     length1(Antecedent, Size).
  407. /* 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!