Permalink
Browse files

Problem 36

  • Loading branch information...
1 parent 209d464 commit 4ac36f448496da2136464b38772813502f019563 @peterjoel committed Mar 25, 2012
Showing with 59 additions and 13 deletions.
  1. +10 −10 projectEuler.cabal
  2. +4 −3 src/Main.hs
  3. +45 −0 src/Problem0036.hs
View
20 projectEuler.cabal
@@ -6,7 +6,7 @@ license: AllRightsReserved
license-file: ""
copyright:
maintainer:
-build-depends: time -any, containers -any, base -any, array -any
+build-depends: array -any, base -any, containers -any, time -any
stability:
homepage:
package-url:
@@ -43,15 +43,15 @@ includes:
install-includes:
include-dirs:
hs-source-dirs: src
-other-modules: Problem0035 Problem0001 Problem0002 Problem0003
- Problem0004 Problem0005 Problem0006 Problem0007 Problem0008
- Problem0009 Problem0010 Problem0011 Problem0012 Problem0013
- Problem0014 Problem0015 Problem0016 Problem0017 Problem0018
- Problem0019 Problem0020 Problem0021 Problem0022 Problem0023
- Problem0024 Problem0025 Problem0026 Problem0027 Problem0028
- Problem0029 Problem0030 Problem0031 Problem0032 Problem0033
- Problem0034 Problem0042 Problem0067 Num.Combinations Num.Digits
- Num.Primes
+other-modules: Problem0036 Problem0035 Problem0001 Problem0002
+ Problem0003 Problem0004 Problem0005 Problem0006 Problem0007
+ Problem0008 Problem0009 Problem0010 Problem0011 Problem0012
+ Problem0013 Problem0014 Problem0015 Problem0016 Problem0017
+ Problem0018 Problem0019 Problem0020 Problem0021 Problem0022
+ Problem0023 Problem0024 Problem0025 Problem0026 Problem0027
+ Problem0028 Problem0029 Problem0030 Problem0031 Problem0032
+ Problem0033 Problem0034 Problem0042 Problem0067 Num.Combinations
+ Num.Digits Num.Primes
ghc-prof-options:
ghc-shared-options:
ghc-options: -O3
View
7 src/Main.hs
@@ -14,12 +14,13 @@ module Main (
) where
-import Problem0035
+import Problem0036
import Data.Time (diffUTCTime, getCurrentTime)
+
main = do t0 <- getCurrentTime
print =<< run
t1 <- getCurrentTime
putStrLn $ " in " ++ (show $ diffUTCTime t1 t0)
-
-
+
+
View
45 src/Problem0036.hs
@@ -0,0 +1,45 @@
+-----------------------------------------------------------------------------
+--
+-- Project Euler 36
+--
+--
+-- The decimal number, 585 = 1001001001 (binary), is palindromic in
+-- both bases.
+--
+-- Find the sum of all numbers, less than one million, which are
+-- palindromic in base 10 and base 2.
+--
+-- (Please note that the palindromic number, in either base, may not
+-- include leading zeros.)
+--
+--
+-----------------------------------------------------------------------------
+--
+-- I wanted to use pointfree, applicative style for the main part of the
+-- calculation, as an exercise. Got there in the end..
+--
+-----------------------------------------------------------------------------
+module Problem0036 (
+ run
+) where
+
+import Num.Digits
+import Control.Applicative
+
+run :: IO Integer
+run = return $ calc 999999
+
+calc :: Integer -> Integer
+calc n = (sum . doublyPalindromics) [1..(ceiling $ sqrt $ fromIntegral n)]
+
+doublyPalindromics :: [Integer] -> [Integer]
+doublyPalindromics = filter isBinaryPalindrome . decimalPalindromes
+
+isBinaryPalindrome :: Integer -> Bool
+isBinaryPalindrome = (==) <$> (fromDigitsB . reverse . digitsB) <*> id
+
+decimalPalindromes :: [Integer] -> [Integer]
+decimalPalindromes = map fromDigitsD . oddsAndEvens . map digitsD
+ where oddsAndEvens = (++) <$> (map oddDigits) <*> (map evenDigits)
+ evenDigits = (++) <$> id <*> reverse
+ oddDigits = (++) <$> reverse . tail <*> id

0 comments on commit 4ac36f4

Please sign in to comment.