Haddock in DCB, unnötiges Argument in 'preprocess' entfern (density) und Haddock in Utils korrigiert
This commit is contained in:
		
							
								
								
									
										86
									
								
								src/DCB.hs
									
									
									
									
									
								
							
							
						
						
									
										86
									
								
								src/DCB.hs
									
									
									
									
									
								
							@@ -30,24 +30,31 @@ import           Data.Int
 | 
			
		||||
import qualified Data.Vector.Unboxed   as V
 | 
			
		||||
import           Debug.Trace
 | 
			
		||||
 | 
			
		||||
-- | a one-dimensional array
 | 
			
		||||
type Vector r e = Array r DIM1 e
 | 
			
		||||
-- | a two-dimensional array
 | 
			
		||||
type Matrix r e = Array r DIM2 e
 | 
			
		||||
 | 
			
		||||
-- | A 'Matrix' of attribute values assigned to a graph’s nodes.
 | 
			
		||||
--   Each row contains the corresponding node’s attribute values.
 | 
			
		||||
type Attr  = Matrix A.U Double
 | 
			
		||||
-- | Adjacency-Matrix
 | 
			
		||||
type Adj   = Matrix A.U Int16
 | 
			
		||||
 | 
			
		||||
-- | Matrix of constraints
 | 
			
		||||
 | 
			
		||||
--TODO: Haddoc!
 | 
			
		||||
-- | Matrix storing the extent of a 'Graph'’s constraints fulfillment.
 | 
			
		||||
--   It stores the minimum (zeroth column) and maximum (first column) value of all
 | 
			
		||||
--   the 'Graph'’s nodes per attribute.
 | 
			
		||||
--   The 'Vector' stores values of @1@ if the bounds are within the allowed range
 | 
			
		||||
--   ragarding the corresponding attribute, or @0@ if not.
 | 
			
		||||
type Constraints = (Vector A.U Int16, Matrix A.U Double)
 | 
			
		||||
-- | A vector of weights indicating how much divergence is allowed in which dimension
 | 
			
		||||
-- | A 'Vector' of weights indicating how much divergence is allowed in which dimension.
 | 
			
		||||
--   Each dimension represents an attribute.
 | 
			
		||||
type MaxDivergence = Vector A.U Double
 | 
			
		||||
-- | Make this special Scalar explicitly visible
 | 
			
		||||
-- | A graph’s density.
 | 
			
		||||
type Density = Double
 | 
			
		||||
 | 
			
		||||
-- | consists of a Vector denoting which columns of the matrix represents which originating
 | 
			
		||||
--   column in the global adjancency-matrix, a matrix of constraints and a scalar denoting the density
 | 
			
		||||
-- | consists of a 'Vector' denoting which columns of the 'Matrix' represents which originating
 | 
			
		||||
--   column in the global adjancency-matrix, a 'Matrix' of 'Constraints' and a scalar denoting the graph’s 'Density'
 | 
			
		||||
type Graph = (Vector A.U Int, Constraints, Density)
 | 
			
		||||
 | 
			
		||||
instance Ord Graph where
 | 
			
		||||
@@ -84,10 +91,17 @@ testReq = 3 ::Int
 | 
			
		||||
expand :: Adj -> Attr -> Graph ->  [Graph]
 | 
			
		||||
expand adj attr g = undefined -- addablePoints -> for each: addPoint -> filterLayer
 | 
			
		||||
 | 
			
		||||
--TODO: Haddoc!
 | 
			
		||||
--Was macht der Int?
 | 
			
		||||
preprocess :: Adj -> Attr -> Density -> MaxDivergence -> Int -> (Adj, [Graph])
 | 
			
		||||
preprocess adj attr d div req =
 | 
			
		||||
-- | Creates an adjacency matrix from the given adjacency matrix where all
 | 
			
		||||
--   edges are removed whose belonging nodes cannot fulfill the passed constraints.
 | 
			
		||||
--   Additionally, all pairs of connected nodes that satisfy the constraints are
 | 
			
		||||
--   returned as a 'Graph'.
 | 
			
		||||
preprocess :: Adj           -- ^ original adjacency matrix
 | 
			
		||||
           -> Attr          -- ^ table of the node’s attributes
 | 
			
		||||
	       -> MaxDivergence -- ^  maximum allowed ranges of the node’s attribute
 | 
			
		||||
	                        --   values to be considered as consistent
 | 
			
		||||
	       -> Int           -- ^ required number of consistent attributes
 | 
			
		||||
	       -> (Adj, [Graph])
 | 
			
		||||
preprocess adj attr div req =
 | 
			
		||||
    let
 | 
			
		||||
        (Z:.nNodes:._) = A.extent adj
 | 
			
		||||
        results = map (initGraph attr div req) [(i, j) | i <- [0..(nNodes-1)], j <- [(i+1)..(nNodes-1)], adj!(ix2 i j) /= 0]
 | 
			
		||||
@@ -98,9 +112,13 @@ preprocess adj attr d div req =
 | 
			
		||||
        adj' = A.computeS $A.fromFunction (A.extent adj) (\sh -> if mask!sh then 0 else adj!sh)
 | 
			
		||||
    in (adj', finalGraphs)
 | 
			
		||||
 | 
			
		||||
-- | initializes a seed graph if it fulfills the constraints
 | 
			
		||||
--   assumption: given nodes i, j are connected
 | 
			
		||||
initGraph :: Attr -> MaxDivergence -> Int -> (Int, Int) -> Either Graph (Int, Int)
 | 
			
		||||
-- | Initializes a seed 'Graph' if it fulfills the constraints, returns the input nodes
 | 
			
		||||
--   otherwise. It is assumed that the given nodes are connected.
 | 
			
		||||
initGraph :: Attr                    -- ^ table of all node’s attributes
 | 
			
		||||
          -> MaxDivergence
 | 
			
		||||
          -> Int                     -- ^ required number of consistent attributes
 | 
			
		||||
          -> (Int, Int)              -- ^ nodes to create a seed 'Graph' of
 | 
			
		||||
          -> Either Graph (Int, Int)
 | 
			
		||||
initGraph attr div req (i, j) =
 | 
			
		||||
    let
 | 
			
		||||
       constr = constraintInit attr div req i j
 | 
			
		||||
@@ -108,8 +126,12 @@ initGraph attr div req (i, j) =
 | 
			
		||||
            Nothing -> Right (i, j)
 | 
			
		||||
            Just c  -> Left (A.fromListUnboxed (ix1 2) [i,j], c, 1)
 | 
			
		||||
 | 
			
		||||
-- | checks constraints of an initializing seed
 | 
			
		||||
constraintInit :: Attr -> MaxDivergence -> Int -> Int -> Int -> Maybe Constraints
 | 
			
		||||
-- | checks constraints of an initializing seed and creates 'Constraints' matrix if the
 | 
			
		||||
--   check is positive
 | 
			
		||||
constraintInit :: Attr -> MaxDivergence -> Int -- ^ required number of consistent attributes
 | 
			
		||||
               -> Int -- ^ first node to test
 | 
			
		||||
               -> Int -- ^ second node to test first node against
 | 
			
		||||
               -> Maybe Constraints
 | 
			
		||||
constraintInit attr div req i j =
 | 
			
		||||
    let
 | 
			
		||||
        (Z:._:.nAttr) = A.extent attr
 | 
			
		||||
@@ -129,9 +151,13 @@ constraintInit attr div req i j =
 | 
			
		||||
filterLayer :: Vector A.U Graph -> Vector A.U Graph
 | 
			
		||||
filterLayer gs = undefined -- TODO
 | 
			
		||||
 | 
			
		||||
-- | gets a Graph and an Attribute-Matrix and yields true, if the Graph still fulfills
 | 
			
		||||
--   all constraints defined via the Attribute-Matrix.
 | 
			
		||||
constraint :: Attr -> MaxDivergence -> Int -> Graph -> Int -> Maybe Constraints
 | 
			
		||||
-- | Checks whether a given base 'Graph' can be extended by a single node and
 | 
			
		||||
--   the resulting 'Graph' still satisfies the given attribute constraints.
 | 
			
		||||
--   In case of a successful expansion the updated 'Constraints' matrix is returned.
 | 
			
		||||
constraint :: Attr -> MaxDivergence -> Int -- ^ required number of consistent attributes
 | 
			
		||||
           -> Graph -- ^ base graph
 | 
			
		||||
           -> Int   -- ^ node to extend base graph by
 | 
			
		||||
           -> Maybe Constraints
 | 
			
		||||
constraint attr div req (_, (fulfill, constr), _) newNode =
 | 
			
		||||
    let
 | 
			
		||||
        updateConstr :: (DIM2 -> Double) -> DIM2 -> Double
 | 
			
		||||
@@ -145,8 +171,12 @@ constraint attr div req (_, (fulfill, constr), _) newNode =
 | 
			
		||||
        nrHit = A.foldAllS (+) (0::Int) $A.map fromIntegral fulfillNew
 | 
			
		||||
    in if nrHit >= req then Just (A.computeS fulfillNew, constrNew) else Nothing
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
updateDensity :: Adj -> Vector A.U Int -> Int -> Density -> Density
 | 
			
		||||
-- updates the density of a graph extended by a single node
 | 
			
		||||
updateDensity :: Adj            -- ^ global adjacency matrix of all nodes
 | 
			
		||||
              -> Vector A.U Int -- ^ nodes of the base graph
 | 
			
		||||
              -> Int            -- ^ node to extend the graph by
 | 
			
		||||
              -> Density        -- ^ current density of base graph
 | 
			
		||||
              -> Density        -- ^ new density of expanded graph
 | 
			
		||||
updateDensity adj nodes newNode dens =
 | 
			
		||||
    let
 | 
			
		||||
        neighbours = A.foldAllS (+) (0::Int)
 | 
			
		||||
@@ -155,9 +185,17 @@ updateDensity adj nodes newNode dens =
 | 
			
		||||
        n = fromIntegral n'
 | 
			
		||||
    in (dens * (n*(n+1)) / 2 + fromIntegral neighbours) * 2 / ((n+1)*(n+2))
 | 
			
		||||
 | 
			
		||||
-- | 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 :: Adj -> Attr -> Density -> MaxDivergence -> Int -> Graph -> Int -> Maybe Graph
 | 
			
		||||
 | 
			
		||||
-- | Checks a 'Graph' expansion with a single node regarding both the attribute constraints
 | 
			
		||||
--   and a minimum density. If it passes the test the extended graph is returned.
 | 
			
		||||
addPoint :: Adj           -- ^ global adjacency matrix of all nodes
 | 
			
		||||
         -> Attr          -- ^ global attribute matrix
 | 
			
		||||
         -> Density       -- ^ required minimum graph’s density
 | 
			
		||||
         -> MaxDivergence -- ^ allowed divergence per attribute
 | 
			
		||||
         -> Int           -- ^ equired number of consistent attributes
 | 
			
		||||
         -> Graph         -- ^ base graph
 | 
			
		||||
         -> Int           -- ^ node to extend base graph by
 | 
			
		||||
         -> Maybe Graph
 | 
			
		||||
addPoint adj attr d div req g@(nodes, _, dens) n =
 | 
			
		||||
    let
 | 
			
		||||
        constr = constraint attr div req g n
 | 
			
		||||
 
 | 
			
		||||
@@ -117,7 +117,7 @@ emptyLine a
 | 
			
		||||
-- TODO: implement calculation
 | 
			
		||||
--doCalculation :: Matrix Int -> B.ByteString
 | 
			
		||||
doCalculation adj attr =
 | 
			
		||||
        let (adj_, graph_) = preprocess adj attr 0.8 (A.fromListUnboxed (ix1 3) [0.5,0.5,0.5]) 2 in
 | 
			
		||||
        let (adj_, graph_) = preprocess adj attr {--0.8--} (A.fromListUnboxed (ix1 3) [0.5,0.5,0.5]) 2 in
 | 
			
		||||
                B.concat $
 | 
			
		||||
                        [
 | 
			
		||||
                                outputArray $ trace ("After: "++ show (sumAllS adj_)++"\n") adj_,
 | 
			
		||||
 
 | 
			
		||||
							
								
								
									
										16
									
								
								src/Util.hs
									
									
									
									
									
								
							
							
						
						
									
										16
									
								
								src/Util.hs
									
									
									
									
									
								
							@@ -21,34 +21,34 @@ flip4 f d a b c = f a b c d
 | 
			
		||||
flipto1 :: (a -> b) -> (a -> b)
 | 
			
		||||
flipto1 = id
 | 
			
		||||
 | 
			
		||||
-- | Move second argument to last place ('flip' synonym for style uniformity)
 | 
			
		||||
-- | Move first argument to last (second) place ('flip' synonym for style uniformity)
 | 
			
		||||
flipto2 :: (a -> b -> c) -> (b -> a -> c)
 | 
			
		||||
flipto2 = flip
 | 
			
		||||
 | 
			
		||||
-- | Move third argument to last place
 | 
			
		||||
-- | Move first argument to last (third) place
 | 
			
		||||
flipto3 :: (a -> b -> c -> d) -> b -> c -> a -> d
 | 
			
		||||
flipto3 fun b c a = fun a b c 
 | 
			
		||||
 | 
			
		||||
-- | Move forth argument to last place
 | 
			
		||||
-- | Move first argument to last (forth) place
 | 
			
		||||
flipto4 :: (a -> b -> c -> d -> e) -> b -> c -> d -> a -> e
 | 
			
		||||
flipto4 fun b c d a = fun a b c d 
 | 
			
		||||
 | 
			
		||||
-- | Move fifth argument to last place
 | 
			
		||||
-- | Move first argument to last (fifth) place
 | 
			
		||||
flipto5 :: (a -> b -> c -> d -> e -> f) -> b -> c -> d -> e -> a -> f
 | 
			
		||||
flipto5 fun b c d e a = fun a b c d e 
 | 
			
		||||
 | 
			
		||||
-- | Move sixth argument to last place
 | 
			
		||||
-- | Move first argument to last (sixth) place
 | 
			
		||||
flipto6 :: (a -> b -> c -> d -> e -> f -> g) -> b -> c -> d -> e -> f-> a -> g
 | 
			
		||||
flipto6 fun b c d e f a = fun a b c d e f
 | 
			
		||||
 | 
			
		||||
-- | Move seventh argument to last place
 | 
			
		||||
-- | Move first argument to last (seventh) place
 | 
			
		||||
flipto7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> b -> c -> d -> e -> f -> g -> a -> h
 | 
			
		||||
flipto7 fun b c d e f g a = fun a b c d e f g
 | 
			
		||||
 | 
			
		||||
-- | Move eights argument to last place
 | 
			
		||||
-- | Move first argument to last (eights) place
 | 
			
		||||
flipto8 :: (a -> b -> c -> d -> e -> f -> g -> h -> i) -> b -> c -> d -> e -> f -> g -> h -> a -> i
 | 
			
		||||
flipto8 fun b c d e f g h a = fun a b c d e f g h
 | 
			
		||||
 | 
			
		||||
-- | Move ninth argument to last place
 | 
			
		||||
-- | Move first argument to last (ninth) place
 | 
			
		||||
flipto9 :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> b -> c -> d -> e -> f -> g -> h -> i -> a -> j
 | 
			
		||||
flipto9 fun b c d e f g h i a = fun a b c d e f g h i
 | 
			
		||||
 
 | 
			
		||||
		Reference in New Issue
	
	Block a user