Sieve of Sundaram - list comprehension - haskell

I am trying to write a function that calculates all odd prime numbers from 1..n using the "Sieve of Sundaram" algorithm.
Here is my try:
sSund :: Integer -> [Integer]
sSund n = [ i * 2 + 1 | i <- [1..n], j <- [f i], (i + j + 2 * i * j) > n ]
where f 1 = 1
f y = y + 1 --use function f because i don't know how insert 1 into j's list
But it gives some wrong numbers like 9,15,21,25, etc.
*Main> sSund 30
[7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,51,53,55,57,59,61]
What am I doing wrong?

How it works
Sundaram's seive works by focussing on the odd numbers 2n+1, and excluding those that are the product of numbers.
If two numbers multiply to make an odd number, they must both be odd, so our number 2n+1 = (2i+1)(2j+1). If we multiply that out we get 2n+1 = 4ij + 2i +2j + 1, which we can simplify to 2n=4ij+2i+2j, which again simplifies to n=2ij+i+j. So we don't want n if we can write it as 2ij+i+j. This is true for any numbers i and j, but it's OK to just get rid of the ones where i<=j, because otherwise you're definitely excluding the same number twice.
Fixing your code
In your code, you generate some numbers i + j + 2 * i * j to be excluded, but you in fact just exclude the i instead of the i + j + 2 * i * j. The j<-[f i] just gives you a single j value in a list instead all the numbers from i up to n, which you should write as [i..n].
It's much simpler to just generate the exclusion list first:
sSundDelete :: Integer -> [Integer]
sSundDelete n = [i+j+2*i*j|i<-[1..n], j<-[i..n]]
Here I've decided to just allow i and j to be between 1 and n, because otherwise 2ij+i+j is definitely bigger than n.
Now we can make a list of numbers x which don't include these numbers, and then make them odd with the formula 2*n+1:
sSund :: Integer -> [Integer]
sSund n = let del = sSundDelete n in
2:[2*x+1 | x <- [1..n], not (x `elem` del)]
Which correctly gives you
> sSund 30
[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61]
Speeding things up
It's not as fast as it could be, though, because if you look at
> sSundDelete 10
[4,7,10,13,16,19,22,25,28,31,12,17,22,27,32,37,42,47,52,24,31,38,45,52,59,66,73,40,49,58,67,76,85,94,60,71,82,93,104,115,84,97,110,123,136,112,127,142,157,144,161,178,180,199,220]
it has numbers much bigger than we need - sSund 10 only goes as far as 2*10+1=21. This means we're checking our numbers again and again against numbers that we didn't consider anyway!
The simplest thing to do about this is to rewrite sSundDelete to say
sSundDelete n = [i+j+2*i*j|i<-[1..n], j<-[i..n],i+j+2*i*j<=n]
very much as you did, or
sSundDelete n = filter (<= n) [i+j+2*i*j|i<-[1..n], j<-[i..n]]
Using a bit of maths to speed things up
The problem with these is that they generate too many numbers and then throw them away. It would be faster to generate only the numbers we need.
Actually, I think it's best to calculate how far to go. the smallest j we will ever use is i, so the smallest that 2ij+i+j can be is 2i2+2i. If we don't want that to be over n, we want 2i2+2i<=n, which we can rewrite as 2i(i+1)<=n. Correctness is more important than efficiency, so it's OK to go over n a bit, but it's important not to miss out numbers below n, so we're OK to say 2i2<=n. This can be expressed as i <= floor (sqrt (fromIntegral n / 2)) (floor truncates decimals, so floor 35.7 is 35, and fromIntegral is used here to convert n to a floating point number (allowing non-integers) so we can do division and square roots.
That was a lot of working out, but now we can just calculate once how big i should go:
sSundDelete n = filter (<= n) [i+j+2*i*j|i<-[1..floor (sqrt (fromIntegral n / 2))], j<-[i..n]]
We can do a similar job on j. We want 2ij+i+j<=n, which we can rearrange to say (2i+1)j<=n-i which can be done as j<=floor( (n'-i')/(2*i'+1)) where i'=fromIntegral i and n'=fromIntegral n. This gives us
sSundDelete n = [i+j+2*i*j|let n'=fromIntegral n,
i<-[1..floor (sqrt (n' / 2))],
let i' = fromIntegral i,
j<-[i..floor( (n'-i')/(2*i'+1))]]
This makes it fast enough for me to not give up waiting for sSund 5000 to calculate the second prime number!

Related

Factorial function returning negative number for large input

My factorial function seems to work for numbers between 1 and 6, but not for numbers much bigger than 6, for example starting with 21! the results are negative.
I cannot figure out why. Here's my function:
factorial :: Int -> Int
factorial 0 = 1
factorial 1 = 1
factorial num = num * factorial( num - 1)
And here's my binomial coefficient function that calls my factorial function (maybe the problem comes from this one ?):
binomialCoef :: Int -> Int -> Int
binomialCoef n 1 = n
binomialCoef n k = factorial n `div`
((factorial k) * factorial (n - k))
(…) realized my factorial function returns negative numbers starting at 21!, and I can't figure out why.
Because an Int has a fixed number of bits. An Int should at least represent all numbers between -2-29 and 229-1, and on a 64-bit system, typically it will represent numbers between -2-63 and 263-1, but regardless what bounds it represents, it will eventually run out of bits to represent such number.
You can work with Integer to represent arbitrary large numbers:
factorial :: Integer -> Integer
factorial 0 = 1
factorial 1 = 1
factorial num = num * factorial (num-1)
For example:
Prelude> factorial 21
51090942171709440000
Prelude> factorial 22
1124000727777607680000
The binomial coefficient is where ln(gamma) really shines:
Bi(n, k) = n!/(k!*(n-k)!)
Taking the natural log of both sides:
ln(Bi(n, k)) = ln(n!) - ln(k!) - ln((n-k)!)
But
gamma(n) = (n-1)!
Or
gamma(n+1) = n!
Substituting
ln(Bi(n, k)) = lngamma(n+1) - lngamma(k+1) -lngamma(n-k+1)
Taking the exponential of both sides gives the final result:
Bi(n, k) = exp(lngamma(n+1) - lngamma(k+1) - lngamma(n-k+1))
There's a Haskell implementation. I haven't looked at it, but it should return a Double instead of an Integer. You won't have overflow problems because of that fact. It'll also be better behaved because you will be subtracting logarithms instead of dividing a large numerator by a large product in the denominator.
Of course best way to avoid integer overflow and wrap-around while calculating a big factorial is not to calculate the factorial in the first place. Instead, since
factorial n = product [1..n]
keeping [1..n] as the representation of the factorial of n is as good -- or even much better -- as calculating the actual number. Postponing an action until absolutely unavoidable we get to pre-optimize it before post-calculating:
bincoef :: Int -> Int -> Int
bincoef n k = factorial n `div`
((factorial k) * factorial (n - k))
= product [1 .. n] `div`
(product [1 .. k] * product [1 .. n-k])
= product [n-k+1 .. n] `div`
product [1 .. k]
= foldl' g 1 $ zip [n, n-1 .. n-k+1] [1 .. k]
where g !acc (a,b) = (acc * a) `div` b
So now,
> mapM_ (\n -> print $ map (bincoef n) [5,10..n]) [20,30..60]
[15504,184756,15504,1]
[142506,30045015,155117520,30045015,142506,1]
[658008,847660528,40225345056,137846528820,40225345056,847660528,658008,1]
[2118760,10272278170,2250829575120,47129212243960,126410606437752,47129212243960,
2250829575120,10272278170,2118760,1]
[5461512,75394027566,53194089192720,4191844505805495,51915437974328292,1182645815
64861424,51915437974328292,4191844505805495,53194089192720,75394027566,5461512,1]
> head . filter (not . snd) $ map (\n -> (n, all (> 0) $ map (bincoef n) [1..n])) [1..]
(62,False)
the Int wrap-around error makes its first appearance at n=62. But it's still working at n=60, and we can see there are more than 16 digits in those numbers, so no Double-based calculation has a hope of working correctly, there.
To get into yet higher ranges still with the Int-based operations only, the next logical step is keeping the lists of integers as originally proposed, or better yet as their prime factorizations which are easy to multiply and divide; but at that point we'd be getting pretty close to re-implementing the bignum arithmetic ourselves, so might as well just use the simple Integer-based code,
bc :: Integer -> Integer -> Integer
bc n k = product [n-k+1 .. n] `div` product [1 .. k]
which "just works".
> bc 600 199
124988418115780688528958442419612410733294315465732363826979722360319899409241320138
666379143574138790334901309769571503484430553926248548697640619977793300443439200

How to tell if a number is a square number with recursion?

I solved the following exercise, but I'm not a fan of the solution:
Write the function isPerfectSquare using recursion, to tell if an
Int is a perfectSquare
isPerfectSquare 1 -> Should return True
isPerfectSquare 3 -> Should return False
the num+1 part is for the case for isPerfectSquare 0 and isPerfectSquare 1, one of the parts I don't like one bit, this is my solutiuon:
perfectSquare 0 1 = [0] ++ perfectSquare 1 3
perfectSquare current diff = [current] ++ perfectSquare (current + diff) (diff + 2)
isPerfectSquare num = any (==num) (take (num+1) (perfectSquare 0 1))
What is a more elegant solution to this problem? of course we can't use sqrt, nor floating point operations.
#luqui you mean like this?
pow n = n*n
perfectSquare pRoot pSquare | pow(pRoot) == pSquare = True
| pow(pRoot)>pSquare = perfectSquare (pRoot-1) pSquare
| otherwise = False
--
isPerfectSquare number = perfectSquare number number
I can't believe I didn't see it xD thanks a lot! I must be really tired
You can perform some sort of "binary search" on some implicit list of squares. There is however a problem of course, and that is that we first need an upper bound. We can use as upper bound the number itself, since for all integral squares, the square is larger than the value we square.
So it could look like:
isPerfectSquare n = search 0 n
where search i k | i > k = False
| j2 > n = search i (j-1)
| j2 < n = search (j+1) k
| otherwise = True
where j = div (i+k) 2
j2 = j * j
To verify that a number n is a perfect square, we thus have an algorithm that runs in O(log n) in case the integer operations are done in constant time (for example if the number of bits is fixed).
Wikipedia suggests using Newton's method. Here's how that would look. We'll start with some boilerplate. ensure is a little combinator I've used fairly frequently. It's written to be very general, but I've included a short comment that should be pretty explanatory for how we'll plan to use it.
import Control.Applicative
import Control.Monad
ensure :: Alternative f => (a -> Bool) -> a -> f a
ensure p x = x <$ guard (p x)
-- ensure p x | p x = Just x
-- | otherwise = Nothing
Here's the implementation of the formula given by Wikipedia for taking one step in Newton's method. x is our current guess about the square root, and n is the number we're taking the square root of.
stepApprox :: Integer -> Integer -> Integer
stepApprox x n = (x + n `div` x) `div` 2
Now we can recursively call this stepping function until we get the floor of the square root. Since we're using integer division, the right termination condition is to watch for the next step of the approximation to be equal or one greater to the current step. This is the only recursive function.
iterateStepApprox :: Integer -> Integer -> Integer
iterateStepApprox x n = case x' - x of
0 -> x
1 -> x
_ -> iterateStepApprox x' n
where x' = stepApprox x n
To wrap the whole development up in a nice API, to check if a number is a square we can just check that the floor of its square root squares to it. We also need to pick a starting approximation, but we don't have to be super smart -- Newton's method converges very quickly for square roots. We'll pick half the number (rounded up) as our approximation. To avoid division by zero and other nonsense, we'll make zero and negative numbers special cases.
isqrt :: Integer -> Maybe Integer
isqrt n | n < 0 = Nothing
isqrt 0 = Just 0
isqrt n = ensure (\x -> x*x == n) (iterateStepApprox ((n+1)`div`2) n)
Now we're done! It's pretty fast even for large numbers:
> :set +s
> isqrt (10^10000) == Just (10^5000)
True
(0.58 secs, 182,610,408 bytes)
Yours would spend rather a longer time than the universe has got left computing that. It is also marginally faster than the binary search algorithm in my tests. (Of course, not hand-rolling it yourself is several orders of magnitude faster still, probably in part because it uses a better, but more complicated, algorithm based on Karatsuba multiplication.)
If the function is recursive then it is primitive recursive as are 90% of all recursive functions. For these folds are fast and effective. Considering the programmers time, while keeping things simple and correct is important.
Now, that said, it might be fruitful to cinsider text patterns of functions like sqrt. sqrt return a floating point number. If a number is a perfect square then two characters are ".0" at the end. The pattern might occur, however, at the start of any mantissa. If a string goes in, in reverse, then "0." is at the top of the list.
This function takes a Number and returns a Bool
fps n = (take 2.reverse.show $ (n / (sqrt n))) == "0."
fps 10000.00001
False
fps 10000
True

Smallest number divisible by 10^n with digits totaling n -- Haskell

I need to do this program:
minor :: Integer -> Integer
such that (minor n) is the smallest number divisible by 10^n whose digits add up to n. For example,
minor 5 == 500000
minor 20 == 29900000000000000000000
length (show (minor 67^35+3)) == a
I have tried this
minor :: Integer -> Integer
minor n = minimum [x | x <- [n*10^n..], rem x 10^n == 0, sum (digits x) == n]
digits :: Integer -> [Integer]
digits n = [read[d] | d <- show n]
But it's very inefficient, because the computer gets stuck. How would they do that? Thanks.
There are 2 key observations which can be made for this problem:
The number always ends with n zeros.
The rest of the digits are all 9 (except maybe the first digit).
This means you can find the number of nines by dividing by 9, and you can find the left-most digit by using the remainder from that division.
20 = 2 + (2 * 9) = 2 + 9 + 9 ⇒ 299
35 = 8 + (3 * 9) = 8 + 9 + 9 + 9 ⇒ 8999
In Haskell, you can use quotRem to divide by 9 and get both the quotient and remainder at the same time. You can then use these numbers to construct the output number.
minor :: Integer -> Integer
minor n = ((r + 1) * (10 ^ q) - 1) * (10 ^ n)
where (q, r) = n `quotRem` 9
If you're only interested in calculating the number of digits in the output, you can find that out by observing the parts of minor that serve as exponents to 10, namely q and n. If r isn't 0, you can add 1 more digit.
minorLength :: Integer -> Integer
minorLength n = signum r + q + n
where (q, r) = n `quotRem` 9
You can compute the number of digits in the minor of a number without ever computing the number's minor directly, and this is important if you want to know the number of digits in the minors of large inputs.
Willem describes the main first trick: the minor of a number is a single digit, followed by a bunch of 9s, followed by a bunch of 0s. Since we only care how many there are, we can compute those things directly.
numLeadingDigits n = signum (n `mod` 9)
num9s n = n `div` 9
num0s n = n
Now the complete length is just the sum of these.
numDigitsInMinor n = numLeadingDigits n + num9s n + num0s n
This can indeed be run on enormous inputs:
> numDigitsInMinor (67^35 + 3)
9086059680492581695084814449385436459012675694436486492711692052
Computing this minor explicitly would have required 10^63 bytes of memory, many orders of magnitude over the total amount of storage ever produced by the human race in all of history.
Calculating the smallest number
Instead of using a brute force algorithm, we first better think how we can find such number.
A number that is dividably by 10n has n tailing zeros. For example for n=3, then the numbers are 1000, 2000, 3000, etc.
Next we want to find the smallest this means that the digits we have control over (the ones before the last n should be as large as possible at the tail, in order to be small at the lead). The digits are limited between zero and nine.
So we can look for the smallest number where the sum of the digits is n with:
smallest_sum :: (Num n, Ord n) => n -> n
smallest_sum 0 = 0
smallest_sum x = d + 10 * smallest_sum (x - d)
where d = min 9 x
So here d = min 9 x is the digit we calculate, and the digits before are calculated with recursion.
So now the smallest number that satisfies these constraints is:
minor :: Integral i => i -> i
minor n = smallest_sum n * 10 ^ n
So this works in linear time with the value of n.
Examples:
Prelude> minor 5
500000
Prelude> minor 20
29900000000000000000000
Prelude> minor 0
0
Prelude> minor 1
10
Prelude> minor 2
200
Prelude> minor 3
3000
Prelude> minor 4
40000
Prelude> minor 5
500000
Prelude> minor 6
6000000
Prelude> minor 7
70000000
Prelude> minor 8
800000000
Prelude> minor 9
9000000000
Prelude> minor 10
190000000000
The length of that number
But this will, like #DanielWagner says, not suffice to calculate the length, since that number will be gigantic: for 67^35+3 it will contain approximately 10^64 digits, this can not be stored in memory. The point is that we do not have to calculate the number itself in order to calculate the length, we can derive the length with:
length_minor :: Integral i => i -> i
length_minor n = length_smallest_sum n + n
where length_smallest_sum n = div (n+8) 9
So a very compact function that calculates it is:
length_minor :: Integral i => i -> i
length_minor n = div (n+8) 9 + n
or even more compact (but if we use a small integer representation, a bit dangerous for overflow):
length_minor :: Integral i => i -> i
length_minor n = div (10*n+8) 9

ruby while loop translated to haskell

I've just started learning a bit of Haskell and functional programming, but I find it very difficult getting a hang of it :)
I am trying to translate a small piece of ruby code to Haskell (because I like the concept functional programming and Haskell proposes and even more because I come from a mathematics field and Haskell seems very mathematical):
class Integer
def factorial
f = 1; for i in 1..self; f *= i; end; f
end
end
boundary = 1000
m = 0
# Brown Numbers - pair of integers (m,n) where n factorial is equal with square root of m
while m <= boundary
n = 0
while n <= boundary
puts "(#{m},#{n})" if ((n.factorial + 1) == (m ** 2))
n += 1
end
m += 1
end
I could only figure out how to do factorials:
let factorial n = product [1..n]
I cannot figure out how to do the while loops or equivalent in Haskell, even though I found some examples that were far to confusing for me.
The idea is that the loops start from 0 (or 1) and continue (with an increment of 1) until it reaches a boundary (in my code is 1000). The reason there is a boundary is because I was thinking of starting parallel tasks that do the same operation but on different intervals so the results that I expect are returned faster (one operation would be done on 1 to 10000, another on 10000 to 100000, etc.).
I would really appreciate it if anyone could help out with this :)
Try this:
let results = [(x,y) | x <- [1..1000], y <- [1..1000] ,1 + fac x == y*y]
where fac n = product [1..n]
This is a list comprehension. More on that here.
To map it to your Ruby code,
The nested loops in m and n are replaced with x and y. Basically there is iteration over the values of x and y in the specified ranges (1 to 1000 inclusive in this case).
The check at the end is your filter condition for getting Brown numbers.
where allows us to create a helper function to calculate the factorial.
Note that instead of a separate function, we could have computed the factorial in place, like so:
(1 + product[1..x]) == y * y
Ultimately, the (x,y) on the left side means that it returns a list of tuples (x,y) which are your Brown numbers.
OK, this should work in your .hs file:
results :: [(Integer, Integer)] --Use instead of `Int` to fix overflow issue
results = [(x,y) | x <- [1..1000], y <- [1..1000] , fac x == y*y]
where fac n = product [1..n]
To add to shree.pat18's answer, maybe an exercise you could try is to translate the Haskell solution back into Ruby. It should be possible, because Ruby has ranges, Enumerator::Lazy and Enumerable#flat_map. The following rewritten Haskell solution should perhaps help:
import Data.List (concatMap)
results :: [(Integer, Integer)]
results = concatMap (\x -> concatMap (\y -> test x y) [1..1000]) [1..1000]
where test x y = if fac x == y*y then [(x,y)] else []
fac n = product [1..n]
Note that Haskell concatMap is more or less the same as Ruby Enumerable#flat_map.

My solution for Euler Project #3 is too slow

I'm new to Haskell and tinkering around with the Euler Project problems. My solution for problem #3 is far too slow. At first I tried this:
-- Problem 3
-- The prime factors of 13195 are 5, 7, 13 and 29.
-- What is the largest prime factor of the number 600851475143 ?
problem3 = max [ x | x <- [1..n], (mod n x) == 0, n /= x]
where n = 600851475143
Then I changed it to return all x and not just the largest one.
problem3 = [ x | x <- [1..n], (mod n x) == 0, n /= x]
where n = 600851475143
After 30 minutes, the list is still being processed and the output looks like this
[1,71,839,1471,6857,59569,104441,486847,1234169,5753023,10086647,87625999,408464633,716151937
Why is it so slow? Am I doing something terribly wrong or is it normal for this sort of task?
With your solution, there are about 600 billion possible numbers. As noted by delnan, making every check of the number quicker is not going to make much difference, we must limit the number of candidates.
Your solution does not seem to be correct either. 59569 = 71 * 839 isn't it? The question
only asks for prime factors. Notice that 71 and 839 is in your list so you are
doing something right. In fact, you are trying to find all factors.
I think the most dramatic effect you get simply by dividing away the factor before continuing.
euler3 = go 2 600851475143
where
go cand num
| cand == num = [num]
| cand `isFactorOf` num = cand : go cand (num `div` cand)
| otherwise = go (cand + 1) num
isFactorOf a b = b `mod` a == 0
This may seem like an obvious optimization but it relies on the fact that if both a and b divides c and a is coprime to b then a divides c/b.
If you want to do more, the common "Only check until the square root" trick has been
mentioned here. The same trick can be applied to this problem, but the performance gain does not show, unfortunately, on this instance:
euler3 = go 2 600851475143
where
go cand num
| cand*cand > num = [num]
| cand `isFactorOf` num = cand : go cand (num `div` cand)
| otherwise = go (cand + 1) num
isFactorOf a b = b `mod` a == 0
Here, when a candidate is larger than the square root of the remaining number (num), we know that num must be a prime and therefore a prime factor of the original
number (600851475143).
It is possible to remove even more candidates by only considering prime numbers,
but this is slightly more advanced because you need to make a reasonably performant
way of generating primes. See this page for ways of doing that.
It's doing a lot of work! (It's also going to give you the wrong answer, but that's a separate issue!)
There are a few very quick ways you could speed it up by thinking about the problem a little first:
You are applying your function over all numbers 1..n, and checking each one of them to ensure it isn't n. Instead, you could just go over all numbers 1..n-1 and skip out n different checks (small though they are).
The answer is odd, so you can very quickly filter out any even numbers by going from 1..(n-1)/2 and checking for 2x instead of x.
If you think about it, all factors occur in pairs, so you can in fact just search from 1..sqrt(n) (or 1..sqrt(n)/2 if you ignore even numbers) and output pairs of numbers in each step.
Not related to the performance of this function, but it's worth noting that what you've implemented here will find all of the factors of a number, whereas what you want is only the largest prime factor. So either you have to test each of your divisors for primality (which is going to be slow, again) or you can implement the two in one step. You probably want to look at 'sieves', the most simple being the Sieve of Eratosthenes, and how you can implement them.
A complete factorization of a number can take a long time for big numbers. For Project Euler problems, a brute force solution (which this is) is usually not enough to find the answer in your lifetime.
Hint: you do not need to find all prime factors, just the biggest one.
TL;DR: The two things you were doing non-optimally, are: not stopping at the square root, and not dividing out each smallest factor, as they are found.
Here's a little derivation of the (2nd) factorization code shown in the answer by HaskellElephant. We start with your code:
f1 n = [ x | x <- [2..n], rem n x == 0]
n3 = 600851475143
Prelude> f1 n3
[71,839,1471,6857,59569,104441,486847Interrupted.
So it doesn't finish in any reasonable amount of time, and some of the numbers it produces are not prime... But instead of adding primality check to the list comprehension, let's notice that 71 is prime. The first number produced by f1 n is the smallest divisor of n, and thus it is prime. If it weren't, we'd find its smallest divisor first - a contradiction.
So, we can divide it out, and continue searching for the prime factors of newly reduced number:
f2 n = tail $ iterate (\(_,m)-> (\f->(f, quot m f)) . head $ f1 m) (1,n)
Prelude> f2 n3
[(71,8462696833),(839,10086647),(1471,6857),(6857,1),(*** Exception: Prelude.hea
d: empty list
(the error, because f1 1 == []). We're done! (6857 is the answer, here...). Let's wrap it up:
takeUntil p xs = foldr (\x r -> if p x then [x] else x:r) [] xs
pfactors1 n = map fst . takeUntil ((==1).snd) . f2 $ n -- prime factors of n
Trying out our newly minted solution,
Prelude> map pfactors1 [n3..]
[[71,839,1471,6857],[2,2,2,3,3,1259Interrupted.
suddenly we hit a new inefficiency wall, on numbers without small divisors. But if n = a*b and 1 < a <= b, then a*a <= a*b == n and so it is enough to test only until the square root of a number, to find its smallest divisor.
f12 n = [ x | x <- takeWhile ((<= n).(^2)) [2..n], rem n x == 0] ++ [n]
f22 n = tail $ iterate (\(_,m)-> (\f->(f, quot m f)) . head $ f12 m) (1,n)
pfactors2 n = map fst . takeUntil ((==1).snd) . f22 $ n
What couldn't finish in half an hour now finishes in under one second (on a typical performant box):
Prelude> f12 n3
[71,839,1471,6857,59569,104441,486847,600851475143]
All the divisors above sqrt n3 were not needed at all. We unconditionally add n itself as the last divisor in f12 so it is able to handle prime numbers:
Prelude> f12 (n3+6)
[600851475149]
Since n3 / sqrt n3 = sqrt n3 ~= 775146, your original attempt at f1 n3 should have taken about a week to finish. That's how important this optimization is, of stopping at the square root.
Prelude> f22 n3
[(71,8462696833),(839,10086647),(1471,6857),(6857,1),(1,1),(1,1),(1,1),(1,1),(1,
1),(1,1),(1,1),(1,1),(1,1),(1,1),(1,1),(1,1),(1,1),(1,1)Interrupted
We've apparently traded the "Prelude.head: empty list" error for a non-terminating - but productive - behavior.
Lastly, we break f22 up in two parts and fuse them each into the other functions, for a somewhat simplified code. Also, we won't start over anew, as f12 does, searching for the smallest divisor from 2 all the time, anymore:
-- smallest factor of n, starting from d. directly jump from sqrt n to n.
smf (d,n) = head $ [ (x, quot n x) | x <- takeWhile ((<=n).(^2)) [d..]
, rem n x == 0] ++ [(n,1)]
pfactors n = map fst . takeUntil ((==1).snd) . tail . iterate smf $ (2,n)
This expresses guarded (co)recursion through a higher-order function iterate, and is functionally equivalent to that code mentioned above. The following now runs smoothly, and we're even able to find a pair of twin primes as a bonus there:
Prelude Saga> map pfactors [n3..]
[[71,839,1471,6857],[2,2,2,3,3,1259,6628403],[5,120170295029],[2,13,37,227,27514
79],[3,7,7,11,163,2279657],[2,2,41,3663728507],[600851475149],[2,3,5,5,19,31,680
0809],[600851475151],[2,2,2,2,37553217197],[3,3,3,211,105468049],[2,7,11161,3845
351],[5,67,881,2035853],[2,2,3Interrupted.
Here is my solution for Euler Project #3. It takes only 1.22 sec on my Macbook Air.
First we should find all factors of the given number. But we know, that even numbers can't be prime numbers (except number 2). So, to solve Euler Project #3 we need not all, but only odd factors:
getOddFactors num = [ x | x <- [3,5..num], num `rem` x == 0 ]
But we can optimize this function. If we plan to find a factor of num greater than sqrt num, we should have another factor which is less than sqrt num - and these possible factors we have found already. Hence, we can limit our list of possible factors by sqrt num:
getOddFactors num = [ x | x <- [3, 5..(floor.sqrt.fromIntegral) num],
num `rem` x == 0 ]
Next we want to know which of our odd factors of num are prime numbers:
isPrime number = [ x | x <- [3..(floor.sqrt.fromIntegral) number],
number `rem` x == 0] == []
Next we can filter odd factors of num with the function isPrime to find all prime factors of num. But to use laziness of Haskell to optimize our solution, we apply function filter isPrime to the reversed list of odd factors of the num. As soon as our function finds the first value which is prime number, Haskell stops computations and returns solution:
largestPrimeFactor = head . filter isPrime . reverse . getOddDivisors
Hence, the solution is:
ghci> largestPrimeFactor 600851475143
6857
(1.22 secs, 110646064 bytes)

Resources