diff --git a/hgraph.cabal b/hgraph.cabal index c9f0ad6..a289d57 100644 --- a/hgraph.cabal +++ b/hgraph.cabal @@ -25,7 +25,9 @@ executable hgraph main-is: Main.hs buildable: True hs-source-dirs: src - other-modules: DCB + other-modules: + DCB, + Util ghc-options: -eventlog -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3 extensions: BangPatterns, @@ -40,4 +42,5 @@ test-suite test-hgraph buildable: True cpp-options: -DMAIN_FUNCTION=testMain hs-source-dirs: src - ghc-options: -threaded -rtsopts -eventlog \ No newline at end of file + ghc-options: -threaded -rtsopts -eventlog + other-modules: Util diff --git a/src/Main.hs b/src/Main.hs index 67dd3bf..4992246 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,6 +1,7 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DoAndIfThenElse #-} -{-# LANGUAGE TemplateHaskell, BangPatterns #-} +{-# LANGUAGE TemplateHaskell #-} ----------------------------------------------------------------------------- -- -- Module : Main @@ -18,24 +19,27 @@ module Main where import DCB +import Util import Control.DeepSeq import Control.Monad (unless) 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.Array.Repa.Repr.Unboxed +import Data.Array.Repa.Repr.Vector import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Char (isSpace) import Data.Either (lefts, rights) import Data.Functor.Identity +import Data.Int import qualified Data.List as L import qualified Data.Stream as S import qualified Data.Text as T import Data.Text.Encoding -import Data.Int +import qualified Data.Vector.Unboxed as V import Debug.Trace import System.Environment import System.Exit (exitFailure, exitSuccess) @@ -114,33 +118,62 @@ emptyLine a --doCalculation :: Matrix Int -> B.ByteString doCalculation adj attr = let (adj_, graph_) = preprocess adj attr testDensity testDivergence testReq in - createOutput $ trace ("After: "++ show (sumAllS adj_)++"\n") adj_ + B.concat $ + [ + outputArray $ trace ("After: "++ show (sumAllS adj_)++"\n") adj_, + outputGraph graph_ + ] -- | creates a default-formatted output with \",\" in between elements -- and \"\\n\" in between dimensions -- --- calls '_createOutput' with preset properties -createOutput :: (Unbox a, Show a) => Array U DIM2 a -> B.ByteString -createOutput a = _createOutput a "," "\n" +-- calls '_outputArray' with preset properties +outputArray :: (Unbox a, Show a) => Array U DIM2 a -> B.ByteString +outputArray a = _outputArray a "\t" "\n" -- | creates a formatted output from a DIM2 repa-Array -- -- * First String is the between-element-separator -- -- * Second String is the between-dimensions-separator -_createOutput :: (Unbox a, Show a) => Array U DIM2 a -> String -> String -> B.ByteString -_createOutput a itt lt = B.concat $ - (B.pack $ "Matrix "++(show $ listOfShape $ extent a)++ "\n\n") - : (L.map B.pack (_createOutput' (extent a) a itt lt)) +_outputArray :: (Unbox a, Show a) => Array U DIM2 a -> String -> String -> B.ByteString +_outputArray a itt lt = B.concat $ + (B.pack $ "Matrix "++(show $ listOfShape $ extent a)++ "\n") + : (L.map B.pack (_outputArray' (extent a) a itt lt)) where - _createOutput' :: (Unbox a, Show a) => DIM2 -> Array U DIM2 a -> String -> String -> [String] - _createOutput' shape@(Z :. si :. sj) a itt lt = [(_createOutput'' shape i 0 a itt) ++ lt | i <- [0..(si - 1)]] + _outputArray' :: (Unbox a, Show a) => DIM2 -> Array U DIM2 a -> String -> String -> [String] + _outputArray' shape@(Z :. si :. sj) a itt lt = [(_outputArray'' shape i 0 a itt) ++ lt | i <- [0..(si - 1)]] - _createOutput'' :: (Unbox a, Show a) => DIM2 -> Int -> Int -> Array U DIM2 a -> String -> String - _createOutput'' shape@(Z :. si :. sj) i j a itt + _outputArray'' :: (Unbox a, Show a) => DIM2 -> Int -> Int -> Array U DIM2 a -> String -> String + _outputArray'' shape@(Z :. si :. sj) i j a itt | sj-1 == j = show (a!(ix2 i j)) -- no "," for last one.. - | otherwise = show (a!(ix2 i j)) ++ itt ++ (_createOutput'' shape i (j+1) a itt) + | otherwise = show (a!(ix2 i j)) ++ itt ++ (_outputArray'' shape i (j+1) a itt) +outputGraph :: [Graph] -> B.ByteString +outputGraph gs = B.concat $ L.map (flipto3 _outputGraph "," "\n") gs + +|| (parBuffer 25 rseq) --run parallel + +_outputGraph :: Graph -> String -> String -> B.ByteString +_outputGraph (indices, (constdim, constmat), dens) itt lt = + let + plt = B.pack lt + pitt = B.pack itt + in + B.concat $ + [ + (B.pack $ "Density: " ++ lt ++ show dens), + plt, + (B.pack $ "Indices used:" ++ lt ++ V.foldl (appendS itt) "" (toUnboxed indices)), + plt, + (B.pack $ "Attribute-Dimensions satisfied:" ++ lt ++ V.foldl (appendS itt) "" (toUnboxed constdim)), + plt, + outputArray $ computeS $ transpose constmat, + plt, + plt + ] + +appendS :: (Show a) => String -> String -> a -> String +appendS sep a b = (a ++ show b) ++ sep -- | gets the length of the Left a. --