My code aims to create a word search puzzle. There is a data called Orientation representing the direction of each word in the puzzle.
data Orientation =
Forward | Back | Up | Down | UpForward | UpBack | DownForward | DownBack
deriving (Eq, Ord, Show, Read)
Now given a input of strings which is [String], I want to randomly assign each string an orientation like [(Orientation, String)]
assignWordDir :: [String] -> [(Orientation, String)]
assignWordDir [] = []
assignWordDir (s:strs) = (ori, s) : assignWordDir
where ori = pickOri [Forward, Back, Up, Down, UpForward, UpBack, DownForward, DownBack]
pickOri :: [a] -> IO a
pickOri xs = do
i <- randomRIO (0, len)
pure $ xs !! i
where len = length xs - 1
I cannot compile because the output of pickOri is IO Orientation, is there any suggestions on how to modify my code? Thanks a lot
Couldn't match expected type ‘[(IO Orientation, String)]’
with actual type ‘[String] -> [(Orientation, String)]’
You might consider modifying the functions so that they stay pure by taking a RandomGen parameter. The pickOri function, for example, might be modified thusly:
pickOri :: RandomGen g => g -> [a] -> (a, g)
pickOri rnd xs =
let len = length xs - 1
(i, g) = randomR (0, len) rnd
in (xs !! i, g)
It's necessary to return the new RandomGen value g together with the selected list element, so that it'll generate another pseudo-random number the next time around.
Likewise, you can modify assignWordDir like this:
assignWordDir :: RandomGen g => g -> [b] -> [(Orientation, b)]
assignWordDir _ [] = []
assignWordDir rnd (s:strs) = (ori, s) : assignWordDir g strs
where (ori, g) =
pickOri rnd [Forward, Back, Up, Down, UpForward, UpBack, DownForward, DownBack]
Notice that when recursing into to assignWordDir, the recursive function call uses the g it receives from pickOri.
You can use mkStdGen or newStdGen to produce RandomGen values. Here's an example using newStdGen:
*Q65132918> rnd <- newStdGen
*Q65132918> assignWordDir rnd ["foo", "bar", "baz"]
[(UpBack,"foo"),(Up,"bar"),(UpBack,"baz")]
*Q65132918> assignWordDir rnd ["foo", "bar", "baz"]
[(UpBack,"foo"),(Up,"bar"),(UpBack,"baz")]
Notice that when you use the same RandomGen value, you get the same sequence. That's because assignWordDir is a pure function, so that's expected.
You can, however, produce a new random sequence by creating or getting a new StdGen value:
*Q65132918> rnd <- newStdGen
*Q65132918> assignWordDir rnd ["foo", "bar", "baz"]
[(Up,"foo"),(Up,"bar"),(Forward,"baz")]
If you want to play with this in a compiled module, you can keep these functions as presented here, and then compose them with a newStdGen-generated StdGen in the main entry point.
Related
I have random number generator
rand :: Int -> Int -> IO Int
rand low high = getStdRandom (randomR (low,high))
and a helper function to remove an element from a list
removeItem _ [] = []
removeItem x (y:ys) | x == y = removeItem x ys
| otherwise = y : removeItem x ys
I want to shuffle a given list by randomly picking an item from the list, removing it and adding it to the front of the list. I tried
shuffleList :: [a] -> IO [a]
shuffleList [] = []
shuffleList l = do
y <- rand 0 (length l)
return( y:(shuffleList (removeItem y l) ) )
But can't get it to work. I get
hw05.hs:25:33: error:
* Couldn't match expected type `[Int]' with actual type `IO [Int]'
* In the second argument of `(:)', namely
....
Any idea ?
Thanks!
Since shuffleList :: [a] -> IO [a], we have shuffleList (xs :: [a]) :: IO [a].
Obviously, we can't cons (:) :: a -> [a] -> [a] an a element onto an IO [a] value, but instead we want to cons it onto the list [a], the computation of which that IO [a] value describes:
do
y <- rand 0 (length l)
-- return ( y : (shuffleList (removeItem y l) ) )
shuffled <- shuffleList (removeItem y l)
return y : shuffled
In do notation, values to the right of <- have types M a, M b, etc., for some monad M (here, IO), and values to the left of <- have the corresponding types a, b, etc..
The x :: a in x <- mx gets bound to the pure value of type a produced / computed by the M-type computation which the value mx :: M a denotes, when that computation is actually performed, as a part of the combined computation represented by the whole do block, when that combined computation is performed as a whole.
And if e.g. the next line in that do block is y <- foo x, it means that a pure function foo :: a -> M b is applied to x and the result is calculated which is a value of type M b, denoting an M-type computation which then runs and produces / computes a pure value of type b to which the name y is then bound.
The essence of Monad is thus this slicing of the pure inside / between the (potentially) impure, it is these two timelines going on of the pure calculations and the potentially impure computations, with the pure world safely separated and isolated from the impurities of the real world. Or seen from the other side, the pure code being run by the real impure code interacting with the real world (in case M is IO). Which is what computer programs must do, after all.
Your removeItem is wrong. You should pick and remove items positionally, i.e. by index, not by value; and in any case not remove more than one item after having picked one item from the list.
The y in y <- rand 0 (length l) is indeed an index. Treat it as such. Rename it to i, too, as a simple mnemonic.
Generally, with Haskell it works better to maximize the amount of functional code at the expense of non-functional (IO or randomness-related) code.
In your situation, your “maximum” functional component is not removeItem but rather a version of shuffleList that takes the input list and (as mentioned by Will Ness) a deterministic integer position. List function splitAt :: Int -> [a] -> ([a], [a]) can come handy here. Like this:
funcShuffleList :: Int -> [a] -> [a]
funcShuffleList _ [] = []
funcShuffleList pos ls =
if (pos <=0) || (length(take (pos+1) ls) < (pos+1))
then ls -- pos is zero or out of bounds, so leave list unchanged
else let (left,right) = splitAt pos ls
in (head right) : (left ++ (tail right))
Testing:
λ>
λ> funcShuffleList 4 [0,1,2,3,4,5,6,7,8,9]
[4,0,1,2,3,5,6,7,8,9]
λ>
λ> funcShuffleList 5 "#ABCDEFGH"
"E#ABCDFGH"
λ>
Once you've got this, you can introduce randomness concerns in simpler fashion. And you do not need to involve IO explicitely, as any randomness-friendly monad will do:
shuffleList :: MonadRandom mr => [a] -> mr [a]
shuffleList [] = return []
shuffleList ls =
do
let maxPos = (length ls) - 1
pos <- getRandomR (0, maxPos)
return (funcShuffleList pos ls)
... IO being just one instance of MonadRandom.
You can run the code using the default IO-hosted random number generator:
main = do
let inpList = [0,1,2,3,4,5,6,7,8]::[Integer]
putStrLn $ "inpList = " ++ (show inpList)
-- mr automatically instantiated to IO:
outList1 <- shuffleList inpList
putStrLn $ "outList1 = " ++ (show outList1)
outList2 <- shuffleList outList1
putStrLn $ "outList2 = " ++ (show outList2)
Program output:
$ pickShuffle
inpList = [0,1,2,3,4,5,6,7,8]
outList1 = [6,0,1,2,3,4,5,7,8]
outList2 = [8,6,0,1,2,3,4,5,7]
$
$ pickShuffle
inpList = [0,1,2,3,4,5,6,7,8]
outList1 = [4,0,1,2,3,5,6,7,8]
outList2 = [2,4,0,1,3,5,6,7,8]
$
The output is not reproducible here, because the default generator is seeded by its launch time in nanoseconds.
If what you need is a full random permutation, you could have a look here and there - Knuth a.k.a. Fisher-Yates algorithm.
i'm trying to write a function that for n gives matrix n*n with unique rows and columns (latin square).
I got function that gives my list of strings "1" .. "2" .. "n"
numSymbol:: Int -> [String]
I tried to generate all permutations of this, and them all n-length tuples of permutations, and them check if it is unique in row / columns. But complexity (n!)^2 works perfect for 2 and 3, but with n > 3 it takes forever. It is possible to build latin square from permutations directly, for example from
permutation ( numSymbol 3) = [["1","2","3"],["1","3","2"],["2","1","3"],["2","3","1"],["3","1","2"],["3","2","1"]]
get
[[["1","2","3",],["2","1","3"],["3","1","2"]] , ....]
without generating list like [["1",...],["1",...],...], when we know first element disqualify it ?
Note: since we can easily take a Latin square that's been filled with numbers from 1 to n and re-label it with anything we want, we can write code that uses integer symbols without giving anything away, so let's stick with that.
Anyway, the stateful backtracking/nondeterministic monad:
type StateList s = StateT s []
is helpful for this sort of problem.
Here's the idea. We know that every symbol s is going to appear exactly once in each row r, so we can represent this with an urn of all possible ordered pairs (r,s):
my_rs_urn = [(r,s) | r <- [1..n], s <- [1..n]]
Similarly, as every symbol s appears exactly once in each column c, we can use a second urn:
my_cs_urn = [(c,s) | c <- [1..n], s <- [1..n]]
Creating a Latin square is matter of filling in each position (r,c) with a symbol s by removing matching balls (r,s) and (c,s) (i.e., removing two balls, one from each urn) so that every ball is used exactly once. Our state will be the content of the urns.
We need backtracking because we might reach a point where for a particular position (r,c), there is no s such that (r,s) and (c,s) are both still available in their respective urns. Also, a pleasant side-effect of list-based backtracking/nondeterminism is that it'll generate all possible Latin squares, not just the first one it finds.
Given this, our state will look like:
type Urn = [(Int,Int)]
data S = S
{ size :: Int
, rs :: Urn
, cs :: Urn }
I've included the size in the state for convenience. It won't ever be modified, so it actually ought to be in a Reader instead, but this is simpler.
We'll represent a square by a list of cell contents in row-major order (i.e., the symbols in positions [(1,1),(1,2),...,(1,n),(2,1),...,(n,n)]):
data Square = Square
Int -- square size
[Int] -- symbols in row-major order
deriving (Show)
Now, the monadic action to generate latin squares will look like this:
type M = StateT S []
latin :: M Square
latin = do
n <- gets size
-- for each position (r,c), get a valid symbol `s`
cells <- forM (pairs n) (\(r,c) -> getS r c)
return $ Square n cells
pairs :: Int -> [(Int,Int)]
pairs n = -- same as [(x,y) | x <- [1..n], y <- [1..n]]
(,) <$> [1..n] <*> [1..n]
The worker function getS picks an s so that (r,s) and (c,s) are available in the respective urns, removing those pairs from the urns as a side effect. Note that getS is written non-deterministically, so it'll try every possible way of picking an s and associated balls from the urns:
getS :: Int -> Int -> M Int
getS r c = do
-- try each possible `s` in the row
s <- pickSFromRow r
-- can we put `s` in this column?
pickCS c s
-- if so, `s` is good
return s
Most of the work is done by the helpers pickSFromRow and pickCS. The first, pickSFromRow picks an s from the given row:
pickSFromRow :: Int -> M Int
pickSFromRow r = do
balls <- gets rs
-- "lift" here non-determinstically picks balls
((r',s), rest) <- lift $ choices balls
-- only consider balls in matching row
guard $ r == r'
-- remove the ball
modify (\st -> st { rs = rest })
-- return the candidate "s"
return s
It uses a choices helper which generates every possible way of pulling one element out of a list:
choices :: [a] -> [(a,[a])]
choices = init . (zipWith f <$> inits <*> tails)
where f a (x:b) = (x, a++b)
f _ _ = error "choices: internal error"
The second, pickCS checks if (c,s) is available in the cs urn, and removes it if it is:
pickCS :: Int -> Int -> M ()
pickCS c s = do
balls <- gets cs
-- only continue if the required ball is available
guard $ (c,s) `elem` balls
-- remove the ball
modify (\st -> st { cs = delete (c,s) balls })
With an appropriate driver for our monad:
runM :: Int -> M a -> [a]
runM n act = evalStateT act (S n p p)
where p = pairs n
this can generate all 12 Latin square of size 3:
λ> runM 3 latin
[Square 3 [1,2,3,2,3,1,3,1,2],Square 3 [1,2,3,3,1,2,2,3,1],...]
or the 576 Latin squares of size 4:
λ> length $ runM 4 latin
576
Compiled with -O2, it's fast enough to enumerate all 161280 squares of size 5 in a couple seconds:
main :: IO ()
main = print $ length $ runM 5 latin
The list-based urn representation above isn't very efficient. On the other hand, because the lengths of the lists are pretty small, there's not that much to be gained by finding more efficient representations.
Nonetheless, here's complete code that uses efficient Map/Set representations tailored to the way the rs and cs urns are used. Compiled with -O2, it runs in constant space. For n=6, it can process about 100000 Latin squares per second, but that still means it'll need to run for a few hours to enumerate all 800 million of them.
{-# OPTIONS_GHC -Wall #-}
module LatinAll where
import Control.Monad.State
import Data.List
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map, (!))
import qualified Data.Map as Map
data S = S
{ size :: Int
, rs :: Map Int [Int]
, cs :: Set (Int, Int) }
data Square = Square
Int -- square size
[Int] -- symbols in row-major order
deriving (Show)
type M = StateT S []
-- Get Latin squares
latin :: M Square
latin = do
n <- gets size
cells <- forM (pairs n) (\(r,c) -> getS r c)
return $ Square n cells
-- All locations in row-major order [(1,1),(1,2)..(n,n)]
pairs :: Int -> [(Int,Int)]
pairs n = (,) <$> [1..n] <*> [1..n]
-- Get a valid `s` for position `(r,c)`.
getS :: Int -> Int -> M Int
getS r c = do
s <- pickSFromRow r
pickCS c s
return s
-- Get an available `s` in row `r` from the `rs` urn.
pickSFromRow :: Int -> M Int
pickSFromRow r = do
urn <- gets rs
(s, rest) <- lift $ choices (urn ! r)
modify (\st -> st { rs = Map.insert r rest urn })
return s
-- Remove `(c,s)` from the `cs` urn.
pickCS :: Int -> Int -> M ()
pickCS c s = do
balls <- gets cs
guard $ (c,s) `Set.member` balls
modify (\st -> st { cs = Set.delete (c,s) balls })
-- Return all ways of removing one element from list.
choices :: [a] -> [(a,[a])]
choices = init . (zipWith f <$> inits <*> tails)
where f a (x:b) = (x, a++b)
f _ _ = error "choices: internal error"
-- Run an action in the M monad.
runM :: Int -> M a -> [a]
runM n act = evalStateT act (S n rs0 cs0)
where rs0 = Map.fromAscList $ zip [1..n] (repeat [1..n])
cs0 = Set.fromAscList $ pairs n
main :: IO ()
main = do
print $ runM 3 latin
print $ length (runM 4 latin)
print $ length (runM 5 latin)
Somewhat remarkably, modifying the program to produce only reduced Latin squares (i.e., with symbols [1..n] in order in both the first row and the first column) requires changing only two functions:
-- All locations in row-major order, skipping first row and column
-- i.e., [(2,2),(2,3)..(n,n)]
pairs :: Int -> [(Int,Int)]
pairs n = (,) <$> [2..n] <*> [2..n]
-- Run an action in the M monad.
runM :: Int -> M a -> [a]
runM n act = evalStateT act (S n rs0 cs0)
where -- skip balls [(1,1)..(n,n)] for first row
rs0 = Map.fromAscList $ map (\r -> (r, skip r)) [2..n]
-- skip balls [(1,1)..(n,n)] for first column
cs0 = Set.fromAscList $ [(c,s) | c <- [2..n], s <- skip c]
skip i = [1..(i-1)]++[(i+1)..n]
With these modifications, the resulting Square will include symbols in row-major order but skipping the first row and column. For example:
λ> runM 3 latin
[Square 3 [3,1,1,2]]
means:
1 2 3 fill in question marks 1 2 3
2 ? ? =====================> 2 3 1
3 ? ? in row-major order 3 1 2
This is fast enough to enumerate all 16,942,080 reduced Latin squares of size 7 in a few minutes:
$ stack ghc -- -O2 -main-is LatinReduced LatinReduced.hs && time ./LatinReduced
[1 of 1] Compiling LatinReduced ( LatinReduced.hs, LatinReduced.o )
Linking LatinReduced ...
16942080
real 3m9.342s
user 3m8.494s
sys 0m0.848s
The problem sounds like this: write a program that reads a number n and then n persons, for each persons, read their name and age and then return the oldest persons/persons.
Example input:
3
Ion Ionel Ionescu
70
Gica Petrescu
99
Mustafa ben Muhamad
7
Example output
Oldest is Gica Petrescu (99 years).
My code so far:
readPers :: IO(String, Int)
readPers = do
name <- getLine
age <- readLn :: IO Int
return (name, age)
readPerss :: (Ord t, Num t) => t -> [IO (String, Int)]
readPerss n
| n > 0 = readPers : readPerss(n-1)
| otherwise = []
pFunc = do
print "Numer of persons:"
n <- readLn :: IO Int
let persons = readPerss n
return persons
I first read n, then I try to make a list of persons using readPers and readPerss, but I am stuck, I don't know how to tackle it from that point forward and I guess that my implementation thus far is not quite right.
How should I solve the problem?
You are very close! What you are doing in readPerss :: (Ord t, Num t) => t -> [IO (String, Int)] is returning a list of IO actions; each action returns a pair of String and Int when it is executed. Currently in pFunc you are only building this list of actions, storing it in a variable with let, and returning it from pFunc; you are never executing them with a <- “bind” statement.
There are a few simple ways to do what you want. The smallest change to your code that does what you want is to add sequence, which takes a container of actions and produces an action that returns a container:
sequence :: (Traversable t, Monad m) => t (m a) -> m (t a)
Here t is [], m is IO, and a is (String, Int):
sequence :: [IO (String, Int)] -> IO [(String, Int)]
Another way is to rewrite readPerss so that it executes the actions directly, accumulating the (String, Int) results in a list instead of accumulating the IO actions:
readPerss :: (Ord t, Num t) => t -> IO [(String, Int)]
-- Change [IO …] to IO […]: ~~~~~~~~~~~~~~~~~~
readPerss n
| n > 0 = do
pers <- readPers
perss <- readPerss (n - 1)
return (pers : perss)
| otherwise = return []
I know you may not be supposed to use library functions if this is a homework assignment or exercise, but in typical code “repeat x action n times and accumulate the results” is often represented with replicateM n x:
replicateM :: Applicative m => Int -> m a -> m [a]
This is how I always do this (it is from a code challenge isn’t it). I always seperate IO and logic as soon as possible. Works perfect (unless N is very big).
import Data.List.Split (chunksOf)
type Person = (String, Int)
main = do
x <- getContents
putStrLn $ program x
program :: String -> String
program s = “Oldest is “ ++ x ++ “ (“ ++ (show y) ++ “ years old).”
where
(x, y) = solve persons
persons = [(name, read age :: Int) | [name, age] <- chunksOf 2 . tail . lines $ s]
solve :: [Person] -> Person
solve ls = undefined
I leave the undefined to you.
So I'm trying to make a little program that can take in data captured during an experiment, and for the most part I think I've figured out how to recursively take in data until the user signals there is no more, however upon termination of data taking haskell throws Exception: <<loop>> and I can't really figure out why. Here's the code:
readData :: (Num a, Read a) => [Point a] -> IO [Point a]
readData l = do putStr "Enter Point (x,y,<e>) or (d)one: "
entered <- getLine
if (entered == "d" || entered == "done")
then return l
else do let l = addPoint l entered
nl <- readData l
return nl
addPoint :: (Num a, Read a) => [Point a] -> String -> [Point a]
addPoint l s = l ++ [Point (dataList !! 0) (dataList !! 1) (dataList !! 2)]
where dataList = (map read $ checkInputData . splitOn "," $ s) :: (Read a) => [a]
checkInputData :: [String] -> [String]
checkInputData xs
| length xs < 2 = ["0","0","0"]
| length xs < 3 = (xs ++ ["0"])
| length xs == 3 = xs
| length xs > 3 = ["0","0","0"]
As far as I can tell, the exception is indication that there is an infinite loop somewhere, but I can't figure out why this is occurring. As far as I can tell when "done" is entered the current level should simply return l, the list it's given, which should then cascade up the previous iterations of the function.
Thanks for any help. (And yes, checkInputData will have proper error handling once I figure out how to do that.)
<<loop>> basically means GHC has detected an infinite loop caused by a value which depends immediately on itself (cf. this question, or this one for further technical details if you are curious). In this case, that is triggered by:
else do let l = addPoint l entered
This definition, which shadows the l you passed as an argument, defines l in terms of itself. You meant to write something like...
else do let l' = addPoint l entered
... which defines a new value, l', in terms of the original l.
As Carl points out, turning on -Wall (e.g. by passing it to GHC at the command line, or with :set -Wall in GHCi) would make GHC warn you about the shadowing:
<interactive>:171:33: warning: [-Wname-shadowing]
This binding for ‘l’ shadows the existing binding
bound at <interactive>:167:10
Also, as hightlighted by dfeuer, the whole do-block in the else branch can be replaced by:
readData (addPoint l entered)
As an unrelated suggestion, in this case it is a good idea to replace your uses of length and (!!) with pattern matching. For instance, checkInputData can be written as:
checkInputData :: [String] -> [String]
checkInputData xs = case xs of
[_,_] -> xs ++ ["0"]
[_,_,_] -> xs
_ -> ["0","0","0"]
addPoint, in its turn, might become:
addPoint :: (Num a, Read a) => [Point a] -> String -> [Point a]
addPoint l s = l ++ [Point x y z]
where [x,y,z] = (map read $ checkInputData . splitOn "," $ s) :: (Read a) => [a]
That becomes even neater if you change checkInputData so that it returns a (String, String, String) triple, which would better express the invariant that you are reading exactly three values.
I need to generate an infinite stream of random integers, with numbers to be in range [1..n]. However the probability for each number p_i is given in advance thus the distribution is not uniform.
Is there a library function to do it in Haskell?
As people have pointed out there is a function in Control.Monad.Random, but it has pretty poor complexity. Here is some code that I by some coincidence wrote this morning. It uses the beautiful Alias algorithm.
module Data.Random.Distribution.NonUniform(randomsDist) where
import Data.Array
import Data.List
import System.Random
genTable :: (Num a, Ord a) => [a] -> (Array Int a, Array Int Int)
genTable ps =
let n = length ps
n' = fromIntegral n
(small, large) = partition ((< 1) . snd) $ zip [0..] $ map (n' *) ps
loop ((l, pl):ls) ((g, pg):gs) probs aliases =
let prob = (l,pl)
alias = (l,g)
pg' = (pg + pl) - 1
gpg = (g, pg')
in if pg' < 1 then loop (gpg:ls) gs (prob:probs) (alias:aliases)
else loop ls (gpg:gs) (prob:probs) (alias:aliases)
loop ls gs probs aliases = loop' (ls ++ gs) probs aliases
loop' [] probs aliases = (array (0,n-1) probs, array (0,n-1) aliases)
loop' ((g,_):gs) probs aliases = loop' gs ((g,1):probs) ((g, -1):aliases)
in loop small large [] []
-- | Generate an infinite list of random values with the given distribution.
-- The probabilities are scaled so they do not have to add up to one.
--
-- Uses Vose's alias method for generating the values.
-- For /n/ values this has O(/n/) setup complexity and O(1) complexity for each
-- generated item.
randomsDist :: (RandomGen g, Random r, Fractional r, Ord r)
=> g -- | random number generator
-> [(a, r)] -- | list of values with the probabilities
-> [a]
randomsDist g xps =
let (xs, ps) = unzip xps
n = length xps
axs = listArray (0, n-1) xs
s = sum ps
(probs, aliases) = genTable $ map (/ s) ps
(g', g'') = split g
is = randomRs (0, n-1) g'
rs = randoms g''
ks = zipWith (\ i r -> if r <= probs!i then i else aliases!i) is rs
in map (axs!) ks
Just to expand on dflemstr's answer, you can create an infinite list of weighted values using Control.Monad.Random like this:
import Control.Monad.Random
import System.Random
weightedList :: RandomGen g => g -> [(a, Rational)] -> [a]
weightedList gen weights = evalRand m gen
where m = sequence . repeat . fromList $ weights
And use it like this:
> let values = weightedList (mkStdGen 123) [(1, 2), (2, 5), (3, 10)]
> take 20 values
[2,1,3,2,1,2,2,3,3,3,3,3,3,2,3,3,2,2,2,3]
This doesn't require the IO monad, but you need to provide the random number generator that's used for the stream.
Control.Monad.Random offers this function in form of fromList:: MonadRandom m => [(a, Rational)] -> m a
You can use it in the IO Monad with:
import Control.Monad.Random
-- ...
someNums <- evalRandIO . sequence . repeat . fromList $ [(1, 0.3), (2, 0.2), (3, 0.5)]
print $ take 200 someNums
There are other ways of running the Rand Monad as you can see in that package. The weights do not have to add up to 1.
EDIT: Rand is apparently lazier than I thought, so replicateM n can be replaced by sequence . repeat, as #shang suggested.
There is also System.Random.Distributions.frequency
frequency :: (Floating w, Ord w, Random w, RandomGen g) => [(w, a)] -> g -> (a, g)
See https://hackage.haskell.org/package/Euterpea-1.0.0/docs/System-Random-Distributions.html