Problem:
ヒットアンドブロー

太郎君と花子さんはヒットアンドブローで遊ぶことにしました。ヒットアンドブローのルールは、以下の通りです。

出題者と回答者に分かれて行う。

出題者は、重複した数を含まない 4 桁の数字(正解)を決める。

回答者は、その 4 桁の数字(回答)を言い当てる。

回答に対して、出題者はヒットとブローの数でヒントを与える。

回答と正解を比べて、数と桁位置の両方が同じであることをヒットと呼び、数だけが同じで桁位置が異なることをブローと呼ぶ。たとえば、正解が 1234 で、回答が 1354 なら、出題者は「2 ヒット、1 ブロー」というヒントを与え、正解までこれを繰り返す。

出題者と回答者は交代してゲームを行い、より少ない回答で正解を言い当てた方を勝ちとする。

太郎君と花子さんは、ヒットの数とブローの数をその都度判断することが少し面倒に感じているようです。そんな二人のために、ヒットの数とブローの数が即座に分かるプログラムを作成してあげましょう。

正解 r と回答 a を入力とし、ヒットの数とブローの数を出力するプログラムを作成してください。r、a はそれぞれ 0 から 9 の数字 4 つからなる数字の列です。

Input

複数のデータセットの並びが入力として与えられます。入力の終わりはゼロふたつの行で示されます。各データセットとして、r と a が空白区切りで１行に与えられます。

データセットの数は 12000 を超えません。

Output

入力データセットごとに、ヒットの数とブローの数を１行に出力します。

Sample Input

1234 5678
1234 1354
1234 1234
1230 1023
0123 1234
0 0

Output for the Sample Input

0 0
2 1
4 0
1 3
0 3

Solution in Haskell (judge verdict: Accepted)

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString as BS
import Data.Functor
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.List
import qualified Data.Foldable as Foldable
import qualified Data.Set as Set
--import qualified Data.Sequence as Sequence
import Data.List.Split
import Data.Bits
import Data.Char
import Data.Ix
import Data.Ratio
import Data.Ord
import Data.Tuple
import Data.Array
--import Data.Array.Unboxed
--import Data.Array.IArray
import Data.Array.MArray
import Data.Array.IO
import Data.Array.ST
import Data.IORef
import Data.STRef
import GHC.ST
-- import System.IO.Unsafe

-- templete
readInt = read :: String -> Int
readInteger = read :: String -> Integer
readDouble = read :: String -> Double
getInt = readLn :: IO Int
getInts = map readInt . words <$> getLine
getInteger = readLn :: IO Integer
getIntegers = map readInteger . words <$> getLine
getDouble = readLn :: IO Double
getDoubles = map readDouble . words <$> getLine
sjoin :: (Show a) => [a] -> String
sjoin = unwords . map show
tjoin :: (Show a, Show b) => (a, b) -> String
tjoin (x, y) = show x ++ (' ' : show y)
cond :: a -> a -> Bool -> a
cond t f c = if c then t else f
apply2 :: (a -> a -> b) -> [a] -> b
apply2 f [x,y] = f x y
apply3 :: (a -> a -> a -> b) -> [a] -> b
apply3 f [x,y,z] = f x y z
apply4 :: (a -> a -> a -> a -> b) -> [a] -> b
apply4 f [x,y,z,w] = f x y z w
fnTuple :: (a -> b, a -> c) -> a -> (b, c)
fnTuple (f,g) a = (f a, g a)
replace :: (Eq a) => a -> a -> [a] -> [a]
replace x y = map (\z -> if z==x then y else z)
binMap :: (a -> a -> b) -> [a] -> [b]
binMap f (x:xs@(y:_)) = f x y : binMap f xs
binMap _ _ = []
splitRec :: Int -> [a] -> [[a]]
splitRec _ [] = []
splitRec n xs = let (y,ys) = splitAt n xs in y : splitRec n ys
infixl 7 `divCeil`
divCeil :: Integral a => a -> a -> a
x `divCeil` y = (x+y-1) `div` y
coverC :: Ord a => (a, a) -> a -> Bool
coverC (l,r) x = l<=x && x<=r
coverH :: Ord a => (a, a) -> a -> Bool
coverH (l,r) x = l<=x && x<r
ibsearch :: (Int -> Bool) -> (Int,Int) -> Int
ibsearch f (ok,ng) = if abs (ok-ng) <= 1 then ok else let mid = (ok + ng) `div` 2 in ibsearch f (if f mid then (mid,ng) else (ok,mid))
-- templete

hb r a = tjoin (hit, blow)
  where
    hit = length . filter id . zipWith (==) r $ a
    blow = length . filter (\(t,b) -> let ct = fromMaybe 0 $ snd <$> find ((==t) . fst) counts in if b then ct>=2 else ct>=1) $ zipWith (\ t t' -> (t', t==t')) r a
    counts = map (fnTuple (head, length)) . group . sort $ r


main = do
    [r,a] <- words <$> getLine
    unless (r=="0" && a=="0") $ putStrLn (hb r a) >> main