# icyrock.com

HomeOld blogOld blog 2

# PureScript solution to Project Euler problem 68

`2023-06-05 18:38`

Problem details at Project Euler problem 68 page.

## Test

``````module Euler068Test (euler68suite) where

import Prelude

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

euler68suite :: TestSuite
euler68suite =
suite "Euler 68" do
test "Warmup" do
delay (Milliseconds 0.0)
Assert.equal (Just "432621513") (euler68 3 6 9)

test "Real" do
delay (Milliseconds 0.0)
Assert.equal (Just "6531031914842725") (euler68 5 10 16)

``````

## Solution

``````module Euler068 where

import Prelude

import Data.Array (all, catMaybes, length, nub, range, snoc, (!!))
import Data.Foldable (sum)
import Data.Maybe (Maybe(..), maybe)
import Data.Set as S
import Data.String (joinWith)
import Data.String as Str

valid3 :: Array Int -> Boolean
valid3 a =
let l = length a
f xs = length (nub (sum <\$> catMaybes <\$> xs)) == 1
g mx ys = maybe false (\x -> all (x < _) (catMaybes ys)) mx
in
(l < 3 || l > 4 || f [[a !! 0, a !! 1, a !! 2]])
&& (l < 5 || l > 5 || f [[a !! 0, a !! 1, a !! 2], [a !! 3, a !! 2, a !! 4]])
&& (l < 6 || f [[a !! 0, a !! 1, a !! 2], [a !! 3, a !! 2, a !! 4], [a !! 5, a !! 4, a !! 1]])
&& (l < 4 || l > 5 || g (a !! 0) [a !! 3])
&& (l < 6 ||          g (a !! 0) [a !! 3, a !! 5])

valid5 :: Array Int -> Boolean
valid5 a =
let l = length a
f xs = length (nub (sum <\$> catMaybes <\$> xs)) == 1
g mx ys = maybe false (\x -> all (x < _) (catMaybes ys)) mx
in
(l <  3 || l > 4 || f [ [a !! 0, a !! 1, a !! 2]])
&& (l <  5 || l > 6 || f [ [a !! 0, a !! 1, a !! 2], [a !! 3, a !! 2, a !! 4]])
&& (l <  7 || l > 8 || f [ [a !! 0, a !! 1, a !! 2], [a !! 3, a !! 2, a !! 4], [a !! 5, a !! 4, a !! 6]])
&& (l <  9 || l > 9 || f [ [a !! 0, a !! 1, a !! 2], [a !! 3, a !! 2, a !! 4]
, [a !! 5, a !! 4, a !! 6], [a !! 7, a !! 6, a !! 8]])
&& (l < 10 ||          f [ [a !! 0, a !! 1, a !! 2], [a !! 3, a !! 2, a !! 4]
, [a !! 5, a !! 4, a !! 6], [a !! 7, a !! 6, a !! 8], [a !! 9, a !! 8, a !! 1]])
&& (l <  4 || l > 5 || g (a !! 0) [a !! 3])
&& (l <  6 || l > 7 || g (a !! 0) [a !! 3, a !! 5])
&& (l <  8 || l > 9 || g (a !! 0) [a !! 3, a !! 5, a !! 7])
&& (l < 10 ||          g (a !! 0) [a !! 3, a !! 5, a !! 7, a !! 9])

valid :: Int -> Array Int -> Boolean
valid 3 a = valid3 a
valid 5 a = valid5 a
valid _ _ = false

ngonShow3 :: Array Int -> String
ngonShow3 a = joinWith "" \$ show <\$> catMaybes
[ a !! 0, a !! 1, a !! 2
, a !! 3, a !! 2, a !! 4
, a !! 5, a !! 4, a !! 1
]

ngonShow5 :: Array Int -> String
ngonShow5 a = joinWith "" \$ show <\$> catMaybes
[ a !! 0, a !! 1, a !! 2
, a !! 3, a !! 2, a !! 4
, a !! 5, a !! 4, a !! 6
, a !! 7, a !! 6, a !! 8
, a !! 9, a !! 8, a !! 1
]

ngonShow :: Int -> Array Int -> Maybe String
ngonShow 3 a = Just \$ ngonShow3 a
ngonShow 5 a = Just \$ ngonShow5 a
ngonShow _ _ = Nothing

maxNgon :: Int -> Int -> Int -> Maybe (Array Int)
maxNgon n d s =
let digs = S.fromFoldable (range 1 d)
goodLen ng = (Str.length <\$> ngonShow n ng) == Just s
go i ds ng
| i == d && goodLen ng = Just ng
| i == d               = Nothing
| S.isEmpty ds         = Nothing
go i ds ng =
let go2 rs =
case S.findMax rs of
Nothing -> Nothing
Just r ->
let nds = S.delete r ds
nrs = S.delete r rs
nng = ng `snoc` r
in if valid n nng
then case go (i + 1) nds nng of
Nothing -> go2 nrs
res -> res
else go2 nrs
in go2 ds
in go 0 digs []

euler68 :: Int -> Int -> Int -> Maybe String
euler68 n d s = ngonShow n =<< maxNgon n d s

``````