Merge branch 'master' of pwning.de:/hgraph

This commit is contained in:
tpajenka 2013-11-27 12:16:44 +01:00
commit b75f378a67
4 changed files with 80 additions and 48 deletions

View File

@ -1,30 +1,34 @@
module Paths_hgraph ( module Paths_hgraph (
version, version,
getBinDir, getLibDir, getDataDir, getLibexecDir, getBinDir, getLibDir, getDataDir, getLibexecDir,
getDataFileName getDataFileName, getSysconfDir
) where ) where
import qualified Control.Exception as Exception import qualified Control.Exception as Exception
import Data.Version (Version(..)) import Data.Version (Version(..))
import System.Environment (getEnv) import System.Environment (getEnv)
import Prelude
catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
catchIO = Exception.catch catchIO = Exception.catch
version :: Version version :: Version
version = Version {versionBranch = [0,0,1], versionTags = []} version = Version {versionBranch = [0,0,1], versionTags = []}
bindir, libdir, datadir, libexecdir :: FilePath bindir, libdir, datadir, libexecdir, sysconfdir :: FilePath
bindir = "/homes/sdressel/.cabal/bin" bindir = "/home/sdressel/.cabal/bin"
libdir = "/homes/sdressel/.cabal/lib/hgraph-0.0.1/ghc-7.4.1" libdir = "/home/sdressel/.cabal/lib/x86_64-linux-ghc-7.6.3/hgraph-0.0.1"
datadir = "/homes/sdressel/.cabal/share/hgraph-0.0.1" datadir = "/home/sdressel/.cabal/share/x86_64-linux-ghc-7.6.3/hgraph-0.0.1"
libexecdir = "/homes/sdressel/.cabal/libexec" libexecdir = "/home/sdressel/.cabal/libexec"
sysconfdir = "/home/sdressel/.cabal/etc"
getBinDir, getLibDir, getDataDir, getLibexecDir :: IO FilePath getBinDir, getLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath
getBinDir = catchIO (getEnv "hgraph_bindir") (\_ -> return bindir) getBinDir = catchIO (getEnv "hgraph_bindir") (\_ -> return bindir)
getLibDir = catchIO (getEnv "hgraph_libdir") (\_ -> return libdir) getLibDir = catchIO (getEnv "hgraph_libdir") (\_ -> return libdir)
getDataDir = catchIO (getEnv "hgraph_datadir") (\_ -> return datadir) getDataDir = catchIO (getEnv "hgraph_datadir") (\_ -> return datadir)
getLibexecDir = catchIO (getEnv "hgraph_libexecdir") (\_ -> return libexecdir) getLibexecDir = catchIO (getEnv "hgraph_libexecdir") (\_ -> return libexecdir)
getSysconfDir = catchIO (getEnv "hgraph_sysconfdir") (\_ -> return sysconfdir)
getDataFileName :: FilePath -> IO FilePath getDataFileName :: FilePath -> IO FilePath
getDataFileName name = do getDataFileName name = do

View File

@ -1,11 +1,11 @@
/* DO NOT EDIT: This file is automatically generated by Cabal */ /* DO NOT EDIT: This file is automatically generated by Cabal */
/* package QuickCheck-2.4.2 */ /* package QuickCheck-2.6 */
#define VERSION_QuickCheck "2.4.2" #define VERSION_QuickCheck "2.6"
#define MIN_VERSION_QuickCheck(major1,major2,minor) (\ #define MIN_VERSION_QuickCheck(major1,major2,minor) (\
(major1) < 2 || \ (major1) < 2 || \
(major1) == 2 && (major2) < 4 || \ (major1) == 2 && (major2) < 6 || \
(major1) == 2 && (major2) == 4 && (minor) <= 2) (major1) == 2 && (major2) == 6 && (minor) <= 0)
/* package Stream-0.4.6.1 */ /* package Stream-0.4.6.1 */
#define VERSION_Stream "0.4.6.1" #define VERSION_Stream "0.4.6.1"
@ -14,40 +14,40 @@
(major1) == 0 && (major2) < 4 || \ (major1) == 0 && (major2) < 4 || \
(major1) == 0 && (major2) == 4 && (minor) <= 6) (major1) == 0 && (major2) == 4 && (minor) <= 6)
/* package accelerate-0.13.0.5 */ /* package accelerate-0.14.0.0 */
#define VERSION_accelerate "0.13.0.5" #define VERSION_accelerate "0.14.0.0"
#define MIN_VERSION_accelerate(major1,major2,minor) (\ #define MIN_VERSION_accelerate(major1,major2,minor) (\
(major1) < 0 || \ (major1) < 0 || \
(major1) == 0 && (major2) < 13 || \ (major1) == 0 && (major2) < 14 || \
(major1) == 0 && (major2) == 13 && (minor) <= 0) (major1) == 0 && (major2) == 14 && (minor) <= 0)
/* package base-4.5.0.0 */ /* package base-4.6.0.1 */
#define VERSION_base "4.5.0.0" #define VERSION_base "4.6.0.1"
#define MIN_VERSION_base(major1,major2,minor) (\ #define MIN_VERSION_base(major1,major2,minor) (\
(major1) < 4 || \ (major1) < 4 || \
(major1) == 4 && (major2) < 5 || \ (major1) == 4 && (major2) < 6 || \
(major1) == 4 && (major2) == 5 && (minor) <= 0) (major1) == 4 && (major2) == 6 && (minor) <= 0)
/* package bytestring-0.9.2.1 */ /* package bytestring-0.10.0.2 */
#define VERSION_bytestring "0.9.2.1" #define VERSION_bytestring "0.10.0.2"
#define MIN_VERSION_bytestring(major1,major2,minor) (\ #define MIN_VERSION_bytestring(major1,major2,minor) (\
(major1) < 0 || \ (major1) < 0 || \
(major1) == 0 && (major2) < 9 || \ (major1) == 0 && (major2) < 10 || \
(major1) == 0 && (major2) == 9 && (minor) <= 2) (major1) == 0 && (major2) == 10 && (minor) <= 0)
/* package deepseq-1.3.0.0 */ /* package deepseq-1.3.0.1 */
#define VERSION_deepseq "1.3.0.0" #define VERSION_deepseq "1.3.0.1"
#define MIN_VERSION_deepseq(major1,major2,minor) (\ #define MIN_VERSION_deepseq(major1,major2,minor) (\
(major1) < 1 || \ (major1) < 1 || \
(major1) == 1 && (major2) < 3 || \ (major1) == 1 && (major2) < 3 || \
(major1) == 1 && (major2) == 3 && (minor) <= 0) (major1) == 1 && (major2) == 3 && (minor) <= 0)
/* package ghc-7.4.1 */ /* package ghc-7.6.3 */
#define VERSION_ghc "7.4.1" #define VERSION_ghc "7.6.3"
#define MIN_VERSION_ghc(major1,major2,minor) (\ #define MIN_VERSION_ghc(major1,major2,minor) (\
(major1) < 7 || \ (major1) < 7 || \
(major1) == 7 && (major2) < 4 || \ (major1) == 7 && (major2) < 6 || \
(major1) == 7 && (major2) == 4 && (minor) <= 1) (major1) == 7 && (major2) == 6 && (minor) <= 3)
/* package monad-par-0.3.4.5 */ /* package monad-par-0.3.4.5 */
#define VERSION_monad_par "0.3.4.5" #define VERSION_monad_par "0.3.4.5"
@ -56,17 +56,17 @@
(major1) == 0 && (major2) < 3 || \ (major1) == 0 && (major2) < 3 || \
(major1) == 0 && (major2) == 3 && (minor) <= 4) (major1) == 0 && (major2) == 3 && (minor) <= 4)
/* package parallel-3.2.0.2 */ /* package parallel-3.2.0.4 */
#define VERSION_parallel "3.2.0.2" #define VERSION_parallel "3.2.0.4"
#define MIN_VERSION_parallel(major1,major2,minor) (\ #define MIN_VERSION_parallel(major1,major2,minor) (\
(major1) < 3 || \ (major1) < 3 || \
(major1) == 3 && (major2) < 2 || \ (major1) == 3 && (major2) < 2 || \
(major1) == 3 && (major2) == 2 && (minor) <= 0) (major1) == 3 && (major2) == 2 && (minor) <= 0)
/* package text-0.11.1.13 */ /* package text-0.11.3.1 */
#define VERSION_text "0.11.1.13" #define VERSION_text "0.11.3.1"
#define MIN_VERSION_text(major1,major2,minor) (\ #define MIN_VERSION_text(major1,major2,minor) (\
(major1) < 0 || \ (major1) < 0 || \
(major1) == 0 && (major2) < 11 || \ (major1) == 0 && (major2) < 11 || \
(major1) == 0 && (major2) == 11 && (minor) <= 1) (major1) == 0 && (major2) == 11 && (minor) <= 3)

Binary file not shown.

View File

@ -33,7 +33,7 @@ import Debug.Trace
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding import Data.Text.Encoding
--import Stream hiding (map) --same as Data.Stream imported above? --import Stream hiding (map) --same as Data.Stream imported above?
import Data.Array.Accelerate hiding (not) import Data.Array.Accelerate hiding (not,(++))
-- change to Data.Array.Accelerate.CUDA as I and link accelerate-cuda to use GPU instead of CPU -- change to Data.Array.Accelerate.CUDA as I and link accelerate-cuda to use GPU instead of CPU
-- depends on accelerate-cuda package in cabal, which needs the installed CUDA-stuff form -- depends on accelerate-cuda package in cabal, which needs the installed CUDA-stuff form
-- nVidia (nvcc, header-files, ...) and the propriatary driver -- nVidia (nvcc, header-files, ...) and the propriatary driver
@ -88,16 +88,30 @@ createGraph input = createGraph' input (Left [])
createGraph' a r createGraph' a r
| T.null a = r | T.null a = r
| otherwise = | otherwise =
let next = (createGraph' (T.tail a) r) in let next = (createGraph' (T.tail a) r) in -- flip cases for less function-calls?
case next of case next of
Left xs -> Left xs ->
case T.head (traceEvent "parsing" a) of case T.head a of
'0' -> Left $ traceEvent "parse-concat" 0:xs '0' -> Left $ 0:xs
'1' -> Left $ traceEvent "parse-concat" 1:xs '1' -> Left $ 1:xs
_ -> Right $ T.append (T.pack "cannot parse ") a _ -> Right $ T.append (T.pack "cannot parse ") a
Right errstr -> Right errstr ->
Right errstr Right errstr
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' (a:as) r =
let this = read (T.unpack a) :: Double in
case isNaN this of
True -> Right $ T.append (T.pack "cannot parse ") a
_ ->
let next = (createAttr' as r) in
case next of
Left rs -> Left (this:rs)
_ -> next
emptyLine :: T.Text -> Bool emptyLine :: T.Text -> Bool
emptyLine a emptyLine a
| T.null a = True | T.null a = True
@ -109,7 +123,7 @@ 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 a = B.pack $ ""--(show a) ++ "\n"
createOutput :: [[Int]] -> B.ByteString createOutput :: [[Int]] -> B.ByteString
@ -124,6 +138,7 @@ createOutput' (a:as) = T.append
(T.singleton '\n')) (T.singleton '\n'))
(createOutput' as) (createOutput' as)
-- preprocess ::
showHelp = undefined showHelp = undefined
@ -144,29 +159,42 @@ exeMain = do
adjMat <- return $ L.filter (not . emptyLine) (T.lines (decodeUtf8 (head input))) adjMat <- return $ L.filter (not . emptyLine) (T.lines (decodeUtf8 (head input)))
attrMat <- return $ L.filter (not . emptyLine) (T.lines (decodeUtf8 ((head . L.tail) input))) attrMat <- return $ L.filter (not . emptyLine) (T.lines (decodeUtf8 ((head . L.tail) input)))
inputLines <- return $ length adjMat adjLines <- return $ length adjMat
attrLines <- return $ length attrMat
-- TODO: concat with foldl1' kills us later -> use presized/preallocated array so we -- TODO: concat with foldl1' kills us later -> use presized/preallocated array so we
-- 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 (traceEvent "mapping" . createGraph) adjMat) unrefined_graph <- return $ (L.map (createGraph) adjMat)
+|| (parBuffer 100 rdeepseq) --run parallel, evaluate fully
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 --egraph <- return $ graphFolder unrefined_graph
(graph, log, lines) <- return $ ((L.foldl1' ((traceEvent "concatenating graph") . (++)) (lefts unrefined_graph), -- concatenated graph (graph, log, lines) <- return $ ((L.foldl1' (++) (lefts unrefined_graph), -- concatenated graph
traceEvent "concatenating log" T.intercalate (T.singleton '\n') (rights unrefined_graph), -- concat error-log T.intercalate (T.singleton '\n') (rights unrefined_graph), -- concat error-log
traceEvent "getting length" length unrefined_graph) -- number of elements in graph length unrefined_graph) -- number of elements in graph
-- in parallel -- in parallel
`using` parTuple3 rseq rseq rseq) `using` parTuple3 rdeepseq rdeepseq rseq)
(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 -- validate graph
log <- return $ let l = traceEvent "first validation" length graph in log <- return $ let l = length graph in
if l /= lines*lines then if l /= lines*lines then
T.append log $ T.pack $ "Lines dont match up. Read " ++ (show l) ++ T.append log $ T.pack $ "Lines dont match up. Read " ++ (show l) ++
" chars. Expected " ++ (show (lines*lines)) ++ " chars. Expected " ++ (show (lines*lines)) ++
" chars.\n" " 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 else
log log
output <- return $ case emptyLine (traceEvent "last validation" log) of output <- return $ case emptyLine log of
True -> doCalculation $ graph --A.fromList (A.Z A.:. lines A.:. lines) graph 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") _ -> encodeUtf8 $ T.append (T.append (T.pack "Error detected:\n") log) (T.pack "\n\n")
B.putStr output B.putStr output