Haskell List Comprehension and List Monad - haskell

I'm trying to write some self-defined type Martix a, which is basically list of lists [[a]]. When I tried to implement a function named colAt, which should give the vertical elements of a matrix, I firstly used the list comprehension:
colAt :: Int -> Matrix a -> [a]
colAt c m = [ e | r <- m, e <- r !! c ]
But Ghci told me
Occurs check: cannot construct the infinite type: a ~ [a]
In the expression: r !! c
While the do notation worked perfectly with
colAt :: Int -> Matrix a -> [a]
colAt c m = do
r <- m
return (r !! c)
What caused this error? I thought that basically list comprehension is a syntax sugar of list do notations, but given this error my understanding is wrong?

Your understanding is entirely correct: list comprehensions are indeed just syntax sugar for do notation! The issue is that you have not desugared your list comprehension correctly.
To start, let’s repeat the list comprehension for reference:
colAt :: Int -> Matrix a -> [a]
colAt c m = [ e | r <- m, e <- r !! c ]
Now, I’ll desugar it partially, to move the r <- m bit outside the comprehension:
colAt :: Int -> Matrix a -> [a]
colAt c m = do
r <- m
[e | e <- r !! c]
And this is simple to desugar fully:
colAt :: Int -> Matrix a -> [a]
colAt c m = do
r <- m
e <- r !! c
e
Compare to the correct implementation:
colAt :: Int -> Matrix a -> [a]
colAt c m = do
r <- m
return (r !! c)
The issue here is now obvious. In the correct implementation takes m, then for each item r <- m in turn, finds the element r !! c :: a, wraps it in a list, and then returns it. By contrast, your implementation extracts each item r <- m correctly, but then tries to extract each ‘element’ of the ‘list’ r !! c :: a — which is in fact not necessarily a list, giving the type error you see. The fix is easy: as in the correct implementation, simply add a return, giving [ e | r <- m, e <- return (r !! c) ]. Or, more simply, using the fact that [x | x <- return l] is just the same as [l], you can rewrite this more simply as [ r !! c | r <- m ].

If you write e <- r !! c, it expects r !! c to be a list, since you are enumerating over that list, but r !! c is an item (of type a), hence that would only work if you use for example a Matrix [a].
You do not need to enumerate here, you can move the r !! c to the "yield" part:
colAt :: Int -> Matrix a -> [a]
colAt c m = [ r !! c | r <- m ]
but what you here do is a mapping, so you can use map :: (a -> b) -> [a] -> [b]:
colAt :: Int -> Matrix a -> [a]
colAt c = map (!! c)

Related

mapEither inserting both Left and Right

Using the function mapEither for multiset's I can turn a MultiSet into a pair of two multisets. When f is returning Left the element is inserted into the first Multiset of the pair, and if f is returning Right the element is inserted into the second MultiSet of the pair.
How can I insert the same element into both MultiSets at the same time, as if f were returning Right and Left at the same time?
f:: LocalType -> Either LocalType LocalType
f (Sometype lt) = Left lt -- And Right lt
f lt = Left lt
parRule :: (MultiSet LocalType) -> (MultiSet LocalType)
parRule sequent = do
let list = MultiSet.mapEither f sequent
For reference, I use Data.Multiset package, https://hackage.haskell.org/package/multiset-0.3.4.3/docs/Data-MultiSet.html.
You can use a type like These to capture the ability to return both. You can then use toAscOccurList and fromOccurList (or fromAscOccurList if your function is monotonic) to compute the new MultiSet.
You could use These as Daniel Wagner suggests, but I would use a slightly different function to start with, which seems like a slightly better match to the library API. Furthermore, I would recommend a different implementation strategy for performance.
data SP a b = SP !a !b
toPair :: SP a b -> (a, b)
toPair (SP a b) = (a, b)
mapPairOcc :: (Ord b, Ord c) => (a -> Occur -> ((b, Occur), (c, Occur))) -> MultiSet a -> (MultiSet b, MultiSet c)
mapPairOcc f = toPair . mapPairOcc' f
mapPairOcc' :: (Ord b, Ord c) => (a -> Occur -> ((b, Occur), (c, Occur))) -> MultiSet a -> SP (MultiSet b) (MultiSet c)
mapPairOcc' f = foldl' go (SP empty empty) . toAscOccurList
where
go (SP bs cs) a
| ((b, bn), (c, cn)) <- f a
= SP (insertMany b bn bs) (insertMany c cn cs)
When you know that f is strictly monotone in the sense that
a < a' ==> fst (f a) < fst (f a') /\ snd (f a) < snd (f a')
it's possible to do better, building the results in O(n) time. The best way to do this seems to be to use Data.Map internals. I'll reuse the SP type from above.
import Data.Map.Lazy (Map)
import Data.MultiSet (MultiSet, Occur)
import qualified Data.MultiSet as MS
import qualified Data.Map.Internal as M
import Control.Monad (guard)
-- | Map over the keys and values in a map, producing
-- two maps with new keys and values. The passed function
-- must be strictly monotone in the keys in the sense
-- described above.
mapMaybeWithKey2Mono :: (k -> a -> (Maybe (l,b), Maybe (m,c))) -> Map k a -> (Map l b, Map m c)
mapMaybeWithKey2Mono f = toPair . mapMaybeWithKey2Mono' f
mapMaybeWithKey2Mono' :: (k -> a -> (Maybe (l,b), Maybe (m,c))) -> Map k a -> SP (Map l b) (Map m c)
mapMaybeWithKey2Mono' _ M.Tip = SP M.Tip M.Tip
mapMaybeWithKey2Mono' f (M.Bin _ kx x l r)
| (fl, fr) <- f kx x
= SP (groink fl mfl1 mfr1) (groink fr mfl2 mfr2)
where
groink :: Maybe (q, x) -> Map q x -> Map q x -> Map q x
groink m n o = case m of
Just (k', y) -> M.link k' y n o
Nothing -> M.link2 n o
SP mfl1 mfl2 = mapMaybeWithKey2Mono' f l
SP mfr1 mfr2 = mapMaybeWithKey2Mono' f r
Using this new general Map function, we can define the function we want on multisets:
mapPairAscOcc :: (a -> Occur -> ((b, Occur), (c, Occur))) -> MultiSet a -> (MultiSet b, MultiSet c)
mapPairAscOcc f m
| (p, q) <- mapMaybeWithKey2Mono go . MS.toMap $ m
= (MS.fromOccurMap p, MS.fromOccurMap q)
where
-- a -> Occur -> (Maybe (b, Occur), Maybe (c, Occur))
go a aocc
| ((b, bocc), (c, cocc)) <- f a aocc
= ( (b, bocc) <$ guard (bocc > 0)
, (c, cocc) <$ guard (cocc > 0) )
I took the function mapEither from the Data.MultiSet and modified it such that it supports These type.
-- | /O(n)/. Map and separate the 'This' and 'That' or 'These' results
-- modified function of mapEither to map both cases in case f return These
-- code of mapEither found in source code,
mapThese :: (Ord b, Ord c) => (a -> These b c) -> MultiSet a -> (MultiSet b, MultiSet c)
mapThese f = (\(ls,rs) -> (MultiSet.fromOccurList ls, MultiSet.fromOccurList rs)) . mapThese' . MultiSet.toOccurList
where mapThese' [] = ([],[])
mapThese' ((x,n):xs) = case f x of
This l -> let (ls,rs) = mapThese' xs in ((l,n):ls, rs)
That r -> let (ls,rs) = mapThese' xs in (ls, (r,n):rs)
These u i -> let (ls,rs) = mapThese' xs in ((u,n):ls, (i,n):rs)
In the case f returns These, both MultiSet's have an added element.

How to construct a function from its graph?

I wonder if it is possible to make the inverse of the following function:
graphOf :: (Num a, Enum a) => (a -> b) -> [(a, b)]
graphOf f = [(e,v) | e <- [0..], v <- [f e]]
I mean I don't figure out how to write a Haskell function
fromGraph :: (Enum a) => [(a, b)] -> (a -> b)
such that
fromGraph [(1,3),(2,4),(3,5)] :: (Num a) => a -> a
(fromGraph [(1,3),(2,4),(3,5)]) 1 == 3
(fromGraph [(1,3),(2,4),(3,5)]) 2 == 4
(fromGraph [(1,3),(2,4),(3,5)]) 3 == 5
Is it possible?
At least for finite input list?
The simplest way is to use the lookup function:
Prelude> :m +Data.List
Prelude Data.List> lookup 1 [(1,3),(2,4),(3,5)]
Just 3
Prelude Data.List> lookup 2 [(1,3),(2,4),(3,5)]
Just 4
Prelude Data.List> lookup 3 [(1,3),(2,4),(3,5)]
Just 5
This is pretty inefficient though (for every query it just goes through the list linearly). You may want to back it with a faster lookup mechanism, using structures from the containers or unordered-containers packages, for example
import qualified Data.HashMap.Strict as HMS
import Data.Hashable (Hashable)
fastLookup :: Hashable k => [(k,b)] -> k -> Maybe b
fastLookup l = \k -> HMS.lookup k table
where table = HMS.fromList l
Note that I wrote fastLookup l = \k -> .... Do not simplify this to fastLookup l k = ..., because that would re-build the hash map for every query.
You could write something like this
fromGraph :: [(Int, b)] -> Int -> b
fromGraph g i = snd (g !! i)
This would only work for Int indices, and would also assume that for every i, the element in the graph g at g !! i would have index i as well. If you want to do it a little more generically, you could write this:
fromGraph :: Eq a => [(a, b)] -> a -> b
fromGraph g i = snd $ head $ filter ((==i) . fst) g
Not that this would still throw an error if you try to use this function with an index that is not part of the graph.

How to know in Haskell in what row and column of a table ([[a]]) you are

I want to make a sudoku solver in Haskell (as an exercise). My idea is:
I have t :: [[Int]] representing a 9x9 grid so that it contains 0 in an empty field and 1-9 in a solved field.
A function solve :: [[Int]] -> [[Int]] returns the solved sudoku.
Here is a rough sketch of it (i'd like to point out i'm a beginner, i know it is not the most optimal code):
solve :: [[Int]] -> [[Int]]
solve t
| null (filter (elem 0) t) = t
| t /= beSmart t = solve (beSmart t)
| otherwise = guess t
The function beSmart :: [[Int]] -> [[Int]] tries to solve it by applying some solving algorithms, but if methodical approach fails (beSmart returns the unchanged sudoku table in that case) it should try to guess some numbers (and i'll think of that function later). In order to fill in an empty field, i have to find it first. And here's the problem:
beSmart :: [[Int]] -> [[Int]]
beSmart t = map f t
where f row
| elem 0 row = map unsolvedRow row
| otherwise = row
where unsolvedRow a
| a == 0 = tryToDo t r c --?!?!?!?! skip
| otherwise = a
The function tryToDo :: [[Int]]] -> Int -> Int - > Int needs the row and column of the field i'm trying to change, but i have no idea how to get that information. How do i get from map what element of the list i am in at the moment? Or is there a better way to move around in the table? I come from iterative and procedural programing and i understand that perhaps my approach to the problem is wrong when it comes to functional programing.
I know this is not really an answer to your question, but I would argue, that usually you would want a different representation (one that keeps a more detailed view of what you know about the sudoku puzzle, in your attempted solution you can only distinguish a solved cell from a cell that is free to assume any value). Sudoku is a classical instance of CSP. Where modern approaches offer many fairly general smart propagation rules, such as unit propagation (blocking a digit in neighboring cells once used somewhere), but also many other, see AC-3 for further details. Other related topics include SAT/SMT and you might find the algorithm DPLL also interesting. In the heart of most solvers there usually is some kind of a search engine to deal with non-determinism (not every instance must have a single solution that is directly derivable from the initial configuration of the instance by application of inference rules). There are also techniques such as CDCL to direct the search.
To address the question in the title, to know where you are, its probably best if you abstract the traversal of your table so that each step has access to the coordinates, you can for example zip a list of rows with [0..] (zip [0..] rows) to number the rows, when you then map a function over the zipped lists, you will have access to pairs (index, row), the same applies to columns. Just a sketch of the idea:
mapTable :: (Int -> Int -> a -> b) -> [[a]] -> [[b]]
mapTable f rows = map (\(r, rs) -> mapRow (f r) rs) $ zip [0..] rows
mapRow :: (Int -> a -> b) -> [a] -> [b]
mapRow f cols = map (uncurry f) $ zip [0..] cols
or use fold to turn your table into something else (for example to search for a unit cell):
foldrTable :: (Int -> Int -> a -> b -> b) -> b -> [[a]] -> b
foldrTable f z rows = foldr (\(r, rs) b -> foldrRow (f r) b rs) z $ zip [0..] rows
foldrRow :: (Int -> a -> b -> b) -> b -> [a] -> b
foldrRow f z cols = foldr (uncurry f) z $ zip [0..] cols
to find which cell is unital:
foldrTable
(\x y v acc -> if length v == 1 then Just (x, y) else acc)
Nothing
[[[1..9],[1..9],[1..9]],[[1..9],[1..9],[1..9]],[[1..9],[1],[1..9]]]
by using Monoid you can refactor it:
import Data.Monoid
foldrTable' :: Monoid b => (Int -> Int -> a -> b) -> [[a]] -> b
foldrTable' f rows = foldrTable (\r c a b -> b <> f r c a) mempty rows
unit :: Int -> Int -> [a] -> Maybe (Int, Int)
unit x y c | length c == 1 = Just (x, y)
| otherwise = Nothing
firstUnit :: [[[a]]] -> Maybe (Int, Int)
firstUnit = getFirst . foldrTable' (\r c v -> First $ unit r c v)
so now you would do
firstUnit [[[1..9],[1..9],[1..9]],[[1,2],[3,4],[5]]]
to obtain
Just (1, 2)
correctly determining that the first unit cell is at position 1,2 in the table.
[[Int]] is a good type for a sodoku. But map does not give any info regarding the place it is in. This is one of the ideas behind map.
You could zip together the index with the value. But a better idea would be to pass the whole [[Int]] and the indexes to to the function. So its type would become:
f :: [[Int]] -> Int -> Int -> [[Int]]
inside the function you can now access the current element by
t !! x !! y
Already did this a while ago as a learning example. It is definitely not the nicest solution, but it worked for me.
import Data.List
import Data.Maybe
import Data.Char
sodoku="\
\-9-----1-\
\8-4-2-3-7\
\-6-9-7-2-\
\--5-3-1--\
\-7-5-1-3-\
\--3-9-8--\
\-2-8-5-6-\
\1-7-6-4-9\
\-3-----8-"
sodoku2="\
\----13---\
\7-5------\
\1----547-\
\--418----\
\951-67843\
\-2---4--1\
\-6235-9-7\
\--7-98--4\
\89----1-5"
data Position = Position (Int, Int) deriving (Show)
data Sodoku = Sodoku [Int]
insertAtN :: Int -> a -> [a] -> [a]
insertAtN n y xs = intercalate [y] . groups n $ xs
where
groups n xs = takeWhile (not.null) . unfoldr (Just . splitAt n) $ xs
instance Show Sodoku where
show (Sodoku s) = (insertAtN 9 '\n' $ map intToDigit s) ++ "\n"
convertDigit :: Char -> Int
convertDigit x = case x of
'-' -> 0
x -> if digit>=1 && digit<=9 then
digit
else
0
where digit=digitToInt x
convertSodoku :: String -> Sodoku
convertSodoku x = Sodoku $ map convertDigit x
adjacentFields :: Position -> [Position]
adjacentFields (Position (x,y)) =
[Position (i,y) | i<-[0..8]] ++
[Position (x,j) | j<-[0..8]] ++
[Position (u+i,v+j) | i<-[0..2], j<-[0..2]]
where
u=3*(x `div` 3)
v=3*(y `div` 3)
positionToField :: Position -> Int
positionToField (Position (x,y)) = x+y*9
fieldToPosition :: Int -> Position
fieldToPosition x = Position (x `mod` 9, x `div` 9)
getDigit :: Sodoku -> Position -> Int
getDigit (Sodoku x) pos = x !! (positionToField pos )
getAdjacentDigits :: Sodoku -> Position -> [Int]
getAdjacentDigits s p = nub digitList
where
digitList=filter (\x->x/=0) $ map (getDigit s) (adjacentFields p)
getFreePositions :: Sodoku -> [Position]
getFreePositions (Sodoku x) = map fieldToPosition $ elemIndices 0 x
isSolved :: Sodoku -> Bool
isSolved s = (length $ getFreePositions s)==0
isDeadEnd :: Sodoku -> Bool
isDeadEnd s = any (\x->x==0) $ map length $ map (getValidDigits s)$ getFreePositions s
setDigit :: Sodoku -> Position -> Int -> Sodoku
setDigit (Sodoku x) pos digit = Sodoku $ h ++ [digit] ++ t
where
field=positionToField pos
h=fst $ splitAt field x
t=tail$ snd $ splitAt field x
getValidDigits :: Sodoku -> Position -> [Int]
getValidDigits s p = [1..9] \\ (getAdjacentDigits s p)
-- Select numbers with few possible choices first to increase execution time
sortImpl :: (Position, [Int]) -> (Position, [Int]) -> Ordering
sortImpl (_, i1) (_, i2)
| length(i1)<length(i2) = LT
| length(i1)>length(i2) = GT
| length(i1)==length(i2) = EQ
selectMoves :: Sodoku -> Maybe (Position, [Int])
selectMoves s
| length(posDigitList)>0 = Just (head posDigitList)
| otherwise = Nothing
where
posDigitList=sortBy sortImpl $ zip freePos validDigits
validDigits=map (getValidDigits s) freePos
freePos=getFreePositions s
createMoves :: Sodoku -> [Sodoku]
createMoves s=
case selectMoves s of
Nothing -> []
(Just (pos, digits)) -> [setDigit s pos d|d<-digits]
solveStep :: Sodoku -> [Sodoku]
solveStep s
| (isSolved s) = [s]
| (isDeadEnd s )==True = []
| otherwise = createMoves s
solve :: Sodoku -> [Sodoku]
solve s
| (isSolved s) = [s]
| (isDeadEnd s)==True = []
| otherwise=concat $ map solve (solveStep s)
s=convertSodoku sodoku2
readSodoku :: String -> Sodoku
readSodoku x = Sodoku []

Variable List Comprehension Length

I'm generating a list of lists via list comprehension, but I have no idea how to make the sub list's length variable by using a parameter. The input for the following is a tuple (first, second) and an Integer z:
z = 1:
[[a] | a <- [first..second]]
z = 2:
[[a, b] | a <- [first..second], b <- [first..second]]
z = 3:
[[a, b, c] | a <- [first..second], b <- [first..second], c <- [first..second]]
You can use replicateM for this task. It's defined as
replicateM :: Monad m => Int -> m a -> m [a]
replicateM n m = sequence (replicate n m)
The connection here is to turn the list comprehension into do notation:
[[a] | a <- [first..second]] == do
a <- [first..second]
return [a]
[[a, b] | a <- [first..second], b <- [first..second]] == do
a <- [first..second]
b <- [first..second]
return [a, b]
[[a, b, c] | a <- [first..second], b <- [first..second], c <- [first..second]] == do
a <- [first..second]
b <- [first..second]
c <- [first..second]
return [a, b, c]
To make it more clear, let's replace [first..second] by m:
do let m = [first..second]
a <- m
b <- m
c <- m
return [a, b, c]
So here you can see that m is just getting replicated n times, hence replicateM. Let's see how the types line up too:
replicateM :: Monad m => Int -> m a -> m [a]
m ~ []
replicateM_List :: Int -> [a] -> [[a]]
If you need to do this on arbitrary lists, not just repeating the same list, you can just use sequence on it
TL;DR use comprehension and a fold or go with bheklilr's replicateM suggestion
Comprehension and a fold
You know what you're doing with list coprehension, so let's see how to do this recursively by first writing a function which prepends values of a list in all possible ways, so that
ghci> prepend "123" ["first","second"]
["1first","1second","2first","2second","3first","3second"]
prepend :: [a] -> [[a]] -> [[a]]
prepend xs yss = [x:ys| x<-xs, ys<-yss]
Now let's make the list of lists, first using replicate :: Int -> a -> [a] to replicate our list n times, then prepend each copy front of the others by folding the list:
lol :: [a] -> Int -> [[a]]
lol xs n = foldr prepend [[]] $ replicate n xs
ghci> lol "ab" 3
["aaa","aab","aba","abb","baa","bab","bba","bbb"]
ghci> lol [1..3] 2
[[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]
I'm sure you can figure out how to use that with a pair (start, finish) as an argument.
replicateM
As bheklilr points out in the comment, we can import Control.Monad and get
replicateM :: Monad m => Int -> m a -> m [a]
If you specialist that to lists, you get
replicateM :: Int -> [a] -> [[a]]
with that doing what you want:
ghci> replicateM 2 [1..3]
[[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]
If, like me, you don't have as brilliant a mind as bheklilr,
you can use hoogle like this to search for functions with the type we need ([a] -> Int -> [[a]] in this case) and find that the third one down is replicateM. (drop and take don't do what we want.)

Please correct my use of the Maybe Monad

I'm implementing a little program that does exponentiation ciphers. Some of the computations might fail, for instance, computing a modular inverse. I've used Maybe to deal with these sorts of failures. But now I'm stuck, as I need to "inject" the value inside of a maybe into another partially applied function. I know that if I had a function that took one argument, I'd use bind to do this.
import Data.Char
import Math.NumberTheory.Powers
extendedGcd::Integer->Integer->(Integer, Integer)
extendedGcd a b | r == 0 = (0, 1)
| otherwise = (y, x - (y * d))
where
(d, r) = a `divMod` b
(x, y) = extendedGcd b r
modularInverse::Integer->Integer->Maybe Integer
modularInverse n b | relativelyPrime n b = Just . fst $ extGcd n b
| otherwise = Nothing
where
extGcd = extendedGcd
relativelyPrime::Integer->Integer->Bool
relativelyPrime m n | gcd m n == 1 = True
| otherwise = False
textToDigits::String->[Integer]
textToDigits p = map (\x->toInteger (ord x - 97)) p
digitsToText::[Integer]->String
digitsToText d = map (\x->chr ((fromIntegral x) + 97)) d
exptEncipher::Integer->Integer->Integer->Maybe Integer
exptEncipher m k p | relativelyPrime k (p - 1) = Just $ powerMod p k m
| otherwise = Nothing
exptDecipher::Integer->Integer->Integer->Integer
exptDecipher m q c = powerMod c q m
exptEncipherString::Integer->Integer->String->[Maybe Integer]
exptEncipherString m k p = map (exptEncipher m k) plaintext
where
plaintext = textToDigits p
exptDecipherString::Integer->Integer->[Maybe Integer]->Maybe String
exptDecipherString m k c = (fmap digitsToText) plaintext
where
q = modularInverse k (m - 1)
plaintext = map (fmap $ exptDecipher m q) c
Specifically, my problem is in the function exptDecipherString, where I needed to inject the value encapsulated by the monad in q into the function exptDecipher, which I will then lift to work on c. What's the right way to do this? Also, I'm worried that I'll end up with a list of [Maybe Char] instead of the Maybe String that I want. I'm having problems reasoning through all of this. Can someone enlighten me?
You can use sequence and ap to get the types to work out. First for their signatures:
ap :: Monad m => m (a -> b) -> m a -> m b
sequence :: Monad m => [m a] -> m [a]
Notice that sequence directly addresses your worry about having a [Maybe Char] instead of a Maybe String. Both are in Control.Monad (note that you'll have to import ap). We can use them as follows:
exptDecipherString :: Integer -> Integer -> [Maybe Integer] -> Maybe String
exptDecipherString m k c = fmap digitsToText plaintext
where
q = modularInverse k (m - 1)
plaintext = sequence $ map (ap $ fmap (exptDecipher m) q) c
We can get to this point by working through the types. First we appy exptDecipher to m, which gives us a function of type Integer -> Integer -> Integer. We want to apply this to q, but it's a Maybe Integer, so we have to use fmap (exptDecipher m) q, which then has type Maybe (Integer -> Integer). We can then pop ap on the front and get something of type Maybe Integer -> Maybe Integer. We then map this over c, which gives us a [Maybe Integer], which we can turn inside out using sequence.
This might not work—if there are bugs in the logic, etc.—but at least it compiles.
A couple of side notes: you can use the infix operators <$> and <*> from Control.Applicative in place of fmap and ap, respectively, for slightly nicer syntax, and your relativelyPrime can be written much more simply as relativelyPrime m n = gcd m n == 1.

Resources