icyrock.com

HomeOld blogOld blog 2

PureScript solution to Project Euler problem 61

`2022-11-30 21:53`

Problem details at Project Euler problem 61 page.

Test

``````module Euler061Test (euler61suite) where

import Prelude

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

euler61suite :: TestSuite
euler61suite =
suite "Euler 61" do
test "Warmup" do
delay (Milliseconds 0.0)
Assert.equal (Just 19291) (euler61 3)

test "Real" do
delay (Milliseconds 0.0)
Assert.equal (Just 28684) (euler61 6)

``````

Solution

``````module Euler061 where

import Prelude

import Data.Array (concatMap, cons, dropWhile, filter, foldl, head, last, singleton, snoc, take, takeWhile, uncons, zip, (..))
import Data.Foldable (sum)
import Data.Maybe (Maybe(..), fromJust)
import Data.Traversable (traverse)
import Data.Tuple (Tuple(..), fst)
import Partial.Unsafe (unsafePartial)

cyclic :: Int -> Int -> Boolean
cyclic j k = j `mod` 100 == (k / 100) `mod` 100

findOne :: Array Int -> Array (Array Int) -> Array (Array Int)
findOne h t =
let g (Tuple xs y) =
let x = unsafePartial \$ fromJust \$ last xs
in x /= y && cyclic x y
tl (Tuple xs y) = xs `snoc` y
f xss ys = tl <\$> filter g (Tuple <\$> xss <*> ys)
psols = foldl f (singleton <\$> h) t
tsols = zip psols (unsafePartial fromJust (traverse head psols))
in fst <\$> filter g tsols

select :: forall a. Array a -> Array (Tuple a (Array a))
select zs = case uncons zs of
Nothing -> []
Just {head: x, tail: xs} ->
let f (Tuple y ys) = Tuple y (x `cons` ys)
in Tuple x xs `cons` (f <\$> select xs)

perms :: forall a. Array a -> Array (Array a)
perms [] = [[]]
perms xs = do
Tuple y ys <- select xs
zs <- perms ys
pure \$ y `cons` zs

find :: Array (Array Int) -> Array (Array Int)
find nss = case uncons nss of
Nothing -> []
Just {head: h, tail: t} -> concatMap (findOne h) (perms t)

ngonals :: Int -> Int -> Array (Array Int)
ngonals l h =
let
triangle n   = n * (n + 1) / 2
square n     = n * n
pentagonal n = n * (3 * n - 1) / 2
hexagonal n  = n * (2 * n - 1)
heptagonal n = n * (5 * n - 3) / 2
octagonal n  = n * (3 * n - 2)
fs =
[ triangle
, square
, pentagonal
, hexagonal
, heptagonal
, octagonal
]
ns = (_ <\$> 1..h) <\$> fs
nsf = takeWhile (_ < h) <<< dropWhile (_ < l) <\$> ns
in nsf

euler61 :: Int -> Maybe Int
euler61 n = map sum \$ head \$ find \$ take n \$ ngonals 1_000 10_000

``````