Problem Euler 21 - Haskell Solution

Euler21.hs

module Euler.Problem21 where

import qualified Data.Map as Map
import qualified Data.Set as Set
 
problem1::Int->Int->Int->Int
problem1 a b n  = sum [x | x <- [1..n-1], x `mod` a == 0 || x `mod` b == 0]
 
sumOfProperDivisors::Int->Int
sumOfProperDivisors n = sum [x | x <- [1..n `div` 2], n `mod` x == 0]
 
 
groupBySum::Int -> Map.Map Int [Int]
groupBySum n  | n <= 0 = Map.empty
              | otherwise = foldl (\acc (k,v) -> Map.insertWith (++) k [v] acc) Map.empty mapped
                where
                tuples = zip [sumOfProperDivisors x | x <- [1..]] [1..n]  
                mapped = [ (x,y) | (x,y) <- tuples, x > 1]   
 
findAmicable::Int->Map.Map Int [Int]->Maybe(Int,Int)
findAmicable n groups = case Map.lookup n groups of 
                                Just xs -> if s `elem` xs then Just (n `min` s, n `max` s) else Nothing  
                                Nothing -> Nothing
                where s = sumOfProperDivisors n
 
lookupAmicables::Int->Map.Map Int [Int]->Set.Set (Int,Int)
lookupAmicables n groups | n <= 0 = Set.empty
                         | otherwise = case findAmicable n groups of 
                                        Just(x,y) -> if x /= y then Set.insert (x, y) $ lookupAmicables (n - 1) groups
                                                     else lookupAmicables (n - 1) groups 
                                        Nothing -> lookupAmicables (n-1) groups
 
 
solve::Int->Int
solve n = let
                groups = groupBySum n
          in  sum [x + y | (x,y) <- Set.toList (lookupAmicables n groups)]