Wrote Output for Graph-Structure
This commit is contained in:
parent
b761b7a26b
commit
820c9f13d0
@ -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
|
||||
ghc-options: -threaded -rtsopts -eventlog
|
||||
other-modules: Util
|
||||
|
||||
65
src/Main.hs
65
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.
|
||||
--
|
||||
|
||||
Loading…
Reference in New Issue
Block a user