{- | Gaussian Process Library. This module contains assorted functions
     that support random number generation and the construction of basic
     standard training sets.

     Note: these are mostly calls to functions now (but not originally)
     supplied by HMatrix. Originally different random sources were used, 
     hence the current format.

     Copyright (C) 2011 Sean Holden. sbh11\@cl.cam.ac.uk.

-}
{- This file is part of HasGP.

   HasGP is free software: you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation, either version 3 of the License, or
   (at your option) any later version.

   HasGP is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with HasGP.  If not, see <http://www.gnu.org/licenses/>.
-}
module HasGP.Support.Random where

import Numeric.LinearAlgebra
import Numeric.Container

import HasGP.Types.MainTypes

-- | Make a random matrix. Elements are uniformly distributed between 
--   specified bounds. Returns the matrix and a new generator.
uniformMatrix :: Int                 -- ^ Seed
              -> (Double,Double)     -- ^ Range for the elements
              -> Int                 -- ^ Number of rows
              -> Int                 -- ^ Number of columns
              -> DMatrix
uniformMatrix seed (low,high) rows columns = 
        uniformSample seed rows [(low,high) | x <- [1..columns]] 

-- | Produce vectors with normally distributed, independent elements of
--   zero mean and specified variance.
normalVectorSimple :: Int       -- ^ Seed 
                   -> Double    -- ^ Variance
                   -> Int       -- ^ Number of elements in the vector.
                   -> DVector
normalVectorSimple seed v n = 
        flatten $ gaussianSample seed 1 (constant 0.0 n) 
                    (scale (1/v) (ident n)::DMatrix)

-- | Produce lists with normally distributed independent elements of
--   zero mean and specified variance.
normalList :: Int        -- ^ Seed 
           -> Double     -- ^ Variance
           -> Int        -- ^ Number of elements in the list
           -> [Double]
normalList seed v n = toList $ normalVectorSimple seed v n
                          
-- | Produce normally distributed vectors with mean and covariance
--   specified.
normalVector :: Int       -- ^ Seed 
             -> DVector   -- ^ Mean vector
             -> DMatrix   -- ^ Covariance matrix
             -> DVector  
normalVector seed m c = flatten $ gaussianSample seed 1 m c
                             
-- | Make a matrix with normally distributed, independent elements of 
--   zero mean and specified variance.
normalMatrix :: Int       -- ^ Seed 
             -> Double    -- ^ Variance
             -> Int       -- ^ Rows 
             -> Int       -- ^ Columns
             -> DMatrix
normalMatrix seed variance rows columns = 
        gaussianSample seed rows (constant 0.0 columns) 
                           (scale variance ((ident columns)::DMatrix))