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
This commit is contained in:
parent
1bd97fbcc6
commit
410c717abe
32
dist/build/autogen/Paths_hgraph.hs
vendored
32
dist/build/autogen/Paths_hgraph.hs
vendored
@ -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)
|
|
79
dist/build/autogen/cabal_macros.h
vendored
79
dist/build/autogen/cabal_macros.h
vendored
@ -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)
|
|
||||||
|
|
17
hgraph.cabal
17
hgraph.cabal
@ -8,14 +8,25 @@ description:
|
|||||||
data-dir: ""
|
data-dir: ""
|
||||||
|
|
||||||
executable hgraph
|
executable hgraph
|
||||||
build-depends: QuickCheck -any, Stream -any, accelerate -any,
|
build-depends:
|
||||||
base -any, bytestring -any, deepseq -any, ghc -any,
|
QuickCheck -any,
|
||||||
monad-par >=0.3.4, parallel -any, repa >=3.2, text -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
|
main-is: Main.hs
|
||||||
buildable: True
|
buildable: True
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
other-modules: DCB DCB
|
other-modules: DCB DCB
|
||||||
ghc-options: -threaded -rtsopts -eventlog
|
ghc-options: -threaded -rtsopts -eventlog
|
||||||
|
extensions: DoAndIfThenElse
|
||||||
|
|
||||||
test-suite test-hgraph
|
test-suite test-hgraph
|
||||||
build-depends: QuickCheck -any, Stream -any, accelerate -any,
|
build-depends: QuickCheck -any, Stream -any, accelerate -any,
|
||||||
|
122
src/Main.hs
122
src/Main.hs
@ -1,4 +1,5 @@
|
|||||||
{-# LANGUAGE CPP, TemplateHaskell #-}
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
--
|
--
|
||||||
-- Module : Main
|
-- Module : Main
|
||||||
@ -17,23 +18,26 @@ module Main (
|
|||||||
main
|
main
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import DCB
|
import DCB
|
||||||
|
|
||||||
import Control.Monad (unless)
|
import Control.DeepSeq
|
||||||
import Control.Parallel.Strategies
|
import Control.Monad (unless)
|
||||||
import Control.DeepSeq
|
import Control.Monad.Par.Scheds.Trace
|
||||||
import qualified Data.List as L
|
import Control.Parallel.Strategies
|
||||||
import System.Exit (exitFailure)
|
import Data.Array.Repa as A hiding ((++))
|
||||||
import System.Environment
|
import Data.Array.Repa.Repr.Unboxed
|
||||||
import Test.QuickCheck.All (quickCheckAll)
|
import Data.ByteString.Char8 (ByteString)
|
||||||
import qualified Data.ByteString.Char8 as B
|
import qualified Data.ByteString.Char8 as B
|
||||||
import Data.ByteString.Char8 (ByteString)
|
import Data.Either (lefts, rights)
|
||||||
import Control.Monad.Par.Scheds.Trace
|
import qualified Data.List as L
|
||||||
import qualified Data.Stream as S
|
import qualified Data.Stream as S
|
||||||
import Data.Either (lefts, rights)
|
import qualified Data.Text as T
|
||||||
import Debug.Trace
|
import Data.Text.Encoding
|
||||||
import qualified Data.Text as T
|
import Debug.Trace
|
||||||
import Data.Text.Encoding
|
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].
|
-- 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 [])
|
createAttr input = createAttr' (T.split (=='\t') input) (Left [])
|
||||||
where
|
where
|
||||||
createAttr' :: [T.Text] -> Either [Double] T.Text -> Either [Double] T.Text
|
createAttr' :: [T.Text] -> Either [Double] T.Text -> Either [Double] T.Text
|
||||||
|
createAttr' [] r = r
|
||||||
createAttr' (a:as) r =
|
createAttr' (a:as) r =
|
||||||
let this = read (T.unpack a) :: Double in
|
let this = read (T.unpack a) :: Double in
|
||||||
(if isNaN this then
|
(if isNaN this then
|
||||||
Right $ T.append (T.pack "cannot parse ") a
|
Right $ T.append (T.pack "cannot parse ") a
|
||||||
else
|
else
|
||||||
(let next = (createAttr' as r) in
|
(let next = (createAttr' as r) in
|
||||||
@ -80,22 +85,33 @@ emptyLog a = False --emptyLine $ foldl True (&&) (map emptyLine a)
|
|||||||
|
|
||||||
-- TODO: implement calculation
|
-- TODO: implement calculation
|
||||||
--doCalculation :: Matrix Int -> B.ByteString
|
--doCalculation :: Matrix Int -> B.ByteString
|
||||||
doCalculation a = B.pack $ ""--(show a) ++ "\n"
|
doCalculation graph attr = createOutput graph
|
||||||
|
|
||||||
|
|
||||||
createOutput :: [[Int]] -> B.ByteString
|
createOutput :: (Unbox a, Show a) => Array U DIM2 a -> B.ByteString
|
||||||
createOutput a = encodeUtf8 (createOutput' a)
|
createOutput a = B.concat $ L.map B.pack (createOutput' (extent a) a)
|
||||||
|
|
||||||
createOutput' :: [[Int]] -> T.Text
|
createOutput' :: (Unbox a, Show a) => DIM2 -> Array U DIM2 a -> [String]
|
||||||
createOutput' [a] = T.intercalate (T.singleton ',') (L.map (T.pack . show) a)
|
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
|
createOutput' (a:as) = T.append
|
||||||
(T.append
|
(T.append
|
||||||
(T.intercalate (T.singleton ',')
|
(T.intercalate (T.singleton ',')
|
||||||
(L.map (T.pack . show) a))
|
(L.map (T.pack . show) a))
|
||||||
(T.singleton '\n'))
|
(T.singleton '\n'))
|
||||||
(createOutput' as)
|
(createOutput' as)
|
||||||
|
-}
|
||||||
|
|
||||||
-- preprocess ::
|
getAttrLength :: Either [Double] T.Text -> Int
|
||||||
|
getAttrLength (Left a) = length a
|
||||||
|
getAttrLength (Right _) = 0
|
||||||
|
|
||||||
showHelp = undefined
|
showHelp = undefined
|
||||||
|
|
||||||
@ -104,6 +120,13 @@ infixl 1 +||
|
|||||||
(+||) :: a -> Strategy a -> a
|
(+||) :: a -> Strategy a -> a
|
||||||
a +|| b = a `using` b
|
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
|
exeMain = do
|
||||||
-- args <- getArgs
|
-- args <- getArgs
|
||||||
-- input <- case args of
|
-- input <- case args of
|
||||||
@ -123,38 +146,31 @@ exeMain = do
|
|||||||
-- dont copy that much lateron. Best would be Matrix Int
|
-- 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::[Either [Int] String] - [Int] is Adjacency-Line, String is parse-Error
|
||||||
unrefined_graph <- return $ (L.map (createGraph) adjMat)
|
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)
|
unrefined_attr <- return $ (L.map (createAttr) attrMat)
|
||||||
+|| (parBuffer 100 rdeepseq) --run parallel, evaluate fully
|
-- +|| (parBuffer 100 rdeepseq) --run parallel, evaluate fully
|
||||||
--egraph <- return $ graphFolder unrefined_graph
|
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
|
putStrLn $ show (length (L.foldl1 (++) (lefts unrefined_graph)),length (L.foldl1 (++) (lefts unrefined_attr)))
|
||||||
T.intercalate (T.singleton '\n') (rights unrefined_graph), -- concat error-log
|
----- EXTRACT MATRICES
|
||||||
length unrefined_graph) -- number of elements in graph
|
graph <- return $ A.fromListUnboxed (Z :. adjLines :. adjLines) (L.foldl1' (++) (lefts unrefined_graph)) -- concatenated graph
|
||||||
-- in parallel
|
|
||||||
`using` parTuple3 rdeepseq rdeepseq rseq)
|
|
||||||
|
|
||||||
(attr, log, linesAttr) <- return $ ((L.foldl1' (++) (lefts unrefined_graph), -- concatenated graph
|
attr <- return $ A.fromListUnboxed (Z :. attrLines :. attrNum) (L.foldl1' (++) (lefts unrefined_attr)) -- concatenated attr
|
||||||
T.append log (T.intercalate (T.singleton '\n') (rights unrefined_graph)), -- concat error-log
|
|
||||||
length unrefined_graph) -- number of elements in graph
|
----- CALCULATE
|
||||||
-- in parallel
|
output <- return $ doCalculation graph attr
|
||||||
`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")
|
|
||||||
B.putStr output
|
B.putStr output
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user