Commit 7df67263 authored by Nayuki's avatar Nayuki

P57, P58, P73: Added Haskell solutions.

P100: Added Haskell and Mathematica solutions.
Readme: Updated solution count.
parent 17641098
......@@ -5,7 +5,7 @@ A collection of Nayuki's program code to solve over 200 Project Euler math probl
Every solved problem has a program written in Java and usually Python. Some solutions also have Mathematica and Haskell programs. Some solution programs include a detailed mathematical explanation/proof in the comments to justify the code's logic.
All problems from #1 to #100 have a Java and Python program, and problems #1 to #50 have a Mathematica program. This package contains at least 200 solutions in Java, at least 195 in Python, at least 125 in Mathematica, and at least 90 in Haskell.
All problems from #1 to #100 have a Java and Python program, and problems #1 to #50 have a Mathematica program. This package contains at least 200 solutions in Java, at least 195 in Python, at least 125 in Mathematica, and at least 95 in Haskell.
Java solutions require JDK 7+. Python solutions are tested to work on CPython 2.7.10 and 3.4.3. Mathematica solutions are tested to work on Mathematica 5.1.
......
{-
- Solution to Project Euler problem 57
- Copyright (c) Project Nayuki. All rights reserved.
-
- https://www.nayuki.io/page/project-euler-solutions
- https://github.com/nayuki/Project-Euler-solutions
-}
limit = 1000
main = putStrLn (show ans)
ans = sum [1 | b <- take limit (contFracSeq 0 1), b]
contFracSeq :: Integer -> Integer -> [Bool]
contFracSeq n d = let
numer = d
denom = d * 2 + n
in (length (show (numer + denom)) > length (show denom)) : (contFracSeq numer denom)
{-
- Solution to Project Euler problem 58
- Copyright (c) Project Nayuki. All rights reserved.
-
- https://www.nayuki.io/page/project-euler-solutions
- https://github.com/nayuki/Project-Euler-solutions
-}
import Data.Ratio ((%))
import qualified EulerLib
{-
- From the diagram, let's observe the four corners of an n * n square (where n is odd).
- It's not hard to convince yourself that:
- * The bottom right corner always has the value n^2.
- Working clockwise (backwards):
- * The bottom left corner has the value n^2 - (n - 1).
- * The top left corner has the value n^2 - 2(n - 1).
- * The top right has the value n^2 - 3(n - 1).
-
- Furthermore, the number of elements on the diagonal is 2n - 1.
-}
target = 1 % 10
main = putStrLn (show ans)
ans = compute 0 1
compute :: Integer -> Integer -> Integer
compute numPrimes n = let newNumPrimes = numPrimes + (sum [1 | i <- [0..3], EulerLib.isPrime (n^2 - i * (n - 1))])
in if (n > 1 && newNumPrimes % (n * 2 - 1) < target) then n
else compute newNumPrimes (n + 2)
{-
- Solution to Project Euler problem 73
- Copyright (c) Project Nayuki. All rights reserved.
-
- https://www.nayuki.io/page/project-euler-solutions
- https://github.com/nayuki/Project-Euler-solutions
-}
{-
- The Stern-Brocot tree is an infinite binary search tree of all positive rational numbers,
- where each number appears only once and is in lowest terms.
- It is formed by starting with the two sentinels 0/1 and 1/1. Iterating infinitely in any order,
- between any two currently adjacent fractions Ln/Ld and Rn/Rd, insert a new fraction (Ln+Rn)/(Ld+Rd).
- See MathWorld for a visualization: http://mathworld.wolfram.com/Stern-BrocotTree.html
-
- This algorithm uses a lot of stack space (about 12000 frames). You probably need to use a JVM option like "-Xss4M".
-}
main = putStrLn (show ans)
ans = sternBrocotCount 1 3 1 2
-- Counts the number of reduced fractions n/d such that leftN/leftD < n/d < rightN/rightD and d <= 12000.
-- leftN/leftD and rightN/rightD must be adjacent in the Stern-Brocot tree at some point in the generation process.
sternBrocotCount :: Int -> Int -> Int -> Int -> Integer
sternBrocotCount leftN leftD rightN rightD = let
n = leftN + rightN
d = leftD + rightD
in if (d > 12000) then 0
else 1 + (sternBrocotCount leftN leftD n d) + (sternBrocotCount n d rightN rightD)
{-
- Solution to Project Euler problem 100
- Copyright (c) Project Nayuki. All rights reserved.
-
- https://www.nayuki.io/page/project-euler-solutions
- https://github.com/nayuki/Project-Euler-solutions
-}
import qualified EulerLib
{-
- Suppose the box has b blue discs and r red discs.
- The probability of taking 2 blue discs is [b / (b + r)] * [(b - 1) / (b + r - 1)],
- which we want to be equal to 1/2. Rearrange the equation:
- [b(b - 1)] / [(b + r)(b + r - 1)] = 1 / 2.
- 2b(b - 1) = (b + r)(b + r - 1).
- 2b^2 - 2b = b^2 + br - b + br + r^2 - r.
- b^2 - b = r^2 + 2br - r.
- b^2 - (2r + 1)b + (r - r^2) = 0.
- Apply the quadratic equation to solve for b:
- b = [(2r + 1) +/- sqrt((2r + 1)^2 - 4(r - r^2))] / 2
- = r + [1 +/- sqrt(8r^2 + 1)]/2
- = r + [sqrt(8r^2 + 1) + 1]/2. (Discard the minus solution because it would make b < r)
-
- For b to be an integer, we need sqrt(8r^2 + 1) to be odd, and also 8r^2 + 1 be a perfect square.
- Assume 8y^2 + 1 = x^2 for some integer x > 0.
- We can see this is in fact a Pell's equation: x^2 - 8y^2 = 1.
-
- Suppose we have the solution (x0, y0) such that x0 > 0 and x0 is as small as possible.
- This is called the fundamental solution, and all other solutions be derived from it (proven elsewhere).
- Suppose (x0, y0) and (x1, y1) are solutions. Then we have:
- x0^2 - 8*y0^2 = 1.
- (x0 + y0*sqrt(8))(x0 - y0*sqrt(8)) = 1.
- (x1 + y1*sqrt(8))(x1 - y1*sqrt(8)) = 1. (Similarly)
- Multiply them together:
- [(x0 + y0*sqrt(8))(x0 - y0*sqrt(8))][(x1 + y1*sqrt(8))(x1 - y1*sqrt(8))] = 1 * 1.
- [(x0 + y0*sqrt(8))(x1 + y1*sqrt(8))][(x0 - y0*sqrt(8))(x1 - y1*sqrt(8))] = 1.
- [x0*x1 + x0*y1*sqrt(8) + x1*y0*sqrt(8) + 8y0*y1][x0*x1 - x0*y1*sqrt(8) - x1*y0*sqrt(8) + 8y0*y1] = 1.
- [(x0*x1 + 8y0*y1) + (x0*y1 + x1*y0)*sqrt(8)][(x0*x1 + 8y0*y1) - (x0*y1 + x1*y0)*sqrt(8)] = 1.
- (x0*x1 + 8y0*y1)^2 - 8*(x0*y1 + x1*y0)^2 = 1.
- Therefore (x0*x1 + 8y0*y1, x0*y1 + x1*y0) is also a solution.
- By inspection, the fundamental solution is (3, 1).
-}
main = putStrLn (show ans)
ans = compute x0 y0
-- Fundamental solution
x0 = 3
y0 = 1
compute :: Integer -> Integer -> Integer
compute x y = let
sqrt = EulerLib.sqrt (y^2 * 8 + 1)
blue = (div (sqrt + 1) 2) + y
in if (mod sqrt 2 == 1 && blue + y > 10^12) then blue
else compute (x * x0 + y * y0 * 8) (x * y0 + y * x0)
(*
* Solution to Project Euler problem 100
* Copyright (c) Project Nayuki. All rights reserved.
*
* https://www.nayuki.io/page/project-euler-solutions
* https://github.com/nayuki/Project-Euler-solutions
*)
(*
* Suppose the box has b blue discs and r red discs.
* The probability of taking 2 blue discs is [b / (b + r)] * [(b - 1) / (b + r - 1)],
* which we want to be equal to 1/2. Rearrange the equation:
* [b(b - 1)] / [(b + r)(b + r - 1)] = 1 / 2.
* 2b(b - 1) = (b + r)(b + r - 1).
* 2b^2 - 2b = b^2 + br - b + br + r^2 - r.
* b^2 - b = r^2 + 2br - r.
* b^2 - (2r + 1)b + (r - r^2) = 0.
* Apply the quadratic equation to solve for b:
* b = [(2r + 1) +/- sqrt((2r + 1)^2 - 4(r - r^2))] / 2
* = r + [1 +/- sqrt(8r^2 + 1)]/2
* = r + [sqrt(8r^2 + 1) + 1]/2. (Discard the minus solution because it would make b < r)
*
* For b to be an integer, we need sqrt(8r^2 + 1) to be odd, and also 8r^2 + 1 be a perfect square.
* Assume 8y^2 + 1 = x^2 for some integer x > 0.
* We can see this is in fact a Pell's equation: x^2 - 8y^2 = 1.
*
* Suppose we have the solution (x0, y0) such that x0 > 0 and x0 is as small as possible.
* This is called the fundamental solution, and all other solutions be derived from it (proven elsewhere).
* Suppose (x0, y0) and (x1, y1) are solutions. Then we have:
* x0^2 - 8*y0^2 = 1.
* (x0 + y0*sqrt(8))(x0 - y0*sqrt(8)) = 1.
* (x1 + y1*sqrt(8))(x1 - y1*sqrt(8)) = 1. (Similarly)
* Multiply them together:
* [(x0 + y0*sqrt(8))(x0 - y0*sqrt(8))][(x1 + y1*sqrt(8))(x1 - y1*sqrt(8))] = 1 * 1.
* [(x0 + y0*sqrt(8))(x1 + y1*sqrt(8))][(x0 - y0*sqrt(8))(x1 - y1*sqrt(8))] = 1.
* [x0*x1 + x0*y1*sqrt(8) + x1*y0*sqrt(8) + 8y0*y1][x0*x1 - x0*y1*sqrt(8) - x1*y0*sqrt(8) + 8y0*y1] = 1.
* [(x0*x1 + 8y0*y1) + (x0*y1 + x1*y0)*sqrt(8)][(x0*x1 + 8y0*y1) - (x0*y1 + x1*y0)*sqrt(8)] = 1.
* (x0*x1 + 8y0*y1)^2 - 8*(x0*y1 + x1*y0)^2 = 1.
* Therefore (x0*x1 + 8y0*y1, x0*y1 + x1*y0) is also a solution.
* By inspection, the fundamental solution is (3, 1).
*)
(* Fundamental solution *)
x0 = 3;
y0 = 1;
(* Current solution *)
x = x0;
y = y0; (* An alias for the number of red discs *)
While[True,
(* Check if this solution is acceptable *)
sqrt = Sqrt[y^2 * 8 + 1];
blue = (sqrt + 1) / 2 + y;
If[OddQ[sqrt] && blue + y > 10^12,
ans = blue;
Break[]];
nextx = x * x0 + y * y0 * 8;
nexty = x * y0 + y * x0;
x = nextx;
y = nexty;]
ans
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment