suggested to me that bifold might be similar to the function, Q, of
section 12.5 equation 1) on p. 15 of:
http://www.thocp.net/biographies/papers/backus_turingaward_lecture.pdf
Now Q takes just 1 argument, a function. Also, the f function defined
with Q can be short-circuited, IOW, it may not process all the
elements is a list. Also, it may not even act on a list; however,
that just means it's more general and could be easily specialized to
just act on lists.
Anyway, I'll reproduce some of the reference's section 12.5 here:
f == p -> q; Q(f)
where:
Q(k) == h <*> [i, k<*>j]
and where(by p. 4 of reference):
<*> is the function composition operator:
(f <*> g) x == f(g(x))
and where(by p. 9 of reference):
[f,g] x = <f x, g x>
and where(by p. 8 of reference)
<x1,x2,...,xn> is a sequence of objects, x1,x2,...xn (like
haskell's tuple: (x1,x2,...,xn)
and where(by p. 8 of reference):
(p -> g; h)(x) means "if p(x) then do g(x) else do h(x)"
for any functions, k, p, g, h, i, j.
p. 16 provides a nice shorthand for the result of that function:
Q^n(g) = /h<*>[i,i<*>j,...,i<*>j^(n-1),g<*>J^n
where:
f^n = f<*>f<*>....<*> f for n applications of f
/h<*>[f1,f2,...,fn] is defined on p. 13 of reference.
[snip]
Thanks, Larry, this is some interesting stuff.
I'm not sure yet whether Q is equivalent - it may be, but I haven't been able to thoroughly grok it yet.
For uniformity, I shifted the notation you gave to Haskell:
(.^) :: (a -> a) -> Int -> a -> a
f .^ 0 = id
f .^ n = f . (f .^ (n - 1))
(./) :: (b -> c -> c) -> [a -> b] -> (a->c) -> a -> c
(./) = flip . foldr . \h f g -> h <$> f <*> g
_Q_ :: (b -> c -> c) -> (a -> b) -> (a -> a) -> (a -> c) -> a -> c
_Q_ h i j k = h <$> i <*> (k . j)
So the shorthand just states the equivalence of (_Q_ h i j) .^ n and (./) h [ i . (j .^ m) | m <- [0 .. n-1] ] . ( . (j .^ n))
Looking at it that way, we can see that (_Q_ h i j) .^ n takes some initial value, unpacks it into a list of size n+1 (using i as the iterate function),
derives a base case value from the final value (and some function k) maps the initial values into a new list, then foldrs over them.
The _f_ function seems to exist to repeat _Q_ until we reach some stopping condition (rather than n times)
_f_ :: (b -> c -> c) -> (a -> b) -> (a -> a) -> (a -> Bool) -> (a -> c) -> a -> c
_f_ h i j p q a = if p a then q a else _Q_ h i j (_f_ h i j p q) a
No simple way to pass values from left to right pops out at me, but I don't doubt that bifold could be implemented in foldr, and therefore there should be *some* way.
I'll have to give the paper a thorough reading (which, I apologize, I haven't had time to do yet). Thanks again!