/*
 * Gaurav S. KC [gskc@cs]
 *
 * Implementation of persistent sets as binary tries [Patricia Tries]
 *
*/

load :- consult('Pat.pl').


/* Constrain a patricia trie to be one of the following */
patEmpty.
patLeaf(Value) :- number(Value).
patNode(Prefix,BranchBit,Left,Right) :-
  number(Prefix),
  number(BranchBit),
  patNodeOrLeafOrEmpty(Left),
  patNodeOrLeafOrEmpty(Right).
patNodeOrLeafOrEmpty(P) :-
  P = patLeaf(_) ; P = patNode(_,_,_,_) ; P = patEmpty.



/* -- Create ---------------------------------------------------- */

/* "create" returns an empty patricia trie */
create(patEmpty).



/* -- Member (value, trie, yes_no) ------------------------------ */

/* "member" returns "yes" if the value is in the leaf */
member(Value, patLeaf(Value), yes) :- !.

/* "member" returns "no" if the leaf has another value */
member(_Value, patLeaf(_OtherValue), no).

/* "member" recurses down the left branch of the trie */
member(Value, patNode(_Prefix,BranchBit,Left,_Right), Answer) :-
  0 is Value /\ BranchBit, !,
  /* /\ is the bitwise AND operator */
  member(Value, Left, Answer).

/* "member" recurses down the right branch of the trie */
member(Value, patNode(_Prefix,_BranchBit,_Left,Right), Answer) :-
  member(Value, Right, Answer).



/* -- Insert (value, oldtrie, newtrie) -------------------------- */

/* "insert" Value into "P" and return the patricia trie as "NewP" */
insert(Value, P, NewP) :-
  /* check to see that "P" is a valid patricia trie */
  patNodeOrLeafOrEmpty(P),
  /* union a new patricia trie: LEAF with the existing trie: "P" */
  union(P, patLeaf(Value), NewP).



/* -- Union (trie1, trie2, unionOftries) ------------------------ */

/* "Union"-ing "P" with an empty trie returns "P" */
union(patEmpty, P, P) :- !.
union(P, patEmpty, P) :- !.

/* "Union"-ing two leaves with the same value */
union(patLeaf(V),patLeaf(V),patLeaf(V)) :- !.

/* "Union"-ing two leaves to form a node */
union(patLeaf(V1),patLeaf(V2),patNode(Pref,Bran,Left,Right)) :-
  prefix_Bran(V1,V2,Pref,Bran),
  branches(Bran,V1,V2,Left,Right).

/* Call overloaded function with arguments in reversed order */
union(patLeaf(Val),patNode(P,B,L,R),patNode(Prefix,BranchBit,L2,R2)) :-
  !,
union(patNode(P,B,L,R),patLeaf(Val),patNode(Prefix,BranchBit,L2,R2)).

/* "Union"-ing a node with a leaf */
union(patNode(P,B,L,R),patLeaf(Val),patNode(Prefix,BranchBit,L2,R2)) :-
  prefix_Bran(P,Val,Prefix,BranchBit),
  (
    ( /* These have a common prefix -- create new node */
      BranchBit < B,
      0 is BranchBit /\ P, !,
      /* the original node goes on the left side of the new node */
      L2 = patNode(P,B,L,R),
      /* the original leaf goes on the right side of the new node */
      R2 = patLeaf(Val)
    )
  ;
    ( /* These have a common prefix -- create new node */
      BranchBit < B,
      0 is BranchBit /\ Val, !,
      /* the original leaf goes on the left side of the new node */
      L2 = patLeaf(Val),
      /* the original node goes on the right side of the new node */
      R2 = patNode(P,B,L,R)
    )
  ;
    ( /* Prefix in the node is already a prefix for value in leaf */
      0 is BranchBit /\ Val, !,
      R2 = R,
      /* recursively "union" the leaf with left branch of node */
      union(L,patLeaf(Val),L2)
    )
  ;
    ( /* Prefix in the node is already a prefix for value in leaf */
      L2 = L,
      /* recursively "union" the leaf with right branch of node */
      union(R,patLeaf(Val),R2)
    )
  ).

/* "Union"-ing two nodes with the same prefix/branchingBit */
union(patNode(P,B,L1,R1),patNode(P,B,L2,R2),patNode(P,B,L3,R3)) :-
  /* recursively union the left branches */
  !, union(L1,L2,L3),
  /* recursively union the right branches */
  union(R1,R2,R3).


/* "Union"-ing two nodes with different prefix/branchingBit */
union(patNode(P1,B1,L1,R1),patNode(P2,B2,L2,R2),patNode(P3,B3,L3,R3)) :-
  /* P3 = the new Prefix, B3 = the new BranchingBit */
  prefix_Bran(P1,P2,P3,B3),
  (
    ( /* Case 1 */
      /* PREFIX in second node is the same as the new prefix */
      P2 is P3 /\ P2,
      (
        ( /* Case 1.1 */
          /* first node goes on the left side of second node */
          0 is B3 /\ P1, !,
          union(patNode(P1,B1,L1,R2),L2,L3),
          R3 = R2
        )
      ;
        ( /* Case 1.2 */
          /* first node goes on the right side of second node */
          !, L3 = L2,
          union(patNode(P1,B1,L1,R1),R2,R3)
        )
      )
    )
  ;
    ( /* Case 2 */
      /* PREFIX in first node is the same as the new prefix */
      P1 is P3 /\ P1,
      (
        ( /* Case 2.1 */
          /* second node goes on the left side of first node */
          0 is B3 /\ P2, !,
          union(L1,patNode(P2,B2,L2,R2),L3),
          R3 = R1
        )
      ;
        ( /* Case 2.2 */
          /* second node goes on the right side of first node */
          !, L3 = L1,
          union(R1,patNode(P2,B2,L2,R2),R3)
        )
      )
    )
  ;
    ( /* Case 3 */
      /* New prefix: different from [old] prefix in both nodes */
      0 is B3 /\ P1, !,
      /* first node goes on the left side of new node */
      L3 = patNode(P1,B1,L1,R1),
      /* second node goes on the right side of new node */
      R3 = patNode(P2,B2,L2,R2)
    )
  ;
    ( /* Case 4 */
      /* New prefix: different from [old] prefix in both nodes */
      0 is B3 /\ P2, !,
      /* second node goes on the left side of new node */
      L3 = patNode(P2,B2,L2,R2),
      /* first node goes on the right side of new node */
      R3 = patNode(P1,B1,L1,R1)
    )
  ).



/* -- prefix_Bran (value1, value1, prefix, branchbit) ----------- */

/* returns the new prefix: "Prefix" and branch bit: "BranchBit" */
prefix_Bran(V1,V2,Prefix,BranchBit) :-
  /* bitwise X-OR operator for Prolog is "#" */
  Temp1 is V1 # V2,
  /* NEGATION operator for Prolog is "-()" */
  BranchBit is Temp1 /\ -(Temp1),
  /* bitwise AND operator for Prolog is "/\" */
  Prefix is V1 /\ (BranchBit - 1).



/* -- branches (branchbit, value1, value2, leftLf, rightLf) ----- */
/* returns new leafs in the proper [left-right] order */

branches(BranchBit,V1,V2,patLeaf(V1),patLeaf(V2)) :-
  /* V1 goes to the left of node with branchingbit: "BranchBit" */
  0 is V1 /\ BranchBit, !.

branches(BranchBit,V1,V2,patLeaf(V2),patLeaf(V1)) :-
  /* V2 goes to the left of node with branchingbit: "BranchBit" */
  0 is V2 /\ BranchBit.
