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)

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