/*---------------------------------------------------------------*/ /* Winston's incremental learning procedure for structural */ /* descriptions (ARCH) */ /* Copyright (c) 1990 Ivan Bratko */ /* Modified and adapted for SWI-Prolog by Zdravko Markov, 2004 */ /*---------------------------------------------------------------*/ /* Reference: Ivan Bratko, Prolog Programming for AI (Ch.18) */ /* 2nd edition, Addison-Wesley, 1990 */ /* */ /* Call lrn(-Concept) */ /*---------------------------------------------------------------*/ /* This is a restricted version of Winston's incremental */ /* learning procedure for structural descriptions: */ /* - The first example must be positive. */ /* - Up to six objects can be handled. */ /* - The list containing missing or extra descriptors of */ /* a concept can contain only 3 descriptors. */ /* */ /* The representation used: */ /* */ /* Object = object(ListOfParts,ListOfRelations) */ /* */ /* Concept = concept(ListOfParts,MustRels,Rels,MustNotRels) */ /* MustRels - relations that must be present in the concept */ /* Rels - relations that desribe the concept */ /* MustNotRels - relations that must not be present */ /* */ /* Positive example = pos Object */ /* Negative example = neg Object */ /* */ /* Object parts are represented by Prolog variables. */ /* In the concept description they are represented by */ /* constants (i.e. part1, ...) */ /*---------------------------------------------------------------*/ ?- op(500,fx,pos). ?- op(500,fx,neg). lrn(Concept) :- findall(X,example(X),L), lrn(L,Concept). lrn([FirstExample|Examples],ConceptDesc) :- write('EXAMPLE: '),portray_clause(FirstExample), initialize(FirstExample,InitialHypothesis), write('CURRENT HYPOTHESIS: '),portray_clause(InitialHypothesis),nl, process_examples(InitialHypothesis,Examples,ConceptDesc). initialize(pos object(Parts,Rels), concept(Parts,[],Rels,[])) :- append1(Parts,_,[part1,part2,part3,part4,part5,part6]). process_examples(ConceptDesc,[],ConceptDesc) :- !. process_examples(CurDesc,[Example|Examples],FinDesc) :- write('Type Enter to continue ... '), get0(_), nl, write('EXAMPLE: '),portray_clause(Example), object_type(Example,Object,Type), match(Object,CurDesc,Difference), update(Type,Difference,CurDesc,NewDesc), write('CURRENT HYPOTHESIS: '),portray_clause(NewDesc),nl, !, process_examples(NewDesc,Examples,FinDesc). object_type(pos Object,Object,positive). object_type(neg Object,Object,negative). /*---------------------------------------------------------------*/ /* Call: match(+ObjectDesc,+ConceptDesc,-Difference) */ /* Arguments: ObjectDesc = description of an example */ /* ConceptDesc = current concept description */ /* Difference = term of the form: Missing + Extra */ /*---------------------------------------------------------------*/ /* Matches the description of an example against the current */ /* concept description and determines two lists of Missing and */ /* Extra descriptors. match performs the following: */ /* - the "must" lista are matched */ /* - a difference template is generated */ /* - parts of the object and concept descriptions are matched */ /* - other relations are matched */ /* - test whether all MustNot relations are missing. */ /* - on backtracking a different template is tried. */ /*---------------------------------------------------------------*/ match(object(OParts,ORels),concept(CParts,Musts,Rels,MustNots), Missing + Extras) :- list_diff(ORels,Musts,[] + RestRels), short_lists(Missing + Extras), list_diff(OParts,CParts,[] + []), list_diff(RestRels,Rels,Missing + Extras), list_diff(Extras,MustNots,MustNots + _). /*---------------------------------------------------------------*/ /* Call: list_diff(+List1,+List2,-ListDiffs) */ /* Arguments: List1 = list of descriptors */ /* List2 = list of descriptors */ /* ListDiffs = List2\List1 + List1\List2 */ /*---------------------------------------------------------------*/ list_diff(List,[],[] + List). list_diff(List1,[X|List2],Miss + Extras) :- delete1(List1,List11,X,Miss11,Miss), list_diff(List11,List2,Miss11 + Extras). /*---------------------------------------------------------------*/ /* Call: delete1(+List1,+List2,+Descriptor,-List3,-List4) */ /* Arguments: List1 = list of descriptors */ /* List2 = list of descriptors possibly without */ /* Descriptor */ /* Descriptor = Descriptor which should be deleted */ /* List3 = list of descriptors with Descriptor */ /* deleted */ /* List4 = list of descriptors possibly with */ /* Descriptor */ /*---------------------------------------------------------------*/ /* If Descriptor is deleted from List1 then List4 = List1, */ /* if not the List2 = List1 and List4 = [Descriptor|List3]. */ /* (If Descriptor is not deleted then it is missing in List.) */ /*---------------------------------------------------------------*/ delete1([],[],X,Dels,[X|Dels]). delete1([Y|L],L,X,Dels,Dels) :- X == Y, !. delete1([Y|L],L,X,Dels,Dels) :- X = Y. delete1([Y|L],[Y|L1],X,Dels,Dels1) :- delete1(L,L1,X,Dels,Dels1). /*---------------------------------------------------------------*/ /* Call: short_lists(List1 + List2) */ /* Argument: List1 = list of descriptors */ /* List2 = list of descriptors */ /*---------------------------------------------------------------*/ /* short_lists generates difference templates of the form: */ /* [] + [], [] + [_], [_] + [], [] + [_,_], [_] + [_] .... */ /* Each list can contain at most 3 elements. */ /*---------------------------------------------------------------*/ short_lists(L1 + L2) :- append1(L,_,[_,_,_]), append1(L1,L2,L). append1([],L,L). append1([H|T],L,[H|T1]) :- append1(T,L,T1). /*---------------------------------------------------------------*/ /* Call:update(+TypeOfExample,+Difference,+CurrentDesc,-NewDesc) */ /* Arguments: TypeOfExample = classification of the example */ /* Difference = determined difference */ /* CurrentDesc = current concept description */ /* NewDesc = modified concept description */ /*---------------------------------------------------------------*/ /* Clause 1: An extra relation in a negative example must appear */ /* in the MustNot list of the concept description. */ /* Clause 2: Missing relations in a negative example must appear */ /* in the Must list of the concept description. */ /* Clause 3: One missing and one extra relation in a negative */ /* example can be handled separatly. */ /* Clause 4: Generalize an isa-relation by climbing a_kind_of */ /* (ako) taxonomy (background knowledge of the system) */ /*---------------------------------------------------------------*/ update(negative,_ + [ExtraRelation], concept(Parts,Musts,Rels,MustNots), concept(Parts,Musts,Rels,[ExtraRelation|MustNots])). update(negative,Missing + _,concept(Parts,Musts,Rels,MustNots), concept(Parts,NewMusts,NewRels,MustNots)) :- Missing = [_|_], append1(Missing,Musts,NewMusts), list_diff(Rels,Missing,_ + NewRels). update(negative,[MissR] + [ExtraR],CurDesc,_) :- update(negative,[] + [ExtraR],CurDesc,InterDesc), update(negative,[MissR] + [],InterDesc,_). update(positive,[isa(Object,Class1)] + [isa(Object,Class2)], concept(Parts,Musts,Rels,MustNots), concept(Parts,Musts,NewRels,MustNots)) :- climb(Class1,Class), climb(Class2,Class),!, replace(isa(Object,Class1),Rels,isa(Object,Class),NewRels). /*---------------------------------------------------------------*/ /* Call: replace(+Item,+List,+NewItem,-NewList) */ /* Arguments: Item = descriptor */ /* List = list of descriptors */ /* NewItem = replacement descriptor */ /* NewList = replaced list of descriptors */ /*---------------------------------------------------------------*/ replace(Item,List,NewItem,[NewItem|List1]) :- delete1(List,List1,Item,_,_). /*---------------------------------------------------------------*/ /* Call: climb(+Class1,-Class2) */ /* Argument: Class1 = Subclass */ /* Class2 = Superclass */ /*---------------------------------------------------------------*/ climb(Class,Class). climb(Class,SuperClass) :- ako(Class1,Class), climb(Class1,SuperClass).