fox number

KUPCの第何問なったかな？
忘れたけれど。

二つの数A、Bが入力される。（A>B）
A-B〜A+Bの範囲において、
素因数分解したときに、a^a1*b^b1*c^c1*...
と表現できるが、このとき、すべての因数について、
a<b<c<... , a1>b1>c1...
を満たす数の個数を答えよ

というような問題

とりあえず、効率を気にせずに書いてみた

import Data.List

main = getLine >>=
         print.length.filter foxnum
            .map decomp.mkList.map read.words

mkList :: Integral a => [a]->[a]
mkList (a:b:_) = [a-b..a+b]

decomp :: Integral a => a -> [(a,Int)]
decomp = map (\d-> (head d,length d)).group.decomp' 2
 where
  decomp' :: Integral a => a-> a -> [a]
  decomp' m n | n < m = []
              |otherwise = if mod n m == 0
                            then m:decomp' m (div n m)
                            else decomp' (m+1) n

foxnum :: Integral a => [(a,Int)] -> Bool
foxnum [a] = True
foxnum (a:b:xs) = if snd a > snd b
                   then foxnum (b:xs)
                   else False

エラトステネスの篩を用いてやるだけで大分早くなると思います。