5

i noticed a common pattern of executing an action until it stops having certain effects, when one knows that this signifies a fixed point (ie, there can be no future effects). is there a typeclass for this?

is this covered by MonadFix? looking at the code, it seems it would be, but i was scared off by the wiki page "It is tempting to see “recursion” and guess it means performing actions recursively or repeatedly. No."

it also seems to me that fixed points are something like the dual of identities. that is, an identity disappears when combined with a non-identity (0 for (+), 1 for (*), [] for append, etc). whereas a fixed point causes any non-fixed point to disappear under the 'relax' operation below. is there a way to formalize this duality, and is it useful to do so? ie, is there a relationship between MonadPlus and/or Monoid and MonadRelax?

lastly, i notice relax is almost an unfold/anamorphism. would it be better to express it as such?

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}

import Control.Monad.Loops (iterateUntilM) -- cabal install monad-loops

-- states that relax to a fixed point under step
class Monad m => MonadRelax m s | s -> m where
isFixed :: s -> Bool
step :: s -> m s -- often (not always): step s = return s iff isFixed s

relax :: MonadRelax m s => s -> m s
relax = iterateUntilM isFixed step
duplode
  • 31,361
  • 7
  • 69
  • 130
user1441998
  • 417
  • 3
  • 14
  • `step s == s` isn't well-typed, you might have `step s == return s` though, so long as `Eq a => Eq (m a)`. Also, having the fundep as `s -> m` is quite strange. – J. Abrahamson Feb 05 '14 at 23:14
  • yeah i meant for that return to be kind of implicit. the fundep is so isFixed can look up its instance even though it doesn't mention type m (thanks to johnw on #haskell). – user1441998 Feb 05 '14 at 23:24
  • Your `relax` operation, strictly speaking, doesn't "execut[e] an action until it stops having *effects*"—what it observes is the *results* of `step`, and not necessarily its effects. Are you making some assumption that equates effects and results? If so, you may want to clarify this. – Luis Casillas Feb 05 '14 at 23:48
  • yeah i meant "stops having _certain_ effects," which would often, but not necessarily, mean changing the result. i guess in that case, under (Eq s), mfix (or whatever) could find the fixed point automatically, and we wouldn't need isFixed? i don't want to limit it to that case, though. – user1441998 Feb 06 '14 at 00:00
  • I don't understand why `MonadRelax` is better than `iterateUntilM`. In fact it seems worse; is there a reason to believe there is _just one_ good way to step a value once we know its type? – Daniel Wagner Feb 06 '14 at 04:56
  • well, i'm trying to capture the idea of stepping until stepping no longer changes anything, for some flexible idea of "not changing anything." but your point makes me think maybe that's too flexible, and it should really just be either "doesn't change the result" or, if possible to detect (i don't think it is?), actually "has no effect." – user1441998 Feb 06 '14 at 06:00
  • @user1441998 I think it is not the same as "doesn't change the result" - that'd be a plain `fix`. I suppose what you were talking about, is to repeat applying the function even if `s` is the same, as long as it keeps producing effects. However, I am sure you can model the same behaviour with `MonadFix` - wrap the Bool into `s`. – Sassa NF Feb 06 '14 at 09:29
  • but how? `relax = mfix step` diverges, even for `step = return`. `*** Exception: <>` – user1441998 Feb 07 '14 at 00:22

1 Answers1

1

What you are asking for, is actually a plain fix:

cd :: (Monad m) => Int -> Int -> m Int
cd = fix (\f c i -> if i == 0 then return c else f (c+i) (i-1))

This will repeat the computation, until i becomes 0. (I added c to have a meaningful computation; but you could assume s=(Int,Int) with one of them being a rolling sum and the other the counter)

> cd 0 4 :: [Int]
[10]

This is the same as:

relax = fix (\f s -> if isFix s then return s else f (step s))

I believe, this is the definition of iterateUntilM.

Sassa NF
  • 5,334
  • 13
  • 22
  • i must be misunderstanding -- i want step to be able to have effects, and afaict, these types for isFixed and step look wrong: `relax :: Monad m => a -> m a` `relax = fix (\f s -> if isFixed s then return s else f (step s))` `step = undefined` `isFixed = undefined` `:t step -> step :: a` `:t isFixed -> isFixed :: a` – user1441998 Feb 07 '14 at 10:30
  • @user1441998 well, ok, `step s >>= f` then. – Sassa NF Feb 07 '14 at 13:22
  • well that worked, but i don't follow. `fix :: (a -> a) -> a`, but you pass a function of two args. i can see the types work out that `a = b -> mb`. but how do we think of your `f`? some kind of null action, just not quite as null as return? the action of recurring? is this just a trick you know, or is there a way to have reasoned towards this solution? since effects were involved, why wasn't MonadFix necessary, ie, what more would have to be going on for MonadFix to apply? what about the potential duality btw identities and fixed points? can anamorphism always be expressed in terms of fix? – user1441998 Feb 08 '14 at 09:08
  • @user1441998 :) this deserves a long post of its own. Think of it better as so: `cd = fix g` means `cd = g cd`. So the first argument, `f`, of the lambda I passed to `fix` is really `cd`. `f` is not a null action. The trick here is that recursive calls to `cd` are tied with `>>`, which combines the actions of each call. `MonadFix` is used for a different pattern. Identity is related to fixed points like isomorphism is related to identity. `fix` is not always a anamorphism, but anamorphism is always a `fix`. – Sassa NF Feb 08 '14 at 10:03
  • @user1441998 re: fixed points there is a very good categorical treatment of the matter by Varmo Vene in his thesis. – Sassa NF Feb 08 '14 at 10:04
  • huh, thanks, i can see this is deeper than i can grok atm -- no category training, have just merely read _"and anamorphism is just unfold!"_ :) anyway, that way of thinking of `fix` helps a lot, so `f = relax`! and `relax s = if isFixed s then return s else relax =<< step s` makes sense. i guess any recursion is a fix, right? that makes me think this would be better written as an anamorphism, to be more specific? i am surprised that `>>` is involved -- did you mean `>>=`? – user1441998 Feb 08 '14 at 10:46
  • is it odd that this would show up... exactly 1 year ago? http://hackage.haskell.org/package/data-fix-0.0.1/docs/Data-Fix.html – user1441998 Feb 08 '14 at 10:51
  • @user1441998 yes, i did mean `>>=`. Anamorphism is only one type of recursion. – Sassa NF Feb 08 '14 at 15:15
  • _Anamorphism is only one type of recursion._ right, that's my point - relax is (almost) ana (maybe hylo?), so better write it so, rather than the more general `fix`, right? i am coming to see the `fix` solution as unsatisfactory tho - a lambda in `f` that calls `f` seems no better than explicit recursion in `relax`. and the point of `fix` is to avoid the need for an explicit predicate `isFixed`, right? better to write `relax = fix $ \f -> (f =< – user1441998 Feb 10 '14 at 01:16