diff --git a/lib/minikanren/intarith.sx b/lib/minikanren/intarith.sx index 85b2cb69..51b2ee1e 100644 --- a/lib/minikanren/intarith.sx +++ b/lib/minikanren/intarith.sx @@ -127,3 +127,11 @@ ((fresh (a d r-rest start-prime) (conso a d l) (conso (list start a) r-rest result) (pluso-i 1 start start-prime) (enumerate-from-i start-prime d r-rest)))))) (define enumerate-i (fn (l result) (enumerate-from-i 0 l result))) + +(define + counto + (fn + (x l n) + (conde + ((nullo l) (== n 0)) + ((fresh (a d n-rest) (conso a d l) (conde ((== a x) (counto x d n-rest) (pluso-i 1 n-rest n)) ((nafc (== a x)) (counto x d n)))))))) diff --git a/lib/minikanren/tests/counto.sx b/lib/minikanren/tests/counto.sx new file mode 100644 index 00000000..0c9248fc --- /dev/null +++ b/lib/minikanren/tests/counto.sx @@ -0,0 +1,35 @@ +;; lib/minikanren/tests/counto.sx — count occurrences of x in l (intarith). + +(mk-test + "counto-empty" + (run* q (counto 1 (list) q)) + (list 0)) +(mk-test + "counto-not-found" + (run* q (counto 99 (list 1 2 3) q)) + (list 0)) +(mk-test + "counto-once" + (run* q (counto 2 (list 1 2 3) q)) + (list 1)) +(mk-test + "counto-thrice" + (run* + q + (counto + 1 + (list 1 2 1 3 1) + q)) + (list 3)) +(mk-test + "counto-all-same" + (run* + q + (counto 7 (list 7 7 7 7) q)) + (list 4)) +(mk-test + "counto-string" + (run* q (counto "x" (list "x" "y" "x") q)) + (list 2)) + +(mk-tests-run!)