mk: foldr-o — relational right fold
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Takes a 3-arg combiner relation, a list, and an initial accumulator,
produces the right-fold result. (rel a tail-result result) combines
the head with the recursive result.
Examples:
(foldr-o appendo (list (list 1 2) (list 3) (list 4 5)) (list) q)
-> ((1 2 3 4 5)) ; flatten
(foldr-o conso (list 1 2 3) (list) q)
-> ((1 2 3)) ; rebuild list
4 new tests, 505/505 cumulative.
This commit is contained in:
@@ -56,6 +56,14 @@
|
||||
((nullo l) (nullo yes) (nullo no))
|
||||
((fresh (a d y-rest n-rest) (conso a d l) (conde ((pred a) (conso a y-rest yes) (== no n-rest) (partitiono pred d y-rest n-rest)) ((nafc (pred a)) (== yes y-rest) (conso a n-rest no) (partitiono pred d y-rest n-rest))))))))
|
||||
|
||||
(define
|
||||
foldr-o
|
||||
(fn
|
||||
(rel l acc result)
|
||||
(conde
|
||||
((nullo l) (== result acc))
|
||||
((fresh (a d r-rest) (conso a d l) (foldr-o rel d acc r-rest) (rel a r-rest result))))))
|
||||
|
||||
(define
|
||||
membero
|
||||
(fn
|
||||
@@ -80,6 +88,7 @@
|
||||
((nullo l1))
|
||||
((fresh (a d) (conso a d l1) (membero a l2) (subseto d l2))))))
|
||||
|
||||
|
||||
(define
|
||||
reverseo
|
||||
(fn
|
||||
@@ -88,7 +97,6 @@
|
||||
((nullo l) (nullo r))
|
||||
((fresh (a d res-rev) (conso a d l) (reverseo d res-rev) (appendo res-rev (list a) r))))))
|
||||
|
||||
|
||||
(define
|
||||
rev-acco
|
||||
(fn
|
||||
|
||||
38
lib/minikanren/tests/foldr-o.sx
Normal file
38
lib/minikanren/tests/foldr-o.sx
Normal file
@@ -0,0 +1,38 @@
|
||||
;; lib/minikanren/tests/foldr-o.sx — relational right fold.
|
||||
|
||||
(mk-test
|
||||
"foldr-o-empty"
|
||||
(run* q (foldr-o conso (list) (list 99) q))
|
||||
(list (list 99)))
|
||||
|
||||
(mk-test
|
||||
"foldr-o-conso-rebuilds-list"
|
||||
(run* q (foldr-o conso (list 1 2 3) (list) q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"foldr-o-appendo-flattens"
|
||||
(run*
|
||||
q
|
||||
(foldr-o
|
||||
appendo
|
||||
(list
|
||||
(list 1 2)
|
||||
(list 3)
|
||||
(list 4 5))
|
||||
(list)
|
||||
q))
|
||||
(list (list 1 2 3 4 5)))
|
||||
|
||||
(mk-test
|
||||
"foldr-o-with-acc-init"
|
||||
(run*
|
||||
q
|
||||
(foldr-o
|
||||
conso
|
||||
(list 1 2)
|
||||
(list 9 9)
|
||||
q))
|
||||
(list (list 1 2 9 9)))
|
||||
|
||||
(mk-tests-run!)
|
||||
Reference in New Issue
Block a user