Interleaving list functions - haskell

Lets say I'm given two functions:
f :: [a] -> b
g :: [a] -> c
I want to write a function that is the equivalent of this:
h x = (f x, g x)
But when I do that, for large lists inevitably I run out of memory.
A simple example is the following:
x = [1..100000000::Int]
main = print $ (sum x, product x)
I understand this is the case because the list x is being stored in memory without being garbage collected. It would be better instead of f and g worked on x in, well, "parallel".
Assuming I can't change f and g, nor want to make a separate copy of x (assume x is expensive to produce) how can I write h without running into out of memory issues?

A short answer is you can't. Since you have no control over f and g, you have no guarantee that the functions process their input sequentially. Such a function can as well keep the whole list stored in memory before producing the final result.
However, if your functions are expressed as folds, the situation is different. This means that we know how to incrementally apply each step, so we can parallelize those steps in one run.
The are many resources about this area. For example:
Haskell: Can I perform several folds over the same lazy list without keeping list in memory?
Classic Beautiful folding
More beautiful fold zipping
The pattern of consuming a sequence of values with properly defined space bounds is solved more generally with pipe-like libraries such conduit, iteratees or pipes. For example, in conduit, you could express the combination of computing sums and products as
import Control.Monad.Identity
import Data.Conduit
import Data.Conduit.List (fold, sourceList)
import Data.Conduit.Internal (zipSinks)
product', sum' :: (Monad m, Num a) => Sink a m a
sum' = fold (+) 0
product' = fold (*) 1
main = print . runIdentity $ sourceList (replicate (10^6) 1) $$
zipSinks sum' product'

If you can turn your functions into folds, you can then just use them with a scan:
x = [1..100000000::Int]
main = mapM_ print . tail . scanl foo (a0,b0) . takeWhile (not.null)
. unfoldr (Just . splitAt 1000) -- adjust the chunk length as needed
$ x
foo (a,b) x = let a2 = f' a $ f x ; b2 = g' b $ g x
in a2 `seq` b2 `seq` (a2, b2)
f :: [t] -> a -- e.g. sum
g :: [t] -> b -- (`rem` 10007) . product
f' :: a -> a -> a -- e.g. (+)
g' :: b -> b -> b -- ((`rem` 10007) .) . (*)
we consume the input in chunks for better performance. Compiled with -O2, this should run in a constant space. The interim results are printed as indication of progress.
If you can't turn your function into a fold, this means it has to consume the whole list to produce any output and this trick doesn't apply.

You can use multiple threads to evaluate f x and g x in parallel.
E.g.
x :: [Int]
x = [1..10^8]
main = print $ let a = sum x
b = product x
in a `par` b `pseq` (a,b)
Its a nice way to exploit GHC's parallel runtime to prevent a space leak by doing two things at once.
Alternatively, you need to fuse f and g into a single pass.

Related

How to avoid infinite loop in zipWith a self reference?

I'd like to create a list data structure that can zipWith that has a better behavior with self reference. This is for an esoteric language that will rely on self reference and laziness to be Turing complete using only values (no user functions). I've already created it, called Atlas but it has many built ins, I'd like to reduce that and be able to compile/interpret in Haskell.
The issue is that zipWith checks if either list is empty and returns empty. But in the case that this answer depends on the result of zipWith then it will loop infinitely. Essentially I'd like it to detect this case and have faith that the list won't be empty. Here is an example using DList
import Data.DList
import Data.List (uncons)
zipDL :: (a->b->c) -> DList a -> DList b -> DList c
zipDL f a b = fromList $ zipL f (toList a) (toList b)
zipL :: (a->b->c) -> [a] -> [b] -> [c]
zipL _ [] _ = []
zipL _ _ [] = []
zipL f ~(a:as) ~(b:bs) = f a b : zipL f as bs
a = fromList [5,6,7]
main=print $ dh where
d = zipDL (+) a $ snoc (fromList dt) 0
~(Just (dh,dt)) = uncons $ toList d
This code would sum the list 5,6,7 except for the issue. It can be fixed by removing zipL _ _ [] = [] because then it assumes that the result won't be empty and then it in fact turns out not to be empty. But this is a bad solution because we can't always assume that it is the second list that could have the self reference.
Another way of explaining it is if we talk about the sizes of these list.
The size of zip a b = min (size a) (size b)
So in this example: size d = min (size a) (size d-1+1)
But there in lies the problem, if the size of d is 0, then the size of d = 0, but if size of d is 1 the size is 1, however once the size of d is said to be greater than size of a, then the size would be a, which is a contradiction. But any size 0-a works which means it is undefined.
Essentially I want to detect this case and make the size of d = a.
So far the only thing I have figured out is to make all lists lists of Maybe, and terminate lists with a Nothing value. Then in the application of the zipWith binary function return Nothing if either value is Nothing. You can then take out both of the [] checks in zip, because you can think of all lists as being infinite. Finally to make the summation example work, instead of doing a snoc, do a map, and replace any Nothing value with the snoc value. This works because when checking the second list for Nothing, it can lazily return true, since no value of the second list can be nothing.
Here is that code:
import Data.Maybe
data L a = L (Maybe a) (L a)
nil :: L a
nil = L Nothing nil
fromL :: [a] -> L a
fromL [] = nil
fromL (x:xs) = L (Just x) (fromL xs)
binOpMaybe :: (a->b->c) -> Maybe a -> Maybe b -> Maybe c
binOpMaybe f Nothing _ = Nothing
binOpMaybe f _ Nothing = Nothing
binOpMaybe f (Just a) (Just b) = Just (f a b)
zip2W :: (a->b->c) -> L a -> L b -> L c
zip2W f ~(L a as) ~(L b bs) = L (binOpMaybe f a b) (zip2W f as bs)
unconsL :: L a -> (Maybe a, Maybe (L a))
unconsL ~(L a as) = (a, Just as)
mapOr :: a -> L a -> L a
mapOr v ~(L a as) = L (Just $ fromMaybe v a) $ mapOr v as
main=print $ h
where
a = fromL [4,5,6]
b = zip2W (+) a (mapOr 0 (fromJust t))
(h,t) = unconsL $ b
The downside to this approach is it needs this other operator to map with Just . fromMaybe initialvalue. This is a less intuitive operator than ++. And without it the language could be built entirely on ++ uncons and (:[]) which would be pretty neat.
The other thing I've figured out is in the current ruby implementation to throw an error when a value depends on itself, and catch it in the empty list detection. But this is vary hacky and not entirely sound, although it does work for cases like this. I don't think this can work in Haskell since I don't think you can detect self dependence?
Sorry for the long description and the very odd use case. I've spent tons of time thinking about this, but haven't solved it yet and can't explain it any more succinctly! Not expecting an answer but figured it is worth a shot, thanks for considering.
EDIT:
After seeing it framed as a greatest fixed point question, it seems like a poor question because there is no efficient general solution to such a problem. For example, suppose the code was b = zipWith (+) a (if length b < 1 then [1] else []).
For my purposes it could still be nice to handle some cases correctly - the example provided does have a solution. So I could reframe the question as: when can we find the greatest fixed point efficiently and what is that fixed point? But I believe there is no simple answer to such a question, and so it would be a poor basis for a programming language to rely on ad hoc rules.
Sounds like you want a greatest fixed point. I'm not sure I've seen this done before, but maybe it's possible to make a sensible type class for types that support those.
class GF a where gfix :: (a -> a) -> a
instance GF a => GF [a] where
gfix f = case (f (repeat undefined), f []) of
(_:_, _) -> b:bs where
b = gfix (\a' -> head (f (a':bs)))
bs = gfix (\as' -> tail (f (b:as')))
([], []) -> []
_ -> error "no fixed point greater than bottom exists"
-- use the usual least fixed point. this ain't quite right, but
-- it works for this example, and maybe it's Good Enough
instance GF Int where gfix f = let x = f x in x
Try it out in ghci:
> gfix (\xs -> zipWith (+) [5,6,7] (tail xs ++ [0])) :: [Int]
[18,13,7]
This implementation isn't particularly efficient; e.g. replacing [5,6,7] with [1..n] results in a runtime that's quadratic in n. Perhaps with some cleverness that can be improved, but it's not immediately obvious to me how that would go.
I have an answer for this specific case, not general.
appendRepeat :: a -> [a] -> [a]
appendRepeat v a = h : appendRepeat v t
where
~(h,t) =
if null a
then (v,[])
else (head a,tail a)
a = [4,5,6]
main=print $ head b
where
b = zipWith (+) a $ appendRepeat 0 (tail b)
appendRepeat adds a an infinite list of a repeated value to the end of a list. But the key thing about it is it doesn't check if list is empty or not when deciding that it is returning a non empty list where the tail is a recursive call. This way laziness never ends up in an infinite loop checking the zipWith _ [] case.
So this code works, and for the purposes of the original question, it can be used to convert the language to just using 2 simple functions (++ and :[]). But the interpreter would need to do some static analysis for appending a repeated value and replace it to using this special appendRepeat function (which can easily be done in Atlas). It seems hacky to only make this one implementation switcharoo, but that is all that is needed.

Haskell - finding bigrams from an input list of words

I'm following the NLPWP Computational Linguistics site and trying to create a Haskell procedure to find collocations (most common groupings of two words, like "United States" or "to find") in a list of words. I've got the following working code to find bigram frequency:
import Data.Map (Map)
import qualified Data.Map as Map
-- | Function for creating a list of bigrams
-- | e.g. [("Colorless", "green"), ("green", "ideas")]
bigram :: [a] -> [[a]]
bigram [] = []
bigram [_] = []
bigram xs = take 2 xs : bigram (tail xs)
-- | Helper for freqList and freqBigram
countElem base alow = case (Map.lookup alow base) of
Just v -> Map.insert alow (v + 1) base
Nothing -> Map.insert alow 1 base
-- | Maps each word to its frequency.
freqList alow = foldl countElem Map.empty alow
-- | Maps each bigram to its frequency.
freqBigram alow = foldl countElem Map.empty (bigram alow)
I'm trying to write a function that outputs a Map from each bigram to [freq of bigram]/[(freq word 1)*(freq word 2)]. Could you possibly provide advice on how to approach it?
None of the following code is working, but it gives a vague outline for what I was trying to do.
collocations alow =
| let f key = (Map.lookup key freqBi) / ((Map.lookup (first alow) freqs)*(Map.lookup (last alow) freqs))
in Map.mapWithKey f = freqBi
where freqs = (freqList alow)
where freqBi = (freqBigram alow)
I'm very new to Haskell, so let me know if you've got any idea how to fix the collocations procedure. Style tips are also welcome.
Most of your code looks sane, except for the final colloctions function.
I'm not sure why there's a stray pipe in there after the equals sign. You're not trying to write any kind of pattern guard, so I don't think that should be there.
Map.lookup returns a Maybe key, so trying to do division or multiplication isn't going to work. Maybe what you want is some kind of function that takes a key and a map, and returns the associated count or zero if the key doesn't exist?
Other than that, it looks like you're not too far off having this work.
As I read it, your confusion stems from mistaking types, more or less. General advice: Use type signatures on all your top level functions and make sure they are sensible and what you expect of the function (I often do this even before implementing the function).
Let's take a look at your
-- | Function for creating a list of bigrams
-- | e.g. [("Colorless", "green"), ("green", "ideas")]
bigram :: [a] -> [[a]]
If you're giving in a list of Strings, you'll be getting a list of lists of Strings, so your bigram is a list.
You could decide to be more explicit (only allow Strings instead of sometype a - for the beginning at least). So, actually we get a list of Words an make a list of Bigrams from it:
type Word = String
type Bigram = (Word, Word)
bigram :: [Word] -> [Bigram]
For the implementation you can try to use readily available functions from Data.List, for example zipWith and tail.
Now your freqList and freqBigram look like
freqList :: [Word] -> Map Word Int
freqBigram :: [Word] -> Map Bigram Int
With this error messages of the compiler will be clearer to you. To point at it: Take care what you're doing in the lookups for the word frequencies. You're searching for the frequency of word1 and word2, and the bigram is (word1,word2).
Now you should be able to figure the solution out on your own, I guess.
First of all I advise you to have a look at the function
insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
maybe you'll recognize the pattern if used
f freqs bg = insertWith (+) bg 1 freqs
Next as #MathematicalOrchid already pointed out your solution is not too far from being correct.
lookup :: Ord k => k -> Map k a -> Maybe a
You already took care of that in your countElems function.
what I'd like to note that there is this neat abstraction called Applicative, which works really well for problems like yours.
First of all you have to import Control.Applicative if you're using GHC prior to 7.10 for newer versions it is already at your fingertips.
So what does this abstraction provide, similar to Functor it gives you a way to handle "side effects" in your case the possibility of the failing lookup resulting in Nothing.
We have two operators provided by Applicative: pure and <*>, and in addition as every Applicative is required to be a Functor we also get fmap or <$> which are the latter is just an infix alias for convenience.
So how does this apply to your situation?
<*> :: Applicative f => f (a -> b) -> f a -> f b
<$> :: Functor f => a -> b -> f a -> f b
First of all you see that those two look darn similar but with <*> being slightly less familiar.
Now having a function
f :: Int -> Int
f x = x + 3
and
x1 :: Maybe Int
x1 = Just 4
x2 :: Maybe Int
x2 = Nothing
one couldn't simply just f y because that wouldn't typecheck - but and that is the first idea to keep in mind. Maybe is a Functor (it is also an Applicative - it is even more an M-thing, but let's not go there).
f <$> x1 = Just 7
f <$> x2 = Nothing
so you can imagine the f looking up the value and performing the calculation inside the Just and if there is no value - a.k.a. we have the Nothing situation, we'll do what every lazy student does - be lazy and do nothing ;-).
Now we get to the next part <*>
g1 :: Maybe (Int -> Int)
g1 = Just (x + 3)
g2 :: Maybe (Int -> Int)
g2 = Nothing
Still g1 x1 wouldn't work, but
g1 <*> x1 = Just 7
g1 <*> x2 = Nothing
g2 <*> x1 = Nothing -- remember g2 is Nothing
g2 <*> x2 = Nothing
NEAT! - but still how does this solve your problem?
The 'magic' is using both operators ... for multi-argument functions
h :: Int -> Int -> Int
h x y = x + y + 2
and partial function application, which just means put in one value get back a function that waits for the next value.
GHCi> :type h 1
h 1 :: Int -> Int
Now the strange thing happens we can use with a function like h.
GHCi> :type h1 <$> x1
h1 <$> x1 :: Maybe (Int -> Int)
well that's good because then we can use our <*> with it
y1 :: Maybe Int
y1 = Just 7
h1 <$> x1 <*> y1 = Just (4 + 7 + 2)
= Just 13
and this even works with an arbitrary number of arguments
k :: Int -> Int -> Int -> Int -> Int
k x y z w = ...
k <$> x1 <*> y1 <*> z1 <*> w1 = ...
So design a pure function that works with Int, Float, Double or whatever you like and then use the Functor/Applicative abstraction to make your lookup and frequency calculation work with each other.

Directly generating specific subsets of a powerset?

Haskell's expressiveness enables us to rather easily define a powerset function:
import Control.Monad (filterM)
powerset :: [a] -> [[a]]
powerset = filterM (const [True, False])
To be able to perform my task it is crucial for said powerset to be sorted by a specific function, so my implementation kind of looks like this:
import Data.List (sortBy)
import Data.Ord (comparing)
powersetBy :: Ord b => ([a] -> b) -> [a] -> [[a]]
powersetBy f = sortBy (comparing f) . powerset
Now my question is whether there is a way to only generate a subset of the powerset given a specific start and endpoint, where f(start) < f(end) and |start| < |end|. For example, my parameter is a list of integers ([1,2,3,4,5]) and they are sorted by their sum. Now I want to extract only the subsets in a given range, lets say 3 to 7. One way to achieve this would be to filter the powerset to only include my range but this seems (and is) ineffective when dealing with larger subsets:
badFunction :: Ord b => b -> b -> ([a] -> b) -> [a] -> [[a]]
badFunction start end f = filter (\x -> f x >= start && f x <= end) . powersetBy f
badFunction 3 7 sum [1,2,3,4,5] produces [[1,2],[3],[1,3],[4],[1,4],[2,3],[5],[1,2,3],[1,5],[2,4],[1,2,4],[2,5],[3,4]].
Now my question is whether there is a way to generate this list directly, without having to generate all 2^n subsets first, since it will improve performance drastically by not having to check all elements but rather generating them "on the fly".
If you want to allow for completely general ordering-functions, then there can't be a way around checking all elements of the powerset. (After all, how would you know the isn't a special clause built in that gives, say, the particular set [6,8,34,42] a completely different ranking from its neighbours?)
However, you could make the algorithm already drastically faster by
Only sorting after filtering: sorting is O (n · log n), so you want keep n low here; for the O (n) filtering step it matters less. (And anyway, number of elements doesn't change through sorting.)
Apply the ordering-function only once to each subset.
So
import Control.Arrow ((&&&))
lessBadFunction :: Ord b => (b,b) -> ([a]->b) -> [a] -> [[a]]
lessBadFunction (start,end) f
= map snd . sortBy (comparing fst)
. filter (\(k,_) -> k>=start && k<=end)
. map (f &&& id)
. powerset
Basically, let's face it, powersets of anything but a very small basis are infeasible. The particular application “sum in a certain range” is pretty much a packaging problem; there are quite efficient ways to do that kind of thing, but you'll have to give up the idea of perfect generality and of quantification over general subsets.
Since your problem is essentially a constraint satisfaction problem, using an external SMT solver might be the better alternative here; assuming you can afford the extra IO in the type and the need for such a solver to be installed. The SBV library allows construction of such problems. Here's one encoding:
import Data.SBV
-- c is the cost type
-- e is the element type
pick :: (Num e, SymWord e, SymWord c) => c -> c -> ([SBV e] -> SBV c) -> [e] -> IO [[e]]
pick begin end cost xs = do
solutions <- allSat constraints
return $ map extract $ extractModels solutions
where extract ts = [x | (t, x) <- zip ts xs, t]
constraints = do tags <- mapM (const free_) xs
let tagged = zip tags xs
finalCost = cost [ite t (literal x) 0 | (t, x) <- tagged]
solve [finalCost .>= literal begin, finalCost .<= literal end]
test :: IO [[Integer]]
test = pick 3 7 sum [1,2,3,4,5]
We get:
Main> test
[[1,2],[1,3],[1,2,3],[1,4],[1,2,4],[1,5],[2,5],[2,3],[2,4],[3,4],[3],[4],[5]]
For large lists, this technique will beat out generating all subsets and filtering; assuming the cost function generates reasonable constraints. (Addition will be typically OK, if you've multiplications, the backend solver will have a harder time.)
(As a side note, you should never use filterM (const [True, False]) to generate power-sets to start with! While that expression is cute and fun, it is extremely inefficient!)

Recursive state monad for accumulating a value while building a list?

I'm totally new to Haskell so apologies if the question is silly.
What I want to do is recursively build a list while at the same time building up an accumulated value based on the recursive calls. This is for a problem I'm doing for a Coursera course, so I won't post the exact problem but something analogous.
Say for example I wanted to take a list of ints and double each one (ignoring for the purpose of the example that I could just use map), but I also wanted to count up how many times the number '5' appears in the list.
So to do the doubling I could do this:
foo [] = []
foo (x:xs) = x * 2 : foo xs
So far so easy. But how can I also maintain a count of how many times x is a five? The best solution I've got is to use an explicit accumulator like this, which I don't like as it reverses the list, so you need to do a reverse at the end:
foo total acc [] = (total, reverse acc)
foo total acc (x:xs) = foo (if x == 5 then total + 1 else total) (x*2 : acc) xs
But I feel like this should be able to be handled nicer by the State monad, which I haven't used before, but when I try to construct a function that will fit the pattern I've seen I get stuck because of the recursive call to foo. Is there a nicer way to do this?
EDIT: I need this to work for very long lists, so any recursive calls need to be tail-recursive too. (The example I have here manages to be tail-recursive thanks to Haskell's 'tail recursion modulo cons').
Using State monad it can be something like:
foo :: [Int] -> State Int [Int]
foo [] = return []
foo (x:xs) = do
i <- get
put $ if x==5 then (i+1) else i
r <- foo xs
return $ (x*2):r
main = do
let (lst,count) = runState (foo [1,2,5,6,5,5]) 0 in
putStr $ show count
This is a simple fold
foo :: [Integer] -> ([Integer], Int)
foo [] = ([], 0)
foo (x : xs) = let (rs, n) = foo xs
in (2 * x : rs, if x == 5 then n + 1 else n)
or expressed using foldr
foo' :: [Integer] -> ([Integer], Int)
foo' = foldr f ([], 0)
where
f x (rs, n) = (2 * x : rs, if x == 5 then n + 1 else n)
The accumulated value is a pair of both the operations.
Notes:
Have a look at Beautiful folding. It shows a nice way how to make such computations composable.
You can use State for the same thing as well, by viewing each element as a stateful computation. This is a bit overkill, but certainly possible. In fact, any fold can be expressed as a sequence of State computations:
import Control.Monad
import Control.Monad.State
-- I used a slightly non-standard signature for a left fold
-- for simplicity.
foldl' :: (b -> a -> a) -> a -> [b] -> a
foldl' f z xs = execState (mapM_ (modify . f) xs) z
Function mapM_ first maps each element of xs to a stateful computation by modify . f :: b -> State a (). Then it combines a list of such computations into one of type State a () (it discards the results of the monadic computations, just keeps the effects). Finally we run this stateful computation on z.

Composing a chain of 2-argument functions

So I have a list of a functions of two arguments of the type [a -> a -> a]
I want to write a function which will take the list and compose them into a chain of functions which takes length+1 arguments composed on the left. For example if I have [f,g,h] all of types [a -> a -> a] I need to write a function which gives:
chain [f,g,h] = \a b c d -> f ( g ( h a b ) c ) d
Also if it helps, the functions are commutative in their arguments ( i.e. f x y = f y x for all x y ).
I can do this inside of a list comprehension given that I know the the number of functions in question, it would be almost exactly like the definition. It's the stretch from a fixed number of functions to a dynamic number that has me stumped.
This is what I have so far:
f xs = f' xs
where
f' [] = id
f' (x:xs) = \z -> x (f' xs) z
I think the logic is along the right path, it just doesn't type-check.
Thanks in advance!
The comment from n.m. is correct--this can't be done in any conventional way, because the result's type depends on the length of the input list. You need a much fancier type system to make that work. You could compromise in Haskell by using a list that encodes its length in the type, but that's painful and awkward.
Instead, since your arguments are all of the same type, you'd be much better served by creating a function that takes a list of values instead of multiple arguments. So the type you want is something like this: chain :: [a -> a -> a] -> [a] -> a
There are several ways to write such a function. Conceptually you want to start from the front of the argument list and the end of the function list, then apply the first function to the first argument to get something of type a -> a. From there, apply that function to the next argument, then apply the next function to the result, removing one element from each list and giving you a new function of type a -> a.
You'll need to handle the case where the list lengths don't match up correctly, as well. There's no way around that, other than the aforementioned type-encoded-lengths and the hassle associate with such.
I wonder, whether your "have a list of a functions" requirement is a real requirement or a workaround? I was faced with the same problem, but in my case set of functions was small and known at compile time. To be more precise, my task was to zip 4 lists with xor. And all I wanted is a compact notation to compose 3 binary functions. What I used is a small helper:
-- Binary Function Chain
bfc :: (c -> d) -> (a -> b -> c) -> a -> b -> d
bfc f g = \a b -> f (g a b)
For example:
ghci> ((+) `bfc` (*)) 5 3 2 -- (5 * 3) + 2
17
ghci> ((+) `bfc` (*) `bfc` (-)) 5 3 2 1 -- ((5 - 3) * 2) + 1
5
ghci> zipWith3 ((+) `bfc` (+)) [1,2] [3,4] [5,6]
[9,12]
ghci> getZipList $ (xor `bfc` xor `bfc` xor) <$> ZipList [1,2] <*> ZipList [3,4] <*> ZipList [5,6] <*> ZipList [7,8]
[0,8]
That doesn't answers the original question as it is, but hope still can be helpful since it covers pretty much what question subject line is about.

Resources