# icyrock.com

HomeOld blogOld blog 2

# PureScript solution to Project Euler problem 66

`2023-04-06 19:14`

Problem details at Project Euler problem 66 page.

## Test

``````module Euler066Test (euler66suite) where

import Prelude

import Data.Maybe (Maybe(..))
import Effect.Aff (Milliseconds(..), delay)
import Euler066 (euler66)
import Test.Unit (TestSuite, suite, test)
import Test.Unit.Assert as Assert

euler66suite :: TestSuite
euler66suite =
suite "Euler 66" do
test "Warmup" do
delay (Milliseconds 0.0)
Assert.equal (Just 5) (euler66 7)

test "Real" do
delay (Milliseconds 0.0)
Assert.equal (Just 661) (euler66 1000)

``````

## Solution

``````module Euler066 where

import Prelude

import Data.BigInt (BigInt, fromInt)
import Data.Foldable (maximumBy)
import Data.Int (floor, toNumber)
import Data.Lazy (defer)
import Data.List.Lazy (List(..), Step(..), catMaybes, filter, head, range, step)
import Data.Maybe (Maybe)
import Data.Number (sqrt)

irrational :: Int -> Boolean
irrational n =
let si = floor \$ sqrt \$ toNumber n
in si * si /= n

continued_fraction :: Int -> List Int
continued_fraction d =
let p0 = 0
q0 = 1
a0 = floor \$ sqrt \$ toNumber d
go p q a =
let pn = a * q - p
qn = (d - pn * pn) / q
an = (a0 + pn) / qn
in List \$ defer \_ ->
Cons a \$ go pn qn an
in go p0 q0 a0

convergents :: Int -> List {d :: Int, p :: BigInt, q :: BigInt}
convergents d =
case step \$ continued_fraction d of
Nil -> List \$ defer \_ -> Nil
Cons a0 as' ->
case step as' of
Nil -> List \$ defer \_ -> Nil
Cons a1 as'' ->
let a0b = fromInt a0
a1b = fromInt a1
b1  = fromInt 1
e0 = {d, p: a0b, q: b1}
e1 = {d, p: a0b * a1b + b1, q: a1b}
go _ _ Nil = List \$ defer \_ -> Nil
go ep ec (Cons an as''') =
let anb = fromInt an
en = {d, p: anb * ec.p + ep.p, q: anb * ec.q + ep.q}
in List \$ defer \_ ->
Cons en \$ go ec en (step as''')
in List \$ defer \_ ->
Cons e0 \$
List \$ defer \_ ->
Cons e1 \$ go e0 e1 (step as'')

solve_pell :: Int -> Maybe {d :: Int, p :: BigInt, q :: BigInt}
solve_pell d =
let cs = convergents d
f {p, q} = p * p - fromInt d * q * q == fromInt 1
in head \$ filter f cs

euler66 :: Int -> Maybe Int
euler66 = map (_.d) <<< maximumBy (comparing (_.p)) <<< catMaybes <<< map solve_pell <<< filter irrational <<< range 1

``````