/******************************************************************/
/* cobweb.pl  Last modified by Z.Markov: Sat 20 Dec 1997 14:40:06 */
/* Fisher's incremental concept formation algorithm               */
/******************************************************************/
/*
   Copyright (c) 1989 Joerg-Uwe Kietz

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    Version 1 as published by the Free Software Foundation.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public
    License along with this program; if not, write to the Free
    SoftwareFoundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
    USA.
*/
/******************************************************************/
/*  impl. by    : Joerg-Uwe Kietz                                 */
/*                F3-XPS                                          */
/*                Gesellschaft fuer Mathematik und Datenver-      */
/*                arbeitung                                       */
/*                Schloss Birlinghoven                            */
/*                5201 St. Augustin 1                             */
/*                E-Mail: kietz@gmdzi.gmd.de                      */
/*                1989                                            */
/*                                                                */
/*  reference   : Gennari, J.H., Langley, P., Fisher, D.          */
/*                Models of Incremental Concept Formation         */
/*                Artifical Intelligence, Vol 40, pp. 11-61,      */
/*                1989                                            */
/*                                                                */
/*  correction  : There is a bracket around the subtraction of    */
/*                the two double sums missing in formula (3) on   */
/*                p. 35.                                          */
/*                In the case of Split-Node is the best, the call */
/*                cobweb(N,I) leads to double incorporation of I  */
/*                into Node N.                                    */
/*                                                                */
/*  call        : lrn                                             */
/*                                                                */
/*  side effects: assertz and retracts clauses                    */
/*                                                                */
/*  restrictions: Prolog-dialect must allow real arithmetic.      */
/*                                                                */
/******************************************************************/

/******************************************************************/
/*                                                                */
/*  call        : lrn                                             */
/*                                                                */
/*  side effects: assertz and retracts clauses                    */
/*                                                                */
/*  restrictions: Prolog-dialect must allow real arithmetric.     */
/*                                                                */
/******************************************************************/
/* With the predicate 'learn' the cobweb algorithm is called in   */
/* batch mode. In this mode the data have to be present at call-  */
/* time in the internal database. They have to follow the format  */
/* shown in the example file. Because, cobweb is an incremental   */
/* concept formation system it retrieves first a datum from the   */
/* database (in Prolog's processing order) and integrates it in a */
/* growing concept tree. Before the learning process starts the   */
/* internal concept tree data structure is initialized. The       */
/* concept tree is asserted and modified at runtime. At the       */
/* moment a tree-pretty-printer is missing.                       */
/******************************************************************/

lrn :-
      initialize,
      get_case(X),
      cobweb(X),
      fail.
lrn.

initialize :-
           abolish(node/3),
           abolish(d_sub/2),
           abolish(root/2),
           abolish(root/4),
           abolish(prediction_counter/2),
           abolish(gensym_counter/2),
           !.
/******************************************************************/
/*                                                                */
/*  call        : learn_more                                      */
/*                                                                */
/*  side effects: assertz and retracts clauses                    */
/*                                                                */
/******************************************************************/
/* With the predicate 'learn_more' the cobweb algorithm is called */
/* in batch mode. In this mode the data have to be present at     */
/* call-time in the internal database. They have to follow the    */
/* format shown in the example file. Because, cobweb is an        */
/* incremental concept formation system it retrieves first a      */
/* datum from the database (in Prolog's processing order) and     */
/* integrates it in a growing concept tree. The data structure of */
/* the internal concept tree data structure is not initialized,   */
/* thus allowing to process large datasets in smaller parts. The  */
/* concept tree is asserted and modified at runtime. The user has */
/* to take care that the dataset is erased after each batch run,  */
/* to avoid that data are processed twice.                        */
/******************************************************************/

learn_more :-
           get_case(X),
           cobweb(X),
           fail.
learn_more.


nmember(E,[E|L],1).
nmember(E,[_|R],P1) :- nmember(E,R,P),
                       P1 is P + 1.

nth1(1,[X|_],X).
nth1(P1,[_|R],X) :- P1 > 1,
                    P is P1 - 1,
                    nth1(P,R,X).

/******************************************************************/
/*                                                                */
/*  call        : get_case(+Case)                                 */
/*                                                                */
/*  arguments   : Case = unique case identificator                */
/*                                                                */
/******************************************************************/
/* This is a new version of get_case/1 called by COBWEB. This     */
/* version is independent from the data set. Using this version   */
/* one can change the data-set (i.e consult a different data file)*/
/* without changing the access operations (especially the number  */
/* of arguments)                                                  */
/******************************************************************/

get_case(CaseID) :- case([CaseID|_]),
                    nl, nl, write(' Processing case '),
                    write(CaseID), write(' ...').

/******************************************************************/
/*                                                                */
/*  call        : get_case_features(+Case,+Type,-AttVall)         */
/*                                                                */
/*  arguments   : Case   = unique case identificator              */
/*                Type   = type description of value              */
/*                AttVal = Attribute-Value Pair                   */
/*                                                                */
/******************************************************************/
/* This is a new version of get_case_features/3 called by COBWEB. */
/* This version is independent from the data set. Using this      */
/* version one can change the data-set (i.e consult a different   */
/* case file) without changing the access operations (especially  */
/* the number of arguments)                                       */
/******************************************************************/

get_case_feature(CaseId,Type,[Feature,Val]):-
        case([CaseId|CaseDescription]),
        features(FeatureDescription),
  /* backtrack through all feature description and */
        nmember([Type,Feature],FeatureDescription,Pos),
  /* get corresponding feature value */
        nth1(Pos,CaseDescription,Val).

/******************************************************************/
/*                                                                */
/*  call        : cobweb(+Case)                                   */
/*                                                                */
/*  arguments   : Case = unique case identificator                */
/*                                                                */
/*  side effects: assertz and retracts clauses                    */
/*                                                                */
/******************************************************************/
/* cobweb processes a case always completely. The case identifi-  */
/* cator is used as pointer to the case. Every case must have a   */
/* unique case identificator, accessible over the predicate       */
/* get_case(Case). The three cases of asserting a case as initial */
/* root node, as new terminal node in the tree, or integrating    */
/* the case into a node and processing the subtree's are handled. */
/******************************************************************/

cobweb(Case) :-
    /* if the tree is empty */
          \+(get_node(_)),
          init_node,
    /* generate root from Case */
          node(Root,root,1,1),
          new_node_from_case(Case,Root),
          assert_node(Root),
          msgs([nl,' Root initialized with case: ',Root]),
          !.
cobweb(Case) :-
   /* if root is terminal: */
          node(OldRoot,root,1,1),
          remove_node(OldRoot),
          !,
   /* first, make a copy of root */
          copy_node_to_new_node(OldRoot,New),
          node(New,_,1,1),
          assert_node(New),
          msgs([nl,' Root node: ',OldRoot,' used as new terminal node: ',New]),
          assert_d_sub(OldRoot,New),
   /* second, make a node of Case */
          new_node_from_case(Case,New2),
          node(New2,_,1,1),
          assert_node(New2),
          msgs([nl,' Case ',Case,' becomes new terminal ',New2]),
          assert_d_sub(OldRoot,New2),
   /* third, incorporate Case into root */
          incorporate_case_into_node(Case,OldRoot),
          node(NewRoot,root,2,_),
          assert_node(NewRoot),
          msgs([nl,' Root changed to: ',NewRoot]),
          !.
cobweb(Case) :-
   /* if root is not terminal: */
          node_name(OldRoot,root),
          remove_node(OldRoot),
          !,
   /* first, incorporate Case into root */
          incorporate_case_into_node(Case,OldRoot),
          node_objects(OldRoot,Objects),
          NewObjects is Objects + 1,
          node(NewRoot,root,NewObjects,_),
          assert_node(NewRoot),
          msgs([nl,' Root changed to: ',NewRoot]),
   /* second, compute new subtree */
          cobweb(NewRoot,Case),
          !.

cobweb(none,_).
cobweb(Parent,Case) :-
   best_child(Parent,Case,Best,IBest,Next,DoneRest,RestPred,PartSize,
              IncPrediction),
   !,
   new_child(Parent,Case,Best,Next,RestPred,PartSize,New,NewPrediction),
   !,
   merge_child(Parent,Case,Best,Next,RestPred,PartSize,Merge,
               MergePrediction),
   !,
/* Correction of the reference: In the case of Split-Node is the best,
   The call cobweb(N,I) leads to double incorporating I into Node N. */
   split_child(Parent,Case,Best,IBest,Next,DoneRest,RestPred,PartSize,
   SplitPrediction),
   !,
  max_of([IncPrediction,NewPrediction,MergePrediction,SplitPrediction],
         BestPrediction),
  !,
  ( BestPrediction = IncPrediction,
    do_incorp(IBest,Best,Merge,New,Case,NewParent);
         BestPrediction = SplitPrediction,
                do_split(Best,IBest,New,Merge,Parent,NewParent);
         BestPrediction = MergePrediction,
                do_merge(Best,Next,Merge,Parent,IBest,New,NewParent);
         BestPrediction = NewPrediction,
                do_new(Parent,New,IBest,Merge,NewParent)),
        !,
        cobweb(NewParent,Case).

do_incorp(IBest,Best,Merge,New,Case,NewParent):-
        msgs([nl,' Incorporating case ',Case,' into node: ',IBest]),
        move_subs(Best,IBest),
        delete_node(Merge),
        delete_node(New),
        if(terminal_node(Best),
   ( /* if Best is a terminal node we have the case from the paper,
                where N is terminal before incorporating the new case.
                first: make Best to an subnode of IBest */
            ins_node(IBest,Best,[]),
            msgs([nl,' Using old node: ',Best,' as terminal node.']),
            /* second: generate a new terminal node from Case */
            new_node_from_case(Case,New2),
            node(New2,_,1,1),
            assert_node(New2),
            msgs([nl,' New terminal node: ',New2]),
            /* and make it to an subnode of IBest, too */
            ins_node(IBest,New2,[]),
            /* than all is done, because Best and NewNode2 are terminal. */
            NewParent = none),
           (delete_node(Best),
            NewParent = IBest)).

do_split(Best,IBest,New,Merge,Parent,Parent):-
         msgs([nl,' Case ',Case,' splits node: ',Best]),
    /* The next call also copies the d_subs from Best to Parent */
         delete_node(Best),
         delete_node(IBest),
         delete_node(New),
         delete_node(Merge).

do_merge(Best,Next,Merge,Parent,IBest,New,Merge):-
         msgs([nl,' Case ',New,' merges nodes: ',nl,' ',Best,
               ' and ',Next,nl,' into ',Merge]),
         ins_node(Parent,Merge,[Best,Next]),
     /* Possible optimization:
            We could remember that Best is the best_child for
            incorporate and Next is the second best, RestP = 0, ...,
            i.e. we already know what best_child will produce in the
        next recursion.
     */
         delete_node(IBest),
         delete_node(New).

do_new(Parent,New,IBest,Merge,none):-
         /* all is done, because New is terminal. */
         ins_node(Parent,New,[]),
         msgs([nl,' New terminal node: ',New]),
         delete_node(IBest),
         delete_node(Merge).

best_child(Parent,Case,Best,IBest,Next,DoneRest,RestPred,PartSize,
       IncPrediction) :-
            bagof(Child,get_d_sub(Parent,Child),[C1,C2|DoRest]),
            length([C1,C2|DoRest],PartSize),
            copy_and_inc(C1,Case,IC1),
            copy_and_inc(C2,Case,IC2),
            compare_partitions(C1,IC1,C2,IC2,DoRest,[],Parent,
                               First,IFirst,Second,ISecond,FirstRestP),
            !,
     best_childs(Parent,Case,DoRest,[],First,IFirst,Second,ISecond,
                 FirstRestP,Best,IBest,Next,DoneRest,RestPred),
                 sum_score([IBest],[Next],Parent,RestPred,IncScore),
                 node_prediction(Parent,NormPrediction),
                 IncPrediction is (IncScore - NormPrediction) / PartSize.

best_childs(_,_,[],DoneRest,Best,IBest,Next,_INext,RestP,Best,IBest,
            Next,DoneRest,RestP) :-
                    delete_node(_INext),
                    !.
best_childs(Parent,Case,[Try|DoRest],DoneRest,First,IFirst,Second,ISecond,
     FirstRestP,Best,IBest,Next,NewDoneRest,RestP) :-
             copy_and_inc(Try,Case,ITry),
     if(compare_partitions(Second,ISecond,Try,ITry,DoRest,[First|DoneRest],
        Parent,Second,ISecond,Try,ITry,_),
     (/* Try is weaker than our Second,
         Delete ITry from memory
         put Try to done, use the old Results
      */
         delete_node(ITry),
         best_childs(Parent,Case,DoRest,[Try|DoneRest],
                     First,IFirst,Second,ISecond,FirstRestP,
                     Best,IBest,Next,NewDoneRest,RestP)),
     (/* Try is stronger than our Second,
          Delete ISecond from memory, put Second to done
          compare Try with First, use the new Results
      */
          delete_node(ISecond),
          compare_partitions(First,IFirst,Try,ITry,
                             DoRest,[Second|DoneRest],Parent,NFirst,
                             NIFirst,NSecond,NISecond,NFirstRestP),
        /*  !, ??? */
          best_childs(Parent,Case,DoRest,[Second|DoneRest],NFirst,NIFirst,
                      NSecond,NISecond,NFirstRestP,Best,IBest,Next,
                      NewDoneRest,RestP))).

new_child(Parent,Case,Best,Next,RestPred,PartSize,New,NewPrediction) :-
          new_node_from_case(Case,New),
   /* Prediction from New is equal to 1 */
          node(New,_,1,1),
          assert_node(New),
          sum_score([New],[Best,Next],Parent,RestPred,NewPredictionSum),
          node_prediction(Parent,NormPrediction),
          NewPrediction is (NewPredictionSum - NormPrediction)
                           / (PartSize + 1),
          !.

merge_child(_Parent,_Case,_Best,_Next,_RestPred,2,Merge,-10000) :-
        new_node(Merge),
        assert_node(Merge),
        !.
merge_child(Parent,Case,Best,Next,RestPred,PartSize,Merge,MergePrediction) :-
    /* first, copy BestNode Attributes to MergeNode */
        copy_node_to_new_node(Best,Merge),
    /* second, merge NextNode Attributes into MergeNode */
        merge_node_into_node(Next,Merge),
    /* third, incorporate Case into MergeNode */
        incorporate_case_into_node(Case,Merge),
    /* compute the rest of MergeNode */
        node_objects(Best,BestO),
        node_objects(Next,NextO),
        MergeObjects is BestO + NextO + 1,
        node_objects(Merge,MergeObjects),
        compute_prediction(Merge),
        assert_node(Merge),
        sum_score([Merge],[],Parent,RestPred,MergePredictionSum),
        node_prediction(Parent,NormPrediction),
        MergePrediction is (MergePredictionSum - NormPrediction) /
                           (PartSize - 1), /* completed W.E. */
        !.


split_child(_Parent,_Case,Best,_IBest,_Next,_DoneRest,_RestPred,_PartSize,
            -10000) :-
                terminal_node(Best),
     /* we cannot split Best if it is terminal */
                !.
split_child(Parent,Case,Best,_IBest,Next,DoneRest,_RestPred,PartSize,
            SplitPrediction) :-
        /* best_child of the partition resulting from split */
        /* (i.e. best of: Parent-Childs union Best-Childs without Best) */
             bagof(Child,get_d_sub(Best,Child),[C1|DoRest]),
             length([C1|DoRest],CPartSize),
             copy_and_inc(C1,Case,IC1),
             copy_and_inc(Next,Case,INext),
             compare_partitions(C1,IC1,Next,INext,DoRest,DoneRest,Parent,
                                First,IFirst,Second,ISecond,FirstRestP),
             !,
      best_childs(Parent,Case,DoRest,DoneRest,First,IFirst,Second,ISecond,
                  FirstRestP,_CBest,CIBest,CNext,_,RPred),
      sum_score([CIBest],[CNext],Parent,RPred,SplitPredictionSum),
      node_prediction(Parent,NormPrediction),
      SplitPrediction is (SplitPredictionSum - NormPrediction) /
                         (PartSize + CPartSize -1 ),
      delete_node(CIBest),
      !.

/******************************************************************/
/* compare_partitions                                             */
/******************************************************************/

compare_partitions(C1,IC1,C2,IC2,DoRest,DoneRest,Parent,First,IFirst,
                   Second,ISecond,RestP) :-
          sum_score(DoRest,DoneRest,Parent,0,RestP),
          sum_score([C1],[IC2],Parent,RestP,IC2_Score),
          sum_score([IC1],[C2],Parent,RestP,IC1_Score),
          (IC2_Score > IC1_Score ->
                ( First = C2,
                  IFirst = IC2,
                  Second = C1,
                  ISecond = IC1)
                ;
                ( First = C1,
                  IFirst = IC1,
                  Second = C2,
                  ISecond = IC2)),
          !.

/******************************************************************/
/* basic node operations                                          */
/******************************************************************/

copy_and_inc(Node,Case,INode) :-
                   new_node(INode),
                   !,
         /* first, copy all Node Attributes to INode */
                   copy_node_to_new_node(Node,INode),
         /* second, incorporate Case into INode */
                   incorporate_case_into_node(Case,INode),
                   node_objects(Node,Objects),
                   IObjects is Objects + 1,
                   node_objects(INode,IObjects),
                   compute_prediction(INode),
                   assert_node(INode),
                   !.

/******************************************************************/
/* basic node attribute operations                                */
/******************************************************************/

merge_node_into_node(Node,MergeNode) :-
	(get_node_nominal_attr(Node,Attr,ValuesCounter),
	 if((remove_node_nominal_attr(MergeNode,Attr,MergeValuesCounter),
	     sum_value_counter(ValuesCounter,MergeValuesCounter,
	                       NewValuesCounter),
	     assert_node_nominal_attr(MergeNode,Attr,NewValuesCounter)),
            fail);
	 true),
	(get_node_numeric_attr(Node,Attr,N,SumXiPow2,SumXi),
	 if((remove_node_numeric_attr(MergeNode,Attr,MergeN,
	 			      MergeSumXiPow2,MergeSumXi),
	     NewN is N + MergeN,
	     NewSumXiPow2 is SumXiPow2 + MergeSumXiPow2,
	     NewSumXi is SumXi + MergeSumXi,
	     assert_node_numeric_attr(MergeNode,Attr,NewN,NewSumXiPow2,
	     			      NewSumXi)),
             fail);
	 true),
	!.

new_node_from_case(Case,Node) :-
	new_node(Node),
	(get_case_feature(Case,nominal,[Attr,Val]),
	 if(assert_node_nominal_attr(Node,Attr,[Val-1]),
	    fail);
         true),
	(get_case_feature(Case,numeric,[Attr,Val]),
	 if((SumXiPow2 is Val * Val,
	     assert_node_numeric_attr(Node,Attr,1,SumXiPow2,Val)),
	    fail);
         true),
	!.

copy_node_to_new_node(Node,NewNode) :-
	new_node(NewNode),
	(get_node_nominal_attr(Node,Attr,ValuesCounter),
	 if(assert_node_nominal_attr(NewNode,Attr,ValuesCounter),
	    fail);
	 true),
	(get_node_numeric_attr(Node,Attr,N,SumXiPow2,SumXi),
	 if(assert_node_numeric_attr(NewNode,Attr,N,SumXiPow2,SumXi),
	    fail);
	 true),
	!.

incorporate_case_into_node(Case,Node) :-
	(get_case_feature(Case,nominal,[Attr,Val]),
	 if((remove_node_nominal_attr(Node,Attr,ValuesCounter),
	     sum_value_counter(ValuesCounter,[Val-1],NewValuesCounter),
	     assert_node_nominal_attr(Node,Attr,NewValuesCounter)),
	    fail);
         true),
	(get_case_feature(Case,numeric,[Attr,Val]),
	 if((remove_node_numeric_attr(Node,Attr,N,SumXiPow2,SumXi),
	     NewN is N + 1,
	     NewSumXiPow2 is SumXiPow2 + (Val * Val),
	     NewSumXi is SumXi + Val,
	     assert_node_numeric_attr(Node,Attr,NewN,NewSumXiPow2,NewSumXi)),
	    fail);
         true),
	!.
	
/******************************************************************/
/* sum_value_counter(+ValuesCounter,+ValuesCounter,-ValuesCounter)*/
/******************************************************************/

sum_value_counter(ValuesCounter,[],ValuesCounter) :- !.
sum_value_counter([],ValuesCounter,ValuesCounter).
sum_value_counter([Val-C1|R1],[Val-C2|R2],[Val-SumC|Rest]) :-
                  SumC is C1 + C2,
                  !,
                  sum_value_counter(R1,R2,Rest).
sum_value_counter([Val1-C1|R1],[Val2-C2|R2],[Val1-C1|Rest]) :-
                  Val1 @< Val2,
                  !,
                  sum_value_counter(R1,[Val2-C2|R2],Rest).
sum_value_counter([Val1-C1|R1],[Val2-C2|R2],[Val2-C2|Rest]) :-
                  Val2 @< Val1,
                  !,
                  sum_value_counter([Val1-C1|R1],R2,Rest).

/******************************************************************/
/* sum_score(+NodeList,+NodeList,+NormNode,+BaseScore,-FinalScore)*/
/******************************************************************/
/* This is following Gennari, et. al. 1989 and the COBWEB/3
   implementation */

sum_score([],[],_,Score,Score).
sum_score([],[Node|Rest],NormNode,Score,Sum_Score) :-
           node(Node,_,Objects,Prediction),
           node_objects(NormNode,NormObjects),
           ZScore is ((Objects / NormObjects) * Prediction)
                        + Score,
           !,
           sum_score([],Rest,NormNode,ZScore,Sum_Score).
sum_score([Node|Rest],ToDo,NormNode,Score,Sum_Score) :-
           node(Node,_,Objects,Prediction),
           node_objects(NormNode,NormObjects),
           ZScore is ((Objects / NormObjects) * Prediction)
                        + Score,
           !,
           sum_score(Rest,ToDo,NormNode,ZScore,Sum_Score).

/* This is following Fisher 1987 in the ML Journal but this
   seems to be wrong

   sum_score([],[],_,Score,Score).
   sum_score([],[Node|Rest],NormNode,Score,Sum_Score):-
        node(Node,_,Objects,Prediction),
        node(NormNode,_,NormObjects,NormPrediction),
        ZScore is ((Objects / NormObjects) * (Prediction - NormPrediction))
                      + Score,
        !,
        sum_score([],Rest,NormNode,ZScore,Sum_Score).
 sum_score([Node|Rest],ToDo,NormNode,Score,Sum_Score):-
        node(Node,_,Objects,Prediction),
        node(NormNode,_,NormObjects,NormPrediction),
        ZScore is ((Objects / NormObjects) * (Prediction - NormPrediction))
                   + Score,
        !,
        sum_score(Rest,ToDo,NormNode,ZScore,Sum_Score).
*/

/******************************************************************/
/* compute the prediction of Node                                 */
/******************************************************************/

compute_prediction(Node) :-
         node_objects(Node,Objects),
         asserta(prediction_counter(0,0)),
         get_node_nominal_attr(Node,_,ValuesCounter),
         if(retract(prediction_counter(Sum,Count)),true),
         NCount is Count + 1,
         asserta(prediction_counter(Sum,NCount)),
         member(_-C,ValuesCounter),
         if(retract(prediction_counter(NNSum,NCount)),true),
         NSum is NNSum + ((C / Objects) * (C / Objects)),
         asserta(prediction_counter(NSum,NCount)),
         fail.
compute_prediction(Node) :-
         get_node_numeric_attr(Node,_,N,SumXiPow2,SumXi),
         if(retract(prediction_counter(Sum,Count)),true),
         NCount is Count + 1,
         DeviationPow2 is (SumXiPow2/N) - ((SumXi*SumXi)/(N*N)),
         PosDeviationPow2 is abs(DeviationPow2),
         Deviation is sqrt(PosDeviationPow2),
 /* Deviation of one Instance is 0, so we use a minimum deviation of 1 */
 /* Here 'acuity' is hardcoded ! */
         max_of([Deviation,1],ScoreDeviation),
         NSum is Sum + 1/ScoreDeviation,
         asserta(prediction_counter(NSum,NCount)),
         fail.
compute_prediction(Node) :-
  /* Normalize the Prediction against the Number of Attributes */
         retract(prediction_counter(Prediction,Count)),
         NormPrediction is Prediction / Count,
         node_prediction(Node,NormPrediction),
         !.

/******************************************************************/
/* Internal Data Structures are:                                  */
/*                                                                */
/*    node(Node,Objects) with                                     */
/*         Node = Atom and Objects = Integer                      */
/*    node(Attribute,[Val-Count|...]) with                        */
/*         Attribute = Atom, Val = Atom and Count = Integer       */
/*    d_sub(Parent,Child) with                                    */
/*         Parent = Atom and Child = Atom                         */
/******************************************************************/

init_node:-
        abolish(root/2),
        abolish(root/4),
        (retract(gensym_counter(node_,_));true),
        (retractall(node(root,_,_));true),
        (retractall(d_sub(root,_));true),
        (retractall(d_sub(_,root));true),
        !.

new_node(node(Node,_,_)) :- nonvar(Node).

new_node(node(Node,_,_)):-
        var(Node),
        gensym(node_,Node),
        abolish(Node/2),
        abolish(Node/4),
        (retractall(node(Node,_,_));true),
        (retractall(d_sub(Node,_));true),
        (retractall(d_sub(_,Node));true),
        !.

delete_node(Node) :- remove_node(Node),
                     node_name(Node,NodeName),
                     abolish(NodeName/2),
                     abolish(NodeName/4),
        /* This asumes that there is mostly one ParentNode */
                     (remove_d_sub(Parent,Node),
                      remove_d_sub(Node,Child),
                      assert_d_sub(Parent,Child),
                      fail;
                      true),
                     !.

terminal_node(Node) :- node_objects(Node,1).

move_subs(Source,Dest) :- remove_d_sub(Source,Child),
                          assert_d_sub(Dest,Child),
                          fail.
move_subs(Source,Dest) :- remove_d_sub(Parent,Source),
                          assert_d_sub(Parent,Dest),
                          !.

ins_node(Parent,New,[]) :- assert_d_sub(Parent,New),
                           !.
ins_node(Parent,New,[Child|Rest]) :-
                (remove_d_sub(Parent,Child);true),
                assert_d_sub(New,Child),
                !,
                ins_node(Parent,New,Rest).

/******************************************************************/
/* node(Node:Atom,Objects:Integer,Prediction:Real)                */
/******************************************************************/

node_name(node(Name,_,_),Name) :- nonvar(Name),!.

node_objects(node(Name,Objects,_),Objects) :-
                   nonvar(Name),
                   if(var(Objects),get_node(node(Name,Objects,_)),true),
                   !.

node_prediction(node(Name,Objects,Pred),Pred) :- nonvar(Name),
            (var(Pred), get_node(node(Name,Objects,Pred));
             true),
            if(var(Pred),compute_prediction(node(Name,Objects,Pred)),true),
            !.

node(node(Name,Objects,Pred),Name,Objects,Pred) :- nonvar(Name),
            if(var(Objects),get_node(node(Name,Objects,_)),true),
            (var(Pred), get_node(node(Name,Objects,Pred));
             true),
            if(var(Pred),compute_prediction(node(Name,Objects,Pred)),true),
            !.

get_node(node(Node,Objects,Pred)) :-
            clause(node(Node,Objects,Pred),true).

assert_node(node(Node,Objects,Pred)) :- nonvar(Node),
            asserta(node(Node,Objects,Pred)).

remove_node(node(Node,Objects,Pred)) :- retract(node(Node,Objects,Pred)).

/******************************************************************/
/* node(Attr:Atom,[Val:Atom-Count:Integer|...])                   */
/******************************************************************/

get_node_nominal_attr(node(Node,_,_),Attr,ValuesCounter) :-
             nonvar(Node), nonvar(Attr),
             Call =.. [Node,Attr,ValuesCounter],
             (clause(Call,true);
              if(var(ValuesCounter),ValuesCounter = [])),
             !.
get_node_nominal_attr(node(Node,_,_),Attr,ValuesCounter) :-
             nonvar(Node), var(Attr),
             Call =.. [Node,Attr,ValuesCounter],
             clause(Call,true).

assert_node_nominal_attr(_,_,[]).
assert_node_nominal_attr(node(Node,_,_),Attr,ValuesCounter) :-
             nonvar(Node), nonvar(Attr), nonvar(ValuesCounter),
             Call =.. [Node,Attr,ValuesCounter],
             asserta(Call).

remove_node_nominal_attr(node(Node,_,_),Attr,ValuesCounter) :-
             nonvar(Node), nonvar(Attr),
             Call =.. [Node,Attr,ValuesCounter],
             (retract(Call);
              if(var(ValuesCounter),ValuesCounter = [])),
             !.
remove_node_nominal_attr(node(Node,_,_),Attr,ValuesCounter) :-
             nonvar(Node),
             Call =.. [Node,Attr,ValuesCounter],
             retract(Call).

/******************************************************************/
/* node(Attr:Atom,N:Integer,SumXiPow2:Integer,SumXi:Integer)      */
/******************************************************************/

get_node_numeric_attr(node(Node,_,_),Attr,N,SumXiPow2,SumXi) :-
             nonvar(Node), nonvar(Attr),
             Call =.. [Node,Attr,N,SumXiPow2,SumXi],
             (clause(Call,true);
              if(var(N),(N = 0, SumXiPow2=0, SumXi=0))),
             !.
get_node_numeric_attr(node(Node,_,_),Attr,N,SumXiPow2,SumXi) :-
              nonvar(Node), var(Attr),
              Call =.. [Node,Attr,N,SumXiPow2,SumXi],
              clause(Call,true).

assert_node_numeric_attr(_,_,0,_,_).
assert_node_numeric_attr(node(Node,_,_),Attr,N,SumXiPow2,SumXi) :-
     nonvar(Node), nonvar(Attr), nonvar(N), nonvar(SumXiPow2), nonvar(SumXi),
     Call =.. [Node,Attr,N,SumXiPow2,SumXi],
     asserta(Call).

remove_node_numeric_attr(node(Node,_,_),Attr,N,SumXiPow2,SumXi) :-
             nonvar(Node), nonvar(Attr),
             Call =.. [Node,Attr,N,SumXiPow2,SumXi],
             (retract(Call);
              if(var(N),(N = 0,SumXiPow2=0,SumXi=0))),
             !.
remove_node_numeric_attr(node(Node,_,_),Attr,N,SumXiPow2,SumXi) :-
             nonvar(Node),
             Call =.. [Node,Attr,N,SumXiPow2,SumXi],
             retract(Call).

/******************************************************************/
/* d_sub(SuperNode:Atom,SubNode:Atom)                             */
/******************************************************************/

get_d_sub(node(SuperNode,_,_),node(SubNode,_,_)) :-
             clause(d_sub(SuperNode,SubNode),true).

assert_d_sub(node(SuperNode,_,_),node(SubNode,_,_)) :-
             asserta(d_sub(SuperNode,SubNode)).

remove_d_sub(node(SuperNode,_,_),node(SubNode,_,_)) :-
             retract(d_sub(SuperNode,SubNode)).

/******************************************************************/
/* Miscealenous definitions                                       */
/******************************************************************/

max_of([F|R],Max) :- max_of(R,F,Max),!.
max_of([],Max,Max).
max_of([F|R],Best,Max) :- F =< Best,!,
                          max_of(R,Best,Max).
max_of([F|R],_,Max) :- max_of(R,F,Max).

msgs([]) :- !.
msgs([First|Rest]) :- msg(First),msgs(Rest).

/*
msg(node(ID,Obj,Pred)) :-
          !, write(ID), write('(obj='),
          write(Obj), write(',pred='),
          write(Pred), write(')').
*/
msg(Var)   :- var(Var),!,write(Var).
msg(nl)    :- !, nl.
msg(nl(N)) :- !, msg_repeat(N,nl).
msg(sp)    :- !, write(' ').
msg(sp(N)) :- !, msg_repeat(N,outterm(' ')).
msg(q_(O)) :- !, write(O).
msg(X)     :- !, write(X).

/* msg_repeat Call N times. */
msg_repeat(N,_) :- N < 1, !.
msg_repeat(N,Call) :- Call,
                      N1 is N - 1,
                      msg_repeat(N1,Call).

print_kb:-
        if(Call = d_sub(SuperNode,SubNode),true),
        clause(Call,true),
        if((write(Call),
            write(.),
            nl),
           fail).
print_kb:- get_node(Node),
           if((node_name(Node,Name),
             Call =.. [Name,Attr,ValuesCounter]),
             true),
             clause(Call,true),
             if((write(Call),
                 write(.),
                 nl),
               fail).
print_kb:- get_node(Node),
           if((node_name(Node,Name),
              Call =.. [Name,Attr,N,SumXiPow2,SumXi]),true),
              clause(Call,true),
           if((write(Call),
               write(.),
               nl),
              fail).
print_kb.

clear_kb :- get_node(Node),
            if((node_name(Node,Name),
                abolish(Name/2),
                abolish(Name/4)),
              fail).
clear_kb:- abolish(node/3),
           abolish(d_sub/2),
        (retract(gensym_counter(node_,_));true),
        assertz(gensym_counter(node_,0)),
        !.

/******************************************************************/
/* utility predicates                                             */
/******************************************************************/

if(Cond,Then) :- Cond, !, Then.
if(_,_).

if(Cond,Then,_) :-
             Cond, !, calltrue(Then).
if(_,_,Else) :-
             calltrue(Else).

calltrue(Call) :-  Call, !.
calltrue(_).

count(VAR,X) :-
          retract(gensym_counter(VAR,N)),
          X is N+1,
          assertz(gensym_counter(VAR,X)), ! .
count(VAR,1) :-
          assertz(gensym_counter(VAR,1)) .

gensym(SYM) :- gensym(g,SYM).

gensym(N,Sym) :- count(N,X),
              name(N,S1), num2ascii(X,S2),
              append(S1,S2,S3), name(Sym,S3).

num2ascii(N,[A]) :- N<10, A is N+48, !.
num2ascii(N,R) :- M is N // 10, num2ascii(M,T), A is N mod 10 + 48,
                  append(T,[A],R),!.

append([],L,L) :- !.
append([H|T],L,[H|V]) :- append(T,L,V).

member(X,[X|_]).
member(X,[_|T]) :- member(X,T).

/* Accessing examples */

case([Id|Values]) :-
   example(Id,_,Avs),
   get_values(Avs,Values).

get_values([],[]).
get_values([_=V|T],[V|R]) :-
   get_values(T,R).

features(Features) :-
   example(_,_,AV), !,
   build_features(AV,Features).

build_features([],[]).
build_features([A=_|T],[[nominal,A]|R]) :-
   build_features(T,R).
