LTS-0.1.0.0: LTS: Labelled Transition System

CopyrightCopyright (c) 2020 Ajay Kumar Eeralla
Maintainerajay.eeralla@gmail.com
Stabilityexperimental
Portabilityportable
Safe HaskellSafe
LanguageHaskell2010

Data.LTS

Description

This module implements a labelled transition system

Synopsis

Documentation

data LTSState a Source #

LTSState is a record type which may hold id, output, etc.

Constructors

LTSState 

Fields

Instances
Eq a => Eq (LTSState a) Source # 
Instance details

Defined in Data.LTS

Methods

(==) :: LTSState a -> LTSState a -> Bool #

(/=) :: LTSState a -> LTSState a -> Bool #

Eq a => Ord (LTSState a) Source #

Define Ord instance by id

Instance details

Defined in Data.LTS

Methods

compare :: LTSState a -> LTSState a -> Ordering #

(<) :: LTSState a -> LTSState a -> Bool #

(<=) :: LTSState a -> LTSState a -> Bool #

(>) :: LTSState a -> LTSState a -> Bool #

(>=) :: LTSState a -> LTSState a -> Bool #

max :: LTSState a -> LTSState a -> LTSState a #

min :: LTSState a -> LTSState a -> LTSState a #

Read a => Read (LTSState a) Source # 
Instance details

Defined in Data.LTS

Show a => Show (LTSState a) Source # 
Instance details

Defined in Data.LTS

Methods

showsPrec :: Int -> LTSState a -> ShowS #

show :: LTSState a -> String #

showList :: [LTSState a] -> ShowS #

Generic (LTSState a) Source # 
Instance details

Defined in Data.LTS

Associated Types

type Rep (LTSState a) :: Type -> Type #

Methods

from :: LTSState a -> Rep (LTSState a) x #

to :: Rep (LTSState a) x -> LTSState a #

type Rep (LTSState a) Source # 
Instance details

Defined in Data.LTS

type Rep (LTSState a) = D1 (MetaData "LTSState" "Data.LTS" "LTS-0.1.0.0-LMCmeFMnp4HKv6s7g1TTv7" False) (C1 (MetaCons "LTSState" PrefixI True) (S1 (MetaSel (Just "stateId") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int) :*: S1 (MetaSel (Just "out") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)))

data Transition a b Source #

Transition models that on a LTSState, given input symbol from an alphabet [b], | takes to the next LTSState

Instances
(Eq a, Eq b) => Eq (Transition a b) Source # 
Instance details

Defined in Data.LTS

Methods

(==) :: Transition a b -> Transition a b -> Bool #

(/=) :: Transition a b -> Transition a b -> Bool #

(Eq a, Eq b) => Ord (Transition a b) Source #

Define Ord instance for Transition

Instance details

Defined in Data.LTS

Methods

compare :: Transition a b -> Transition a b -> Ordering #

(<) :: Transition a b -> Transition a b -> Bool #

(<=) :: Transition a b -> Transition a b -> Bool #

(>) :: Transition a b -> Transition a b -> Bool #

(>=) :: Transition a b -> Transition a b -> Bool #

max :: Transition a b -> Transition a b -> Transition a b #

min :: Transition a b -> Transition a b -> Transition a b #

(Read a, Read b) => Read (Transition a b) Source # 
Instance details

Defined in Data.LTS

(Show a, Show b) => Show (Transition a b) Source # 
Instance details

Defined in Data.LTS

Methods

showsPrec :: Int -> Transition a b -> ShowS #

show :: Transition a b -> String #

showList :: [Transition a b] -> ShowS #

Generic (Transition a b) Source # 
Instance details

Defined in Data.LTS

Associated Types

type Rep (Transition a b) :: Type -> Type #

Methods

from :: Transition a b -> Rep (Transition a b) x #

to :: Rep (Transition a b) x -> Transition a b #

type Rep (Transition a b) Source # 
Instance details

Defined in Data.LTS

type Rep (Transition a b) = D1 (MetaData "Transition" "Data.LTS" "LTS-0.1.0.0-LMCmeFMnp4HKv6s7g1TTv7" False) (C1 (MetaCons "Transition" PrefixI True) (S1 (MetaSel (Just "transitionFrom") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (LTSState a)) :*: (S1 (MetaSel (Just "transitionGuard") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 b) :*: S1 (MetaSel (Just "transitionTo") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (LTSState a)))))

type LTS a b = [Transition a b] Source #

LTS is a list of Transition

checkTrans :: (Eq a, Eq b) => LTSState a -> LTS a b -> Bool Source #

Check if the set of transitions has same origin

getFromIds :: (Eq a, Eq b) => LTS a b -> [Int] Source #

Sorting related functions | Get origin LTSState ids

getToIds :: (Eq a, Eq b) => LTS a b -> [Int] Source #

Get final LTSState ids

sortById :: Eq a => [LTSState a] -> [LTSState a] Source #

Sort LTSStates by Id

sortByToSt :: (Eq a, Eq b) => LTS a b -> LTS a b Source #

Sort transitions by to LTSState

sortByFromSt :: (Eq a, Eq b) => LTS a b -> LTS a b Source #

Sort transitions by from LTSState

collectTrans :: (Eq a, Eq b) => LTSState a -> LTS a b -> Bool -> LTS a b Source #

Compute set of transitions (that can be ordered using a flag b) from a given LTSState

getStartSt :: (Eq a, Eq b) => LTS a b -> LTSState a Source #

Get the start LTSState

getFinalSt :: (Eq a, Eq b) => LTS a b -> LTSState a Source #

Get the final LTSState

depth :: (Eq a, Eq b) => LTS a b -> LTSState a -> Nat Source #

Compute depth of a transition system which is the longest simple path | from the start state to a final state

type Alphabet b = [b] Source #

Alphabet is a generic list

findTransIndex :: (Eq a, Eq b) => LTSState a -> b -> LTS a b -> Int Source #

Return the index of the Transition that current state can take on input symbol

transExists :: (Eq a, Eq b) => LTSState a -> b -> LTS a b -> Bool Source #

Check if transition exists from a given symbol from Alphabet and LTSState