icyrock.com

HomeOld blogOld blog 2

PureScript solution to Project Euler problem 60

2022-10-31 17:14

Problem details at Project Euler problem 60 page.

Test

module Euler060Test (euler60suite) where

import Prelude

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

euler60suite :: TestSuite
euler60suite =
  suite "Euler 60" do
    test "Warmup" do
      delay (Milliseconds 0.0)
      Assert.equal (Just 792) (euler60 1_000_000 1_000 4)

    test "Real" do
      delay (Milliseconds 0.0)
      Assert.equal (Just 26033) (euler60 100_000_000 10_000 5)

Solution

module Euler060 where

import Prelude

import Control.Alternative (guard)
import Control.Monad.ST (ST, for, run)
import Data.Array (all, drop, filter, foldl, head, last, singleton, snoc, takeWhile, (..))
import Data.Array.ST (STArray, peek, poke, withArray)
import Data.Foldable (sum)
import Data.Int (floor, fromString, toNumber)
import Data.Maybe (Maybe(..), fromJust)
import Data.Set as S
import Data.Number (sqrt)
import Partial.Unsafe (unsafePartial)

crosser :: forall h. Int -> STArray h Int -> ST h Unit
crosser n a =
  let sn = 1 + (floor $ sqrt $ toNumber n)
  in for 2 sn \i -> do
       v <- peek i a
       when (v == Just i) do
         let u = 1 + n / i
         for i u \j -> do
           poke (j * i) 0 a

genTable :: Int -> Array Int
genTable n = run (withArray (crosser n) (0..n))

genPrimes :: Int -> Array Int
genPrimes n = filter (_ /= 0) $ drop 2 $ genTable n

glue :: Int -> Int -> Int
glue j k =
  let sb = show j <> show k
  in unsafePartial $ fromJust $ fromString $ sb

pairs :: Array Int -> Int -> Array Int
pairs xs y = do
  j <- xs
  p <- [glue j y, glue y j]
  pure p

primePairSet :: S.Set Int -> Array Int -> Int-> Boolean
primePairSet ss xs y =
  let ps = pairs xs y
      f p = p `S.member` ss
  in all f ps

combine :: S.Set Int -> Array (Array Int) -> Array Int -> Array (Array Int)
combine ss xss ys = do
  xs <- xss
  let xsl = unsafePartial $ fromJust $ last xs
  y <- ys
  guard $ xsl < y && primePairSet ss xs y
  pure $ xs `snoc` y

euler60 :: Int -> Int -> Int -> Maybe Int
euler60 pcnt maxp ncnt =
  let psb = genPrimes pcnt
      ss = S.fromFoldable psb
      ps = takeWhile (_ < maxp) psb
      pa = singleton <$> ps
      f ca _ = combine ss ca ps
      cs = foldl f pa (2..ncnt)
      sol = sum <$> head cs
  in sol