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.
- 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).
- 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.
- 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.000sPython
#!/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