added debug, made createGraph more generic, changed Int8 to Int16 for testing
This commit is contained in:
parent
a3228188e5
commit
07d6aca36c
@ -32,12 +32,12 @@ type Matrix r e = Array r DIM2 e
|
||||
|
||||
type Attr = Matrix A.U Double
|
||||
-- | Adjacency-Matrix
|
||||
type Adj = Matrix A.U Int8
|
||||
type Adj = Matrix A.U Int16
|
||||
|
||||
-- | Matrix of constraints
|
||||
|
||||
--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
|
||||
type MaxDivergence = Vector A.U Double
|
||||
-- | Make this special Scalar explicitly visible
|
||||
@ -135,7 +135,7 @@ constraint attr div req (_, (fulfill, constr), _) newNode =
|
||||
0 -> min (f sh) (attr!sh)
|
||||
1 -> max (f sh) (attr!sh)
|
||||
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
|
||||
nrHit = A.foldAllS (+) (0::Int) $A.map fromIntegral fulfillNew
|
||||
in if nrHit >= req then Just (A.computeS fulfillNew, constrNew) else Nothing
|
||||
|
12
src/Main.hs
12
src/Main.hs
@ -25,6 +25,7 @@ import Control.Monad.Par.Scheds.Trace
|
||||
import Control.Parallel.Strategies
|
||||
import Data.Array.Repa as A hiding ((++))
|
||||
import Data.Array.Repa.Repr.Unboxed
|
||||
import Data.Array.Repa.Eval (Elt)
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.Char (isSpace)
|
||||
@ -54,10 +55,10 @@ import Test.QuickCheck.All (quickCheckAll)
|
||||
--
|
||||
-- * 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 [])
|
||||
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
|
||||
| T.null a = r
|
||||
| otherwise =
|
||||
@ -67,7 +68,7 @@ createGraph (!input) = createGraph' input (Left [])
|
||||
_ -> Right $ T.append (T.pack "cannot parse ") a
|
||||
-- call recursion as last resort -> ensure not much happens on the heap
|
||||
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 =
|
||||
case createGraph' cs r of
|
||||
Left xs -> Left (x:xs)
|
||||
@ -111,7 +112,9 @@ emptyLine a
|
||||
|
||||
-- TODO: implement calculation
|
||||
--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
|
||||
-- and \"\\n\" in between dimensions
|
||||
@ -235,4 +238,5 @@ main = do
|
||||
|
||||
----- CALCULATE & OUTPUT
|
||||
|
||||
debug $ "Before: " ++ show (sumAllS graph)
|
||||
B.putStr $ doCalculation graph attr
|
||||
|
Loading…
Reference in New Issue
Block a user