Project Euler Problem 44
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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