仲間はずれの判定 どう書く？org

早く起きてしまったので解いた。

otherList :: (Eq a) => [a] -> [a]
otherList (x:xs) = [ y |  y<-xs , y /= x ]

quasiHomo1 :: (Eq a) => [a] -> Bool
quasiHomo1     = (== 1) . length . otherList

quasiHomo2 :: (Eq a) => [a] -> Bool
quasiHomo2 xs  = (== 1) $ (length xs ) - (length $ otherList xs)

quasiHomoList :: (Eq a) => [a] -> [a]
quasiHomoList xs = map head $ [xs] ++ [otherList xs]

homo :: (Eq a) => [a] -> Bool
homo (xs) = xs == [ y | y <- xs , y == (head xs)]

classify :: (Eq a) => [a] ->  ([Char],[a])
classify xs | homo xs = ("homo" , [head xs])
            | quasiHomo1 xs = ("quasi-homo", quasiHomoList xs)
            | quasiHomo2 xs = ("quasi-homo", reverse $ quasiHomoList xs)
            | otherwise = ("hetero",[])

なんか、すっきり書く方法が思いつきませんでした。精進しないとなぁ。

*Main> classify [1,1,1,1,1]                                                                                                                
("homo",[1])
it :: ([Char], [Integer])                                                                                                                  
*Main> classify [1,1,2,1,1]
("quasi-homo",[1,2])                                                                                                                       
it :: ([Char], [Integer])
*Main> classify [2,1,1,1,1]                                                                                                                
("quasi-homo",[1,2])
it :: ([Char], [Integer])                                                                                                                  
*Main> classify [2,2,1,2,2]
("quasi-homo",[2,1])                                                                                                                       
it :: ([Char], [Integer])
*Main> classify [2,3,2,1,5]                                                                                                                
("hetero",[])
it :: ([Char], [Integer])