How do I add the contents of a string? - string

Im am making a function which compares two strings to see if one is a rearrangement of the other. for example "hhe" and "heh" would produce true but "hhe" and "hee" would be false. I thought I could do this by summing the elements of the string and seeing if they are the same. I am knew to haskell, so I dont know if I can sum chars like in C. Code so far:
comp :: String -> String-> Bool
comp x y = (sum x) == (sum y)
This produces an error when compiling.

You can first sort, then compare the strings
import Data.List
import Data.Function
comp = (==) `on` sort
which can then be used like this
"abcd" `comp` "dcba" --yields True

It doesn't make sense to "sum" two strings. Use permutations instead:
comp :: String -> String -> Bool
comp x = (`elem` permutations x)
Live demo

Though there are problems with your implementation, as suggested by others, the direct answer to your question is that you can first convert characters to Int (a type that supports arithmetic) with fromEnum.
> sum . map fromEnum $ "heh"
309

Taking your example code at face value, the problem with it is that Char doesn't implement Num, so sum :: Num a => [a] -> a is incompatible.
We can fix that, however, by using fromEnum to convert the Chars to Ints:
isPermutationOf :: String -> String-> Bool
isPermutationOf x y = hash x == hash y
where hash = sum . map fromEnum
And this will work on your example case:
λ isPermutationOf "hhe" "heh"
True
The downside is that it also has some false positives:
λ isPermutationOf "AAA" "ab"
True
We can try to reduce those somewhat by making sure that the lengths, maxes, and mins of the inputs are the same:
isPermutationOf :: String -> String-> Bool
isPermutationOf x y = hash x == hash y && maximum x == maximum y && minimum x == minimum y
where hash = sum . map fromEnum
But though that catches some cases
λ isPermutationOf "AAA" "ab"
False
It doesn't catch them all
λ isPermutationOf "abyz" "acxz"
True
To do that, we really need to make sure we've got the same number of each Char in both inputs. We could solve this by using a Data.Map.Map to store the counts of each Char or by using Data.List.sort to sort each of the inputs, but if we only want to use the Prelude, we'll need to roll our own solution.
There's any number of examples on how to write quicksort in haskell out there, so I'm not going to tell you how to do that. So here's a dumb isPermutationOf that uses math instead.
isPermutationOf xs ys = all (\k -> powsum k as == powsum k bs) [0..n]
where as = map fromEnum xs
bs = map fromEnum ys
n = length xs
powsum k zs = sum (map (^k) zs)
Basically, we can view an n-length string as a set of n unknowns. isPermutationOf checks the n+1 equations:
eq0: x00 + x10 + ... + xn-10 = y00 + y10 + ... + ym-10
eq1: x01 + x11 + ... + xn-11 = y01 + y11 + ... + ym-11
eq2: x02 + x12 + ... + xn-12 = y02 + y12 + ... + ym-12
...
eqn: x0n + x1n + ... + xn-1n = y0n + y1n + ... + ym-1n
eq0 is essentially a length check. Given xs, the other n equations work out to n equations for n unknowns, which will give us a solution for ys unique up to permutation.
But really, you should use a (bucket) sort instead, because the above algorithm is O(n^2), which is slow for this kind of check.

if you do not want to use standard library(learning purpose) function, you can quickSort both string and check for equality of string (bonus: quickSort)
isEqual :: String -> String -> Bool
isEqual a b = sortString a == sortString b
where
sortString :: String -> String
sortString [] = []
sortString (x:xs) = sortString (filter (<x) xs) ++ [x] ++ sortString (filter (>=x) xs)

Related

Generate next lexicographical string in Haskell

If I was given a string like skhfbvqa, how would I generate the next string? For this example, it would be skhfbvqb, and the next string of that would be skhfbvqc, and so on. The given string (and the answer) will always be N characters long (in this case, N=8).
What I tried:
I tried to generate the entire (infinite) list of possible combinations, and get the required (next) string of the given string, but unsurprisingly, it's so slow, that I don't even get the answer for N=6.
I used list comprehension:
allStrings = [ c : s | s <- "" : allStrings, c <- ['a'..'z'] ]
main = do
input <- readFile "k.in"
putStrLn . head . tail . dropWhile (not . (==) input) . map reverse $ allStrings
(Please excuse my incredibly bad Haskell-ing :) Still a noob)
So my question is, how can I do this? If there are multiple methods, a comparison between them is much appreciated. Thanks!
Here's a version with base conversion (this way you could add and subtract arbitrarily if you like):
encode x base = encode' x [] where
encode' x' z | x' == 0 = z
| otherwise = encode' (div x' base) ((mod x' base):z)
decode num base =
fst $ foldr (\a (b,i) -> (b + a * base^i,i + 1)) (0,0) num
Output:
*Main> map (\x -> toEnum (x + 97)::Char)
$ encode (decode (map (\x -> fromEnum x - 97) "skhfbvqa") 26 + 1) 26
"skhfbvqb"
I would go and make a helper function f :: Integer -> String and one g :: String -> Integer, where f 1 = "a", ... f 27 = "aa", f 28 = "ab" and so on and the inverse g.
Then incrementString = f . succ . g
Note: I omitted the implementation of f on purpose for learning
Update
for a different approach you could define a increment with carry function inc' :: Char -> (Char, Bool), and then
incString :: String -> String
incString = reverse . incString'
where incString' [] = []
incString' (x:xs) = case inc' x of (x',True) -> x': incString' xs
(x',False) -> x':xs
Note: this function is not tail recursive!
I found this to work. It just uses pattern matching to see if the string begins with a z and adds an additional a accordingly.
incrementString' :: String -> String
incrementString' [] = ['a']
incrementString' ('z':xs) = 'a' : incrementString' xs
incrementString' (x:xs) = succ x : xs
incrementString :: String -> String
incrementString = reverse . incrementString' . reverse

Defining a Boolean function on Haskell that determines if an element occurs once in a list

So I'm trying to define a function in Haskell that if given an integer and a list of integers will give a 'true' or 'false' whether the integer occurs only once or not.
So far I've got:
let once :: Eq a => a -> [a] -> Bool; once x l =
But I haven't finished writing the code yet. I'm very new to Haskell as you may be able to tell.
Start off by using pattern matching:
once x [] =
once x (y:ys) =
This won't give you a good program immediately, but it will lead you in the right direction.
Here's a solution that doesn't use pattern matching explicitly. Instead, it keeps track of a Bool which represents if a occurance has already been found.
As others have pointed out, this is probably a homework problem, so I've intentionally left the then and else branches blank. I encourage user3482534 to experiment with this code and fill them in themselves.
once :: Eq a => a -> [a] -> Bool
once a = foldr f False
where f x b = if x == a then ??? else ???
Edit: The naive implementation I was originally thinking of was:
once :: Eq a => a -> [a] -> Bool
once a = foldr f False
where f x b = if x == a then b /= True else b
but this is incorrect as,
λ. once 'x' "xxx"
True
which should, of course, be False as 'x' occurs more than exactly once.
However, to show that it is possible to write once using a fold, here's a revised version that uses a custom monoid to keep track of how many times the element has occured:
import Data.List
import Data.Foldable
import Data.Monoid
data Occur = Zero | Once | Many
deriving Eq
instance Monoid Occur where
mempty = Zero
Zero `mappend` x = x
x `mappend` Zero = x
_ `mappend` _ = Many
once :: Eq a => a -> [a] -> Bool
once a = (==) Once . foldMap f
where f x = if x == a then Once else Zero
main = do
let xss = inits "xxxxx"
print $ map (once 'x') xss
which prints
[False,True,False,False,False]
as expected.
The structure of once is similar, but not identical, to the original.
I'll answer this as if it were a homework question since it looks like one.
Read about pattern matching in function declarations, especially when they give an example of processing a list. You'll use tools from Data.List later, but probably your professor is teaching about pattern matching.
Think about a function that maps values to a 1 or 0 depending on whethere there is a match ...
match :: a -> [a] -> [Int]
match x xs = map -- fill in the thing here such that
-- match 3 [1,2,3,4,5] == [0,0,1,0,0]
Note that there is the sum function that takes a list of numbers and returns the sum of the numbers in the list. So to count the matches a function can take the match function and return the counts.
countN :: a -> [a] -> Int
countN x xs = ? $ match x xs
And finally a function that exploits the countN function to check for a count of only 1. (==1).
Hope you can figure out the rest ...
You can filter the list and then check the length of the resulting list. If length == 1, you have only one occurrence of the given Integer:
once :: Eq a => a -> [a] -> Bool
once x = (== 1) . length . filter (== x)
For counting generally, with import Data.List (foldl'), pointfree
count pred = foldl' (\ n x -> if pred x then n + 1 else n) 0
applicable like
count (< 10) [1 .. 10] == 9
count (== 'l') "Hello" == 2
gives
once pred xs = count pred xs == 1
Efficient O(n) short-circuit predicated form, testing whether the predicate is satisfied exactly once:
once :: (a -> Bool) -> [a] -> Bool
once pred list = one list 0
where
one [] 1 = True
one [] _ = False
one _ 2 = False
one (x : xs) n | pred x = one xs (n + 1)
| otherwise = one xs n
Or, using any:
none pred = not . any pred
once :: (a -> Bool) -> [a] -> Bool
once _ [] = False
once pred (x : xs) | pred x = none pred xs
| otherwise = one pred xs
gives
elemOnce y = once (== y)
which
elemOnce 47 [1,1,2] == False
elemOnce 2 [1,1,2] == True
elemOnce 81 [81,81,2] == False

Convert Negative-base binary to Decimal in Haskell: "Instances of .. required"

I have to write two functions converting decimal numers into a (-2)adian number system (similar to binary only with -2) and vice versa.
I already have managed to get the decimal -> (-2)adian running.
But with (-2)adian -> decimal I have a problem and just don't know where to begin.
Hope you can Help me
type NegaBinary = String
-- Function (-2)adisch --> decimal
negbin_dezi :: NegaBinary -> Integer -> Integer
negbin_dezi (xs:x) n
| (x == 0) = if ([xs] == "") then 0 else (negbin_dezi [xs] (n+1))
| (x == 1) = if ([xs] == "") then (-2)**n else (-2)**n + (negbin_dezi [xs] (n+1))
It always throws:
"Instances of (Num [Char], Floating Integer) required for definition of negbin_dezi.
Anyone an idea why it wont work?
Please please please :)
You have your list pattern-matching syntax backwards. In _ : _ the first argument is the head of the list (one element), and the second is the tail of the list (another list). e.g. x:xs matched with "abc" gives x = 'a' xs = "bc". So xs:x should be x:xs. The reason for GHC asking for an instance of Num [Char], is the comparison x == 0 (and x == 1). In this, it is trying to match the type of x (String == [Char]) with the type of 0 (Num a => a), and to do this, it requires a Num instance for String.
The fix is: negbin_dezi (x:xs) n
The problem asking for an Floating Integer instance is because (**) has type Floating a => a -> a -> a, where as you want (^) which has type (Num a, Integral b) => a -> b -> a (i.e. it is restricted to integer powers.)
Once you've done this, you'll find that your algorithm doesn't work for a few reasons:
The number 0 is different to the character '0', you should be comparing x with the characters '0' and '1' rather than the numbers 0 and 1.
xs is already a string, so [xs] is a list containing a string, which isn't what you want. This is fixed by removing the square brackets.
Possibly the ordering of the reduction is wrong.
On a different note, the duplicated if statement suggests that there is some optimisations that could happen with your code. Specifically, if you handle the empty string as part of negbin_dezi then you won't have to special case it. You could write it something like
negbin_dezi "" _ = 0
negbin_dezi (x:xs) n
| n == '0' = negbin_dezi xs (n+1)
| n == '1' = (-2)^n + negbin_dezi
(This has the bonus of meaning that the function is "more total", i.e. it is defined on more inputs.)
A few more things:
The code is "stringly-typed": your data is being represented as a string, despite having more structure. A list of booleans ([Bool]) would be much better.
The algorithm can be adapted to be cleaner. For the following, I'm assuming you are storing it like "01" = -2 "001" = 4, etc. If so, then we know that number = a + (-2) * b + (-2)^2 * c ... = a + (-2) * (b + (-2) * (c + ...)) where a,b,c,... are the digits. Looking at this, we can see the stuff inside the brackets is actually the same as the whole expression, just starting at the second digit. This is easy to express in Haskell (I'm using the list-of-bools idea.):
negbin [] = 0
negbin (x:xs) = (if x then 1 else 0) + (-2) * negbin xs
And that's the whole thing. If you aren't storing it in that order, then a call to reverse fixes that! (Being really tricky, one could write
negbin = foldr (\x n -> (if x then 1 else 0) + (-2)*n) 0
)
Some problems:
x == 0 or x == 1, but x is a Char, so you mean x == '0'.
You write (xs:x). There's no pattern for matching at the end of a list. Perhaps use a helper function that reverses the list first.
[xs] has one element, and will never be "". Use a base case instead.
Pattern matching is more helpful than equality checking.
** is for floating point powers, ^ is for integer powers
You often use [xs] where you mean xs. You don't need to put square brackets to make a list.
Here's a rewrite that works:
negbin_dezi1 :: NegaBinary -> Integer
negbin_dezi1 xs = negbin (reverse xs) 0
negbin [] _ = 0
negbin (x:xs) n
| x == '0' = negbin xs (n+1)
| x == '1' = (-2)^n + (negbin xs (n+1))
It would be nicer to use pattern matching:
negbin_dezi2 :: NegaBinary -> Integer
negbin_dezi2 xs = negbin (reverse xs) 0 where
negbin [] _ = 0
negbin ('0':xs) n = negbin xs (n+1)
negbin ('1':xs) n = (-2)^n + negbin xs (n+1)
But maybe it would be nicer to convert '0' to 0 and '1' to 1 and just multiply by that:
val :: Char -> Int
val '0' = 0
val '1' = 1
negbin_dezi3 :: NegaBinary -> Integer
negbin_dezi3 xs = negbin (reverse xs) 0 where
negbin [] _ = 0
negbin (x:xs) n = val x * (-2)^n + negbin xs (n+1)
I'd not write it that way, though:
A completely different approach is to think about the whole thing at once.
"10010" -rev> [0,1,0,0,1] -means> [ 0, 1, 0, 0, 1 ]
[(-2)^0, (-2)^1, (-2)^2, (-2)^3, (-2)^4]
so let's make both lists
powers = [(-2)^n | n <- [0..]]
coefficients = reverse.map val $ xs
and multiply them
zipWith (*) powers coefficients
then add up, giving:
negbin_dezi4 xs = sum $ zipWith (*) powers coefficients
where powers = [(-2)^n | n <- [0..]]
coefficients = reverse.map val $ xs
You could rewrite powers as map ((-2)^) [0..],
or even nicer: powers = 1:map ((-2)*) powers.
(It's nicer because it reuses previous calculations and is pleasantly clean.)
this
convB2D::NegaBinary->Integer
convB2D xs|(length xs)==0 =0
|b=='0' = convB2D(drop 1 xs)
|b=='1' = val+convB2D(drop 1 xs)
|otherwise= error "invalid character "
where b=head xs
val=(-2)^((length xs)-1)
worked for me.
I on the other hand have problems to convert dec->nbin :D

What can be improved on my first haskell program?

Here is my first Haskell program. What parts would you write in a better way?
-- Multiplication table
-- Returns n*n multiplication table in base b
import Text.Printf
import Data.List
import Data.Char
-- Returns n*n multiplication table in base b
mulTable :: Int -> Int -> String
mulTable n b = foldl (++) (verticalHeader n b w) (map (line n b w) [0..n])
where
lo = 2* (logBase (fromIntegral b) (fromIntegral n))
w = 1+fromInteger (floor lo)
verticalHeader :: Int -> Int -> Int -> String
verticalHeader n b w = (foldl (++) tableHeader columnHeaders)
++ "\n"
++ minusSignLine
++ "\n"
where
tableHeader = replicate (w+2) ' '
columnHeaders = map (horizontalHeader b w) [0..n]
minusSignLine = concat ( replicate ((w+1)* (n+2)) "-" )
horizontalHeader :: Int -> Int -> Int -> String
horizontalHeader b w i = format i b w
line :: Int -> Int -> Int -> Int -> String
line n b w y = (foldl (++) ((format y b w) ++ "|" )
(map (element b w y) [0..n])) ++ "\n"
element :: Int -> Int -> Int -> Int -> String
element b w y x = format (y * x) b w
toBase :: Int -> Int -> [Int]
toBase b v = toBase' [] v where
toBase' a 0 = a
toBase' a v = toBase' (r:a) q where (q,r) = v `divMod` b
toAlphaDigits :: [Int] -> String
toAlphaDigits = map convert where
convert n | n < 10 = chr (n + ord '0')
| otherwise = chr (n + ord 'a' - 10)
format :: Int -> Int -> Int -> String
format v b w = concat spaces ++ digits ++ " "
where
digits = if v == 0
then "0"
else toAlphaDigits ( toBase b v )
l = length digits
spaceCount = if (l > w) then 0 else (w-l)
spaces = replicate spaceCount " "
Here are some suggestions:
To make the tabularity of the computation more obvious, I would pass the list [0..n] to the line function rather than passing n.
I would further split out the computation of the horizontal and vertical axes so that they are passed as arguments to mulTable rather than computed there.
Haskell is higher-order, and almost none of the computation has to do with multiplication. So I would change the name of mulTable to binopTable and pass the actual multiplication in as a parameter.
Finally, the formatting of individual numbers is repetitious. Why not pass \x -> format x b w as a parameter, eliminating the need for b and w?
The net effect of the changes I am suggesting is that you build a general higher-order function for creating tables for binary operators. Its type becomes something like
binopTable :: (i -> String) -> (i -> i -> i) -> [i] -> [i] -> String
and you wind up with a much more reusable function—for example, Boolean truth tables should be a piece of cake.
Higher-order and reusable is the Haskell Way.
You don't use anything from import Text.Printf.
Stylistically, you use more parentheses than necessary. Haskellers tend to find code more readable when it's cleaned of extraneous stuff like that. Instead of something like h x = f (g x), write h = f . g.
Nothing here really requires Int; (Integral a) => a ought to do.
foldl (++) x xs == concat $ x : xs: I trust the built-in concat to work better than your implementation.
Also, you should prefer foldr when the function is lazy in its second argument, as (++) is – because Haskell is lazy, this reduces stack space (and also works on infinite lists).
Also, unwords and unlines are shortcuts for intercalate " " and concat . map (++ "\n") respectively, i.e. "join with spaces" and "join with newlines (plus trailing newline)"; you can replace a couple things by those.
Unless you use big numbers, w = length $ takeWhile (<= n) $ iterate (* b) 1 is probably faster. Or, in the case of a lazy programmer, let w = length $ toBase b n.
concat ( (replicate ((w+1)* (n+2)) "-" ) == replicate ((w+1) * (n+2)) '-' – not sure how you missed this one, you got it right just a couple lines up.
You do the same thing with concat spaces, too. However, wouldn't it be easier to actually use the Text.Printf import and write printf "%*s " w digits?
Norman Ramsey gave excellent high-level (design) suggestions; Below are some low-level ones:
First, consult with HLint. HLint is a friendly program that gives you rudimentary advice on how to improve your Haskell code!
In your case HLint gives 7 suggestions. (mostly about redundant brackets)
Modify your code according to HLint's suggestions until it likes what you feed it.
More HLint-like stuff:
concat (replicate i "-"). Why not replicate i '-'?
Consult with Hoogle whenever there is reason to believe that a function you need is already available in Haskell's libraries. Haskell comes with tons of useful functions so Hoogle should come in handy quite often.
Need to concatenate strings? Search for [String] -> String, and voila you found concat. Now go replace all those folds.
The previous search also suggested unlines. Actually, this even better suits your needs. It's magic!
Optional: pause and thank in your heart to Neil M for making Hoogle and HLint, and thank others for making other good stuff like Haskell, bridges, tennis balls, and sanitation.
Now, for every function that takes several arguments of the same type, make it clear which means what, by giving them descriptive names. This is better than comments, but you can still use both.
So
-- Returns n*n multiplication table in base b
mulTable :: Int -> Int -> String
mulTable n b =
becomes
mulTable :: Int -> Int -> String
mulTable size base =
To soften the extra characters blow of the previous suggestion: When a function is only used once, and is not very useful by itself, put it inside its caller's scope in its where clause, where it could use the callers' variables, saving you the need to pass everything to it.
So
line :: Int -> Int -> Int -> Int -> String
line n b w y =
concat
$ format y b w
: "|"
: map (element b w y) [0 .. n]
element :: Int -> Int -> Int -> Int -> String
element b w y x = format (y * x) b w
becomes
line :: Int -> Int -> Int -> Int -> String
line n b w y =
concat
$ format y b w
: "|"
: map element [0 .. n]
where
element x = format (y * x) b w
You can even move line into mulTable's where clause; imho, you should.
If you find a where clause nested inside another where clause troubling, then I suggest to change your indentation habits. My recommendation is to use consistent indentation of always 2 or always 4 spaces. Then you can easily see, everywhere, where the where in the other where is at. ok
Below's what it looks like (with a few other changes in style):
import Data.List
import Data.Char
mulTable :: Int -> Int -> String
mulTable size base =
unlines $
[ vertHeaders
, minusSignsLine
] ++ map line [0 .. size]
where
vertHeaders =
concat
$ replicate (cellWidth + 2) ' '
: map horizontalHeader [0 .. size]
horizontalHeader i = format i base cellWidth
minusSignsLine = replicate ((cellWidth + 1) * (size + 2)) '-'
cellWidth = length $ toBase base (size * size)
line y =
concat
$ format y base cellWidth
: "|"
: map element [0 .. size]
where
element x = format (y * x) base cellWidth
toBase :: Integral i => i -> i -> [i]
toBase base
= reverse
. map (`mod` base)
. takeWhile (> 0)
. iterate (`div` base)
toAlphaDigit :: Int -> Char
toAlphaDigit n
| n < 10 = chr (n + ord '0')
| otherwise = chr (n + ord 'a' - 10)
format :: Int -> Int -> Int -> String
format v b w =
spaces ++ digits ++ " "
where
digits
| v == 0 = "0"
| otherwise = map toAlphaDigit (toBase b v)
spaces = replicate (w - length digits) ' '
0) add a main function :-) at least rudimentary
import System.Environment (getArgs)
import Control.Monad (liftM)
main :: IO ()
main = do
args <- liftM (map read) $ getArgs
case args of
(n:b:_) -> putStrLn $ mulTable n b
_ -> putStrLn "usage: nntable n base"
1) run ghc or runhaskell with -Wall; run through hlint.
While hlint doesn't suggest anything special here (only some redundant brackets), ghc will tell you that you don't actually need Text.Printf here...
2) try running it with base = 1 or base = 0 or base = -1
If you want multiline comments use:
{- A multiline
comment -}
Also, never use foldl, use foldl' instead, in cases where you are dealing with large lists which must be folded. It is more memory efficient.
A brief comments saying what each function does, its arguments and return value, is always good. I had to read the code pretty carefully to fully make sense of it.
Some would say if you do that, explicit type signatures may not be required. That's an aesthetic question, I don't have a strong opinion on it.
One minor caveat: if you do remove the type signatures, you'll automatically get the polymorphic Integral support ephemient mentioned, but you will still need one around toAlphaDigits because of the infamous "monomorphism restriction."

Comparing 3 output lists in haskell

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.

Resources