diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index a2c8f231..eff42820 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -80,6 +80,15 @@ ((nullo l) (nullo result)) ((fresh (a d a-result rest-result) (conso a d l) (rel a a-result) (flat-mapo rel d rest-result) (appendo a-result rest-result result)))))) +(define + nub-o + (fn + (l result) + (conde + ((nullo l) (nullo result)) + ((fresh (a d r-rest) (conso a d l) (conde ((membero a d) (nub-o d result)) ((nafc (membero a d)) (conso a r-rest result) (nub-o d r-rest)))))))) + + (define membero (fn @@ -88,7 +97,6 @@ ((fresh (d) (conso x d l))) ((fresh (a d) (conso a d l) (membero x d)))))) - (define not-membero (fn diff --git a/lib/minikanren/tests/nub-o.sx b/lib/minikanren/tests/nub-o.sx new file mode 100644 index 00000000..cffa5159 --- /dev/null +++ b/lib/minikanren/tests/nub-o.sx @@ -0,0 +1,31 @@ +;; lib/minikanren/tests/nub-o.sx — relational dedupe (keep last occurrence). + +(mk-test "nub-o-empty" (run* q (nub-o (list) q)) (list (list))) + +(mk-test + "nub-o-no-duplicates" + (run* q (nub-o (list 1 2 3) q)) + (list (list 1 2 3))) + +(mk-test + "nub-o-with-duplicates" + (run* + q + (nub-o + (list 1 2 1 3 2 4) + q)) + (list (list 1 3 2 4))) + +(mk-test + "nub-o-all-same" + (let + ((res (run* q (nub-o (list 1 1 1) q)))) + (every? (fn (r) (= r (list 1))) res)) + true) + +(mk-test + "nub-o-keeps-last" + (run* q (nub-o (list 1 2 1) q)) + (list (list 2 1))) + +(mk-tests-run!)