-- | Module for generating random 'Instance's. module AM3.RandomInstance ( -- * Random generator randomInstance , randomInstanceFile -- * Parameters , Params(..) , Range -- * Probability , Probability , fromDouble -- * Auxiliary functions , coin ) where import AM3.Instance import Control.Monad.Random import Control.Monad (replicateM) import Control.Monad.Trans -- | An inclusive range of 'Int's. type Range = (Int, Int) -- | A real between 0 and 1. newtype Probability = Prob Double deriving (Eq, Num, Ord, Show) instance Fractional Probability where fromRational = fromDouble . fromRational (Prob a) / (Prob b) = Prob (a / b) -- | Creates a probability from a 'Double'. Error if not between 0 and 1. fromDouble :: Double -> Probability fromDouble p | 0 <= p && p <= 1 = Prob p | otherwise = error $ show p ++ " is not a probability" asDouble :: Probability -> Double asDouble (Prob p) = p -- | Parameters for generating a random 'Instance'. -- -- Concrete values are picked uniformly at random within the defined 'Range's. data Params = Params { _NC :: Range -- ^ Number of entities (@nOffices + nCenters@). , _oP :: Probability -- ^ Probability for an entity of being an office, as -- opposed to being a center. In other words, proportion -- @nOffices/nCenters@. , _kR :: Range -- ^ Capacities range. , _dR :: Range -- ^ Data range. , _pR :: Range -- ^ Number of segments range. , _fR :: Range -- ^ Fixed costs range. , _cI :: Int -- ^ Positive 'Int'. Max cost increase added to a certain lower -- bound. This lower bound ensures that the total cost is -- monotonic with respect to the stored data. See the -- documentation of 'randomInstance'. , _uP :: Probability -- ^ Probability of allowed connection. } deriving (Show) -- | Flips a coin with probability of heads /p/. coin :: MonadRandom m => Probability -> m Bool coin (Prob p) = (< p) <$> getRandom -- | Generates a random 'Instance' from a set of parameters 'Params'. -- -- Ensures the cost of a center is monotonic with respect to the amount -- of data stored in it. This can be expressed by the following inequation. -- -- * @M[i]@: threshold of segment @i@. -- * @C[i]@: cost of segment @i@. -- -- @M[i]*C[i] > (M[i] - 1)*C[i-1]@. -- -- equivalent to: -- -- @C[i] > (C[i-1] * (1 + M[i])) \/ M[i]@. -- -- We add an additional random positive cost @I[i]@ to add randomness. -- -- * @I[i]@: random cost increase. In range of (1, '_cI'). -- -- Finally we define @C[i]@ as follows. -- -- @i = 0: C[i] = I[i]@. -- -- @i > 0: C[i] + I[i] = (C[i-1] * (1 + M[i])) \/ M[i]@. randomInstance :: MonadRandom m => Params -> m Instance randomInstance Params{..} = do nEntities <- getRandomR _NC nSegs <- getRandomR _pR xs <- take nEntities <$> getRandoms let nOffices = length (filter (< asDouble _oP) xs) nCenters = nEntities - nOffices allowdCons <- replicateM (nOffices*nCenters) (coin _uP) fixedCosts <- take nCenters <$> getRandomRs _fR datas <- take nOffices <$> getRandomRs _dR caps <- take nCenters <$> getRandomRs _kR spans <- take (nSegs - 1) <$> getRandomRs (incR nSegs) let thresh = scanl (+) 0 spans costs <- getCosts thresh return (newInstance r datas caps fixedCosts costs thresh allowdCons) where r = 2 getCosts ms = do cost0 <- getRandomR (1, _cI) step ms cost0 where step [] _ = return [] step (m2:ms) c1 = do c2 <- getRandomR (lb, lb + _cI) cs <- step ms c2 return (c2:cs) where lb = ceiling (((m + 1)*fromIntegral c1) / m) m = fromIntegral m2 :: Double expectedCap = let (a, b) = _kR in a + (a + b)`div`2 incR segs = let x = expectedCap `div` segs in (max 1 x, x) -- | Generates a random 'Instance' and exports it to a @.dat@ file. -- -- * Running the generation with a seed: -- -- @evalRandT (randomInstanceFile params path) (mkStdGen seed)@ -- -- * Running the generation without a seed (using the @IO monad@): -- -- @evalRandT (randomInstanceFile params path)@ randomInstanceFile :: Params -- ^ Parameters for the generation. -> FilePath -- ^ Path of the @.dat@ file. -> RandT StdGen IO () randomInstanceFile p file = randomInstance p >>= lift . toFile file