use a map so immobile nodes have names
This commit is contained in:
parent
d6e0ccce25
commit
28959686b0
1 changed files with 16 additions and 14 deletions
|
@ -10,6 +10,7 @@ import Data.Ratio
|
||||||
import Data.Ord
|
import Data.Ord
|
||||||
import Data.List
|
import Data.List
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
import qualified Data.Map.Strict as M
|
||||||
|
|
||||||
{-
|
{-
|
||||||
- Tunable values
|
- Tunable values
|
||||||
|
@ -56,18 +57,17 @@ numSteps = 100
|
||||||
main = putStrLn . summarize =<< evalRandIO (simulate numSteps =<< genNetwork)
|
main = putStrLn . summarize =<< evalRandIO (simulate numSteps =<< genNetwork)
|
||||||
-- Only pure code below :)
|
-- Only pure code below :)
|
||||||
|
|
||||||
data Network = Network [ImmobileNode] [TransferNode]
|
data Network = Network (M.Map NodeName ImmobileNode) [TransferNode]
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data ImmobileNode = ImmobileNode NodeRepo
|
data ImmobileNode = ImmobileNode NodeRepo
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
-- Index in the Network's list of ImmobileNodes.
|
type NodeName = String
|
||||||
type ImmobileNodeIdx = Int
|
|
||||||
|
|
||||||
data TransferNode = TransferNode
|
data TransferNode = TransferNode
|
||||||
{ currentlocation :: ImmobileNodeIdx
|
{ currentlocation :: NodeName
|
||||||
, possiblelocations :: [ImmobileNodeIdx]
|
, possiblelocations :: [NodeName]
|
||||||
, movefrequency :: Probability
|
, movefrequency :: Probability
|
||||||
, transferrepo :: NodeRepo
|
, transferrepo :: NodeRepo
|
||||||
}
|
}
|
||||||
|
@ -145,11 +145,12 @@ step (Network immobiles transfers) = go immobiles [] transfers
|
||||||
go is c (t:ts) = do
|
go is c (t:ts) = do
|
||||||
r <- randomProbability
|
r <- randomProbability
|
||||||
if movefrequency t <= r
|
if movefrequency t <= r
|
||||||
then do
|
then case M.lookup (currentlocation t) is of
|
||||||
let (is1, (currentloc:is2)) = splitAt (currentlocation t) is
|
Nothing -> go is (c ++ [t]) ts
|
||||||
let (currentloc', t') = exchangeRequestsFiles currentloc t
|
Just currentloc -> do
|
||||||
t'' <- move t'
|
let (currentloc', t') = exchangeRequestsFiles currentloc t
|
||||||
go (is1 ++ currentloc' : is2) (c ++ [t'']) ts
|
t'' <- move t'
|
||||||
|
go (M.insert (currentlocation t) currentloc' is) (c ++ [t'']) ts
|
||||||
else go is (c ++ [t]) ts
|
else go is (c ++ [t]) ts
|
||||||
|
|
||||||
type Exchanger = ImmobileNode -> TransferNode -> (ImmobileNode, TransferNode)
|
type Exchanger = ImmobileNode -> TransferNode -> (ImmobileNode, TransferNode)
|
||||||
|
@ -190,7 +191,8 @@ move t = do
|
||||||
|
|
||||||
genNetwork :: (RandomGen g) => Rand g Network
|
genNetwork :: (RandomGen g) => Rand g Network
|
||||||
genNetwork = do
|
genNetwork = do
|
||||||
immobiles <- sequence (replicate numImmobileNodes mkImmobile)
|
l <- sequence (replicate numImmobileNodes mkImmobile)
|
||||||
|
let immobiles = M.fromList (zip (map show [1..]) l)
|
||||||
transfers <- sequence (replicate numTransferNodes (mkTransfer immobiles))
|
transfers <- sequence (replicate numTransferNodes (mkTransfer immobiles))
|
||||||
return $ Network immobiles transfers
|
return $ Network immobiles transfers
|
||||||
|
|
||||||
|
@ -213,7 +215,7 @@ mkImmobile = ImmobileNode <$> genrepo
|
||||||
-- (Also when running the sim.)
|
-- (Also when running the sim.)
|
||||||
<*> (S.fromList <$> sequence (replicate (totalFiles `div` numImmobileNodes) randomFile))
|
<*> (S.fromList <$> sequence (replicate (totalFiles `div` numImmobileNodes) randomFile))
|
||||||
|
|
||||||
mkTransfer :: (RandomGen g) => [ImmobileNode] -> Rand g TransferNode
|
mkTransfer :: (RandomGen g) => M.Map NodeName ImmobileNode -> Rand g TransferNode
|
||||||
mkTransfer immobiles = do
|
mkTransfer immobiles = do
|
||||||
-- Transfer nodes are given random routes. May be simplistic.
|
-- Transfer nodes are given random routes. May be simplistic.
|
||||||
-- Also, some immobile nodes will not be serviced by any transfer nodes.
|
-- Also, some immobile nodes will not be serviced by any transfer nodes.
|
||||||
|
@ -225,7 +227,7 @@ mkTransfer immobiles = do
|
||||||
let repo = (NodeRepo [] S.empty)
|
let repo = (NodeRepo [] S.empty)
|
||||||
return $ TransferNode currentloc possiblelocs movefreq repo
|
return $ TransferNode currentloc possiblelocs movefreq repo
|
||||||
where
|
where
|
||||||
indexes = [0..length immobiles - 1]
|
indexes = M.keys immobiles
|
||||||
|
|
||||||
randomfrom :: (RandomGen g) => [a] -> Rand g a
|
randomfrom :: (RandomGen g) => [a] -> Rand g a
|
||||||
randomfrom l = do
|
randomfrom l = do
|
||||||
|
@ -247,4 +249,4 @@ summarize (Network is _ts) = unlines $ map (\(d, s) -> d ++ ": " ++ s)
|
||||||
let wantedfs = S.fromList $ map requestedFile (findoriginreqs (wantFiles r))
|
let wantedfs = S.fromList $ map requestedFile (findoriginreqs (wantFiles r))
|
||||||
in S.difference wantedfs (haveFiles r)
|
in S.difference wantedfs (haveFiles r)
|
||||||
repo (ImmobileNode r) = r
|
repo (ImmobileNode r) = r
|
||||||
overis f = map f is
|
overis f = map f $ M.elems is
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue