Home

PureScript solution to Project Euler problem 33

2020-Jun-22 22:36
purescriptproject-euler

Problem details at Project Euler problem 33 page.

Test

1
2
3
4
5
6
7
8
9
10
11
12
13
module Euler033Test (euler33suite) where
 
import Prelude
 
import Euler033 (euler33)
import Test.Unit (TestSuite, suite, test)
import Test.Unit.Assert as Assert
 
euler33suite :: TestSuite
euler33suite =
  suite "Euler 33" do
    test "Real" do
      Assert.equal 100 (euler33 unit)

Solution

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
module Euler033 where
 
import Prelude
 
import Control.MonadZero (guard)
import Data.Array (foldl, range, reverse, zip)
import Data.Foldable (or)
import Data.Tuple (Tuple(..))
 
data Frac = Frac Int Int
 
instance showFrac :: Show Frac where
  show (Frac j k) = "Frac " <> show j <> " " <> show k
 
trivial :: Frac -> Boolean
trivial (Frac j k) = j `mod` 10 == 0 && k `mod` 10 == 0
 
digits :: Int -> Array Int
digits j = [j `mod` 10, j / 10]
 
cancelOne :: Frac -> Array (Tuple Int Int) -> Boolean
cancelOne (Frac j k) [Tuple jf kf, Tuple jg kg] =
  jf == kf && (j * kg == jg * k)
cancelOne _ _ = false
 
cancel :: Frac -> Boolean
cancel f@(Frac j k) =
  let jd = digits j
      kd = digits k
      g = [ zip jd kd
          , zip (reverse jd) kd
          , zip jd (reverse kd)
          , zip (reverse jd) (reverse kd)
          ]
  in or $ map (cancelOne f) g
 
digcan :: Frac -> Boolean
digcan j = not (trivial j) && cancel j
 
digcans :: Unit -> Array Frac
digcans _ = do
  j <- range 10 99
  k <- range 10 99
  guard $ j < k
  let f = Frac j k
  guard $ digcan f
  pure f
 
prod :: Frac -> Frac -> Frac
prod (Frac jf kf) (Frac jg kg) = Frac (jf * jg) (kf * kg)
 
lcd :: Frac -> Frac
lcd (Frac j k) =
  let f = gcd j k
  in  Frac (j / f) (k / f)
 
euler33 :: Unit -> Int
euler33 _ =
  let (Frac j k) = lcd $ foldl prod (Frac 1 1) (digcans unit)
  in  k