diff --git a/Data/DEVS.hs b/Data/DEVS.hs new file mode 100644 --- /dev/null +++ b/Data/DEVS.hs @@ -0,0 +1,35 @@ +{- +Copyright (c) 2013, Markus Barenhoff +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-} + +module Data.DEVS + ( module Data.DEVS.Devs + , module Data.DEVS.Simulation + ) where + +import Data.DEVS.Devs +import Data.DEVS.Simulation diff --git a/Data/DEVS/Devs.hs b/Data/DEVS/Devs.hs new file mode 100644 --- /dev/null +++ b/Data/DEVS/Devs.hs @@ -0,0 +1,184 @@ +{- +Copyright (c) 2013, Markus Barenhoff +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-} + +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ExistentialQuantification #-} + + +-- | The /Discrete Event System Sepcification (DEVS)/ formalism defines +-- discrete event simulation models in a hierachical, modular manner. +module Data.DEVS.Devs + ( -- * Parallel DEVS + PDEVS (..) + -- * Time base + , T, t_infinity + -- * AtomicModel + , AtomicModel (..) + -- * CoupledModel + , CoupledModel (..), ComponentRef, Z (..) + -- * References + -- $references + ) where + +import Data.Binary +import Data.Typeable (Typeable, cast) +import Data.Set (Set) +import Data.Map (Map) +import Data.Maybe (isJust) +import qualified Data.Map as Map +import qualified Data.Set as Set + +import qualified Prelude as P +import Numeric.Units.Dimensional.Prelude +import Data.DEVS.Simulation.Infinite + +-- | The 'Time' type 'T' used in "Data.DEVS" +type T = Time Double + +-- | the inifinite time +t_infinity :: T +t_infinity = infinity *~ second + +-- | The /Parallel DEVS (P-DEVS)/ Model [PDEVS94]. +class (Typeable m, Ord m, Show m) => PDEVS m where + type X m :: * + type Y m :: * + data S m :: * + + -- | the models initial state + s0 :: m -> S m + + -- | the internal transition function + delta_int :: m -- ^ the model + -> S m -- ^ the current state + -> S m -- ^ the new state + + -- | the external transition function + delta_ext :: m -- ^ the model + -> S m -- ^ the current state + -> T -- ^ the current time + -> Set (X m) -- ^ the set of input events at current time + -> S m -- ^ the new state + + -- | the confluent transition function + delta_con :: m -- ^ the model + -> S m -- ^ the current state + -> Set (X m) -- ^ the set of input events at current time + -> S m -- ^ the new state + + -- | the output function of the model. + lambda :: m -- ^ the model + -> S m -- ^ the current state + -> Y m -- ^ the output + + -- | the time advance function + ta :: m -- ^ the model + -> S m -- ^ the current state + -> T -- ^ the time of next internal event + + -- | a reference to the model it self as a component of a 'CoupledModel'. + selfRef :: m -> ComponentRef + selfRef m = MkComponentRef m + +-- | A 'PDEVS' model which does not have furter 'ComponentRef's +class (PDEVS m) => AtomicModel m + +-- | A 'PDEVS' model which is composed out of other 'AtomicModel' or 'CoupledModel' +class (PDEVS d) => CoupledModel d where + -- | the set of 'CoupledModel's components + componentRefs :: d -> Set ComponentRef + + -- | the map of influencers, for all components in 'componentRefs' + compInfluencers :: d -> Map ComponentRef (Set ComponentRef) + + -- | the influencers of the model it self + selfInfluencers :: d -> Set ComponentRef + + -- | the map of influencers, for all components in 'componentRefs' and self + influencers :: d -> Map ComponentRef (Set ComponentRef) + influencers d = + let crefs' = compInfluencers d + crefs_no_self = case (Map.lookup (selfRef d) crefs') of + Nothing -> crefs' + Just _ -> error $ "compInfluencers of " ++ show d ++ + " must not contain a reference to the model it self" + x = Set.map f $ componentRefs d + f r = isJust $ Map.lookup r $ crefs' + y = Set.fold (&&) True x + crefs = if (y) then crefs_no_self else + error $ "compInfluencers of " ++ show d ++ " must contain an entry " ++ + "for every Component in componentRefs" + allinfs = Map.insert (selfRef d) (selfInfluencers d) crefs + in allinfs + +-- | a Reference to a 'PDEVS' component hiding its model +data ComponentRef = forall m . (PDEVS m) => MkComponentRef m + +-- | a @i@-to-@j@ output translation used for coupleing the components of a 'CoupledModel'. +-- +-- [@ExtCoup@] external coupling (translate 'CoupledModel' @i@ input to component @j@ input) +-- +-- [@IntCoup@] internal coupling (translate component @i@ output to component @j@ input) +-- +-- [@OutCoup@] internal coupling (translate component @i@ output to 'CoupledModel' @j@ output) +data Z i j where + ExtCoup :: ((X i) -> (X j)) + -> Z i j + IntCoup :: ((Y i) -> (X j)) + -> Z i j + OutCoup :: ((Y i) -> (Y j)) -> Z i j + + +-- $references +-- * [PDEVS94] Chow, A.C.; Zeigler, B.P., /Parallel DEVS: a parallel, hierarchical, modular modeling formalism/, Simulation Conference Proceedings, 1994. Winter, pp.716,722, 11-14 Dec. 1994, URL: + + + +instance Eq (ComponentRef) where + (MkComponentRef m1) == (MkComponentRef m2) = + case (cast m2) of + Nothing -> False + Just m2' -> m1 == m2' + +instance Ord (ComponentRef) where + compare (MkComponentRef m1) (MkComponentRef m2) = + case (cast m2) of + Nothing -> compare (show m1) (show m2) + Just m2' -> compare m1 m2' + +instance Show (ComponentRef) where + show (MkComponentRef m) = "MkComponentRef (" ++ show m ++ ")" + +instance Binary T where + put = (put :: Time Double -> Put) + get = (get :: Get (Time Double)) + + + diff --git a/Data/DEVS/Simulation.hs b/Data/DEVS/Simulation.hs new file mode 100644 --- /dev/null +++ b/Data/DEVS/Simulation.hs @@ -0,0 +1,39 @@ +{- +Copyright (c) 2013, Markus Barenhoff +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-} + +module Data.DEVS.Simulation + ( module Data.DEVS.Simulation.Processor + , module Data.DEVS.Simulation.Simulator + , module Data.DEVS.Simulation.Coordinator + ) where + + +import Data.DEVS.Simulation.Processor +import Data.DEVS.Simulation.Simulator +import Data.DEVS.Simulation.Coordinator + diff --git a/Data/DEVS/Simulation/Coordinator.hs b/Data/DEVS/Simulation/Coordinator.hs new file mode 100644 --- /dev/null +++ b/Data/DEVS/Simulation/Coordinator.hs @@ -0,0 +1,84 @@ +{- +Copyright (c) 2013, Markus Barenhoff +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-} + +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module Data.DEVS.Simulation.Coordinator ( Coordinator, Processor (..)) where + +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Typeable +import Data.DEVS.Devs +import Data.DEVS.Simulation.Processor +import Control.Distributed.Process + +data Coordinator deriving (Typeable) + + +instance ProcessorType Coordinator + + +instance Processor Coordinator where + data ProcessorConf Coordinator = + CoordinatorConf { coord_compConfs :: forall t . (ProcessorType t) + => Map (ProcessorModelT t) (ProcessorConf t) + } + defaultProcessorConf = + CoordinatorConf { coord_compConfs = Map.empty + } + + + data ProcessorState Coordinator = + CoordinatorState { coord_model :: ProcessorModelT Coordinator + , coord_procs :: [ProcessorT] + } + + + + + mkProcessor conf' (PM m' mconf) = + let conf = maybe conf' id mconf + m = maybe (error $ "mkProcessor of Coordinator must be called with a CoupledModel") id + (cast m') + + in do + proc_say conf $ "creating Coordinator for model " ++ show m + return . MkProcessorT $ CoordinatorState { + coord_model = m, + coord_procs = [] + } + + diff --git a/Data/DEVS/Simulation/Infinite.hs b/Data/DEVS/Simulation/Infinite.hs new file mode 100644 --- /dev/null +++ b/Data/DEVS/Simulation/Infinite.hs @@ -0,0 +1,38 @@ +{- +Copyright (c) 2013, Markus Barenhoff +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-} + +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} + +module Data.DEVS.Simulation.Infinite where + +class HasInfinite s where + infinity :: s + +instance (RealFloat f) => HasInfinite f where + infinity = encodeFloat (floatRadix 0 - 1) (snd $ floatRange 0) diff --git a/Data/DEVS/Simulation/Processor.hs b/Data/DEVS/Simulation/Processor.hs new file mode 100644 --- /dev/null +++ b/Data/DEVS/Simulation/Processor.hs @@ -0,0 +1,101 @@ +{- +Copyright (c) 2013, Markus Barenhoff +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-} + +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module Data.DEVS.Simulation.Processor + (ProcessorType (..), Processor (..), ProcessorT (..), ProcessorModelT (..), ProcessorModel (..)) where + +import Data.Typeable (Typeable, cast) +import Control.Distributed.Process +import Control.Distributed.Process.Serializable + +import Data.DEVS.Devs + + +class ProcessorType p + + + +-- | a processor runs a model during simulation +class Processor p where + data ProcessorConf p :: * + data ProcessorState p :: * + + -- | returns the processors default configuration + defaultProcessorConf :: ProcessorConf p + + -- | start a new processor with given config. + mkProcessor :: ProcessorConf p -> ProcessorModelT p -> Process ProcessorT + + -- | start a new processor with default config. + mkDefaultProcessor :: ProcessorModelT p -> Process ProcessorT + mkDefaultProcessor = mkProcessor defaultProcessorConf + + -- | let the processor say a message + proc_say :: ProcessorConf p -> String -> Process () + proc_say c msg = do say $ msg + + -- | error: will output error message and call 'fail' + proc_fail :: ProcessorConf p -> String -> Process () + proc_fail c err = do proc_say c err ; fail err + +-- | a 'Model' which is suitable to be used in a 'Processor' +class (PDEVS m, Serializable (X m), Serializable (Y m), ProcessorType p) => + ProcessorModel p m | m -> p where + procModelWith :: Maybe (ProcessorConf p) -> m -> ProcessorModelT p + procModelWith conf m = PM m conf + procModel :: m -> ProcessorModelT p + procModel = procModelWith Nothing + + +data ProcessorT = forall p . MkProcessorT (ProcessorState p) + +data ProcessorModelT p = forall m . (ProcessorModel p m ) => + PM { proc_model :: m + , proc_conf :: Maybe (ProcessorConf p) + } + deriving (Typeable) + +instance Show (ProcessorModelT p) where + show (PM m _) = show m + +instance Eq (ProcessorModelT p) where + (PM a _) == (PM b _) = case (cast b) of + Nothing -> False + Just b' -> a == b' + +instance Ord (ProcessorModelT p) where + compare (PM a _) (PM b _) = case (cast b) of + Nothing -> compare (show a) (show b) + Just b' -> compare a b' diff --git a/Data/DEVS/Simulation/Simulator.hs b/Data/DEVS/Simulation/Simulator.hs new file mode 100644 --- /dev/null +++ b/Data/DEVS/Simulation/Simulator.hs @@ -0,0 +1,64 @@ +{- +Copyright (c) 2013, Markus Barenhoff +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +-} + +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module Data.DEVS.Simulation.Simulator + ( Simulator, Processor (..)) where + +import Data.Typeable (Typeable, cast) +import Control.Distributed.Process +import qualified Prelude as P +import Numeric.Units.Dimensional.Prelude +import Data.DEVS.Simulation.Processor + + +data Simulator deriving (Typeable) + +instance ProcessorType Simulator + +instance Processor Simulator where + data ProcessorConf Simulator = SimulatorConf {} + data ProcessorState Simulator = + SimulatorState { sim_model :: ProcessorModelT Simulator } + + defaultProcessorConf = SimulatorConf + mkProcessor conf (PM m' mconf) = + let m = maybe + (error $ "mkProcessor of Simulator must be called with an AtomicModel.") id + (cast m') + in do + proc_say conf $ "creating Simulator for model " ++ show m + return . MkProcessorT $ SimulatorState + { sim_model = m } + + diff --git a/Example.hs b/Example.hs new file mode 100644 --- /dev/null +++ b/Example.hs @@ -0,0 +1,137 @@ +module Main where + +import Data.DEVS.Simulation +import Example.Ship + + + +{- + +-- +-- SHIP +-- +data Ship = Ship { + ship_mass :: Mass Double, + ship_init_x :: Length Double, + ship_init_y :: Length Double, + ship_engine :: Engine +} deriving (Typeable) + +data ShipCmd = ShipSetSpeed (Velocity Double) | ShipSetHeading (PlaneAngle Double) + deriving (Eq, Ord) +data ShipEvent = ShipEventEngines Bool + +instance Model Ship where + type X Ship = ShipCmd + type Y Ship = ShipEvent + data S Ship = + ShipState { + ship_x :: Length Double, + ship_y :: Length Double, + ship_bearing :: PlaneAngle Double, + ship_vx :: Velocity Double, + ship_vy :: Velocity Double, + ship_thrust :: Thrust Double, + ship_set_hdg :: PlaneAngle Double, + ship_set_v :: Velocity Double + } + s0 ship = ShipState + { ship_x = ship_init_x ship + , ship_y = ship_init_y ship + , ship_bearing = 0 *~ degree + , ship_vx = 0 *~ (meter / second) + , ship_vy = 0 *~ (meter / second) + , ship_thrust = 0 *~ (newton) + , ship_set_hdg = 0 *~ degree + , ship_set_v = 0 *~ (meter / second) + } + +instance DEVS Ship where + lambda m s = undefined --ShipEventEngines (ship_v s == ship_set_v s) + ta m s = t_infinity + delta_int m s = s + delta_ext m s t xs = + let a = ((ship_thrust s) / (ship_mass m)) + ax = a * cos (ship_bearing s) + ay = a * sin (ship_bearing s) + s' = s { ship_vx = ship_vx s + (ax * t) + , ship_vy = ship_vy s + (ay * t) + , ship_x = ship_x s + (ship_vx s * t) + , ship_y = ship_y s + (ship_vy s * t) + } + in s + delta_con m s xs = undefined + + + +--x = f / m + +eng1 = Engine { engine_a = 1000 *~ newton, engine_rate = 13 *~ (liter / minute)} +eng1_sim = engineSim eng1 + +instance CoupledModel Ship + +-- +-- TANK +-- + + + +instance DEVS Tank where + + + + + + + +instance ProcessorModel Tank where +-- +-- ENGINE +-- + +data Engine = Engine { + engine_a :: Thrust Double, + engine_rate :: FlowRate Double + } deriving (Typeable) + +data EngineCmd = EngineEnable | EngineDisable + deriving (Ord, Eq) + +instance Binary EngineCmd where + +data EngineEvent = EngineEventThrust (Thrust Double) + deriving (Typeable) + +instance Binary EngineEvent where + +instance Model Engine where + type X Engine = EngineCmd + type Y Engine = EngineEvent + data S Engine = + EngineState { + engine_enabled :: Bool + } + s0 _ = EngineState { engine_enabled = False } + +instance DEVS Engine where + lambda m s = EngineEventThrust $ + if (engine_enabled s) + then engine_a m + else 0 *~ newton + delta_int _ s = s + delta_ext m s t xs = delta_con m s xs + delta_con m s xs = + let es = engine_enabled s + sw = Set.member (if es then EngineDisable else EngineEnable) xs + es' = if sw then not es else es + in s { engine_enabled = es' } + ta m _ = t_infinity + +instance ProcessorModel Engine where + + +engineSim :: Engine -> Simulator Engine +engineSim = mkSimulator + +-} diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2013, Markus Barenhoff +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, this + list of conditions and the following disclaimer in the documentation and/or + other materials provided with the distribution. + +* Neither the name of the {organization} nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +lambda-devs +=========== + +a Paralell-DEVS implementaion based on distributed-process diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/lambda-devs.cabal b/lambda-devs.cabal new file mode 100644 --- /dev/null +++ b/lambda-devs.cabal @@ -0,0 +1,112 @@ +-- Initial lambda-devs.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: lambda-devs + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.3.1 +stability: alpha + +-- A short (one-line) description of the package. +synopsis: a Paralell-DEVS implementaion based on distributed-process +description: The Discrete Event System Sepcification (DEVS) formalism + defines discrete event simulation models in a hierachical, + modular manner. +-- A longer description of the package. +-- description: + +-- URL for the project homepage or repository. +homepage: http://github.com/alios/lambda-devs + +-- The license under which the package is released. +license: BSD3 + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Markus Barenhoff + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: alios@alios.org + +-- A copyright notice. +-- copyright: + +category: Control, Simulation + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +extra-source-files: README.md, LICENSE + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + +tested-with: GHC == 7.6.3 + + +source-repository head + type: git + location: https://github.com/alios/lambda-devs.git + + +library + -- Modules exported by the library. + exposed-modules: Data.DEVS, + Data.DEVS.Devs + Data.DEVS.Simulation + Data.DEVS.Simulation.Processor + Data.DEVS.Simulation.Simulator + Data.DEVS.Simulation.Coordinator + + -- Modules included in this library but not exported. + other-modules: Data.DEVS.Simulation.Infinite + + + -- LANGUAGE extensions used by modules in this package. + other-extensions: MultiParamTypeClasses, + DeriveDataTypeable, + GADTs, + TypeFamilies, + FlexibleInstances, + FlexibleContexts, + UndecidableInstances, + ExistentialQuantification, + FunctionalDependencies + + + -- Other library packages from which modules are imported. + build-depends: base >=4.6 && <= 5, + binary >=0.5, + containers >=0.5, + distributed-process >=0.4, + dimensional >= 0.12 + + -- Directories containing source files. + -- hs-source-dirs: + + -- Base language which the package is written in. + default-language: Haskell2010 + +executable lambda-devs-example + main-is: Example.hs + build-depends: base >= 4.6 && <= 5, + binary >= 0.5, + containers >= 0.5, + distributed-process >= 0.4, + lambda-devs >= 0.3, + numtype >= 1.0, + dimensional >= 0.12 + + + default-language: Haskell2010 +