Variable List Comprehension Length - haskell

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.)

Related

Haskell List Comprehension and List Monad

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)

Apply a Function to every element in a list

I've created a function m such that
m "abc" "def" == "bcd"
and I would like to create another function that uses m to generate the output ["bcd","efg","hia"] when given the input ["abc","def","ghi"]
The definition of m is
m :: [a] -> [a] -> [a]
m str1 str2 = (drop 1 str1) ++ (take 1 str2)
You can make use of zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] here where you take the entire list as first parameter, and tail (cycle l) as second parameter (with l the list):
combine :: [a] -> [a]
combine l = zipWith m l (tail (cycle l))
zipWith will enumerate concurrently on both lists and each time call m with an element of the first and the second list. For example:
Prelude> combine ["abc","def","ghi"]
["bcd","efg","hia"]
You can append the first element to the end to simulate a wrap-around, then zip the list with its tail to get tuples of each element, then map it:
f :: [[a]] -> [[a]]
f [] = []
f l#(x:xs) = map (\(a, b) -> m a b) $ zip wrapped (tail wrapped)
where wrapped = l ++ [x]
Alternatively, you can use uncurry:
f :: [[a]] -> [[a]]
f [] = []
f l#(x:xs) = map (uncurry m) $ zip wrapped (tail wrapped)
where wrapped = l ++ [x]
import Data.List.HT (rotate)
m2 :: [[a]] -> [[a]]
m2 list = zipWith m list (rotate 1 list)
where m is yours.
You can make it point free in a couple of ways.
Here's using the Applicative style,
m2 :: [[a]] -> [[a]]
m2 = zipWith m <$> id <*> (rotate 1)
which can read as m2 is the function that passes its argument to id and rotate 1 respectively, and then those results to zipWith m.
Here's using the Monadic style,
import Control.Monad (ap)
m2 :: [[a]] -> [[a]]
m2 = zipWith m `ap` rotate 1
which is imho a bit less clear, in this case; you can read it as m2 passes its argument to both zipWith m and rotate 1 and then feeds the result of the latter to the the result of the former.
Honestly, I like the other answer a bit more, as it avoids importing rotate and gets the same effect with tail . cycle.

Greaters function define

I would like to define a greaters function, which selects from a list items that are larger than the one before it.
For instance:
greaters [1,3,2,4,3,4,5] == [3,4,4,5]
greaters [5,10,6,11,7,12] == [10,11,12]
The definition I came up with is this :
greaters :: Ord a => [a] -> [a]
Things I tried so far:
greaters (x:xs) = group [ d | d <- xs, x < xs ]
Any tips?
We can derive a foldr-based solution by a series of re-writes starting from the hand-rolled recursive solution in the accepted answer:
greaters :: Ord a => [a] -> [a]
greaters [] = []
greaters (x:xs) = go x xs -- let's re-write this clause
where
go _ [] = []
go last (act:xs)
| last < act = act : go act xs
| otherwise = go act xs
greaters (x:xs) = go xs x -- swap the arguments
where
go [] _ = []
go (act:xs) last
| last < act = act : go xs act
| otherwise = go xs act
greaters (x:xs) = foldr g z xs x -- go ==> foldr g z
where
foldr g z [] _ = []
foldr g z (act:xs) last
| last < act = act : foldr g z xs act
| otherwise = foldr g z xs act
greaters (x:xs) = foldr g z xs x
where -- simplify according to
z _ = [] -- foldr's definition
g act (foldr g z xs) last
| last < act = act : foldr g z xs act
| otherwise = foldr g z xs act
Thus, with one last re-write of foldr g z xs ==> r,
greaters (x:xs) = foldr g z xs x
where
z = const []
g act r last
| last < act = act : r act
| otherwise = r act
The extra parameter serves as a state being passed forward as we go along the input list, the state being the previous element; thus avoiding the construction by zip of the shifted-pairs list serving the same purpose.
I would start from here:
greaters :: Ord a => [a] -> [a]
greaters [] = []
greaters (x:xs) = greatersImpl x xs
where
greatersImpl last [] = <fill this out>
greatersImpl last (x:xs) = <fill this out>
The following functions are everything you’d need for one possible solution :)
zip :: [a] -> [b] -> [(a, b)]
drop 1 :: [a] -> [a]
filter :: (a -> Bool) -> [a] -> [a]
(<) :: Ord a => a -> a -> Bool
uncurry :: (a -> b -> c) -> (a, b) -> c
map :: (a -> b) -> [a] -> [b]
snd :: (a, b) -> b
Note: drop 1 can be used when you’d prefer a “safe” version of tail.
If you like over-generalization like me, you can use the witherable package.
{-# language ScopedTypeVariables #-}
import Control.Monad.State.Lazy
import Data.Witherable
{-
class (Traversable t, Filterable t) => Witherable t where
-- `wither` is an effectful version of mapMaybe.
wither :: Applicative f => (a -> f (Maybe b)) -> t a -> f (t b)
-}
greaters
:: forall t a. (Ord a, Witherable t)
=> t a -> t a
greaters xs = evalState (wither go xs) Nothing
where
go :: a -> State (Maybe a) (Maybe a)
go curr = do
st <- get
put (Just curr)
pure $ case st of
Nothing -> Nothing
Just prev ->
if curr > prev
then Just curr
else Nothing
The state is the previous element, if there is one. Everything is about as lazy as it can be. In particular:
If the container is a Haskell list, then it can be an infinite one and everything will still work. The beginning of the list can be produced without withering the rest.
If the container extends infinitely to the left (e.g., an infinite snoc list), then everything will still work. How can that be? We only need to know what was in the previous element to work out the state for the current element.
"Roll your own recursive function" is certainly an option here, but it can also be accomplished with a fold. filter can't do it because we need some sort of state being passed, but fold can nicely accumulate the result while keeping that state at the same time.
Of course the key idea is that we keep track of last element add the next one to the result set if it's greater than the last one.
greaters :: [Int] -> [Int]
greaters [] = []
greaters (h:t) = reverse . snd $ foldl (\(a, r) x -> (x, if x > a then x:r else r)) (h, []) t
I'd really love to eta-reduce it but since we're dropping the first element and seeding the accumulator with it it kinda becomes awkward with the empty list; still, this is effectively an one-liner.
So i have come up with a foldr solution. It should be similar to what #Will Ness has demonstrated but not quite i suppose as we don't need a separate empty list check in this one.
The thing is, while folding we need to encapsulate the previous element and also the state (the result) in a function type. So in the go helper function f is the state (the result) c is the current element of interest and p is the previous one (next since we are folding right). While folding from right to left we are nesting up these functions only to run it by applyying the head of the input list to it.
go :: Ord a => a -> (a -> [a]) -> (a -> [a])
go c f = \p -> let r = f c
in if c > p then c:r else r
greaters :: Ord a => [a] -> [a]
greaters = foldr go (const []) <*> head
*Main> greaters [1,3,2,4,3,4,5]
[3,4,4,5]
*Main> greaters [5,10,6,11,7,12]
[10,11,12]
*Main> greaters [651,151,1651,21,651,1231,4,1,16,135,87]
[1651,651,1231,16,135]
*Main> greaters [1]
[]
*Main> greaters []
[]
As per rightful comments of #Will Ness here is a modified slightly more general code which hopefully doesn't break suddenly when the comparison changes. Note that const [] :: b -> [a] is the initial function and [] is the terminator applied to the result of foldr. We don't need Maybe since [] can easily do the job of Nothing here.
gs :: Ord a => [a] -> [a]
gs xs = foldr go (const []) xs $ []
where
go :: Ord a => a -> ([a] -> [a]) -> ([a] -> [a])
go c f = \ps -> let r = f [c]
in case ps of
[] -> r
[p] -> if c > p then c:r else r

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 []

Returning a decyphered string as part of tuple in Haskell

For project euler 59, I came up with this to return a list of tuples containing the decyphered string and the key used (and yes I know about Data.Bits):
module XOR where
import Data.List
import Data.Char
decToBin :: Integer -> [Integer]
decToBin x = reverse $ decToBin' x
where
decToBin' 0 = []
decToBin' y = let (a,b) = quotRem y 2 in [b] ++ decToBin' a
binToDec :: [Integer] -> Integer
binToDec xs = foldl (+) 0 $ map (\(x,y) -> x*(2^y) ) $reverse $ zip (reverse xs) [0..]
bitwise f x y = zipWith f x y
lenBin :: Integer -> Integer
lenBin x= length$ decToBin x
xor :: Integer -> Integer -> Bool
xor x y | x == y = 0
| x /= y = 1
| otherwise = error "Impossible"
bitwiseXOR :: Integer -> Integer -> Integer
bitwiseXOR a b | (lenBin a) > (lenBin b) = binToDec $ bitwise xor ((replicate ((lenBin a) - (lenBin b)) 0)++(decToBin b)) (decToBin a)
| (lenBin a) < (lenBin b) = binToDec $ bitwise xor ((replicate ((lenBin b) - (lenBin a)) 0)++(decToBin a)) (decToBin b)
| otherwise =binToDec $ bitwise xor (decToBin b) (decToBin a)
decyph :: [char] -> [char]
decyph key = map chr $ map (\(x,y)-> bitwiseXOR x (ord y) ) $ zip numbers $ cycle key
brute :: [([Char],[Char])]
brute = [(n,k)|k<- (sequence $ replicate 3 ['a'..'z']) ,n <- decyph k, "the" `isInfixOf` n]
numbers :: [Integer]
numbers = [79,59,12,2,79,35,8...]
The problem is that when I can't run decyph because the tuples it is producing only contain one character in the first part and the key in the second rather than the entire decrypted text with the key used. How can I fix this?
PS: Is it reasonable to assume the text will contain string "the"?
decyph key returns the deciphered text as a [Char]. With the syntax
n <- decyph k
in your list comprehension, n will be of type Char and be assigned the individual characters of the deciphered text, but what you want here is that it is assigned the full result of decyph so make it
let n = decyph k
Finally, check the type of elem:
> :t elem
elem :: (Eq a) => a -> [a] -> Bool
with the type of n being [Char], the first argument must be Char, but you have another string there. If you wish to work with elems, you could split up the deciphered text in words:
"the" `elem` words n
This will compile here then.
PS: Is it reasonable to assume the
text will contain string "the"?
It is most certainly a common English word, but the text could possibly be all-uppercase or the might only appear as The at the beginning of a sentence.

Resources