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

Wrote Output for Graph-Structure

Browse Source
This commit is contained in:
Stefan Dresselhaus
2013-12-02 21:47:33 +01:00
parent b761b7a26b
commit 820c9f13d0
2 changed files with 54 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

65
src/Main.hs
View File

@@ -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.
--