Haskell scripts to solve identity matrix - haskell

how to solve identity for a matrix using Haskell scripts?
For example, if with this given type
type Matrice a = [[a]]
identity :: Int -> Maybe (Matrice Int)
How can it return the identity matrice for the given size? I know that identity matrice is a square matrice which has zero for all values, except the values on the top-left to bottom-right diagonal which are all one. With the condition of, if the size is less than 1, then the identity matrice isn't defined and Nothing is returned.
So say for example,
Prelude > identity 5
Just [[1,0,0,0,0],[0,1,0,0,0],[0,0,1,0,0],[0,0,0,1,0],[0,0,0,0,1]]
Prelude > identity 2
Just [[1,0],[0,1]]
I've tried
identity1 :: Int -> Int -> [Int]
identity1 a b
| a == 0 []
| b == 0 (1:identity (a-1) (-1))
| otherwise = (0:identity' (a-1) (b-1))
identity2 :: Int -> Int -> Matrice Int
identity2 a b
| b == 0 []
| otherwise = (0:identity1 (a-1) (b-1) : identity2 a (b-1)

One short approach is to define the "infinite" identity matrix as
ii = (1 : repeat 0) : fmap (0:) ii
The first row is 1 0 0 ...; each subsequent row is the row above it with a 0 prepended to it.
It should be obvious that the first n rows of the first n columns of the infinite identity matrix is In.
1 | 0 | 0 | 0 | 0 | 0 |
--+ | | | | |
0 1 | 0 | 0 | 0 | 0 |
------+ | | | |
0 0 1 | 0 | 0 | 0 |
----------+ | | | ...
0 0 0 1 | 0 | 0 |
--------------+ | |
0 0 0 0 1 | 0 |
------------------+ |
0 0 0 0 0 1 |
----------------------+
. .
. .
. .
Given that, we just use take to obtain the appropriate-sized sub matrix. take n applied to each row will return the first n columns, and take n applied to the result takes just the first n rows.
type Matrix a = [[a]]
identity :: Int -> Maybe (Matrix Int)
identity n | n <= 0 = Nothing
| otherwise = let ii = (1:repeat 0) : (fmap (0:) ii)
in Just $ take n (take n <$> ii)
If recursively defined infinite lists tie your brain in knots, you can also just define an enlarge function that generates In+1 from In. To do so, it is convenient to assume that I0 exists and is represented as an empty list.
enlarge :: Matrix Int -> Matrix Int
enlarge [] = [[1]]
enlarge i#(r:_) = (1:(0<$r)) : fmap (0:) i
Then you can define identity :: Int -> Matrix Int by indexing an infinite list of identity matrices
identity n | n <= 0 = Nothing
identity n = Just (identities !! n)
where identities :: [Matrix Int] is built with either iterate
identities = iterate enlarge []
or Data.List.unfoldr:
identities = unfoldr (\x -> Just (x, enlarge x)) []
It's also worth noting that the infinite identity matrix is the fixed point of enlarge:
import Data.Function
ii = fix enlarge

One way to accomplish this is through recursion.
I'm going to ask you some leading questions, since I haven't seen what you've tried so far:
What's the identity for 1x1 matrices?
Given the identity for nxn matrices, what would you need to add to create the identity for (n+1)x(n+1) matrices?
Or in pseudo-code:
identity 1 = Just $ _1x1_identity
-- _1x1_identity :: [[Int]]
identity n_plus_1 | n_plus_1 > 1 = fmap _alter_identity (identity n)
where n = n_plus_1 - 1
-- _alter_identity :: [[Int]] -> [[Int]]
identity n | n < 1 = Nothing
If you're unfamiliar with fmap, it's used here to unwrap/rewrap the Maybe value returned from the other call to identity.
I could do the same more verbosely as
identity n_plus_1 | n_plus_1 > 1 = case identity n of
Nothing -> Nothing
Just matrix -> Just (_alter_identity matrix)
where n = n_plus_1 - 1
Your approach in the comments attempts to construct the entire matrix row by row, which is also workable.
One way to implement that approach more directly is through a list comprehension.
List comprehensions make it easy to define new lists and lists of lists:
Prelude> [ i | i <- [0..4] ]
[0,1,2,3,4]
Prelude> [ [(i,j) | j <- [0..3]] | i <- [0..2] ]
[ [(0,0),(0,1),(0,2),(0,3)]
, [(1,0),(1,1),(1,2),(1,3)]
, [(2,0),(2,1),(2,2),(2,3)]
]
Above we can see that we can use a list comprehension to generate a matrix of coordinates - the value (i,j) shows up in the i'th row and the jth column.
List comprehensions allow you to place arbitrary expressions on the left-hand-side of the |, so I could do i + j instead of (i,j) to get a very different matrix:
Prelude> [ [i + j | j <- [0..3]] | i <- [0..2] ]
[ [0,1,2,3]
, [1,2,3,4]
, [2,3,4,5]
]
That's a rectangular matrix. A square matrix would use the same bounds for i and j.
If you were to use a list comprehension like that to create a square matrix, what expression would you put to the left hand side of the | to create the identity matrix? To put it another way, can you express the identity matrix's value at row i column j in terms of i and j?

In case one needs some iterative approach in Haskell, recursion is used. This means that we need to define base case(s) as well as inductive case(s).
There are two base cases here:
the value is less than or equal to zero, in that case the value is Nothing;
the case where the value is exactly one, in that case we return a Just with a 1×1 matrix:
1
There is one inductive case: in case the number is greater than 1, we first generate the identity matrix for n-1, and then we add row at the top and a column at the left:
1 0 0 0
0 1 0 0
0 0 1 0
0 0 0 1
this means we thus need to prepend all rows of the previous matrix with 0, and we prepend the matrix with a list that contains one 1 and n-1 zeros.
Let us first forget about the first base case (n is less than or equal to zero), and assume n is always strictly positive. In that case there is no need to wrap the value in a Maybe, so we first construct a function:
identity' :: Int -> Matrix Int
identity' = ...
so the base case is where the parameter is 1:
identity' 1 = ...
and the inductive case has shape:
identity' n = first_row : map prepend_zero (identity (n-1))
where first_row = ...
prepend_zero = ...
Now we can construct identity in terms of identity' by only once check whether the value is less than or equal to zero:
identity :: Int -> Maybe (Matrix Int)
identity n | n <= 0 = Nothing
| otherwise = Just (identity' n)
where identity' 1 = ...
identity' n = first_row : map prepend_zero (identity (n-1))
where first_row = ...
prepend_zero = ...
I leave the expressions (...) as an exercise that should probably be reasonable.

deconstructivism
identity n = splitEvery n $ (concat $ replicate (n-1) $ 1: replicate n 0)++[1]
proof without words
[[1,0,0,0,0],[0,1,0,0,0],[0,0,1,0,0],[0,0,0,1,0],[0,0,0,0,1]] ~
[1,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,1] ~
[1,0,0,0,0,0],[1,0,0,0,0,0],[1,0,0,0,0,0],[1,0,0,0,0,0] ++ [1] ~
[1,0,0,0,0,0]{4} ++ [1] ~
(1:[0]{5}){4} ++ [1]
you need to handle special cases (n<0 and n==1)

Related

Haskell tail recursion for Fibonacci sequence

So I am working on an assignment where I have to find the nth fibonacci number, and I came across this idea shown below, however this returns a list, and I would just like to return the final number, so for example fibo 3 would give me [0,1,1,2,3,5,8,13], except I just want 13 to return, is there any way I could do that? This is my first time using Haskell and I am sort of learning functional programming as well for the first time, any help is appreciated. Thanks
fibo :: Integral x => x -> [x]
fibo n = fiboHelper [0,1] 0 1 n
fiboHelper :: Integral x => [x]->x->x->x->[x]
fiboHelper l x y 0 = l
fiboHelper l x y n = fiboHelper (l ++ [y+x] ++ [y+x+y]) (x+y) (y+x+y) (n-1)
Yes, you can keep track of the last 2 steps as you go down the recursive stack.
fibo :: Integral x => x -> x
fibo a
| a < 3 = 1
| otherwise = go 2 1 1 where
go a' b' c'
| a' == a = c'
| otherwise = go (a'+1) (c') (b'+c')
On a side note, a very interesting way I learned to create an infinite list of Fibonacci numbers in Haskell is as follows:
fibs = 1 : scanl (+) 1 fibs
combining this with take and last you can achieve whatever solution you are looking for.
take 5 fibs
-- produces [1,1,2,3,5]
last $ take 5 fibs
-- produces 5
You can work with a helper function that contains two variables: the first and second item, and each
fibo :: (Integral a, Integral b) => a -> b
fibo 0 = 0
fibo n = fiboHelper 0 1 (n-1)
fiboHelper :: (Integral a, Integral b) => a -> a -> b -> a
fiboHelper si si1 n
| n <= 0 = si1
| otherwise = fiboHelper si1 (si+si1) (n-1)
This then produces:
Prelude> fibo 7
13
As for the algorithm in your question, usually appending at the right side of a list is not a good idea, since it runs in linear time with the size of the left operand. This thus means that your algorithm runs in O(n2) time. You can implement this as:
fibo :: (Integral a, Integral b) => a -> [b]
fibo 0 = [0]
fibo n = 0 : fiboHelper 0 1 (n-1)
fiboHelper :: (Integral a, Integral b) => a -> a -> b -> [a]
fiboHelper si si1 n
| n < 0 = []
| otherwise = si1 : fiboHelper si1 (si+si1) (n-1)
this will produce:
Prelude> fibo 7
[0,1,1,2,3,5,8,13]
Instead of a list, you only need to keep track of the last two Fibonacci numbers, so that you can add them together for the next iteration. The recurrence relation you want can be defined using
-- replace a and b with (a+b) and a, respectively, forgetting b.
helper a b n == fiboHelper (a+b) a (n-1)
helper a b 1 == a
helper _ b 0 == b
(The second case isn't strictly necessary, but avoids an unnecessary addition.)
As n gets smaller, the desired value "accumulates" in the second parameter, with the value when n == 0 being the final result.
Note that you can get different series by providing different initial values for a and b. For example, fibo = helper 1 0, while the Lucas numbers are defined by lucas = helper 1 2:
lucas 5 = helper 1 2 5
== helper 3 1 4
== helper 4 3 3
== helper 7 4 2
== helper 11 7 1
( == helper 18 11 0)
== 11

Convert a list of position,value tuples into a single list

I am writing some code to work with arbitrary radix numbers in haskell. They will be stored as lists of integers representing the digits.
I almost managed to get it working, but I have run into the problem of converting a list of tuples [(a_1,b_1),...,(a_n,b_n)] into a single list which is defined as follows:
for all i, L(a_i) = b_i.
if there is no i such that a_i = k, a(k)=0
In other words, this is a list of (position,value) pairs for values in an array. If a position does not have a corresponding value, it should be set to zero.
I have read this (https://wiki.haskell.org/How_to_work_on_lists) but I don't think any of these methods are suitable for this task.
baseN :: Integer -> Integer -> [Integer]
baseN n b = convert_digits (baseN_digits n b)
chunk :: (Integer, Integer) -> [Integer]
chunk (e,m) = m : (take (fromIntegral e) (repeat 0))
-- This is broken because the exponents don't count for each other's zeroes
convert_digits :: [(Integer,Integer)] -> [Integer]
convert_digits ((e,m):rest) = m : (take (fromIntegral (e)) (repeat 0))
convert_digits [] = []
-- Converts n to base b array form, where a tuple represents (exponent,digit).
-- This works, except it ignores digits which are zero. thus, I converted it to return (exponent, digit) pairs.
baseN_digits :: Integer -> Integer -> [(Integer,Integer)]
baseN_digits n b | n <= 0 = [] -- we're done.
| b <= 0 = [] -- garbage input.
| True = (e,m) : (baseN_digits (n-((b^e)*m)) b)
where e = (greedy n b 0) -- Exponent of highest digit
m = (get_coef n b e 1) -- the highest digit
-- Returns the exponent of the highest digit.
greedy :: Integer -> Integer -> Integer -> Integer
greedy n b e | n-(b^e) < 0 = (e-1) -- We have overshot so decrement.
| n-(b^e) == 0 = e -- We nailed it. No need to decrement.
| n-(b^e) > 0 = (greedy n b (e+1)) -- Not there yet.
-- Finds the multiplicity of the highest digit
get_coef :: Integer -> Integer -> Integer -> Integer -> Integer
get_coef n b e m | n - ((b^e)*m) < 0 = (m-1) -- We overshot so decrement.
| n - ((b^e)*m) == 0 = m -- Nailed it, no need to decrement.
| n - ((b^e)*m) > 0 = get_coef n b e (m+1) -- Not there yet.
You can call "baseN_digits n base" and it will give you the corresponding array of tuples which needs to be converted to the correct output
Here's something I threw together.
f = snd . foldr (\(e,n) (i,l') -> ( e , (n : replicate (e-i-1) 0) ++ l')) (-1,[])
f . map (fromIntegral *** fromIntegral) $ baseN_digits 50301020 10 = [5,0,3,0,1,0,2,0]
I think I understood your requirements (?)
EDIT:
Perhaps more naturally,
f xs = foldr (\(e,n) fl' i -> (replicate (i-e) 0) ++ (n : fl' (e-1))) (\i -> replicate (i+1) 0) xs 0

Haskell Decimal to Binary

I am trying to build a function that converts a Decimal(Int) into a Binary number.
Unfortunately other than in java it is not possible to divide an int by two in haskell.
I am very new to functional programming so the problem could be something trivial.
So far I could not find another solution to this problem but
here is my first try :
fromDecimal :: Int -> [Int]
fromDecimal 0 = [0]
fromDecimal n = if (mod n 2 == 0) then
do
0:fromDecimal(n/2)
else
do
1:fromDecimal(n/2)
I got an java implementation here which I did before :
public void fromDecimal(int decimal){
for (int i=0;i<values.length;i++){
if(decimal % 2 = 0)
values[i]=true ;
decimal = decimal/ 2;
else {values[i]= false;
} }
}
Hopefully this is going to help to find a solution!
There are some problems with your solution. First of all, I advise not to use do at all, until you understand what do does. Here we do not need do at all.
Unfortunately other than in java it is not possible to divide an int by two in haskell.
It actually is, but the / operator (which is in fact the (/) function), has type (/) :: Fractional a => a -> a -> a. An Int is not Fractional. You can perform integer division with div :: Integral a => a -> a -> a.
So then the code looks like:
fromDecimal :: Int -> [Int]
fromDecimal 0 = [0]
fromDecimal n = if (mod n 2 == 0) then 0:fromDecimal (div n 2) else 1:fromDecimal (div n 2)
But we can definitely make this more elegant. mod n 2 can only result in two outcomes: 0 and 1, and these are exactly the ones that we use at the left side of the (:) operator.
So we do not need to use an if-then-else at all:
fromDecimal :: Int -> [Int]
fromDecimal 0 = [0]
fromDecimal n = mod n 2 : fromDecimal (div n 2)
Likely this is still not exactly what you want: here we write the binary value such that the last element, is the most significant one. This function will add a tailing zero, which does not make a semantical difference (due to that order), but it is not elegant either.
We can define an function go that omits this zero, if the given value is not zero, like:
fromDecimal :: Int -> [Int]
fromDecimal 0 = [0]
fromDecimal n = go n
where go 0 = []
go k = mod k 2 : go (div k 2)
If we however want to write the most significant bit first (so in the same order as we write decimal numbers), then we have to reverse the outcome. We can do this by making use of an accumulator:
fromDecimal :: Int -> [Int]
fromDecimal 0 = [0]
fromDecimal n = go n []
where go 0 r = r
go k rs = go (div k 2) (mod k 2:rs)
You cannot / integers in Haskell – division is not defined in terms of integral numbers! For integral division use div function, but in your case more suitable would be divMod that comes with mod gratis.
Also, you are going to get reversed output, so you can reverse manually it after that, or use more memory-efficient version with accumulator:
decToBin :: Int -> [Int]
decToBin = go [] where
go acc 0 = acc
go acc n = let (d, m) = n `divMod` 2 in go (m : acc) d
go will give you an empty list for 0. You may add it manually if the list is empty:
decToBin = (\l -> if null l then [0] else l) . go [] where ...
Think through how your algorithm will work. It starts from 2⁰, so it will generate bits backward from how we ordinarily think of them, i.e., least-significant bit first. Your algorithm can represent non-negative binary integers only.
fromDecimal :: Int -> [Int]
fromDecimal d | d < 0 = error "Must be non-negative"
| d == 0 = [0]
| otherwise = reverse (go d)
where go 0 = []
go d = d `rem` 2 : go (d `div` 2)
In Haskell, when we generate a list in reverse, go ahead and do so but then reverse the result at the end. The reason for this is consing up a list (gluing new items at the head with :) has a constant cost and the reverse at the end has a linear cost — but appending with ++ has a quadratic cost.
Common Haskell style is to have a private inner loop named go that the outer function applies when it’s happy with its arguments. The base case is to terminate with the empty list when d reaches zero. Otherwise, we take the current remainder modulo 2 and then proceed with d halved and truncated.
Without the special case for zero, fromDecimal 0 would be the empty list rather than [0].
The binary numbers are usually strings and not really used in calculations.
Strings are also less complicated.
The pattern of binary numbers is like any other. It repeats but at a faster clip.
Only a small set is necessary to generate up to 256 (0-255) binary numbers.
The pattern can systematically be expanded for more.
The starting pattern is 4, 0-3
bd = ["00","01","10","11"]
The function to combine them into larger numbers is
d2b n = head.drop n $ [ d++e++f++g | d <- bd, e <- bd, f <- bd, g <- bd]
d2b 125
"01111101"
If it's not obvious how to expand, then
bd = ["000","001","010","011","100","101","110","111"]
Will give you up to 4096 binary digits (0-4095). All else stays the same.
If it's not obvious, the db2 function uses 4 pairs of binary numbers so 4 of the set. (2^8) - 1 or (2^12) - 1 is how many you get.
By the way, list comprehension are sugar coated do structures.
Generate the above patterns with
[ a++b | a <- ["0","1"], b <- ["0","1"] ]
["00","01","10","11"]
and
[ a++b++c | a <- ["0","1"], b <- ["0","1"], c <- ["0","1"] ]
["000","001","010","011","100","101","110","111"]
More generally, one pattern and one function may serve the purpose
b2 = ["0","1"]
b4 = [ a++b++c++d | a <- b2, b <- b2, c <- b2, d <- b2]
b4
["0000","0001","0010","0011","0100","0101","0110","0111","1000","1001","1010","1011","1100","1101","1110","1111"]
bb n = head.drop n $ [ a++b++c++d | a <- b4, b <- b4, c <- b4, d <- b4]
bb 32768
"1000000000000000"
bb 65535
"1111111111111111"
To calculate binary from decimal directly in Haskell using subtraction
cvtd n (x:xs) | x>n = 0:(cvtd n xs)
| n>x = 1:(cvtd (n-x) xs)
| True = 1:[0|f<-xs]
Use any number of bits you want, for example 10 bits.
cvtd 639 [2^e|e<-[9,8..0]]
[1,0,0,1,1,1,1,1,1,1]
import Data.List
dec2bin x =
reverse $ binstr $ unfoldr ndiv x
where
binstr = map (\x -> "01" !! x)
exch (a,b) = (b,a)
ndiv n =
case n of
0 -> Nothing
_ -> Just $ exch $ divMod n 2

How can you quickly map the indices of a banded matrix to a 1-dimensional array?

This is closely related to a the question: How to map the indexes of a matrix to a 1-dimensional array (C++)?
I need to assign a reversible index to each non-zero element in a banded matrix.
In the normal, full matrix it is easy to do:
|-------- 5 ---------|
Row ______________________ _ _
0 |0 1 2 3 4 | |
1 |5 6 7 8 9 | 4
2 |10 11 12 13 14| |
3 |15 16 17 18 19| _|_
|______________________|
Column 0 1 2 3 4
To find the array index we just use the following bijective formula:
matrix[ i ][ j ] = array[ i*m + j ]
In my case, we have a symmetrically banded matrix with some constraint on distance from the diagonal. For example, the following uses an upper and lower bound of 1:
|-------- 5 ---------|
Row ______________________ _ _
0 |0 1 X X X | |
1 |2 3 4 X X | 4
2 |X 5 6 7 X | |
3 |X X 8 9 10| _|_
|______________________|
Column 0 1 2 3 4
In this case, I want to assign an index position to each element within the bandwidth, and ignore everything outside. There are a couple of ways to do this, one of which is to create a list of all the acceptable indices ix's, and then use map lookups to quickly go back and forth between a (row,col) pair and a singular index:
ix's :: [(Int,Int)] -- List of all valid indices
lkup :: Map (Int,Int) Int
lkup = M.fromList $ zip ix's [0..]
rlkup :: Map Int (Int, Int)
rlkup = M.fromList $ zip [0..] ix's
fromTup :: (Int, Int) -> Int
fromTup tup = fromMaybe 0 $ M.lookup tup lkup
toTup :: Int -> (Int, Int)
toTup i = fromMaybe (0,0) $ M.lookup i rlkup
For large matrices, this leads to a huge number of map lookups, which causes a bottleneck. Is there a more efficient formula to translate between the valid addresses, k, and (row,col) pairs?
You might find it more straightforward to "waste" a few indexes at the beginning and end of the matrix, and so assign:
Row ______________________ _ _
0 (0) |1 2 X X X | |
1 |3 4 5 X X | 4
2 |X 6 7 8 X | |
3 |X X 9 10 11 | _|_
|______________________|
Column 0 1 2 3 4
where (0) is an ignored index.
This is similar to the band matrix representation used by the highly respected LAPACK library.
You just need to take care that the unused elements are properly ignored when performing operations where they might affect used elements. (For example, a fast fill routine can be written without regard to which elements are used or unused; but a matrix multiplication would need to take a little more more care.)
If you take this approach, then the bijections are pretty simple:
import Data.Char
import Data.Maybe
type Index = Int
-- |(row,col) coordinate: (0,0) is top level
type Coord = (Int, Int)
-- |Matrix dimensions: (rows, cols, edges) where edges gives
-- the count of auxiliary diagonals to *each side* of the main
-- diagonal (i.e., what you call the maximum distance), so the
-- total band width is 1+2*edges
type Dims = (Int, Int, Int)
-- |Get index for (row,col)
idx :: Dims -> Coord -> Index
idx (m, n, e) (i, j) = let w = 1+2*e in w*i+(j-i+e)
-- |Get (row,col) for index
ij :: Dims -> Index -> Coord
ij (m, n, e) idx = let w = 1+2*e
(i, j') = idx `quotRem` w
in (i, j'+i-e)
--
-- test code
--
showCoords :: Dims -> [(Coord, Char)] -> String
showCoords (m, n, _) cs =
unlines $
for [0..m-1] $ \i ->
for [0..n-1] $ \j ->
fromMaybe '.' $ lookup (i,j) cs
where for = flip map
test :: Dims -> IO ()
test dm#(m,n,_) = do
putStrLn $ "Testing " ++ show dm
let idxs = [0..]
-- get valid index/coordinates for this matrix
let cs = takeWhile (\(_, (i,j)) -> i<m || j<n)
$ filter (\(_, (i,j)) -> i>=0 && j>=0)
$ map (\ix -> (ix, ij dm ix)) idxs
-- prove the coordinates are right
putStr $ showCoords dm (map (\(ix, (i,j)) -> ((i,j), chr (ord 'A' + ix))) cs)
-- prove getIndex inverts getCoord
print $ all (\(ix, (i,j)) -> idx dm (i,j) == ix) cs
putStrLn ""
main = do test (4, 5, 1) -- your example
test (3, 8, 2) -- another example

Euler #4 with bigger domain

Consider the modified Euler problem #4 -- "Find the maximum palindromic number which is a product of two numbers between 100 and 9999."
rev :: Int -> Int
rev x = rev' x 0
rev' :: Int -> Int -> Int
rev' n r
| n == 0 = r
| otherwise = rev' (n `div` 10) (r * 10 + n `mod` 10)
pali :: Int -> Bool
pali x = x == rev x
main :: IO ()
main = print . maximum $ [ x*y | x <- nums, y <- nums, pali (x*y)]
where
nums = [9999,9998..100]
This Haskell solution using -O2 and ghc 7.4.1 takes about 18
seconds.
The similar C solution takes 0.1 second.
So Haskell is 180 times
slower. What's wrong with my solution? I assume that this type of
problems Haskell solves pretty well.
Appendix - analogue C solution:
#define A 100
#define B 9999
int ispali(int n)
{
int n0=n, k=0;
while (n>0) {
k = 10*k + n%10;
n /= 10;
}
return n0 == k;
}
int main(void)
{
int max = 0;
for (int i=B; i>=A; i--)
for (int j=B; j>=A; j--) {
if (i*j > max && ispali(i*j))
max = i*j; }
printf("%d\n", max);
}
The similar C solution
That is a common misconception.
Lists are not loops!
And using lists to emulate loops has performance implications unless the compiler is able to eliminate the list from the code.
If you want to compare apples to apples, write the Haskell structure more or less equivalent to a loop, a tail recursive worker (with strict accumulator, though often the compiler is smart enough to figure out the strictness by itself).
Now let's take a more detailed look. For comparison, the C, compiled with gcc -O3, takes ~0.08 seconds here, the original Haskell, compiled with ghc -O2 takes ~20.3 seconds, with ghc -O2 -fllvm ~19.9 seconds. Pretty terrible.
One mistake in the original code is to use div and mod. The C code uses the equivalent of quot and rem, which map to the machine division instructions and are faster than div and mod. For positive arguments, the semantics are the same, so whenever you know that the arguments are always non-negative, never use div and mod.
Changing that, the running time becomes ~15.4 seconds when compiling with the native code generator, and ~2.9 seconds when compiling with the LLVM backend.
The difference is due to the fact that even the machine division operations are quite slow, and LLVM replaces the division/remainder with a multiply-and-shift operation. Doing the same by hand for the native backend (actually, a slightly better replacement taking advantage of the fact that I know the arguments will always be non-negative) brings its time down to ~2.2 seconds.
We're getting closer, but are still a far cry from the C.
That is due to the lists. The code still builds a list of palindromes (and traverses a list of Ints for the two factors).
Since lists cannot contain unboxed elements, that means there is a lot of boxing and unboxing going on in the code, that takes time.
So let us eliminate the lists, and take a look at the result of translating the C to Haskell:
module Main (main) where
a :: Int
a = 100
b :: Int
b = 9999
ispali :: Int -> Bool
ispali n = go n 0
where
go 0 acc = acc == n
go m acc = go (m `quot` 10) (acc * 10 + (m `rem` 10))
maxpal :: Int
maxpal = go 0 b
where
go mx i
| i < a = mx
| otherwise = go (inner mx b) (i-1)
where
inner m j
| j < a = m
| p > m && ispali p = inner p (j-1)
| otherwise = inner m (j-1)
where
p = i*j
main :: IO ()
main = print maxpal
The nested loop is translated to two nested worker functions, we use an accumulator to store the largest palindrome found so far. Compiled with ghc -O2, that runs in ~0.18 seconds, with ghc -O2 -fllvm it runs in ~0.14 seconds (yes, LLVM is better at optimising loops than the native code generator).
Still not quite there, but a factor of about 2 isn't too bad.
Maybe some find the following where the loop is abstracted out more readable, the generated core is for all intents and purposes identical (modulo a switch of argument order), and the performance of course the same:
module Main (main) where
a :: Int
a = 100
b :: Int
b = 9999
ispali :: Int -> Bool
ispali n = go n 0
where
go 0 acc = acc == n
go m acc = go (m `quot` 10) (acc * 10 + (m `rem` 10))
downto :: Int -> Int -> a -> (a -> Int -> a) -> a
downto high low acc fun = go high acc
where
go i acc
| i < low = acc
| otherwise = go (i-1) (fun acc i)
maxpal :: Int
maxpal = downto b a 0 $ \m i ->
downto b a m $ \mx j ->
let p = i*j
in if mx < p && ispali p then p else mx
main :: IO ()
main = print maxpal
#axblount is at least partly right; the following modification makes the program run almost three times as fast as the original:
maxPalindrome = foldl f 0
where f a x | x > a && pali x = x
| otherwise = a
main :: IO ()
main = print . maxPalindrome $ [x * y | x <- nums, y <- nums]
where nums = [9999,9998..100]
That still leaves a factor 60 slowdown, though.
This is more true to what the C code is doing:
maxpali :: [Int] -> Int
maxpali xs = go xs 0
where
go [] m = m
go (x:xs) m = if x > m && pali(x) then go xs x else go xs m
main :: IO()
main = print . maxpali $ [ x*y | x <- nums, y <- nums ]
where nums = [9999,9998..100]
On my box this takes 2 seconds vs .5 for the C version.
Haskell may be storing that entire list [ x*y | x <- nums, y <- nums, pali (x*y)] where as the C solution calculates the maximum on the fly. I'm not sure about this.
Also the C solution will only calculate ispali if the product beats the previous maximum. I would bet Haskell calculates are palindrome products regardless of whether x*y is a possible max.
It seems to me that you are having a branch prediction problem. In the C code, you have two nested loops and as soon as a palindrome is seen in the inner loop, the rest of the inner loop will be skipped very fast.
The way you feed this list of products instead of the nested loops I am not sure that ghc is doing any of this prediction.
Another way to write this is to use two folds, instead of one fold over the flattened list:
-- foldl g0 0 [x*y | x<-[b-1,b-2..a], y<-[b-1,b-2..a], pali(x*y)] (A)
-- foldl g1 0 [x*y | x<-[b-1,b-2..a], y<-[b-1,b-2..a]] (B)
-- foldl g2 0 [ [x*y | y<-[b-1,b-2..a]] | x<-[b-1,b-2..a]] (C)
maxpal b a = foldl f1 0 [b-1,b-2..a] -- (D)
where
f1 m x = foldl f2 m [b-1,b-2..a]
where
f2 m y | p>m && pali p = p
| otherwise = m
where p = x*y
main = print $ maxpal 10000 100
Seems to run much faster than (B) (as in larsmans's answer), too (only 3x - 4x slower then the following loops-based code). Fusing foldl and enumFromThenTo definitions gets us the "functional loops" code (as in DanielFischer's answer),
maxpal_loops b a = f (b-1) 0 -- (E)
where
f x m | x < a = m
| otherwise = g (b-1) m
where
g y m | y < a = f (x-1) m
| p>m && pali p = g (y-1) p
| otherwise = g (y-1) m
where p = x*y
The (C) variant is very suggestive of further algorithmic improvements (that's outside the scope of the original Q of course) that exploit the hidden order in the lists, destroyed by the flattening:
{- foldl g2 0 [ [x*y | y<-[b-1,b-2..a]] | x<-[b-1,b-2..a]] (C)
foldl g2 0 [ [x*y | y<-[x, x-1..a]] | x<-[b-1,b-2..a]] (C1)
foldl g0 0 [ safehead 0 . filter pali $
[x*y | y<-[x, x-1..a]] | x<-[b-1,b-2..a]] (C2)
fst $ until ... (\(m,s)-> (max m .
safehead 0 . filter pali . takeWhile (> m) $
head s, tail s))
(0,[ [x*y | y<-[x, x-1..a]] | x<-[b-1,b-2..a]]) (C3)
safehead 0 $ filter pali $ mergeAllDescending
[ [x*y | y<-[x, x-1..a]] | x<-[b-1,b-2..a]] (C4)
-}
(C3) can stop as soon as the head x*y in a sub-list is smaller than the currently found maximum. It is what short-cutting functional loops code could achieve, but not (C4), which is guaranteed to find the maximal palindromic number first. Plus, for list-based code its algorithmic nature is more visually apparent, IMO.

Resources