added some haddock
This commit is contained in:
parent
e7c73a33df
commit
887c6a8a43
@ -76,6 +76,9 @@ instance (A.Shape sh, V.Unbox e) => NFData (Array A.U sh e) where
|
|||||||
|
|
||||||
--TODO: Do we have to filter?
|
--TODO: Do we have to filter?
|
||||||
|
|
||||||
|
-- | creates a step in iteration.
|
||||||
|
-- Basically calls expand for every Graph left in our List of interesting Graphs
|
||||||
|
-- and returns the expanded ones.
|
||||||
step :: [Graph] -> Adj -> Attr -> Density -> MaxDivergence -> Int -> [Graph]
|
step :: [Graph] -> Adj -> Attr -> Density -> MaxDivergence -> Int -> [Graph]
|
||||||
step gs@((ind,_,_):_) a b c d e = traceEvent ("step from " P.++ show (A.extent ind) ) $
|
step gs@((ind,_,_):_) a b c d e = traceEvent ("step from " P.++ show (A.extent ind) ) $
|
||||||
filterLayer $ concat $ map (expand a b c d e ) gs
|
filterLayer $ concat $ map (expand a b c d e ) gs
|
||||||
@ -183,7 +186,7 @@ constraint attr div req (ind, (fulfill, constr), _) newNode =
|
|||||||
! fulfillNew = A.zipWith (\i b -> if i == 1 && b then 1::Int else 0::Int) fulfill
|
! fulfillNew = A.zipWith (\i b -> if i == 1 && b then 1::Int else 0::Int) fulfill
|
||||||
$A.zipWith (\thediv dist -> abs dist <= thediv) div $A.foldS (-) 0 constrNew
|
$A.zipWith (\thediv dist -> abs dist <= thediv) div $A.foldS (-) 0 constrNew
|
||||||
! nrHit = A.foldAllS (+) (0::Int) $A.map fromIntegral fulfillNew
|
! nrHit = A.foldAllS (+) (0::Int) $A.map fromIntegral fulfillNew
|
||||||
in if nrHit >= req then Just {-$ trace ("returning const-matrix for "P.++ show (A.toList ind) P.++"\n" P.++ (B.unpack $ outputArray constrNew))-}
|
in if nrHit >= req then Just
|
||||||
(A.computeUnboxedS fulfillNew, constrNew) else Nothing
|
(A.computeUnboxedS fulfillNew, constrNew) else Nothing
|
||||||
|
|
||||||
-- | Updates the density of a graph extended by a single node
|
-- | Updates the density of a graph extended by a single node
|
||||||
@ -196,17 +199,11 @@ updateDensity adj nodes newNode dens =
|
|||||||
let
|
let
|
||||||
neighbourSlice = A.map (\n -> fromIntegral $adj!(A.ix2 newNode n)) nodes
|
neighbourSlice = A.map (\n -> fromIntegral $adj!(A.ix2 newNode n)) nodes
|
||||||
neighbours = A.foldAllS (+) (0::Int) ({- trace (show $ A.computeUnboxedS neighbourSlice)-} neighbourSlice)
|
neighbours = A.foldAllS (+) (0::Int) ({- trace (show $ A.computeUnboxedS neighbourSlice)-} neighbourSlice)
|
||||||
|
|
||||||
{- A.traverse adj (reduceDim) (\f (Z :. i) ->
|
|
||||||
if not $ V.any (==i) $ A.toUnboxed nodes then
|
|
||||||
fromIntegral $adj!(ix2 i newNode)
|
|
||||||
else
|
|
||||||
0)-}
|
|
||||||
! (Z:.n') = A.extent nodes
|
! (Z:.n') = A.extent nodes
|
||||||
! n = fromIntegral n'
|
! n = fromIntegral n'
|
||||||
newdens = (dens * ((n)*(n-1)) / 2 + fromIntegral neighbours) * 2 / ((n+1)*(n))
|
newdens = (dens * ((n)*(n-1)) / 2 + fromIntegral neighbours) * 2 / ((n+1)*(n))
|
||||||
in newdens
|
in newdens
|
||||||
{-+ trace (
|
{- + trace (
|
||||||
(show dens) P.++ " ("P.++(show (dens * (n*(n-1)) / 2)) P.++"/"P.++ (show ((n*(n-1))/(2::Double))) P.++ ") -> "
|
(show dens) P.++ " ("P.++(show (dens * (n*(n-1)) / 2)) P.++"/"P.++ (show ((n*(n-1))/(2::Double))) P.++ ") -> "
|
||||||
P.++ (show newdens) P.++ " ("P.++(show (newdens * ((n)*(n+1)) / 2)) P.++"/"P.++ (show (((n)*(n+1))/(2::Double))) P.++ ") \n"
|
P.++ (show newdens) P.++ " ("P.++(show (newdens * ((n)*(n+1)) / 2)) P.++"/"P.++ (show (((n)*(n+1))/(2::Double))) P.++ ") \n"
|
||||||
P.++ (show newNode)
|
P.++ (show newNode)
|
||||||
@ -237,7 +234,7 @@ addPoint adj attr d div req g@(nodes, _, dens) n =
|
|||||||
Nothing -> Nothing
|
Nothing -> Nothing
|
||||||
(Just c@(ful,constr)) ->
|
(Just c@(ful,constr)) ->
|
||||||
--trace (B.unpack $ outputArray constr) $
|
--trace (B.unpack $ outputArray constr) $
|
||||||
Just {-$ trace ("submitting graph:\n================\n " P.++ (B.unpack $ outputGraph [(A.computeS $nodes ++ A.fromListUnboxed (ix1 1) [n], c, densNew)])) -}
|
Just
|
||||||
(A.computeUnboxedS $nodes ++ A.fromListUnboxed (ix1 1) [n], c, densNew)
|
(A.computeUnboxedS $nodes ++ A.fromListUnboxed (ix1 1) [n], c, densNew)
|
||||||
|
|
||||||
reduceDim :: (A.Shape sh, Integral a) => (sh :. a) -> sh
|
reduceDim :: (A.Shape sh, Integral a) => (sh :. a) -> sh
|
||||||
|
@ -40,10 +40,32 @@ _outputArray a itt lt = B.concat $
|
|||||||
| sj-1 == j = show (a!(ix2 i j)) -- no "," for last one..
|
| sj-1 == j = show (a!(ix2 i j)) -- no "," for last one..
|
||||||
| otherwise = show (a!(ix2 i j)) ++ itt ++ (_outputArray'' shape i (j+1) a itt)
|
| otherwise = show (a!(ix2 i j)) ++ itt ++ (_outputArray'' shape i (j+1) a itt)
|
||||||
|
|
||||||
|
-- | creates a default-formatted output with \",\" in between elements
|
||||||
|
-- and \"\\n\" in between dimensions
|
||||||
|
--
|
||||||
|
-- calls '_outputArray' with preset properties
|
||||||
outputGraph :: [Graph] -> B.ByteString
|
outputGraph :: [Graph] -> B.ByteString
|
||||||
outputGraph gs = B.concat $ L.map (flipto3 _outputGraph "," "\n") (L.sort gs)
|
outputGraph gs = B.concat $ L.map (flipto3 _outputGraph "," "\n") (L.sort gs)
|
||||||
+|| (parBuffer 25 rseq) --run parallel
|
+|| (parBuffer 25 rseq) --run parallel
|
||||||
|
|
||||||
|
-- | creates a formatted output from a Graph
|
||||||
|
--
|
||||||
|
-- * First String is the between-element-separator
|
||||||
|
--
|
||||||
|
-- * Second String is the between-dimensions-separator
|
||||||
|
--
|
||||||
|
-- Example Output with \",\" and \"\\n\":
|
||||||
|
--
|
||||||
|
-- > Density:
|
||||||
|
-- > 0.7619047619047619
|
||||||
|
-- > Indices used:
|
||||||
|
-- > 28,71,78,81,100,349,401,
|
||||||
|
-- > Attribute-Dimensions satisfied:
|
||||||
|
-- > 0,0,1,0,1,1,
|
||||||
|
-- > Matrix [6,2]
|
||||||
|
-- > 28.0 3.0 1.0 551.0 0.0 10.0
|
||||||
|
-- > 401.0 67.0 4.0 2524.0 5.0 19.0
|
||||||
|
--
|
||||||
_outputGraph :: Graph -> String -> String -> B.ByteString
|
_outputGraph :: Graph -> String -> String -> B.ByteString
|
||||||
_outputGraph (indices, (constdim, constmat), dens) itt lt =
|
_outputGraph (indices, (constdim, constmat), dens) itt lt =
|
||||||
let
|
let
|
||||||
|
Loading…
Reference in New Issue
Block a user