Euler problems/41 to 50
What is the largest n-digit pandigital prime that exists?
problem_41 = head [p | n <- init (tails "987654321"), p <- perms n, isPrime (read p)] where perms  = [] perms xs = [x:ps | x <- xs, ps <- perms (delete x xs)] isPrime n = n > 1 && smallestDivisor n == n smallestDivisor n = findDivisor n (2:[3,5..]) findDivisor n (testDivisor:rest) | n `mod` testDivisor == 0 = testDivisor | testDivisor*testDivisor >= n = n | otherwise = findDivisor n rest
How many triangle words can you make using the list of common English words?
score :: String -> Int score = sum . map ((subtract 64) . ord . toUpper) istrig :: Int -> Bool istrig n = istrig' n trigs istrig' :: Int -> [Int] -> Bool istrig' n (t:ts) | n == t = True | otherwise = if t < n && head ts > n then False else istrig' n ts trigs = map (\n -> n*(n+1) `div` 2) [1..] --get ws from the Euler site ws = ["A","ABILITY" ... "YOURSELF","YOUTH"] problem_42 = length $ filter id $ map (istrig . score) ws
Find the sum of all pandigital numbers with an unusual sub-string divisibility property.
problem_43 = undefined
Find the smallest pair of pentagonal numbers whose sum and difference is pentagonal.
problem_44 = undefined
After 40755, what is the next triangle number that is also pentagonal and hexagonal?
problem_45 = head . dropWhile (<= 40755) $ match tries (match pents hexes) where match (x:xs) (y:ys) | x < y = match xs (y:ys) | y < x = match (x:xs) ys | otherwise = x : match xs ys tries = [n*(n+1) `div` 2 | n <- [1..]] pents = [n*(3*n-1) `div` 2 | n <- [1..]] hexes = [n*(2*n-1) | n <- [1..]]
What is the smallest odd composite that cannot be written as the sum of a prime and twice a square?
This solution is inspired by exercise 3.70 in Structure and Interpretation of Computer Programs, (2nd ed.).
problem_46 = head $ oddComposites `orderedDiff` gbSums oddComposites = filter ((>1) . length . primeFactors) [3,5..] gbSums = map gbWeight $ weightedPairs gbWeight primes [2*n*n | n <- [1..]] gbWeight (a,b) = a + b weightedPairs w (x:xs) (y:ys) = (x,y) : mergeWeighted w (map ((,)x) ys) (weightedPairs w xs (y:ys)) mergeWeighted w (x:xs) (y:ys) | w x <= w y = x : mergeWeighted w xs (y:ys) | otherwise = y : mergeWeighted w (x:xs) ys x `orderedDiff`  = x  `orderedDiff` y =  (x:xs) `orderedDiff` (y:ys) | x < y = x : xs `orderedDiff` (y:ys) | x > y = (x:xs) `orderedDiff` ys | otherwise = xs `orderedDiff` ys
Find the first four consecutive integers to have four distinct primes factors.
problem_47 = undefined
Find the last ten digits of 11 + 22 + ... + 10001000.
Solution: If the problem were more computationally intensive, modular exponentiation might be appropriate. With this problem size the naive approach is sufficient.
problem_48 = sum [n^n | n <- [1..1000]] `mod` 10^10
Find arithmetic sequences, made of prime terms, whose four digits are permutations of each other.
I'm new to haskell, improve here :-)
isprime2 n x = if x < n then if (n `mod` x == 0) then False else isprime2 n (x+1) else True isprime n = isprime2 n 2 quicksort  =  quicksort (x:xs) = quicksort [y | y <- xs, y<x ] ++ [x] ++ quicksort [y | y <- xs, y>=x] -- 'each' works like this: each 1234 => [1,2,3,4] each n 0 =  each n len = let x = 10 ^ (len-1) in n `div` x : each (n `mod` x) (len-1) ispermut x y = if x /= y then (quicksort (each x 4)) == (quicksort (each y 4)) else False isin2 a  = False isin2 a (b:bs) = if a == b then True else isin2 a bs isin a  = False isin a (b:bs) = if a `isin2` b then True else isin a bs problem_49_2 prime  =  problem_49_2 prime (pr:rest) = if ispermut prime pr then (pr:(problem_49_2 prime rest)) else problem_49_2 prime rest problem_49_1  res = res problem_49_1 (pr:prims) res = if not (pr `isin` res) then let x = (problem_49_2 pr (pr:prims)) in if x /=  then problem_49_1 prims (res ++ [(pr:x)]) else problem_49_1 prims res else problem_49_1 prims res problem_49 = problem_49_1 [n | n <- [1000..9999], isprime n] 
Which prime, below one-million, can be written as the sum of the most consecutive primes?
problem_50 = undefined