Drezil/hgraph
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

added debug, made createGraph more generic, changed Int8 to Int16 for testing

Browse Source
This commit is contained in:
Nicole Dresselhaus 2013-12-01 19:46:19 +01:00
parent a3228188e5
commit 07d6aca36c
2 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/DCB.hs
View File

@ -32,12 +32,12 @@ type Matrix r e = Array r DIM2 e
type Attr = Matrix A.U Double type Attr = Matrix A.U Double
-- | Adjacency-Matrix -- | Adjacency-Matrix
type Adj = Matrix A.U Int8 type Adj = Matrix A.U Int16
-- | Matrix of constraints -- | Matrix of constraints
--TODO: Haddoc! --TODO: Haddoc!
type Constraints = (Vector A.U Int8, Matrix A.U Double) 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
type MaxDivergence = Vector A.U Double type MaxDivergence = Vector A.U Double
-- | Make this special Scalar explicitly visible -- | Make this special Scalar explicitly visible
@ -135,7 +135,7 @@ constraint attr div req (_, (fulfill, constr), _) newNode =
0 -> min (f sh) (attr!sh) 0 -> min (f sh) (attr!sh)
1 -> max (f sh) (attr!sh) 1 -> max (f sh) (attr!sh)
constrNew = A.computeUnboxedS $A.traverse constr id updateConstr constrNew = A.computeUnboxedS $A.traverse constr id updateConstr
fulfillNew = A.zipWith (\i b -> if i == 1 && b then 1::Int8 else 0::Int8) fulfill fulfillNew = A.zipWith (\i b -> if i == 1 && b then 1::Int16 else 0::Int16) 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 (A.computeS fulfillNew, constrNew) else Nothing in if nrHit >= req then Just (A.computeS fulfillNew, constrNew) else Nothing

12
src/Main.hs
View File

@ -25,6 +25,7 @@ import Control.Monad.Par.Scheds.Trace
import Control.Parallel.Strategies import Control.Parallel.Strategies
import Data.Array.Repa as A hiding ((++)) import Data.Array.Repa as A hiding ((++))
import Data.Array.Repa.Repr.Unboxed import Data.Array.Repa.Repr.Unboxed
import Data.Array.Repa.Eval (Elt)
import Data.ByteString.Char8 (ByteString) import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Char8 as B
import Data.Char (isSpace) import Data.Char (isSpace)
@ -54,10 +55,10 @@ import Test.QuickCheck.All (quickCheckAll)
-- --
-- * Invalid: \\r -- * Invalid: \\r
createGraph :: T.Text -> Either [Int8] T.Text createGraph :: (Elt a, Integral a) => T.Text -> Either [a] T.Text
createGraph (!input) = createGraph' input (Left []) createGraph (!input) = createGraph' input (Left [])
where where
createGraph' :: T.Text -> Either [Int8] T.Text -> Either [Int8] T.Text createGraph' :: (Elt a, Integral a) => T.Text -> Either [a] T.Text -> Either [a] T.Text
createGraph' a r createGraph' a r
| T.null a = r | T.null a = r
| otherwise = | otherwise =
@ -67,7 +68,7 @@ createGraph (!input) = createGraph' input (Left [])
_ -> Right $ T.append (T.pack "cannot parse ") a _ -> Right $ T.append (T.pack "cannot parse ") a
-- call recursion as last resort -> ensure not much happens on the heap -- call recursion as last resort -> ensure not much happens on the heap
where where
createGraph'' :: Int8 -> T.Text -> Either [Int8] T.Text -> Either [Int8] T.Text createGraph'' :: (Elt a, Integral a) => a -> T.Text -> Either [a] T.Text -> Either [a] T.Text
createGraph'' x cs r = createGraph'' x cs r =
case createGraph' cs r of case createGraph' cs r of
Left xs -> Left (x:xs) Left xs -> Left (x:xs)
@ -111,7 +112,9 @@ emptyLine a
-- TODO: implement calculation -- TODO: implement calculation
--doCalculation :: Matrix Int -> B.ByteString --doCalculation :: Matrix Int -> B.ByteString
doCalculation adj attr = createOutput $ fst $ preprocess adj attr testDensity testDivergence testReq doCalculation adj attr =
let (adj_, graph_) = preprocess adj attr testDensity testDivergence testReq in
createOutput $ trace ("After: "++ show (sumAllS adj_)++"\n") adj_
-- | creates a default-formatted output with \",\" in between elements -- | creates a default-formatted output with \",\" in between elements
-- and \"\\n\" in between dimensions -- and \"\\n\" in between dimensions
@ -235,4 +238,5 @@ main = do
----- CALCULATE & OUTPUT ----- CALCULATE & OUTPUT
debug $ "Before: " ++ show (sumAllS graph)
B.putStr $ doCalculation graph attr B.putStr $ doCalculation graph attr