Add solution for problem 62.

This commit is contained in:
Jesse D. McDonald 2015-09-05 00:44:13 -05:00
parent 9c24c2f0d2
commit 20472682ac
2 changed files with 22 additions and 1 deletions

View File

@ -60,6 +60,8 @@ data Decimal = Decimal { integerPart :: Integer
whenM, unlessM :: Monad m => m Bool -> m () -> m ()
whenM mc m = mc >>= (\c -> when c m)
unlessM mc m = mc >>= (\c -> unless c m)
{-# INLINE whenM #-}
{-# INLINE unlessM #-}
primesTo n = LST.runST $ do
isPrimeArr <- LST.strictToLazyST (newArray (2, n) 1 :: ST s (STUArray s Integer Word8))
@ -98,6 +100,7 @@ primeFactors n = go n primes
divides :: Integral a => a -> a -> Bool
a `divides` b = b `mod` a == 0
{-# INLINE divides #-}
class Ix a => RangeIx a where
intersectBounds :: (a, a) -> (a, a) -> (a, a)
@ -152,6 +155,7 @@ instance Show Decimal where
toDigits :: (Integral a, Integral b) => a -> [b]
toDigits = toDigitsBase 10
{-# INLINE toDigits #-}
toDigitsBase :: (Integral a, Integral b) => a -> a -> [b]
toDigitsBase n = reverse . unfoldr (\x ->
@ -159,6 +163,7 @@ toDigitsBase n = reverse . unfoldr (\x ->
fromDigits :: (Integral a, Integral b) => [a] -> b
fromDigits = fromDigitsBase 10
{-# INLINE fromDigits #-}
fromDigitsBase :: (Integral a, Integral b) => b -> [a] -> b
fromDigitsBase n = foldl' (\a b -> n * a + fromIntegral b) 0
@ -170,6 +175,6 @@ isPalindrome xs = xs == reverse xs
(\\\) :: Ord a => [a] -> [a] -> [a]
(a:as) \\\ (b:bs) = case compare a b of
LT -> a : (as \\\ (b:bs))
EQ -> as \\\ (b:bs)
EQ -> as \\\ bs
GT -> (a:as) \\\ bs
infix 5 \\\

16
Problem062.hs Normal file
View File

@ -0,0 +1,16 @@
-- The cube, 41063625 (345^3), can be permuted to produce two other cubes:
-- 56623104 (384^3) and 66430125 (405^3). In fact, 41063625 is the smallest
-- cube which has exactly three permutations of its digits which are also cube.
--
-- Find the smallest cube for which exactly five permutations of its digits are
-- cube.
import Euler
main = print $ head $ do
let cubes = map (^3) [1..]
x <- cubes
let ps = filter ((== sort (toDigits x)) . sort . toDigits)
$ takeWhile (< 10 * x) $ dropWhile (< x) cubes
guard $ length ps == 5
return x