Skip to content

Instantly share code, notes, and snippets.

@johnmcdonnell
Created March 18, 2012 19:17
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save johnmcdonnell/2079968 to your computer and use it in GitHub Desktop.
Project Euler Problem 44
import Data.Maybe
import Data.Set as S
import Data.List as L
-- Problem 44
-- Pentagonal item and list definitions.
pentagonal :: Integral a => a -> a
pentagonal n = n*(3*n - 1) `div` 2
pentagonals :: Integral a => [a]
pentagonals = L.map pentagonal [1..]
pentaset :: Integral a => S.Set a
pentaset = S.fromList $ take 2500 pentagonals
--mergePairsBy cmp max x:[] = x
-- O(log n)
ispentagonal :: Integral a => a -> Bool
ispentagonal = (`member` pentaset)
-- pair type
type Pair = (Int, Int)
pairdiff :: Pair -> Int
pairdiff somepair = (pentagonal $ snd somepair) - (pentagonal $ fst somepair)
pairsum :: Pair -> Int
pairsum somepair = (pentagonal $ fst somepair) + (pentagonal $ snd somepair)
-- Pentagonality of differences and sums
sumpentagonal :: Pair -> Bool
sumpentagonal somepair = (ispentagonal $ pairsum somepair)
diffpentagonal :: Pair -> Bool
diffpentagonal somepair = (ispentagonal $ pairdiff somepair)
dualpentagonal :: Pair -> Bool
dualpentagonal somepair = (sumpentagonal somepair) && (diffpentagonal somepair)
-- We want to sort the differences in order from least to greatest.
-- Merge an infinite list of lists, where the head of each successive list is greater than the last.
mergePairsBy :: (Pair -> Pair -> Ordering) -> Int -> [[Pair]] -> [Pair]
mergePairsBy cmp max [] = []
mergePairsBy cmp max lists = winner : mergePairsBy cmp newmax newlists
where
newmax = if winnerarg == (max-1)
then max+1
else max
newlists = (fst newlistsplit) ++ (tail $ head $ snd newlistsplit) : (tail $ snd newlistsplit)
newlistsplit = splitAt winnerarg lists
winnerarg = fromJust $ elemIndex winner heads
winner = minimumBy cmp heads
heads = L.map head $ take max lists
paircompare :: (Pair -> Pair -> Ordering)
paircompare p1 p2 = (pairdiff p1) `compare` (pairdiff p2)
allpairs :: [[Pair]]
allpairs = [ [ (a,a+n) | a <- [1..] ] | n<-[1..] ]
pairsinorder = mergePairsBy paircompare 1 allpairs
-- These are just to see if things seem to work.
sumpentagonals = L.filter sumpentagonal pairsinorder
diffpentagonals = L.filter diffpentagonal pairsinorder
-- Actual solution
problemanswer = L.find dualpentagonal pairsinorder
-- And what project Euler wants
euleranswer = pairdiff problemanswer
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment