- added possibility to read parameter input file (alpha, omega, delta)
TODO: documentation of specification - if program parameters are specified -> use them; otherwise -> use "defaults" (sampledata.[...])
This commit is contained in:
parent
887c6a8a43
commit
afcfe59a2e
87
src/Main.hs
87
src/Main.hs
@ -20,6 +20,7 @@
|
|||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import DCB.DCB
|
import DCB.DCB
|
||||||
|
import DCB.Structures
|
||||||
import DCB.IO
|
import DCB.IO
|
||||||
import Util
|
import Util
|
||||||
|
|
||||||
@ -48,6 +49,11 @@ import System.Exit (exitFailure, exitSuccess)
|
|||||||
import Test.QuickCheck.All (quickCheckAll)
|
import Test.QuickCheck.All (quickCheckAll)
|
||||||
|
|
||||||
|
|
||||||
|
data Params = Params { density :: Double
|
||||||
|
, matches :: Int
|
||||||
|
, range :: [Double]
|
||||||
|
} deriving (Show)
|
||||||
|
|
||||||
-- | Parses the graph
|
-- | Parses the graph
|
||||||
-- a graph consists of NxN chars layouted like
|
-- a graph consists of NxN chars layouted like
|
||||||
--
|
--
|
||||||
@ -108,6 +114,50 @@ createAttr (!input) = createAttr' (T.split (=='\t') input) (Left [])
|
|||||||
Left rs -> Left (this : rs)
|
Left rs -> Left (this : rs)
|
||||||
_ -> next))
|
_ -> next))
|
||||||
|
|
||||||
|
createParams :: Char -> [T.Text] -> Either Params T.Text
|
||||||
|
createParams delim t =
|
||||||
|
if length t < 3 then
|
||||||
|
Right $ T.pack "parsing parameter file: less parameters than expected"
|
||||||
|
else
|
||||||
|
let
|
||||||
|
-- parse (=reads) successful if String is empty, otherwise error
|
||||||
|
densLine = head t
|
||||||
|
matchLine = head $ tail t
|
||||||
|
rangeLine = head $ drop 2 t
|
||||||
|
densR = reads (T.unpack $ densLine) :: [(Double, String)]
|
||||||
|
matchR = reads (T.unpack $ matchLine) :: [(Int, String)]
|
||||||
|
in -- general test of input
|
||||||
|
if (L.length t > 3 && T.empty /= (T.concat $ drop 3 t)) then
|
||||||
|
Right $T.pack "parsing parameter file: more parameter lines than expected"
|
||||||
|
else
|
||||||
|
-- test density part
|
||||||
|
case not (L.null densR) && L.null (snd $ head densR) && not (isNaN $ fst $ head densR) of
|
||||||
|
True ->
|
||||||
|
-- test match part
|
||||||
|
case matchR of -- parse successful
|
||||||
|
[(m, "")] ->
|
||||||
|
let
|
||||||
|
range = parseRange $ rangeLine
|
||||||
|
errors = rights range
|
||||||
|
in
|
||||||
|
-- test and parse range line
|
||||||
|
-- some "rights" may be empty entries, they can be ignored
|
||||||
|
case T.null (T.concat errors) of
|
||||||
|
True -> Left $ Params (fst $ head densR) m (lefts range)
|
||||||
|
False -> Right $ T.append (T.pack "parsing parameter file: cannot parse ") (T.concat errors)
|
||||||
|
_ -> Right $ T.append (T.pack ("parsing parameter file: cannot parse ")) $ T.append matchLine $ T.pack "::Int"
|
||||||
|
False -> Right $ T.append (T.pack ("parsing parameter file: cannot parse ")) $ T.append densLine $ T.pack "::Double"
|
||||||
|
where
|
||||||
|
-- parses the line of attribute ranges
|
||||||
|
parseRange :: T.Text -> [Either Double T.Text]
|
||||||
|
parseRange t = L.map parseRange' (T.split (== delim) t)
|
||||||
|
-- parses each number in line seperated by 'delim'
|
||||||
|
parseRange' s = case reads (T.unpack s) :: [(Double, String)] of
|
||||||
|
[(d,"")] -> Left d
|
||||||
|
-- empty entries caused by duplicated delimiter are ignored
|
||||||
|
_ -> Right (if T.null s then T.empty
|
||||||
|
else T.append (T.pack ("cannot parse ")) $ T.append s $ T.pack "::Double,")
|
||||||
|
|
||||||
-- | checks if a given Text is empty (Empty String, whitespaces)
|
-- | checks if a given Text is empty (Empty String, whitespaces)
|
||||||
emptyLine :: T.Text -> Bool
|
emptyLine :: T.Text -> Bool
|
||||||
emptyLine a
|
emptyLine a
|
||||||
@ -115,13 +165,13 @@ emptyLine a
|
|||||||
| T.all isSpace a = True
|
| T.all isSpace a = True
|
||||||
| otherwise = False
|
| otherwise = False
|
||||||
|
|
||||||
-- TODO: implement calculation
|
doCalculation :: Adj -> Attr -> Params -> B.ByteString
|
||||||
--doCalculation :: Matrix Int -> B.ByteString
|
doCalculation adj attr p =
|
||||||
doCalculation adj attr =
|
|
||||||
let
|
let
|
||||||
dens = 0.75
|
dens = density p --0.75
|
||||||
omega = (A.fromListUnboxed (ix1 6) [0,5,3,300,5,10])
|
nAttr = length (range p)
|
||||||
delta = 2
|
omega = A.fromListUnboxed (ix1 nAttr) (range p) --(A.fromListUnboxed (ix1 6) [0,5,3,300,5,10])
|
||||||
|
delta = matches p --2
|
||||||
(adj_, graph_) = preprocess adj attr {--0.8--} omega delta
|
(adj_, graph_) = preprocess adj attr {--0.8--} omega delta
|
||||||
in
|
in
|
||||||
B.concat $
|
B.concat $
|
||||||
@ -178,18 +228,19 @@ debug a = return () --putStrLn a
|
|||||||
|
|
||||||
-- | The main-function to bootstrap our application
|
-- | The main-function to bootstrap our application
|
||||||
main = do
|
main = do
|
||||||
-- args <- getArgs
|
args <- getArgs
|
||||||
-- input <- case args of
|
input <- case args of
|
||||||
-- ["--help"] -> showHelp
|
[] -> Prelude.mapM B.readFile ["sampledata.adj","sampledata.adj.atr","sampledata.p"]
|
||||||
|
-- ["--help"] -> showHelp -- TODO: implement help display
|
||||||
-- ["-h"] -> showHelp
|
-- ["-h"] -> showHelp
|
||||||
-- [] -> error "Error: Wrong number of Arguments given. Try --help for more information."
|
[adj, attr, params] -> Prelude.mapM B.readFile [adj, attr, params]
|
||||||
-- [adj, attr] -> Prelude.mapM B.readFile [adj, attr]
|
_ -> error "Error: Wrong number of Arguments given. Try --help for more information."
|
||||||
-- _ -> error "Wrong arguments given"
|
|
||||||
input <- Prelude.mapM B.readFile ["sampledata.adj","sampledata.adj.atr"]
|
|
||||||
-- read file and clean
|
-- read file and clean
|
||||||
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)))
|
||||||
|
paramRef <- return $ L.filter (not . emptyLine) (T.lines (decodeUtf8 ((head . L.tail . L.tail) input)))
|
||||||
|
|
||||||
adjLines <- return $ length adjMat
|
adjLines <- return $ length adjMat
|
||||||
attrLines <- return $ length attrMat
|
attrLines <- return $ length attrMat
|
||||||
|
|
||||||
@ -197,6 +248,7 @@ main = do
|
|||||||
-- +|| (parBuffer 25 rseq) --run parallel, evaluate fully
|
-- +|| (parBuffer 25 rseq) --run parallel, evaluate fully
|
||||||
unrefined_attr <- return $ (L.map (createAttr) attrMat)
|
unrefined_attr <- return $ (L.map (createAttr) attrMat)
|
||||||
-- +|| (parBuffer 25 rseq) --run parallel, evaluate fully
|
-- +|| (parBuffer 25 rseq) --run parallel, evaluate fully
|
||||||
|
paramsFinal <- return $ createParams '\t' paramRef
|
||||||
adjNum <- return $ getLength (head unrefined_graph)
|
adjNum <- return $ getLength (head unrefined_graph)
|
||||||
attrNum <- return $ getLength (head unrefined_attr)
|
attrNum <- return $ getLength (head unrefined_attr)
|
||||||
debug $ show (adjLines, attrLines, attrNum)
|
debug $ show (adjLines, attrLines, attrNum)
|
||||||
@ -206,6 +258,7 @@ main = do
|
|||||||
-- parser-errors
|
-- parser-errors
|
||||||
checkError $ T.intercalate (T.singleton '\n') (rights unrefined_graph)
|
checkError $ T.intercalate (T.singleton '\n') (rights unrefined_graph)
|
||||||
checkError $ T.intercalate (T.singleton '\n') (rights unrefined_attr)
|
checkError $ T.intercalate (T.singleton '\n') (rights unrefined_attr)
|
||||||
|
checkError $ either (\a -> T.empty) (\b -> b) $ paramsFinal
|
||||||
-- attribute-errors
|
-- attribute-errors
|
||||||
if adjLines /= attrLines then
|
if adjLines /= attrLines then
|
||||||
checkError $ T.pack $ "Adjacency-Matrix size "++ show adjLines ++
|
checkError $ T.pack $ "Adjacency-Matrix size "++ show adjLines ++
|
||||||
@ -228,9 +281,7 @@ main = do
|
|||||||
----- CALCULATE & OUTPUT
|
----- CALCULATE & OUTPUT
|
||||||
|
|
||||||
--debug $ "Before: " ++ show (sumAllS graph)
|
--debug $ "Before: " ++ show (sumAllS graph)
|
||||||
B.putStr $ doCalculation graph attr
|
B.putStr $ doCalculation graph attr $ (\(Left a) -> a) paramsFinal
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{---TIMINGS
|
{---TIMINGS
|
||||||
@ -453,4 +504,4 @@ gen[1].sync: 0
|
|||||||
REAL SPEEDUP AGAINST OVERHEAD-VARIANT: 129.39/34.05 = 3.8
|
REAL SPEEDUP AGAINST OVERHEAD-VARIANT: 129.39/34.05 = 3.8
|
||||||
=========================================================
|
=========================================================
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
20
src/Util.hs
20
src/Util.hs
@ -86,8 +86,28 @@ a +|| b = a `using` b
|
|||||||
appendS :: (Show a) => String -> String -> a -> String
|
appendS :: (Show a) => String -> String -> a -> String
|
||||||
appendS sep a b = (a ++ show b) ++ sep
|
appendS sep a b = (a ++ show b) ++ sep
|
||||||
|
|
||||||
|
-- I thought I needed those function... Whe I realised my mistake I
|
||||||
|
-- did not want to remove them again ;-(
|
||||||
|
-- | Removes repetitions from a list. An element is only considered a
|
||||||
|
-- duplication if it equals the previous element. Special case of
|
||||||
|
-- 'remDupsBy' with fixed '==' function.
|
||||||
|
remDups :: (Eq a) => [a] -> [a]
|
||||||
|
remDups l = remDupsBy (==) l
|
||||||
|
|
||||||
|
-- | Removes repetitions from a list. An element is only considered a
|
||||||
|
-- duplication if it equals the previous element.
|
||||||
|
remDupsBy :: (Eq a) => (a -> a -> Bool) -> [a] -> [a]
|
||||||
|
remDupsBy f [] = []
|
||||||
|
remDupsBy f (l:ls) = l:(remDups' l ls)
|
||||||
|
where remDups' l [] = []
|
||||||
|
remDups' prev (l:ls) = case f prev l of
|
||||||
|
True -> remDups' prev ls
|
||||||
|
False -> l:(remDups' l ls)
|
||||||
|
|
||||||
-- When removing duplicates, the first function assigns the input to a bucket,
|
-- When removing duplicates, the first function assigns the input to a bucket,
|
||||||
-- the second function checks whether it is already in the bucket (linear search).
|
-- the second function checks whether it is already in the bucket (linear search).
|
||||||
|
-- | /O(n^2)/ Removes duplicate elements from a list. Performs better than
|
||||||
|
-- 'Prelude.nub' by exploiting features of the 'Ord' class.
|
||||||
ordNubBy :: (Ord b) => (a -> b) -> (a -> a -> Bool) -> [a] -> [a]
|
ordNubBy :: (Ord b) => (a -> b) -> (a -> a -> Bool) -> [a] -> [a]
|
||||||
ordNubBy p f l = go Map.empty l
|
ordNubBy p f l = go Map.empty l
|
||||||
where
|
where
|
||||||
|
Loading…
Reference in New Issue
Block a user