I originally tried writing this without being tail recursive, as according to http://www.erlang.org/doc/efficiency_guide/myths.html the BEAM does it itself. It works, I'm just wondering if my code is overly ugly/inefficient. The one at literate programs http://en.literateprograms.org/Selection_sort_%28Erlang%29 seems a little bit less concise than my version, yet I feel mine has too many params to be easily understood. I am unsure if I would feel this way if I was more experienced with recursion.
-module(selection).
-export([selection/1]).
selection([H|T]) -> lists:reverse(selection(T,H,[],[])).
selection([],Min,[H|T],Acc) -> selection(T,H,[],[Min|Acc]);
selection([],Min,[],Acc) -> [Min|Acc];
selection([H|T],Min,Rest,Acc) when H < Min -> selection(T,H,[Min|Rest],Acc);
selection([H|T],Min,Rest,Acc) -> selection(T,Min,[H|Rest],Acc).
Here is one version:
-module(selection).
-export([selection/1]).
selection([]) -> [];
selection([H|T]) ->
{Min, Rest} = remove_min(H, T, []),
[Min | selection(Rest)].
remove_min(Min, [], Rest) -> {Min, Rest};
remove_min(SoFar, [H|T], Acc) when H < SoFar ->
remove_min(H, T, [SoFar|Acc]);
remove_min(Min, [H|T], Acc) -> remove_min(Min, T, [H|Acc]).
Or getting maximum as YOUR ARGUMENT IS VALID pointed out with accumulator but without reverse:
selection([H|T]) -> selection(T,H,[],[]).
selection([],Max,[H|T],Acc) -> selection(T,H,[],[Max|Acc]);
selection([],Max,[],Acc) -> [Max|Acc];
selection([H|T],Max,Rest,Acc) when H > Max -> selection(T,H,[Max|Rest],Acc);
selection([H|T],Max,Rest,Acc) -> selection(T,Max,[H|Rest],Acc).
It seems both have almost same performance.
Related
Specifically I'm searching for a function 'maximumWith',
maximumWith :: (Foldable f, Ord b) => (a -> b) -> f a -> a
Which behaves in the following way:
maximumWith length [[1, 2], [0, 1, 3]] == [0, 1, 3]
maximumWith null [[(+), (*)], []] == []
maximumWith (const True) x == head x
My use case is picking the longest word in a list.
For this I'd like something akin to maximumWith length.
I'd thought such a thing existed, since sortWith etc. exist.
Let me collect all the notes in the comments together...
Let's look at sort. There are 4 functions in the family:
sortBy is the actual implementation.
sort = sortBy compare uses Ord overloading.
sortWith = sortBy . comparing is the analogue of your desired maximumWith. However, this function has an issue. The ranking of an element is given by applying the given mapping function to it. However, the ranking is not memoized, so if an element needs to compared multiple times, the ranking will be recomputed. You can only use it guilt-free if the ranking function is very cheap. Such functions include selectors (e.g. fst), and newtype constructors. YMMV on simple arithmetic and data constructors. Between this inefficiency, the simplicity of the definition, and its location in GHC.Exts, it's easy to deduce that it's not used that often.
sortOn fixes the inefficiency by decorating each element with its image under the ranking function in a pair, sorting by the ranks, and then erasing them.
The first two have analogues in maximum: maximumBy and maximum. sortWith has no analogy; you may as well write out maximumBy (comparing _) every time. There is also no maximumOn, even though such a thing would be more efficient. The easiest way to define a maximumOn is probably just to copy sortOn:
maximumOn :: (Functor f, Foldable f, Ord r) => (a -> r) -> f a -> a
maximumOn rank = snd . maximumBy (comparing fst) . fmap annotate
where annotate e = let r = rank e in r `seq` (r, e)
There's a bit of interesting code in maximumBy that keeps this from optimizing properly on lists. It also works to use
maximumOn :: (Foldable f, Ord r) => (a -> r) -> f a -> a
maximumOn rank = snd . fromJust . foldl' max' Nothing
where max' Nothing x = let r = rank x in r `seq` Just (r, x)
max' old#(Just (ro, xo)) xn = let rn = rank xn
in case ro `compare` rn of
LT -> Just (rn, xo)
_ -> old
These pragmas may be useful:
{-# SPECIALIZE maximumOn :: Ord r => (a -> r) -> [a] -> a #-}
{-# SPECIALIZE maximumOn :: (a -> Int) -> [a] -> a #-}
HTNW has explained how to do what you asked, but I figured I should mention that for the specific application you mentioned, there's a way that's more efficient in certain cases (assuming the words are represented by Strings). Suppose you want
longest :: [[a]] -> [a]
If you ask for maximumOn length [replicate (10^9) (), []], then you'll end up calculating the length of a very long list unnecessarily. There are several ways to work around this problem, but here's how I'd do it:
data MS a = MS
{ _longest :: [a]
, _longest_suffix :: [a]
, _longest_bound :: !Int }
We will ensure that longest is the first of the longest strings seen thus far, and that longest_bound + length longest_suffix = length longest.
step :: MS a -> [a] -> MS a
step (MS longest longest_suffix longest_bound) xs =
go longest_bound longest_suffix xs'
where
-- the new list is not longer
go n suffo [] = MS longest suffo n
-- the new list is longer
go n [] suffn = MS xs suffn n
-- don't know yet
go !n (_ : suffo) (_ : suffn) =
go (n + 1) suffo suffn
xs' = drop longest_bound xs
longest :: [[a]] -> [a]
longest = _longest . foldl' step (MS [] [] 0)
Now if the second to longest list has q elements, we'll walk at most q conses into each list. This is the best possible complexity. Of course, it's only significantly better than the maximumOn solution when the longest list is much longer than the second to longest.
Data.Tree includes unfoldTreeM_BF and unfoldForestM_BF functions to construct trees breadth-first using the results of monadic actions. The tree unfolder can be written easily using the forest unfolder, so I'll focus on the latter:
unfoldForestM_BF :: Monad m =>
(b -> m (a, [b])) -> [b] -> m [Tree a]
Starting with a list of seeds, it applies a function to each, generating actions that will produce the tree roots and the seeds for the next level of unfolding. The algorithm used is somewhat strict, so using unfoldForestM_BF with the Identity monad is not exactly the same as using the pure unfoldForest. I've been trying to figure out if there's a way to make it lazy without sacrificing its O(n) time bound. If (as Edward Kmett suggested to me) this is impossible, I wonder if it would be possible to do it with a more constrained type, specifically requiring MonadFix rather than Monad. The concept there would be to (somehow) set up the pointers to the results of future computations while adding those computations to the to-do list, so if they are lazy in the effects of earlier computations they will be available immediately.
I previously claimed that the third solution presented below has the same strictness as the depth-first unfoldForest, which is not correct.
Your intuition that trees can be lazily unfolded breadth first is at least partially correct, even if we don't require a MonadFix instance. Solutions exist for the special cases when the branching factor is known to be finite and when the branching factor is known to be "large". We will start with a solution that runs in O(n) time for trees with finite branching factors including degenerate trees with only one child per node. The solution for finite branching factors will fail to terminate on trees with infinite branching factors, which we will rectify with a solution that that runs in O(n) time for trees with "large" branching factors greater than one including trees with infinite branching factor. The solution for "large" branching factors will run in O(n^2) time on degenerate trees with only one child or no children per node. When we combine the methods from both steps in an attempt to make a hybrid solution that runs in O(n) time for any branching factor we will get a solution that is lazier than the first solution for finite branching factors but cannot accommodate trees that make a rapid transition from an infinite branching factor to having no branches.
Finite Branching Factor
The general idea is that we will first build all the labels for an entire level and the seeds for the forests for the next level. We will then descend into the next level, building all of it. We will collect together the results from the deeper level to build the forests for the outer level. We will put the labels together with the forests to build the trees.
unfoldForestM_BF is fairly simple. If there are no seeds for the level it returns. After building all the labels, it takes the seeds for each forest and collects them together into one list of all the seeds to build the next level and unfolds the entire deeper level. Finally it constructs the forest for each tree from the structure of the seeds.
import Data.Tree hiding (unfoldTreeM_BF, unfoldForestM_BF)
unfoldForestM_BF :: Monad m => (b->m (a, [b])) -> [b] -> m [Tree a]
unfoldForestM_BF f [] = return []
unfoldForestM_BF f seeds = do
level <- sequence . fmap f $ seeds
let (labels, bs) = unzip level
deeper <- unfoldForestM_BF f (concat bs)
let forests = trace bs deeper
return $ zipWith Node labels forests
trace reconstructs the structure of nested lists from a flattened list.It is assumed that there is an item in [b] for each of the items anywhere in [[a]]. The use of concat ... trace to flatten all the information about ancestor levels prevents this implementation from working on trees with infinite children for a node.
trace :: [[a]] -> [b] -> [[b]]
trace [] ys = []
trace (xs:xxs) ys =
let (ys', rem) = takeRemainder xs ys
in ys':trace xxs rem
where
takeRemainder [] ys = ([], ys)
takeRemainder (x:xs) (y:ys) =
let ( ys', rem) = takeRemainder xs ys
in (y:ys', rem)
Unfolding a tree is trivial to write in terms of unfolding a forest.
unfoldTreeM_BF :: MonadFix m => (b->m (a, [b])) -> b -> m (Tree a)
unfoldTreeM_BF f = (>>= return . head) . unfoldForestMFix_BF f . (:[])
Large Branching Factor
The solution for large branching factor proceeds in much the same way as the solution for finite branching factor, except it keeps the entire structure of the tree around instead of concatenating the branches in a level to a single list and traceing that list. In addition to the imports used in the previous section, we will be using Compose to compose the functors for multiple levels of a tree together and Traversable to sequence across multi-level structures.
import Data.Tree hiding (unfoldForestM_BF, unfoldTreeM_BF)
import Data.Foldable
import Data.Traversable
import Data.Functor.Compose
import Prelude hiding (sequence, foldr)
Instead of flattening all of the ancestor structures together with concat we will wrap with Compose the ancestors and the seeds for the next level and recurse on the entire structure.
unfoldForestM_BF :: (Traversable t, Traceable t, Monad m) =>
(b->m (a, [b])) -> t b -> m (t (Tree a))
unfoldForestM_BF f seeds
| isEmpty seeds = return (fmap (const undefined) seeds)
| otherwise = do
level <- sequence . fmap f $ seeds
deeper <- unfoldForestM_BF f (Compose (fmap snd level))
return $ zipWithIrrefutable Node (fmap fst level) (getCompose deeper)
zipWithIrrefutable is a lazier version of zipWith that relies on the assumption that there is an item in the second list for each item in the first list. The Traceable structures are the Functors that can provide a zipWithIrrefutable. The laws for Traceable are for every a, xs, and ys if fmap (const a) xs == fmap (const a) ys then zipWithIrrefutable (\x _ -> x) xs ys == xs and zipWithIrrefutable (\_ y -> y) xs ys == ys. Its strictness is given for every f and xs by zipWithIrrefutable f xs ⊥ == fmap (\x -> f x ⊥) xs.
class Functor f => Traceable f where
zipWithIrrefutable :: (a -> b -> c) -> f a -> f b -> f c
We can combine two lists lazily if we already know they have the same structure.
instance Traceable [] where
zipWithIrrefutable f [] ys = []
zipWithIrrefutable f (x:xs) ~(y:ys) = f x y : zipWithIrrefutable f xs ys
We can combine the composition of two functors if we know that we can combine each functor.
instance (Traceable f, Traceable g) => Traceable (Compose f g) where
zipWithIrrefutable f (Compose xs) (Compose ys) =
Compose (zipWithIrrefutable (zipWithIrrefutable f) xs ys)
isEmpty checks for an empty structure of nodes to expand like the pattern match on [] did in the solution for finite branching factors.
isEmpty :: Foldable f => f a -> Bool
isEmpty = foldr (\_ _ -> False) True
The astute reader may notice that zipWithIrrefutable from Traceable is very similar to liftA2 which is half of the definition of Applicative.
Hybrid Solution
The hybrid solution combines the approaches of the finite solution and the "large" solution. Like the finite solution, we will compress and decompress the tree representation at each step. Like the solution for "large" branching factors we will use a data structure that allows stepping over complete branches. The finite branching factor solution used a data type that is flattened everywhere, [b]. The "large" branching factor solution used a data type that was flattened nowhere: increasingly nested lists starting with [b] then [[b]] then [[[b]]] and so on. In between these structures would be nested lists that either stop nesting and just hold a b or keep nesting and hold [b]s. That pattern of recursion is described in general by the Free monad.
data Free f a = Pure a | Free (f (Free f a))
We will be working specifically with Free [] which looks like.
data Free [] a = Pure a | Free [Free [] a]
For the hybrid solution we will repeat all of its imports and components so that the code below here should be complete working code.
import Data.Tree hiding (unfoldTreeM_BF, unfoldForestM_BF)
import Data.Traversable
import Prelude hiding (sequence, foldr)
Since we will be working with Free [], we will provide it with a zipWithIrrefutable.
class Functor f => Traceable f where
zipWithIrrefutable :: (a -> b -> c) -> f a -> f b -> f c
instance Traceable [] where
zipWithIrrefutable f [] ys = []
zipWithIrrefutable f (x:xs) ~(y:ys) = f x y : zipWithIrrefutable f xs ys
instance (Traceable f) => Traceable (Free f) where
zipWithIrrefutable f (Pure x) ~(Pure y ) = Pure (f x y)
zipWithIrrefutable f (Free xs) ~(Free ys) =
Free (zipWithIrrefutable (zipWithIrrefutable f) xs ys)
The breadth first traversal will look very similar to the original version for the finitely branching tree. We build the current labels and seeds for the current level, compress the structure of the remainder of the tree, do all the work for the remaining depths, and decompress the structure of the results to get the forests to go with the labels.
unfoldFreeM_BF :: (Monad m) => (b->m (a, [b])) -> Free [] b -> m (Free [] (Tree a))
unfoldFreeM_BF f (Free []) = return (Free [])
unfoldFreeM_BF f seeds = do
level <- sequence . fmap f $ seeds
let (compressed, decompress) = compress (fmap snd level)
deeper <- unfoldFreeM_BF f compressed
let forests = decompress deeper
return $ zipWithIrrefutable Node (fmap fst level) forests
compress takes a Free [] holding the seeds for forests [b] and flattens the [b] into the Free to get a Free [] b. It also returns a decompress function that can be used to undo the flattening to get the original structure back. We compress away branches with no remaining seeds and branches that only branch one way.
compress :: Free [] [b] -> (Free [] b, Free [] a -> Free [] [a])
compress (Pure [x]) = (Pure x, \(Pure x) -> Pure [x])
compress (Pure xs ) = (Free (map Pure xs), \(Free ps) -> Pure (map getPure ps))
compress (Free xs) = wrapList . compressList . map compress $ xs
where
compressList [] = ([], const [])
compressList ((Free [],dx):xs) = let (xs', dxs) = compressList xs
in (xs', \xs -> dx (Free []):dxs xs)
compressList ( (x,dx):xs) = let (xs', dxs) = compressList xs
in (x:xs', \(x:xs) -> dx x:dxs xs)
wrapList ([x], dxs) = (x, \x -> Free (dxs [x]))
wrapList (xs , dxs) = (Free xs, \(Free xs) -> Free (dxs xs ))
Each compression step also returns a function that will undo it when applied to a Free [] tree with the same structure. All of these functions are partially defined; what they do to Free [] trees with a different structure is undefined. For simplicity we also define partial functions for the inverses of Pure and Free.
getPure (Pure x) = x
getFree (Free xs) = xs
Both unfoldForestM_BF and unfoldTreeM_BF are defined by packaging their argument up into a Free [] b and unpackaging the results assuming they are in the same structure.
unfoldTreeM_BF :: MonadFix m => (b->m (a, [b])) -> b -> m (Tree a)
unfoldTreeM_BF f = (>>= return . getPure) . unfoldFreeM_BF f . Pure
unfoldForestM_BF :: MonadFix m => (b->m (a, [b])) -> [b] -> m [Tree a]
unfoldForestM_BF f = (>>= return . map getPure . getFree) . unfoldFreeM_BF f . Free . map Pure
A more elegant version of this algorithm can probably be made by recognizing that >>= for a Monad is grafting on trees and both Free and FreeT provide monad instances. Both compress and compressList probably have more elegant presentations.
The algorithm presented above is not lazy enough to allow querying trees that branch an infinite number of ways and then terminate. A simple counter example is the following generating function unfolded from 0.
counterExample :: Int -> (Int, [Int])
counterExample 0 = (0, [1, 2])
counterExample 1 = (1, repeat 3)
counterExample 2 = (2, [3])
counterExample 3 = (3, [])
This tree would look like
0
|
+- 1
| |
| +- 3
| |
| `- 3
| |
| ...
|
`- 2
|
+- 3
Attempting to descend the second branch (to 2) and inspect the remaining finite sub-tree will fail to terminate.
Examples
The following examples demonstrate that all implementations of unfoldForestM_BF run actions in breadth first order and that runIdentity . unfoldTreeM_BF (Identity . f) has the same strictness as unfoldTree for trees with finite branching factor. For trees with inifinite branching factor, only the solution for "large" branching factors has the same strictness as unfoldTree. To demonstrate laziness we'll define three infinite trees - a unary tree with one branch, a binary tree with two branches, and an infinitary tree with an infinite number of branches for each node.
mkUnary :: Int -> (Int, [Int])
mkUnary x = (x, [x+1])
mkBinary :: Int -> (Int, [Int])
mkBinary x = (x, [x+1,x+2])
mkInfinitary :: Int -> (Int, [Int])
mkInfinitary x = (x, [x+1..])
Together with unfoldTree, we will define unfoldTreeDF in terms of unfoldTreeM to check that unfoldTreeM really is lazy like you claimed and unfoldTreeBF in terms of unfoldTreeMFix_BF to check that the new implementation is just as lazy.
import Data.Functor.Identity
unfoldTreeDF f = runIdentity . unfoldTreeM (Identity . f)
unfoldTreeBF f = runIdentity . unfoldTreeM_BF (Identity . f)
To get finite pieces of these infinite trees, even the infinitely branching one, we'll define a way to take from a tree as long as its labels match a predicate. This could be written more succinctly in terms of the ability to apply a function to every subForest.
takeWhileTree :: (a -> Bool) -> Tree a -> Tree a
takeWhileTree p (Node label branches) = Node label (takeWhileForest p branches)
takeWhileForest :: (a -> Bool) -> [Tree a] -> [Tree a]
takeWhileForest p = map (takeWhileTree p) . takeWhile (p . rootLabel)
This lets us define nine example trees.
unary = takeWhileTree (<= 3) (unfoldTree mkUnary 0)
unaryDF = takeWhileTree (<= 3) (unfoldTreeDF mkUnary 0)
unaryBF = takeWhileTree (<= 3) (unfoldTreeBF mkUnary 0)
binary = takeWhileTree (<= 3) (unfoldTree mkBinary 0)
binaryDF = takeWhileTree (<= 3) (unfoldTreeDF mkBinary 0)
binaryBF = takeWhileTree (<= 3) (unfoldTreeBF mkBinary 0)
infinitary = takeWhileTree (<= 3) (unfoldTree mkInfinitary 0)
infinitaryDF = takeWhileTree (<= 3) (unfoldTreeDF mkInfinitary 0)
infinitaryBF = takeWhileTree (<= 3) (unfoldTreeBF mkInfinitary 0)
All five methods have the same output for the unary and binary trees. The output comes from putStrLn . drawTree . fmap show
0
|
`- 1
|
`- 2
|
`- 3
0
|
+- 1
| |
| +- 2
| | |
| | `- 3
| |
| `- 3
|
`- 2
|
`- 3
However, the breadth first traversal from the finite branching factor solution is not sufficiently lazy for a tree with an infinite branching factor. The other four methods output the entire tree
0
|
+- 1
| |
| +- 2
| | |
| | `- 3
| |
| `- 3
|
+- 2
| |
| `- 3
|
`- 3
The tree generated with unfoldTreeBF for the finite branching factor solution can never be completely drawn past its first branches.
0
|
+- 1
| |
| +- 2
| | |
| | `- 3
| |
| `- 3
The construction is definitely breadth first.
mkDepths :: Int -> IO (Int, [Int])
mkDepths d = do
print d
return (d, [d+1, d+1])
mkFiltered :: (Monad m) => (b -> Bool) -> (b -> m (a, [b])) -> (b -> m (a, [b]))
mkFiltered p f x = do
(a, bs) <- f x
return (a, filter p bs)
binaryDepths = unfoldTreeM_BF (mkFiltered (<= 2) mkDepths) 0
Running binaryDepths outputs the outer levels before the inner ones
0
1
1
2
2
2
2
From Lazy to Downright Slothful
The hybrid solution from the earlier section is not lazy enough to have the same strictness semantics as Data.Tree's unfoldTree. It is the first in a series of algorithms, each slightly lazier than their predecessor, but none lazy enough to have the same strictness semantics as unfoldTree.
The hybrid solution does not provide a guarantee that exploring a portion of a tree doesn't demand exploring other portions of the same tree. Nor will the code presented below. In one particular yet common case identified by dfeuer exploring only a log(N) sized slice of a finite tree forces the entirety of the tree. This happens when exploring the last descendant of each branch of a tree with constant depth. When compressing the tree we throw out every trivial branch with no descendants, which is necessary to avoid O(n^2) running time. We can only lazily skip over this portion of compression if we can quickly show that a branch has at least one descendant and we can therefore reject the pattern Free []. At the greatest depth of the tree with constant depth, none of the branches have any remaining descendants, so we can never skip a step of the compression. This results in exploring the entire tree to be able to visit the very last node. When the entire tree to that depth is non-finite due to infinite branching factor, exploring a portion of the tree fails to terminate when it would terminate when generated by unfoldTree.
The compression step in the hybrid solution section compresses away branches with no descendants in the first generation that they can be discovered in, which is optimal for compression but not optimal for laziness. We can make the algorithm lazier by delaying when this compression occurs. If we delay it by a single generation (or even any constant number of generations) we will maintain the O(n) upper bound on time. If we delay it by a number of generations that somehow depends on N we would necessarily sacrifice the O(N) time bound. In this section we will delay the compression by a single generation.
To control how compression happens, we will separate stuffing the innermost [] into the Free [] structure from compressing away degenerate branches with 0 or 1 descendants.
Because part of this trick doesn't work without a lot of laziness in the compression, we will adopt a paranoid level of excessively slothful laziness everywhere. If anything about a result other than the tuple constructor (,) could be determined without forcing part of its input with a pattern match we will avoid forcing it until it is necessary. For tuples, anything pattern matching on them will do so lazily. Consequently, some of the code below will look like core or worse.
bindFreeInvertible replaces Pure [b,...] with Free [Pure b,...]
bindFreeInvertible :: Free [] ([] b) -> (Free [] b, Free [] a -> Free [] ([] a))
bindFreeInvertible = wrapFree . go
where
-- wrapFree adds the {- Free -} that would have been added in both branches
wrapFree ~(xs, dxs) = (Free xs, dxs)
go (Pure xs) = ({- Free -} (map Pure xs), Pure . map getPure . getFree)
go (Free xs) = wrapList . rebuildList . map bindFreeInvertible $ xs
rebuildList = foldr k ([], const [])
k ~(x,dx) ~(xs, dxs) = (x:xs, \(~(x:xs)) -> dx x:dxs xs)
wrapList ~(xs, dxs) = ({- Free -} xs, \(~(Free xs)) -> Free (dxs xs)))
compressFreeList removes occurrences of Free [] and replaces Free [xs] with xs.
compressFreeList :: Free [] b -> (Free [] b, Free [] a -> Free [] a)
compressFreeList (Pure x) = (Pure x, id)
compressFreeList (Free xs) = wrapList . compressList . map compressFreeList $ xs
where
compressList = foldr k ([], const [])
k ~(x,dx) ~(xs', dxs) = (x', dxs')
where
x' = case x of
Free [] -> xs'
otherwise -> x:xs'
dxs' cxs = dx x'':dxs xs''
where
x'' = case x of
Free [] -> Free []
otherwise -> head cxs
xs'' = case x of
Free [] -> cxs
otherwise -> tail cxs
wrapList ~(xs, dxs) = (xs', dxs')
where
xs' = case xs of
[x] -> x
otherwise -> Free xs
dxs' cxs = Free (dxs xs'')
where
xs'' = case xs of
[x] -> [cxs]
otherwise -> getFree cxs
The overall compression will not bind the Pure []s into Frees until after the degenerate Frees have been compressed away, delaying compression of degenerate Frees introduced in one generation to the next generation's compression.
compress :: Free [] [b] -> (Free [] b, Free [] a -> Free [] [a])
compress xs = let ~(xs' , dxs' ) = compressFreeList xs
~(xs'', dxs'') = bindFreeInvertible xs'
in (xs'', dxs' . dxs'')
Out of continued paranoia, the helpers getFree and getPure are also made irrefutably lazy.
getFree ~(Free xs) = xs
getPure ~(Pure x) = x
This very quickly solves the problematic example dfeuer discovered
print . until (null . subForest) (last . subForest) $
flip unfoldTreeBF 0 (\x -> (x, if x > 5 then [] else replicate 10 (x+1)))
But since we only delayed the compression by 1 generation, we can recreate exactly the same problem if the very last node of the very last branch is 1 level deeper than all of the other branches.
print . until (null . subForest) (last . subForest) $
flip unfoldTreeBF (0,0) (\(x,y) -> ((x,y),
if x==y
then if x>5 then [] else replicate 9 (x+1, y) ++ [(x+1, y+1)]
else if x>4 then [] else replicate 10 (x+1, y)))
I am defining some functions in an Erlang script file and calling them in main to demonstrate their correctness. I have not had any problems up to now, but suddenly I'm getting an error for no real reason. Here is the code in question (I have checked that this line is the problem by commenting it out):
fibSeq() -> [0] ++ [1] ++ lists:zipwith(func(X, Y) -> X + Y end, fibs(), lists:delete(0, fibSeq())).
The idea behind this function is to efficiently calculate the Fibonacci sequence. It's possible the error is arising because of the infinite recursive nature of the function, however I believe I read that Erlang uses lazy evaluation, so I feel like this should work.
Edit: The usage of this would be list:sublist(fibSeq(), N) or list:nth(N, fibSeq()) where N is an integer.
Edit 2:
The error message is "Syntax error before '->'" with reference to the line number one above the fibSeq() function, and the code before it is
merge([], []) -> [];
merge(A, []) -> A;
merge([], B) -> B;
merge([A|As], [B|Bs]) when A < B -> [A] ++ merge(As, [B] ++ Bs);
merge([A|As], [B|Bs]) -> [B] ++ merge([A] ++ As, Bs).
mergesort([]) -> [];
mergesort([A]) -> [A];
mergesort(As) ->
merge(mergesort(lists:sublist(As, length(As) div 2)), mergesort(lists:sublist(As, length(As) div 2 + 1, length(As) div 2 + 1))).
I have changed my fibonacci code to use a different linear evaluation that I thought of shortly after:
fib(N) when N >= 0, is_integer(N) -> fibHelp(0, 1, N).
fibHelp(L, _, 0) -> L;
fibHelp(L, H, A) when A > 0, is_integer(L), is_integer(H), is_integer(A) ->
fibHelp(H, L+H, A - 1).
The syntax for higher order functions in erlang is fun(X) -> X * 2 end. Using func is a syntax error.
Hey I have implemented this code segment as a move ordering system for a alpha-beta pruning function. It does speed up my code by a little but when I profiled my code I saw it was very clunky.
move_ord [] (primary_ord,secondary_ord) = primary_ord ++ secondary_ord
move_ord (y:ys) (primary_ord,secondary_ord) = case no_of_pebbles state y of
0 -> move_ord ys (primary_ord,secondary_ord)
13 -> move_ord ys (y : primary_ord,secondary_ord)
x
| 7 - y == x -> move_ord ys (y : primary_ord,secondary_ord)
| otherwise -> move_ord ys (primary_ord,y : secondary_ord)
It is meant to place moves with specific pebble values (13 and 7-y==x) at the front of the list. While also filtering out illegal moves of 0 pebbles.
Pebbles are stored as Int. y is a Int.
Thank you in advance.
Does the order in which the elements of primary_ord appear matter?
No it does not. I am ordering branches to check first for alpha-beta cutoffs. The cases I outlined have a higher probability of triggering a pruning on the next branch evaluated. Though since I have no other information they can be in any order as long as they appear in front of the other cases.
In that case, you should deliver the good ones as soon as you find them, and only defer delivering the bad ones.
If move_ord is - except in the recursive calls - only called with ([],[]) as the second argument, I'd recommend
move_ord = go []
where
go acc (y:ys) = case no_of_pebbles state y of
0 -> go acc ys
13 -> y : go acc ys
x | x == 7-y -> y : go acc ys
| otherwise -> go (y:acc) ys
go acc _ = acc
Thus a) you can run in smaller space (unless the consumer accumulates the entire result) and b) the consumer need not wait for the entire list to be traversed before it can start working.
Of course, if there are only very few or even none "good" ys, it may not make a difference, and if the consumer needs the entire list before it can do anything neither. But usually, that should improve matters somewhat. Otherwise, there is not much that can be done in this function, no_of_pebbles would be what uses the most resources here.
If move_ord can be called with non-empty primary_ord or secondary_ord, use a wrapper
move_ord xs (primary, secondary) = primary ++ go secondary xs
where
go acc ... -- as above
I'm assuming that move_ord starts out being called as move_ord ys ([], []). We then have a streaming filter pattern on Either.
import Data.Either
sorter :: (a -> Bool) -> [a] -> [Either a a]
sorter p = map go where go x = if p x then Left x else Right x
then,
uncurry (++)
. partitionEithers
. sorter (\x -> no_of_pebbles x == 13 || 7 - x == no_of_pebbles x)
. filter (\x -> no_of_pebbles x != 0)
Which is still a little ugly because we keep computing no_of_pebbles in various places. This might be alright for documentation purposes, but we could also precompute no_of_pebbles.
uncurry (++)
. partitionEithers
. sorter (\(x, num) -> num == 13 || 7 - x == num)
. filter ((!=0) . snd)
. map (\x -> (x, no_of_pebbles x))
Specialization.
As you use literal constant the compiler will infer default Integer type not Int.
Then you need to specialize the type signature of your function, like so.
move_ord :: [Int] -> ([Int], [Int]) -> ([Int], [Int])
Memoization.
Your input list can contain duplicate element, then two strategy are possible.
Memoize your call of no_of_pebbles, it will save you extract computation, or you can sort and remove the duplicate of your input list before processing it.
Return a tuple.
You accumulate the response as a tuple then maybe you should return it as is.
Trying to merge the two element of it into the function seems to be out of scope.
Should be manage later in your code, and it's good to know that list store in tuple are common data type know as dlist.
I am just curious if there are any (first order polymorphic only) optimisations with folds.
For maps, there's deforestation: map g (map f ls) => map (g . f) ls, and rev (map f ls) => rev_map f ls (faster in Ocaml).
But fold is so powerful, it seems to defy any optimisation.
The obvious ones:
fold_left f acc (List.map g li) => fold_left (fun acc x -> f acc (g x)) acc li
fold_right f li acc => fold_left f acc li (* if (f,acc) is a monoid *)
You may be interested in the classical paper on the topic, "Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire". Beware however that it is technical and has impenetrable notation.
http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.41.125
Edit: my first version of the first rule was wrong, edited thanks to vincent-hugot.
You can use deforestation on folds. In fact, map/map fusion is a special case of that.
The trick is to replace list construction by a special build function:
build :: (forall b. (a -> b -> b) -> b -> b) -> [a]
build g = g (:) []
Now, using the standard definition of foldr
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr c n [] = n
foldr c n (x:xs) = c x (foldr c n xs)
We have the following equivalence:
foldr c n (build g) == g c n
(Actually this is only true under certain, but common, circumstances. For details see "Correctness of short-cut fusion").
If you write your list producing functions (including map) using build and your consumers using foldr, then the above equality can remove most intermediate lists. Haskell's list comprehensions are translated into combinations of build and foldr.
The downside of this approach is that it cannot handle left folds. Stream Fusion handles this just fine, though. It expresses list producers and transformers as streams (coinductive datatypes, kind of like iterators). The above paper is very readable, so I recommend taking a look.
The "bananas" paper mentioned by gasche goes into more details about kinds of folds and their equivalences.
Finally, there is Bird and Moor's "Algebra of Programming", which mentions transformations such as combining two folds into one.
If you're interested going a bit deeper into theory, I suggest you to read something about catamorphisms, anamorphisms and hylomorphisms. While the category theory surrounding it may seem to be a bit scary, the concept isn't that difficult.
Catamorphisms are functions that consume recursive data structures and produce some kind of a value. Anamorphisms are functions that given some value (a kind of a seed) produce recursive data structures. In particular, foldr and build mentioned in the other anwers are functions to build catamorphisms and anamorphisms on lists. But this concept can be applied to basically any recursive data structure, such as different kinds of trees etc.
Now if you build a recursive data structure with an anamorphism and then consume it with a catamorphism, you get what is called a hylomorphism. In such a case, you actually don't need the intermediate structure. You can skip creating it and destroying it. This is often called deforestation.
Concerning map: This function is interesting that it's both a catamorphism and an anamorphism:
map consumes a list and produces something; but also
map produces a list, consuming something.
So you can view the composition of two maps map f . map g as a composition of an anamorphism (map g) with a catamorphism (map f), forming a hylomorphism. So you know can optimize (deforest) by not creating the intermediate list.
To be specific: You could write map in two ways, one using foldr and the other using build:
mapAna :: (a -> b) -> [a] -> [b]
mapAna f xs = build (mapAna' f xs)
mapAna' :: (a -> b) -> [a] -> (b -> c -> c) -> c -> c
mapAna' f [] cons nil = nil
mapAna' f (x : xs) cons nil = (f x) `cons` (mapAna' f xs cons nil)
mapCata :: (a -> b) -> [a] -> [b]
mapCata f xs = foldr (\x ys -> f x : ys) [] xs
and the composition map f (map g zs) as mapCata f (mapAna g zs), which after some simplifications and applying foldr c n (build g) == g c n results in map (f . g).