Question

Triangle, square, pentagonal, hexagonal, heptagonal, and octagonal numbers are all figurate (polygonal) numbers and are generated by the following formulae:

$$\begin{aligned} \text{Triangle } & P_{3,n}=\frac{n(n+1)}{2} & 1, 3, 6, 10, 15, ... \\ \text{Square } & P_{4,n}=n^2 & 1, 4, 9, 16, 25, ... \\ \text{Pentagonal } & P_{5,n}=\frac{n(3n-1)}{2} & 1, 5, 12, 22, 35, ... \\ \text{Hexagonal } & P_{6,n}=n(2n-1) & 1, 6, 15, 28, 45, ... \\ \text{Heptagonal } & P_{7,n}=\frac{n(5n-3)}{2} & 1, 7, 18, 34, 55, ... \\ \text{Octagonal } & P_{8,n}=n(3n-2) & 1, 8, 21, 40, 65, ... \end{aligned}$$

The ordered set of three 4-digit numbers: 8128, 2882, 8281, has three interesting properties.

1. The set is cyclic, in that the last two digits of each number is the first two digits of the next number (including the last number with the first).
2. Each polygonal type: triangle ($P_{3,127}=8128$), square ($P_{4,91}=8281$), and pentagonal ($P_{5,44}=2882$), is represented by a different number in the set.
3. This is the only set of 4-digit numbers with this property.

Find the sum of the only ordered set of six cyclic 4-digit numbers for which each polygonal type: triangle, square, pentagonal, hexagonal, heptagonal, and octagonal, is represented by a different number in the set.

Haskell

import qualified Data.Set as Set

stringSet :: [Int] -> Set.Set String
stringSet = Set.fromList . map show . takeWhile (< 10000) . dropWhile (< 1000)

cyclic :: String -> String -> Bool
cyclic a b = drop 2 a == take 2 b

solve :: [Set.Set String] -> [[Int]]
solve sets = [map read [a, b, c, d, e, f] | a <- Set.toList $ head sets,
                                            b <- filter (cyclic a) $ concatMap Set.toList $ tail sets,
                                            let be = filter (Set.notMember b) $ tail sets,
                                            c <- filter (cyclic b) $ concatMap Set.toList be,
                                            let ce = filter (Set.notMember c) be,
                                            d <- filter (cyclic c) $ concatMap Set.toList ce,
                                            let de = filter (Set.notMember d) ce,
                                            e <- filter (cyclic d) $ concatMap Set.toList de,
                                            let ee = filter (Set.notMember e) de,
                                            f <- filter (cyclic e) $ concatMap Set.toList ee,
                                            cyclic f a]

main :: IO ()
main = print $ sum $ head $ solve figurates
    where figurates = map stringSet [[n*(n + 1) `quot` 2 | n <- [1..]],
                                     [n*n | n <- [1..]],
                                     [n*(3*n - 1) `quot` 2 | n <- [1..]],
                                     [n*(2*n - 1) | n <- [1..]],
                                     [n*(5*n - 3) `quot` 2 | n <- [1..]],
                                     [n*(3*n - 2) | n <- [1..]]]

$ ghc -O2 -o figurate-numbers figurate-numbers.hs
$ time ./figurate-numbers
real   0m0.010s
user   0m0.010s
sys    0m0.000s

Python

#!/usr/bin/env python
def triangle(n): return n*(n+1)//2
def square(n): return n*n
def pentagonal(n): return n*(3*n-1)//2
def hexagonal(n): return n*(2*n-1)
def heptagonal(n): return n*(5*n-3)//2
def octagonal(n): return n*(3*n-2)

figurates = {
    3: [n for n in map(triangle, list(range(1000))) if n < 10000 and n >= 1000],
    4: [n for n in map(square, list(range(1000))) if n < 10000 and n >= 1000],
    5: [n for n in map(pentagonal, list(range(1000))) if n < 10000 and n >= 1000],
    6: [n for n in map(hexagonal, list(range(1000))) if n < 10000 and n >= 1000],
    7: [n for n in map(heptagonal, list(range(1000))) if n < 10000 and n >= 1000],
    8: [n for n in map(octagonal, list(range(1000))) if n < 10000 and n >= 1000]
}

def is_cyclic(a, b):
    return str(a)[-2:] == str(b)[:2]

def main():
    numbers = [(key, value) for key in list(figurates.keys()) for value in figurates[key]]
    for k1, v1 in numbers:
        for k2, v2 in [(k, v) for k, v in numbers if k not in [k1] and is_cyclic(v1, v)]:
            for k3, v3 in [(k, v) for k, v in numbers if k not in [k1, k2] and is_cyclic(v2, v)]:
                for k4, v4 in [(k, v) for k, v in numbers if k not in [k1, k2, k3] and is_cyclic(v3, v)]:
                    for k5, v5 in [(k, v) for k, v in numbers if k not in [k1, k2, k3, k4] and is_cyclic(v4, v)]:
                        for k6, v6 in [(k, v) for k, v in numbers if k not in [k1, k2, k3, k4, k5] and is_cyclic(v5, v)]:
                            if is_cyclic(v6, v1):
                                print(sum([v1, v2, v3, v4, v5, v6]))
                                return

if __name__ == "__main__":
    main()

$ time python3 figurate-numbers.py
real   0m0.339s
user   0m0.339s
sys    0m0.000s