Ok, I got it. I was confusing myself with <$> and some of those are
clearer with map. I ended up with this, which I'm happy with:
run :: IO Int
run = return $ calc [1..999]
calc :: [Int] -> Int
calc = sum . filter isBinaryPalindrome . decimalPalindromes
isBinaryPalindrome :: Int -> Bool
isBinaryPalindrome = (==) <$> (fromDigitsB . reverse . digitsB) <*> id
decimalPalindromes :: [Int] -> [Int]
decimalPalindromes = map fromDigitsD . oddsAndEvens . map digitsD
where oddsAndEvens = (++) <$> (map oddDigits) <*> (map evenDigits)
evenDigits = (++) <$> id <*> reverse
oddDigits = (++) <$> reverse . tail <*> id
Peter
On 24 March 2012 21:18, Peter Hall
As an exercise I'm trying to rewrite a Project Euler solution below to be as point-free as possible. I'm stuck trying to extract the [1..999] range so it can be passed as an argument to calc. Can someone help me figure it out?
Thanks, Peter
module Problem0036 ( run ) where
import Num.Digits import Control.Applicative
run :: IO Int run = return $ calc
calc :: Int calc = sum $ filter isBinaryPalindrome decimalPalindromes
isBinaryPalindrome :: Int -> Bool isBinaryPalindrome = (==) <$> (fromDigitsB . reverse . digitsB) <*> id
decimalPalindromes :: [Int] decimalPalindromes = fromDigitsD <$> oddsAndEvens (digitsD <$> [1..999]) where oddsAndEvens = (++) <$> (oddDigits <$>) <*> (evenDigits <$>) evenDigits = (++) <$> id <*> reverse oddDigits = (++) <$> reverse . tail <*> id
-- The other imported module:
module Num.Digits ( digits ,digitsD ,digitsB ,fromDigits ,fromDigitsB ,fromDigitsD ) where
import Data.Char (digitToInt) import Data.List (insert, foldl1')
{-# INLINABLE digitsD #-} digitsD :: Integral a => a -> [a] digitsD = digits 10
{-# INLINABLE fromDigitsD #-} fromDigitsD :: Integral a => [a] -> a fromDigitsD = fromDigits 10
{-# INLINABLE digitsB #-} digitsB :: Integral a => a -> [a] digitsB = digits 2
{-# INLINABLE fromDigitsB #-} fromDigitsB :: Integral a => [a] -> a fromDigitsB = fromDigits 2
{-# INLINABLE digits #-} digits :: Integral a => a -> a -> [a] digits b 0 = [0] digits b n = reverse $ digits' n where digits' 0 = [] digits' n = r : digits' q where (q,r) = quotRem n b
{-# INLINABLE fromDigits #-} fromDigits :: Integral a => a -> [a] -> a fromDigits b = foldl1' (\i j -> b * i + j)