Is there a fixed point combinator for creating tuples of mutually recursive functions? I.e. I'm looking for something like the Y-Combinator but which takes multiple "recursive"* functions, and will return a tuple of functions?
*: not really recursive of course, as they are written to take themselves (and siblings) as arguments, in the usual Y-Combinator way.
The creature you are looking for is Y* combinator.
Basing on this page by oleg-at-okmij.org I ported the Y* to Clojure:
(defn Y* [& fs]
(map (fn [f] (f))
((fn [x] (x x))
(fn [p]
(map
(fn [f]
(fn []
(apply f
(map
(fn [ff]
(fn [& y] (apply (ff) y)))
(p p)))))
fs)))))
The classic example of mutual recursive function is even/odd so here is the example:
(let
[[even? odd?]
(Y*
(fn [e o]
(fn [n]
(or (= 0 n) (o (dec n)))))
(fn [e o]
(fn [n]
(and (not= 0 n) (e (dec n)))))
)
]
(do
(assert (even? 14))
(assert (odd? 333))
))
You can easily blow the stack with this functions if you use big enough arguments, so here is trampolined version of it for example completeness which do not consume stack at all:
(let
[[even? odd?]
(Y*
(fn [e o]
(fn [n]
(or (= 0 n) #(o (dec n)))))
(fn [e o]
(fn [n]
(and (not= 0 n) #(e (dec n)))))
)
]
(do
(assert (trampoline even? 144444))
(assert (trampoline odd? 333333))
))
The Y* combinator is very useful for defining mutual recursive definitions of monadic parsers, of which I'll blog soon on lambder.com , stay tuned ;)
--
Lambder
The following web page describes the fix-point combinators for mutual recursion (polyvariadic fixpoint combinators) in detail. It derives the simplest so far
combinator.
http://okmij.org/ftp/Computation/fixed-point-combinators.html#Poly-variadic
For ease of reference, here is the simplest polyvariadic combinator in Haskell
(one-liner)
fix_poly:: [[a]->a] -> [a]
fix_poly fl = fix (\self -> map ($ self) fl)
where fix f = f (fix f)
and here it is in Scheme, a strict language
(define (Y* . l)
((lambda (u) (u u))
(lambda (p)
(map (lambda (li) (lambda x (apply (apply li (p p)) x))) l))))
Please see the web page for examples and more discussion.
I'm not entirely sure about this one. I'm still trying to find a formal proof of it. But it seems to me you don't need one.
In Haskell, if you have something like:
fix :: (a -> a) -> a
fix f = let x = f x in x
main = let { x = ... y ...; y = ... x ... } in x
you can rewrite main to
main = fst $ fix $ \(x, y) -> (... y ..., ... x ...)
But like I said, I'm not 100% sure about this one.
Related
In clojure, I would like to write a tail-recursive function that memoizes its intermediate results for subsequent calls.
[EDIT: this question has been rewritten using gcd as an example instead of factorial.]
The memoized gcd (greatest common divisor) could be implemented like this:
(def gcd (memoize (fn [a b]
(if (zero? b)
a
(recur b (mod a b))))
In this implementation, intermediate results are not memoized for subsequent calls. For example, in order to calculate gcd(9,6), gcd(6,3) is called as an intermediate result. However, gcd(6,3) is not stored in the cache of the memoized function because the recursion point of recur is the anonymous function that is not memoized.
Therefore, if after having called gcd(9,6), we call gcd(6,3) we won't benefit from the memoization.
The only solution I can think about will be to use mundane recursion (explicitely call gcd instead of recur) but then we will not benefit from Tail Call Optimization.
Bottom Line
Is there a way to achieve both:
Tail call optimization
Memoization of intermediate results for subsequent calls
Remarks
This question is similar to Combine memoization and tail-recursion. But all the answers there are related to F#. Here, I am looking for an answer in clojure.
This question has been left as an exercise for the reader by The Joy of Clojure (chap 12.4). You can consult the relevant page of the book at http://bit.ly/HkQrio.
in your case it's hard to show memoize do anything with factorial because the intermediate calls are unique, so I'll rewrite a somewhat contrived example assuming the point is to explore ways to avoid blowing the stack:
(defn stack-popper [n i]
(if (< i n) (* i (stack-popper n (inc i))) 1))
which can then get something out of a memoize:
(def stack-popper
(memoize (fn [n i] (if (< i n) (* i (stack-popper n (inc i))) 1))))
the general approaches to not blowing the stack are:
use tail calls
(def stack-popper
(memoize (fn [n acc] (if (> n 1) (recur (dec n) (* acc (dec n))) acc))))
use trampolines
(def stack-popper
(memoize (fn [n acc]
(if (> n 1) #(stack-popper (dec n) (* acc (dec n))) acc))))
(trampoline (stack-popper 4 1))
use a lazy sequence
(reduce * (range 1 4))
None of these work all the time, though I have yet to hit a case where none of them work. I almost always go for the lazy ones first because I find them to be most clojure like, then I head for tail calling with recur or tramplines
(defmacro memofn
[name args & body]
`(let [cache# (atom {})]
(fn ~name [& args#]
(let [update-cache!# (fn update-cache!# [state# args#]
(if-not (contains? state# args#)
(assoc state# args#
(delay
(let [~args args#]
~#body)))
state#))]
(let [state# (swap! cache# update-cache!# args#)]
(-> state# (get args#) deref))))))
This will allow a recursive definition of a memoized function, which also caches intermediate results. Usage:
(def fib (memofn fib [n]
(case n
1 1
0 1
(+ (fib (dec n)) (fib (- n 2))))))
(def gcd
(let [cache (atom {})]
(fn [a b]
#(or (#cache [a b])
(let [p (promise)]
(deliver p
(loop [a a b b]
(if-let [p2 (#cache [a b])]
#p2
(do
(swap! cache assoc [a b] p)
(if (zero? b)
a
(recur b (mod a b))))))))))))
There is some concurrency issues (double evaluation, the same problem as with memoize, but worse because of the promises) which may be fixed using #kotarak's advice.
Turning the above code into a macro is left as an exercise to the reader. (Fogus's note was imo tongue-in-cheek.)
Turning this into a macro is really a simple exercise in macrology, please remark that the body (the 3 last lines) remain unchanged.
Using Clojure's recur you can write factorial using an accumulator that has no stack growth, and just memoize it:
(defn fact
([n]
(fact n 1))
([n acc]
(if (= 1 n)
acc
(recur (dec n)
(* n acc)))))
This is factorial function implemented with anonymous recursion with tail call and memoization of intermediate results. The memoization is integrated with the function and a reference to shared buffer (implemented using Atom reference type) is passed by a lexical closure.
Since the factorial function operates on natural numbers and the arguments for succesive results are incremental, Vector seems more tailored data structure to store buffered results.
Instead of passing the result of a previous computation as an argument (accumulator) we're getting it from the buffer.
(def ! ; global variable referring to a function
(let [m (atom [1 1 2 6 24])] ; buffer of results
(fn [n] ; factorial function definition
(let [m-count (count #m)] ; number of results in a buffer
(if (< n m-count) ; do we have buffered result for n?
(nth #m n) ; · yes: return it
(loop [cur m-count] ; · no: compute it recursively
(let [r (*' (nth #m (dec cur)) cur)] ; new result
(swap! m assoc cur r) ; store the result
(if (= n cur) ; termination condition:
r ; · base case
(recur (inc cur)))))))))) ; · recursive case
(time (do (! 8000) nil)) ; => "Elapsed time: 154.280516 msecs"
(time (do (! 8001) nil)) ; => "Elapsed time: 0.100222 msecs"
(time (do (! 7999) nil)) ; => "Elapsed time: 0.090444 msecs"
(time (do (! 7999) nil)) ; => "Elapsed time: 0.055873 msecs"
How do I create a recursive anonymous function in Clojure which is not tail recursive?
The following clearly doesn't work, as recur is only for tail recursive functions. I'm also reluctant to drag in a y-combinator..
((fn [n] (if (= 1 n) 1 (* n (recur (dec n))))) 5)
Functions can be given a name to refer to themselves by specifying it between fn and the arglist:
user> ((fn ! [n] (if (= 1 n) 1 (* n (! (dec n))))) 5)
120
Here's a way that keeps it anonymous, mostly:
(((fn [!] (fn [n] (if (= 1 n) 1 (* n ((! !) (dec n))))))
(fn [!] (fn [n] (if (= 1 n) 1 (* n ((! !) (dec n)))))))
5)
It's not quite the Y combinator, but it does contain the same bit of self-application that allows Y to do its thing. By having a copy of the entire function in scope as ! whenever you need it, you can always make another copy.
I'm trying to write a function that returns a memoized recursive function in Clojure, but I'm having trouble making the recursive function see its own memoized bindings. Is this because there is no var created? Also, why can't I use memoize on the local binding created with let?
This slightly unusual Fibonacci sequence maker that starts at a particular number is an example of what I wish I could do:
(defn make-fibo [y]
(memoize (fn fib [x] (if (< x 2)
y
(+ (fib (- x 1))
(fib (- x 2)))))))
(let [f (make-fibo 1)]
(f 35)) ;; SLOW, not actually memoized
Using with-local-vars seems like the right approach, but it doesn't work for me either. I guess I can't close over vars?
(defn make-fibo [y]
(with-local-vars [fib (fn [x] (if (< x 2)
y
(+ (#fib (- x 1))
(#fib (- x 2)))))]
(memoize fib)))
(let [f (make-fibo 1)]
(f 35)) ;; Var null/null is unbound!?!
I could of course manually write a macro that creates a closed-over atom and manage the memoization myself, but I was hoping to do this without such hackery.
There is an interesting way to do it that does rely neither on rebinding nor the behavior of def. The main trick is to go around the limitations of recursion by passing a function as an argument to itself:
(defn make-fibo [y]
(let
[fib
(fn [mem-fib x]
(let [fib (fn [a] (mem-fib mem-fib a))]
(if (<= x 2)
y
(+ (fib (- x 1)) (fib (- x 2))))))
mem-fib (memoize fib)]
(partial mem-fib mem-fib)))
Then:
> ((make-fibo 1) 50)
12586269025
What happens here:
The fib recursive function got a new argument mem-fib. This will be the memoized version of fib itself, once it gets defined.
The fib body is wrapped in a let form that redefines calls to fib so that they pass the mem-fib down to next levels of recursion.
mem-fib is defined as memoized fib
... and will be passed by partial as the first argument to itself to start the above mechanism.
This trick is similar to the one used by the Y combinator to calculate function's fix point in absence of a built-in recursion mechanism.
Given that def "sees" the symbol being defined, there is little practical reason to go this way, except maybe for creating anonymous in-place recursive memoized functions.
This seems to work:
(defn make-fibo [y]
(with-local-vars
[fib (memoize
(fn [x]
(if (< x 2)
y
(+ (fib (- x 2)) (fib (dec x))))))]
(.bindRoot fib #fib)
#fib))
with-local-vars only provides thread-local bindings for the newly created Vars, which are popped once execution leaves the with-local-vars form; hence the need for .bindRoot.
(def fib (memoize (fn [x] (if (< x 2)
x
(+ (fib (- x 1))
(fib (- x 2)))))))
(time (fib 35))
Here is the simplest solution:
(def fibo
(memoize (fn [n]
(if (< n 2)
n
(+ (fibo (dec n))
(fibo (dec (dec n))))))))
You can encapsulate the recursive memoized function pattern in a macro if you plan to use it several times.
(defmacro defmemo
[name & fdecl]
`(def ~name
(memoize (fn ~fdecl))))
Here's a cross between the Y-combinator and Clojure's memoize:
(defn Y-mem [f]
(let [mem (atom {})]
(#(% %)
(fn [x]
(f #(if-let [e (find #mem %&)]
(val e)
(let [ret (apply (x x) %&)]
(swap! mem assoc %& ret)
ret))))))))
You can macrosugar this up:
(defmacro defrecfn [name args & body]
`(def ~name
(Y-mem (fn [foo#]
(fn ~args (let [~name foo#] ~#body))))))
Now for using it:
(defrecfn fib [n]
(if (<= n 1)
n
(+' (fib (- n 1))
(fib (- n 2)))))
user=> (time (fib 200))
"Elapsed time: 0.839868 msecs"
280571172992510140037611932413038677189525N
Or the Levenshtein distance:
(defrecfn edit-dist [s1 s2]
(cond (empty? s1) (count s2)
(empty? s2) (count s1)
:else (min (inc (edit-dist s1 (butlast s2)))
(inc (edit-dist (butlast s1) s2))
((if (= (last s1) (last s2)) identity inc)
(edit-dist (butlast s1) (butlast s2))))))
Your first version actually works, but you're not getting all the benefits of memoization because you're only running through the algorithm once.
Try this:
user> (time (let [f (make-fibo 1)]
(f 35)))
"Elapsed time: 1317.64842 msecs"
14930352
user> (time (let [f (make-fibo 1)]
[(f 35) (f 35)]))
"Elapsed time: 1345.585041 msecs"
[14930352 14930352]
You can generate memoized recursive functions in Clojure with a variant of the Y combinator. For instance, the code for factorial would be:
(def Ywrap
(fn [wrapper-func f]
((fn [x]
(x x))
(fn [x]
(f (wrapper-func (fn [y]
((x x) y))))))))
(defn memo-wrapper-generator []
(let [hist (atom {})]
(fn [f]
(fn [y]
(if (find #hist y)
(#hist y)
(let [res (f y)]
(swap! hist assoc y res)
res))))))
(def Ymemo
(fn [f]
(Ywrap (memo-wrapper-generator) f)))
(def factorial-gen
(fn [func]
(fn [n]
(println n)
(if (zero? n)
1
(* n (func (dec n)))))))
(def factorial-memo (Ymemo factorial-gen))
This is explained in details in this article about Y combinator real life application: recursive memoization in clojure.
Doing the Y-Combinator for a single argument function such as factorial or fibonacci in Clojure is well documented:
http://rosettacode.org/wiki/Y_combinator#Clojure
My question is - how do you do it for a two argument function such as this getter for example?
(Assumption here is that I want to solve this problem recursively and this non-idiomatic clojure code is there deliberately for another reason)
[non y-combinator version]
(defn get_ [n lat]
(cond
(empty? lat) ()
(= 0 (- n 1)) (first lat)
true (get_ (- n 1) (rest lat))))
(get_ 3 '(a b c d e f g h i j))
The number of args doesn't change anything since the args are apply'd. You just need to change the structure of get_:
(defn get_ [f]
(fn [n lat]
(cond
(empty? lat) ()
(= 1 n) (first lat)
:else (f (dec n) (next lat)))))
(defn Y [f]
((fn [x] (x x))
(fn [x]
(f (fn [& args]
(apply (x x) args))))))
user=> ((Y getf) 3 '(a b c d e f g h i j))
c
It'd be pretty straight forward.
Say you've got a function H:
(def H
(fn [x]
(fn [x y]
(stuff happens))))
Then you apply the same ol' Y-Combinator:
((Y H) 4 5)
Where 4 and 5 are arguments you want to pass to H.
The combinator is essentially "dealing with" the top-level function in H, not the one that's doing the hard work (the one with arity 2, here).
I am writing some signal processing software, and I am starting off by writing out a discrete convolution function.
This works fine for the first ten thousand or so list of values, but as they get larger (say, 100k), I begin to get StackOverflow errors, of course.
Unfortunately, I am having a lot of trouble converting the imperative convolution algorithm I have to a recursive & lazy version that is actually fast enough to use (having at least a modicum of elegance would be nice as well).
I am also not 100% sure I have this function completely right, yet – please let me know if I'm missing something/doing something wrong. I think it's correct.
(defn convolve
"
Convolves xs with is.
This is a discrete convolution.
'xs :: list of numbers
'is :: list of numbers
"
[xs is]
(loop [xs xs finalacc () acc ()]
(if (empty? xs)
(concat finalacc acc)
(recur (rest xs)
(if (empty? acc)
()
(concat finalacc [(first acc)]))
(if (empty? acc)
(map #(* (first xs) %) is)
(vec-add
(map #(* (first xs) %) is)
(rest acc)))))))
I'd be much obliged for any sort of help: I'm still getting my bearings in Clojure, and making this elegant and lazy and/or recursive would be wonderful.
I'm a little surprised how difficult it is to express an algorithm which is quite easy to express in an imperative language in a Lisp. But perhaps I'm doing it wrong!
EDIT:
Just to show how easy it is to express in an imperative language, and to give people the algorithm that works nicely and is easy to read, here is the Python version. Aside from being shorter, more concise and far easier to reason about, it executes orders of magnitude faster than the Clojure code: even my imperative Clojure code using Java arrays.
from itertools import repeat
def convolve(ns, ms):
y = [i for i in repeat(0, len(ns)+len(ms)-1)]
for n in range(len(ns)):
for m in range(len(ms)):
y[n+m] = y[n+m] + ns[n]*ms[m]
return y
Here, on the other hand, is the imperative Clojure code. It also drops the last, non fully-immersed, values from the convolution. So aside from being slow and ugly, it's not 100% functional. Nor functional.
(defn imp-convolve-1
[xs is]
(let [ys (into-array Double (repeat (dec (+ (count xs) (count is))) 0.0))
xs (vec xs)
is (vec is)]
(map #(first %)
(for [i (range (count xs))]
(for [j (range (count is))]
(aset ys (+ i j)
(+ (* (nth xs i) (nth is j))
(nth ys (+ i j)))))))))
This is so disheartening. Please, someone show me I've just missed something obvious.
EDIT 3:
Here's another version I thought up yesterday, showing how I'd like to be able express it (though other solutions are quite elegant; I'm just putting another one out there!)
(defn convolve-2
[xs is]
(reduce #(vec-add %1 (pad-l %2 (inc (count %1))))
(for [x xs]
(for [i is]
(* x i)))))
It uses this utility function vec-add:
(defn vec-add
([xs] (vec-add xs []))
([xs ys]
(let [lxs (count xs)
lys (count ys)
xs (pad-r xs lys)
ys (pad-r ys lxs)]
(vec (map #(+ %1 %2) xs ys))))
([xs ys & more]
(vec (reduce vec-add (vec-add xs ys) more))))
(vec (reduce vec-add (vec-add xs ys) more))))
(defn ^{:static true} convolve ^doubles [^doubles xs ^doubles is]
(let [xlen (count xs)
ilen (count is)
ys (double-array (dec (+ xlen ilen)))]
(dotimes [p xlen]
(dotimes [q ilen]
(let [n (+ p q), x (aget xs p), i (aget is q), y (aget ys n)]
(aset ys n (+ (* x i) y)))))
ys))
Riffing on j-g-faustus's version if I was doing this in the Clojure equiv branch. Works for me. ~400ms for 1,000,000 points, ~25ms for 100,000 on a i7 Mackbook Pro.
The likely cause of the stack overflow errors is that the lazy thunks are getting too deep. (concat and map are lazy). Try wrapping those calls in doall to force evaluation of their return values.
As for a more functional solution, try something like this:
(defn circular-convolve
"Perform a circular convolution of vectors f and g"
[f g]
(letfn [(point-mul [m n]
(* (f m) (g (mod (- n m) (count g)))))
(value-at [n]
(reduce + (map #(point-mul % n) (range (count g)))))]
(map value-at (range (count g)))))
Use can use reduce to perform summation easily, and since map produces a lazy sequence, this function is also lazy.
Can't help with a high-performance functional version, but you can get a 100-fold speedup for the imperative version by foregoing laziness and adding type hints:
(defn imp-convolve-2 [xs is]
(let [^doubles xs (into-array Double/TYPE xs)
^doubles is (into-array Double/TYPE is)
ys (double-array (dec (+ (count xs) (count is)))) ]
(dotimes [i (alength xs)]
(dotimes [j (alength is)]
(aset ys (+ i j)
(+ (* (aget xs i) (aget is j))
(aget ys (+ i j))))))
ys))
With xs size 100k and is size 2, your imp-convolve-1 takes ~6,000ms on my machine when wrapped in a doall, while this one takes ~35ms.
Update
Here is a lazy functional version:
(defn convolve
([xs is] (convolve xs is []))
([xs is parts]
(cond
(and (empty? xs) (empty? parts)) nil
(empty? xs) (cons
(reduce + (map first parts))
(convolve xs is
(remove empty? (map rest parts))))
:else (cons
(+ (* (first xs) (first is))
(reduce + (map first parts)))
(lazy-seq
(convolve (rest xs) is
(cons
(map (partial * (first xs)) (rest is))
(remove empty? (map rest parts)))))))))
On sizes 100k and 2, it clocks in at ~600ms (varying 450-750ms) vs ~6,000ms for imp-convolve-1 and ~35ms for imp-convolve-2.
So it's functional, lazy and has tolerable performance. Still, it's twice as much code as the imperative version and took me 1-2 additional hours to find, so I'm not sure that I see the point.
I'm all for pure functions when they make the code shorter or simpler, or have some other benefit over an imperative version. When they don't, I have no objection to switch to imperative mode.
Which is one of the reasons I think Clojure is great, since you can use either approach as you see fit.
Update 2:
I'll amend my "what's the point of doing this functionally" by saying that I like this functional implementation (the second one, further down the page) by David Cabana.
It's brief, readable and times to ~140ms with the same input sizes as above (100,000 and 2), making it by far the best-performing functional implementation of those I tried.
Considering that it is functional (but not lazy), uses no type hints and works for all numeric types (not just doubles), that's quite impressive.
(defn convolve [xs is]
(if (> (count xs) (count is))
(convolve is xs)
(let [os (dec (+ (count xs) (count is)))
lxs (count xs)
lis (count is)]
(for [i (range os)]
(let [[start-x end-x] [(- lxs (min lxs (- os i))) (min i (dec lxs))]
[start-i end-i] [(- lis (min lis (- os i))) (min i (dec lis))]]
(reduce + (map *
(rseq (subvec xs start-x (inc end-x)))
(subvec is start-i (inc end-i)))))))))
It is possible to express a lazy, functional solution in concise terms. Alas, the performance for > 2k is impractical. I'm interested to see if there are ways to speed it up without sacrificing readability.
Edit:
After reading drcabana's informative post on the topic (http://erl.nfshost.com/2010/07/17/discrete-convolution-of-finite-vectors/), I've updated my code to accept different sized vectors. His implementation is better performing:
for xs size 3, is size 1000000, ~2s vs ~3s
Edit 2:
Taking drcabana's ideas of simply reversing xs and padding is, I arrived at:
(defn convolve [xs is]
(if (> (count xs) (count is))
(convolve is xs)
(let [is (concat (repeat (dec (count xs)) 0) is)]
(for [s (take-while not-empty (iterate rest is))]
(reduce + (map * (rseq xs) s))))))
This is probably as concise as it's going to get, but it is still slower overall, likely due to take-while. Kudos to the blog author for a well considered approach. The only advantage here is that the above is truly lazy in that if I ask (nth res 10000), it will only need the first 10k calculations to arrive at a result.
Not really an answer to any of the many questions you asked, but I have several comments on the ones you didn't ask.
You probably shouldn't use nth on vectors. Yes, it's O(1), but because nth works on other sequences in O(n), it (a) doesn't make it clear that you expect the input to be a vector, and (b) means if you make a mistake, your code will mysteriously get really slow instead of failing immediately.
for and map are both lazy, and aset is side-effects-only. This combination is a recipe for disaster: for side-effecting for-like behavior, use doseq.
for and doseq allow multiple bindings, so you don't need to pile up loads of them like you (apparently) do in Python.
(doseq [i (range (count cs))
j (range (count is))]
...)
will do what you want.
#(first %) is more concisely written as first; likewise #(+ %1 %2) is +.
Calling vec on a bunch of intermediate results that don't need to be vectors will slow you down. Specifically in vec-add it's sufficient to only call vec when you make a final return value: in (vec (reduce foo bar)) there's no reason for foo to turn its intermediate results into vectors if it never uses them for random access.