hgraph/src/DCB.hs

-----------------------------------------------------------------------------
--
-- Module      :  DCB
-- Copyright   :
-- License     :  AllRightsReserved
--
-- Maintainer  :
-- Stability   :
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

module DCB where

import Prelude hiding (Int, Double, Float)
import qualified Prelude (Int, Double, Float)

--import Stream hiding (map) --same as Data.Stream imported above?
import Data.Array.Accelerate (Z(..),DIM0,DIM1,DIM2,DIM3,Scalar,Vector,(:.)(..),Array,(!),(!!),
    Int8,Int,Float,Double,Acc,Exp,Elt,(>->),(>*),(<*),(>=*),(<=*),(==*),(/=*),(?),(?|),(&&*),(||*))
import qualified Data.Array.Accelerate as A
-- change to Data.Array.Accelerate.CUDA as I and link accelerate-cuda to use GPU instead of CPU
-- depends on accelerate-cuda package in cabal, which needs the installed CUDA-stuff form
-- nVidia (nvcc, header-files, ...) and the propriatary driver
import Data.Array.Accelerate.Interpreter as I
type Matrix e = Array DIM2 e

type Attr  = Matrix Double
-- Adjecency-Matrix
type Adj   = Matrix Int8
-- Vector of the Adjecency-Matrix
type AdjV  = Vector Int
newtype Constraints = Matrix Double
-- Graph consists of a Vector denoting which colums of the matrix represents wich originating
-- column in the global adjencency-matrix, the reduces adjencency-matrix of the graph, a
-- matrix of constraints and a scalar denoting the density
type Density = Scalar Double

-- Graph
type Graph = (Vector Int, Adj, Constraints, Density)

-- Vector of Graphs
type MultiGraph e = (Vector Int, Array DIM3 e, Constraints, Density)

-- Multigraph correct output ?
preprocess :: Acc (Matrix Int8) -> Acc Attr -> Acc (MultiGraph Int8)
preprocess adj a = undefined

-- tests whether the minimum amount of attributes are within range
-- first argument: required attributes to be in range
-- second argument: constraints vector with 1/0 entries for single attributes
testConstraints :: Acc (Scalar Int) -> Acc (Vector Int8) -> Exp Bool
testConstraints minHits = A.the . A.map (\s -> A.the minHits >=* A.fromIntegral s) . A.fold1All (+)

createConstrMat :: Acc Attr -> Acc (Vector Double) -> Acc (Vector Int)
        -> Acc ((Matrix Double), (Vector Int8))
createConstrMat attr maxDist nodes =
    let
        (Z:._:.nAttr) = A.unlift (A.shape attr) :: ((:.) ((:.) Z (Exp Int)) (Exp Int))
        constrMat = A.generate (A.index2 nAttr 3) (genConstrMat)
        -- generator function for the constraints fulfillment matrix
        -- first column contains minimum and second column maximum value of the attributes
        genConstrMat :: Exp DIM2 -> Exp Double
        genConstrMat ix =
            let
                (Z:.idAttr:.col) = A.unlift ix :: ((:.) ((:.) Z (Exp Int)) (Exp Int))
            in case col of
                    0 -> A.the $A.minimum (A.map (\i -> attr!(A.index2 i idAttr)) nodes)
                    1 -> A.the $A.maximum (A.map (\i -> attr!(A.index2 i idAttr)) nodes)
        -- tests whether an attribute is within the accepted threshold
        testDist :: Exp Int -> Exp Double -> Exp Int8
        testDist ix d = abs d <* maxDist!(A.index1 ix) ? (1, 0)
    in A.lift (constrMat, (A.fold1 ((-):: Exp Double -> Exp Double -> Exp Double)
            >-> A.zipWith testDist (A.enumFromN (A.index1 nAttr) 0)) constrMat)
            --subtract values >-> combine with vector of indices and test distance
            --TODO improvable by permute/backpermute?

--creates the new constraints fulfillment matrix when adding a new node to a known graph
updateConstrMatrix :: Acc Attr -> Acc (Vector Double) -> Acc (Scalar Int)
        -> Acc (Matrix Double, Vector Int8) -> Acc ((Matrix Double), (Vector Int8))
updateConstrMatrix attr maxDist node constr =
    let
        (Z:._:.nAttr) = A.unlift (A.shape attr) :: ((:.) ((:.) Z (Exp Int)) (Exp Int))
        (minmax, fulfill) = A.unlift constr :: (Acc (Matrix Double), Acc (Vector Int8))
        newConstr = A.generate (A.shape attr) genUpConstrMat
        genUpConstrMat :: Exp DIM2 -> Exp Double
        genUpConstrMat ix =
            let
                (Z:.idAttr:.col) = A.unlift ix :: ((:.) ((:.) Z (Exp Int)) (Exp Int))
            in case col of
                    0 -> A.min (attr!(A.index2 (A.the node) idAttr)) (minmax!(A.index2 idAttr 0))
                    1 -> A.max (attr!(A.index2 (A.the node) idAttr)) (minmax!(A.index2 idAttr 1))
        testUpDist :: Exp Int -> Exp Double -> Exp Int8
        testUpDist ix d =
            let
                dIx = A.index1 ix
            in fulfill!dIx ==* 1 &&* abs d <* maxDist!dIx ? (1, 0)
    in A.lift (newConstr, (A.fold1 ((-):: Exp Double -> Exp Double -> Exp Double)
            >-> A.zipWith testUpDist (A.enumFromN (A.index1 nAttr) 0)) newConstr)

expand :: Acc (MultiGraph Int8)-> Acc Adj -> Acc Attr -> Acc (MultiGraph Int8)
expand g a att = undefined

-- constraint gets a Graph and an Attribute-Matrix and yields true, if the Graph still fulfills
-- all constraints defined via the Attribute-Matrix.
--constraint :: Acc Graph -> Acc Attr -> Acc (Scalar Bool)
constraint :: Acc Graph -> Int -> Acc Attr -> Acc (Maybe Graph)
constraint g newNode a = undefined


-- addPoint gets a graph and a tuple of an adjecancy-Vector with an int wich column of the
-- Adjacency-Matrix the Vector should represent to generate further Graphs
addPoint :: Acc Graph -> Acc (Adj, (Scalar Int)) -> Acc (MultiGraph Int8)
addPoint g a = undefined


-- addablePoints yields all valid addititons to a Graph
addablePoints :: Acc Adj -> Acc Graph-> Acc (Vector Int8)
addablePoints a g = undefined