From afcfe59a2e837faa1437baf8d2777f69a73cee4b Mon Sep 17 00:00:00 2001 From: tpajenka Date: Sun, 5 Jan 2014 22:12:41 +0100 Subject: [PATCH] - 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.[...]) --- src/Main.hs | 87 ++++++++++++++++++++++++++++++++++++++++++----------- src/Util.hs | 20 ++++++++++++ 2 files changed, 89 insertions(+), 18 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index f0a4611..43987b4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -20,6 +20,7 @@ module Main where import DCB.DCB +import DCB.Structures import DCB.IO import Util @@ -48,6 +49,11 @@ import System.Exit (exitFailure, exitSuccess) import Test.QuickCheck.All (quickCheckAll) +data Params = Params { density :: Double + , matches :: Int + , range :: [Double] + } deriving (Show) + -- | Parses the graph -- 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) _ -> 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) emptyLine :: T.Text -> Bool emptyLine a @@ -115,13 +165,13 @@ emptyLine a | T.all isSpace a = True | otherwise = False --- TODO: implement calculation ---doCalculation :: Matrix Int -> B.ByteString -doCalculation adj attr = +doCalculation :: Adj -> Attr -> Params -> B.ByteString +doCalculation adj attr p = let - dens = 0.75 - omega = (A.fromListUnboxed (ix1 6) [0,5,3,300,5,10]) - delta = 2 + dens = density p --0.75 + nAttr = length (range p) + 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 in B.concat $ @@ -178,18 +228,19 @@ debug a = return () --putStrLn a -- | The main-function to bootstrap our application main = do --- args <- getArgs --- input <- case args of --- ["--help"] -> showHelp + args <- getArgs + input <- case args of + [] -> Prelude.mapM B.readFile ["sampledata.adj","sampledata.adj.atr","sampledata.p"] +-- ["--help"] -> showHelp -- TODO: implement help display -- ["-h"] -> showHelp --- [] -> error "Error: Wrong number of Arguments given. Try --help for more information." --- [adj, attr] -> Prelude.mapM B.readFile [adj, attr] --- _ -> error "Wrong arguments given" - input <- Prelude.mapM B.readFile ["sampledata.adj","sampledata.adj.atr"] + [adj, attr, params] -> Prelude.mapM B.readFile [adj, attr, params] + _ -> error "Error: Wrong number of Arguments given. Try --help for more information." + -- read file and clean adjMat <- return $ L.filter (not . emptyLine) (T.lines (decodeUtf8 (head 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 attrLines <- return $ length attrMat @@ -197,6 +248,7 @@ main = do -- +|| (parBuffer 25 rseq) --run parallel, evaluate fully unrefined_attr <- return $ (L.map (createAttr) attrMat) -- +|| (parBuffer 25 rseq) --run parallel, evaluate fully + paramsFinal <- return $ createParams '\t' paramRef adjNum <- return $ getLength (head unrefined_graph) attrNum <- return $ getLength (head unrefined_attr) debug $ show (adjLines, attrLines, attrNum) @@ -206,6 +258,7 @@ main = do -- parser-errors checkError $ T.intercalate (T.singleton '\n') (rights unrefined_graph) checkError $ T.intercalate (T.singleton '\n') (rights unrefined_attr) + checkError $ either (\a -> T.empty) (\b -> b) $ paramsFinal -- attribute-errors if adjLines /= attrLines then checkError $ T.pack $ "Adjacency-Matrix size "++ show adjLines ++ @@ -228,9 +281,7 @@ main = do ----- CALCULATE & OUTPUT --debug $ "Before: " ++ show (sumAllS graph) - B.putStr $ doCalculation graph attr - - + B.putStr $ doCalculation graph attr $ (\(Left a) -> a) paramsFinal {---TIMINGS @@ -453,4 +504,4 @@ gen[1].sync: 0 REAL SPEEDUP AGAINST OVERHEAD-VARIANT: 129.39/34.05 = 3.8 ========================================================= --} \ No newline at end of file +-} diff --git a/src/Util.hs b/src/Util.hs index c080598..cb1d778 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -86,8 +86,28 @@ a +|| b = a `using` b appendS :: (Show a) => String -> String -> a -> String 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, -- 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 p f l = go Map.empty l where