g ll =
foldlM (\ some_list b -> do
part <- f b
return (some_list ++ part)) [] ll
In above piece of code I use do statement just because the f function return a monad type: M a where a is a list.
( I "unpack" that list with <-. This is why I need do statement). Can I avoid it and write that more concisely? ( Yes, I know that I can write it using >>= but I also consider something nicer.)
foldlM is the wrong tool for the job. You can use it, as chepner's answer shows, but the way you're concatenating lists could get expensive. Luka Rahne's one-liner is much better:
g ll = fmap concat (mapM f ll)
Another option is to use foldr directly:
g = foldr (\x r -> (++) <$> f x <*> r) (pure [])
Another way to write the second version, by inlining the foldr:
g [] = pure []
g (x : xs) = (++) <$> f x <*> g xs
Your do expression
do
part <- f b
return (some_list ++ part)
follows the extract-apply-return pattern that fmap captures (due to the identity fmap f k = k >>= return . f
You extract part from the computation f b
You apply (some_list ++) to part
You return the result of that application.
This can be done in one step with fmap:
-- foldlM (f b >>= return . (some_list ++)) [] ll
foldlM (\some_list b -> fmap (some_list ++) (f b)) [] ll
Consider the following 2 expressions in Haskell:
foldl' (>>=) Nothing (repeat (\y -> Just (y+1)))
foldM (\x y -> if x==0 then Nothing else Just (x+y)) (-10) (repeat 1)
The first one takes forever, because it's trying to evaluate the infinite expression
...(((Nothing >>= f) >>= f) >>=f)...
and Haskell will just try to evaluate it inside out.
The second expression, however, gives Nothing right away. I've always thought foldM was just doing fold using (>>=), but then it would run into the same problem. So it's doing something more clever here - once it hits Nothing it knows to stop. How does foldM actually work?
foldM can't be implemented using foldl. It needs the power of foldr to be able to stop short. Before we get there, here's a version without anything fancy.
foldM f b [] = return b
foldM f b (x : xs) = f b x >>= \q -> foldM f q xs
We can transform this into a version that uses foldr. First we flip it around:
foldM f b0 xs = foldM' xs b0 where
foldM' [] b = return b
foldM' (x : xs) b = f b x >>= foldM' xs
Then move the last argument over:
foldM' [] = return
foldM' (x : xs) = \b -> f b x >>= foldM' xs
And then recognize the foldr pattern:
foldM' = foldr go return where
go x r = \b -> f b x >>= r
Finally, we can inline foldM' and move b back to the left:
foldM f b0 xs = foldr go return xs b0 where
go x r b = f b x >>= r
This same general approach works for all sorts of situations where you want to pass an accumulator from left to right within a right fold. You first shift the accumulator all the way over to the right so you can use foldr to build a function that takes an accumulator, instead of trying to build the final result directly. Joachim Breitner did a lot of work to create the Call Arity compiler analysis for GHC 7.10 that helps GHC optimize functions written this way. The main reason to want to do so is that it allows them to participate in the GHC list libraries' fusion framework.
One way to define foldl in terms of foldr is:
foldl f z xn = foldr (\ x g y -> g (f y x)) id xn z
It's probably worth working out why that is for yourself. It can be re-written using >>> from Control.Arrow as
foldl f z xn = foldr (>>>) id (map (flip f) xn) z
The monadic equivalent of >>> is
f >=> g = \ x -> f x >>= \ y -> g y
which allows us to guess that foldM might be
foldM f z xn = foldr (>=>) return (map (flip f) xn) z
which turns out to be the correct definition. It can be re-written using foldr/map as
foldM f z xn = foldr (\ x g y -> f y x >>= g) return xn z
newtype Set a = Set [a]
New Type Set that contains a list.
empty :: Set a
empty = Set []
sing :: a -> Set a
sing x = Set [x]
Function to creat a set.
memSet :: (Eq a) => a -> Set a -> Bool
memSet _ (Set []) = False
memSet x (Set xs)
| elem x xs = True
| otherwise = False
{-
makeSet :: (Eq a) => [a] -> Set a
makeSet [] = empty
makeset (x:xs) = union (sing x) (makeSet xs)
-- etc
-- we need the obvious stuff:
union :: Set a -> Set a -> Set a
unionMult :: [ Set a ] -> Set a
intersection :: Set a -> Set a -> Set a
subSet :: Set a -> Set a -> Bool
mapSet :: (a -> b) -> Set a -> Set b
mapset f (Set xs) = makeSet (map f xs)
-}
-- now making it a monad:
instance Monad Set where
return = sing
(Set x) >>= f = unionMult (map f x)
Verification:
Left identity:
return a >>= f ≡ f a
Right identity:
m >>= return ≡ m
Associativity:
(m >>= f) >>= g ≡ m >>= (\x -> f x >>= g)
left:
return x >>= f
(Set [x]) >>= f
unionMult (map f [x])
unionMult [ (f x) ] = f x
right:
(Set [xs]) >>= return
unionMult (map return [xs])
unionMult [ys]
Set [xs]
Need help with the last one.
Since Set a is just a newtype around [a] lets use [] directly. The proofs will be similar so long as we use Set's instances; we'll be able to use []'s constructors (somewhat) directly. That's nice because then we can prove things inductively.
We want to show that for all xs :: [a] xs >>= return == xs. Let's first assume that xs == [].
[] >>= return
unionConcat (map return [])
unionConcat []
[]
Without defining unionConcat we can use this to show that unless unionConcat [] = [] holds, we can't get associativity. We'll keep that in mind for later.
Now we'll do the inductive step, assuming that we have some particular xs :: [a] where xs >>= return == xs, can we show that (x:xs) >>= return == x:xs?
(x:xs) >>= return
unionConcat (map return (x:xs))
unionConcat (return x : map return xs)
...
x : unionConcat (map return xs)
x : (xs >>= return)
x:xs -- working upward from the bottom here
Providing yet another property of unionConcat---
unionConcat (return x : xs) = x : unionConcat xs
So even before we have a definition of unionConcat we can already say that our properties will hold contingent on it following certain properties of its own. We ought to translate the (:) constructor back into a notion for sets, though.
unionConcat (return x : xs) = insert x (unionConcat xs)
unionConcat is already defined in Data.Set.... To be concrete, I will use the following definiitions in this proof
unionConcat = Data.Set.unions
return = Data.Set.fromList [a]
(I will use other functions defined in Data.Set here, some may require "Ord a", presumably that won't be a problem).
I also make use of the following properties
union x y = fromList (toList x ++ toList y)
concat . map (:[]) = id
The first states that the union of two sets can be obtained by taking a list of items in the set, concatinating them, then removing the repeats.... This follows from the definition of what a set is
The second property just states that concat and map (:[]) are inverses of each other. This should also be obvious from the definition of concat
map (:[]) [a, b, c, ....] = [[a], [b], [c], ....]
concat [[a], [b], [c], ....] = [a, b, c, ....]
(In order to really finish this proof, I would have to show that these properties follow from the Haskell definitions of (:[]), concat and union, but this is more detail that I think you want, and the actual definitions might change from version to version, so we will just have to assume that the writers of these functions followed the spirit of how sets and concat should work).
(In case it isn't obvious, remember the monkey operator (:[]) wraps single elements in brackets- (:[]) x = [x]).
Since "unions" is just a multiple appliction of "union", and "concat" is just a multiple application of (++), the first propterty can be generalized to
unions sets = fromList (concat $ map toLists sets)
Now for the proof-
y >>= return
= unions $ map return (toList y)
= unions $ map (fromList . (:[])) (toList y)
= unions $ map fromList $ map (:[]) (toList y)
= unions $ map fromList $ map (:[]) $ toList y
= fromList $ concat $ map toList $ map fromList $ map (:[]) (toList y)
= fromList $ concat $ map (:[]) (toList y)
= fromList $ toList y
= y
QED
Edit- See discussion below, I made a mistake and proved the wrong law (d'oh, I should have just read the title of the question :) ), so I am adding the correct one (associativity) below.
Two prove associativity, we need to use two properties....
property 1 - toList (x >>= f) = su (toList x >>=' toList . f)
property 2 - su (x >>=' f) = su (su x >>=' f)
where su sorts and uniqs a list, ie-
su [4,2,4,1] = [1,2,4],
and >>=' is the array bind operator,
x >>=' f = concat . map f x
The first property should be obvious.... It just states that you can get the result of x >>= f in two different ways, either by applying f to the values in the set x and taking the union, or to the exact same values in the corresponding list, and concating the values. The only hitch is that you might get repeat values in the list (the set couldn't even allow that), so you apply the su function on the right side to canonicalize the result (note that toList also outputs in the same form).
The second property states that if you sort/uniq a result at the end of a pipeline of binds, you can also perform it earlier in the pipeline without changing the answer. Again, this should be obvious.... Adding/removing duplicates or reordering the values with the initial list only add/removes duplicates or reorders the final result. But we are going to remove the duplicates and reorder at the end anyway, so it doesn't matter.
(A more rigorous proof of these two properties could be given based on the definitions of map/concat, toList, etc, but it would blow up the size of this posting.... I'll assume that everyone's intuition is strong enough and continue....)
Using these, I can now show you the proof. The general plan is to use the known associativity of the array bind operator, and the relationship of arrays with sets to show that the set bind operator must also be associative.
Since
toList set1 == toList set2
implies that
set1 == set2
I can prove
toList ((y >>= f) >>= g) = toList (y >>= (\x -> f x >>= g))
to get the desired result.
toList ((y >>= f) >>= g)
su (toList (y >>= f) >>=' toList . g) --by property 1
su (su (toList y >>=' toList . f) >>=' toList . g) --by property 1
su ((toList y >>=' toList . f) >>=' toList . g) --by property 2
su (toList y >>=' (\x -> (toList . f) x >>=' toList . g)) --by the associativity of the array bind operator
su (toList y >>=' (\x -> su (toList (f x) >>=' toList . g))) --by property 2 and associativity of (.)
su (toList y >>=' (\x -> toList (f x >>= g))) --by property 1
su (toList y >>=' toList (\x -> f x >>= g)) --by associativity of (.)
su (su (toList y >>=' toList (\x -> f x >>= g))) --by property 2
su (toList (y >>= (\x -> f x >>= g))) --by property 1
toList (y >>= (\x -> f x >>= g)) --because toList is already sorted/uniqued
QED
> U :: [Setx] --> Set x
>
> (m >>= f) >>= g ≡ m >>= (\x -> f x >>= g)
> VL(leftSide)
> (m >>= f) >>= g
> (Set x >>= f) >>=g <=>
> (U(map f x)) >>=g <=> (U(map f x)=Set y)
> Set y >>= g <=>
>
>
> HL:(right Side)
> m >>= (\x -> f x >>= g) <=>
> Set x >>=(\x -> f x >>= g) (funktionen \x -> f x gives a Set y it will consume value of x.)
But this prrof i wrong. (U= UnionMult.)
I was told that i should try to create a function conposition for both left side and right side. It will help in showing that right side and left side are equal.
HL: rightSide
VL leftSide
want to show VL==HL
This question already has answers here:
Closed 11 years ago.
Possible Duplicate:
Library function to compose a function with itself n times
I need a function to call another function n number of times.
so it would look something like this
f n = g(g(g(g(l))))
where n equals to the number of function g nested.
how should I go about this? thanks!
iterate is a common solution:
> :t iterate
iterate :: (a -> a) -> a -> [a]
So, given a function with a domain the same as its range, a -> a, and an initial input a, produce an infinite list of results in the form:
iterate f a --> [a, f(a), f(f(a)), ...]
And you can access the nth element of the list using !!:
iterate f a !! n
NB iterate f a !! 0 == a.
This is a function that I use often at the ghci prompt. There are a few ways to write it, none of which I am particularly fond of, but they are all reasonably clean:
fpow n f x = iterate f x !! n
fpow n f = foldr (.) id $ replicate n f
fpow n = foldr (.) id . replicate n -- just eta the above
fpow 0 f = id
fpow n f = f . fpow (n-1) f
The middle two appeal to me because my brain has chunked foldr (.) id to mean "compose a list of functions".
I kinda just wish it were in the prelude :-).
f 0 = l
f n = g (f (n-1))
But more functional would be:
f 0 l = l
f n l = g (f (n-1) l)
This could also be done with folds or morfisms, but this is easier to understand.
For example here's using a hylomorphism, but it doesn't make it clearer really:
f g l = hylo l (.) (\n -> (g, n-1)) (==0)
It says some thing like compose (.) g(l) until n==0
Can be done using fold:
applyNTimes :: Int -> (a -> a) -> a -> a
applyNTimes n f val = foldl (\s e -> e s) val [f | x <- [1..n]]
I've been trying to learn a bit of functional programming (with Haskell & Erlang) lately and I'm always amazed at the succinct solutions people can come up with when they can think recursively and know the tools.
I want a function to convert a list of sorted, unique, non-contiguous integers into a list of contiguous lists, i.e:
[1,2,3,6,7,8,10,11]
to:
[[1,2,3], [6,7,8], [10,11]
This was the best I could come up with in Haskell (two functions)::
make_ranges :: [[Int]] -> [Int] -> [[Int]]
make_ranges ranges [] = ranges
make_ranges [] (x:xs)
| null xs = [[x]]
| otherwise = make_ranges [[x]] xs
make_ranges ranges (x:xs)
| (last (last ranges)) + 1 == x =
make_ranges ((init ranges) ++ [(last ranges ++ [x])]) xs
| otherwise = make_ranges (ranges ++ [[x]]) xs
rangify :: [Int] -> [[Int]]
rangify lst = make_ranges [] lst
It might be a bit subjective but I'd be interested to see a better, more elegant, solution to this in either Erlang or Haskell (other functional languages too but I might not understand it.) Otherwise, points for just fixing my crappy beginner's Haskell style!
Most straightforward way in my mind is a foldr:
ranges = foldr step []
where step x [] = [[x]]
step x acc#((y:ys):zs) | y == x + 1 = (x:y:ys):zs
| otherwise = [x]:acc
Or, more concisely:
ranges = foldr step []
where step x ((y:ys):zs) | y == x + 1 = (x:y:ys):zs
step x acc = [x]:acc
But wait, there's more!
abstractRanges f = foldr step []
where step x ((y:ys):zs) | f x y = (x:y:ys):zs
step x acc = [x]:acc
ranges = abstractRanges (\x y -> y == x + 1)
powerRanges = abstractRanges (\x y -> y == x*x) -- mighty morphin
By turning the guard function into a parameter, you can group more interesting things than just +1 sequences.
*Main> powerRanges [1,1,1,2,4,16,3,9,81,5,25]
[[1,1,1],[2,4,16],[3,9,81],[5,25]]
The utility of this particular function is questionable...but fun!
I can't believe I got the shortest solution. I know this is no code golf, but I think it is still quite readable:
import GHC.Exts
range xs = map (map fst) $ groupWith snd $ zipWith (\a b -> (a, a-b)) xs [0..]
or pointfree
range = map (map snd) . groupWith fst . zipWith (\a b -> (b-a, b)) [0..]
BTW, groupWith snd can be replaced with groupBy (\a b -> snd a == snd b) if you prefer Data.List over GHC.Exts
[Edit]
BTW: Is there a nicer way to get rid of the lambda (\a b -> (b-a, b)) than (curry $ (,) <$> ((-) <$> snd <*> fst) <*> snd) ?
[Edit 2]
Yeah, I forgot (,) is a functor. So here is the obfuscated version:
range = map (map fst) . groupWith snd . (flip $ zipWith $ curry $ fmap <$> (-).fst <*> id) [0..]
Suggestions are welcome...
import Data.List (groupBy)
ranges xs = (map.map) snd
. groupBy (const fst)
. zip (True : zipWith ((==) . succ) xs (tail xs))
$ xs
As to how to come up with such a thing: I started with the zipWith f xs (tail xs), which is a common idiom when you want to do something on consecutive elements of a list. Likewise is zipping up a list with information about the list, and then acting (groupBy) upon it. The rest is plumbing.
Then, of course, you can feed it through #pl and get:
import Data.List (groupBy)
import Control.Monad (ap)
import Control.Monad.Instances()
ranges = (((map.map) snd)
. groupBy (const fst))
.) =<< zip
. (True:)
. ((zipWith ((==) . succ)) `ap` tail)
, which, by my authoritative definition, is evil due to Mondad ((->) a). Twice, even. The data flow is meandering too much to lay it out in any sensible way. zipaptail is an Aztec god, and Aztec gods aren't to be messed with.
Another version in Erlang:
part(List) -> part(List,[]).
part([H1,H2|T],Acc) when H1 =:= H2 - 1 ->
part([H2|T],[H1|Acc]);
part([H1|T],Acc) ->
[lists:reverse([H1|Acc]) | part(T,[])];
part([],Acc) -> Acc.
k z = map (fst <$>) . groupBy (const snd) .
zip z . (False:) . (zipWith ((==) . succ) <*> tail) $ z
Try reusing standard functions.
import Data.List (groupBy)
rangeify :: (Num a) => [a] -> [[a]]
rangeify l = map (map fst) $ groupBy (const snd) $ zip l contigPoints
where contigPoints = False : zipWith (==) (map (+1) l) (drop 1 l)
Or, following (mixed) advice to use unfoldr, stop abusing groupBy, and be happy using partial functions when it doesn't matter:
import Control.Arrow ((***))
import Data.List (unfoldr)
spanContig :: (Num a) => [a] -> [[a]]
spanContig l =
map fst *** map fst $ span (\(a, b) -> a == b + 1) $ zip l (head l - 1 : l)
rangeify :: (Num a) => [a] -> [[a]]
rangeify = unfoldr $ \l -> if null l then Nothing else Just $ spanContig l
Erlang using foldr:
ranges(List) ->
lists:foldr(fun (X, [[Y | Ys], Acc]) when Y == X + 1 ->
[[X, Y | Ys], Acc];
(X, Acc) ->
[[X] | Acc]
end, [], List).
This is my v0.1 and I can probably make it better:
makeCont :: [Int] -> [[Int]]
makeCont [] = []
makeCont [a] = [[a]]
makeCont (a:b:xs) = if b - a == 1
then (a : head next) : tail next
else [a] : next
where
next :: [[Int]]
next = makeCont (b:xs)
And I will try and make it better. Edits coming I think.
As a comparison, here's an implementation in Erlang:
partition(L) -> [lists:reverse(T) || T <- lists:reverse(partition(L, {[], []}))].
partition([E|L], {R, [EL|_] = T}) when E == EL + 1 -> partition(L, {R, [E|T]});
partition([E|L], {R, []}) -> partition(L, {R, [E]});
partition([E|L], {R, T}) -> partition(L, {[T|R], [E]});
partition([], {R, []}) -> R;
partition([], {R, T}) -> [T|R].
The standard paramorphism recursion scheme isn't in Haskell's Data.List module, though I think it should be. Here's a solution using a paramorphism, because you are building a list-of-lists from a list, the cons-ing is a little tricksy:
contig :: (Eq a, Num a) => [a] -> [[a]]
contig = para phi [] where
phi x ((y:_),(a:acc)) | x + 1 == y = (x:a):acc
phi x (_, acc) = [x]:acc
Paramorphism is general recursion or a fold with lookahead:
para :: (a -> ([a], b) -> b) -> b -> [a] -> b
para phi b [] = b
para phi b (x:xs) = phi x (xs, para phi b xs)
It can be pretty clear and simple in the Erlang:
partition([]) -> [];
partition([A|T]) -> partition(T, [A]).
partition([A|T], [B|_]=R) when A =:= B+1 -> partition(T, [A|R]);
partition(L, P) -> [lists:reverse(P)|partition(L)].
Edit: Just for curiosity I have compared mine and Lukas's version and mine seems about 10% faster either in native either in bytecode version on testing set what I generated by lists:usort([random:uniform(1000000)||_<-lists:seq(1,1000000)]) on R14B01 64b version at mine notebook. (Testing set is 669462 long and has been partitioned to 232451 sublists.)
Edit2: Another test data lists:usort([random:uniform(1000000)||_<-lists:seq(1,10000000)]), length 999963 and 38 partitions makes bigger diference in native code. Mine version finish in less than half of time. Bytecode version is only about 20% faster.
Edit3: Some microoptimizations which provides additional performance but leads to more ugly and less maintainable code:
part4([]) -> [];
part4([A|T]) -> part4(T, A, []).
part4([A|T], B, R) when A =:= B+1 -> part4(T, A, [B|R]);
part4([A|T], B, []) -> [[B]|part4(T, A, [])];
part4([A|T], B, R) -> [lists:reverse(R, [B])|part4(T, A, [])];
part4([], B, R) -> [lists:reverse(R,[B])].
Here's an attempt from a haskell noob
ranges ls = let (a, r) = foldl (\(r, a#(h:t)) e -> if h + 1 == e then (r, e:a) else (a:r, [e])) ([], [head ls]) (tail ls)
in reverse . map reverse $ r : a