Project Euler Problem 012

import Control.Monad
import Control.Applicative
import Data.List

--003より
primes :: [Integer]
primes = 2 : ([3,5..] `minus` join [[p*p, p*p+2*p..] | p <- primes']) 
  where
    primes' = 3 : ([5,7..] `minus` join [[p*p, p*p+2*p..] | p <- primes'])   
    join  ((x:xs):t)    = x : union xs (join (pairs t))
    pairs ((x:xs):ys:t) = (x : union xs ys) : pairs t                      
    union (x:xs) (y:ys) = case (compare x y) of 
      LT -> x : union  xs  (y:ys)
      EQ -> x : union  xs     ys 
      GT -> y : union (x:xs)  ys
    union  xs     []    = xs
    union  []     ys    = ys
    minus (x:xs) (y:ys) = case (compare x y) of 
      LT -> x : minus  xs  (y:ys)
      EQ ->     minus  xs     ys
      GT ->     minus (x:xs)  ys
    minus  xs     _     = xs

factor :: Integer -> [Integer]
factor n = factorimpl n primes where
  factorimpl n pri@(p:xs) =
    if p*p>n then [n]
    else if n`rem` p == 0 then
      p:factorimpl (n `quot` p) pri
         else
           factorimpl n xs
-- -}
tri :: Integral a => a -> a
tri n = n*(n+1)`quot`2
tris :: [Integer]
tris = map tri [1..]
countdivisor :: [Integer] -> Int
countdivisor = product . map ((+1).length) . group
q :: Integer -> Int
q = countdivisor . factor
ans1 = head $ dropWhile ((<=500) . q) tris
--76576500
main :: IO ()
main = print ans1

-- 別解
{-
-- 約数の個数は、各素因数の指数の値+1をかけあわせたもの
divnum :: Integer -> Int
divnum n = product $ map ((+1).length) fz where
  fz = group $ factor n
ans2 :: Integer
ans2 = head $ filter ((>500).divnum) $ scanl1(+)[1..] --76576500

primes :: [Integer]
primes = 2:f[3][3,5..] where
  f (x:xs) ys = ps ++ f(xs++ps)[z|z<-qs,z`rem`x/=0] where
    (ps,qs) = span (< x*x) ys
factor :: Integer -> [Integer]
factor n = imp n primes where
  imp n (p:ps) | n p:imp (n`quot`p) (p:ps)
    _ -> imp n ps
-- -}