- 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

@@ -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 :: Adj -> Attr -> Params -> B.ByteString
---doCalculation :: Matrix Int -> B.ByteString
+doCalculation adj attr p =
-doCalculation adj attr =
         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
         in
                 B.concat $
@@ -178,17 +228,18 @@ debug a = return () --putStrLn a
 
 -- | The main-function to bootstrap our application
 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
---            [] -> 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
     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

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