From 410c717abe24484080ce62c3c8368b5fe026228b Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Fri, 29 Nov 2013 18:46:49 +0100 Subject: [PATCH] multiple changes - modified main-loop - changed error-handling - all read arrays are now repa-arrays - modified & tested output to print generic DIM2-repa-arrays in our format --- dist/build/autogen/Paths_hgraph.hs | 32 -------- dist/build/autogen/cabal_macros.h | 79 ------------------- hgraph.cabal | 17 +++- src/Main.hs | 122 ++++++++++++++++------------- 4 files changed, 83 insertions(+), 167 deletions(-) delete mode 100644 dist/build/autogen/Paths_hgraph.hs delete mode 100644 dist/build/autogen/cabal_macros.h diff --git a/dist/build/autogen/Paths_hgraph.hs b/dist/build/autogen/Paths_hgraph.hs deleted file mode 100644 index 1e48b9f..0000000 --- a/dist/build/autogen/Paths_hgraph.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Paths_hgraph ( - version, - getBinDir, getLibDir, getDataDir, getLibexecDir, - getDataFileName - ) where - -import qualified Control.Exception as Exception -import Data.Version (Version(..)) -import System.Environment (getEnv) -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -catchIO = Exception.catch - - -version :: Version -version = Version {versionBranch = [0,0,1], versionTags = []} -bindir, libdir, datadir, libexecdir :: FilePath - -bindir = "/home/thomas/.cabal/bin" -libdir = "/home/thomas/.cabal/lib/hgraph-0.0.1/ghc-7.4.1" -datadir = "/home/thomas/.cabal/share/hgraph-0.0.1" -libexecdir = "/home/thomas/.cabal/libexec" - -getBinDir, getLibDir, getDataDir, getLibexecDir :: IO FilePath -getBinDir = catchIO (getEnv "hgraph_bindir") (\_ -> return bindir) -getLibDir = catchIO (getEnv "hgraph_libdir") (\_ -> return libdir) -getDataDir = catchIO (getEnv "hgraph_datadir") (\_ -> return datadir) -getLibexecDir = catchIO (getEnv "hgraph_libexecdir") (\_ -> return libexecdir) - -getDataFileName :: FilePath -> IO FilePath -getDataFileName name = do - dir <- getDataDir - return (dir ++ "/" ++ name) diff --git a/dist/build/autogen/cabal_macros.h b/dist/build/autogen/cabal_macros.h deleted file mode 100644 index 3680a76..0000000 --- a/dist/build/autogen/cabal_macros.h +++ /dev/null @@ -1,79 +0,0 @@ -/* DO NOT EDIT: This file is automatically generated by Cabal */ - -/* package QuickCheck-2.4.2 */ -#define VERSION_QuickCheck "2.4.2" -#define MIN_VERSION_QuickCheck(major1,major2,minor) (\ - (major1) < 2 || \ - (major1) == 2 && (major2) < 4 || \ - (major1) == 2 && (major2) == 4 && (minor) <= 2) - -/* package Stream-0.4.6.1 */ -#define VERSION_Stream "0.4.6.1" -#define MIN_VERSION_Stream(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 4 || \ - (major1) == 0 && (major2) == 4 && (minor) <= 6) - -/* package accelerate-0.13.0.5 */ -#define VERSION_accelerate "0.13.0.5" -#define MIN_VERSION_accelerate(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 13 || \ - (major1) == 0 && (major2) == 13 && (minor) <= 0) - -/* package base-4.5.0.0 */ -#define VERSION_base "4.5.0.0" -#define MIN_VERSION_base(major1,major2,minor) (\ - (major1) < 4 || \ - (major1) == 4 && (major2) < 5 || \ - (major1) == 4 && (major2) == 5 && (minor) <= 0) - -/* package bytestring-0.9.2.1 */ -#define VERSION_bytestring "0.9.2.1" -#define MIN_VERSION_bytestring(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 9 || \ - (major1) == 0 && (major2) == 9 && (minor) <= 2) - -/* package deepseq-1.3.0.0 */ -#define VERSION_deepseq "1.3.0.0" -#define MIN_VERSION_deepseq(major1,major2,minor) (\ - (major1) < 1 || \ - (major1) == 1 && (major2) < 3 || \ - (major1) == 1 && (major2) == 3 && (minor) <= 0) - -/* package ghc-7.4.1 */ -#define VERSION_ghc "7.4.1" -#define MIN_VERSION_ghc(major1,major2,minor) (\ - (major1) < 7 || \ - (major1) == 7 && (major2) < 4 || \ - (major1) == 7 && (major2) == 4 && (minor) <= 1) - -/* package monad-par-0.3.4.5 */ -#define VERSION_monad_par "0.3.4.5" -#define MIN_VERSION_monad_par(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 3 || \ - (major1) == 0 && (major2) == 3 && (minor) <= 4) - -/* package parallel-3.2.0.4 */ -#define VERSION_parallel "3.2.0.4" -#define MIN_VERSION_parallel(major1,major2,minor) (\ - (major1) < 3 || \ - (major1) == 3 && (major2) < 2 || \ - (major1) == 3 && (major2) == 2 && (minor) <= 0) - -/* package repa-3.2.1.1 */ -#define VERSION_repa "3.2.1.1" -#define MIN_VERSION_repa(major1,major2,minor) (\ - (major1) < 3 || \ - (major1) == 3 && (major2) < 2 || \ - (major1) == 3 && (major2) == 2 && (minor) <= 1) - -/* package text-0.11.3.1 */ -#define VERSION_text "0.11.3.1" -#define MIN_VERSION_text(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 11 || \ - (major1) == 0 && (major2) == 11 && (minor) <= 3) - diff --git a/hgraph.cabal b/hgraph.cabal index 0ce3de8..f0073b2 100644 --- a/hgraph.cabal +++ b/hgraph.cabal @@ -8,14 +8,25 @@ description: data-dir: "" executable hgraph - build-depends: QuickCheck -any, Stream -any, accelerate -any, - base -any, bytestring -any, deepseq -any, ghc -any, - monad-par >=0.3.4, parallel -any, repa >=3.2, text -any + build-depends: + QuickCheck -any, + Stream -any, + accelerate -any, + base -any, + bytestring -any, + deepseq -any, + ghc -any, + monad-par >=0.3.4, + parallel -any, + repa >=3.2, + text -any, + transformers >=0.3.0 main-is: Main.hs buildable: True hs-source-dirs: src other-modules: DCB DCB ghc-options: -threaded -rtsopts -eventlog + extensions: DoAndIfThenElse test-suite test-hgraph build-depends: QuickCheck -any, Stream -any, accelerate -any, diff --git a/src/Main.hs b/src/Main.hs index ebb519b..5807c5b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE CPP, TemplateHaskell #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} ----------------------------------------------------------------------------- -- -- Module : Main @@ -17,23 +18,26 @@ module Main ( main ) where -import DCB +import DCB -import Control.Monad (unless) -import Control.Parallel.Strategies -import Control.DeepSeq -import qualified Data.List as L -import System.Exit (exitFailure) -import System.Environment -import Test.QuickCheck.All (quickCheckAll) -import qualified Data.ByteString.Char8 as B -import Data.ByteString.Char8 (ByteString) -import Control.Monad.Par.Scheds.Trace -import qualified Data.Stream as S -import Data.Either (lefts, rights) -import Debug.Trace -import qualified Data.Text as T -import Data.Text.Encoding +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.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B +import Data.Either (lefts, rights) +import qualified Data.List as L +import qualified Data.Stream as S +import qualified Data.Text as T +import Data.Text.Encoding +import Debug.Trace +import System.Environment +import System.Exit (exitFailure) +import Test.QuickCheck.All (quickCheckAll) +import Data.Functor.Identity -- TODO: Give createGraph a presized Array and no dynamic [Int]. @@ -59,9 +63,10 @@ createAttr :: T.Text -> Either [Double] T.Text createAttr input = createAttr' (T.split (=='\t') input) (Left []) where createAttr' :: [T.Text] -> Either [Double] T.Text -> Either [Double] T.Text + createAttr' [] r = r createAttr' (a:as) r = let this = read (T.unpack a) :: Double in - (if isNaN this then + (if isNaN this then Right $ T.append (T.pack "cannot parse ") a else (let next = (createAttr' as r) in @@ -80,22 +85,33 @@ emptyLog a = False --emptyLine $ foldl True (&&) (map emptyLine a) -- TODO: implement calculation --doCalculation :: Matrix Int -> B.ByteString -doCalculation a = B.pack $ ""--(show a) ++ "\n" +doCalculation graph attr = createOutput graph -createOutput :: [[Int]] -> B.ByteString -createOutput a = encodeUtf8 (createOutput' a) +createOutput :: (Unbox a, Show a) => Array U DIM2 a -> B.ByteString +createOutput a = B.concat $ L.map B.pack (createOutput' (extent a) a) -createOutput' :: [[Int]] -> T.Text -createOutput' [a] = T.intercalate (T.singleton ',') (L.map (T.pack . show) a) +createOutput' :: (Unbox a, Show a) => DIM2 -> Array U DIM2 a -> [String] +createOutput' shape@(Z :. si :. sj) a = [(createOutput'' shape i 0 a) ++ "\n" | i <- [0..(si - 1)]] + +createOutput'' :: (Unbox a, Show a) => DIM2 -> Int -> Int -> Array U DIM2 a -> String +createOutput'' shape@(Z :. si :. sj) i j a + | sj-1 == j = show (a!(ix2 i j)) -- no "," for last one.. + | otherwise = show (a!(ix2 i j)) ++ "," ++ (createOutput'' shape i (j+1) a) + +{- +T.intercalate (T.singleton ',') (L.map (T.pack . show) a) createOutput' (a:as) = T.append (T.append (T.intercalate (T.singleton ',') (L.map (T.pack . show) a)) (T.singleton '\n')) (createOutput' as) +-} --- preprocess :: +getAttrLength :: Either [Double] T.Text -> Int +getAttrLength (Left a) = length a +getAttrLength (Right _) = 0 showHelp = undefined @@ -104,6 +120,13 @@ infixl 1 +|| (+||) :: a -> Strategy a -> a a +|| b = a `using` b +checkError :: T.Text -> IO () +checkError a + | T.null a = return () + | otherwise = do + B.putStr $ encodeUtf8 $ T.append (T.append (T.pack "Error detected:\n") a) (T.pack "\n\n") + exitFailure + exeMain = do -- args <- getArgs -- input <- case args of @@ -123,38 +146,31 @@ exeMain = do -- dont copy that much lateron. Best would be Matrix Int -- unrefined_graph::[Either [Int] String] - [Int] is Adjacency-Line, String is parse-Error unrefined_graph <- return $ (L.map (createGraph) adjMat) - +|| (parBuffer 100 rdeepseq) --run parallel, evaluate fully + -- +|| (parBuffer 100 rdeepseq) --run parallel, evaluate fully unrefined_attr <- return $ (L.map (createAttr) attrMat) - +|| (parBuffer 100 rdeepseq) --run parallel, evaluate fully - --egraph <- return $ graphFolder unrefined_graph + -- +|| (parBuffer 100 rdeepseq) --run parallel, evaluate fully + attrNum <- return $ getAttrLength (head unrefined_attr) + putStrLn $ show (adjLines, attrLines, attrNum) + + ----- CHECK FOR ERRORS + -- print out any read-errors and abort + if adjLines /= attrLines then + checkError $ T.pack $ "Adjacency-Matrix size "++ show adjLines ++ + " differs from Attribute-Matrix " ++ show attrLines ++ + ".\n" + else + return () + checkError $ T.intercalate (T.singleton '\n') (rights unrefined_graph) + checkError $ T.intercalate (T.singleton '\n') (rights unrefined_attr) - (graph, log, lines) <- return $ ((L.foldl1' (++) (lefts unrefined_graph), -- concatenated graph - T.intercalate (T.singleton '\n') (rights unrefined_graph), -- concat error-log - length unrefined_graph) -- number of elements in graph - -- in parallel - `using` parTuple3 rdeepseq rdeepseq rseq) + putStrLn $ show (length (L.foldl1 (++) (lefts unrefined_graph)),length (L.foldl1 (++) (lefts unrefined_attr))) + ----- EXTRACT MATRICES + graph <- return $ A.fromListUnboxed (Z :. adjLines :. adjLines) (L.foldl1' (++) (lefts unrefined_graph)) -- concatenated graph - (attr, log, linesAttr) <- return $ ((L.foldl1' (++) (lefts unrefined_graph), -- concatenated graph - T.append log (T.intercalate (T.singleton '\n') (rights unrefined_graph)), -- concat error-log - length unrefined_graph) -- number of elements in graph - -- in parallel - `using` parTuple3 rdeepseq rdeepseq rseq) - - -- validate graph - log <- return $ let l = length graph in - if l /= lines*lines then - T.append log $ T.pack $ "Lines dont match up. Read " ++ (show l) ++ - " chars. Expected " ++ (show (lines*lines)) ++ - " chars.\n" - else if adjLines /= attrLines then - T.append log $ T.pack $ "Adjecency-Matrix size "++ (show adjLines) ++ - " differs from Attribute-Matrix " ++ (show attrLines) ++ - ".\n" - else - log - output <- return $ case emptyLine log of - True -> doCalculation $ graph --A.fromList (A.Z A.:. lines A.:. lines) graph - _ -> encodeUtf8 $ T.append (T.append (T.pack "Error detected:\n") log) (T.pack "\n\n") + attr <- return $ A.fromListUnboxed (Z :. attrLines :. attrNum) (L.foldl1' (++) (lefts unrefined_attr)) -- concatenated attr + + ----- CALCULATE + output <- return $ doCalculation graph attr B.putStr output