A not yet working try to resolve pb61
This commit is contained in:
parent
5f12fd23f2
commit
f21e0a8145
1 changed files with 69 additions and 0 deletions
69
061.hs
Normal file
69
061.hs
Normal file
|
@ -0,0 +1,69 @@
|
|||
-- 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.
|
||||
|
||||
triangles, squares, pentagonals, hexagonals, heptagonals, octagonals :: [Int]
|
||||
triangles = map (\ n -> (n * (n+1)) `div` 2) [0..]
|
||||
squares = map (\ n -> n^2) [0..]
|
||||
pentagonals = map (\ n -> n*(3*n - 1)`div`2) [0..]
|
||||
hexagonals = map (\ n -> n*(2*n - 1)) [0..]
|
||||
heptagonals = map (\ n -> n*(5*n - 3)`div`2) [0..]
|
||||
octagonals = map (\ n -> n*(3*n - 2)) [0..]
|
||||
|
||||
polynumbers=[triangles,squares,pentagonals, hexagonals, heptagonals, octagonals]
|
||||
interestingNumbers=map (filter (\x -> x<10000 && x>999)) polynumbers
|
||||
|
||||
inum = concatMap (filter (\x -> x<10000 && x>999)) polynumbers
|
||||
|
||||
-- compatibles 1234 [3212,3412,1123] => [3412]
|
||||
-- last two digit of x are equal to first to digit of element of the list
|
||||
compatibles x = filter (\y -> (x `rem` 100) == (y `div` 100))
|
||||
|
||||
|
||||
solution2 = do
|
||||
x <- inum
|
||||
let m = compatibles x $ dropWhile (<= x) $ inum
|
||||
y <- m
|
||||
let n = compatibles y $ dropWhile (<= y) $ inum
|
||||
z <- n
|
||||
let o = compatibles z $ dropWhile (<= z) $ inum
|
||||
t <- o
|
||||
let p = compatibles t $ dropWhile (<= t) $ inum
|
||||
u <- p
|
||||
let q = compatibles u $ dropWhile (<= u) $ inum
|
||||
v <- q
|
||||
let r = compatibles v [x]
|
||||
w <- r
|
||||
return [w,y,z,t,u,v]
|
||||
|
||||
solution = do
|
||||
x <- interestingNumbers !! 0
|
||||
let m = compatibles x $ dropWhile (<= x) $ interestingNumbers !! 1
|
||||
y <- m
|
||||
let n = compatibles y $ dropWhile (<= y) $ interestingNumbers !! 2
|
||||
z <- n
|
||||
let o = compatibles z $ dropWhile (<= z) $ interestingNumbers !! 3
|
||||
t <- o
|
||||
let p = compatibles t $ dropWhile (<= t) $ interestingNumbers !! 4
|
||||
u <- p
|
||||
let q = compatibles u $ dropWhile (<= u) $ interestingNumbers !! 5
|
||||
v <- q
|
||||
let r = compatibles v [x]
|
||||
w <- r
|
||||
return [w,y,z,t,u,v]
|
||||
|
||||
main = do
|
||||
print $ head solution2
|
Loading…
Reference in a new issue