I hope this works by just pasting and running it with "runghc euler4.hs 1000". Since I am having a hard time learning Haskell, can someone perhaps tell me how I could improve here? Especially all those "fromIntegral" are a mess.
module Main where
import System.Environment
main :: IO ()
main = do
args <- getArgs
let
hBound = read (args !! 0)::Int
squarePal = pal hBound
lBound = floor $ fromIntegral squarePal /
(fromIntegral hBound / fromIntegral squarePal)
euler = maximum $ takeWhile (>squarePal) [ x | y <- [lBound..hBound],
z <- [y..hBound],
let x = y * z,
let s = show x,
s == reverse s ]
putStrLn $ show euler
pal :: Int -> Int
pal n
| show pow == reverse (show pow) = n
| otherwise = pal (n-1)
where
pow = n^2
If what you want is integer division, you should use div instead of converting back and forth to Integral in order to use ordinary /.
module Main where
import System.Environment
main :: IO ()
main = do
(arg:_) <- getArgs
let
hBound = read arg :: Int
squarePal = pal hBound
lBound = squarePal * squarePal `div` hBound
euler = maximum $ takeWhile (>squarePal) [ x | y <- [lBound..hBound],
z <- [y..hBound],
let x = y * z,
let s = show x,
s == reverse s ]
print euler
pal :: Int -> Int
pal n
| show pow == reverse (show pow) = n
| otherwise = pal (n - 1)
where
pow = n * n
(I've re-written the lbound expression, that used two /, and fixed some styling issues highlighted by hlint.)
Okay, couple of things:
First, it might be better to pass in a lower bound and an upper bound for this question, it makes it a little bit more expandable.
If you're only going to use the first two (one in your previous case) arguments from the CL, we can handle this with pattern matching easily and avoid yucky statements like (args !! 0):
(arg0:arg1:_) <- getArgs
Let's convert these to Ints:
let [a, b] = map (\x -> read x :: Int) [arg0,arg1]
Now we can reference a and b, our upper and lower bounds.
Next, let's make a function that runs through all of the numbers between an upper and lower bound and gets a list of their products:
products a b = [x*y | x <- [a..b], y <- [x..b]]
We do not have to run over each number twice, so we start x at our current y to get all of the different products.
from here, we'll want to make a method that filters out non-palindromes in some data set:
palindromes xs = filter palindrome xs
where palindrome x = show x == reverse $ show x
finally, in our main function:
print . maximum . palindromes $ products a b
Here's the full code if you would like to review it:
import System.Environment
main = do
(arg0:arg1:_) <- getArgs
let [a, b] = map (\x -> read x :: Int) [arg0,arg1]
print . maximum . palindromes $ products a b
products a b = [x*y | x <- [a..b], y <- [x..b]]
palindromes = filter palindrome
where palindrome x = (show x) == (reverse $ show x)
Related
import Data.List (intercalate)
import Control.Concurrent (threadDelay)
import System.IO
-- I love how amazingly concise Haskell code can be. This same program in C, C++ or Java
-- would be at least twice as long.
pascal :: Int -> Int -> Int
pascal row col | col >= 0 && col <= row =
if row == 0 || col == 0 || row == col
then 1
else pascal (row - 1) (col - 1) + pascal (row - 1) col
pascal _ _ = 0
pascalsTriangle :: Int -> [[Int]]
pascalsTriangle rows =
[[pascal row col | col <- [0..row]] | row <- [0..rows]]
main :: IO ()
main = do
putStrLn ""
putStr "Starting at row #0, how many rows of Pascal's Triangle do you want to print out? "
hFlush stdout
numRows <- (\s -> read s :: Int) <$> getLine
let triangle = pascalsTriangle numRows
triangleOfStrings = map (intercalate ", ") $ map (map show) triangle
lengthOfLastDiv2 = div ((length . last) triangleOfStrings) 2
putStrLn ""
mapM_ (\s -> let spaces = [' ' | x <- [1 .. lengthOfLastDiv2 - div (length s) 2]]
in (putStrLn $ spaces ++ s) >> threadDelay 200000) triangleOfStrings
putStrLn ""
My little program above finds the values of Pascal's Triangle. But if you compile it and use it you'll see that the "triangle" looks more like a Christmas tree than a triangle! Ouch!
I'm just taking half the length of the last line and subtracting from that half the length of each preceding line, and creating that many blank spaces to add to the beginning of each string. It ALMOST works, but I'm looking for an equilateral triangle type of effect, but to me it resembles a sloping Christmas tree! Is there a better way to do this. What am I missing besides some programming talent?! Thanks for the help. THIS IS NOT A HOMEWORK ASSIGNMENT. I'm just doing this for fun and recreation. I appreciate the help.
Best.
Douglas Lewit.
Here's a straightforward implementation:
space n = replicate n ' '
pad n s | n < length s = take n s
pad n s = space (n - length s) ++ s
triangle = iterate (\ xs -> zipWith (+) (xs ++ [0]) (0:xs)) [1]
rowPrint n hw xs = space (n * hw) ++ concatMap (pad (2*hw) . show) xs
triRows n hw = [rowPrint (n-i) hw row | (i,row) <- zip [1..n] triangle]
main = do
s <- getLine
mapM_ putStrLn (triRows (read s) 2)
Note that triangle is an infinite Pascal's triangle, generated by the recurrence relation. Also, hw stands for "half-width": half the width allocated for printing a number, and pad is a strict left-pad that truncates the output rather than disrupt the formatting.
I'm trying to print out my 2d array in game of life, but i'm not quite sure how to go on with it. So I need some help with my printArray function I'm not quite sure how to proceed. Her is the code below, everything is working.. Except printing it out in the right manner.
module GameOfLife where
import Data.List
import System.IO
import Text.Show
import Data.Array
import System.Random
width :: Int
width = 5
height :: Int
height = 5
data State = Alive | Dead deriving (Eq, Show)
type Pos = (Int,Int)
type Board = Array Pos State
startBoard :: Pos -> Board
startBoard (width,height) =
let bounds = ((0,0),(width - 1,height - 1))
in array bounds $ zip (range bounds) (repeat Dead)
set :: Board -> [(Pos,State)] -> Board
set = (//)
get :: Board -> [Pos] -> [State]
get board pos = map (board!) pos
neighbours :: Board -> Pos -> [Pos]
neighbours board c#(x,y) =
filter (/= c) $ filter (inRange (bounds board)) [(x',y') | x' <- [x -
1..x + 1], y' <- [y - 1..y + 1]]
nextGen :: Board -> Board
nextGen board =(irrelevant code for the question..)
printArray :: Board -> String
printArray arr =
unlines [unwords [show (arr ! (x, y)) | x <- [1..5]] | y <- [1..5]]
My output:
[((0,0),Dead),((0,1),Dead),((0,2),Dead),((0,3),Dead),((1,0),Dead),
((1,1),Dead),((1,2),Dead),((1,3),Dead),((2,0),Dead),((2,1),Dead),
((2,2),Dead)2,3),Dead)]
My preferable output:
1 2 3 4 5
1 . . . . .
2 n n n . .
3 n X n . .
4 n n n . .
5 . . . . .
To start to answer your question, I suggest breaking the problem into several pieces:
Print out the numbers across the top.
Number each row as you print them.
Decide what symbol to print in each cell.
Tackle each of these pieces one at a time. If it helps, rather than think in terms of "printing" just build up a String object. Once you have a String, printing is pretty trivial.
Hi i am trying to learn haskell and compare its performance to other languages
when i run the following code..
module BST (
Tree,
singletonTree,
insert,
member
) where
import System.IO
import System.IO.Error hiding (try)
import Control.Exception
import Data.Char
import System.CPUTime
--
-- Take the string and convert it to a list of numbers
--
trim = f . f
where f = reverse . dropWhile isSpace
fromDigits = foldl addDigit 0
where addDigit num d = 10*num+d
strToInt str = fromDigits (map digitToInt str)
split_comma "" = []
split_comma input =
let (a,b) = break (\x->x==',') input in
[(trim a)]++(split_comma (drop 1 b))
make_int_list input =map strToInt (split_comma input)
-- end of converting string to integers
data Tree a = EmptyTree | Node a (Tree a)(Tree a) deriving (Show)
singletonTree :: a -> Tree a
singletonTree x = Node x EmptyTree EmptyTree
insert :: Ord a => a -> Tree a -> Tree a
insert x EmptyTree = singletonTree x
insert x (Node root left right)
| x < root = Node root (insert x left) (right)
| x > root = Node root (left) (insert x right)
| x == root = Node root (Node x left EmptyTree) (right)
member :: Ord a => a -> Tree a -> Bool
member x EmptyTree = False
member x (Node n left right)
| x == n = True
| x < n = member x left
| x > n = member x right
---A test function to do the timing
test_func input_list =do
startTime <- getCPUTime
--Note: If you don't use any results haskell won't even run the code
-- if you just mergesrt here (uncomment next line) instead of print
-- return (let tree = foldr insert EmptyTree )
-- then it will always take 0 seconds since it won't actually sort!
let tree = foldr insert EmptyTree input_list
prin(tree)
finishTime <- getCPUTime
return $ fromIntegral (finishTime - startTime) / 1000000000000
main :: IO ()
main = do
inh <- openFile "random_numbers.txt" ReadMode
mainloop inh
hClose inh
--Read in my file and run test_func on input
mainloop :: Handle -> IO ()
mainloop inh =
do input <- try (hGetLine inh)
case input of
Left e ->
if isEOFError e
then return ()
else ioError e
Right inpStr ->
do
let my_list = make_int_list inpStr;
my_time <- test_func my_list
putStrLn ("Execution time in Sections: ")
print(my_time);
return ();
when attempting to run this code i get
Prelude> :load "bst.hs"
[1 of 1] Compiling BST ( bst.hs, interpreted )
bst.hs:83:29: parse error on input `<-'
Failed, modules loaded: none.
i have exhausted my knowledge of haskell. I tried moving the module statements to both before and after the includes but neither help. I have used both the bst and the timing code separately but combined is causing error
random_numbers.txt is a list of comma separated values.
The last do block is not formatted correctly. Here is a diff:
## -78,9 +78,7 ##
then return ()
else ioError e
Right inpStr ->
- do
- let my_list = make_int_list inpStr;
- my_time <- test_func my_list
- putStrLn ("Execution time in Sections: ")
- print(my_time);
- return ();
+ do let my_list = make_int_list inpStr;
+ my_time <- test_func my_list
+ putStrLn("Execution time in Sections: ")
+ print(my_time)
Notes:
I am not using tabs anywhere in the source; I have a feeling your source uses tabs. My advice is to avoid tabs in Haskell source.
You do not need parens to call functions - putStrLn "..." and print my_time will work
Also, prin(tree) earlier should be print(tree) but is more commonly written print tree - the parens are not needed.
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.
I am doing another Project Euler problem and I need to find when the result of these 3 lists is equal (we are given 40755 as the first time they are equal, I need to find the next:
hexag n = [ n*(2*n-1) | n <- [40755..]]
penta n = [ n*(3*n-1)/2 | n <- [40755..]]
trian n = [ n*(n+1)/2 | n <- [40755..]]
I tried adding in the other lists as predicates of the first list, but that didn't work:
hexag n = [ n*(2*n-1) | n <- [40755..], penta n == n, trian n == n]
I am stuck as to where to to go from here.
I tried graphing the function and even calculus but to no avail, so I must resort to a Haskell solution.
Your functions are weird. They get n and then ignore it?
You also have a confusion between function's inputs and outputs. The 40755th hexagonal number is 3321899295, not 40755.
If you really want a spoiler to the problem (but doesn't that miss the point?):
binarySearch :: Integral a => (a -> Bool) -> a -> a -> a
binarySearch func low high
| low == high = low
| func mid = search low mid
| otherwise = search (mid + 1) high
where
search = binarySearch func
mid = (low+high) `div` 2
infiniteBinarySearch :: Integral a => (a -> Bool) -> a
infiniteBinarySearch func =
binarySearch func ((lim+1) `div` 2) lim
where
lim = head . filter func . lims $ 0
lims x = x:lims (2*x+1)
inIncreasingSerie :: (Ord a, Integral i) => (i -> a) -> a -> Bool
inIncreasingSerie func val =
val == func (infiniteBinarySearch ((>= val) . func))
figureNum :: Integer -> Integer -> Integer
figureNum shape index = (index*((shape-2)*index+4-shape)) `div` 2
main :: IO ()
main =
print . head . filter r $ map (figureNum 6) [144..]
where
r x = inIncreasingSerie (figureNum 5) x && inIncreasingSerie (figureNum 3) x
Here's a simple, direct answer to exactly the question you gave:
*Main> take 1 $ filter (\(x,y,z) -> (x == y) && (y == z)) $ zip3 [1,2,3] [4,2,6] [8,2,9]
[(2,2,2)]
Of course, yairchu's answer might be more useful in actually solving the Euler question :)
There's at least a couple ways you can do this.
You could look at the first item, and compare the rest of the items to it:
Prelude> (\x -> all (== (head x)) $ tail x) [ [1,2,3], [1,2,3], [4,5,6] ]
False
Prelude> (\x -> all (== (head x)) $ tail x) [ [1,2,3], [1,2,3], [1,2,3] ]
True
Or you could make an explicitly recursive function similar to the previous:
-- test.hs
f [] = True
f (x:xs) = f' x xs where
f' orig (y:ys) = if orig == y then f' orig ys else False
f' _ [] = True
Prelude> :l test.hs
[1 of 1] Compiling Main ( test.hs, interpreted )
Ok, modules loaded: Main.
*Main> f [ [1,2,3], [1,2,3], [1,2,3] ]
True
*Main> f [ [1,2,3], [1,2,3], [4,5,6] ]
False
You could also do a takeWhile and compare the length of the returned list, but that would be neither efficient nor typically Haskell.
Oops, just saw that didn't answer your question at all. Marking this as CW in case anyone stumbles upon your question via Google.
The easiest way is to respecify your problem slightly
Rather than deal with three lists (note the removal of the superfluous n argument):
hexag = [ n*(2*n-1) | n <- [40755..]]
penta = [ n*(3*n-1)/2 | n <- [40755..]]
trian = [ n*(n+1)/2 | n <- [40755..]]
You could, for instance generate one list:
matches :: [Int]
matches = matches' 40755
matches' :: Int -> [Int]
matches' n
| hex == pen && pen == tri = n : matches (n + 1)
| otherwise = matches (n + 1) where
hex = n*(2*n-1)
pen = n*(3*n-1)/2
tri = n*(n+1)/2
Now, you could then try to optimize this for performance by noticing recurrences. For instance when computing the next match at (n + 1):
(n+1)*(n+2)/2 - n*(n+1)/2 = n + 1
so you could just add (n + 1) to the previous tri to obtain the new tri value.
Similar algebraic simplifications can be applied to the other two functions, and you can carry all of them in accumulating parameters to the function matches'.
That said, there are more efficient ways to tackle this problem.