Skip to content

Commit 7df6726

Browse files
nayukinayuki
committed
P57, P58, P73: Added Haskell solutions.
P100: Added Haskell and Mathematica solutions. Readme: Updated solution count.
1 parent 1764109 commit 7df6726

File tree

6 files changed

+200
-1
lines changed

6 files changed

+200
-1
lines changed

‎Readme.markdown

+1-1
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ A collection of Nayuki's program code to solve over 200 Project Euler math probl
55

66
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.
77

8-
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.
8+
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.
99

1010
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.
1111

‎haskell/p057.hs

+18
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
{-
2+
- Solution to Project Euler problem 57
3+
- Copyright (c) Project Nayuki. All rights reserved.
4+
-
5+
- https://www.nayuki.io/page/project-euler-solutions
6+
- https://github.com/nayuki/Project-Euler-solutions
7+
-}
8+
9+
10+
limit = 1000
11+
main = putStrLn (show ans)
12+
ans = sum [1 | b <- take limit (contFracSeq 0 1), b]
13+
14+
contFracSeq :: Integer -> Integer -> [Bool]
15+
contFracSeq n d = let
16+
numer = d
17+
denom = d * 2 + n
18+
in (length (show (numer + denom)) > length (show denom)) : (contFracSeq numer denom)

‎haskell/p058.hs

+31
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
{-
2+
- Solution to Project Euler problem 58
3+
- Copyright (c) Project Nayuki. All rights reserved.
4+
-
5+
- https://www.nayuki.io/page/project-euler-solutions
6+
- https://github.com/nayuki/Project-Euler-solutions
7+
-}
8+
9+
import Data.Ratio ((%))
10+
import qualified EulerLib
11+
12+
13+
{-
14+
- From the diagram, let's observe the four corners of an n * n square (where n is odd).
15+
- It's not hard to convince yourself that:
16+
- * The bottom right corner always has the value n^2.
17+
- Working clockwise (backwards):
18+
- * The bottom left corner has the value n^2 - (n - 1).
19+
- * The top left corner has the value n^2 - 2(n - 1).
20+
- * The top right has the value n^2 - 3(n - 1).
21+
-
22+
- Furthermore, the number of elements on the diagonal is 2n - 1.
23+
-}
24+
target = 1 % 10
25+
main = putStrLn (show ans)
26+
ans = compute 0 1
27+
28+
compute :: Integer -> Integer -> Integer
29+
compute numPrimes n = let newNumPrimes = numPrimes + (sum [1 | i <- [0..3], EulerLib.isPrime (n^2 - i * (n - 1))])
30+
in if (n > 1 && newNumPrimes % (n * 2 - 1) < target) then n
31+
else compute newNumPrimes (n + 2)

‎haskell/p073.hs

+30
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
{-
2+
- Solution to Project Euler problem 73
3+
- Copyright (c) Project Nayuki. All rights reserved.
4+
-
5+
- https://www.nayuki.io/page/project-euler-solutions
6+
- https://github.com/nayuki/Project-Euler-solutions
7+
-}
8+
9+
10+
{-
11+
- The Stern-Brocot tree is an infinite binary search tree of all positive rational numbers,
12+
- where each number appears only once and is in lowest terms.
13+
- It is formed by starting with the two sentinels 0/1 and 1/1. Iterating infinitely in any order,
14+
- between any two currently adjacent fractions Ln/Ld and Rn/Rd, insert a new fraction (Ln+Rn)/(Ld+Rd).
15+
- See MathWorld for a visualization: http://mathworld.wolfram.com/Stern-BrocotTree.html
16+
-
17+
- This algorithm uses a lot of stack space (about 12000 frames). You probably need to use a JVM option like "-Xss4M".
18+
-}
19+
main = putStrLn (show ans)
20+
ans = sternBrocotCount 1 3 1 2
21+
22+
23+
-- Counts the number of reduced fractions n/d such that leftN/leftD < n/d < rightN/rightD and d <= 12000.
24+
-- leftN/leftD and rightN/rightD must be adjacent in the Stern-Brocot tree at some point in the generation process.
25+
sternBrocotCount :: Int -> Int -> Int -> Int -> Integer
26+
sternBrocotCount leftN leftD rightN rightD = let
27+
n = leftN + rightN
28+
d = leftD + rightD
29+
in if (d > 12000) then 0
30+
else 1 + (sternBrocotCount leftN leftD n d) + (sternBrocotCount n d rightN rightD)

‎haskell/p100.hs

+57
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,57 @@
1+
{-
2+
- Solution to Project Euler problem 100
3+
- Copyright (c) Project Nayuki. All rights reserved.
4+
-
5+
- https://www.nayuki.io/page/project-euler-solutions
6+
- https://github.com/nayuki/Project-Euler-solutions
7+
-}
8+
9+
import qualified EulerLib
10+
11+
12+
{-
13+
- Suppose the box has b blue discs and r red discs.
14+
- The probability of taking 2 blue discs is [b / (b + r)] * [(b - 1) / (b + r - 1)],
15+
- which we want to be equal to 1/2. Rearrange the equation:
16+
- [b(b - 1)] / [(b + r)(b + r - 1)] = 1 / 2.
17+
- 2b(b - 1) = (b + r)(b + r - 1).
18+
- 2b^2 - 2b = b^2 + br - b + br + r^2 - r.
19+
- b^2 - b = r^2 + 2br - r.
20+
- b^2 - (2r + 1)b + (r - r^2) = 0.
21+
- Apply the quadratic equation to solve for b:
22+
- b = [(2r + 1) +/- sqrt((2r + 1)^2 - 4(r - r^2))] / 2
23+
- = r + [1 +/- sqrt(8r^2 + 1)]/2
24+
- = r + [sqrt(8r^2 + 1) + 1]/2. (Discard the minus solution because it would make b < r)
25+
-
26+
- For b to be an integer, we need sqrt(8r^2 + 1) to be odd, and also 8r^2 + 1 be a perfect square.
27+
- Assume 8y^2 + 1 = x^2 for some integer x > 0.
28+
- We can see this is in fact a Pell's equation: x^2 - 8y^2 = 1.
29+
-
30+
- Suppose we have the solution (x0, y0) such that x0 > 0 and x0 is as small as possible.
31+
- This is called the fundamental solution, and all other solutions be derived from it (proven elsewhere).
32+
- Suppose (x0, y0) and (x1, y1) are solutions. Then we have:
33+
- x0^2 - 8*y0^2 = 1.
34+
- (x0 + y0*sqrt(8))(x0 - y0*sqrt(8)) = 1.
35+
- (x1 + y1*sqrt(8))(x1 - y1*sqrt(8)) = 1. (Similarly)
36+
- Multiply them together:
37+
- [(x0 + y0*sqrt(8))(x0 - y0*sqrt(8))][(x1 + y1*sqrt(8))(x1 - y1*sqrt(8))] = 1 * 1.
38+
- [(x0 + y0*sqrt(8))(x1 + y1*sqrt(8))][(x0 - y0*sqrt(8))(x1 - y1*sqrt(8))] = 1.
39+
- [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.
40+
- [(x0*x1 + 8y0*y1) + (x0*y1 + x1*y0)*sqrt(8)][(x0*x1 + 8y0*y1) - (x0*y1 + x1*y0)*sqrt(8)] = 1.
41+
- (x0*x1 + 8y0*y1)^2 - 8*(x0*y1 + x1*y0)^2 = 1.
42+
- Therefore (x0*x1 + 8y0*y1, x0*y1 + x1*y0) is also a solution.
43+
- By inspection, the fundamental solution is (3, 1).
44+
-}
45+
main = putStrLn (show ans)
46+
ans = compute x0 y0
47+
48+
-- Fundamental solution
49+
x0 = 3
50+
y0 = 1
51+
52+
compute :: Integer -> Integer -> Integer
53+
compute x y = let
54+
sqrt = EulerLib.sqrt (y^2 * 8 + 1)
55+
blue = (div (sqrt + 1) 2) + y
56+
in if (mod sqrt 2 == 1 && blue + y > 10^12) then blue
57+
else compute (x * x0 + y * y0 * 8) (x * y0 + y * x0)

‎mathematica/p100.mathematica

+63
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,63 @@
1+
(*
2+
* Solution to Project Euler problem 100
3+
* Copyright (c) Project Nayuki. All rights reserved.
4+
*
5+
* https://www.nayuki.io/page/project-euler-solutions
6+
* https://github.com/nayuki/Project-Euler-solutions
7+
*)
8+
9+
10+
(*
11+
* Suppose the box has b blue discs and r red discs.
12+
* The probability of taking 2 blue discs is [b / (b + r)] * [(b - 1) / (b + r - 1)],
13+
* which we want to be equal to 1/2. Rearrange the equation:
14+
* [b(b - 1)] / [(b + r)(b + r - 1)] = 1 / 2.
15+
* 2b(b - 1) = (b + r)(b + r - 1).
16+
* 2b^2 - 2b = b^2 + br - b + br + r^2 - r.
17+
* b^2 - b = r^2 + 2br - r.
18+
* b^2 - (2r + 1)b + (r - r^2) = 0.
19+
* Apply the quadratic equation to solve for b:
20+
* b = [(2r + 1) +/- sqrt((2r + 1)^2 - 4(r - r^2))] / 2
21+
* = r + [1 +/- sqrt(8r^2 + 1)]/2
22+
* = r + [sqrt(8r^2 + 1) + 1]/2. (Discard the minus solution because it would make b < r)
23+
*
24+
* For b to be an integer, we need sqrt(8r^2 + 1) to be odd, and also 8r^2 + 1 be a perfect square.
25+
* Assume 8y^2 + 1 = x^2 for some integer x > 0.
26+
* We can see this is in fact a Pell's equation: x^2 - 8y^2 = 1.
27+
*
28+
* Suppose we have the solution (x0, y0) such that x0 > 0 and x0 is as small as possible.
29+
* This is called the fundamental solution, and all other solutions be derived from it (proven elsewhere).
30+
* Suppose (x0, y0) and (x1, y1) are solutions. Then we have:
31+
* x0^2 - 8*y0^2 = 1.
32+
* (x0 + y0*sqrt(8))(x0 - y0*sqrt(8)) = 1.
33+
* (x1 + y1*sqrt(8))(x1 - y1*sqrt(8)) = 1. (Similarly)
34+
* Multiply them together:
35+
* [(x0 + y0*sqrt(8))(x0 - y0*sqrt(8))][(x1 + y1*sqrt(8))(x1 - y1*sqrt(8))] = 1 * 1.
36+
* [(x0 + y0*sqrt(8))(x1 + y1*sqrt(8))][(x0 - y0*sqrt(8))(x1 - y1*sqrt(8))] = 1.
37+
* [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.
38+
* [(x0*x1 + 8y0*y1) + (x0*y1 + x1*y0)*sqrt(8)][(x0*x1 + 8y0*y1) - (x0*y1 + x1*y0)*sqrt(8)] = 1.
39+
* (x0*x1 + 8y0*y1)^2 - 8*(x0*y1 + x1*y0)^2 = 1.
40+
* Therefore (x0*x1 + 8y0*y1, x0*y1 + x1*y0) is also a solution.
41+
* By inspection, the fundamental solution is (3, 1).
42+
*)
43+
44+
(* Fundamental solution *)
45+
x0 = 3;
46+
y0 = 1;
47+
48+
(* Current solution *)
49+
x = x0;
50+
y = y0; (* An alias for the number of red discs *)
51+
52+
While[True,
53+
(* Check if this solution is acceptable *)
54+
sqrt = Sqrt[y^2 * 8 + 1];
55+
blue = (sqrt + 1) / 2 + y;
56+
If[OddQ[sqrt] && blue + y > 10^12,
57+
ans = blue;
58+
Break[]];
59+
nextx = x * x0 + y * y0 * 8;
60+
nexty = x * y0 + y * x0;
61+
x = nextx;
62+
y = nexty;]
63+
ans

0 commit comments

Comments
 (0)