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.
Related
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.
I want to add two positive numbers together without the use of any basic operators like + for addition. I've already worked my way around that (in the add''' function) (i think) may not be efficient but thats not the point right now. I am getting lots of type errors however which i have no idea how to handle, and is very confusing for me as it works on paper and i've come from python.
add 1245 7489
--add :: Int -> Int -> Int
add x y = add'' (zip (add' x) (add' y))
where
add' :: Int -> [Int]
add' 0 = []
add' x = add' (x `div` 10) ++ [x `mod` 10]
conversion [1,2,4,5] [7,4,8,9] then zipping them together [(1,7),(2,4)....]
add'' :: [(Int,Int)] -> [Int]
add'' (x:xs) = [(add''' (head x) (last x))] ++ add'' xs
summary [8,6,...] what happens when the sum reaches 10 is not implemented yet.
where
--add''' :: (Int,Int) -> Int
add''' x y = last (take (succ y) $ iterate succ x)
adding two numbers together
You can't use head and last on tuples. ...Frankly, you should never use these functions at all because they're unsafe (partial), but they can be used on lists. In Haskell, lists are something completely different from tuples.To get at the elements of a tuple, use pattern matching.
add'' ((x,y):xs) = [add''' x y] ++ add'' xs
(To get at the elements of a list, pattern matching is very often the best too.) Alternatively, you can use fst and snd, these do on 2-tuples what you apparently thought head and last would.
Be clear which functions are curried and which aren't. The way you write add''', its type signature is actually Int -> Int -> Int. That is equivalent to (Int, Int) -> Int, but it's still not the same to the type checker.
The result of add'' is [Int], but you're trying to use this as Int in the result of add. That can't work, you need to translate from digits to numbers again.
add'' doesn't handle the empty case. That's fixed easily enough, but better than doing this recursion at all is using standard combinators. In your case, this is only supposed to work element-wise anyway, so you can simply use map – or do that right in the zipping, with zipWith. Then you also don't need to unwrap any tuples at all, because it works with a curried function.
A clean version of your attempt:
add :: Int -> Int -> Int
add x y = fromDigits 0 $ zipWith addDigits (toDigits x []) (toDigits y [])
where
fromDigits :: Int -> [Int] -> Int
fromDigits acc [] = acc
fromDigits acc (d:ds)
= acc `seq` -- strict accumulator, to avoid thunking.
fromDigits (acc*10 + d) ds
toDigits :: Int -> [Int] -> [Int] -- yield difference-list,
toDigits 0 = id -- because we're consing
toDigits x = toDigits (x`div`10) . ((x`mod`10):) -- left-associatively.
addDigits :: Int -> Int -> Int
addDigits x y = last $ take (succ x) $ iterate succ y
Note that zipWith requires both numbers to have the same number of digits (as does zip).
Also, yes, I'm using + in fromDigits, making this whole thing pretty futile. In practice you would of course use binary, then it's just a bitwise-or and the multiplication is a left shift. What you actually don't need to do here is take special care with 10-overflow, but that's just because of the cheat of using + in fromDigits.
By head and last you meant fst and snd, but you don't need them at all, the components are right there:
add'' :: [(Int, Int)] -> [Int]
add'' (pair : pairs) = [(add''' pair)] ++ add'' pairs
where
add''' :: (Int, Int) -> Int
add''' (x, y) = last (take (succ y) $ iterate succ x)
= iterate succ x !! y
= [x ..] !! y -- nice idea for an exercise!
Now the big question that remains is what to do with those big scary 10-and-over numbers. Here's a thought: produce a digit and a carry with
= ([(d, 0) | d <- [x .. 9]] ++ [(d, 1) | d <- [0 ..]]) !! y
Can you take it from here? Hint: reverse order of digits is your friend!
the official answer my professor gave
works on positive and negative numbers too, but still requires the two numbers to be the same length
add 0 y = y
add x y
| x>0 = add (pred x) (succ y)
| otherwise = add (succ x) (pred y)
The other answers cover what's gone wrong in your approach. From a theoretical perspective, though, they each have some drawbacks: they either land you at [Int] and not Int, or they use (+) in the conversion back from [Int] to Int. What's more, they use mod and div as subroutines in defining addition -- which would be okay, but then to be theoretically sound you would want to make sure that you could define mod and div themselves without using addition as a subroutine!
Since you say efficiency is no concern, I propose using the usual definition of addition that mathematicians give, namely: 0 + y = y, and (x+1) + y = (x + y)+1. Here you should read +1 as a separate operation than addition, a more primitive one: the one that just increments a number. We spell it succ in Haskell (and its "inverse" is pred). With this theoretical definition in mind, the Haskell almost writes itself:
add :: Int -> Int -> Int
add 0 y = y
add x y = succ (add (pred x) y)
So: compared to other answers, we can take an Int and return an Int, and the only subroutines we use are ones that "feel" more primitive: succ, pred, and checking whether a number is zero or nonzero. (And we land at only three short lines of code... about a third as long as the shortest proposed alternative.) Of course the price we pay is very bad performance... try add (2^32) 0!
Like the other answers, this only works for positive numbers. When you are ready for handling negative numbers, we should chat again -- there's some fascinating mathematical tricks to pull.
I'm trying to understand how the Select monad works. Apparently, it is a cousin of Cont and it can be used for backtracking search.
I have this list-based solution to the n-queens problem:
-- All the ways of extracting an element from a list.
oneOf :: [Int] -> [(Int,[Int])]
oneOf [] = []
oneOf (x:xs) = (x,xs) : map (\(y,ys) -> (y,x:ys)) (oneOf xs)
-- Adding a new queen at col x, is it threathened diagonally by any of the
-- existing queens?
safeDiag :: Int -> [Int] -> Bool
safeDiag x xs = all (\(y,i) -> abs (x-y) /= i) (zip xs [1..])
nqueens :: Int -> [[Int]]
nqueens queenCount = go [] [1..queenCount]
where
-- cps = columsn of already positioned queens.
-- fps = columns that are still available
go :: [Int] -> [Int] -> [[Int]]
go cps [] = [cps]
go cps fps = [ps | (p,nfps) <- oneOf fps, ps <- go (p:cps) nfps, safeDiag p cps]
I'm struggling to adapt this solution to use Select instead.
It seems that Select lets you abstract over the "evaluation function" that is used to compare answers. That function is passed to runSelect. I have the feeling that something like safeDiag in my solution could work as the evaluation function, but how to structure the Select computation itself?
Also, is it enough to use the Select monad alone, or do I need to use the transformer version over lists?
I realize this is question is almost 4 years old and already has an answer, but I wanted to chime in with some additional information for the sake of anyone who comes across this question in the future. Specifically, I want to try to answer 2 questions:
how are multiple Selects that return single values combined to create a single Select that returns a sequence of values?
is it possible to return early when a solution path is destined to fail?
Chaining Selects
Select is implemented as a monad transformer in the transformers library (go figure), but let's take a look at how one might implement >>= for Select by itself:
(>>=) :: Select r a -> (a -> Select r b) -> Select r b
Select g >>= f = Select $ \k ->
let choose x = runSelect (f x) k
in choose $ g (k . choose)
We start by defining a new Select which takes an input k of type a -> r (recall that Select wraps a function of type (a -> r) -> a). You can think of k as a function that returns a "score" of type r for a given a, which the Select function may use to determine which a to return.
Inside our new Select, we define a function called choose. This function passes some x to the function f, which is the a -> m b portion of monadic binding: it transforms the result of the m a computation into a new computation m b. So f is going to take that x and return a new Select, which choose then runs using our scoring function k. You can think of choose as a function that asks "what would the final result be if I selected x and passed it downstream?"
On the second line, we return choose $ g (k . choose). The function k . choose is the composition of choose and our original scoring function k: it takes in a value, calculates the downstream result of selecting that value, and returns the score of that downstream result. In other words, we've created a kind of "clairvoyant" scoring function: instead of returning the score of a given value, it returns the score of the final result we would get if we selected that value. By passing in our "clairvoyant" scoring function to g (the original Select that we're binding to), we're able to select the intermediate value that leads to the final result we're looking for. Once we have that intermediate value, we simply pass it back into choose and return the result.
That's how we're able to string together single-value Selects while passing in a scoring function that operates on an array of values: each Select is scoring the hypothetical final result of selecting a value, not necessarily the value itself. The applicative instance follows the same strategy, the only difference being how the downstream Select is computed (instead of passing a candidate value into the a -> m b function, it maps a candidate function over the 2nd Select.)
Returning Early
So, how can we use Select while returning early? We need some way of accessing the scoring function within the scope of the code that constructs the Select. One way to do that is to construct each Select within another Select, like so:
sequenceSelect :: Eq a => [a] -> Select Bool [a]
sequenceSelect [] = return []
sequenceSelect domain#(x:xs) = select $ \k ->
if k [] then runSelect s k else []
where
s = do
choice <- elementSelect (x:|xs)
fmap (choice:) $ sequenceSelect (filter (/= choice) domain)
This allows us to test the sequence in progress and short-circuit the recursion if it fails. (We can test the sequence by calling k [] because the scoring function includes all of the prepends that we've recursively lined up.)
Here's the whole solution:
import Data.List
import Data.List.NonEmpty (NonEmpty(..))
import Control.Monad.Trans.Select
validBoard :: [Int] -> Bool
validBoard qs = all verify (tails qs)
where
verify [] = True
verify (x:xs) = and $ zipWith (\i y -> x /= y && abs (x - y) /= i) [1..] xs
nqueens :: Int -> [Int]
nqueens boardSize = runSelect (sequenceSelect [1..boardSize]) validBoard
sequenceSelect :: Eq a => [a] -> Select Bool [a]
sequenceSelect [] = return []
sequenceSelect domain#(x:xs) = select $ \k ->
if k [] then runSelect s k else []
where
s = do
choice <- elementSelect (x:|xs)
fmap (choice:) $ sequenceSelect (filter (/= choice) domain)
elementSelect :: NonEmpty a -> Select Bool a
elementSelect domain = select $ \p -> epsilon p domain
-- like find, but will always return something
epsilon :: (a -> Bool) -> NonEmpty a -> a
epsilon _ (x:|[]) = x
epsilon p (x:|y:ys) = if p x then x else epsilon p (y:|ys)
In short: we construct a Select recursively, removing elements from the domain as we use them and terminating the recursion if the domain has been exhausted or if we're on the wrong track.
One other addition is the epsilon function (based on Hilbert's epsilon operator). For a domain of size N it will check at most N - 1 items... it might not sound like a huge savings, but as you know from the above explanation, p will usually kick off the remainder of the entire computation, so it's best to keep predicate calls to a minimum.
The nice thing about sequenceSelect is how generic it is: it can be used to create any Select Bool [a] where
we're searching within a finite domain of distinct elements
we want to create a sequence that includes every element exactly once (i.e. a permutation of the domain)
we want to test partial sequences and abandon them if they fail the predicate
Hope this helps clarify things!
P.S. Here's a link to an Observable notebook in which I implemented the Select monad in Javascript along with a demonstration of the n-queens solver: https://observablehq.com/#mattdiamond/the-select-monad
Select can be viewed as an abstraction of a search in a "compact" space, guided by some predicate. You mentioned SAT in your comments, have you tried modelling the problem as a SAT instance and throw it at a solver based on Select (in the spirit of this paper)? You can specialise the search to hardwire the N-queens specific constraints inside your and turn the SAT solver into a N-queens solver.
Inspired by jd823592's answer, and after looking at the SAT example in the paper, I have written this code:
import Data.List
import Control.Monad.Trans.Select
validBoard :: [Int] -> Bool
validBoard qs = all verify (tails qs)
where
verify [] = True
verify (x : xs) = and $ zipWith (\i y -> x /= y && abs (x-y) /= i) [1..] xs
nqueens :: Int -> [Int]
nqueens boardSize = runSelect (traverse selectColumn columns) validBoard
where
columns = replicate boardSize [1..boardSize]
selectColumn candidates = select $ \s -> head $ filter s candidates ++ candidates
It seems to arrive (albeit slowly) to a valid solution:
ghci> nqueens 8
[1,5,8,6,3,7,2,4]
I don't understand it very well, however. In particular, the way sequence works for Select, transmuting a function (validBoard) that works over a whole board into functions that take a single column index, seems quite magical.
The sequence-based solution has the defect that putting a queen in a column doesn't rule out the possibility of choosing the same column for subsequent queens; we end up unnecesarily exploring doomed branches.
If we want our column choices to be affected by previous decisions, we need to go beyond Applicative and use the power of Monad:
nqueens :: Int -> [Int]
nqueens boardSize = fst $ runSelect (go ([],[1..boardSize])) (validBoard . fst)
where
go (cps,[]) = return (cps,[])
go (cps,fps) = (select $ \s ->
let candidates = map (\(z,zs) -> (z:cps,zs)) (oneOf fps)
in head $ filter s candidates ++ candidates) >>= go
The monadic version still has the problem that it only checks completed boards, when the original list-based solution backtracked as soon as a partially completed board was found to be have a conflict. I don't know how to do that using Select.
I am a new comer to the Haskell world and I am wondering if there is something like this:
data IndexedList a = IList Int [a]
findIndex::(Int->Int)->IndexedList a->(a,IndexedList a)
findIndex f (IList x l) = (l!!(f x), IList (f x) l)
next::IndexedList a->(a,IndexedList a)
next x = findIndex (+1) x
I've noticed that this kind of list is not purely functional but kind of useful for some applications. Should it be considered harmful?
Thanks,
Bob
It's certainly useful to have a list that comes equipped with a pointed to a particular location in the list. However, the way it's usually done in Haskell is somewhat different - rather than using an explicit pointer, we tend to use a zipper.
The list zipper looks like this
data ListZipper a = LZ [a] a [a] deriving (Show)
You should think of the middle field a as being the element that is currently pointed to, the first field [a] as being the elements before the current position, and the final field [a] as being the elements after the current position.
Usually we store the elements before the current one in reverse order, for efficiency, so that the list [0, 1, 2, *3*, 4, 5, 6] with a pointer to the middle element, would be stored as
LZ [2,1,0] 3 [4,5,6]
You can define functions that move the pointer to the left or right
left (LZ (a:as) b bs) = LZ as a (b:bs)
right (LZ as a (b:bs)) = LZ (a:as) b bs
If you want to move to the left or right n times, then you can do that with the help of a function that takes another function, and applies it n times to its argument
times n f = (!!n) . iterate f
so that to move left three times, you could use
>> let lz = LZ [2,1,0] 3 [4,5,6]
>> (3 `times` left) lz
LZ [] 0 [1,2,3,4,5,6]
Your two functions findIndex and next can be written as
next :: ListZipper a -> (a, ListZipper a)
next = findIndex 1
findIndex :: Int -> ListZipper a -> (a, ListZipper a)
findIndex n x = let y#(LZ _ a _) = (n `times` right) x in (a, y)
Contrary to what you think this list is in fact purely functional. The reason is that IList (f x) l creates a new list (and does not, as you may think, modify the current IndexedList). It is in general not that easy to create non-purely functional data structures or functions in Haskell, as long as you stay away from unsafePerformIO.
The reason I would recommend against using the IndexedList is that there is no assurance that the index is less than the length of the list. In this case the lookup l!!(f x) will fail with an exception, which is generally considered bad style in Haskell. An alternative could be to use a safe lookup, which returns a Maybe a like the following:
findIndex :: (Int -> Int) -> IndexedList a -> (Maybe a, IndexedList a)
findIndex f (IList i l) = (maybe_x, IList new_i l)
where
new_i = f i
maybe_x = if new_i < length l
then Just (l !! newI)
else Nothing
I can also not think of a usecase where such a list would be useful, but I guess I am limited by my creativity ;)
Suppose for a minute that we think the following is a good idea:
data Fold x y = Fold {start :: y, step :: x -> y -> y}
fold :: Fold x y -> [x] -> y
Under this scheme, functions such as length or sum can be implemented by calling fold with the appropriate Fold object as argument.
Now, suppose you want to do clever optimisation tricks. In particular, suppose you want to write
unFold :: ([x] -> y) -> Fold x y
It should be relatively easy to rule a RULES pragma such that fold . unFold = id. But the interesting question is... can we actually implement unFold?
Obviously you can use RULES to apply arbitrary code transformations, whether or not they preserve the original meaning of the code. But can you really write an unFold implementation which actually does what its type signature suggests?
No, it's not possible. Proof: let
f :: [()] -> Bool
f[] = False
f[()] = False
f _ = True
First we must, for f' = unFold f, have start f' = False, because when folding over the empty list we directly get the start value. Then we must require step f' () False = False to achieve fold f' [()] = False. But when now evaluating fold f' [(),()], we would again only get a call step f' () False, which we had to define as False, leading to fold f' [(),()] ≡ False, whereas f[(),()] ≡ True. So there exists no unFold f that fulfills fold $ unFold f ≡ f. □
You can, but you need to make a slight modification to Fold in order to pull it off.
All functions on lists can be expressed as a fold, but sometimes to accomplish this, extra bookkeeping is needed. Suppose we add an additional type parameter to your Fold type, which passes along this additional contextual information.
data Fold a c r = Fold { _start :: (c, r), _step :: a -> (c,r) -> (c,r) }
Now we can implement fold like so
fold :: Fold a c r -> [a] -> r
fold (Fold step start) = snd . foldr step start
Now what happens when we try to go the other way?
unFold :: ([a] -> r) -> Fold a c r
Where does the c come from? Functions are opaque values, so it's hard to know how to inspect a function and know which contextual information it relies on. So, let's cheat a little. We're going to have the "contextual information" be the entire list, so then when we get to the leftmost element, we can just apply the function to the original list, ignoring the prior cumulative results.
unFold :: ([a] -> r) -> Fold a [a] r
unFold f = Fold { _start = ([], f [])
, _step = \a (c, _r) -> let c' = a:c in (c', f c') }
Now, sadly, this does not necessarily compose with fold, because it requires that c must be [a]. Let's fix that by hiding c with existential quantification.
{-# LANGUAGE ExistentialQuantification #-}
data Fold a r = forall c. Fold
{ _start :: (c,r)
, _step :: a -> (c,r) -> (c,r) }
fold :: Fold a r -> [a] -> r
fold (Fold start step) = snd . foldr step start
unFold :: ([a] -> r) -> Fold a r
unFold f = Fold start step where
start = ([], f [])
step a (c, _r) = let c' = a:c in (c', f c')
Now, it should always be true that fold . unFold = id. And, given a relaxed notion of equality for the Fold data type, you could also say that unFold . fold = id. You can even provide a smart constructor that acts like the old Fold constructor:
makeFold :: r -> (a -> r -> r) -> Fold a r
makeFold start step = Fold start' step' where
start' = ((), start)
step' a ((), r) = ((), step a r)
tl;dr:
Conclusion 1: you can't
What you asked for originally isn't possible, at least not by any version of what you wanted I can come up with. (See below.)
If change your data type to allow me to store intermediate calculations, I think I'll be fine, but even then,
the function unFold would be rather inefficient, which seems to run counter to your clever optimisation tricks agenda!
Conclusion 2: I don't think it achieves what you want, even if you work around it by changing the types
Any optimisation of the list algorithm would be subject to the problem that you've calculated the step function using the original unoptimised function, and quite probably in a complicated way.
Since there's no equality on functions, optimising step to something efficient isn't possible. I think you need a human to do unFold, not a compiler.
Anyway, back to the original question:
Could fold . unFold = id ?
No. Suppose we have
isSingleton :: [a] -> Bool
isSingleton [x] = True
isSingleton _ = False
then if we had unFold :: ([x] -> y) -> Fold x y then if foldSingleton was the same as unFold isSingleton would need to have
foldSingleton = Fold {start = False , step = ???}
Where step takes an element of the list and updates the result.
Now isSingleton "a" == True, we need
step False = True
and because isSingleton "ab" == False, we need
step True = False
so step = not would do so far, but also isSingleton "abc" == False so we also need
step False = False
Since there are functions ([x] -> y) that cannot be represented by a value of type Fold x y, there cannot exist a function unFold :: ([x] -> y) -> Fold x y such that fold . unFold = id, because id is a total function.
Edit:
It turns out you're not convinced by this, because you only expected unFold to work on functions that had a representation as a fold, so maybe you meant unFold.fold = id.
Could unFold . fold = id ?
No.
Even if you just want unFold to work on functions ([x] -> y) that can be obtained using fold :: Fold x y -> ([x] -> y), I don't think it's possible. Let's address the question by assuming now we have defined
combine :: X -> Y -> Y
initial :: Y
folded :: [X] -> Y
folded = fold $ Fold initial combine
Recovering the value initial is trivial: initial = folded [].
Recovery of the original combine is not, because there's no way to go from a function that gives you some values of Y to one which combines arbitrary values of Y.
For an example, if we had X = Y = Int and I defined
combine x y | y < 0 = -10
| otherwise = y + 1
initial = 0
then since combine just adds one to y every time you use it on positive y, and the initial value is 0, folded is indistinguishable from length in terms of its output. Notice that since folded xs is never negative, it's also impossible to define a function unFold :: ([x] -> y) -> Fold x y that ever recovers our combine function. This boils down to the fact that fold is not injective; it carries different values of type Fold x y to the same value of type [x] -> y.
Thus I've proved two things: if unFold :: ([x] -> y) -> Fold x y then both fold.unFold /= id and now also unFold.fold /= id
I bet you're not convinced by this either, because you don't really care whether you got Fold 0 (\_ y -> y+1) or Fold 0 combine back from unFold folded, seeing as they have the same value when refolded! Let's narrow the goalposts one more time. Perhaps you want unFold to work whenever the function is obtainable via fold, and you're happy for it not to give you inconsistent answers as long as when you fold the result again, you get the same function. I can summarise that with this next question:
Could fold . unFold . fold = fold ?
i.e. Could you define unFold so that fold.unFold is the identity on the set of functions obtainable via fold?
I'm really convinced this isn't possible, because it's not a tractible problem to calculate the step function without retaining extra information about intermediate values on sublists.
Suppose we had
unFold f = Fold {start = f [], step = recoverstep f}
we need
recoverstep f x1 initial == f [x1]
so if there's an Eq instance for x (ring the alarm bells!), then recoverstep must have the same effect as
recoverstep f x1 y | y == initial = f [x1]
also we need
recoverstep f x2 (f [x1]) == f [x1,x2]
so if there's an Eq instance for x, then recoverstep must have the same effect as
recoverstep f x2 y | y == (f [x1]) = f [x1,x2]
but there's a massive problem here: the variable x1 is free in the right hand side of this equation.
This means that logically, we can't tell what value the step function should have on an x unless we already
know what values it has been used on. We would need to store the values of f [x1], f [x1,x2] etc in the Fold
data type to make it work, and this is the clincher as to why we can't define unFold. If you change the data type Fold
to allow us to store information about intermediate lists, I can see it would work, but as it stands it's impossible
to recover the context.
Similar to Dan's answer, but using a slightly different approach. Instead of pairing the accumulator with partial results which will be thrown away at the end, we add a "post-processing" function which will convert from the accumulator type to the final result.
The same "cheat" for unFold just does all the work in the post-processing step:
{-# LANGUAGE ExistentialQuantification #-}
data Fold a r = forall c. Fold
{ _start :: c
, _step :: a -> c -> c
, _result :: c -> r }
fold :: Fold a r -> [a] -> r
fold (Fold start step result) = result . foldr step start
unFold :: ([a] -> r) -> Fold a r
unFold f = Fold [] (:) f
makeFold :: r -> (a -> r -> r) -> Fold a r
makeFold start step = Fold start step id