Related
I'm trying to solve a decomposition problem with backtracking and list Monad in Haskell. Here is the problem statement: given a positive integer n, find all lists of consecutive integers (in range i..j) whose sum is equal to n.
I came out with the following solution which seems to work fine. Could someone suggest a better/more efficient implementation using list Monad and backtracking?
Any suggestions are welcome. Thanks in advance.
import Control.Monad
decompose :: Int -> [[Int]]
decompose n = concatMap (run n) [1 .. n - 1]
where
run target n = do
x <- [n]
guard $ x <= target
if x == target
then return [x]
else do
next <- run (target - n) (n + 1)
return $ x : next
test1 = decompose 10 == [[1,2,3,4]]
test2 = decompose 9 == [[2,3,4],[4,5]]
The sum of a range of numbers k .. l with k≤l is equal to (l×(l+1)-k×(k-1))/2. For example: 1 .. 4 is equal to (4×5-1×0)/2=(20-0)/2=10; and the sum of 4 .. 5 is (5×6-4×3)/2=(30-12)/2=9.
If we have a sum S and an offset k, we can thus find out if there is an l for which the sum holds with:
2×S = l×(l+1)-k×(k-1)
0=l2+l-2×S-k×(k-1)
we can thus solve this equation with:
l=(-1 + √(1+8×S+4×k×(k-1)))/2
If this is an integral number, then the sequence exists. For example for S=9 and k=4, we get:
l = (-1 + √(1+72+48))/2 = (-1 + 11)/2 = 10/2 = 5.
We can make use of some function, like the Babylonian method [wiki] to calculate integer square roots fast:
squareRoot :: Integral t => t -> t
squareRoot n
| n > 0 = babylon n
| n == 0 = 0
| n < 0 = error "Negative input"
where
babylon a | a > b = babylon b
| otherwise = a
where b = quot (a + quot n a) 2
We can check if the found root is indeed the exact square root with by squaring the root and see if we obtain back the original input.
So now that we have that, we can iterate over the lowerbound of the sequence, and look for the upperbound. If that exists, we return the sequence, otherwise, we try the next one:
decompose :: Int -> [[Int]]
decompose s = [ [k .. div (sq-1) 2 ]
| k <- [1 .. s]
, let r = 1+8*s+4*k*(k-1)
, let sq = squareRoot r
, r == sq*sq
]
We can thus for example obtain the items with:
Prelude> decompose 1
[[1]]
Prelude> decompose 2
[[2]]
Prelude> decompose 3
[[1,2],[3]]
Prelude> decompose 3
[[1,2],[3]]
Prelude> decompose 1
[[1]]
Prelude> decompose 2
[[2]]
Prelude> decompose 3
[[1,2],[3]]
Prelude> decompose 4
[[4]]
Prelude> decompose 5
[[2,3],[5]]
Prelude> decompose 6
[[1,2,3],[6]]
Prelude> decompose 7
[[3,4],[7]]
Prelude> decompose 8
[[8]]
Prelude> decompose 9
[[2,3,4],[4,5],[9]]
Prelude> decompose 10
[[1,2,3,4],[10]]
Prelude> decompose 11
[[5,6],[11]]
We can further constrain the ranges, for example specify that k<l, with:
decompose :: Int -> [[Int]]
decompose s = [ [k .. l ]
| k <- [1 .. div s 2 ]
, let r = 1+8*s+4*k*(k-1)
, let sq = squareRoot r
, r == sq*sq
, let l = div (sq-1) 2
, k < l
]
This then gives us:
Prelude> decompose 1
[]
Prelude> decompose 2
[]
Prelude> decompose 3
[[1,2]]
Prelude> decompose 4
[]
Prelude> decompose 5
[[2,3]]
Prelude> decompose 6
[[1,2,3]]
Prelude> decompose 7
[[3,4]]
Prelude> decompose 8
[]
Prelude> decompose 9
[[2,3,4],[4,5]]
Prelude> decompose 10
[[1,2,3,4]]
Prelude> decompose 11
[[5,6]]
NB This answer is slightly tangential since the question specifically calls for a direct backtracking solution in Haskell. Posting it in case there is some interest in other approaches to this problem, in particular using off-the-shelf SMT solvers.
These sorts of problems can be easily handled by off-the-shelf constraint solvers, and there are several libraries in Haskell to access them. Without going into too much detail, here's how one can code this using the SBV library (https://hackage.haskell.org/package/sbv):
import Data.SBV
decompose :: Integer -> IO AllSatResult
decompose n = allSat $ do
i <- sInteger "i"
j <- sInteger "j"
constrain $ 1 .<= i
constrain $ i .<= j
constrain $ j .< literal n
constrain $ literal n .== ((j * (j+1)) - ((i-1) * i)) `sDiv` 2
We simply express the constraints on i and j for the given n, using the summation formula. The rest is simply handled by the SMT solver, giving us all possible solutions. Here're a few tests:
*Main> decompose 9
Solution #1:
i = 4 :: Integer
j = 5 :: Integer
Solution #2:
i = 2 :: Integer
j = 4 :: Integer
Found 2 different solutions.
and
*Main> decompose 10
Solution #1:
i = 1 :: Integer
j = 4 :: Integer
This is the only solution.
While this may not provide much insight into how to solve the problem, it sure leverages existing technologies. Again, while this answer doesn't use the list-monad as asked, but hopefully it is of some interest when considering applications of SMT solvers in regular programming.
So I have to make a decimal number into binary list like so: intToBitString 4 = [1,0,0].
Which i have done like so:
intToBitString n = reverse (helper n)
helper 0 = []
helper n
| n `mod` 2 == 1 = 1 : helper (n `div` 2)
| n `mod` 2 == 0 = 0 : helper(n `div` 2)
But then I also have to make a function called intToByte, which pads out the list with 0-s until it's length is 8 elements long. (so making it a bytestring) Like this:
intToByte 7 = [0, 0, 0, 0, 0, 1, 1, 1]
I have tried so many things, but they never work. I am a beginner, so I only know the "if" loop the way I showed above, and recursion, but I dont know anything fancy. One of my tries:
intToByte 0 = [0]
intToByte n
| eight n == helper2 n = reverse (helper2 n)
| otherwise = eight n
helper2 0 = []
helper2 n
| n `mod` 2 == 1 = 1 : helper2 (n `div` 2)
| n `mod` 2 == 0 = 0 : helper2 (n `div` 2)
eight n
| length (helper2 n) < 8 = 0 : eight n
| otherwise = helper2 n
I have been working on this for so many hours that i'm getting confused by it. But this is part of an important assignment, so help would be very appreciated!
First of all, you can simplify your code with:
helper2 :: Integral i => i -> [i]
helper2 0 = []
helper2 n = r : helper2 q
where (q,r) = quotRem n 2
Secondly, the above is a big endian representation [wiki]. Indeed, 7 is represented as [1,1,1], whereas 14 is for example represented as [0,1,1,1]. If we want to revers this, we can work with an accumulator:
helper2 :: Integral i => i -> [i]
helper2 = go []
where go rs 0 = rs
go rs n = go (r:rs) q
where (q,r) = quotRem n 2
This thus maps 7 to [1,1,1] and 14 to [1,1,1,0]. But now we still need to add leading zeros. We can do that for example by maintaing the number of elements already added to the list:
eight :: Integral i => i -> [i]
eight = go [] 0
where go rs l 0 = replicate (8-l) 0 ++ rs
go rs l n = go (r:rs) (l+1) q
where (q,r) = quotRem n 2
Padding can be as simple as computing how many additional elements to push to the list and then have those elements produced using the function replicate from the Prelude:
padLeft :: Int -> a -> [a] -> [a]
padLeft n x xs = replicate (n - length xs) x ++ xs
For instance:
> padLeft 8 0 [1, 1, 0]
[0,0,0,0,0,1,1,0]
One approach would be to define a function bits such that bits k converts its argument to a bit string of length k:
bits :: Int -> Int -> [Int]
bits 0 _n = []
bits k n | n < 0 = error "bits: negative"
| n > 2 * m - 1 = error "bits: overflow"
| otherwise = let (i, j) = n `divMod` m in i : bits (k - 1) j
where m = 2 ^ (k - 1)
Your function eight is then easily written as
eight :: Int -> [Int]
eight = bits 8
This gives:
> eight 4
[0,0,0,0,0,1,0,0]
> eight 7
[0,0,0,0,0,1,1,1]
This is the code I have so far:
data Suit = Diamond | Club | Heart | Spade
deriving (Read, Enum, Eq, Bounded)
data Rank = Two | Three | Four
| Five | Six | Seven | Eight | Nine | Ten
| Jack | Queen | King | Ace
deriving (Read, Enum, Eq, Ord, Bounded)
and I am trying to map each value, either Rank or Suit to a unique prime number.
primeMapper :: Either Rank Suit -> Int
should be the final function and I want to iterate over each Suit and set it to the first four primes:
primeMapper [Diamond .. Spade] = [2,3,5,7]
and each Rank equal to the rest of the primes up until the 17th:
primeMapper [Two .. Ace] = drop 4 . take 17 $ primes
assuming I have a generating function called primes.
This code, however throws errors obviously because it generates a list from a list. How can I achieve what I am trying to do? Let me know if I can explain it better.
The ultimate goal is to have a hash table that gives unique IDs to each cards based on prime factors, and then generate prime factorization and use modulo to quickly compare poker hands.
Ultimately I solved what I am trying to do by hand as so:
primeMapper :: Either Suit Rank -> Int
primeMapper x = case x of
Left Diamond -> 2
Left Club -> 3
Left Heart -> 5
Left Spade -> 7
Right Two -> 11
Right Three -> 13
Right Four -> 17
Right Five -> 19
Right Six -> 23
Right Seven -> 29
Right Eight -> 31
Right Nine -> 37
Right Ten -> 41
Right Jack -> 43
Right Queen -> 47
Right King -> 53
Right Ace -> 59
... was there a more concise way to do this rather than write each case out by hand?
Your solution using pattern matching is best, though I would prefer
primeMapper :: Either Suit Rank -> Int
primeMapper (Left Diamond) = 2
primeMapper (Left Club) = 3
...
rather than your long case expression.
However you could also use lookup :: Eq a => a -> [(a, b)] -> Maybe b
import Data.Maybe (fromJust)
primeMapper :: Either Suit Rank -> Int
primeMapper = fromJust . flip lookup zippedPrimes
where
zippedPrimes = zip suitranks primes
suitranks = fmap Left suits ++ fmap Right ranks :: [Either Suit Rank]
suits = fromEnum minBound
ranks = fromEnum minBound
Depending on what you plan to use this for, you may not need to use primes or prime factorizations at all; you can get fast conversion to and from plain numbers just by picking one or the other of the suit or rank for a base conversion. Here I'll pick suit -- there are four suits, so take the first digit in base 4 as the suit and the remaining digits as the rank.
encode :: (Suit, Rank) -> Int
encode (s, r) = fromEnum s + 4 * fromEnum r
decode :: Int -> (Suit, Rank)
decode n = (toEnum s, toEnum r) where (r, s) = n `quotRem` 4
You can verify in ghci that this gives a unique number to each card:
> [encode (s, r) | r <- [minBound .. maxBound], s <- [minBound .. maxBound]]
[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51]
And that they decode appropriately:
> map decode [0..51] == [(s, r) | r <- [minBound .. maxBound], s <- [minBound .. maxBound]]
True
You can adapt some of this I hope.
no2s3s5s = \n -> take n $ scanl (\b a -> a+b) 11 $ cycle [2,4,2,4,6,2,6,4]
rnk = filter (/=49) $ no2s3s5s 14
stv = [2,3,5,7]
_deck = [ b*v | b <- stv, v <- rnk]
_Dia = take 13.drop (0*13) $ _deck
_Clb = take 13.drop (1*13) $ _deck
_Hrt = take 13.drop (2*13) $ _deck
_Spd = take 13.drop (3*13) $ _deck
_Dia
[22,26,34,38,46,58,62,74,82,86,94,106,118]
_Clb
[33,39,51,57,69,87,93,111,123,129,141,159,177]
_Hrt
[55,65,85,95,115,145,155,185,205,215,235,265,295]
_Spd
[77,91,119,133,161,203,217,259,287,301,329,371,413]
_deck
[22,26,34,38,46,58,62,74,82,86,94,106,118,33,39,51,57,69,87,93,111,123,129,141,159,177,55,65,85,95,115,145,155,185,205,215,235,265,295,77,91,119,133,161,203,217,259,287,301,329,371,413]
length _deck
52
Your multiples (_deck) are all unique.
I normally use no2s3s5s with a computed (limited) factor list and the mod function to generate a long prime list.
I have following problem:
You are given matrix m*n and you have to find maximal positive ( all elements of submatrix should be > 0) submatrices from (1,1) to (x,y).
What do I mean by maximal is, when you have following matrix:
[[1,2,3,4],[5,6,7,8],[9,10,-11,12],[13,14,15,16]]
then maximal positive submatrices are:
[[[1,2,3,4],[5,6,7,8]],[[1,2],[5,6],[9,10],[13,14]]]
i.e. first two rows is one solution and first two columns is second solution.
Another example: matrix is
[[1,2,3,-4],[5,6,7,8],[-9,10,-11,12],[13,14,15,16]]
and solution is:
[[[1,2,3],[5,6,7]]]
This is my Haskell program which solves it:
import Data.List hiding (insert)
import qualified Data.Set as Set
unique :: Ord a => [a] -> [a]
unique = Set.toList . Set.fromList
subList::[[Int]] ->[[[Int]]]
subList matrix = filter (allPositiveMatrix) $ [ (submatrix matrix 1 1 x y) | x<-[1..width(matrix)], y<-[1..height(matrix)]]
maxWidthMat::[[[Int]]] -> Int
maxWidthMat subList =length ((foldl (\largestPreviousX nextMatrix -> if (length (nextMatrix!!0)) >(length (largestPreviousX !!0)) then nextMatrix else largestPreviousX ) [[]] subList)!!0)
maxWidthSubmatrices:: [[[Int]]] -> Int ->[[[Int]]]
maxWidthSubmatrices subList maxWidth = filter (\x -> (length $x!!0)==maxWidth) subList
height matrix = length matrix
width matrix = length (matrix!!0)
maximalPositiveSubmatrices matrix = maxWidthSubmatrices (subList matrix) (maxWidthMat (filter (\x -> (length $x!!0)==( maxWidthMat $ subList matrix )) (subList matrix)))
allPositiveList list = foldl (\x y -> if (y>0)&&(x==True) then True else False) True list
allPositiveMatrix:: [[Int]] -> Bool
allPositiveMatrix matrix = foldl (\ x y -> if (allPositiveList y)&&(x==True) then True else False ) True matrix
submatrix matrix x1 y1 x2 y2 = slice ( map (\x -> slice x x1 x2) matrix) y1 y2
slice list x y = drop (x-1) (take y list)
maximalWidthSubmatrix mm = maximum $ maximalPositiveSubmatrices mm
maximalHeigthSubmatrix mm = transpose $ maximum $ maximalPositiveSubmatrices $ transpose mm
-- solution
solution matrix =unique $ [maximalWidthSubmatrix matrix]++[maximalHeigthSubmatrix matrix]
As you can see it's extremely lengthy and ugly.
It problably isn't fastest too.
Could you show me more elegant, faster and shorter solution ( possibly with explantions) ?
Proposed algorithm
I think that in order to solve the problem, we first better perform a dimension reduction:
reduce_dim :: (Num a,Ord a) => [[a]] -> [Int]
reduce_dim = map (length . takeWhile (>0)) -- O(m*n)
Here for every row, we calculate the number of items - starting from the left - that are positive. So for the given matrix:
1 2 3 4 | 4
5 6 7 8 | 4
9 10 -11 12 | 2
13 14 15 16 | 4
The second row thus maps to 2, since the third element is -11.
Or for your other matrix:
1 2 3 -4 | 3
5 6 7 8 | 4
-9 10 -11 12 | 0
13 14 15 16 | 4
Since the first row has a -4 at column 4, and the third one at column 1.
Now we can obtain a scanl1 min over these rows:
Prelude> scanl1 min [4,4,2,4] -- O(m)
[4,4,2,2]
Prelude> scanl1 min [3,4,0,4] -- O(m)
[3,3,0,0]
Now each time the number decreases (and at the end), we know we have found a maximal submatrix at the row above. Since that means we now work with a row from where on, the number of columns is less. Once we reach zero, we know that further evaluation has no sense, since we are working with a matrix with 0 columns.
So based on that list, we can simply generate a list of tuples of the sizes of the maximal submatrices:
max_sub_dim :: [Int] -> [(Int,Int)]
max_sub_dim = msd 1 -- O(m)
where msd r [] = []
msd r (0:_) = []
msd r [c] = [(r,c)]
msd r (c1:cs#(c2:_)) | c2 < c1 = (r,c1) : msd (r+1) cs
| otherwise = msd (r+1) cs
So for your two matrices, we obtain:
*Main> max_sub_dim $ scanl1 min $ reduce_dim [[1,2,3,4],[5,6,7,8],[9,10,-11,12],[13,14,15,16]]
[(2,4),(4,2)]
*Main> max_sub_dim $ scanl1 min $ reduce_dim [[1,2,3,-4],[5,6,7,8],[-9,10,-11,12],[13,14,15,16]]
[(2,3)]
Now we only need to obtain these submatrices themselves. We can do this by using take and a map over take:
construct_sub :: [[a]] -> [(Int,Int)] -> [[[a]]]
construct_sub mat = map (\(r,c) -> take r (map (take c) mat)) -- O(m^2*n)
And now we only need to link it all together in a solve:
-- complete program
reduce_dim :: (Num a,Ord a) => [[a]] -> [Int]
reduce_dim = map (length . takeWhile (>0))
max_sub_dim :: [Int] -> [(Int,Int)]
max_sub_dim = msd 1
where msd r [] = []
msd r (0:_) = []
msd r [c] = [(r,c)]
msd r (c1:cs#(c2:_)) | c2 < c1 = (r,c1) : msd (r+1) cs
| otherwise = msd (r+1) cs
construct_sub :: [[a]] -> [(Int,Int)] -> [[[a]]]
construct_sub mat = map (\(r,c) -> take r (map (take c) mat))
solve :: (Num a,Ord a) => [[a]] -> [[[a]]]
solve mat = construct_sub mat $ max_sub_dim $ scanl1 min $ reduce_dim mat
Which then generates:
*Main> solve [[1,2,3,4],[5,6,7,8],[9,10,-11,12],[13,14,15,16]]
[[[1,2,3,4],[5,6,7,8]],[[1,2],[5,6],[9,10],[13,14]]]
*Main> solve [[1,2,3,-4],[5,6,7,8],[-9,10,-11,12],[13,14,15,16]]
[[[1,2,3],[5,6,7]]]
Time complexity
The algorithm runs in O(m×n) with m the number of rows and n the number of columns, to construct the dimensions of the matrices. For every defined function, I wrote the time complexity in comment.
It will take O(m2×n) to construct all submatrices. So the algorithm runs in O(m2×n).
We can transpose the approach and run on columns instead of rows. So in case we are working with matrices where the number of rows differs greatly from the number of columns, we can first calculate the minimum, optionally transpose, and thus make m the smallest of the two.
Point of potential optimization
we can make the algorithm faster by constructing submatrices while constructing max_sub_dim saving some work.
This question already has answers here:
product of list iteratively
(2 answers)
Closed 6 years ago.
I'm really new to haskell and would like to multiply all numbers in an array. For example.:
Array:
[3,2,4] //3*2*4
Output
24
Thanks, any help is greatly appreciated.
There are a number of ways of doing it in Haskell.
For instance, you could use:
product [3,2,4]
or equivalently
foldr (*) 1 [3,2,4]
or recursively:
prod [] = 1
prod (x : xs) = x * prod xs
Function foldr is the so called list catamorphism. To understand foldr we need to first understand list constructors. In Haskell, [3,2,4] is a syntax sugar for 3 : 2 : 4 : [], where : is list-cons constructor and [] is the empty list. Application foldr f v replaces every occurrence of : in a list by function f and the empty list for v. Its definition is as follows:
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f v [] = v -- equation 1
foldr f v (x:xs) = f x (foldr f v xs) -- equation 2
As an example, consider foldr (*) 1 [3,2,4]:
foldr (*) 1 [3,2,4] =
3 * (foldr (*) 1 [2,4]) = (by equation 2 of foldr)
3 * (2 * (foldr (*) 1 [4])) = (by equation 2 of foldr)
3 * (2 * (4 * (foldr (*) 1 []))) = (by equation 2 of foldr)
3 * (2 * (4 * 1)) = (by equation 1 of foldr)
= 24
You can do so with a fold function:
foldr (*) 1 [2,3,4]
or...
foldr1 (*) [2,3,4]
The product function is exactly what you're looking for.
It has also the feature that product [] equals 1, as you would expect mathematically speaking.
If you look at its definition, you can see that product is indeed the fold of multiplication (with 1 as neutral element).