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.
Related
I'm trying to optimize my old code from Project Euler #23 and noticed some strange slowdown while removing useless comparisons in a function for list merging.
My code:
import Data.List
import Debug.Trace
limit = 28123
-- sum of all integers from 1 to n
summe :: Int -> Int
summe n = div (n*(n+1)) 2
-- all divisors of x excluding itself
divisors :: Int -> [Int]
divisors x = l1 ++ [x `div` z | z <- l1, z*z /= x, z /= 1]
where m = floor $ sqrt $ fromIntegral x
l1 = [y | y <- [1..m] , mod x y == 0]
-- list of all abundant numbers
liste :: [Int]
liste = [x | x <- [12..limit] , x < sum (divisors x)]
-- nested list with sums of abundent numbers
sumliste :: [[Int]]
sumliste = [[x+y | x <- takeWhile (<=y) liste, x + y <= limit] | y <- liste]
-- reduced list
rsl :: [[Int]] -> [Int]
rsl (hl:[]) = hl
rsl (hl:l) = mergelists hl (rsl l)
-- build a sorted union of two sorted lists
mergelists :: [Int] -> [Int] -> [Int]
mergelists [] [] = []
mergelists [] b = b
mergelists a [] = a
mergelists as#(a:at) bs#(b:bt)
-- | a == b = a : mergelists at bt
-- | a > b = b : mergelists as bt
-- | a < b = a : mergelists at bs
| a == b = if a == hl1
then trace "1" l1
else a : l1
| a > b = if b == hl2
then trace "2" l2
else b : l2
| a < b = if a == hl3
then trace "3" l3
else a : l3
where l1 = mergelists at bt
hl1 = if null l1 then a + 1 else head l1
l2 = mergelists as bt
hl2 = head l2
l3 = mergelists at bs
hl3 = head l3
-- build the sum of target numbers by subtracting sum of nontarget numbers from all numbers
main = print $ (summe limit) - (sum $ rsl sumliste)
My problem is the function mergelists. The body of this functions contains some useless if clauses (as can be seen by the missing trace output) and could be refactored to the three commented lines. The problem with this is an increase of execution time from 3.4s to 5.8s what I can't understand.
Why is the shorter code slower?
As Thomas M. DuBuisson suggested, the problem has to do with the lack of strictness. The following code is a slight modification of the code that you have commented out, which uses the $! operator to ensure that the mergelists call is evaluated before forming the list.
mergelists :: [Int] -> [Int] -> [Int]
mergelists [] [] = []
mergelists [] b = b
mergelists a [] = a
mergelists as#(a:at) bs#(b:bt)
| a == b = (a :) $! mergelists at bt
| a > b = (b :) $! mergelists as bt
| a < b = (a :) $! mergelists at bs
The function $! ensures if the result of (_ :) $! mergelists _ _ is evaluated, then mergelists _ _ must be evaluated as well. Thanks to the recursion, this implies that if the result of mergelists is evaluated, then the entire list must be evaluated.
In the slow version,
mergelists as#(a:at) bs#(b:bt)
| a == b = a : mergelists at bt
| a > b = b : mergelists as bt
| a < b = a : mergelists at bs
you can inspect the first element of the result without evaluating the remainder of the list. The call to mergelists in the tail of the list is stored as an unevaluated thunk. This has various implications:
This is good if you only need a small portion of the merged list, or if the inputs are infinitely long.
On the other hand, if the lists aren't that big to begin with and/or you need all the elements eventually, this adds extra overhead due to the presence of the thunk. It also means that the garbage collector doesn't get to free any of the inputs since the thunks will retain references to them.
I don't understand exactly why it's slower for your particular problem though — perhaps someone more experienced can shed some light on this.
I've noticed that, at -O0, the "slow version" is actually the fastest of the three approaches, so I suspect that GHC was able to take advantage of the strictness and produce more optimized code.
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.
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
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
I am doing yet another projecteuler question in Haskell, where I must find if the sum of the factorials of each digit in a number is equal to the original number. If not repeat the process until the original number is reached. The next part is to find the number of starting numbers below 1 million that have 60 non-repeating units. I got this far:
prob74 = length [ x | x <- [1..999999], 60 == ((length $ chain74 x)-1)]
factorial n = product [1..n]
factC x = sum $ map factorial (decToList x)
chain74 x | x == 0 = []
| x == 1 = [1]
| x /= factC x = x : chain74 (factC x)
But what I don't know how to do is to get it to stop once the value for x has become cyclic. How would I go about stopping chain74 when it gets back to the original number?
When you walk through the list that might contain a cycle your function needs to keep track of the already seen elements to be able to check for repetitions. Every new element is compared against the already seen elements. If the new element has already been seen, the cycle is complete, if it hasn't been seen the next element is inspected.
So this calculates the length of the non-cyclic part of a list:
uniqlength :: (Eq a) => [a] -> Int
uniqlength l = uniqlength_ l []
where uniqlength_ [] ls = length ls
uniqlength_ (x:xs) ls
| x `elem` ls = length ls
| otherwise = uniqlength_ xs (x:ls)
(Performance might be better when using a set instead of a list, but I haven't tried that.)
What about passing another argument (y for example) to the chain74 in the list comprehension.
Morning fail so EDIT:
[.. ((length $ chain74 x x False)-1)]
chain74 x y not_first | x == y && not_first = replace_with_stop_value_:-)
| x == 0 = []
| x == 1 = [1]
| x == 2 = [2]
| x /= factC x = x : chain74 (factC x) y True
I implemented a cycle-detection algorithm in Haskell on my blog. It should work for you, but there might be a more clever approach for this particular problem:
http://coder.bsimmons.name/blog/2009/04/cycle-detection/
Just change the return type from String to Bool.
EDIT: Here is a modified version of the algorithm I posted about:
cycling :: (Show a, Eq a) => Int -> [a] -> Bool
cycling k [] = False --not cycling
cycling k (a:as) = find 0 a 1 2 as
where find _ _ c _ [] = False
find i x c p (x':xs)
| c > k = False -- no cycles after k elements
| x == x' = True -- found a cycle
| c == p = find c x' (c+1) (p*2) xs
| otherwise = find i x (c+1) p xs
You can remove the 'k' if you know your list will either cycle or terminate soon.
EDIT2: You could change the following function to look something like:
prob74 = length [ x | x <- [1..999999], let chain = chain74 x, not$ cycling 999 chain, 60 == ((length chain)-1)]
Quite a fun problem. I've come up with a corecursive function that returns the list of the "factorial chains" for every number, stopping as soon as they would repeat themselves:
chains = [] : let f x = x : takeWhile (x /=) (chains !! factC x) in (map f [1..])
Giving:
take 4 chains == [[],[1],[2],[3,6,720,5043,151,122,5,120,4,24,26,722,5044,169,363601,1454]]
map head $ filter ((== 60) . length) (take 10000 chains)
is
[1479,1497,1749,1794,1947,1974,4079,4097,4179,4197,4709,4719,4790,4791,4907,4917
,4970,4971,7049,7094,7149,7194,7409,7419,7490,7491,7904,7914,7940,7941,9047,9074
,9147,9174,9407,9417,9470,9471,9704,9714,9740,9741]
It works by calculating the "factC" of its position in the list, then references that position in itself. This would generate an infinite list of infinite lists (using lazy evaluation), but using takeWhile the inner lists only continue until the element occurs again or the list ends (meaning a deeper element in the corecursion has repeated itself).
If you just want to remove cycles from a list you can use:
decycle :: Eq a => [a] -> [a]
decycle = dc []
where
dc _ [] = []
dc xh (x : xs) = if elem x xh then [] else x : dc (x : xh) xs
decycle [1, 2, 3, 4, 5, 3, 2] == [1, 2, 3, 4, 5]