{- | Gaussian Process Library - functions for producing data sets
     From Rasmussen and Williams, "Gaussian Processes for Machine Learning."

     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.Data.RWData1 where

import Numeric.LinearAlgebra

import HasGP.Types.MainTypes
import HasGP.Support.Random

-- | Generate training data for a simple classification problem as in 
--   Rasmussen/Williams, page 62.
simpleClassificationData :: Int -- ^ Seed for random number generator. 
                         -> (DMatrix, DVector)
simpleClassificationData seed = 
	((asColumn $ join [(-6)+x1, x2, 2+x3]), 
         join [constant 1 20, constant 0 30, constant 1 10])
    where
      v = (0.8)^2
      x1 = normalVectorSimple seed v 20 
      x2 = normalVectorSimple (seed+1) v 30
      x3 = normalVectorSimple (seed+2) v 10