Extracting arguments point-free

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

Extracting arguments point-free

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)


Reply | Threaded
Open this post in threaded view
|

Extracting arguments point-free

Peter Hall
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 <peter.hall at memorphic.com> wrote:

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