证明流的平等

Question

I have a data type

data N a = N a [N a]

of rose trees and Applicative instance

instance Applicative N where
 pure a = N a (repeat (pure a))
 (N f xs) <*> (N a ys) = N (f a) (zipWith (<*>) xs ys)

and need to prove the Applicative laws for it. However, pure creates infinitely deep, infinitely branching trees. So, for instance, in proving the homomorphism law

pure f <*> pure a = pure (f a)

I thought that proving the equality

zipWith (<*>) (repeat (pure f)) (repeat (pure a)) = repeat (pure (f a))

by the approximation (or take) lemma would work. However, my attempts lead to "vicious circles" in the inductive step. In particular, reducing

approx (n + 1) (zipWith (<*>) (repeat (pure f)) (repeat (pure a))

gives

(pure f <*> pure a) : approx n (repeat (pure (f a)))

where approx is the approximation function. How can I prove the equality without an explicit coinductive proof?

Answer 1

I'd use the universal property of unfolds (since repeat and a suitably uncurried zipWith are both unfolds). There's a related discussion on my blog . But you might also like Ralf Hinze's papers on unique fixpoints ICFP2008 (and the subsequent JFP paper).

(Just checking: all your rose trees are infinitely wide and infinitely deep? I'm guessing that the laws won't hold otherwise.)

Answer 2

The following is a sketch of something that I think works and remains at the level of programmatic syntax and equational reasoning.

The basic intuition is that it is much easier to reason about repeat x than it is to reason about a stream (and worse yet, a list) in general.

uncons (repeat x) = (x, repeat x)

zipWithAp xss yss = 
    let (x,xs) = uncons xss
        (y,ys) = uncons yss
    in (x <*> y) : zipWithAp xs ys

-- provide arguments to zipWithAp
zipWithAp (repeat x) (repeat y) = 
    let (x',xs) = uncons (repeat x)
        (y',ys) = uncons (repeat y)
    in (x' <*> y') : zipWithAp xs ys

-- substitute definition of uncons...
zipWithAp (repeat x) (repeat y) = 
    let (x,repeat x) = uncons (repeat x)
        (y,repeat y) = uncons (repeat y)
    in (x <*> y) : zipWithAp (repeat x) (repeat y)

-- remove now extraneous let clause
zipWithAp (repeat x) (repeat y) = (x <*> y) : zipWithAp (repeat x) (repeat y)

-- unfold identity by one step
zipWithAp (repeat x) (repeat y) = (x <*> y) : (x <*> y) : zipWithAp (repeat x) (repeat y)

-- (co-)inductive step
zipWithAp (repeat x) (repeat y) = repeat (x <*> y)

Answer 3

Why do yo need coinduction? Just induct.

pure f <*> pure a = pure (f a)

can also be written (you need to prove the left and right equality)

N f [(pure f)] <*> N a [(pure a)] = N (f a) [(pure (f a))]

which allows you to off one term at a time. That gives you your induction.