69 lines
2.8 KiB
Haskell
69 lines
2.8 KiB
Haskell
-- Problem 61
|
|
--
|
|
-- Triangle, square, pentagonal, hexagonal, heptagonal, and octagonal numbers are all figurate (polygonal) numbers and are generated by the following formulae:
|
|
--
|
|
-- Triangle P3,n=n(n+1)/2 1, 3, 6, 10, 15, ...
|
|
-- Square P4,n=n2 1, 4, 9, 16, 25, ...
|
|
-- Pentagonal P5,n=n(3n1)/2 1, 5, 12, 22, 35, ...
|
|
-- Hexagonal P6,n=n(2n1) 1, 6, 15, 28, 45, ...
|
|
-- Heptagonal P7,n=n(5n3)/2 1, 7, 18, 34, 55, ...
|
|
-- Octagonal P8,n=n(3n2) 1, 8, 21, 40, 65, ...
|
|
-- 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 (P3,127=8128), square (P4,91=8281), and pentagonal (P5,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.
|
|
|
|
import Data.List (sort,(\\) )
|
|
|
|
triangles, squares, pentagonals, hexagonals, heptagonals, octagonals :: [Int]
|
|
triangles = fourNumbers $ map (\ n -> (n * (n+1)) `div` 2) [0..]
|
|
squares = fourNumbers $ map (\ n -> n^2) [0..]
|
|
pentagonals = fourNumbers $ map (\ n -> n*(3*n - 1)`div`2) [0..]
|
|
hexagonals = fourNumbers $ map (\ n -> n*(2*n - 1)) [0..]
|
|
heptagonals = fourNumbers $ map (\ n -> n*(5*n - 3)`div`2) [0..]
|
|
octagonals = fourNumbers $ map (\ n -> n*(3*n - 2)) [0..]
|
|
|
|
fourNumbers :: [Int] -> [Int]
|
|
fourNumbers = takeWhile (<10000) . dropWhile (<1000)
|
|
|
|
polynumbers=[triangles,squares,pentagonals, hexagonals, heptagonals, octagonals]
|
|
interestingNumbers=polynumbers
|
|
|
|
inum = sort $ concat polynumbers
|
|
|
|
-- compatibles 1234 [3212,3412,1123] => [3412]
|
|
-- last two digit of x are equal to first to digit of element of the list
|
|
isCompatible :: Int -> Int -> Bool
|
|
isCompatible x y = (x `rem` 100) == (y `div` 100)
|
|
compatibles :: Int -> [Int] -> [Int]
|
|
compatibles x = filter (isCompatible x)
|
|
|
|
sub :: Int -> Int -> [Int]
|
|
-- sub x = compatibles x $ dropWhile (<= x) $ inum
|
|
sub x i = compatibles x $ interestingNumbers !! i
|
|
|
|
solution = do
|
|
i <- [0..5]
|
|
x <- interestingNumbers !! i
|
|
j <- [0..5] \\ [i]
|
|
y <- sub x j
|
|
k <- [0..5] \\ [i,j]
|
|
z <- sub y k
|
|
l <- [0..5] \\ [i,j,k]
|
|
t <- sub z l
|
|
m <- [0..5] \\ [i,j,k,l]
|
|
u <- sub t m
|
|
n <- [0..5] \\ [i,j,k,l,m]
|
|
v <- sub u n
|
|
if isCompatible v x
|
|
then
|
|
return [(x,i),(y,j),(z,k),(t,l),(u,m),(v,n)]
|
|
else
|
|
return []
|
|
|
|
main = do
|
|
let toto = head $ filter (/=[]) solution
|
|
print $ map (\(x,y) -> (x,y+3)) toto
|
|
print $ sum $ map fst toto
|