diff --git a/src/MindMap.hs b/src/MindMap.hs index a0d66b0..142a975 100644 --- a/src/MindMap.hs +++ b/src/MindMap.hs @@ -55,25 +55,10 @@ springField = calcul where -- This could be optimized in such a way, that you update both computation partners at once. - calculDelta :: AG.Graph MMNode -> MMNode -> (Int, V2 Double) - calculDelta graph node = - let accel = foldl sproing (V2 0 0 :: V2 Double) (vertexList graph) - sproing acc a - | mmId a == mmId node = - acc + V2 0 0 - | a `elem` map snd (filter ((== node) . fst) $ edgeList graph) = - 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 (* (springKonst * (distance (mmPos a) (mmPos node) - l0))) - (normv (mmPos node - mmPos a)) - | otherwise = - acc - fmap (* (1000 / ((distance (mmPos node) (mmPos a)) ^ (2 :: Int)))) - (normv (mmPos a - mmPos node)) - in (mmId node, fmap (* friction) accel) + -- Limit the force calcul graph = - let deltas = map (calculDelta graph) (vertexList graph) - in if any (\(_, v) -> len v > 0.1) + let deltas = calculDelta2 graph -- map (calculDelta graph) (vertexList graph) + in if any (\(_, v) -> len v > 1) (A.log A.Debug ("deltas: " ++ show deltas) deltas) -- deltas then @@ -85,8 +70,10 @@ springField = (calcul ngraph) else graph len v = sqrt (v `dot` v) - normv v@(V2 0 0) = v - normv v = signorm v + +normv :: (Eq a, Floating a) => V2 a -> V2 a +normv v@(V2 0 0) = v +normv v = signorm v buildFloorMap :: AG.Graph MMNode -> (M.Matrix Int, AG.Graph MMNode) buildFloorMap inGraph = @@ -146,3 +133,52 @@ manhattan graph input = | (M.safeGet (r + 1) c inter /= M.safeGet r c inter) && (M.safeGet (r + 1) c mat /= Just Wall) = M.setElem Wall (r, c) mat | otherwise = mat + +calculDelta :: AG.Graph MMNode -> MMNode -> (Int, V2 Double) +calculDelta graph node = + let accel = foldl sproing (V2 0 0 :: V2 Double) (vertexList graph) + sproing acc a + | mmId a == mmId node = + acc + V2 0 0 + | a `elem` map snd (filter ((== node) . fst) $ edgeList graph) = + 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 (* (springKonst * (distance (mmPos a) (mmPos node) - l0))) + (normv (mmPos node - mmPos a)) + | otherwise = + acc - fmap (* (1000 / ((distance (mmPos node) (mmPos a)) ^ (2 :: Int)))) + (normv (mmPos a - mmPos node)) + in (mmId node, fmap (* friction) accel) + +calculDelta2 :: AG.Graph MMNode -> [(Int, V2 Double)] +calculDelta2 graph = + let accel2 = sproing2 (zip (vertexList graph) (repeat $ V2 0 0)) + sproing2 [] = [] + sproing2 ((cnode, cacc):nodeaccs) = + ( mmId cnode + , if (distance (V2 0 0) (V2 100 100 * normv deltasum)) < distance (V2 0 0) deltasum + then V2 100 100 * normv deltasum + else deltasum + ) : sproing2 dnodeaccs + where + deltasum = cacc + sum deltas + deltas = map ((fmap (* friction)) . doForce) (map fst nodeaccs) + doForce n + -- are the nodes identic? (unlikely) + | mmId cnode == mmId n = + V2 0 0 + -- Is the cnode pointing to the currently mapped node? + | n `elem` map snd (filter ((== cnode) . fst) $ edgeList graph) = + fmap (* (springKonst * (distance (mmPos n) (mmPos cnode) - l0))) + (normv (mmPos n - mmPos cnode)) + -- Is the cnode being pointed to from the currently mapped node? + | cnode `elem` map snd (filter ((== n) . fst) $ edgeList graph) = + - fmap (* (springKonst * (distance (mmPos n) (mmPos cnode) - l0))) + (normv (mmPos cnode - mmPos n)) + -- Do gravitational push in all other cases + | otherwise = + - fmap (* (1000 / ((distance (mmPos cnode) (mmPos n)) ^ (2 :: Int)))) + (normv (mmPos n - mmPos cnode)) + dnodeaccs = zipWith (\(n, a) d -> (n, a - d)) nodeaccs deltas + in accel2