mkg.hs 1.34 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
import Data.Array.ST
import Data.Array
import System.Random
import System.IO
import System.Exit
import System.Environment

import Data.Array.Parallel.Unlifted
import Graph

randomG :: RandomGen g => g -> Int -> Int -> Graph
randomG g n e = Graph n e ues
  where
    aes = runSTArray (do
            arr <- newArray (0,n-1) []
            fill arr (randomRs (0,n-1) g) e
          )

    fill arr _ 0        = return arr
    fill arr (m:n:rs) e =
      let lo = min m n
          hi = max m n
      in
      do
        ns <- readArray arr lo
        if lo == hi || hi `elem` ns
          then fill arr rs e
          else do
                 writeArray arr lo (hi : ns)
                 fill arr rs (e-1)


    ues = toU $ concat [map (:*: m) ns | (m,ns) <- assocs aes]

main = do
         args  <- getArgs
         (n,e) <- parseArgs args
         g     <- newStdGen
         print $ randomG g n e

  where
    parseArgs [nodes,edges] =
      do
        n <- parseInt nodes
        e <- parseInt edges
        return (n,e)
    parseArgs _ = do
                    hPutStrLn stderr "Invalid arguments"
                    exitFailure

    parseInt s = case reads s of
                   ((n,_) : _) -> return n
                   _           -> do
                                    hPutStrLn stderr $ "Invalid argument " ++ s
                                    exitFailure