haskell -- set fixedpoint library?

Question

I'm looking for a library that will compute the fixed point / closure of a set under a number of operators of variable arity. For example,

fixwith [(+)] [1]

for the integers should compute all of N (the naturals, 1..). I tried taking a stab at writing it, but some things are lacking. It's not very efficient, and I have a feeling that my handling of multi-arity functions is not the most elegant. Further, would it be possible to write using the builtin fix function instead of manual recursion?

class OperatorN α β | β -> α where
    wrap_op :: β -> (Int, [α] -> α)

instance OperatorN α (() -> α) where
    wrap_op f = (0, \[] -> f ())

instance OperatorN α (α -> α) where
    wrap_op f = (1, \[x] -> f x)

instance OperatorN α ((α, α) -> α) where
    wrap_op f = (2, \[x, y] -> f (x, y))

instance OperatorN α ((α, α, α) -> α) where
    wrap_op f = (3, \[x, y, z] -> f (x, y, z))

instance OperatorN α ((α, α, α, α) -> α) where
    wrap_op f = (4, \[x, y, z, w] -> f (x, y, z, w))

type WrappedOp α = (Int, [α] -> α)
fixwith_next :: Eq α => [WrappedOp α] -> [α] -> [α]
fixwith_next ops s = List.nub (foldl (++) s (map g ops)) where
    g (0, f) = [f []]
    g (arity, f) = do
        x <- s
        let fx = \xs -> f (x:xs)
        g (arity - 1, fx)
fixwith ops s
    | next <- fixwith_next ops s
    , next /= s
    = fixwith ops next
fixwith _ s = s

examples,

> fixwith [wrap_op $ uncurry (*)] [-1 :: Int]
[-1,1]
> fixwith [wrap_op $ uncurry (*)] [1 :: Int]
[1]
> fixwith [wrap_op $ max 3, wrap_op $ \() -> 0] [1 :: Int]
[1,3,0]

set version

This doesn't improve performance all that much, though I guess I just need to figure out how to do less computation to make it actually faster.

import qualified Control.RMonad as RMonad

class OperatorN α β | β -> α where
    wrap_op :: β -> (Int, [α] -> α)

instance OperatorN α (() -> α) where
    wrap_op f = (0, \[] -> f ())

instance OperatorN α (α -> α) where
    wrap_op f = (1, \[x] -> f x)

instance OperatorN α ((α, α) -> α) where
    wrap_op f = (2, \[x, y] -> f (x, y))

instance OperatorN α ((α, α, α) -> α) where
    wrap_op f = (3, \[x, y, z] -> f (x, y, z))

instance OperatorN α ((α, α, α, α) -> α) where
    wrap_op f = (4, \[x, y, z, w] -> f (x, y, z, w))

type WrappedOp α = (Int, [α] -> α)

fixwith_next :: Ord α => [WrappedOp α] -> Set α -> Set α
fixwith_next ops s = Set.unions $ s : map g ops where
    g (0, f) = RMonad.return $ f []
    g (arity, f) = s RMonad.>>= \x ->
        g (arity - 1, \xs -> f (x:xs))
fixwith' ops s
    | next <- fixwith_next ops s
    , next /= s
    = fixwith' ops next
fixwith' _ s = s
fixwith ops s = Set.toList $ fixwith' ops (Set.fromList s)

set version that's lazy

I used RMonad to clean this up a little, and made it lazy as Daniel suggested. I think most of the time is being spent in the actual multiplication routines, sadly, so I didn't see any performance benefit from this change. The laziness is cool though.

notin :: Ord α => Set α -> Set α -> Set α
notin = flip Set.difference

class Ord α => OperatorN α β | β -> α where
    next_values :: β -> Set α -> Set α

instance Ord α => OperatorN α (α -> α) where
    next_values f s = notin s $ s RMonad.>>= \x -> RMonad.return (f x)

instance Ord α => OperatorN α (α -> α -> α) where
    next_values f s = s RMonad.>>= \x -> next_values (f x) s

instance Ord α => OperatorN α (α -> α -> α -> α) where
    next_values f s = s RMonad.>>= \x -> next_values (f x) s

instance Ord α => OperatorN α (α -> α -> α -> α -> α) where
    next_values f s = s RMonad.>>= \x -> next_values (f x) s

-- bind lambdas with next_values
fixwith_next :: Ord α => [Set α -> Set α] -> Set α -> Set α
fixwith_next nv_bnd s = Set.unions $ map (\f -> f s) nv_bnd -- bound next values

fixwith' :: Ord α => [Set α -> Set α] -> Set α -> [α]
fixwith' ops s@(fixwith_next ops -> next)
    | Set.size next == 0 = []
    | otherwise = (Set.toList next) ++ fixwith' ops (Set.union s next)
fixwith ops s = (Set.toList s) ++ fixwith' ops s
fixwith_lst ops = fixwith ops . Set.fromList

example

> take 3 $ fixwith [next_values (+2)] (Set.fromList [1])
[1,3,5]

I had to lose unary operations, but that's not a deal killer.

Answer 1

Nope, fix is a red herring. It's computing a different kind of fixed-point than you are.

Your handling of arity is very pragmatic. There are a number of different ways you could make it a bit less boiler-platey; see one of my previous answers for one such way. I'm sure someone will come on and add another mind-blowing type-level numerals-based solution eventually, as well. =)

For efficiency, I'm not sure you can do much better with only an Eq instance anyway. You might consider filtering out s values from the results of the calls to the (local) g function -- that is, letting fixwith_next return only the new elements. This ought to make the termination check faster and may even make it possible to have a productive, lazy fixwith.

If you're alright with strictness and requiring an Ord instance, using real Sets will probably improve the efficiency as well.