rand.hs revision 1.1
11.1Syamt{- 21.1Syamt/* $NetBSD: rand.hs,v 1.1 2006/10/09 12:32:46 yamt Exp $ */ 31.1Syamt 41.1Syamt/*- 51.1Syamt * Copyright (c)2005 YAMAMOTO Takashi, 61.1Syamt * All rights reserved. 71.1Syamt * 81.1Syamt * Redistribution and use in source and binary forms, with or without 91.1Syamt * modification, are permitted provided that the following conditions 101.1Syamt * are met: 111.1Syamt * 1. Redistributions of source code must retain the above copyright 121.1Syamt * notice, this list of conditions and the following disclaimer. 131.1Syamt * 2. Redistributions in binary form must reproduce the above copyright 141.1Syamt * notice, this list of conditions and the following disclaimer in the 151.1Syamt * documentation and/or other materials provided with the distribution. 161.1Syamt * 171.1Syamt * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 181.1Syamt * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 191.1Syamt * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 201.1Syamt * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 211.1Syamt * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 221.1Syamt * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 231.1Syamt * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 241.1Syamt * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 251.1Syamt * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 261.1Syamt * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 271.1Syamt * SUCH DAMAGE. 281.1Syamt */ 291.1Syamt-} 301.1Syamt 311.1Syamtimport System.Environment 321.1Syamtimport System.IO 331.1Syamtimport List 341.1Syamtimport Maybe 351.1Syamtimport Random 361.1Syamt 371.1Syamtcontain x xs = isJust $ find (== x) xs 381.1Syamt 391.1SyamtdeleteAt 0 (_:xs) = xs 401.1SyamtdeleteAt at (x:xs) = x:deleteAt (at-1) xs 411.1Syamt 421.1Syamtdo_rand1 rg npg n q qlen [] = (reverse n, q) 431.1Syamtdo_rand1 rg npg n q qlen rs@(r:rs2) = 441.1Syamt if contain r q then 451.1Syamt do_rand1 rg npg n q qlen rs2 461.1Syamt else if qlen < npg then 471.1Syamt do_rand1 rg npg (r:n) (r:q) (qlen+1) rs2 481.1Syamt else 491.1Syamt let 501.1Syamt (i, nrg) = next rg 511.1Syamt at = i `mod` npg 521.1Syamt nq = deleteAt at q 531.1Syamt in 541.1Syamt do_rand1 nrg npg (r:n) (r:nq) qlen rs2 551.1Syamt 561.1Syamtdo_rand npg rs = fst $ do_rand1 rg npg [] [] 0 rs 571.1Syamt where 581.1Syamt rg = mkStdGen 0 591.1Syamt 601.1Syamtmain = do 611.1Syamt xs <- getContents 621.1Syamt args <- getArgs 631.1Syamt let 641.1Syamt ls = lines xs 651.1Syamt npgs::Int 661.1Syamt npgs = read $ args !! 0 671.1Syamt pgs::[Int] 681.1Syamt pgs = map read ls 691.1Syamt mapM_ print $ do_rand npgs pgs 70