How to implement Factorial via Control.Arrow.loop? - haskell

I wonder whether it is possible to implement factorial using Control.Arrow.loop.
loop :: ArrowLoop a => a (b, d) (c, d) -> a b c
One of the evident ideas is to implement a somehow terminating branch (a branch where the first element of the pair (type c) wouldn't depend on the second element of the pair (type d)).
It seems to me that it can't be done since we can't apply any boolean function to the second element of the pair (type d) during the first iteration because it would cause infinite recursion, so it only leaves us with the argument (type b), but the result of any boolean function wouldn't differ depending on the iteration (the argument doesn't change), thus, it would either terminate instantly or never terminate at all.
The other idea I had is to create an endless stream of factorials, but this doesn't seem real either, since, once again, the argument can't be changed.
So, I have 3 questions:
Am I right about the points above?
Am I missing any other concept which would help to implement factorial via Control.Arrow.loop?
What is the correct idea behind this implementation?

I've never actually used ArrowLoop before, loop is pretty cool.
Here is a factorial implemented using loop:
fact :: Integer -> Integer
fact =
loop $ \(n, f) ->
( f n 1
, \i acc ->
if i > 0
then f (i - 1) (i * acc)
else acc)
Let's give it a try:
λ> fact <$> [1..11]
[1,2,6,24,120,720,5040,40320,362880,3628800,39916800]
I don't know if I can answer the first question you have, but for the 3rd one it's obviously possible. For the concepts that could help you, I think the fix point is the one you are looking for. For example you can start by trying this ;)
λ> import Data.Function
λ> fix error
Once you press enough Ctrl+C you can write factorial using fix point:
λ> let fact = fix $ \ f i -> if i > 1 then i * f (i - 1) else i
λ> fact <$> [1..11]
[1,2,6,24,120,720,5040,40320,362880,3628800,39916800]
Edit
It seems like a bit of expansion on the answer could be helpful.
First of all let's look at an alternative and better (due to tail recursion) implementation of fact using fix, so we can see how it compares with our implementation using loop:
factFix :: Integer -> Integer
factFix n =
fix
(\f ->
\i acc ->
if i > 0
then f (i - 1) (i * acc)
else acc)
n
1
We can see it is not far off. In both cases we get f as an argument and we return back a function that uses that f, in fact, the returned non-recursive function is identical in both cases. Just for clarity let's extract it an reuse in both places:
factNoRec :: (Ord p, Num p) => (p -> p -> p) -> p -> p -> p
factNoRec f i acc =
if i > 0
then f (i - 1) (i * acc)
else acc
factLoop :: Integer -> Integer
factLoop n = loop (\(k, f) -> (f k 1, factNoRec f)) n
factFix :: Integer -> Integer
factFix n = fix (\f -> factNoRec f) n 1
Hopefully now it is much more apparent that they are really related concepts.
Looking into implementations of fix and loop (at least for functions, cause there are also mfix and loop for Kleisli) provides even more insight into their relation:
λ> fix f = let x = f x in x
λ> loop f b = let (c,d) = f (b,d) in c
They are really close to each other.
How about type signatures:
λ> :t fix
fix :: (t -> t) -> t
λ> :t loop
loop :: ((b, d) -> (c, d)) -> b -> c
Those look different. But if you do a bit of unification in the fact case you'll see that fix and loop acquire types:
λ> :t fix :: ((a -> b -> c) -> (a -> b -> c)) -> a -> b -> c
λ> :t loop :: ((b, a -> b -> c) -> (c, a -> b -> c)) -> b -> c
All of a b and c become all Integer in the end, but looking at type variables instead gives a better insight into what's going on. And really what's going on is just recursion by the means of fixed point combinators.

Related

How can i fix this higher order function code in haskell?

I want to fix this code
h :: (a -> b) -> [a] -> [b]
h f = foldr (\x y -> f x : y) []
if i put h (+100) [1,2,3,4,5] in GHCI
it returns to me [101,202,303,404,505]
when i put h (*10) [1,2,3,4,5] then
i want to get [10,200,3000,40000,500000] list
can anyone help me fixing this code?
You here implemented a map, but in order to repeat the same operation multiple times, you need to perform a mapping on the tail y:
h :: (a -> a) -> [a] -> [a]
h f = foldr (\x y -> f x : map f y) []
Solving the general problem, as Willem Van Onsem's answer does, requires O(n^2) time to calculate the first n elements, because the function has to be applied k times to calculate the kth element.
To solve this sort of problem efficiently, you will need to take advantage of some additional structure. Based on your examples, I think the most obvious approach is to think about semigroup actions. That is, instead of applying an arbitrary function repeatedly, look for an efficient way to represent the compositions of the function. For example, (*x) can be represented by x, allowing (*x) . (*y) to be represented by x*y.
To apply this idea, we first need to transform Willem's solution to make the compositions explicit.
h :: (a -> a) -> [a] -> [a]
h f0 as0 = go as0 f0
where
go [] _ = []
go (a:as) f = f a : go as (f0 . f)
If we like, we can write that as a fold:
h :: (a -> a) -> [a] -> [a]
h f0 as = foldr go stop as f0
where
stop _ = []
go a r f = f a : r (f0 . f)
Now we've structured the function using an accumulator (which is a function). As we compose onto the accumulator, it will get slower and slower to apply it. We want to replace that accumulator with one we can "apply" quickly.
{-# language BangPatterns #-}
import Data.Semigroup
repeatedly :: Semigroup s => (s -> a -> a) -> s -> [a] -> [a]
repeatedly act s0 as = foldr go stop as s0
where
stop _ = []
go a r !s = act s a : r (s0 <> s)
Now you can use, for example,
repeatedly (\(Product s) -> (s*)) (Product 10) [1..5]
==> [10,200,3000,40000,500000]
repeatedly (\(Sum s) -> (s+)) (Sum 100) [1..5]
==> [101,202,303,404,505]
In each of these, you accumulate a product/sum which is added to/multiplied by the current list element.

Does haskell's foldr always take a two-parameter lambda?

Haskell newb here
I'm working on this problem in haskell:
(**) Eliminate consecutive duplicates of list elements.
If a list contains repeated elements they should be replaced with a single copy of the element. The order of the elements should not be changed.
Example:
* (compress '(a a a a b c c a a d e e e e))
(A B C A D E)
The solution (which I had to look up) uses foldr:
compress' :: (Eq a) => [a] -> [a]
compress' xs = foldr (\x acc -> if x == (head acc) then acc else x:acc) [last xs] xs
This foldr, according to the solution, takes two parameters, x and acc. It would seem like all foldr's take these parameters; is there any exception to this? Like a foldr that takes 3 or more? If not, is this convention redundant and can the formula be written with less code?
foldr takes a function of 2 arguments, but this doesn't prevent it from taking a function of 3 arguments provided that function has the right type signature.
If we had a function
g :: x -> y -> z -> w
With
foldr :: (a -> b -> b) -> b -> [a] -> b
Where we want to pass g to foldr, then (a -> b -> b) ~ (x -> y -> z -> w) (where ~ is type equality). Since -> is right associative, this means we can write g's signature as
x -> y -> (z -> w)
and its meaning is the same. Now we've produced a function of two parameters that returns a function of one parameter. In order to unify this with the type a -> b -> b, we just need to line up the arguments:
a -> | x ->
b -> | y ->
b | (z -> w)
This means that b ~ z -> w, so y ~ b ~ z -> w and a ~ x so g's type really has to be
g :: x -> (z -> w) -> (z -> w)
implying
foldr g :: (z -> w) -> [x] -> (z -> w)
This is certainly not impossible, although more unlikely. Our accumulator is a function instead, and to me this begs to be demonstrated with DiffLists:
type DiffList a = [a] -> [a]
append :: a -> DiffList a -> DiffList a
append x dl = \xs -> dl xs ++ [x]
reverse' :: [a] -> [a]
reverse' xs = foldr append (const []) xs $ []
Note that foldr append (const []) xs returns a function which we apply to [] to reverse a list. In this case we've given an alias to functions of the type [a] -> [a] called DiffList, but it's really no different than having written
append :: a -> ([a] -> [a]) -> [a] -> [a]
which is a function of 3 arguments.
As with all things in haskell have a look at the types of things to guide your way you can do this for any function in ghci.
Looking at this for foldr we see:
Prelude> :t foldr
foldr :: (a -> b -> b) -> b -> [a] -> b
This slightly abstract string can be written in english as:
foldr is a function that takes
1 ) a function with two parameters one of type a and one of type b and returns something of type b
2 ) A value of type b
3 ) A list of values of type a
And returns a value of type b
Where a and b are type variables (see here for a good tutorial on them) which can be filled in with any type you like.
It turns out that you can solve your compress problem using a foldr with a three-argument function.
compress :: Eq a => [a] -> [a]
compress [] = []
compress (z:zs) = z : foldr f (const []) zs z
where f x k w | x==w = k x
| otherwise = x : k x
Let's dissect that. First, we can improve readability by changing the last two lines to
where f x k = \w -> if x==w then k x else x : k x
This makes it evident that a ternary function is nothing but a binary function returning a unary function. The advantage of looking at it in this way is that foldr is best understood when passed a binary function. Indeed, we are passing a binary function, which just happens to return a function.
Let's focus on types now:
f :: a -> (a -> [a]) -> (a -> [a])
f x k
So, x::a is the element of the list we are folding on. Function k is the result of the fold on the list tail. The result of f x k is something having the same type as k.
\w -> if .... :: (a -> [a])
The overall idea behind this anonymous function is as follows. The parameter k plays the same role as acc in the OP code, except it is a function expecting the previous element w in the list before producing the accumulated compressed list.
Concretely, we use now k x when we used acc, passing on the current element to the next step, since by that time x will become the previous element w. At the top-level, we pass z to the function which is returned by foldr f (const []).
This compress variant is lazy, unlike the posted solution. In fact, the posted solution needs to scan the whole list before starting producing something: this is due to (\x acc -> ...) being strict in acc, and to the use of last xs. Instead, the above compress outputs list elements in a "streaming" fashion. Indeed, it works with infinite lists as well:
> take 10 $ compress [1..]
[1,2,3,4,5,6,7,8,9,10]
That being said, I think using a foldr here feels a bit weird: the code above is arguably less readable than the explicit recursion.

What else can `loeb` function be used for?

I am trying to understand "Löb and möb: strange loops in Haskell", but right now the meaning is sleaping away from me, I just don't see why it could be useful. Just to recall function loeb is defined as
loeb :: Functor f => f (f a -> a) -> f a
loeb x = go where go = fmap ($ go) x
or equivalently:
loeb x = go
where go = fmap (\z -> z go) x
In the article there is an example with [] functor and spreadsheets implementation, but it is bit foreign for me just as spreadsheets themselves (never used them).
While I'm understanding that spreadsheet thing, I think it would help a lot for me and others to have more examples, despite lists. Is there any application for loeb for Maybe or other functors?
The primary source (I think) for loeb is Dan Piponi's blog, A Neighborhood of Infinity. There he explains the whole concept in greater detail. I'll replicate a little bit of that as an answer and add some examples.
loeb implements a strange kind of lazy recursion
loeb :: Functor a => a (a x -> x) -> a x
loeb x = fmap (\a -> a (loeb x)) x
Let's imagine we have a type a, where Functor a, and an a-algebra (a function of type a x -> x). You might think of this as a way of computing a value from a structure of values. For instance, here are a few []-algebras:
length :: [Int] -> Int
(!! 3) :: [a] -> a
const 3 :: Num a => [a] -> a
\l -> l !! 2 + l !! 3 :: Num a => [a] -> a
We can see that these a-algebras can use both values stored in the Functor and the structure of the Functor itself.
Another way to think of d :: a x -> x is as a value of x which requires some context–a whole Functorized value a x–in order to be computed. Perhaps this interpretation is more clearly written as Reader (a x) x, emphasizing that this is just a value of x which is delayed, awaiting the a x context to be produced.
type Delay q x = q -> x
Using these ideas we can describe loeb as follows. We're given a f-structure containing some Delayed values, where f is a Functor
Functor f, f (Delay q x)
Naturally, if we were given a q then we could convert this into a not delayed form. In fact, there's only one (non-cheating) function that does this polymorphically:
force :: Functor f => f (Delay q x) -> q -> f x
force f q = fmap ($ q) f
What loeb does is handle the extra tricky case where q is actually force f q, the very result of this function. If you're familiar with fix, this is exactly how we can produce this result.
loeb :: Functor a => a (Delay (a x) x) -> a x
loeb f = fix (force f)
So to make an example, we simply must build a structure containing Delayed values. One natural example of this is to use the list examples from before
> loeb [ length :: [Int] -> Int
, const 3 :: [Int] -> Int
, const 5 :: [Int] -> Int
, (!! 2) :: [Int] -> Int
, (\l -> l !! 2 + l !! 3) :: [Int] -> Int
]
[5, 3, 5, 5, 10]
Here we can see that the list is full of values delayed waiting on the result of evaluating the list. This computation can proceed exactly because there are no loops in data dependency, so the whole thing can just be determined lazily. For instance, const 3 and const 5 are both immediately available as values. length requires that we know the length of the list but none of the values contained so it also proceeds immediately on our fixed-length list. The interesting ones are the values delayed waiting on other values from inside our result list, but since (!! 2) only ends up depending on the third value of the result list, which is determined by const 5 and thus can be immediately available, the computation moves forward. The same idea happens with (\l -> l !! 2 + l !! 3).
So there you have it: loeb completes this strange kind of delayed value recursion. We can use it on any kind of Functor, though. All we need to do is to think of some useful Delayed values.
Chris Kuklewicz's comment notes that there's not a lot you could do interestingly with Maybe as your functor. That's because all of the delayed values over Maybe take the form
maybe (default :: a) (f :: a -> a) :: Maybe a -> a
and all of the interesting values of Maybe (Delay (Maybe a) a) ought to be Just (maybe default f) since loeb Nothing = Nothing. So at the end of the day, the default value never even gets used---we always just have that
loeb (Just (maybe default f)) == fix f
so we may as well write that directly.
You can use it for dynamic programming. The example that comes to mind is the Smith-Waterman algorithm.
import Data.Array
import Data.List
import Control.Monad
data Base = T | C | A | G deriving (Eq,Show)
data Diff = Sub Base Base | Id Base | Del Base | Ins Base deriving (Eq,Show)
loeb x = let go = fmap ($ go) x in go
s a b = if a == b then 1 else 0
smithWaterman a' b' = let
[al,bl] = map length [a',b']
[a,b] = zipWith (\l s -> array (1,s) $ zip [1..] l) [a',b'] [al,bl]
h = loeb $ array ((0,0),(al,bl)) $
[((x,0),const 0) | x <- [0 .. al]] ++
[((0,y),const 0) | y <- [1 .. bl]] ++
[((x,y),\h' -> maximum [
0,
(h' ! (x - 1,y - 1)) + s (a ! x) (b ! y),
(h' ! (x - 1, y)) + 1,
(h' ! (x, y - 1)) + 1
]
) | x <- [1 .. al], y <- [1 .. bl]]
ml l (0,0) = l
ml l (x,0) = ml (Del (a ! x): l) (x - 1, 0)
ml l (0,y) = ml (Ins (b ! y): l) (0, y - 1)
ml l (x,y) = let
(p,e) = maximumBy ((`ap` snd) . (. fst) . (const .) . (. (h !)) . compare . (h !) . fst) [
((x - 1,y),Del (a ! x)),
((y, x - 1),Ins (b ! y)),
((y - 1, x - 1),if a ! x == b ! y then Id (a ! x) else Sub (a ! x) (b ! y))
]
in ml (e : l) p
in ml [] (al,bl)
Here is a live example where it is used for: Map String Float
http://tryplayg.herokuapp.com/try/spreadsheet.hs/edit
with loop detection and loop resolution.
This program calculates speed, time and space. Each one depends on the other two. Each cell has two values: his current entered value and the expression as a function of the other cell values/expressions. circularity is permitted.
The Cell recalculation code uses the famous loeb expression by Dan Piponi in the 2006. Until now by my knowledge there haven't been any materialization of this formula on a real working spreadsheet. this one is close to it. Since loeb enters in a infinite loop when circular expressions are used, the program counts the loops and reduces complexity by progressively substituting formulas by cell values until the expression has no loops
This program is configured for immediate recalculation on cell change, but that can be adapted to allow the modification of more than one cell before recalculation by triggering it by means of a button.
This is blog pos:
http://haskell-web.blogspot.com.es/2014/09/spreadsheet-like-program-in-browser.html

Simplifying nested Maybe pattern matching

I have the following construct in my code:
f :: Maybe A -> X
f a = case a of
Nothing -> x
(Just b) -> case b of
Nothing -> y
(Just c) -> case c of
Nothing -> z
(Just d) -> d
I'm not seeing an obvious way to simplify this instead of using nested maybe functions, which wouldn't make the whole thing look much better. Are there any clever - but still understandable - tricks that would help make this construct more "elegant"?
Why did the code construct a Maybe (Maybe (Maybe X)) value in the first place? Unpacking such a value isn't nice, but the real question is, why there even is such a value. Maybe the code would better avoid all those nested Maybes.
If you really need to have such a value and need to do different things in all the Just/Nothing cases you'll have to write them all down. But instead of several nested case statements you could combine them into one big pattern match:
f Nothing = x
f (Just Nothing)) = y
f (Just (Just Nothing)) = z
f (Just (Just (Just d))) = d
Despite your constraint about not using maybe, I think this looks quite nice:
f = maybe x (maybe y (maybe z id))
or even better, as #pat suggests in his comment:
f = maybe x . maybe y . maybe z $ id
UPDATED 2
Monad Either is for you
import Data.Maybe (maybe)
maybeE :: e -> Maybe a -> Either e a
maybeE e = maybe (Left e) Right
f :: Maybe (Maybe (Maybe d)) -> Either e d
f a = maybeE x a
>>= maybeE y
>>= maybeE z
UPDATED 3
If we want to have not Either type, we could rewrite function:
import Data.Either(either)
either' = either id id
f :: Maybe (Maybe (Maybe d)) -> d
f a = either' $ maybeE x a
>>= maybeE y
>>= maybeE z

Transforming a function that computes a fixed point

I have a function which computes a fixed point in terms of iterate:
equivalenceClosure :: (Ord a) => Relation a -> Relation a
equivalenceClosure = fst . List.head -- "guaranteed" to exist
. List.dropWhile (uncurry (/=)) -- removes pairs that are not equal
. U.List.pairwise (,) -- applies (,) to adjacent list elements
. iterate ( reflexivity
. symmetry
. transitivity
)
Notice that we can abstract from this to:
findFixedPoint :: (a -> a) -> a -> a
findFixedPoint f = fst . List.head
. List.dropWhile (uncurry (/=)) -- dropWhile we have not reached the fixed point
. U.List.pairwise (,) -- applies (,) to adjacent list elements
. iterate
$ f
Can this function be written in terms of fix? It seems like there should be a transformation from this scheme to something with fix in it, but I don't see it.
There's quite a bit going on here, from the mechanics of lazy evaluation, to the definition of a fixed point to the method of finding a fixed point. In short, I believe you may be incorrectly interchanging the fixed point of function application in the lambda calculus with your needs.
It may be helpful to note that your implementation of finding the fixed-point (utilizing iterate) requires a starting value for the sequence of function application. Contrast this to the fix function, which requires no such starting value (As a heads up, the types give this away already: findFixedPoint is of type (a -> a) -> a -> a, whereas fix has type (a -> a) -> a). This is inherently because the two functions do subtly different things.
Let's dig into this a little deeper. First, I should say that you may need to give a little bit more information (your implementation of pairwise, for example), but with a naive first-try, and my (possibly flawed) implementation of what I believe you want out of pairwise, your findFixedPoint function is equivalent in result to fix, for a certain class of functions only
Let's take a look at some code:
{-# LANGUAGE RankNTypes #-}
import Control.Monad.Fix
import qualified Data.List as List
findFixedPoint :: forall a. Eq a => (a -> a) -> a -> a
findFixedPoint f = fst . List.head
. List.dropWhile (uncurry (/=)) -- dropWhile we have not reached the fixed point
. pairwise (,) -- applies (,) to adjacent list elements
. iterate f
pairwise :: (a -> a -> b) -> [a] -> [b]
pairwise f [] = []
pairwise f (x:[]) = []
pairwise f (x:(xs:xss)) = f x xs:pairwise f xss
contrast this to the definition of fix:
fix :: (a -> a) -> a
fix f = let x = f x in x
and you'll notice that we're finding a very different kind of fixed-point (i.e. we abuse lazy evaluation to generate a fixed point for function application in the mathematical sense, where we only stop evaluation iff* the resulting function, applied to itself, evaluates to the same function).
For illustration, let's define a few functions:
lambdaA = const 3
lambdaB = (*)3
and let's see the difference between fix and findFixedPoint:
*Main> fix lambdaA -- evaluates to const 3 (const 3) = const 3
-- fixed point after one iteration
3
*Main> findFixedPoint lambdaA 0 -- evaluates to [const 3 0, const 3 (const 3 0), ... thunks]
-- followed by grabbing the head.
3
*Main> fix lambdaB -- does not stop evaluating
^CInterrupted.
*Main> findFixedPoint lambdaB 0 -- evaluates to [0, 0, ...thunks]
-- followed by grabbing the head
0
now if we can't specify the starting value, what is fix used for? It turns out that by adding fix to the lambda calculus, we gain the ability to specify the evaluation of recursive functions. Consider fact' = \rec n -> if n == 0 then 1 else n * rec (n-1), we can compute the fixed point of fact' as:
*Main> (fix fact') 5
120
where in evaluating (fix fact') repeatedly applies fact' itself until we reach the same function, which we then call with the value 5. We can see this in:
fix fact'
= fact' (fix fact')
= (\rec n -> if n == 0 then 1 else n * rec (n-1)) (fix fact')
= \n -> if n == 0 then 1 else n * fix fact' (n-1)
= \n -> if n == 0 then 1 else n * fact' (fix fact') (n-1)
= \n -> if n == 0 then 1
else n * (\rec n' -> if n' == 0 then 1 else n' * rec (n'-1)) (fix fact') (n-1)
= \n -> if n == 0 then 1
else n * (if n-1 == 0 then 1 else (n-1) * fix fact' (n-2))
= \n -> if n == 0 then 1
else n * (if n-1 == 0 then 1
else (n-1) * (if n-2 == 0 then 1
else (n-2) * fix fact' (n-3)))
= ...
So what does all this mean? depending on the function you're dealing with, you won't necessarily be able to use fix to compute the kind of fixed point you want. This is, to my knowledge, dependent on the function(s) in question. Not all functions have the kind of fixed point computed by fix!
*I've avoided talking about domain theory, as I believe it would only confuse an already subtle topic. If you're curious, fix finds a certain kind of fixed point, namely the least available fixed point of the poset the function is specified over.
Just for the record, it is possible to define the function findFixedPoint using fix.
As Raeez has pointed out, recursive functions can be defined in terms of fix.
The function that you are interested in can be recursively defined as:
findFixedPoint :: Eq a => (a -> a) -> a -> a
findFixedPoint f x =
case (f x) == x of
True -> x
False -> findFixedPoint f (f x)
This means that we can define it as fix ffp where ffp is:
ffp :: Eq a => ((a -> a) -> a -> a) -> (a -> a) -> a -> a
ffp g f x =
case (f x) == x of
True -> x
False -> g f (f x)
For a concrete example, let us assume that f is defined as
f = drop 1
It is easy to see that for every finite list l we have findFixedPoint f l == [].
Here is how fix ffp would work when the "value argument" is []:
(fix ffp) f []
= { definition of fix }
ffp (fix ffp) f []
= { f [] = [] and definition of ffp }
[]
On the other hand, if the "value argument" is [42], we would have:
fix ffp f [42]
= { definition of fix }
ffp (fix ffp) f [42]
= { f [42] =/= [42] and definition of ffp }
(fix ffp) f (f [42])
= { f [42] = [] }
(fix ffp) f []
= { see above }
[]

Resources