Skip to content
{{ message }}

Instantly share code, notes, and snippets.

# johnmcdonnell/problem44.hs

Created Mar 18, 2012
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
to join this conversation on GitHub. Already have an account? Sign in to comment