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

cleaning

Browse source
This commit is contained in:
nek0 2018-06-24 12:59:24 +02:00
parent 0fff278fdb
commit 7a4248671e
1 changed files with 11 additions and 45 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
src/MindMap.hs
View file

@ -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