Implementing Backtracking on Haskell - haskell

I have a problem making Backtracking on Haskell, I know how to do recursive functions but I get troubles when I try to get multiple solutions or the best one (backtracking).
There's a list with some strings, then I need to get the solutions to get from a string to another one changing one letter from the string, I will get the list, the first string and the last one. If there is solution return the count of steps that it did, if there is not solution it returns -1. here's an example:
wordF ["spice","stick","smice","stock","slice","slick","stock"] "spice" "stock"
Then I have my list and I need to start with "spice" and get to "stock"
and the best solution is ["spice","slice","slick","stick","stock"] with four steps to get from "spice" to "stock". then it return 4.
Another solution is ["spice","smice","slice","slick","stick","stock"] with five steps to get to "stock" then it return `5. But this is a wrong solution because there's another one that's better with lesser steps than this one.
I'm having troubles making a backtracking to get the best solution, because I don't know how to make that my code search another solutions and just not one..
Here's a code that i tried to make but i get some errors, btw i dont know if my way to "make" backtracking is good or if there are some mistakes that im not seeing..
wordF :: [String] -> String -> String -> (String, String, Int)
wordF [] a b = (a, b, -1)
wordF list a b | (notElem a list || notElem b list) = (a, b, -1)
| otherwise = (a, b, (wordF2 list a b [a] 0 (length list)))
wordF2 :: [String] -> String -> String -> [String] -> Int -> Int -> Int
wordF2 list a b list_aux cont maxi | (cont==maxi) = 1000
| (a==b) = length list_aux
| (a/=b) && (cont<maxi) && notElemFound && (checkin /= "ThisWRONG") && (wording1<=wording2) = wording1
| (a/=b) && (cont<maxi) && notElemFound && (checkin /= "ThisWRONG") && (wording1>wording2) = wording2
| (a/=b) && (checkin == "ThisWRONG") = wordF2 list a b list_aux (cont+1) maxi
where
checkin = (check_word2 a (list!!cont) (list!!cont) 0)
wording1 = (wordF2 list checkin b (list_aux++[checkin]) 0 maxi)
wording2 = (wordF2 list checkin b (list_aux++[checkin]) 1 maxi)
notElemFound = ((any (==(list!!cont)) list_aux) == False)
check_word2 :: String -> String -> String -> Int -> String
check_word2 word1 word2 word3 dif | (dif > 1) = "ThisWRONG"
| ((length word1 == 1) && (length word2 == 1) && (head word1 == head word2)) = word3
| ((length word1 == 1) && (length word2 == 1) && (head word1 /= head word2) && (dif<1)) = word3
| ((head word1) == (head word2)) = check_word2 (tail word1) (tail word2) word3 dif
| otherwise = check_word2 (tail word1) (tail word2) word3 (dif+1)
My first function wordF2 get the list, the start, the end, an auxiliary list to get the current solution with the first element that always will be there ([a]), a counter with 0, and the max size of the counter (length list)..
and the second function check_word2 it checks if a word can pass to another word, like "spice" to "slice" if it cant like "spice" to "spoca" it returns "ThisWRONG".
This solution gets an error of pattern match failure
Program error: pattern match failure: wordF2 ["slice","slick"] "slice" "slick" ["slice"] 0 1
I was trying with little cases and nothing, and I'm restricting that i get a wrong position of the list with the count and the max.
Or may be I dont know how to implement backtracking on haskell to get multiple solutions, the best solution, etc..
UPDATE: I did a solution but its not backtracking
wordF :: [String] -> String -> String -> (String, String, Int)
wordF [] a b = (a, b, -1)
wordF list a b | (notElem a list || notElem b list) = (a, b, -1)
| otherwise = (a, b, (wordF1 list a b))
wordF1 :: [String] -> String -> String -> Int
wordF1 list a b | ((map length (wordF2 (subconjuntos2 (subconjuntos list) a b))) == []) = -1
| (calculo > 0) = calculo
| otherwise = -1
where
calculo = (minimum (map length (wordF2 (subconjuntos2 (subconjuntos list) a b))))-1
wordF2 :: [[String]] -> [[String]]
wordF2 [[]] = []
wordF2 (x:xs) | ((length xs == 1) && ((check_word x) == True) && ((check_word (head xs)) == True)) = x:xs
| ((length xs == 1) && ((check_word x) == False) && ((check_word (head xs)) == True)) = xs
| ((length xs == 1) && ((check_word x) == True) && ((check_word (head xs)) == False)) = [x]
| ((length xs == 1) && ((check_word x) == False) && ((check_word (head xs)) == False)) = []
| ((check_word x) == True) = x:wordF2 xs
| ((check_word x) == False ) = wordF2 xs
check_word :: [String] -> Bool
check_word [] = False
check_word (x:xs) | ((length xs == 1) && ((check_word2 x (head xs) 0) == True)) = True
| ((length xs >1) && ((check_word2 x (head xs) 0) == True)) = True && (check_word xs)
| otherwise = False
check_word2 :: String -> String -> Int -> Bool
check_word2 word1 word2 dif | (dif > 1) = False
| ((length word1 == 1) && (length word2 == 1) && (head word1 == head word2)) = True
| ((length word1 == 1) && (length word2 == 1) && (head word1 /= head word2) && (dif<1)) = True
| ((head word1) == (head word2)) = check_word2 (tail word1) (tail word2) dif
| otherwise = check_word2 (tail word1) (tail word2) (dif+1)
subconjuntos2 :: [[String]] -> String -> String -> [[String]]
subconjuntos2 [] a b = []
subconjuntos2 (x:xs) a b | (length x <= 1) = subconjuntos2 xs a b
| ((head x == a) && (last x == b)) = (x:subconjuntos2 xs a b)
| ((head x /= a) || (last x /= b)) = (subconjuntos2 xs a b)
subconjuntos :: [a] -> [[a]]
subconjuntos [] = [[]]
subconjuntos (x:xs) = [x:ys | ys <- sub] ++ sub
where sub = subconjuntos xs
Mmm may be its inefficient but at least it does the solution..
i search all posible solutions, i compare head == "slice" and last == "stock", then i filter the ones that are solution and print the shorter one,
thanks and if you guys have any suggest say it :)

Not thoroughly tested, but this hopefully will help:
import Data.Function (on)
import Data.List (minimumBy, delete)
import Control.Monad (guard)
type Word = String
type Path = [String]
wordF :: [Word] -> Word -> Word -> Path
wordF words start end =
start : minimumBy (compare `on` length) (generatePaths words start end)
-- Use the list monad to do the nondeterminism and backtracking.
-- Returns a list of all paths that lead from `start` to `end`
-- in steps that `differByOne`.
generatePaths :: [Word] -> Word -> Word -> [Path]
generatePaths words start end = do
-- Choose one of the words, nondeterministically
word <- words
-- If the word doesn't `differByOne` from `start`, reject the choice
-- and backtrack.
guard $ differsByOne word start
if word == end
then return [word]
else do
next <- generatePaths (delete word words) word end
return $ word : next
differsByOne :: Word -> Word -> Bool
differsByOne "" "" = False
differsByOne (a:as) (b:bs)
| a == b = differsByOne as bs
| otherwise = as == bs
Example run:
>>> wordF ["spice","stick","smice","stock","slice","slick","stock"] "spice" "stock"
["spice","slice","slick","stick","stock"]
The list monad in Haskell is commonly described as a form of nondeterministic, backtracking computation. What the code above is doing is allowing the list monad to take on the responsibility of generating alternatives, testing whether they satisfy criteria, and backtracking on failure to the most recent choice point. The bind of the list monad, e.g. word <- words, means "nondeterministically pick one of the words. guard means "if the choices so far don't satisfy this condition, backtrack and make a different choice. The result of a list monad computation is the list of all the results that stem from choices that did not violate any guards.
If this looks like list comprehensions, well, list comprehensions are the same thing as the list monad—I chose to express it with the monad instead of comprehensions.

There have been several articles published recently on classic brute-force search problems.
Mark Dominus published a simple example of using lists for a simple exhaustive search.
Justin Le followed up with a small modification to the previous article that simplified tracking the current state of the search.
I followed up with a further modification that allowed measuring the gains from early rejection of part of the search tree.
Note that the code in my article is quite slow because it's measuring the amount of work done as well as doing it. My article has good examples for how to quickly reject parts of the search tree, but it should be considered only an illustration - not production code.

A brute force approach using recursion:
import Data.List (filter, (\\), reverse, delete, sortBy)
import Data.Ord (comparing)
neighbour :: String -> String -> Bool
neighbour word = (1 ==) . length . (\\ word)
process :: String -> String -> [String] -> [(Int, [String])]
process start end dict =
let
loop :: String -> String -> [String] -> [String] -> [(Int,[String])] -> [(Int,[String])]
loop start end dict path results =
case next of
[] -> results
xs ->
if elem end xs
then (length solution, solution) : results
else results ++ branches xs
where
next = filter (neighbour start) dict'
dict' = delete start dict
path' = start : path
branches xs = [a | x <- xs, a <- loop x end dict' path' results]
solution = reverse (end : path')
in
loop start end dict [] []
shortestSolution :: Maybe Int
shortestSolution = shortest solutions
where
solutions = process start end dict
shortest s =
case s of
[] -> Nothing
xs -> Just $ fst $ head $ sortBy (comparing fst) xs
start = "spice"
end = "stock"
dict = ["spice","stick","smice","slice","slick","stock"]
Notes:
This code computes all possibles solutions (process) and select the shortest one (shortestSolution), as Carl said, you might want to prune parts of the search tree for better performance.
Using a Maybe instead of returning -1 when a function can fail to return results is preferred.
Another way using a tree with breadth-first search:
import Data.Tree
import Data.List( filter, (\\), delete )
import Data.Maybe
node :: String -> [String] -> Tree String
node label dict = Node{ rootLabel = label, subForest = branches label (delete label dict) }
branches :: String -> [String] -> [Tree String]
branches start dict = map (flip node dict) (filter (neighbour start) dict)
neighbour :: String -> String -> Bool
neighbour word = (1 ==) . length . (\\ word)
-- breadth first traversal
shortestBF tree end = find [tree] end 0
where
find ts end depth
| null ts = Nothing
| elem end (map rootLabel ts) = Just depth
| otherwise = find (concat (map subForest ts)) end (depth+1)
result = shortestBF tree end
tree :: Tree String
tree = node start dict
start = "spice"
end = "stock"
dict = ["spice","stick","smice","slice","slick","stock"]

Related

Rewriting function haskell

mostCommonNeighbour pairsTally word =
let matchedPairTally = neighboursTally word pairsTally
in if matchedPairTally == [] then Nothing -- Has no neighbour
else let commonNeighbour = (fst $ largestTally matchedPairTally)
in if (fst commonNeighbour) == word then Just (snd commonNeighbour)
else Just (fst commonNeighbour)
where
-- Filter out all Pairs from pairsTally that does not contain word
neighboursTally :: String -> PairsTally -> PairsTally
neighboursTally word pairsTally = filter ((inPair word).fst) pairsTally
-- Check if a word is contained in a pair
inPair :: String -> (String, String) -> Bool
inPair word pair
| word == (fst pair) || word == (snd pair) = True
| otherwise = False
-- Return the largest Tally in a PairsTally
largestTally :: PairsTally -> ((String, String), Int)
largestTally pairsTally = foldr bigTally (("", ""), 0) pairsTally
where
bigTally :: ((String, String), Int) -> ((String, String), Int) -> ((String, String), Int)
bigTally tally1 tally2
| snd tally1 > snd tally2 = tally1
| otherwise = tally2
Anyone know a good way to rewrite this function?, feel like it's a little long and am just checking if anyone knows how to make it shorter
I guess something like this looks pretty decent:
import Data.Ord
import Safe
mostCommonNeighbour pairsTally word = fst <$> maximumByMay (comparing snd)
[ (here, n)
| ((w1, w2), n) <- pairsTally
, (here, there) <- [(w1, w2), (w2, w1)]
, there == word
]
The Safe module may be obtained from the safe package; or you can copy maximumByMay into your codebase yourself (it is just two lines long).

Function containing head and tail functions throws empty list error

I'm trying the solve the first question in Advent of Code 2017, and come up with the following solution to calculate the needed value:
checkRepetition :: [Int] -> Bool
checkRepetition [] = False
checkRepetition (x:xs)
| x == ( head xs ) = True
| otherwise = False
test :: [Int] -> Int
test [] = 0
test [x] = 0
test xs
| checkRepetition xs == True = ((head xs)*a) + (test (drop a xs))
| otherwise = test (tail xs)
where
a = (go (tail xs)) + 1
go :: [Int] -> Int
go [] = 0
go xs
| checkRepetition xs == True = 1 + ( go (tail xs) )
| otherwise = 0
However, when I give an input that contains repetitive numbers such as [1,3,3], it gives the error
*** Exception: Prelude.head: empty list
However, for 1.5 hours, I couldn't figure out exactly where this error is generated. I mean any function that is used in test function have a definition for [], but still it throws this error, so what is the problem ?
Note that, I have checked out this question, and in the given answer, it is advised not to use head and tail functions, but I have tested those function for various inputs, and they do not throw any error, so what exactly is the problem ?
I would appreciate any help or hint.
As was pointed out in the comments, the issue is here:
checkRepetition (x:xs)
| x == ( head xs ) = True
xs is not guaranteed to be a non-empty list (a one-element list is written as x:[], so that (x:xs) pattern matches that xs = []) and calling head on an empty list is a runtime error.
You can deal with this by changing your pattern to only match on a 2+ element list.
checkRepetition [] = False
checkRepetition [_] = False
checkRepetition (x1:x2:_) = x1 == x2
-- No need for the alternations on this function, by the way.
That said, your algorithm seems needlessly complex. All you have to do is check if the next value is equal, and if so then add the current value to the total. Assuming you can get your String -> [Int] on your own, consider something like:
filteredSum :: [Int] -> Int
filteredSum [] = 0 -- by definition, zero- and one-element lists
filteredSum [_] = 0 -- cannot produce a sum, so special case them here
filteredSum xss#(first:_) = go xss
where
-- handle all recursive cases
go (x1:xs#(x2:_)) | x1 == x2 = x1 + go xs
| otherwise = go xs
-- base case
go [x] | x == first = x -- handles last character wrapping
| otherwise = 0 -- and if it doesn't wrap
-- this should be unreachable
go [] = 0
For what it's worth, I think it's better to work in the Maybe monad and operate over Maybe [Int] -> Maybe Int, but luckily that's easy since Maybe is a functor.
digitToMaybeInt :: Char -> Maybe Int
digitToMaybeInt '0' = Just 0
digitToMaybeInt '1' = Just 1
digitToMaybeInt '2' = Just 2
digitToMaybeInt '3' = Just 3
digitToMaybeInt '4' = Just 4
digitToMaybeInt '5' = Just 5
digitToMaybeInt '6' = Just 6
digitToMaybeInt '7' = Just 7
digitToMaybeInt '8' = Just 8
digitToMaybeInt '9' = Just 9
digitToMaybeInt _ = Nothing
maybeResult :: Maybe Int
maybeResult = fmap filteredSum . traverse digitToMaybeInt $ input
result :: Int
result = case maybeResult of
Just x -> x
Nothing -> 0
-- this is equivalent to `maybe 0 id maybeResult`
Thank you for the link. I went there first to glean the purpose.
I assume the input will be a string. The helper function below constructs a numeric list to be used to sum if predicate is True, that is, the zipped values are equal, that is, each number compared to each successive number (the pair).
The helper function 'nl' invokes the primary function 'invcap' Inverse Captcha with a list of numbers.
The nl function is a list comprehension. The invcap function is a list comprehension. Perhaps the logic in this question is at fault. Overly complicated logic is more likely to introduce errors. Proofs are very much easier when logic is not cumbersome.
The primary function "invcap"
invcap l = sum [ x | (x,y) <- zip l $ (tail l) ++ [head l], x == y]
The helper function that converts a string to a list of digits and invokes invcap with a list of numeric digits.
nl cs = invcap [ read [t] :: Int | t <- cs]
Invocation examples
Prelude> nl "91212129" ......
9 ' ' ' ' ' ' ' ' ' ' ' ' '
Prelude> nl "1122" ......
3

Getting parse error while doing list comprehensions in haskell

I'm writing a function like this:
testing :: [Int] -> [Int] -> [Int]
testing lst1 lst2 =
let t = [ r | (x,y) <- zip lst1 lst2, let r = if y == 0 && x == 2 then 2 else y ]
let t1 = [ w | (u,v) <- zip t (tail t), let w = if (u == 2) && (v == 0) then 2 else v]
head t : t1
What the first let does is: return a list like this: [2,0,0,0,1,0], from the second let and the following line, I want the output to be like this: [2,2,2,2,1,0]. But, it's not working and giving parse error!!
What am I doing wrong?
There are two kinds of lets: the "let/in" kind, which can appear anywhere an expression can, and the "let with no in" kind, which must appear in a comprehension or do block. Since your function definition isn't in either, its let's must use an in, for example:
testing :: [Int] -> [Int] -> [Int]
testing lst1 lst2 =
let t = [ r | (x,y) <- zip lst1 lst2, let r = if y == 0 && x == 2 then 2 else y ] in
let t1 = [ w | (u,v) <- zip t (tail t), let w = if (x == 2) && (y == 0) then 2 else y] in
return (head t : t1)
Alternately, since you can define multiple things in each let, you could consider:
testing :: [Int] -> [Int] -> [Int]
testing lst1 lst2 =
let t = [ r | (x,y) <- zip lst1 lst2, let r = if y == 0 && x == 2 then 2 else y ]
t1 = [ w | (u,v) <- zip t (tail t), let w = if (x == 2) && (y == 0) then 2 else y]
in return (head t : t1)
The code has other problems, but this should get you to the point where it parses, at least.
With an expression formed by a let-binding, you generally need
let bindings
in
expressions
(there are exceptions when monads are involved).
So, your code can be rewritten as follows (with simplification of r and w, which were not really necessary):
testing :: [Int] -> [Int] -> [Int]
testing lst1 lst2 =
let t = [ if y == 0 && x == 2 then 2 else y | (x,y) <- zip lst1 lst2]
t1 = [ if (v == 0) && (u == 2) then 2 else v | (u,v) <- zip t (tail t)]
in
head t : t1
(Note, I also switched u and v so that t1 and t has similar forms.
Now given a list like [2,0,0,0,1,0], it appears that your code is trying to replace 0 with 2 if the previous element is 2 (from the pattern of your code), so that eventually, the desired output is [2,2,2,2,1,0].
To achieve this, it is not enough to use two list comprehensions or any fixed number of comprehensions. You need to somehow apply this process recursively (again and again). So instead of only doing 2 steps, we can write out one step, (and apply it repeatedly). Taking your t1 = ... line, the one step function can be:
testing' lst =
let
t1 = [ if (u == 2) && (v == 0) then 2 else v | (u,v) <- zip lst (tail lst)]
in
head lst : t1
Now this gives:
*Main> testing' [2,0,0,0,1,0]
[2,2,0,0,1,0]
, as expected.
The rest of the job is to apply testing' as many times as necessary. Here applying it (length lst) times should suffice. So, we can first write a helper function to apply another function n times on a parameter, as follows:
apply_n 0 f x = x
apply_n n f x = f $ apply_n (n - 1) f x
This gives you what you expected:
*Main> apply_n (length [2,0,0,0,1,0]) testing' [2,0,0,0,1,0]
[2,2,2,2,1,0]
Of course, you can wrap the above in one function like:
testing'' lst = apply_n (length lst) testing' lst
and in the end:
*Main> testing'' [2,0,0,0,1,0]
[2,2,2,2,1,0]
NOTE: this is not the only way to do the filling, see the fill2 function in my answer to another question for an example of achieving the same thing using a finite state machine.

Retrieve strings from Matrix

I'm stuck with my homework task, somebody help, please..
Here is the task:
Find all possible partitions of string into words of some dictionary
And here is how I'm trying to do it:
I use dynamical programming concept to fill matrix and then I'm stuck with how to retrieve data from it
-- Task5_2
retrieve :: [[Int]] -> [String] -> Int -> Int -> Int -> [[String]]
retrieve matrix dict i j size
| i >= size || j >= size = []
| index /= 0 = [(dict !! index)]:(retrieve matrix dict (i + sizeOfWord) (i + sizeOfWord) size) ++ retrieve matrix dict i (next matrix i j) size
where index = (matrix !! i !! j) - 1; sizeOfWord = length (dict !! index)
next matrix i j
| j >= (length matrix) = j
| matrix !! i !! j > 0 = j
| otherwise = next matrix i (j + 1)
getPartitionMatrix :: String -> [String] -> [[Int]]
getPartitionMatrix text dict = [[ indiceOfWord (getWord text i j) dict 1 | j <- [1..(length text)]] | i <- [1..(length text)]]
--------------------------
getWord :: String -> Int -> Int -> String
getWord text from to = map fst $ filter (\a -> (snd a) >= from && (snd a) <= to) $ zip text [1..]
indiceOfWord :: String -> [String] -> Int -> Int
indiceOfWord _ [] _ = 0
indiceOfWord word (x:xs) n
| word == x = n
| otherwise = indiceOfWord word xs (n + 1)
-- TESTS
dictionary = ["la", "a", "laa", "l"]
string = "laa"
matr = getPartitionMatrix string dictionary
test = retrieve matr dictionary 0 0 (length string)
Here is a code that do what you ask for. It doesn't work exactly like your solution but should work as fast if (and only if) both our dictionary lookup were improved to use tries as would be reasonable. As it is I think it may be a bit faster than your solution :
module Partitions (partitions) where
import Data.Array
import Data.List
data Branches a = Empty | B [([a],Branches a)] deriving (Show)
isEmpty Empty = True
isEmpty _ = False
flatten :: Branches a -> [ [ [a] ] ]
flatten Empty = []
flatten (B []) = [[]]
flatten (B ps) = concatMap (\(word, bs) -> ...) ps
type Dictionary a = [[a]]
partitions :: (Ord a) => Dictionary a -> [a] -> [ [ [a] ] ]
partitions dict xs = flatten (parts ! 0)
where
parts = listArray (0,length xs) $ zipWith (\i ys -> starting i ys) [0..] (tails xs)
starting _ [] = B []
starting i ys
| null words = ...
| otherwise = ...
where
words = filter (`isPrefixOf` ys) $ dict
go word = (word, parts ! (i + length word))
It works like this : At each position of the string, it search all possible words starting from there in the dictionary and evaluates to a Branches, that is either a dead-end (Empty) or a list of pairs of a word and all possible continuations after it, discarding those words that can't be continued.
Dynamic programming enter the picture to record every possibilities starting from a given index in a lazy array. Note that the knot is tied : we compute parts by using starting, which uses parts to lookup which continuations are possible from a given index. This only works because we only lookup indices after the one starting is computing and starting don't use parts for the last index.
To retrieve the list of partitions from this Branches datatype is analogous to the listing of all path in a tree.
EDIT : I removed some crucial parts of the solution in order to let the questioner search for himself. Though that shouldn't be too hard to complete with some thinking. I'll probably put them back with a somewhat cleaned up version later.

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