Euler problems/41 to 50

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

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

problem_43 = undefined

problem_44 = undefined

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..]]

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

problem_47 = undefined

problem_48 = sum [n^n | n <- [1..1000]] `mod` 10^10

import Data.List
 
isprime :: (Integral a) => a -> Bool
isprime n = isprime2 2
    where isprime2 x | x < n     = if n `mod` x == 0 then False else isprime2 (x+1)
                     | otherwise = True
 
 
-- 'each' works like this: each (4,1234) => [1,2,3,4]
each :: (Int, Int) -> [Int]
each = unfoldr (\(o,y) -> let x = 10 ^ (o-1) 
                              (d,m) = y `divMod` x in
                          if o == 0 then Nothing else Just (d,(o-1,m)))
 
ispermut :: Int -> Int -> Bool
ispermut = let f = (sort . each . (,) 4) in (. f) . (==) . f
 
isin :: (Eq a) => a -> [[a]] -> Bool
isin = any . elem 
 
problem_49_1 :: [Int] -> [[Int]] -> [[Int]]
problem_49_1 [] res = res
problem_49_1 (pr:prims) res = problem_49_1 prims res'
    where res' = if pr `isin` res then res else res ++ [pr:(filter (ispermut pr) (pr:prims))]
 
problem_49 :: [[Int]]
problem_49 = problem_49_1 [n | n <- [1000..9999], isprime n] []

problem_50 = undefined