Project Euler #4: A palindromic number reads the same both ways. The largest palindrome made from the product of two 2-digit numbers is 9009 = 91 × 99. Find the largest palindrome made from the product of two 3-digit numbers.
This solution works:
p004largestPalindrome :: Integer
p004largestPalindrome = largest [ a * b | a <- [100..999], b <- [100..999], isPalindrome $ show(a*b) ]
where
isPalindrome [] = True
isPalindrome [_] = True
isPalindrome (x:xs) = if x == last xs then isPalindrome (init xs) else False
largest [] = 0
largest [x] = x
largest (x:xs) = if x > head xs then largest (x:(tail xs)) else largest xs
My question is: can you assign type signatures to the functions in the where clause, given that the both have different arrangements of parameters ([], [x], (x:xs))? Sticking in isPalindrome :: (Eq a) -> [a] -> Bool throws an error.
Edit: I am trying to insert a type signature like so:
p004largestPalindrome :: Integer
p004largestPalindrome = largest [ a * b | a <- [100..999], b <- [100..999], isPalindrome $ show(a*b) ]
where
isPalindrome :: (Eq a) -> [a] -> Bool
isPalindrome [] = True
isPalindrome [_] = True
isPalindrome (x:xs) = if x == last xs then isPalindrome (init xs) else False
largest [] = 0
largest [x] = x
largest (x:xs) = if x > head xs then largest (x:(tail xs)) else largest xs
You have a typo. [Should] be (Eq a) =>... (arrow should be made with equal sign) – Michal Seweryn
Class constraints are separated from the types they constrain with =>.
Related
I am trying to use a recursive function that prints the list that has the maximum length out of the lists resulting from my following code:
allincreasing :: Ord a => [a] -> [[a]]
allincreasing = map nub . filter isSorted . subsequences
main = do
print $ allincreasing[3,2,6,4,5,1]
I need to pass the output below to a recursive function that find the one with max length :
[[],[3],[2],[6],[3,6],[2,6],[4],[3,4],[2,4],[5],[3,5],[2,5],[4,5],[3,4,5],[2,4,5],[1]]
I tried to do it using the following code based on my understanding of an answer to this question but I couldn't implement the recursion part well. Here is my attempt:
longest :: Ord a => [[a]] -> [a]
longest [y] = y --base case: if there's only one element left, return it.
longest (x:y:lst) --extract the first two elements x, y from the list.
| length x < length y = longest (y:lst)
| otherwise = x : (longest (y:lst))
lis :: Ord a => [a] -> a
lis = length . longest . allincreasing
Note: I am required to use recursion to solve the problem of longest increasing sequence.
When you want to track stuf alongsiede recursion (like the max list so far...) one use accumulators (you could read about them here...):
Edited due to comment request:
module Main where
import Data.List
isSorted :: (Ord a) => [a] -> Bool
isSorted [] = True
isSorted [x] = True
isSorted (x:y:xs) = x <= y && isSorted (y:xs)
allincreasing :: Ord a => [a] -> [[a]]
allincreasing = map nub . filter isSorted . subsequences
main :: IO ()
main = do
let list = [3,2,6,4,5,1]
print $ allincreasing list
print $ longest $ allincreasing list
longest :: Ord a => [[a]] -> [a]
longest list = longest' list []
where
longest' [] acc = acc
longest' (x:xs) [] = longest' xs x
longest' (x:xs) acc
| length acc >= length x = longest' xs acc
| length acc < length x = longest' xs x
longest' _ _ = error "something went wrong..."
Im new to haskell and Im writing a function that compares two sequences and reports the length of the prefix they have in common. This is what I have so far but it doesn't work for all cases.
commonLen :: Eq a => [a] -> [a] -> Int
commonLen (x:xs) [] = 0
commonLen (x:xs) (y:ys) | x==y = 1+(commonLen xs ys)
| otherwise = commonLen xs ys
Any ideas where im going wrong? Any help would be appreciated
You should not recurse in case x is different from y. In that case we return 0:
commonLen :: Eq a => [a] -> [a] -> Int
commonLen [] _ = 0
commonLen _ [] = 0
commonLen (x:xs) (y:ys) | x == y = 1 + commonLen xs ys
| otherwise = 0 -- ← return 0
You also can avoid the explicit recursion, and work with:
commonLen :: Eq a => [a] -> [a] -> Int
commonLen xs ys = length (takeWhile id (zipWith (==) xs ys))
here we iterate over both lists concurrently, and compare the elements. We thus make a list of Bools that is True if the elements of the two lists match. Then we use takeWhile to take elements as long as the item is True, and we use length to determine the number of elements in that list. Due to Haskell's laziness, we will never evaluate the entire list if one of the elements differs from the corresponding element in the other list.
I have created a program to remove first smallest element but I dont how to do for second largest:
withoutBiggest (x:xs) =
withoutBiggestImpl (biggest x xs) [] (x:xs)
where
biggest :: (Ord a) => a -> [a] -> a
biggest big [] = big
biggest big (x:xs) =
if x < big then
biggest x xs
else
biggest big xs
withoutBiggestImpl :: (Eq a) => a -> [a] -> [a] -> [a]
withoutBiggestImpl big before (x:xs) =
if big == x then
before ++ xs
else
withoutBiggestImpl big (before ++ [x]) xs
Here is a simple solution.
Prelude> let list = [10,20,100,50,40,80]
Prelude> let secondLargest = maximum $ filter (/= (maximum list)) list
Prelude> let result = filter (/= secondLargest) list
Prelude> result
[10,20,100,50,40]
Prelude>
A possibility, surely not the best one.
import Data.Permute (rank)
x = [4,2,3]
ranks = rank (length x) x -- this gives [2,0,1]; that means 3 (index 1) is the second smallest
Then:
[x !! i | i <- [0 .. length x -1], i /= 1]
Hmm.. not very cool, let me some time to think to something better please and I'll edit my post.
EDIT
Moreover my previous solution was wrong. This one should be correct, but again not the best one:
import Data.Permute (rank, elems, inverse)
ranks = elems $ rank (length x) x
iranks = elems $ inverse $ rank (length x) x
>>> [x !! (iranks !! i) | i <- filter (/=1) ranks]
[4,2]
An advantage is that this preserves the order of the list, I think.
Here is a solution that removes the n smallest elements from your list:
import Data.List
deleteN :: Int -> [a] -> [a]
deleteN _ [] = []
deleteN i (a:as)
| i == 0 = as
| otherwise = a : deleteN (i-1) as
ntails :: Int -> [a] -> [(a, Int)] -> [a]
ntails 0 l _ = l
ntails n l s = ntails (n-1) (deleteN (snd $ head s) l) (tail s)
removeNSmallest :: Ord a => Int -> [a] -> [a]
removeNSmallest n l = ntails n l $ sort $ zip l [0..]
EDIT:
If you just want to remove the 2nd smallest element:
deleteN :: Int -> [a] -> [a]
deleteN _ [] = []
deleteN i (a:as)
| i == 0 = as
| otherwise = a : deleteN (i-1) as
remove2 :: [a] -> [(a, Int)] -> [a]
remove2 [] _ = []
remove2 [a] _ = []
remove2 l s = deleteN (snd $ head $ tail s) l
remove2Smallest :: Ord a => [a] -> [a]
remove2Smallest l = remove2 l $ sort $ zip l [0..]
It was not clear if the OP is looking for the biggest (as the name withoutBiggest implies) or what. In this case, one solution is to combine the filter :: (a->Bool) -> [a] -> [a] and maximum :: Ord a => [a] -> a functions from the Prelude.
withoutBiggest l = filter (/= maximum l) l
You can remove the biggest elements by first finding it and then filtering it:
withoutBiggest :: Ord a => [a] -> [a]
withoutBiggest [] = []
withoutBiggest xs = filter (/= maximum xs) xs
You can then remove the second-biggest element in much the same way:
withoutSecondBiggest :: Ord a => [a] -> [a]
withoutSecondBiggest xs =
case withoutBiggest xs of
[] -> xs
rest -> filter (/= maximum rest) xs
Assumptions made:
You want each occurrence of the second-biggest element removed.
When there is zero/one element in the list, there isn't a second element, so there isn't a second-biggest element. Having the list without an element that isn't there is equivalent to having the list.
When the list contains only values equivalent to maximum xs, there also isn't a second-biggest element even though there may be two or more elements in total.
The Ord type-class instance implies a total ordering. Otherwise you may have multiple maxima that are not equivalent; otherwise which one is picked as the biggest and second-biggest is not well-defined.
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
I was given this code and told to explain its logic, does anyone know what is going on, new to Haskell.
cpfx :: [[Char]] -> [Char]
cpfx [] = []
cpfx [x] = x
cpfx (x:xs) = cpfx' (x:xs) 0
cpfx' :: [[Char]] -> Int -> [Char]
cpfx' [x] _ = []
cpfx' (x:xs) n
| ifMatch (x:xs) n = x!!n : cpfx' (x:xs) (n+1)
| otherwise = []
ifMatch :: [[Char]] -> Int -> Bool
ifMatch [x] _ = True
ifMatch [x,y] n = x!!n == y!!n
ifMatch (x:y:xs) n
| x!!n == y!!n = ifMatch xs n
| otherwise = False
I am having trouble understand what cpfx,cpfx' and ifMatch are doing.
Take each function directly and look at it. Let's start from the bottom up, since they each use each other.
ifMatch :: [[Char]] -> Int -> Bool
so ifMatch takes a list of lists of Chars (or a list of Strings) and an Int, and gives you back a true/false value. Now let's look at the pattern matches
[x] _ = True -- one element list and any number is True
[x, y] n = x!!n == y!!n {- two element list is true if the character at index
#n# is the same in both lists -}
(x:y:xs) n -- three+ element list guards against...
| x!!n == y!n -- if the characters at index #n# are equal...
= ifMatch xs n -- ... then recurse
| otherwise = False -- otherwise, give me a False.
Taken together, you can see that ifMatch is supposed to check that all strings passed to it have the same letter at index n. It is equivalent to:
ifMatch [] _ = True
ifMatch xs n = let c = head xs !! n in
foldr ((&&) . (==c) . (!!n)) True xs
Though it actually appears to have a slight bug. It only checks if each pair of strings has identical letters at index n, so
ifMatch ["This", "That", "In", "Onward"] 1 == True
-- (^ == ^) && (^ == ^)
cpfx' :: [[Char]] -> Int -> [Char]
so cpfx' takes a list of list of Chars (or a list of Strings) and an Int and gives you back a list of Chars (or a String). Let's look at pattern matches here:
cpfx' [x] _ = [] -- one element list and any number is the empty list
cpfx' (x:xs) n -- multiple element list guards against...
| ifMatch (x:xs) n -- if all #x:xs# share an element at #n#...
= x!!n : -- ...add x!!n and...
cpfx' (x:xs) (n+1) -- ...recurse to the next index
| otherwise = [] -- otherwise, empty list.
So this grabs a character from x until the characters no longer match among all the strings in x:xs, and returns that prefix string.
cpfx :: [[Char]] -> [Char]
From a list of list of Chars (or a list of Strings) to a list of Chars (or a String).
cpfx [] = [] -- empty string gives empty string
cpfx [x] = x -- one-element list gives its only element
cpfx (x:xs) = cpfx' (x:xs) 0 {- anything else gives the shared prefix starting
at index zero -}
All in all, we've got three functions that work together to give you the longest substring of the head of a list of strings that exists at the beginning of all strings in that list.
import Data.Maybe (mapMaybe)
safeIndex :: [a] -> Int -> Maybe a
safeIndex xs n | length xs > n = Just $ xs !! n
| otherwise = Nothing
allEq :: Eq a => [a] -> Bool
allEq [] = True
allEq [_] = True
allEq (x:xs) = all (==x) xs
prefix :: [String] -> String
prefix xss#(x:_) = map snd $ takeWhile pred $ zip [0..] x where
pred :: (Int, Char) -> Bool
pred (n, _) = (allEq . mapMaybe (flip safeIndex n)) xss
testData :: [String]
testData = ["Hello", "Hello, World!", "Hello, Universe!", "Hello everybody!", "Hell's to you, then!"]
main :: IO ()
main = do
let p = prefix testData
putStrLn "Should be \"Hell\""
putStrLn p
or much easier with transpose
import Data.List (transpose)
prefix' :: [String] -> String
prefix' xss#(x:_) = take (length $ takeWhile allEq transposed) x where
transposed = transpose xss
or slightly more efficient
lengthWhile :: (a -> Bool) -> [a] -> Int
lengthWhile _ [] = 0
lengthWhile pred (x:xs) | pred x = 1 + lengthWhile pred xs
| otherwise = 0
prefix'' :: [String] -> String
prefix'' xss#(x:_) = take (lengthWhile allEq transposed) x where
transposed = transpose xss
Define a function nohundred :: Int -> Int such that for a positive number n nohundred n is the nth positive number such that "100" does not occur as a substring in its binary expansion.
decToBin :: Int -> [Int]
decToBin x = reverse $ decToBin' x
where
decToBin' :: Int -> [Int]
decToBin' 0 = []
decToBin' y = let (a,b) = quotRem y 2 in [b] ++ decToBin' a
check :: [Int] -> Bool
check (z:zs)
|((z == 1) && (head (zs) == 0) && (head (tail zs) == 0)) = True
| otherwise = check zs
binToDec :: [Int] -> Int
binToDec l = sumlist (zipWith (*) (iterate f 1) (reverse l))
where
sumlist :: [Int] -> Int
sumlist [] = 0
sumlist (x:xs) = x + (sumlist xs)
f :: Int -> Int
f j = (2 * j)
nohundred :: Int -> Int
nohundred n = if ((check fun) == True) then (binToDec (fun)) else (nohundred (n+1))
where
fun = decToBin n
The above code gives error :-
*Main> nohundred 10
*** Exception: Prelude.head: empty list...
The desired output is 14.
*Main> nohundred 100
100
The desired output is 367...
Can anyone suggest the cause of error?
This function is partial:
check (z:zs)
|((z == 1) && (head (zs) == 0) && (head (tail zs) == 0)) = True
| otherwise = check zs
When called with a one- or two-element list, the first check will call head on an empty list. Additionally, it does not cover the empty-list case. The idiomatic way to write this is:
check (1:0:0:zs) = True
check (z:zs) = check zs
check [] = False
Additionally, your nohundred function takes a number and finds the next higher non-hundred number; but you want the nth non-hundred number, which is a very different thing.