You're using an old link! - Thankfully, you no longer need to specify a nonstandard port (8080) to access my site. You could've used the more standard: http://pbrisbin.com/pages/euler.html.
I'm putting up my working file for project euler; come check it out as I work my way through the questions with haskell.
Fri, 11 Dec 2009 20:02:58 -0500
I've been trying to learn haskell off and on for a couple of months now. As you might know, XMonad is my WM of choice, and I do have a pretty complicated xmonad.hs that I did not blindly copy and paste. The more haskell I learn, the more interesting it is, but I was having trouble finding an application for it, a real world way to get my hands dirty; that's really the only way I'd actually _learn_ it.
So, I happened upon projecteuler.net and it is awesome. It's quite simply a list of mathematic and programmatic problems that can be solved in any way you want. Hop over and take a look, it's really interesting.
I publish here, my working euler file. Haskell seems almost made for this sort of thing, being such a mathy language. I'll give you an example.
-- -- Euler problem 48: find the last ten digits of the sum of the series -- 1^1+2^2+3^3 ... 1000^1000 -- -- -- haskell one-liner to get the solution -- problemFortyEight = reverse . take 10 . reverse . show $ sum [ n^n | n <- [1..1000] ]
I mean, it doesn't get much more literal than that, right?
List comprehension has to be one of the coolest aspects of haskell; here's another example:
-- -- Euler problem 9: there exists only one pythagorean triplet for which -- a+b+c = 1000; find the product of a*b*c. -- -- -- haskell one-liner to get solution -- problemNine = head $ [ a*b*c | a <- [1..998], b <- [1..999], c <- [1..1000], a < b, b < c, a^2 + b^2 == c^2, a + b + c == 1000 ]
So anyway... Feel free to peruse my file; I'm no haskell expert, but thanks to Project Euler, I'm getting there.
-- -- http://projecteuler.net :: brisbin33 -- module Main where -- Imports {{{ import Data.Function (on) import Data.List (maximumBy, sort, nub) import Data.Maybe (listToMaybe) import System (getArgs) import System.IO (putStrLn) -- }}} -- Main {{{ main :: IO () main = do args <- getArgs let problemsToShow = map read args :: [Int] mapM_ putStrLn $ map printProblem problemsToShow where printProblem :: Int -> String printProblem n = case (findProblem problems n) of Just e -> "Problem " ++ show n ++ ": " ++ problem e _ -> "Problem " ++ show n ++ ": not solved yet" findProblem :: [Euler] -> Int -> Maybe Euler findProblem e n = listToMaybe $ filter ((n ==) . key) e -- }}} -- Solved {{{ data Euler = Euler { key :: Int , problem :: String } problems :: [Euler] problems = [ Euler 1 problemOne , Euler 2 problemTwo , Euler 3 problemThree , Euler 4 problemFour , Euler 5 problemFive , Euler 6 problemSix , Euler 7 problemSeven , Euler 8 problemEight , Euler 9 problemNine , Euler 10 problemTen , Euler 11 problemEleven , Euler 16 problemSixteen , Euler 20 problemTwenty , Euler 13 problemThirteen , Euler 25 problemTwentyFive , Euler 48 problemFortyEight , Euler 21 problemTwentyOne , Euler 30 problemThirty , Euler 29 problemTwentyNine , Euler 36 problemThirtySix , Euler 35 problemThirtyFive , Euler 40 problemForty , Euler 52 problemFiftyTwo , Euler 55 problemFiftyFive , Euler 41 problemFortyOne ] -- }}} -- 1 SOLVED {{{ -- -- find the sum of all the multiples of 3 or 5 below 1000 -- problemOne :: String problemOne = show . sum $ [ x | x <- [1..999], multThreeOrFive x ] where multThreeOrFive :: Int -> Bool multThreeOrFive n | n `mod` 3 == 0 = True | n `mod` 5 == 0 = True | otherwise = False -- }}} -- 2 SOLVED {{{ -- -- find the sum of all the even-valued terms in the F seq -- which do not exceed four million -- problemTwo :: String problemTwo = show . sum $ [ x | x <- takeWhile (<4000000) fibonaccis, even x ] -- print a list of fibonacci numbers fibonaccis :: [Integer] fibonaccis = 1 : 1 : zipWith (+) fibonaccis (tail fibonaccis) --- }}} -- 3 SOLVED {{{ -- -- find the largest prime factor of the number 600851475143 -- problemThree :: String problemThree = show . last . getPrimes $ 600851475143 -- returns an ordered list of prime factors of n getPrimes :: (Integral a) => a -> [a] getPrimes n = primesByList (2:[3,5..n `div` 2]) n where primesByList :: (Integral a) => [a] -> a -> [a] primesByList _ 1 = [] primesByList [] n = [n] primesByList (x:xs) n = if n `rem` x == 0 then x : primesByList (x:xs) (n `div` x) else primesByList xs n -- }}} -- 4 SOLVED {{{ -- -- find the largest palindrome made from the product of two -- 3 digit numbers -- problemFour :: String problemFour = show . maximum $ palindromics where palindromics = map read . filter isPalindromic . map show $ productsOfThree :: [Int] productsOfThree = [ x*y | x <- [100..999], y <- [100..999] ] -- check if list is palindromic: [1,2,3,2,1] isPalindromic :: (Eq a) => [a] -> Bool isPalindromic xs = xs == reverse xs -- }}} -- 5 SOLVED {{{ -- -- what is the smallest number that is evenly divisible by -- all of the numbers 1 to 20? -- problemFive :: String problemFive = show . head . dropWhile (not . evenlyByAll [1..20]) $ [20..] -- check if n is divisible by all elements of list evenlyByAll :: (Integral a) => [a] -> a -> Bool evenlyByAll xs n | xs == [] = True | n `rem` (head xs) /= 0 = False | otherwise = evenlyByAll (tail xs) n -- }}} -- 6 SOLVED {{{ -- -- find the difference between the sum of the squares of the -- first 100 natural numbers and the square of the sum -- problemSix :: String problemSix = show . abs $ (sumSquare [1..100]) - (squareSum [1..100]) where sumSquare :: (Integral a) => [a] -> a sumSquare xs = sum $ map (^2) xs squareSum :: (Integral a) => [a] -> a squareSum xs = (^2) $ sum xs -- }}} -- 7 SOLVED {{{ -- -- what is the 10001st prime number? -- problemSeven :: String problemSeven = show . (!! 1000) $ allPrimes -- list starts at element zero allPrimes :: [Integer] allPrimes = filter isPrime $ 2:[3,5..] isPrime :: (Integral a) => a -> Bool isPrime n | n < 2 = False | n == 2 || n == 3 = True | mod n 2 == 0 = False | divisibleByOdd n 3 == False = True | otherwise = False where divisibleByOdd x y | mod x y == 0 = True | y*y <= x = divisibleByOdd x (y+2) | otherwise = False -- }}} -- 8 SOLVED {{{ -- -- find the greatest product of five consecutive digits in -- the 1000 digit number. -- problemEight :: String problemEight = show . maximum . productsOfConsec 5 . stringToInts . show $ theNumber where theNumber :: Integer theNumber = 7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450 -- convert a string to a list of ints for processing stringToInts :: [Char] -> [Int] stringToInts xs | xs == [] = [] | otherwise = let x = read (take 1 xs) :: Int in x : stringToInts (tail xs) -- list out all products of consecutive n elements in a list productsOfConsec :: (Num a) => Int -> [a] -> [a] productsOfConsec n xs | length xs < n = [] | otherwise = let x = product $ take n xs in x : productsOfConsec n (tail xs) -- }}} -- 9 SOLVED {{{ -- -- there exists only one pythagorean triplet for which -- a+b+c = 1000; find the product of a*b*c. -- problemNine :: String problemNine = show . head $ [ a*b*c | a <- [1..998], b <- [1..999], c <- [1..1000], a < b, b < c, a^2 + b^2 == c^2, a + b + c == 1000 ] -- }}} -- 10 SOLVED {{{ -- -- find the sum of all primes below two million. -- problemTen :: String problemTen = show . sum . takeWhile (<2000000) $ allPrimes -- }}} -- 11 SOLVED {{{ -- -- what is the greatest product of 4 adjacent numbers in any -- direction in the 20x20 grid? -- problemEleven :: String problemEleven = show . maximum . getAllProducts 4 $ theGrid -- Note: (0,0) --> 8, (2,5) --> 16 theGrid = [ [08,02,22,97,38,15,00,40,00,75,04,05,07,78,52,12,50,77,91,08] , [49,49,99,40,17,81,18,57,60,87,17,40,98,43,69,48,04,56,62,00] , [81,49,31,73,55,79,14,29,93,71,40,67,53,88,30,03,49,13,36,65] , [52,70,95,23,04,60,11,42,69,24,68,56,01,32,56,71,37,02,36,91] , [22,31,16,71,51,67,63,89,41,92,36,54,22,40,40,28,66,33,13,80] , [24,47,32,60,99,03,45,02,44,75,33,53,78,36,84,20,35,17,12,50] , [32,98,81,28,64,23,67,10,26,38,40,67,59,54,70,66,18,38,64,70] , [67,26,20,68,02,62,12,20,95,63,94,39,63,08,40,91,66,49,94,21] , [24,55,58,05,66,73,99,26,97,17,78,78,96,83,14,88,34,89,63,72] , [21,36,23,09,75,00,76,44,20,45,35,14,00,61,33,97,34,31,33,95] , [78,17,53,28,22,75,31,67,15,94,03,80,04,62,16,14,09,53,56,92] , [16,39,05,42,96,35,31,47,55,58,88,24,00,17,54,24,36,29,85,57] , [86,56,00,48,35,71,89,07,05,44,44,37,44,60,21,58,51,54,17,58] , [19,80,81,68,05,94,47,69,28,73,92,13,86,52,17,77,04,89,55,40] , [04,52,08,83,97,35,99,16,07,97,57,32,16,26,26,79,33,27,98,66] , [88,36,68,87,57,62,20,72,03,46,33,67,46,55,12,32,63,93,53,69] , [04,42,16,73,38,25,39,11,24,94,72,18,08,46,29,32,40,62,76,36] , [20,69,36,41,72,30,23,88,34,62,99,69,82,67,59,85,74,04,36,16] , [20,73,35,29,78,31,90,01,74,31,49,71,48,86,81,16,23,57,05,54] , [01,70,54,71,83,51,54,69,16,92,33,48,61,43,52,01,89,19,67,48] ] -- map product onto each of the consecutive n numbers in xss getAllProducts n xss = map product $ getAllConsecutive n xss -- get all n consecutive values in xss in all four directions getAllConsecutive n xss = getAllDown n xss ++ getAllOver n xss ++ getAllDiagR n xss ++ getAllDiagL n xss -- list all consecutive n values in xss in four directions getAllDown n xss = [ getDown n xss (x,y) | (x,y) <- gridElements xss, y <= gridHeight xss - (n-1) ] getAllOver n xss = [ getOver n xss (x,y) | (x,y) <- gridElements xss, x <= gridWidth xss - (n-1) ] getAllDiagR n xss = [ getDiagR n xss (x,y) | (x,y) <- gridElements xss, x <= gridWidth xss - (n-1), y <= gridHeight xss - (n-1) ] getAllDiagL n xss = [ getDiagL n xss (x,y) | (x,y) <- gridElements xss, x >= (n-1) , y <= gridHeight xss - (n-1) ] -- prints all available (x,y)s of xss for easy mapping gridElements xss = [ (x,y) | x <- [0..gridWidth xss], y <- [0..gridHeight xss] ] -- set the limits of 0 based xss gridHeight xss = (length xss) - 1 gridWidth xss = (head $ map length xss) - 1 -- list consecutive n values including (x,y) in xss in four directions getDown n xss (x,y) = [ getFromGrid xss (x , y+n') | n' <- [0..(n-1)] ] getOver n xss (x,y) = [ getFromGrid xss (x+n', y ) | n' <- [0..(n-1)] ] getDiagR n xss (x,y) = [ getFromGrid xss (x+n', y+n') | n' <- [0..(n-1)] ] getDiagL n xss (x,y) = [ getFromGrid xss (x-n', y+n') | n' <- [0..(n-1)] ] -- returns value xss(x,y) getFromGrid xss (x,y) = (!! x) $ xss !! y -- }}} -- 16 SOLVED {{{ -- -- what is the sum of the digits of 2^1000 -- problemSixteen :: String problemSixteen = show . sum . stringToInts . show $ 2^1000 -- }}} -- 20 SOLVED {{{ -- -- find the sum of the digits in 100! -- problemTwenty :: String problemTwenty = show . sum . stringToInts . show $ factorials !! 100 -- print infinite list of factorials factorials = scanl (*) 1 [2..] -- }}} -- 13 SOLVED {{{ -- -- work out the first ten digits of the sum of the following -- 100 50-digit numbers -- problemThirteen :: String problemThirteen = concat . map show . take 10 . stringToInts . show $ sum theNumbers where theNumbers = [ 37107287533902102798797998220837590246510135740250 , 46376937677490009712648124896970078050417018260538 , 74324986199524741059474233309513058123726617309629 , 91942213363574161572522430563301811072406154908250 , 23067588207539346171171980310421047513778063246676 , 89261670696623633820136378418383684178734361726757 , 28112879812849979408065481931592621691275889832738 , 44274228917432520321923589422876796487670272189318 , 47451445736001306439091167216856844588711603153276 , 70386486105843025439939619828917593665686757934951 , 62176457141856560629502157223196586755079324193331 , 64906352462741904929101432445813822663347944758178 , 92575867718337217661963751590579239728245598838407 , 58203565325359399008402633568948830189458628227828 , 80181199384826282014278194139940567587151170094390 , 35398664372827112653829987240784473053190104293586 , 86515506006295864861532075273371959191420517255829 , 71693888707715466499115593487603532921714970056938 , 54370070576826684624621495650076471787294438377604 , 53282654108756828443191190634694037855217779295145 , 36123272525000296071075082563815656710885258350721 , 45876576172410976447339110607218265236877223636045 , 17423706905851860660448207621209813287860733969412 , 81142660418086830619328460811191061556940512689692 , 51934325451728388641918047049293215058642563049483 , 62467221648435076201727918039944693004732956340691 , 15732444386908125794514089057706229429197107928209 , 55037687525678773091862540744969844508330393682126 , 18336384825330154686196124348767681297534375946515 , 80386287592878490201521685554828717201219257766954 , 78182833757993103614740356856449095527097864797581 , 16726320100436897842553539920931837441497806860984 , 48403098129077791799088218795327364475675590848030 , 87086987551392711854517078544161852424320693150332 , 59959406895756536782107074926966537676326235447210 , 69793950679652694742597709739166693763042633987085 , 41052684708299085211399427365734116182760315001271 , 65378607361501080857009149939512557028198746004375 , 35829035317434717326932123578154982629742552737307 , 94953759765105305946966067683156574377167401875275 , 88902802571733229619176668713819931811048770190271 , 25267680276078003013678680992525463401061632866526 , 36270218540497705585629946580636237993140746255962 , 24074486908231174977792365466257246923322810917141 , 91430288197103288597806669760892938638285025333403 , 34413065578016127815921815005561868836468420090470 , 23053081172816430487623791969842487255036638784583 , 11487696932154902810424020138335124462181441773470 , 63783299490636259666498587618221225225512486764533 , 67720186971698544312419572409913959008952310058822 , 95548255300263520781532296796249481641953868218774 , 76085327132285723110424803456124867697064507995236 , 37774242535411291684276865538926205024910326572967 , 23701913275725675285653248258265463092207058596522 , 29798860272258331913126375147341994889534765745501 , 18495701454879288984856827726077713721403798879715 , 38298203783031473527721580348144513491373226651381 , 34829543829199918180278916522431027392251122869539 , 40957953066405232632538044100059654939159879593635 , 29746152185502371307642255121183693803580388584903 , 41698116222072977186158236678424689157993532961922 , 62467957194401269043877107275048102390895523597457 , 23189706772547915061505504953922979530901129967519 , 86188088225875314529584099251203829009407770775672 , 11306739708304724483816533873502340845647058077308 , 82959174767140363198008187129011875491310547126581 , 97623331044818386269515456334926366572897563400500 , 42846280183517070527831839425882145521227251250327 , 55121603546981200581762165212827652751691296897789 , 32238195734329339946437501907836945765883352399886 , 75506164965184775180738168837861091527357929701337 , 62177842752192623401942399639168044983993173312731 , 32924185707147349566916674687634660915035914677504 , 99518671430235219628894890102423325116913619626622 , 73267460800591547471830798392868535206946944540724 , 76841822524674417161514036427982273348055556214818 , 97142617910342598647204516893989422179826088076852 , 87783646182799346313767754307809363333018982642090 , 10848802521674670883215120185883543223812876952786 , 71329612474782464538636993009049310363619763878039 , 62184073572399794223406235393808339651327408011116 , 66627891981488087797941876876144230030984490851411 , 60661826293682836764744779239180335110989069790714 , 85786944089552990653640447425576083659976645795096 , 66024396409905389607120198219976047599490197230297 , 64913982680032973156037120041377903785566085089252 , 16730939319872750275468906903707539413042652315011 , 94809377245048795150954100921645863754710598436791 , 78639167021187492431995700641917969777599028300699 , 15368713711936614952811305876380278410754449733078 , 40789923115535562561142322423255033685442488917353 , 44889911501440648020369068063960672322193204149535 , 41503128880339536053299340368006977710650566631954 , 81234880673210146739058568557934581403627822703280 , 82616570773948327592232845941706525094512325230608 , 22918802058777319719839450180888072429661980811197 , 77158542502016545090413245809786882778948721859617 , 72107838435069186155435662884062257473692284509516 , 20849603980134001723930671666823555245252804609722 , 53503534226472524250874054075591789781264330331690 ] -- }}} -- 14 {{{ -- -- which starting number, under one million, produces the -- longest collatz sequence -- problemFourteen :: String problemFourteen = show . fst . maximumBy (compare `on` snd) $ [ (n, length $ collatzSeq n) | n <- [1..1000000] ] -- generates the collatz sequence starting a n collatzSeq n | n == 1 = [1] | even n = n : collatzSeq (n `div` 2) | odd n = n : collatzSeq (n*3 +1) -- }}} -- 12 {{{ -- -- what is the value of the first triangle number to have -- over five hundred divisors -- problemTwelve :: String problemTwelve = show . head $ dropWhile ((<= 500) . numberOfDivisors) triangleNumbers -- returns the number of divisors of n numberOfDivisors n = length $ listDivisors n -- lists all divisors of n listDivisors n = [ x | x <- [1..n], n `rem` x == 0 ] -- outputs an infinite list of triangle numbers triangleNumbers = scanl (+) 1 [2..] -- }}} -- 25 SOLVED {{{ -- -- what is the first term in the Fibonacci sequence to -- contain 1000 digits -- problemTwentyFive :: String problemTwentyFive = show . length . takeWhile (<=1000) . map (length . show) $ fibonaccis -- }}} -- 48 SOLVED {{{ -- -- find the last ten digits of the sum of the series -- 1^1+2^2+3^3 ... 1000^1000 -- problemFortyEight :: String problemFortyEight = reverse . take 10 . reverse . show . sum $ [ n^n | n <- [1..1000] ] -- }}} -- 21 SOLVED {{{ -- -- evaulate the sum of all amicable numbers under 10000 -- problemTwentyOne :: String problemTwentyOne = show . sum $ [ x | x <- [ 1..9999], x /= (d x), d (d x) == x ] where d n = sum . proper $ n proper n = [ x | x <- [ 1..n-1], n `mod` x == 0 ] -- }}} -- 30 SOLVED {{{ -- -- find the sum of all the numbers that can be written as the -- sum of fifth powers of their digits -- -- assumption: a number greater than n+1 digits can't be -- written as the sum of nth powers of its -- digits -- problemThirty :: String problemThirty = show . sum . filter (isSumOfPowers 5) $ [2..999999] isSumOfPowers n m = if sumOfPowers n m == m then True else False sumOfPowers n m = sum $ map (^n) $ stringToInts . show $ m -- }}} -- 29 SOLVED {{{ -- -- how many different terms are in the sequence generated by -- a^b for 2 <= a <= 100 and 2 <= b <= 100 -- problemTwentyNine :: String problemTwentyNine = show . length . nub $ [ a^b | a <- [2..100], b <- [2..100] ] -- }}} -- 36 SOLVED {{{ -- -- find the sum of all numbers, less than one million, which -- are palindromic in base 10 and base 2 -- problemThirtySix :: String problemThirtySix = show . sum $ [ n | n <- [0..1000000], isPalindromicInBoth n ] isPalindromicInBoth n = (isPalindromic . show $ n) && (isPalindromic . convertToBinary $ n) convertToBinary n = reverse $ convertToBinary' n where convertToBinary' 0 = [] convertToBinary' m = let (a,b) = quotRem m 2 in [b] ++ convertToBinary' a -- }}} -- 34 {{{ -- -- find the sum of all numbers which are equal to the sum of -- the factorial of their digits -- problemThirtyFour :: String problemThirtyFour = show . sum $ [ n | n <- [1..], isSumOfFactorials n ] -- need an upper limit isSumOfFactorials n = n == sumOfFactorials n sumOfFactorials n | n <= 2 = 0 -- 0, 1, and 2 aren't techinically sums | otherwise = sum $ [ factorials !! (m-1) | m <- stringToInts $ show n, m > 0 ] -- }}} -- 35 SOLVED {{{ -- -- How many circular primes are there below on million -- problemThirtyFive :: String problemThirtyFive = show . length $ [ n | n <- filter (isPrime) $ [1..1000000], isCircularPrime n ] -- casting to a string prevents infinite loops on numbers like 10, 101, etc isCircularPrime n = let s = show n in if False `elem` (map isPrime $ listStringsToInts $ rotateStrings s) then False else True where listStringsToInts ss = map read $ ss :: [Int] -- kinda hacky, but it works rotateStrings xs = [xs] ++ [ xs' | xs' <- takeWhile (/= xs) $ drop 1 $ allRotations xs ] where allRotations xs = [xs] ++ (allRotations (tail xs ++ [head xs])) -- }}} -- 40 SOLVED {{{ -- -- find the value of the following expression -- d 1 * d 10 * d 100 ... d 1000000 -- problemForty :: String problemForty = show . product . stringToInts $ [ d n | n <- [1,10,100,1000,10000,100000,1000000] ] d n = theFraction !! (n-1) where theFraction = concat $ map show [1..] -- }}} -- 23 {{{ -- -- find the sum of all the positive integers which cannot -- be written as the sum of two abundant number -- problemTwentyThree :: String problemTwentyThree = show . sum $ [ n | n <- [24..28123], isNotSumOfTwoAbundants n ] -- true if n can be written as a sum of two abundant numbers isNotSumOfTwoAbundants n = [ a+b | a <- [12..n-12], b <- [12..n-12], a+b == n, numberIsAbundant a, numberIsAbundant b ] == [] -- might as well write them all out numberIsPerfect n = if (sum $ filter (/= n) $ listDivisors n) == n then True else False numberIsAbundant n = if (sum $ filter (/= n) $ listDivisors n) > n then True else False numberIsDeficient n = if (sum $ filter (/= n) $ listDivisors n) < n then True else False -- }}} -- 15 {{{ -- -- how many routes are there through a 20x20 grid? -- --problemFifteen :: String --problemFifteen = -- example case: 2x2 grid (technically 3x3 nodes) theGrid' = [ [(0,0), (1,0), (2,0) ] , [(0,1), (1,1), (2,1) ] , [(0,2), (1,2), (2,2) ] ] gridMax xss = (gridWidth xss, gridHeight xss) -- bounded validNextMoveGrid (x',y') (x,y) xss = filter (withinBounds (gridMax xss)) $ validNextMove (x',y') (x,y) where -- unbounded validNextMove (x',y') (x,y) = filter (/= (x',y')) $ [ (x+1,y), (x-1,y), (x,y+1), (x,y-1) ] withinBounds (w,h) (x,y) -- gridMax handles the zero base | x > w || y > h = False | x < 0 || y < 0 = False | otherwise = True -- }}} -- 52 SOLVED {{{ -- -- find the smallest positive integer x such that 2x, 3x, 4x, -- 5x, and 6x contain the same digits -- problemFiftyTwo :: String problemFiftyTwo = show . head $ [ x | x <- [1..], x `isSameDigits` (2*x) , x `isSameDigits` (3*x) , x `isSameDigits` (4*x) , x `isSameDigits` (5*x) , x `isSameDigits` (6*x) ] n `isSameDigits` m = if any (`notElem` (show n)) (show m) then False else True -- }}} -- 55 SOLVED {{{ -- -- how many Lychel numbers are there below ten thousand -- problemFiftyFive :: String problemFiftyFive = show . length $ [ n | n <- [1..10000], isLychrel n ] isLychrel :: Integer -> Bool isLychrel n = if (length $ take 50 $ takeWhile (not . isPalindromic) $ map show $ addReverse n) == 50 then True else False addReverse :: Integer -> [Integer] addReverse n = let m = read . reverse . show $ n :: Integer in m+n : addReverse (m+n) -- }}} -- 39 {{{ -- -- for which value of p <= 1000 is the number of solutions -- maximized -- problemThirtyNine :: String problemThirtyNine = show . fst . maximumBy (compare `on` snd) $ numTriangles 1 1000 -- the number of triangles that can be made from perimeters -- from n to m numTriangles :: Int -> Int -> [(Int,Int)] numTriangles n m = [ (p, numTriangles' p) | p <- [n..m] ] where -- how many right triangles can be made of perimeter p numTriangles' :: Int -> Int numTriangles' p = length $ rightTriangles p -- list all right triangles with perimeter p rightTriangles :: Int -> [(Int,Int,Int)] rightTriangles p = [ (a,b,c) | a <- [1..p], b <- [1..p], c <- [1..p], a < b, b < c, a^2+b^2 == c^2, a+b+c == p ] -- }}} -- 41 SOLVED {{{ -- -- what is the largest n-digit pandigital prime that exists? -- problemFortyOne :: String problemFortyOne = show . maximum . concat . map (findHighest . show) $ possibles -- assumption: one of these contains a solution; otherwise, we'd get an -- empty list error on the call to maximum above possibles :: [Integer] possibles = [ 123456789 , 12345678 , 1234567 , 123456 , 12345 , 1234 , 123 , 12 , 1 ] findHighest :: String -> [Integer] findHighest xs = take 1 . reverse . sort . filter isPrime . map read . allPermutations $ xs :: [Integer] allPermutations :: (Eq a) => [a] -> [[a]] allPermutations xs | xs == [] = [] | length xs == 1 = [xs] | length xs == 2 = [xs] ++ [reverse xs] | otherwise = let m = length xs in concat [ getPermutation xs n | n <- [1..m] ] where getPermutation :: (Eq a) => [a] -> Int -> [[a]] getPermutation xs n = map ([(!! (n-1)) xs] ++) . allPermutations $ (take (n-1) xs ++ drop n xs) -- unneeded but i'll keep it for now... isPandigit :: Int -> Bool isPandigit n = let m = sort . show $ n in m == (concat . map show $ [1..(length m)]) -- }}} -- 38 {{{ -- -- what is the largest 1 to 9 pandigital 9-digit number that -- can be formed as the concatenated product of an integer -- with [1..n] where n > 1? -- --problemThirtyEight :: String --problemThirtyEight = concatProduct :: Int -> [Int] -> Int concatProduct n xs = read . concat . map show $ map (n*) xs :: Int -- }}}
pbrisbin dot com 2010