public
Created

Project Euler Problem 44

  • Download Gist
problem44.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.