Weird output from Haskell until function - haskell

I'm writing a bit of code to help me with some math stuff. I'm trying to implement the Miller test, not Miller-Rabin, and I need to make a list of a bunch of exponents. Here's the code so far. It inserts the last result twice for some reason, and I don't know why. I must not understand how the until function works.
import Math.NumberTheory.Powers
divides::Integer->Integer->Bool
divides x y = y `mod` x == 0
factorcarmichael::Integer->(Integer,Integer)
factorcarmichael n = until (\(_, s) -> not $ divides 2 s)
(\(r, s) -> (r+1, div s 2))
(0, n-1)
second::((Integer,Integer),[Integer])->[Integer]
second (x,xs) = xs
millerlist::Integer->Integer->[Integer]
millerlist a n = second $ until (\((r,s), xs) -> r<0)
(\((r,s), xs) -> ((r-1,s), (powerMod a ((2^r)*s) n):xs))
(factoredcarmichael, [])
where
factoredcarmichael = factorcarmichael n
Also, the millerlist function is a little kludgy. If someone can suggest an alternative, that would be nice.
The output I'm getting for
millerlist 8888 9746347772161
repeats the last element twice.

That is because
7974284540860^2 ≡ 7974284540860 (mod 9746347772161)
so the number appears twice in the list. But your list is one too long, I believe. I think you only want the remainder of a^(2^k*s) modulo n for 0 <= k < r.
As for alternatives, is there a particular reason why you're not using Math.NumberTheory.Primes.isStrongFermatPP? If you're only interested in the outcome, that's less work coding.
If you want to generate the list, what about
millerlist a n = go r u
where
(r,s) = factorcarmichael n
u = powerMod a s n
go 0 m = []
go k m = m : go (k-1) ((m*m) `mod` n)
or
millerlist a n = take (fromInteger r) $ iterate (\m -> (m*m) `mod` n) u
where
(r,s) = factorcarmichael n
u = powerMod a s n

Related

Alternative way to write a Haskell function of single input and output of this kind

Good morning everyone!
I'm using the following function as a fitting example of a function that needs to have a simple input and output. In this case it's a function that converts a number from decimal to binary form, as a list of digits no less, just because it is convenient later on.
I chose to write it like this, because even though a number goes in and a list comes out, another structure is needed as an intermediate step, that will hold the digits found so far and hold the quotient of the division, as input for the next step of the loop. I will clean up the necessary mess before outputing anything, though, by selecting the part of the structure that I'm interested in, in this case the second one , and not counters or other stuff, that I'm done with. (As I mentioned this is an example only, and it's not unusual in other cases to initialize the until loop with a triplet like (a,b,c), only to pick one of them at the end, as I see fit, with the help of additional function, like pickXof3.)
So there,
dec2Bin :: Int -> [Int]
dec2Bin num = snd $ until
(\(n,l) -> n <=0) -- test
(\(n,l) -> (fst $ division n, (snd $ division n):l)) -- main function
(num,[]) -- initialization
where division a = divMod a 2
I find it very convenient that Haskell, although lacking traditional for/while loops has a function like until, which reminds me very much of Mathematica's NextWhile, that I'm familiar with.
In the past I would write sth even uglier, like two functions, a "helper" one and a "main" one, like so
dec2BinHelper :: (Int,[Int]) -> (Int,[Int])
dec2BinHelper (n,l)
| n <= 0 = (n,l)
| otherwise = dec2BinHelper (fst $ division n, (snd $ division n):l)
where division a = divMod a 2
-- a function with the sole purpose to act as a front-end to the helper function, initializing its call parameters and picking up its output
dec2Bin :: Int -> [Int]
dec2Bin n = snd $ dec2BinHelper (n,[])
which I think is unnecessarily bloated.
Still, while the use of until allows me to define just one function, I get the feeling that it could be done even simpler/easier to read, perhaps in a way more fitting to functional programming. Is that so? How would you write such a function differently, while keeping the input and output at the absolutely essential values?
I strongly prefer your second solution. I'd start a clean-up with two things: use pattern matching, and use where to hide your helper functions. So:
dec2Bin :: Int -> [Int]
dec2Bin n = snd $ dec2BinHelper (n, []) where
dec2BinHelper (n, l)
| n <= 0 = (n, l)
| otherwise = dec2BinHelper (d, m:l)
where (d, m) = divMod n 2
Now, in the base case, you return a tuple; but then immediately call snd on it. Why not fuse the two?
dec2Bin :: Int -> [Int]
dec2Bin n = dec2BinHelper (n, []) where
dec2BinHelper (n, l)
| n <= 0 = l
| otherwise = dec2BinHelper (d, m:l)
where (d, m) = divMod n 2
There's no obvious reason why you should pass these arguments in a tuple, rather than as separate arguments, which is more idiomatic and saves some allocation/deallocation noise besides.
dec2Bin :: Int -> [Int]
dec2Bin n = dec2BinHelper n [] where
dec2BinHelper n l
| n <= 0 = l
| otherwise = dec2BinHelper d (m:l)
where (d, m) = divMod n 2
You can swap the arguments to dec2BinHelper and eta-reduce; that way, you will not be shadowing the definition of n.
dec2Bin :: Int -> [Int]
dec2Bin = dec2BinHelper [] where
dec2BinHelper l n
| n <= 0 = l
| otherwise = dec2BinHelper (m:l) d
where (d, m) = divMod n 2
Since you know that n > 0 in the recursive call, you can use the slightly faster quotRem in place of divMod. You could also consider using bitwise operations like (.&. 1) and shiftR 1; they may be even better, but you should benchmark to know for sure.
dec2Bin :: Int -> [Int]
dec2Bin = dec2BinHelper [] where
dec2BinHelper l n
| n <= 0 = l
| otherwise = dec2BinHelper (r:l) q
where (q, r) = quotRem n 2
When you don't have a descriptive name for your helper function, it's traditional to name it go or loop.
dec2Bin :: Int -> [Int]
dec2Bin = go [] where
go l n
| n <= 0 = l
| otherwise = go (r:l) q
where (q, r) = quotRem n 2
At this point, the two sides of the conditional are short enough that I'd be tempted to put them on their own line, though this is something of an aesthetic choice.
dec2Bin :: Int -> [Int]
dec2Bin = go [] where
go l n = if n <= 0 then l else go (r:l) q
where (q, r) = quotRem n 2
Finally, a comment on the name: the input isn't really in decimal in any meaningful sense. (Indeed, it's much more physically accurate to think of the input as already being in binary!) Perhaps int2Bin or something like that would be more accurate. Or let the type speak for itself, and just call it toBin.
toBin :: Int -> [Int]
toBin = go [] where
go l n = if n <= 0 then l else go (r:l) q
where (q, r) = quotRem n 2
At this point I'd consider this code quite idiomatic.

Project Euler #24 in Haskell

I am trying to solve the problems from Project Euler using Haskell, but I got sucked at #24
I'm trying to use factorials to solve problem but just can't work for the last three digits, here is my code:
import Data.List
fact n = product [n, n-1 .. 1]
recur :: Int -> Int -> [Int] -> [Int]
recur x y arr
| y > 1 = arr !! d : recur r (y-1) (delete (arr !! d) arr)
| otherwise = arr
where d = x `div` fact y
r = x `mod` fact y
main::IO()
main = print(recur 1000000 9 [0..9])
(I know it is now not really "functional")
I managed to get result [2,7,8,3,9,1,4,5,0,6], while the right answer I accidently figured out by hand is 2783915460.
I just want to know why this algorithm doesn't work for the last three digits. Thanks.
Unadulterated divMod is wrong for this algorithm. You need
dvm x facty | r == 0 = (d-1, facty)
| otherwise = (d, r)
where
(d, r) = divMod x facty
instead:
recur x y arr
.......
.......
where (d, r) = x `dvm` fact y
We cannot have zero combinations to do left. Zero means none.
Also the pattern guard condition should be changed to y > 0. Only when the length of the remaining choices list is 1 (at which point y is 0) there's no more choices to be made and we just use the last available digit left.

Just Int to Int

This code either returns the first factor of an Integer starting from 2 or returns nothing if it's a prime.
Example: firstFactorOf 24 returns "Just 2"
Example: firstFactorOf 11 returns "Nothing"
My question is, how would I return the value 2 rather than "Just 2" if there is a factor or return the value x if there is no factor.
firstFactorOf x
| m == Nothing = m
| otherwise = m
where m =(find p [2..x-1])
p y = mod x y == 0
//RETURNS:
ghci> firstFactorOf 24
Just 2
ghci> firstFactorOf 11
Nothing
Haskell is statically typed, meaning that you can define a function Maybe a -> a, but the question is what to do with the Nothing case.
Haskell has two functions that can be helpful here: fromMaybe and fromJust:
fromMaybe :: a -> Maybe a -> a
fromJust :: Maybe a -> a
fromJust simply assumes that you will always provide it a Just x, and return x, in the other case, it will throw an exception.
fromMaybe on the other hand expects two parameters, the first - an a is the "default case" the value that should be returned in case of Nothing. Next it is given a Maybe a and in case it is a Just x, x is returned. In the other case (Nothing) as said before the default is returned.
In your comment you say x should be returned in case no such factor exists. So I propose you define a new function:
firstFactorOfJust :: Integral a => a -> a
firstFactorOfJust x = fromMaybe x $ firstFactorOf x
So this function firstFactorOfJust calls your firstFactorOf function and if the result is Nothing, x will be returned. In the other case, the outcome of firstFactorOf will be returned (but only the Integral part, not the Just ... part).
EDIT (simplified)
Based on your own answer that had the intend to simplify things a bit, I had the idea that you can simplify it a bit more:
firstFactorOf x | Just z <- find ((0 ==) . mod x) [2..x-1] = z
| otherwise = x
and since we are all fan of optimization, you can already stop after sqrt(x) iterations (a well known optimization in prime checking):
isqrt :: Int -> Int
isqrt = floor . sqrt . fromIntegral
firstFactorOf x | Just z <- find ((0 ==) . mod x) [2..isqrt x] = z
| otherwise = x
Simplified question
For some reason there was some peculiarly complicated aspect in your question:
firstFactorOf x
| m == Nothing = m
| otherwise = m
where m =(find p [2..x-1])
p y = mod x y == 0
Why do you use guards to make a distinction between two cases that generate the exact same output? You can fold this into:
firstFactorOf x = m
where m = (find p [2..x-1])
p y = mod x y == 0
and even further:
firstFactorOf x = find p [2..x-1]
where p y = mod x y == 0
If you want it to return the first factor of x, or x, then this should work:
firstFactorOf x =
let
p y = mod x y == 0
m = (find p [2..x-1])
in
fromMaybe x m
import Data.List
import Data.Maybe
firstFactorOf x
| m == Nothing = x
| otherwise = fromJust m
where m =(find p [2..x-1])
p y = mod x y == 0
This was what I was after. Not sure why you guys made this so complicated.

Euler 75 what is wrong, I have all primitive triangles and multiples but still something fails

Basetri looks just like the wikipedia definition of the euclidian
algorithm (but i only save perimeter) , and seems to generate all
triangles.
Timesify gives all multiples of these triangles (the 120 triangle
appears 3 times)
Then i concatenate, sort and group to give list of lists with each of
the perimeters in same group, then filter the ones with more than 1
just one way to make the perimeter.
This should give me all the triangles that are just possible to do in just one way, however length euler75 = 157730 does not seem to be the valid answer.
euler75 = filter justOneElement $ group $ sort $ concat $ timesify (takeWhile (<=1500000) basetri)
justOneElement (x:[]) = True
justOneElement _ = False
basetri = [((x m n + y m n + z m n)) | m<-[1..700],n<-[1..(m-1)], odd (m-n),gcd m n == 1]
where
x m n = (m^2 - n^2)
y m n = 2*m*n
z m n = (m^2+n^2)
timesify [] = []
timesify (x:xs) = (takeWhile (<=1500000) $ (map (*x) [1..])) : timesify xs
Changed to
triangs :: Integer -> [Integer]
triangs l = [p | n <- [2..1000],
m <- [1..n-1],
gcd m n == 1,
odd (m+n),
let p = 2 * (n^2 + m*n),
p <= l]
and now it works

Recursion confusion in Haskell

I hope someone can help figure out where my error lies. Calling g 3 4 0 2 (M.empty,0) [], I would expect [[2,1,0,1]] as a result. Instead, I'm seeing [[2,1,0,1],[2,1,0,1]].
The program is supposed to accumulate distinct digit patterns of length m by adding a different digit to the list each time, returning back down when reaching n-1 and up when reaching 0. The apparent problem happens in the middle when the function is called recursively for both the up and down directions.
If I comment out line 11 like so:
else g n m (digitCount + 1) (lastDigit + 1) (hash',hashCount') (lastDigit:digits)
-- g n m (digitCount + 1) (lastDigit - 1) (hash',hashCount') (lastDigit:digits)
I get the correct result []
As when commenting out line 11 and modifying line 10 to:
else g n m (digitCount + 1) (lastDigit - 1) (hash',hashCount') (lastDigit:digits)
Again, a correct result [[2,1,0,1]]
Why when calling g twice using the ++ operator, I'm getting two [2,1,0,1]'s instead of just one? In my thinking, each result in g should be distinct because in any recursive call, a different order of digits is (or should be) accumulating.
Thanks in advance.
import qualified Data.Map as M
g :: Int -> Int -> Int -> Int -> (M.Map Int Bool, Int) -> [Int] -> [[Int]]
g n m digitCount lastDigit (hash,hashCount) digits
| digitCount == m = if test then [reverse digits] else []
| otherwise =
if lastDigit == 0
then g n m (digitCount + 1) (lastDigit + 1) (hash',hashCount') (lastDigit:digits)
else if lastDigit == n - 1
then g n m (digitCount + 1) (lastDigit - 1) (hash',hashCount') (lastDigit:digits)
else g n m (digitCount + 1) (lastDigit + 1) (hash',hashCount') (lastDigit:digits)
++ g n m (digitCount + 1) (lastDigit - 1) (hash',hashCount') (lastDigit:digits)
where test = hashCount == n
(hash',hashCount') =
if test
then (M.empty,hashCount)
else case M.lookup lastDigit hash of
Just anyting -> (hash,hashCount)
Nothing -> (M.insert lastDigit True hash,hashCount + 1)
Now that you've got it working, here's a more generic approach.
We need to walk the tree of solutions.
data S a = Solution a | Explore [S a]
Solutions are leaves of this tree, Explore are lists of options to explore.
-- this is very much unfoldr-like
generator :: [S a] -> [a]
generator [] = []
generator (Solution a: ss) = a: generator ss
generator (Explore ps: ss) = generator $ ss ++ ps
Now, given a list of "maybe-solutions", produce a list of solutions. The generator pattern-matches Explores, and appends the list of solutions to explore to the end of the list. This way we are exploring the solutions breadth-first, and that way we can deal with non-terminating branches. (Depth-first can't get out of non-terminating branches). This of course is at expense of memory, but you can find a finite number of solutions even for problems with infinite number of solutions.
Now, the function that generates solutions for your problem:
g :: Int -> Int -> [S [Int]]
g n m = [Explore $ g' [i] (S.singleton i) | i <- [1..n-1]] where
g' is#(h:_) ms
| h < 0 || h >= n || length is > m = [] --no solution, nothing to explore
| otherwise = maybeSolution ++
[ Explore $ g' ((h-1):is) $ S.insert (h-1) ms
, Explore $ g' ((h+1):is) $ S.insert (h+1) ms ]
where
maybeSolution
| S.size ms == n = [Solution is]
| otherwise = []
Given n and m, produces a list of subtrees to Explore. g' is the helper function that produces a list of subtrees, given a list of Int already produced and a Set of Int already used. So, there is a definite termination condition: we appended a number outside the needed range, or the list became too long - exploring any further cannot produce Solutions, so return []. Otherwise, we are within bounds, maybeSolution sees if the list of Ints is already a valid solution, and suggests more subtrees to explore.
main = print $ map reverse $ generator $ g 3 6
Your problem solved.
Why when calling g twice using the ++ operator, I'm getting two [2,1,0,1]'s instead of just
one? In my thinking, each result in g should be distinct because in any recursive call, a
different order of digits is (or should be) accumulating.
But your pair of (Map,Int) is the same in both calls, so the recursive calls don't know what has been found by the other call. Consider the call g ... (lastDigit-1). It will also call g ... (lastDigit) (by adding 1 to (lastDigit-1) that it got), and follow the branch g ... (lastDigit+1) to produce the same result.
Also, (Map a ()) is a (Set a), and since you don't use the Bool value from the map, it is the same as ():
import qualified Data.Set as S
g :: Int -> Int -> Int -> Int -> (S.Set Int, Int) -> [Int] -> [[Int]]
g n m digitCount lastDigit (hash,hashCount) digits
| digitCount == m = if test then [reverse digits] else []
| lastDigit < 0 || lastDigit == n = []
| otherwise = g n m d' (lastDigit + 1) h' (lastDigit:digits)
++ g n m d' (lastDigit - 1) h' (lastDigit:digits)
where test = hashCount == n
d' = digitCount + 1
h'
| test = (S.empty,hashCount)
| S.member lastDigit hash = (hash,hashCount)
| otherwise = (S.insert lastDigit hash,hashCount + 1)
In your two recursive calls to g combined with (++) in the final else branch, you are passing exactly the same parameters except for lastDigit.
The base case of your recursion doesn't look at lastDigit - it just compares m and digitCount, n and hashCount and then returns [reverse digits].
So in any situation where the (++) case is hit immediately followed by the base case returning [reverse digits], you'll get the same value repeated.
I didn't fully understand your problem specification but perhaps you need to add the "new" value for lastDigit to digits when you make the recursive calls - i.e. (lastDigit-1):digits or (lastDigit+1):digits.

Resources