1*dbdfc1f6Syamt{- 2*dbdfc1f6Syamt/* $NetBSD: rand.hs,v 1.1 2006/10/09 12:32:46 yamt Exp $ */ 3*dbdfc1f6Syamt 4*dbdfc1f6Syamt/*- 5*dbdfc1f6Syamt * Copyright (c)2005 YAMAMOTO Takashi, 6*dbdfc1f6Syamt * All rights reserved. 7*dbdfc1f6Syamt * 8*dbdfc1f6Syamt * Redistribution and use in source and binary forms, with or without 9*dbdfc1f6Syamt * modification, are permitted provided that the following conditions 10*dbdfc1f6Syamt * are met: 11*dbdfc1f6Syamt * 1. Redistributions of source code must retain the above copyright 12*dbdfc1f6Syamt * notice, this list of conditions and the following disclaimer. 13*dbdfc1f6Syamt * 2. Redistributions in binary form must reproduce the above copyright 14*dbdfc1f6Syamt * notice, this list of conditions and the following disclaimer in the 15*dbdfc1f6Syamt * documentation and/or other materials provided with the distribution. 16*dbdfc1f6Syamt * 17*dbdfc1f6Syamt * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 18*dbdfc1f6Syamt * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19*dbdfc1f6Syamt * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20*dbdfc1f6Syamt * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 21*dbdfc1f6Syamt * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22*dbdfc1f6Syamt * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23*dbdfc1f6Syamt * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24*dbdfc1f6Syamt * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25*dbdfc1f6Syamt * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26*dbdfc1f6Syamt * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27*dbdfc1f6Syamt * SUCH DAMAGE. 28*dbdfc1f6Syamt */ 29*dbdfc1f6Syamt-} 30*dbdfc1f6Syamt 31*dbdfc1f6Syamtimport System.Environment 32*dbdfc1f6Syamtimport System.IO 33*dbdfc1f6Syamtimport List 34*dbdfc1f6Syamtimport Maybe 35*dbdfc1f6Syamtimport Random 36*dbdfc1f6Syamt 37*dbdfc1f6Syamtcontain x xs = isJust $ find (== x) xs 38*dbdfc1f6Syamt 39*dbdfc1f6SyamtdeleteAt 0 (_:xs) = xs 40*dbdfc1f6SyamtdeleteAt at (x:xs) = x:deleteAt (at-1) xs 41*dbdfc1f6Syamt 42*dbdfc1f6Syamtdo_rand1 rg npg n q qlen [] = (reverse n, q) 43*dbdfc1f6Syamtdo_rand1 rg npg n q qlen rs@(r:rs2) = 44*dbdfc1f6Syamt if contain r q then 45*dbdfc1f6Syamt do_rand1 rg npg n q qlen rs2 46*dbdfc1f6Syamt else if qlen < npg then 47*dbdfc1f6Syamt do_rand1 rg npg (r:n) (r:q) (qlen+1) rs2 48*dbdfc1f6Syamt else 49*dbdfc1f6Syamt let 50*dbdfc1f6Syamt (i, nrg) = next rg 51*dbdfc1f6Syamt at = i `mod` npg 52*dbdfc1f6Syamt nq = deleteAt at q 53*dbdfc1f6Syamt in 54*dbdfc1f6Syamt do_rand1 nrg npg (r:n) (r:nq) qlen rs2 55*dbdfc1f6Syamt 56*dbdfc1f6Syamtdo_rand npg rs = fst $ do_rand1 rg npg [] [] 0 rs 57*dbdfc1f6Syamt where 58*dbdfc1f6Syamt rg = mkStdGen 0 59*dbdfc1f6Syamt 60*dbdfc1f6Syamtmain = do 61*dbdfc1f6Syamt xs <- getContents 62*dbdfc1f6Syamt args <- getArgs 63*dbdfc1f6Syamt let 64*dbdfc1f6Syamt ls = lines xs 65*dbdfc1f6Syamt npgs::Int 66*dbdfc1f6Syamt npgs = read $ args !! 0 67*dbdfc1f6Syamt pgs::[Int] 68*dbdfc1f6Syamt pgs = map read ls 69*dbdfc1f6Syamt mapM_ print $ do_rand npgs pgs 70