RandomInstance.hs

-- | 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