From 7a4248671e9a1c130f6d166f5fd1e514237b5d70 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 24 Jun 2018 12:59:24 +0200 Subject: [PATCH] cleaning --- src/MindMap.hs | 56 ++++++++++---------------------------------------- 1 file changed, 11 insertions(+), 45 deletions(-) diff --git a/src/MindMap.hs b/src/MindMap.hs index cfca4f3..c01a636 100644 --- a/src/MindMap.hs +++ b/src/MindMap.hs @@ -18,12 +18,12 @@ import Data.List (find) import Types -repKonst = 0.03 -friction = 0.05 :: Double -eqRep = 96 -l0 = 1 :: Double +friction :: Double +friction = 0.05 +l0 :: Double +l0 = 1 +springKonst :: Double springKonst = 0.8 -- N/m -gravKonst = 1/2 -- 6.67408e-11 buildMindMap :: Int -> Word -> IO (AG.Graph MMNode) buildMindMap num difficulty = do @@ -31,7 +31,7 @@ buildMindMap num difficulty = do makeVert [MMNode (V2 10 10) (-1)] [1 .. (1 + fromIntegral difficulty)] - aux <- randomRIO (0, floor (fromIntegral num * 5 / 8)) :: IO Int + aux <- randomRIO (0, floor (fromIntegral num * 5 / 8 :: Double)) :: IO Int auxPaths <- mapM (\_ -> do len <- randomRIO (0, num `div` 10) (path . (MMNode (V2 0 0) 0 :)) <$> foldM makeVert [] [1 .. len] @@ -61,24 +61,17 @@ springField inGraph = | mmId a == mmId node = acc + V2 0 0 | a `elem` map snd (filter ((== node) . fst) $ edgeList graph) = - -- acc - fmap (* (1000 / (len (mmPos a - mmPos node)) ^ 2)) - -- (signorm (mmPos a - mmPos node)) acc + fmap (* (springKonst * (distance (mmPos a) (mmPos node) - l0))) (normv (mmPos a - mmPos node)) | node `elem` map snd (filter ((== a) . fst) $ edgeList graph) = - -- acc - fmap (* (1000 / (len (mmPos a - mmPos node)) ^ 2)) - -- (signorm (mmPos a - mmPos node)) acc - fmap (* (springKonst * (distance (mmPos a) (mmPos node) - l0))) (normv (mmPos node - mmPos a)) | otherwise = - -- acc - V2 0 0 - acc - fmap (* (1000 / ((distance (mmPos node) (mmPos a)) ^ 2))) + acc - fmap (* (1000 / ((distance (mmPos node) (mmPos a)) ^ (2 :: Int)))) (normv (mmPos a - mmPos node)) - -- acc - fmap (* (springKonst * (len (mmPos a - mmPos node)))) - -- (signorm (mmPos a - mmPos node)) in (mmId node, fmap (* friction) accel) calcul graph = - let deltas = foldl (\acc a -> calculDelta graph a : acc) [] (vertexList graph) + let deltas = map (calculDelta graph) (vertexList graph) in if any (\(_, v) -> len v > 0.1) (A.log A.Debug ("deltas: " ++ show deltas) deltas) -- deltas @@ -94,39 +87,12 @@ springField inGraph = normv v@(V2 0 0) = v normv v = signorm v -forceField :: AG.Graph MMNode -> AG.Graph MMNode -forceField input = - calcul input - where - calculDelta :: AG.Graph MMNode -> MMNode -> V2 Double - calculDelta inGraph n = - let accel :: V2 Double - accel = - foldl (\acc a -> - acc + - (if n == a || distance (mmPos n) (mmPos a) > eqRep - then V2 0 0 - else fmap - (* (repKonst * (dist a - eqRep) / dist a)) - (mmPos n - mmPos a) - ) - ) - (V2 0 0 :: V2 Double) - inGraph - dist :: MMNode -> Double - dist a = distance (mmPos n) (mmPos a) - in fmap (* friction) accel - calcul inGraph = - let deltaSum = foldl (\acc a -> acc + (calculDelta inGraph a)) (V2 0 0) inGraph - in if sqrt (deltaSum `dot` deltaSum) > 1e-15 - then A.log A.Verbose (show deltaSum) - (calcul ((\n -> n { mmPos = mmPos n + calculDelta inGraph n }) <$> inGraph)) - else A.log A.Verbose (show deltaSum) inGraph - buildFloorMap :: AG.Graph MMNode -> M.Matrix Int buildFloorMap inGraph = foldl - (\amat (MMNode (V2 r c) id) -> M.setElem (if id == 0 then -2 else id) (floor r + 2, floor c + 2) amat) + (\amat (MMNode (V2 r c) i) -> M.setElem (if i == 0 then -2 else i) + (floor r + 2, floor c + 2) amat + ) emptyFloor (A.log A.Debug ("floorGraph: " ++ show floorGraph) floorGraph) where