Concurrent Clean : あなたならどうお書きになります1.0

[id:lethevert:20061222:p5]
この間のあれは、何も考えずに書いたので、当然ながら効率は悪い。
手元のPCで、８人までは１秒以内だったが、９人で５秒。１０人以上ではメモリも時間もかなりかかってしまう。
そこで、別のアプローチに切り替えて書き直してみよう。

• • • -

とりあえず、こんな。２０要素でも１秒以内に結果が返ってきます。
解なしの可能性を考えて、試行回数を３０回に制限しています。
ところで、shuffle関数は、OptEnvに含めてしまおうかと思っています。

import StdEnv, OptEnv, MersenneTwister

/* an imperative perfect shuffle algorithm
 * according to http://okmij.org/ftp/Haskell/
 */
shuffle :: [a] [Int] -> ([a],[Int])
shuffle ls rnd # arr = asArray {a \\ a <- ls}
                 (n, arr) = usize arr
                 n = dec n
                 (arr,rnd) = shuffle n rnd arr
               = ([a \\ a <-: arr], rnd)
  where
    shuffle n rnd arr | n <= 0 = (arr,rnd)
    shuffle n [r:rnd] arr = shuffle (dec n) rnd (swap ((abs r) rem n) arr)
      where
        swap i arr=:{[i]=ai,[n]=an} = {arr & [i]=an,[n]=ai}

shuffle2 ls rnd = shuffle2 rnd
  where
    shuffle2 rnd # (ls2, rnd) = shuffle ls rnd
                 = [ls2:shuffle2 rnd]

::Person = Person !Char !Int
instance == Person where
  (==) (Person g1 p1) (Person g2 p2) = g1 == g2 && p1 == p2

answer trial ps rnd = filter f $ map (zip2 ps) $ take trial $ shuffle2 ps rnd
  where
    f [] = True
    f [(Person g1 _,Person g2 _):rest] = g1 <> g2 && f rest

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