Concurrent Clean : 枝刈り

枝刈りを入れてみた。pruningの定義から、shuffled_permを追い出してしまいたいのだけれど、型付けの制限を回避しないといけないので、もう少し検討。

import StdEnv, OptEnv, MersenneTwister

/* shuffled_perm ::
 *   pruning_function random_list_generator list random_seed
 * pruning_function ::
 *   random_list_generator list random_seed
 */
shuffled_perm _ _ [] _ = [[]]
shuffled_perm pruning frnd ls s # (ls,rnd) = shuffle ls (frnd s)
                                  (slst,rnd) = map_shuffle [] ls rnd
                                  arr = asArray {a \\ a <- slst}
                                  (n,arr) = usize arr
                                = loop n arr rnd
  where
    map_shuffle _ [] rnd = ([],rnd)
    map_shuffle ls1 [a:ls2] [s:r] # (rest,rnd) = map_shuffle [a:ls1] ls2 r
                                  = ([pruning frnd a (ls1++ls2) s:rest], rnd)

    loop 0 _ _ = []
    loop n arr [s:r] # ((fr,to),arr) = arr![i]
                     = case to of
                        [] = loop n_1 (swap i n_1 arr) r
                        [h:t] # arr = {arr & [i]=(fr,t)}
                              = [[fr:h]:loop n arr r]
      where
        i = (abs s) rem n
        n_1 = dec n

::Person = Person !Char !Int

answer ps frnd s = map (zip2 ps) $ shuffled_perm (pruning ps) frnd ps s
  where
    pruning [Person g1 _:pr] frnd a=:(Person g2 _) ls s
        | g1 == g2 = (a,[])
                   = (a,shuffled_perm (pruning pr) frnd ls s)

Start w # (t,w) = tick_count w
        = case answer case20` genRandInt t of
            []  = Nothing
            ans = Just (hd ans)