# Add alpha-unique-atom: Alpha-Equivalence Deduplication Function

examples/test_alpha_unique_atom.metta

@@ -0,0 +1,59 @@
+; tests for alpha-unique-atom 
+
+; 1 Basic duplicates with different variables
+!(test (=alpha (alpha-unique-atom ((link $x human) (link $y human) (link $z human)))
+               ((link $a human)))
+       True)
+
+!(test (=alpha (alpha-unique-atom ((parent $x human) (parent $y human) (child $z human)))
+               ((parent $a human) (child $b human)))
+       True)
+
+; 2 Different functors
+!(test (=alpha (alpha-unique-atom ((parent $x human) (child $y human) (friend $z human)))
+               ((parent $a human) (child $b human) (friend $c human)))
+       True)
+
+!(test (=alpha (alpha-unique-atom ((likes $x) (hates $y) (knows $z)))
+               ((likes $a) (hates $b) (knows $c)))
+       True)
+
+; 3 Nested structures
+!(test (=alpha (alpha-unique-atom ((link (foo $x) human) (link (foo $y) human) (link (bar $z) human)))
+               ((link (foo $a) human) (link (bar $b) human)))
+       True)
+
+!(test (=alpha (alpha-unique-atom ((parent (child $x) human) (parent (child $y) human) (parent (child $x) human)))
+               ((parent (child $a) human)))
+       True)
+
+; 4 Mix of unique and duplicates
+!(test (=alpha (alpha-unique-atom ((link $x human) (parent $x human) (link $y human) (parent $z human) (link $x human)))
+               ((link $a human) (parent $a human)))
+       True)
+
+!(test (=alpha (alpha-unique-atom ((foo $x) (foo $y) (bar $x) (foo $x) (bar $y)))
+               ((foo $a) (bar $a)))
+       True)
+
+; 5 Numbers and atoms
+!(test (=alpha (alpha-unique-atom (1 2 2 3 1 4 4 5))
+               (1 2 3 4 5))
+       True)
+
+!(test (=alpha (alpha-unique-atom (a b a c b d e a))
+               (a b c d e))
+       True)
+
+; 6 Empty and single-element lists
+!(test (=alpha (alpha-unique-atom ())
+               ())
+       True)
+
+!(test (=alpha (alpha-unique-atom (1))
+               (1))
+       True)
+
+!(test (=alpha (alpha-unique-atom ((link $x human)))
+               ((link $a human)))
+       True)

src/metta.pl

@@ -112,6 +112,29 @@
 first([A, _], A).
 'second-from-pair'([_, A], A).
 'unique-atom'(A, B) :- list_to_set(A, B).
+
+%%% Alpha-equivalence unique atom %%%
+'alpha-unique-atom'(A, B) :-
+    must_be(list, A),
+    alpha_list_to_set(A, B).
+
+alpha_list_to_set(List, Set) :-
+    empty_assoc(Seen0),
+    alpha_list_to_set_assoc(List, Seen0, Set).
+
+alpha_list_to_set_assoc([], _, []).
+alpha_list_to_set_assoc([H|T], SeenIn, R) :-
+    copy_term(H, HCopy),
+    numbervars(HCopy, 0, _),
+    term_hash(HCopy, Key),
+    ( get_assoc(Key, SeenIn, _) ->
+        alpha_list_to_set_assoc(T, SeenIn, R)
+    ;
+        put_assoc(Key, SeenIn, true, SeenOut),
+        R = [H|RT],
+        alpha_list_to_set_assoc(T, SeenOut, RT)
+    ).
+
 'sort-atom'(List, Sorted) :- msort(List, Sorted).
 'size-atom'(List, Size) :- length(List, Size).
 'car-atom'([H|_], H).
@@ -271,7 +294,7 @@
 register_fun(N) :- (fun(N) -> true ; assertz(fun(N))).
 :- maplist(register_fun, [superpose, empty, let, 'let*', '+','-','*','/', '%', min, max, 'change-state!', 'get-state', 'bind!',
                           '<','>','==', '!=', '=', '=?', '<=', '>=', and, or, xor, implies, not, sqrt, exp, log, cos, sin,
-                          'first-from-pair', 'second-from-pair', 'car-atom', 'cdr-atom', 'unique-atom',
+                          'first-from-pair', 'second-from-pair', 'car-atom', 'cdr-atom', 'unique-atom', 'alpha-unique-atom',
                           repr, repra, parse, 'println!', 'readln!', test, assert, 'mm2-exec', atom_concat, atom_chars, copy_term, term_hash,
                           foldl, first, last, append, length, 'size-atom', sort, msort, member, 'is-member', 'exclude-item', list_to_set, maplist, eval, reduce, 'import!',
                           'add-atom', 'remove-atom', 'get-atoms', match, 'is-var', 'is-expr', 'is-space', 'get-mettatype',