A not yet working try to resolve pb61

061.hs

@@ -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