nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

optimizing MindMap generation

Browse source
This commit is contained in:
nek0 2018-07-08 07:55:44 +02:00
parent 4913b054d8
commit bfccf32451
1 changed files with 56 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

72
src/MindMap.hs
View file

@ -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,6 +70,8 @@ springField =
(calcul ngraph)
else graph
len v = sqrt (v `dot` v)
normv :: (Eq a, Floating a) => V2 a -> V2 a
normv v@(V2 0 0) = v
normv v = signorm v
@ -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