Why do we need containers? - haskell

(As an excuse: the title mimics the title of Why do we need monads?)
There are containers [1] (and indexed ones [2]) (and hasochistic ones [3]) and descriptions.[4] But containers are problematic [5] and to my very small experience it's harder to think in terms of containers than in terms of descriptions. The type of non-indexed containers is isomorphic to Σ — that's quite too unspecific. The shapes-and-positions description helps, but in
⟦_⟧ᶜ : ∀ {α β γ} -> Container α β -> Set γ -> Set (α ⊔ β ⊔ γ)
⟦ Sh ◃ Pos ⟧ᶜ A = ∃ λ sh -> Pos sh -> A
Kᶜ : ∀ {α β} -> Set α -> Container α β
Kᶜ A = A ◃ const (Lift ⊥)
we are essentially using Σ rather than shapes and positions.
The type of strictly-positive free monads over containers has a rather straightforward definition, but the type of Freer monads looks simpler to me (and in a sense Freer monads are even better than usual Free monads as described in the paper [6]).
So what can we do with containers in a nicer way than with descriptions or something else?
References
Abbott, Michael, Thorsten Altenkirch, and Neil Ghani. "Containers: Constructing strictly positive types." Theoretical Computer Science 342, no. 1 (2005): 3-27.
Altenkirch, Thorsten, Neil Ghani, Peter Hancock, Conor McBride, and PETER MORRIS. 2015. “Indexed Containers.” Journal of Functional Programming 25. Cambridge University Press: e5. doi:10.1017/S095679681500009X.
McBride, Conor. "hasochistic containers (a first attempt)." Jun, 2015.
Chapman, James, Pierre-Evariste Dagand, Conor Mcbride, and Peter Morris. "The gentle art of levitation." In ICFP 2010, pp. 3-14. 2010.
Francesco. "W-types: good news and bad news." Mar 2010.
Kiselyov, Oleg, and Hiromi Ishii. "Freer monads, more extensible effects." In 8th ACM SIGPLAN Symposium on Haskell, Haskell 2015, pp. 94-105. Association for Computing Machinery, Inc, 2015.

To my mind, the value of containers (as in container theory) is their uniformity. That uniformity gives considerable scope to use container representations as the basis for executable specifications, and perhaps even machine-assisted program derivation.
Containers: a theoretical tool, not a good run-time data representation strategy
I would not recommend fixpoints of (normalized) containers as a good general purpose way to implement recursive data structures. That is, it is helpful to know that a given functor has (up to iso) a presentation as a container, because it tells you that generic container functionality (which is easily implemented, once for all, thanks to the uniformity) can be instantiated to your particular functor, and what behaviour you should expect. But that's not to say that a container implementation will be efficient in any practical way. Indeed, I generally prefer first-order encodings (tags and tuples, rather than functions) of first-order data.
To fix terminology, let us say that the type Cont of containers (on Set, but other categories are available) is given by a constructor <| packing two fields, shapes and positions
S : Set
P : S -> Set
(This is the same signature of data which is used to determine a Sigma type, or a Pi type, or a W type, but that does not mean that containers are the same as any of these things, or that these things are the same as each other.)
The interpretation of such a thing as a functor is given by
[_]C : Cont -> Set -> Set
[ S <| P ]C X = Sg S \ s -> P s -> X -- I'd prefer (s : S) * (P s -> X)
mapC : (C : Cont){X Y : Set} -> (X -> Y) -> [ C ]C X -> [ C ]C Y
mapC (S <| P) f (s , k) = (s , f o k) -- o is composition
And we're already winning. That's map implemented once for all. What's more, the functor laws hold by computation alone. There is no need for recursion on the structure of types to construct the operation, or to prove the laws.
Descriptions are denormalized containers
Nobody is attempting to claim that, operationally, Nat <| Fin gives an efficient implementation of lists, just that by making that identification we learn something useful about the structure of lists.
Let me say something about descriptions. For the benefit of lazy readers, let me reconstruct them.
data Desc : Set1 where
var : Desc
sg pi : (A : Set)(D : A -> Desc) -> Desc
one : Desc -- could be Pi with A = Zero
_*_ : Desc -> Desc -> Desc -- could be Pi with A = Bool
con : Set -> Desc -- constant descriptions as singleton tuples
con A = sg A \ _ -> one
_+_ : Desc -> Desc -> Desc -- disjoint sums by pairing with a tag
S + T = sg Two \ { true -> S ; false -> T }
Values in Desc describe functors whose fixpoints give datatypes. Which functors do they describe?
[_]D : Desc -> Set -> Set
[ var ]D X = X
[ sg A D ]D X = Sg A \ a -> [ D a ]D X
[ pi A D ]D X = (a : A) -> [ D a ]D X
[ one ]D X = One
[ D * D' ]D X = Sg ([ D ]D X) \ _ -> [ D' ]D X
mapD : (D : Desc){X Y : Set} -> (X -> Y) -> [ D ]D X -> [ D ]D Y
mapD var f x = f x
mapD (sg A D) f (a , d) = (a , mapD (D a) f d)
mapD (pi A D) f g = \ a -> mapD (D a) f (g a)
mapD one f <> = <>
mapD (D * D') f (d , d') = (mapD D f d , mapD D' f d')
We inevitably have to work by recursion over descriptions, so it's harder work. The functor laws, too, do not come for free. We get a better representation of the data, operationally, because we don't need to resort to functional encodings when concrete tuples will do. But we have to work harder to write programs.
Note that every container has a description:
sg S \ s -> pi (P s) \ _ -> var
But it's also true that every description has a presentation as an isomorphic container.
ShD : Desc -> Set
ShD D = [ D ]D One
PosD : (D : Desc) -> ShD D -> Set
PosD var <> = One
PosD (sg A D) (a , d) = PosD (D a) d
PosD (pi A D) f = Sg A \ a -> PosD (D a) (f a)
PosD one <> = Zero
PosD (D * D') (d , d') = PosD D d + PosD D' d'
ContD : Desc -> Cont
ContD D = ShD D <| PosD D
That's to say, containers are a normal form for descriptions. It's an exercise to show that [ D ]D X is naturally isomorphic to [ ContD D ]C X. That makes life easier, because to say what to do for descriptions, it's enough in principle to say what to do for their normal forms, containers. The above mapD operation could, in principle, be obtained by fusing the isomorphisms to the uniform definition of mapC.
Differential structure: containers show the way
Similarly, if we have a notion of equality, we can say what one-hole contexts are for containers uniformly
_-[_] : (X : Set) -> X -> Set
X -[ x ] = Sg X \ x' -> (x == x') -> Zero
dC : Cont -> Cont
dC (S <| P) = (Sg S P) <| (\ { (s , p) -> P s -[ p ] })
That is, the shape of a one-hole context in a container is the pair of the shape of the original container and the position of the hole; the positions are the original positions apart from that of the hole. That's the proof-relevant version of "multiply by the index, decrement the index" when differentiating power series.
This uniform treatment gives us the specification from which we can derive the centuries-old program to compute the derivative of a polynomial.
dD : Desc -> Desc
dD var = one
dD (sg A D) = sg A \ a -> dD (D a)
dD (pi A D) = sg A \ a -> (pi (A -[ a ]) \ { (a' , _) -> D a' }) * dD (D a)
dD one = con Zero
dD (D * D') = (dD D * D') + (D * dD D')
How can I check that my derivative operator for descriptions is correct? By checking it against the derivative of containers!
Don't fall into the trap of thinking that just because a presentation of some idea is not operationally helpful that it cannot be conceptually helpful.
On "Freer" monads
One last thing. The Freer trick amounts to rearranging an arbitrary functor in a particular way (switching to Haskell)
data Obfuncscate f x where
(:<) :: forall p. f p -> (p -> x) -> Obfuncscate f x
but this is not an alternative to containers. This is a slight currying of a container presentation. If we had strong existentials and dependent types, we could write
data Obfuncscate f x where
(:<) :: pi (s :: exists p. f p) -> (fst s -> x) -> Obfuncscate f x
so that (exists p. f p) represents shapes (where you can choose your representation of positions, then mark each place with its position), and fst picks out the existential witness from a shape (the position representation you chose). It has the merit of being obviously strictly positive exactly because it's a container presentation.
In Haskell, of course, you have to curry out the existential, which fortunately leaves a dependency only on the type projection. It's the weakness of the existential which justifies the equivalence of Obfuncscate f and f. If you try the same trick in a dependent type theory with strong existentials, the encoding loses its uniqueness because you can project and tell apart different choices of representation for positions. That is, I can represent Just 3 by
Just () :< const 3
or by
Just True :< \ b -> if b then 3 else 5
and in Coq, say, these are provably distinct.
Challenge: characterizing polymorphic functions
Every polymorphic function between container types is given in a particular way. There's that uniformity working to clarify our understanding again.
If you have some
f : {X : Set} -> [ S <| T ]C X -> [ S' <| T' ]C X
it is (extensionally) given by the following data, which make no mention of elements whatsoever:
toS : S -> S'
fromP : (s : S) -> P' (toS s) -> P s
f (s , k) = (toS s , k o fromP s)
That is, the only way to define a polymorphic function between containers is to say how to translate input shapes to output shapes, then say how to fill output positions from input positions.
For your preferred representation of strictly positive functors, give a similarly tight characterisation of the polymorphic functions which eliminates abstraction over the element type. (For descriptions, I would use exactly their reducability to containers.)
Challenge: capturing "transposability"
Given two functors, f and g, it is easy to say what their composition f o g is: (f o g) x wraps up things in f (g x), giving us "f-structures of g-structures". But can you readily impose the extra condition that all of the g structures stored in the f structure have the same shape?
Let's say that f >< g captures the transposable fragment of f o g, where all the g shapes are the same, so that we can just as well turn the thing into a g-structure of f-structures. E.g., while [] o [] gives ragged lists of lists, [] >< [] gives rectangular matrices; [] >< Maybe gives lists which are either all Nothing or all Just.
Give >< for your preferred representation of strictly positive functors. For containers, it's this easy.
(S <| P) >< (S' <| P') = (S * S') <| \ { (s , s') -> P s * P' s' }
Conclusion
Containers, in their normalized Sigma-then-Pi form, are not intended to be an efficient machine representation of data. But the knowledge that a given functor, implemented however, has a presentation as a container helps us understand its structure and give it useful equipment. Many useful constructions can be given abstractly for containers, once for all, when they must be given case-by-case for other presentations. So, yes, it is a good idea to learn about containers, if only to grasp the rationale behind the more specific constructions you actually implement.

Related

Is it possible to derive induction for the church-encoded Nat?

I was just wondering if it is possible to derive induction for the church-encoded Nat type on Idris, Agda, Coq and similar. Notice this is a different issue from doing it on CoC (which is known to be impossible) because we have much more expressivity on those (we're able to, for example, extract the second element of Sigma).
Here is a poor proof sketch on Idris (had a lot of syntax issues):
CN : Type
CN = (t : Type) -> t -> (t -> t) -> t
CS : CN -> CN
CS n t z s = s (n t z s)
CZ : CN
CZ t z s = z
ind :
(p : CN -> Type) ->
(z : p CZ) ->
(s : (n : CN) -> p n -> p (CS n)) ->
(n : CN) ->
p n
ind p z s n =
let base_case = the (x : CN ** p x) (CZ ** z)
step_case = the ((x : CN ** p x) -> (y : CN ** p y)) (\ (n ** pf) => (CS n ** s n pf))
result = the (x : CN ** p x) (n (x : CN ** p x) base_case step_case)
fst_result = fst result
snd_result = snd result
fst_is_n = the (fst_result = n) ?fst_is_n
in ?wat
I'm doing it by building a Sigma type starting from CZ ** z all way up to CS (CS ... CZ) ** s (s ... z). Problem is that, while I know the first element of it will be equal to n, I'm not sure how to prove it.
Here's a related question I asked about homotopy type theory. I am also a little out my depth here, so take all this with a grain of salt.
I've proved that CN is isomorphic to Nat iff the free theorm for CN holds. Furthermore, it's known that there are no free theorems under the law of excluded middle (in HoTT). I.e. with LEM, you could could define CNs such as
foo : CN
foo T z s = if T is Bool then not z else z
which is not a proper church natural and would not be covered by the induction principle. Because excluded middle and HoTT are consistent with the type theories you are asking about (as far as I know), it follows that there will not be a proof of ind.
It is known not to be provable because there are models of the calculus of constructions where the impredicative encoding of the natural numbers is not initial (i.e. doesn't satisfy induction).
It does follow from relational parametricity as Phil Wadler has shown long time ago. Hence combining Wadler with internal relational parametricity ala Moulin and Bernardy may do the trick.
I think there is no formal proof that it's impossible, but generally expected that it can't be done. See e.g. the introduction to this paper by Aaron Stump.

Nested List Haskell Iteration

I need to implement a nested list operation in Haskell.
f :: [[String]] -> [[String]]
My input is a 2d array
[ [ ”A” , ”A” , ”A” ]
, [ ”B” , ”B” , ”A” ]
, [ ”A” , ”A” , ”B” ] ]
I arbitrarily generated that list.
A A A
B B A
A A B
So in my implementation I need to do the following.
If a position has A, and it has 2 or more than 2 "B" neighbors, it will turn to B.
If a position has B, and it has 2 or more than 2 "B" neighbors, it stays like as it is.
If a position has B, and it has less than 2 "B" neighbors, it will turn to A.
So after 1st step my table will look like this.
B B A
A B B
B B A
If I were going to use C or C++, my algorithm would like this:
Make a copy of my input.
Traverse both list in 2for loops, check if statements to make a change in the location and whenever I'm going to make a change, I will change the second list not the first, so that traversing the first list won't effect the other "A"'s and "B"'s.
Return second list.
The problem is, in Haskell, I cannot use iteration. How can I solve this problem?
As I stated in a comment, recursion is the looping primitive in Haskell. However, Haskell gives us a lot of power to build more user-friendly abstractions instead of using recursion directly. As #Lazersmoke mentioned, Comonad is a good abstraction when you're updating each individual value of a collection based on other values in the collection, such as the neighbors of the value.
There are quite a few examples of the Comonad class on the web, but it is sadly eclipsed by Monad. So here's my attempt to even the score a bit.
This is going to be a long post, so let me begin with the results. This is from GHCi:
λ display example
[[A,A,A],[B,B,A],[A,A,B]]
λ display (transition example)
[[B,B,A],[A,B,B],[B,B,A]]
Ok, now let's get down to business. First a few administrative things:
module Main where
import Control.Comonad -- from the comonad package
I'm going to try explaining each piece carefully, but it may take a while before the bigger picture becomes apparent. First, we're going to create an interesting data structure often called a zipper and implement an instance of Functor for it.
data U x = U [x] x [x] deriving Functor
instance Functor U where
fmap f (U as x bs) = U (fmap f as) (f x) (fmap f bs)
This data structure doesn't seem so special. It's how we use U that makes it cool. Because Haskell is lazy, we can use infinite lists with the U constructor. For example, i1 = U [-1,-2..] 0 [1,2..] represents all integers. That's not all, though. There's another piece of information: a center point at 0. We could have also represented all integers as i2' = U [0,-1..] 1 [2,3..]. These values are almost the same; they are just shifted by one. We can, in fact, create functions that will transform one into the other.
rightU (U a b (c:cs)) = U (b:a) c cs
leftU (U (a:as) b c) = U as a (b:c)
As you can see, we can slide a U to the left or the right just by rearranging elements. Let's make a Show instance for U and then verify that rightU and leftU work. We obviously can't print infinite lists, so we'll just take 3 elements from each side.
instance Show x => Show (U x) where
show (U as x bs) = (show . reverse . take 3) as ++ (show x) ++ (show . take 3) bs
λ i1
[-3,-2,-1]0[1,2,3]
λ leftU i2
[-3,-2,-1]0[1,2,3]
λ i2
[-2,-1,0]1[2,3,4]
λ rightU i1
[-2,-1,0]1[2,3,4]
Let's review our ultimate goal. We want to have a data structure where we can update each value based on all of its neighbors. Let's see how to do that with our U data structure. Suppose we want to replace each number with the sum of its neighbors. First, let's write a function that calculates the neighbors of the current position of a U:
sumOfNeighbors :: U Int -> Int
sumOfNeighbors (U (a:_) _ (b:_)) = a + b
And just to verify that it works:
λ sumOfNeighbors i1
0
λ sumOfNeighbors i2
2
Unfortunately, this only gives us a single result. We want to apply this function to every possible position. Well U has a Functor instance, so we can fmap a function over it. That would work great if our function had a type like Int -> Int, but it's actually U Int -> Int. But what if we could turn our U Int into a U (U Int)? Then fmap sumOfNeighbors would do exactly what we want!
Get ready for some inception-level data structuring. We're going to take our U Int and create a U (U Int) that will look like this:
-- not real Haskell. just for illustration
U [leftU u, (leftU . leftU) u, (leftU . leftU . leftU) u..] u [rightU u, (rightU . rightU) u, (rightU . rightU . rightU) u..]
This center of this new U (U a) is the original U a. When we slide left, we get original U a slid left, and likewise sliding right. In other words, the new U (U a) contains all the left and right slides of the original U a Here's how we do it:
duplicate :: U a -> U (U a)
duplicate u = U lefts u rights
where lefts = tail $ iterate leftU u
rights = tail $ iterate rightU u
We can use duplicate to write the function that we want:
extend :: (U a -> b) -> U a -> U b
extend f = fmap f . duplicate
Let's try it out.
λ extend sumOfNeighbors i1
[-6,-4,-2]0[2,4,6]
Looks like it works. These function names, duplicate and extend weren't chosen arbitrarily (by me, at least). These functions are part of the Comonad type class. We've been implementing it for our U data type.
class Functor w => Comonad w where
extract :: w a -> a
duplicate :: w a -> w (w a)
extend :: (w a -> b) -> w a -> w b
The only thing missing is extract which is trivial for U:
extract (U _ x _) = x
It's probably not apparent how useful this class is yet. Let's move on and look at how to handle the 2-dimensional case. We can do 2-dimensions with a zipper of zippers. That is, U (U a) where moving left and right shifts the inner zippers, and moving up and down shifts the outer zipper.
newtype V a = V { getV :: U (U a) }
instance Functor V where
fmap f = V . (fmap . fmap) f . getV
-- shift the 'outer' zipper
up :: V a -> V a
up = V . leftU . getV
down :: V a -> V a
down = V . rightU . getV
-- shift the 'inner' zippers
left :: V a -> V a
left = V . fmap leftU .getV
right :: V a -> V a
right = V . fmap rightU . getV
Here's what Comonad looks like for V:
instance Comonad V where
extract = extract . extract . getV
duplicate = fmap V . V . dup . dup . getV
where dup u = U (lefts u) r (right u)
lefts u = tail $ iterate (fmap leftU) u
rights u = tail $ iterate (fmap rightU) u
The extract function is fairly straightforward; it just digs through two layers of zippers to grab the current value. On the other hand, duplicate is sort of a monster. Ignoring the newtype V, its type would be duplicate :: U (U a) -> U (U (U (U a))). The purpose of thedup helper function is to add a U layer. It gets invoked twice. Then we wrap that in V to get a V (U (U a)). Then fmap V wraps the inner U (U a) to make the result V (V a).
Oh by the way, if you're wondering where extend is, we don't actually have to write it. The definition given above is its default.
That was a lot of work, but now we'll be able to easily tackle the original problem! Check this out. I'm going to make a data structure that includes your A and B values, and also a value that we don't care about, C:
data Token = A | B | C deriving (Eq,Show)
And here's some stuff to make building and displaying a V easier.
-- a list of U's containing nothing but x's
filled x = repeat $ U (repeat x) x (repeat x)
type Triple a = (a,a,a)
-- create a U with the middle values a, b, and c, and all the other values the defaulted to d
toU :: a -> Triple a -> U a
toU d (a,b,c) = U (a : repeat d) b (c : repeat d)
-- create a V centered on the 9 given values and default all other values to d
toV :: a -> Triple (Triple a) -> V a
toV d (as, bs, cs) = V (U x y z)
where x = (toU d as) : filled d
y = toU d bs
z = (toU d cs) : filled d
display :: Show a => V a -> [[a]]
display v = fmap g [ [up . left, up, up . right]
, [left, id, right]
, [down . left, down , down . right] ]
where g = fmap (extract . ($ v))
Here's what the example looks like:
example = toV C ((A,A,A)
,(B,B,A)
,(A,A,B))
And the rule is implemented by:
-- move into each neighboring position and get the value in that position
neighbors :: V a -> [a]
neighbors v = fmap (extract . ($ v)) positions
where positions = [ up . left
, up
, up . right
, left
, right
, down . left
, down
, down . right ]
numberOfBs :: V Token -> Int
numberOfBs = length . filter (==B) . neighbors
rule :: V Token -> Token
rule v = case extract v of
C -> C -- C's remain C's forever
_ -> if numberOfBs v >= 2 then B else A
Finally, we can apply rule to every value using extend:
transition = extend rule
λ display (transition example)
[[B,B,A],[A,B,B],[B,B,A]]
This rule is kind of boring though. Everything quickly becomes B's.
λ take 10 $ fmap display (iterate transition example)
[[[A,A,A],[B,B,A],[A,A,B]],[[B,B,A],[A,B,B],[B,B,A]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]]]
Creating a different rule is easy.
rule2 :: V Token -> Token
rule2 v = case extract v of
C -> C
A -> if numberOfBs v >= 2 then B else A
B -> if numberOfBs v >= 4 then A else B
λ take 10 $ fmap display (iterate (extend rule2) example)
[[[A,A,A],[B,B,A],[A,A,B]],[[B,B,A],[B,B,B],[B,B,B]],[[B,A,B],[A,A,A],[B,A,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,A,B],[A,A,A],[B,A,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,A,B],[A,A,A],[B,A,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,A,B],[A,A,A],[B,A,B]],[[B,B,B],[B,B,B],[B,B,B]]]
Cool, right? One final thing I want to mention. Did you notice that we didn't write any special cases to handle the edges? Since the data structure is infinite, we just filled the stuff out of the range which we don't care about with the value C and ignored it when considering the neighbors.

Is this an accurate example of a Haskell Pullback?

I'm still trying to grasp an intuition of pullbacks (from category theory), limits, and universal properties, and I'm not quite catching their usefulness, so maybe you could help shed some insight on that as well as verifying my trivial example?
The following is intentionally verbose, the pullback should be (p, p1, p2), and (q, q1, q2) is one example of a non-universal object to "test" the pullback against to see if things commute properly.
-- MY DIAGRAM, A -> B <- C
type A = Int
type C = Bool
type B = (A, C)
f :: A -> B
f x = (x, True)
g :: C -> B
g x = (1, x)
-- PULLBACK, (p, p1, p2)
type PL = Int
type PR = Bool
type P = (PL, PR)
p = (1, True) :: P
p1 = fst
p2 = snd
-- (g . p2) p == (f . p1) p
-- TEST CASE
type QL = Int
type QR = Bool
type Q = (QL, QR)
q = (152, False) :: Q
q1 :: Q -> A
q1 = ((+) 1) . fst
q2 :: Q -> C
q2 = ((||) True) . snd
u :: Q -> P
u (_, _) = (1, True)
-- (p2 . u == q2) && (p1 . u = q1)
I was just trying to come up with an example that fit the definition, but it doesn't seem particularly useful. When would I "look for" a pull back, or use one?
I'm not sure Haskell functions are the best context
in which to talk about pull-backs.
The pull-back of A -> B and C -> B can be identified with a subset of A x C,
and subset relationships are not directly expressible in Haskell's
type system. In your specific example the pull-back would be
the single element (1, True) because x = 1 and b = True are
the only values for which f(x) = g(b).
Some good "practical" examples of pull-backs may be found
starting on page 41 of Category Theory for Scientists
by David I. Spivak.
Relational joins are the archetypal example of pull-backs
which occur in computer science. The query:
SELECT ...
FROM A, B
WHERE A.x = B.y
selects pairs of rows (a,b) where a is a row from table A
and b is a row from table B and where some function of a
equals some other function of b. In this case the functions
being pulled back are f(a) = a.x and g(b) = b.y.
Another interesting example of a pullback is type unification in type inference. You get type constraints from several places where a variable is used, and you want to find the tightest unifying constraint. I mention this example in my blog.

Transitive closure of a graph in Haskell

The following program has as its purpose the transitive closure of relation (as a set of ordered pairs - a graph) and a test about membership of an ordered pair to that relation.
I tried to make the program efficient through the use of Data.Set instead of lists and eliminating redundancies in the generation of the missing pair.
I would like to know:
how to use QuickCheck to verify its correctness;
how calculate the efficiency of the program, if it is possible, or
how does it compare with similar solutions of the problem (ex.
Transitive closure from a list ).
Any criticism and suggestion will be appreciated.
import Data.Set as S
import Data.Foldable as F (foldMap)
data TruthValue = F | U | T deriving (Show,Eq)
isMemberOfTransitiveGraph :: Ord t => (t, t) -> Set (t, t) -> TruthValue
(x,y) `isMemberOfTransitiveGraph` gr
| S.member (x,y) closure = T -- as suggested by user5402
| S.member (y,x) closure = F -- as suggested by user5402
| otherwise = U
where
closure = transitiveClusureOfGraph gr -- as suggested by user5402
transitiveClusureOfGraph :: Ord a => Set (a, a) -> Set (a, a)
transitiveClusureOfGraph gr = F.foldMap (transitiveClosureOfArgument gr) domain
where
domain = S.map fst gr
transitiveClosureOfArgument :: Ord a => Set (a, a) -> a -> Set (a, a)
transitiveClosureOfArgument gr x = S.map ((,) x) $ recursiveImages gr (S.singleton x)
recursiveImages :: Ord a => Set (a, a) -> Set a -> Set a
recursiveImages gr imgs = f gr imgs S.empty
where
f :: Ord a => Set (a, a) -> Set a -> Set a -> Set a
f gr imgs acc
| S.null imgs = acc
| otherwise = f gr (newImgs S.\\ acc) (S.union newImgs acc)
where
newImgs = F.foldMap (imaginsOf gr) imgs
imaginsOf :: (Ord b, Eq a) => Set (a, b) -> a -> Set b
imaginsOf gr arg = S.foldr (\(a,b) acc -> if a == arg then S.insert b acc else acc) S.empty gr
**
EXAMPLE 1
**
someLessThan = S.fromList [("1","2"),("1","4"),("3","4"),("2","8"),("3","5"),("4","7"),("4","8"),("3","9")]
> transitiveClusureOfGraph someLessThan
> fromList [("1","2"),("1","4"),("1","7"),("1","8"),("2","8"),("3","4"),("3","5"),("3","7"),("3","8"),("3","9"),("4","7"),("4","8")]
a `isLessThan` b = (a,b) `isMemberOfTransitiveGraph` someLessThan
> "1" `isLessThan` "8"
> T
> "8" `isLessThan` "1"
> F
> "1" `isLessThan` "9"
> U
> "9" `isLessThan` "1"
> U
**
EXAMPLE 2
**
someTallerThan = S.fromList [("Alexandre","Andrea"),("Andrea","John"),("George","Frank"),("George","Lucy"),("John","Liza"),("Julia","Lucy"),("Liza","Bob"),("Liza","Frank")]
> transitiveClusureOfGraph someTallerThan
> fromList [("Alexandre","Andrea"),("Alexandre","Bob"),("Alexandre","Frank"),("Alexandre","John"),("Alexandre","Liza"),("Andrea","Bob"),("Andrea","Frank"),("Andrea","John"),("Andrea","Liza"),("George","Frank"),("George","Lucy"),("John","Bob"),("John","Frank"),("John","Liza"),("Julia","Lucy"),("Liza","Bob"),("Liza","Frank")]
a `isTallerThan` b = (a,b) `isMemberOfTransitiveGraph` someTallerThan
> "Alexandre" `isTallerThan` "Frank"
> T
> "Frank" `isTallerThan` "Alexandre"
> F
> "Alexandre" `isTallerThan` "George"
> U
> "George" `isTallerThan` "Alexandre"
> U
**
EXAMPLE 3
**
incomeIsLessOrEqualThan = S.fromList [("Bob","Liza"),("Liza","Tom"),("Tom","Bob"),("Tom","Mary"), ("Tom","Tom")]
> S.filter (\(a,b) -> a /= b) $ transitiveClusureOfGraph incomeIsLessOrEqualThan
> fromList [("Bob","Liza"),("Bob","Mary"),("Bob","Tom"),("Liza","Bob"),("Liza","Mary"),("Liza","Tom"),("Tom","Bob"),("Tom","Liza"),("Tom","Mary")]
Some comments:
Some ideas for Quickcheck tests:
Create a random connected graph and verify that every pair of points is in the transitive closure.
Verify that for any random graph the transitive closure of the transitive closure is just the same as doing the transitive closure just once.
Verify that your code returns the same answer as another implementation (such as from the fgl library.)
However, when I look at the fgl library I see that they just use a fixed graph to test their path query functions. Then they know exactly what the answers should be for all the tests.
Another idea is to solve an ACM (programming competition) problem which involves finding the transitive closure of a graph, and use your code in that solution. Both Timus and codeforces accept Haskell programs.
In isMemberOfTransitiveGraph you have the common sub-expression transitiveClusureOfGraph gr. Now GHC could (and should) detect this and factor it out so that it doesn't get evaluated twice, but it doesn't always do that. Moreover, being an interpreter, ghci won't perform common sub-expression elimination. So, given that transitiveClusureOfGraph is an expensive operation, you should write this function like
this:
isMemberOfTransitiveGraph (x,y) gr
| S.member (x,y) closure = T
| S.member (y,x) closure = F
| otherwise = U
where
closure = transitiveClusureOfGraph gr in
Also, computing the transitive closure for the entire graph is
an expensive way to determine if a specific pair is in the closure.
A better way to implement isMemberOfTransitiveClosure is to simply
perform a depth-first search start at one member of the pair until you a) either find the other element or b) fill out the connected component without finding the other element. Otherwise you are performing a lot of work on the other connected components which is irrelevant to the question you are trying to answer.
If you are really concerned about efficiency, restrict your node type to Int and use Data.IntSet or even Data.BitSet for sets of nodes.

How to handle expressions in Haskell?

Let's say I have :
f :: Double -> Double
f x = 3*x^2 + 5*x + 9
I would like to compute the derivative of this function and write
derivate f
so that
derivate f == \x -> 6*x + 5
but how to define derivate?
derivate :: (a -> a) -> (a -> a)
derivate f = f' -- how to compute f'?
I'm aware there is no native way to do this, but is there a library that can?
Do we have to rely on "meta"-datatypes to achieve this?
data Computation = Add Exp Expr | Mult Expr Expr | Power Expr Expr -- etc
Then, is it not a pain to make a corresponding constructor for each function ? However, datatypes should not represent functions (except for parsers).
Is Pure a good alternative because of its term-rewriting feature? Doesn't it have its drawbacks as well?
Are lists affordable?
f :: [Double]
f = [3, 5, 9]
derivate :: (a -> [a])
derivate f = (*) <$> f <*> (getNs f)
compute f x = sum $
((*) . (^) x) <$> (getNs f) <*> f
getNs f = (reverse (iterate (length f) [0..]))
Haskell now looks like it depends on LISP with a less appropriate syntax. Function and arguments waiting to be used together are quite stored in datatypes.
Plus, it's not very natural.
They don't seem to be "flexible" enough to be able my derivate function other than polynomials, such as homographic functions.
Right now, for example, I would like to use derivatives for a game. The character runs on a floor made using a function, and I would like him to slide if the floor is steep enough.
I also need to solve equations for various purposes. Some examples:
I'm a spaceship and I want to take a nap. During my sleep, if I don't place myself carefully, I might crash on a planet because of gravity. I don't have enough gas to go far away from celestial objects and I don't have a map either.
So I must place myself between the objects in this area so that the sum of their gravitationnal influence on me is canceled.
x and y are my coordinates. gravity is a function that takes two objects and return the vector of the gravitationnal force between them.
If there are two objects, say the Earth and the Moon, besides me, all I need to do to find where to go is to solve:
gravity earth spaceship + gravity moon spaceship == (0, 0)
It's much simpler and faster, etc., than to create a new function from scratch equigravityPoint :: Object -> Object -> Object -> Point.
If there are 3 objects besides me, it's still simple.
gravity earth spaceship + gravity moon spaceship + gravity sun spaceship == (0, 0)
Same for 4, and n. Handling a list of objects is much simpler this way than with equigravityPoint.
Other example.
I want to code an ennemy bot that shoots me.
If he just shoots targeting my current position, he will get me if I run towards me, but he'll miss me if I jump and fall on him.
A smarter bot thinks like that: "Well, he jumped from a wall. If I shoot targeting where he is now the bullet won't get him, because he will have moved until then. So I'm gonna anticipate where he'll be in a few seconds and shoot there so that the bullet and him reach this point at the same time".
Basically, I need the ability to compute trajectories. For example, for this case, I need the solution to trajectoryBullet == trajectoryCharacter, which gives a point where the line and the parabola meet.
A similar and simpler example not involving speed.
I'm a fireman bot and there's a building in fire. Another team of firemen is fighting the fire with their water guns. I am and there are people jumping from . While my friends are shooting water, I hold the trampoline.
I need to go where the people will fall before they do. So I need trajectories and equation-solving.
One way of doing this is to do automatic differentiation instead of symbolic differentiation; this is an approach where you simultaneously compute both f(x) and f′(x) in one computation. There's a really cool way of doing this using dual numbers that I learned about from Dan "sigfpe" Piponi's excellent blog post on automatic differentiation. You should probably just go read that, but here's the basic idea. Instead of working with the real numbers (or Double, our favorite (?) facsimile of them), you define a new set, which I'm going to call D, by adjoining a new element ε to ℝ such that ε2 = 0. This is much like the way we define the complex numbers ℂ by adjoining a new element i to ℝ such that i2 = -1. (If you like algebra, this is the same as saying D = ℝ[x]/⟨x2⟩.) Thus, every element of D is of the form a + bε, where a and b are real. Arithmetic over the dual numbers works like you expect:
(a + bε) ± (c + dε) = (a + c) ± (b + d)ε; and
(a + bε)(c + dε) = ac + bcε + adε + bdε2 = ac + (bc + ad)ε.
(Since ε2 = 0, division is more complicated, although the multiply-by-the-conjugate trick you use with the complex numbers still works; see Wikipedia's explanation for more.)
Now, why are these useful? Intuitively, the ε acts like an infinitesimal, allowing you to compute derivatives with it. Indeed, if we rewrite the rule for multiplication using different names, it becomes
(f + f′ε)(g + g′ε) = fg + (f′g + fg′)ε
And the coefficient of ε there looks a lot like the product rule for differentiating products of functions!
So, then, let's work out what happens for one large class of functions. Since we've ignored division above, suppose we have some function f : ℝ → ℝ defined by a power series (possibly finite, so any polynomial is OK, as are things like sin(x), cos(x), and ex). Then we can define a new function fD : D → D in the obvious way: instead of adding real numbers, we add dual numbers, etc., etc. Then I claim that fD(x + ε) = f(x) + f′(x)ε. First, we can show by induction that for any natural number i, it's the case that (x + ε)i = xi + ixi-1ε; this will establish our derivative result for the case where f(x) = xk. In the base case, this equality clearly holds when i = 0. Then supposing it holds for i, we have
(x + ε)i+1 = (x + ε)(x + ε)i by factoring out one copy of (x + ε)
= (x + ε)(xi + ixi-1ε) by the inductive hypothesis
= xi+1 + (xi + x(ixi-1))ε by the definition of dual-number multiplication
= xi+1 + (i+1)xiε by simple algebra.
And indeed, this is what we wanted. Now, considering our power series f, we know that
f(x) = a0 + a1x + a2x2 + … + aixi + …
Then we have
fD(x + ε) = a0 + a1(x + ε) + a2(x + ε)2 + … + ai(x + ε)i + …
= a0 + (a1x + a1ε) + (a2x2 + 2a2xε) + … + (aixi + iaixi-1ε) + … by the above lemma
= (a0 + a1x + a2x2 + … + aixi + …) + (a1ε + 2a2xε + … + iaixi-1ε + …) by commutativity
= (a0 + a1x + a2x2 + … + aixi + …) + (a1 + 2a2x + … + iaixi-1 + …)ε by factoring out the ε
= f(x) + f′(x)ε by definition.
Great! So dual numbers (at least for this case, but the result is generally true) can do differentiation for us. All we have to do is apply our original function to, not the real number x, but the dual number x + ε, and then extract the resulting coefficient of ε. And I bet you can see how one could implement this in Haskell:
data Dual a = !a :+? !a deriving (Eq, Read, Show)
infix 6 :+?
instance Num a => Num (Dual a) where
(a :+? b) + (c :+? d) = (a+c) :+? (b+d)
(a :+? b) - (c :+? d) = (a-c) :+? (b-d)
(a :+? b) * (c :+? d) = (a*c) :+? (b*c + a*d)
negate (a :+? b) = (-a) :+? (-b)
fromInteger n = fromInteger n :+? 0
-- abs and signum might actually exist, but I'm not sure what they are.
abs _ = error "No abs for dual numbers."
signum _ = error "No signum for dual numbers."
-- Instances for Fractional, Floating, etc., are all possible too.
differentiate :: Num a => (Dual a -> Dual a) -> (a -> a)
differentiate f x = case f (x :+? 1) of _ :+? f'x -> f'x
-- Your original f, but with a more general type signature. This polymorphism is
-- essential! Otherwise, we can't pass f to differentiate.
f :: Num a => a -> a
f x = 3*x^2 + 5*x + 9
f' :: Num a => a -> a
f' = differentiate f
And then, lo and behold:
*Main> f 42
5511
*Main> f' 42
257
Which, as Wolfram Alpha can confirm, is exactly the right answer.
More information about this stuff is definitely available. I'm not any kind of expert on this; I just think the idea is really cool, so I'm taking this chance to parrot what I've read and work out a simple proof or two. Dan Piponi has written more about dual numbers/automatic differentiation, including a post where, among other things, he shows a more general construction which allows for partial derivatives. Conal Elliott has a post where he shows how to compute derivative towers (f(x), f′(x), f″(x), …) in an analogous way. The Wikipedia article on automatic differentiation linked above goes into some more detail, including some other approaches. (This is apparently a form of "forward mode automatic differentiation", but "reverse mode" also exists, and can apparently be faster.)
Finally, there's a Haskell wiki page on automatic differentiation, which links to some articles—and, importantly, some Hackage packages! I've never used these, but it appears that the ad package, by Edward Kmett is the most complete, handling multiple different ways of doing automatic differentiation—and it turns out that he uploaded that package after writing a package to properly answer another Stack Overflow question.
I do want to add one other thing. You say "However, datatypes should not represent functions (except for parsers)." I'd have to disagree there—reifying your functions into data types is great for all sorts of things in this vein. (And what makes parsers special, anyway?) Any time you have a function you want to introspect, reifying it as a data type can be a great option. For instance, here's an encoding of symbolic differentiation, much like the encoding of automatic differentiation above:
data Symbolic a = Const a
| Var String
| Symbolic a :+: Symbolic a
| Symbolic a :-: Symbolic a
| Symbolic a :*: Symbolic a
deriving (Eq, Read, Show)
infixl 6 :+:
infixl 6 :-:
infixl 7 :*:
eval :: Num a => (String -> a) -> Symbolic a -> a
eval env = go
where go (Const a) = a
go (Var x) = env x
go (e :+: f) = go e + go f
go (e :-: f) = go e - go f
go (e :*: f) = go e * go f
instance Num a => Num (Symbolic a) where
(+) = (:+:)
(-) = (:-:)
(*) = (:*:)
negate = (0 -)
fromInteger = Const . fromInteger
-- Ignoring abs and signum again
abs = error "No abs for symbolic numbers."
signum = error "No signum for symbolic numbers."
-- Instances for Fractional, Floating, etc., are all possible too.
differentiate :: Num a => Symbolic a -> String -> Symbolic a
differentiate f x = go f
where go (Const a) = 0
go (Var y) | x == y = 1
| otherwise = 0
go (e :+: f) = go e + go f
go (e :-: f) = go e - go f
go (e :*: f) = go e * f + e * go f
f :: Num a => a -> a
f x = 3*x^2 + 5*x + 9
f' :: Num a => a -> a
f' x = eval (const x) $ differentiate (f $ Var "x") "x"
And once again:
*Main> f 42
5511
*Main> f' 42
257
The beauty of both of these solutions (or one piece of it, anyway) is that as long as your original f is polymorphic (of type Num a => a -> a or similar), you never have to modify f! The only place you need to put derivative-related code is in the definition of your new data type and in your differentiation function; you get the derivatives of your existing functions for free.
Numerical derivative can be done easily:
derive f x = (f (x + dx) - f (x - dx)) / (2 * dx) where dx = 0.00001
However, for symbolic derivatives, you need to create an AST, then implement the derivation rules through matching and rewriting the AST.
I don't understand your problem with using a custom data type
data Expr = Plus Expr Expr
| Times Expr Expr
| Negate Expr
| Exp Expr Expr
| Abs Expr
| Signum Expr
| FromInteger Integer
| Var
instance Num Expr where
fromInteger = FromInteger
(+) = Plus
(*) = Times
negate = Negate
abs = Abs
signum = Signum
toNumF :: Num a => Expr -> a -> a
toNumF e x = go e where
go Var = x
go (FromInteger i) = fromInteger i
go (Plus a b) = (go a) + (go b)
...
you can then use this just like you would Int or Double and all will just work! You can define a function
deriveExpr :: Expr -> Expr
which would then let you define the following (RankN) function
derivate :: Num b => (forall a. Num a => a -> a) -> b -> b
derivate f = toNumF $ deriveExpr (f Var)
you can extend this to work with other parts of the numerical hierarchy.

Resources