仲間外れの判別

30分プログラム、その135。予告通り仲間はずれの判定
まとめて判定するステキな方法が思いつかなかったので、個別に判断するようにした。

使い方

*Main> classify [1,1,1]
Just ("homo",1)
*Main> classify [1,1,2]
Just ("onlyOne",2)
*Main> classify [1,2,3]
Nothing

ソースコード

import Control.Monad.List
import Data.List

onlyOne :: (Eq a)=>[a]->Maybe a
onlyOne xs = if r == [] then
                 Nothing
             else
                 Just $ head r
    where r =do x <- xs
                let xs' = delete x xs
                guard $ same xs' /= Nothing
                guard $ and $ map (/=x) xs'
                return x

same :: (Eq a)=>[a]->Maybe a
same (x:xs) = if and $ map (==x) xs then
                  Just x
              else
                  Nothing

classify :: (Eq a)=>[a]->Maybe (String,a)
classify xs = foldr mplus Nothing
              [same xs >>= f "homo",
               onlyOne xs >>= f "onlyOne"]
    where f name x = Just (name,x)