packages feed

dtmc (empty) → 0.2.0.0

raw patch · 66 files changed

+14045/−0 lines, 66 filesdep +QuickCheckdep +arraydep +base

Dependencies added: QuickCheck, array, base, containers, dtmc, finite-typelits, hmatrix, hspec, mwc-random, primitive

Files

+ CHANGELOG.md view
@@ -0,0 +1,49 @@+# Changelog++## 0.2.0.0++First Hackage release.++- Added validated dense and sparse probability distributions.+- Added type-safe finite transition matrices and locally finite transition+  kernels, with representation-independent finite-horizon evolution and+  simulation.+- Added finite-time joint and conditional probabilities.+- Added exact-time, bounded, eventual, competing, and expected hitting and+  return quantities.+- Added finite- and infinite-horizon visit-count analysis, including the+  occupation matrix.+- Added communicating-class, recurrence, transience, periodicity, and cyclic+  class analysis.+- Added canonical decomposition, fundamental matrices, and absorption+  probabilities and expectations.+- Added extremal stationary distributions for every recurrent class, ordinary+  limiting matrices, and cyclic subsequential limits.+- Added state-labelled and list-based construction and inspection. No+  `hmatrix` type appears in the public API.+- Changed the internal dense storage of `DistributionVector` and+  `TransitionMatrix` from statically sized values to ordinary `hmatrix`+  vectors and matrices. The public types remain state-indexed and abstract,+  and their smart constructors continue to validate dimensions against the+  finite state cardinality.+- Added `Dtmc.Distribution.Map.mapStates` for transforming sparse+  distributions, combining the weights of states that share a target.+- Added `Dtmc.Transition.Matrix.fromRows`, which builds a matrix from a grid+  of weights and reports shape mismatches as typed errors.+- Made GTH stationary-distribution normalisation robust when finite weights+  have a sum that overflows `Double`.+- Reduced dense transition-row lookup from quadratic to linear time and+  space.+- Made `Dtmc.Distribution.Vector.fromList` positional: it now takes one weight+  per state in canonical state order, so it is the exact inverse of `toList`,+  and reports a length mismatch through the new `DistributionVectorError`.+  Labelled construction, where duplicates combine and missing states default+  to zero, remains `Dtmc.Distribution.Map.fromList`.+- Supports GHC 9.6 through 9.14.+- Narrowed `Dtmc.Analysis.Classification` to the queries themselves. The+  `Classification` report and `classify` are no longer exported, and with them+  the `Of` suffixes that existed only to keep record fields from colliding+  with the standalone functions. `absorbingStates`, `chainPeriod` and+  `ergodic` are now functions on a matrix, and `communicatingClasses` returns+  `[CommClass state]`, carrying each class's period and closedness rather than+  its members alone.
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2026 Arkadii Kholmetskii++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the copyright holder 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.
+ README.md view
@@ -0,0 +1,251 @@+# dtmc++Type-safe discrete-time Markov chains for Haskell.++`dtmc` supports both finite chains and locally finite kernels over countable+state spaces. It validates probability data at construction, keeps finite+models tied to their state type, and provides finite-time, structural, and+long-run analysis alongside simulation.++## Features++- Dense transition matrices indexed by domain-specific finite state types.+- Sparse transition kernels for finite or potentially infinite state spaces.+- Validated dense and sparse probability distributions.+- Distribution evolution, transition probabilities, timed events, and+  conditional probabilities.+- Hitting times, first-return times, and finite or total visit counts.+- Communicating classes, recurrence, periodicity, and absorbing states.+- Canonical decomposition, fundamental matrices, and absorption analysis.+- Stationary distributions, ordinary limits, and cyclic subsequential limits.+- Random sampling and trajectory simulation through either representation.+- No `hmatrix` types in the public API.++## Installation++Add the package to your Cabal file:++```cabal+build-depends: dtmc ^>=0.2.0.0+```++The package requires GHC 9.6 or newer and a BLAS/LAPACK implementation for+its internal use of `hmatrix`. On Ubuntu or Debian:++```bash+sudo apt-get install libblas-dev liblapack-dev+```++On macOS, `hmatrix` can use Apple Accelerate.++## Quick start++This complete example defines a two-state weather chain and asks three+different probability questions:++```haskell+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}++module Main (main) where++import Dtmc.Analysis.Event (DiscreteEvent (..))+import Dtmc.Analysis.FiniteTime qualified as FiniteTime+import Dtmc.Analysis.HittingTime qualified as HittingTime+import Dtmc.Distribution.Vector (DistributionVector)+import Dtmc.Distribution.Vector qualified as Vector+import Dtmc.State (FiniteState)+import Dtmc.Transition.Matrix (TransitionMatrix)+import Dtmc.Transition.Matrix qualified as Matrix+import GHC.Generics (Generic)++data Weather = Dry | Wet+  deriving (Eq, Ord, Show, Generic, FiniteState)++weather :: TransitionMatrix Weather+weather =+  checked $+    Matrix.fromRows+      [ [0.9, 0.1]+      , [0.4, 0.6]+      ]++initial :: DistributionVector Weather+initial = checked (Vector.fromList [1, 0])++checked :: Show problem => Either problem value -> value+checked = either (error . show) id++main :: IO ()+main = do+  -- P(X_2 = Wet | X_0 = Dry)+  print (FiniteTime.nStepProbability 2 weather Dry Wet)++  -- P(H_Wet <= 2) under the initial distribution+  print (HittingTime.probability (AtMost 2) weather (== Wet) initial)++  -- P(H_Wet < infinity) under the initial distribution+  print (HittingTime.eventualProbability weather [Wet] initial)+```++Constructor order is the canonical state order. The rows and columns above+therefore represent `Dry` followed by `Wet`; `Vector.fromList` uses the same+order. Invalid dimensions, weights, or row sums are returned as typed errors.++The two hitting queries take their target differently, and the difference is+not cosmetic. A bounded query walks forward a fixed number of steps, so it+works through any `Transition` — including a kernel over an infinite state+space — and takes a predicate. An eventual query solves a linear system over+the whole state space, so it requires a finite `TransitionMatrix`, takes an+explicit target list, and returns `Either LinearSystemError`.++Analysis modules intentionally use concise, overlapping names such as+`probability` and `expectation`. Import them qualified, as in the example.+The top-level `Dtmc` module is an orientation and module map rather than a+facade of re-exports.++## Choosing a representation++| State space | Transitions | Initial distribution | Capabilities |+| --- | --- | --- | --- |+| Finite | `TransitionMatrix` | `DistributionVector` or `DistributionMap` | Complete finite-time, structural, and long-run analysis; simulation |+| Finite | `TransitionKernel` | `DistributionVector` or `DistributionMap` | Finite-horizon analysis; simulation |+| Potentially infinite | `TransitionKernel` | Finite-support `DistributionMap` | Finite-horizon analysis; simulation |++A `TransitionKernel` does not enumerate its state space. It only requires each+one-step transition law to have finite support, so the same finite-horizon+algorithms work without global truncation. Analyses that need the complete+state space require a finite `TransitionMatrix`.++### Finite states++For a named enumeration, derive `Generic` and `FiniteState`:++```haskell+data Queue = Empty | Busy | Full+  deriving (Eq, Ord, Show, Generic, FiniteState)+```++Constructors must have no fields. Their declaration order determines the+canonical order used by vectors, matrices, and whole-state results. Use+`Finite n` when names are unnecessary. Instances are also provided for `()`,+`Bool`, and `Ordering`.++### Locally finite kernels++A kernel is a function from a state to a validated sparse distribution:++```haskell+import Dtmc.Distribution (DistributionError)+import Dtmc.Distribution.Map qualified as Distribution+import Dtmc.Transition.Kernel (TransitionKernel)+import Dtmc.Transition.Kernel qualified as Kernel++countUp :: TransitionKernel Integer+countUp = Kernel.fromLaws (Distribution.pointMass . (+ 1))++randomWalk :: Either DistributionError (TransitionKernel Integer)+randomWalk = do+  stepLaw <- Distribution.fromList [(-1, 0.5), (1, 0.5)]+  pure $+    Kernel.fromLaws $ \position ->+      Distribution.mapStates (+ position) stepLaw+```++The random walk has an infinite reachable state space, while every individual+transition law remains finite.++## Construction guide++| Value | Constructor | Notes |+| --- | --- | --- |+| Sparse distribution | `Dtmc.Distribution.Map.fromList` | State-labelled; duplicate states combine |+| Point mass | `Dtmc.Distribution.Map.pointMass` | Concentrates probability on one state |+| Dense finite distribution | `Dtmc.Distribution.Vector.fromList` | One weight per state in canonical order |+| Transition kernel | `Dtmc.Transition.Kernel.fromLaws` | Accepts validated finite-support laws |+| Transition matrix | `Dtmc.Transition.Matrix.fromRows` | Plain row-major lists in canonical order |+| Matrix from a kernel | `Dtmc.Transition.Matrix.fromKernel` | Materializes a finite-state kernel |++Transition matrices can be combined with `compose`, `identity`, and `power`.+Both matrix and vector values are abstract and nominally associated with their+state type, preventing accidental use with a different finite model.++## Analysis guide++| Task | Module |+| --- | --- |+| Evolve distributions | `Dtmc.Dynamics` |+| Transition and timed-observation probabilities | `Dtmc.Analysis.FiniteTime` |+| Hitting times and races between target sets | `Dtmc.Analysis.HittingTime` |+| First-return times | `Dtmc.Analysis.ReturnTime` |+| Bounded and total visit counts; occupation matrix | `Dtmc.Analysis.VisitCount` |+| Communication, recurrence, and periodicity | `Dtmc.Analysis.Classification` |+| Fundamental matrix and absorption quantities | `Dtmc.Analysis.Absorption` |+| Extremal stationary distributions | `Dtmc.Analysis.Stationary` |+| Ordinary and cyclic long-run limits | `Dtmc.Analysis.Limiting` |+| Sampling and trajectories | `Dtmc.Simulation` |++Functions ending in `GivenInitialState` condition on a particular starting+state. Their shorter counterparts accept any compatible `Distribution`.++### Discrete events++Hitting, return, and visit-count queries use `DiscreteEvent`:++| Constructor | Event for `Y` |+| --- | --- |+| `EqualTo n` | `Y = n` |+| `LessThan n` | `Y < n` |+| `AtMost n` | `Y <= n` |+| `GreaterThan n` | `Y > n` |+| `AtLeast n` | `Y >= n` |++For a quantity that may be infinite, `GreaterThan` and `AtLeast` include its+mass at infinity. Eventual hitting, eventual return, and infinitely many+visits remain explicit operations because they require finite-state analysis.++## Validation and numerical behavior++Distribution constructors reject non-finite values and repair coordinate or+total-mass error only within `1e-9`. Tolerated coordinate error is clamped to+`[0, 1]`, then the repaired weights are normalized. Transition-matrix rows+follow the same policy.++Structural analysis is combinatorial: a stored matrix entry is an edge exactly+when it is greater than zero, with no floating-point tolerance. Numerical+analyses use checked `Double` linear algebra and return+`Either LinearSystemError result` on failure. Computed results are not silently+clamped or renormalized, and mathematically infinite expectations are reported+as `InfiniteExpectation` rather than floating-point infinity.++See each module's Haddock documentation for edge cases and complexity bounds.++## Building from source++```bash+git clone https://github.com/kholmetskii/dtmc.git+cd dtmc+cabal update+cabal build all --enable-tests+cabal test all --test-show-details=direct+```++Generate local API documentation with:++```bash+cabal haddock all --haddock-hyperlink-source+```++The package is tested with GHC 9.6.7, 9.8.4, 9.10.3, 9.12.4, and 9.14.1.++## Documentation and support++- Browse the [Haddock API documentation](https://hackage.haskell.org/package/dtmc/docs/Dtmc.html).+- Report bugs or request features in the [issue tracker](https://github.com/kholmetskii/dtmc/issues).+- See the [changelog](https://hackage.haskell.org/package/dtmc/changelog) for+  release notes.++## License++`dtmc` is distributed under the BSD 3-Clause License; see the `LICENSE` file+in the source distribution.
+ dtmc.cabal view
@@ -0,0 +1,151 @@+cabal-version:      3.0+name:               dtmc+version:            0.2.0.0+synopsis:           Type-safe discrete-time Markov chains+description:+  Type-safe finite discrete-time Markov chains with matrix and kernel+  representations, plus locally finite countable-state kernels for exact+  finite-horizon analysis and simulation.+  The package provides validated probability laws, finite-time joint and+  conditional probabilities, hitting and return quantities, visit counts,+  communicating-class analysis, canonical decomposition, absorption,+  stationary distributions, and ordinary and cyclic limiting behaviour.+category:           Math, Probability+homepage:           https://github.com/kholmetskii/dtmc+bug-reports:        https://github.com/kholmetskii/dtmc/issues+license:            BSD-3-Clause+license-file:       LICENSE+author:             Arkadii Kholmetskii+maintainer:         Arkadii Kholmetskii <373321aa@gmail.com>+copyright:          2026 Arkadii Kholmetskii+build-type:         Simple+tested-with:+    GHC ==9.6.7+  , GHC ==9.8.4+  , GHC ==9.10.3+  , GHC ==9.12.4+  , GHC ==9.14.1+extra-doc-files:+    README.md+    CHANGELOG.md++common lang+  default-language: GHC2021++  default-extensions:+      DataKinds+    , RoleAnnotations+    , TypeFamilies++  ghc-options:+      -Wall+      -Wcompat+      -Wincomplete-uni-patterns+      -Wredundant-constraints++library+  import:           lang+  hs-source-dirs:   src++  exposed-modules:+      Dtmc+      Dtmc.Simplex+      Dtmc.State+      Dtmc.Distribution+      Dtmc.Distribution.Vector+      Dtmc.Distribution.Map+      Dtmc.Transition+      Dtmc.Transition.Matrix+      Dtmc.Transition.Kernel+      Dtmc.Simulation+      Dtmc.Dynamics+      Dtmc.Analysis.Event+      Dtmc.Analysis.FiniteTime+      Dtmc.Analysis.Expectation+      Dtmc.Analysis.Limiting+      Dtmc.Analysis.LinearSystem+      Dtmc.Analysis.HittingTime+      Dtmc.Analysis.ReturnTime+      Dtmc.Analysis.VisitCount+      Dtmc.Analysis.Absorption+      Dtmc.Analysis.Classification+      Dtmc.Analysis.Stationary++  other-modules:+      Dtmc.Distribution.Vector.Internal+      Dtmc.Distribution.Map.Internal+      Dtmc.Transition.Matrix.Internal+      Dtmc.Simplex.Internal+      Dtmc.Analysis.FiniteTime.Internal+      Dtmc.Analysis.Classification.Internal+      Dtmc.Analysis.LinearSystem.Internal+      Dtmc.Analysis.Initial.Internal+      Dtmc.Transition.Matrix.Internal.Graph+      Dtmc.Dynamics.Internal+      Dtmc.State.Internal++  build-depends:+      base >=4.18 && <5+    , array >=0.5.8 && <0.6+    , containers >=0.6.7 && <0.8+    , finite-typelits >=0.2.0.1 && <0.3+    , hmatrix >=0.20.2 && <0.21+    , mwc-random >=0.15.0.1 && <0.16+    , primitive >=0.9 && <0.10++test-suite spec+  import:           lang+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          Spec.hs++  other-modules:+      Dtmc.Distribution.VectorSpec+      Dtmc.Distribution.MapSpec+      Dtmc.Distribution.InterfaceSpec+      Dtmc.StateSpec+      Dtmc.Transition.MatrixSpec+      Dtmc.SimulationSpec+      Dtmc.DynamicsSpec+      Dtmc.Analysis.EventSpec+      Dtmc.Analysis.FiniteTimeCanonicalSpec+      Dtmc.Analysis.HittingTimeCanonicalSpec+      Dtmc.Analysis.CanonicalDifferentialSpec+      Dtmc.Analysis.NamespaceCompileSpec+      Dtmc.Analysis.ProbabilityOracle+      Dtmc.Analysis.FiniteTimeSpec+      Dtmc.Analysis.AbsorptionSpec+      Dtmc.Analysis.ClassificationSpec+      Dtmc.Analysis.ReturnTimeCanonicalSpec+      Dtmc.Analysis.VisitCountCanonicalSpec+      Dtmc.Analysis.HittingTimeSpec+      Dtmc.Analysis.ReturnTimeSpec+      Dtmc.Analysis.VisitCountSpec+      Dtmc.Analysis.LimitingSpec+      Dtmc.Analysis.StationarySpec+      Dtmc.Analysis.TimeSpecSupport+      Dtmc.Transition.KernelSpec+      Dtmc.Transition.InterfaceSpec+      Dtmc.IntegrationSpec+      Dtmc.TestSupport++  build-depends:+      base+    , containers+    , dtmc+    , finite-typelits+    , hspec >=2.11.17 && <2.12+    , mwc-random+    , QuickCheck >=2.18 && <2.19++  build-tool-depends:+      hspec-discover:hspec-discover >=2.11.17 && <2.12++source-repository head+  type:             git+  location:         https://github.com/kholmetskii/dtmc.git++source-repository this+  type:             git+  location:         https://github.com/kholmetskii/dtmc.git+  tag:              v0.2.0.0
+ src/Dtmc.hs view
@@ -0,0 +1,45 @@+{- |+Module      : Dtmc+Description : Orientation and module map for discrete-time Markov chains.++This package models time-homogeneous discrete-time Markov chains (DTMCs).+It supports two complementary representations:++* finite chains over a 'Dtmc.State.FiniteState' use+  'Dtmc.Transition.Matrix.TransitionMatrix' and may use dense+  'Dtmc.Distribution.Vector.DistributionVector' values;+* locally finite chains over unrestricted state types use+  'Dtmc.Transition.Kernel.TransitionKernel' and sparse+  'Dtmc.Distribution.Map.DistributionMap' values.++Start with these modules:++* "Dtmc.State" for finite named state types;+* "Dtmc.Distribution.Map" and "Dtmc.Distribution.Vector" for validated+  probability laws;+* "Dtmc.Transition.Kernel" and "Dtmc.Transition.Matrix" for transition+  models;+* "Dtmc.Dynamics" and "Dtmc.Simulation" for evolution and sampling.++Analysis is organised by mathematical subject:++* "Dtmc.Analysis.FiniteTime" for transition, joint, and conditional+  probabilities;+* "Dtmc.Analysis.HittingTime", "Dtmc.Analysis.ReturnTime", and+  "Dtmc.Analysis.VisitCount" for path-time and occupation quantities;+* "Dtmc.Analysis.Classification" for communication, recurrence, and+  periodicity;+* "Dtmc.Analysis.Absorption", "Dtmc.Analysis.Stationary", and+  "Dtmc.Analysis.Limiting" for finite-chain long-run behaviour.++The package deliberately has no broad facade of re-exports because several+analysis modules use the same concise names, such as @probability@ and+@expectation@, for their subject-specific operations. Import analysis modules+qualified.++No @hmatrix@ type appears anywhere in the public API: values are built from+and inspected as plain lists of weights. The package still uses @hmatrix@+internally and therefore requires a BLAS/LAPACK implementation when it is+built.+-}+module Dtmc () where
+ src/Dtmc/Analysis/Absorption.hs view
@@ -0,0 +1,286 @@+{- |+Module      : Dtmc.Analysis.Absorption+Description : Canonical decomposition, fundamental matrix, and absorption.++Absorption analysis for a finite chain. Ordering the states so that the+transient set @T@ comes first and the recurrent set @R@ last puts the+transition matrix in block form++@+P = [ Q  R' ]+    [ 0  S  ]+@++and the fundamental matrix of the transient block is+@G = sum_(n >= 0) Q^n = (I - Q)^-1@, whose entry @G(i,j)@ is the expected+number of visits to @j@ starting from @i@ for transient @i@ and @j@.++Every finite chain has this decomposition, including the degenerate cases+@T = empty@ (no transient states) and a single recurrent class. No witness+type is required: unlike stationarity, the analysis is defined for every+finite transition matrix.++Absorption probabilities are @B = G R'@, where @B(i,k)@ is the probability+that the /first/ recurrent state the chain visits is @k@. This is not the+same as the probability of ever visiting @k@: a recurrent class with more+than one state can be entered at one member and later reach another, which+'Dtmc.Analysis.HittingTime.eventualProbability' counts and @B@ does not. The+two agree only after summing over a whole recurrent class.++Unless stated otherwise, complexity bounds exclude 'FiniteState' method+costs. For those bounds, @n@ is the state count, @E@ the support-edge count,+@t@ the transient-state count, and @s@ an initial distribution's stored+support size.+-}+module Dtmc.Analysis.Absorption (+    -- * Result types+    LinearSystemError (..),+    Expectation (..),++    -- * Canonical decomposition+    canonicalOrder,+    fundamentalMatrix,++    -- * Absorption probabilities+    probability,+    probabilityGivenInitialState,++    -- * Expected time to absorption+    expectation,+    expectationGivenInitialState,+) where++import Data.Array.Unboxed qualified as Unboxed+import Dtmc.Analysis.Classification (+    recurrentState,+    recurrentStates,+    transientStates,+ )+import Dtmc.Analysis.Expectation (+    Expectation (..),+ )+import Dtmc.Analysis.HittingTime qualified as Hitting+import Dtmc.Analysis.Initial.Internal (+    expectationUnderEither,+    probabilityUnderEither,+ )+import Dtmc.Analysis.LinearSystem (+    LinearSystemError (..),+ )+import Dtmc.Analysis.LinearSystem.Internal (+    fundamental,+    subMatrix,+ )+import Dtmc.Distribution (+    Distribution (..),+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.State.Internal (+    stateCardinalityInt,+    stateIndexInt,+ )+import Dtmc.Transition.Matrix.Internal (+    TransitionMatrix,+    unTransitionMatrix,+ )+import Numeric.LinearAlgebra qualified as LA++toIndex :: (FiniteState state) => state -> Int+toIndex = stateIndexInt++{- | Return the transient and recurrent states, each in the canonical order+of the 'FiniteState' instance. This ordering puts the matrix in block form+and indexes the rows and columns of 'fundamentalMatrix'.++Membership is decided from the support graph, so the split is exact and+involves no floating-point comparison.++Complexity: with shared graph facts cached, @O(n)@ time and @O(n)@ temporary+and result space. On an unforced matrix, the first full evaluation takes+@O(n^2 + (n + E) log(n + 1))@ time, @O(n^2 + n + E)@ temporary space, and+retains @O(n + E)@ graph-cache space.+-}+canonicalOrder ::+    (FiniteState state) =>+    TransitionMatrix state ->+    ([state], [state])+canonicalOrder p =+    (transientStates p, recurrentStates p)++{- | Compute the fundamental matrix @G = (I - Q)^-1@ of the transient block,+together with the transient states that index its rows and columns.++Entry @(i,j)@ is @E(V_j | X_0 = i)@, the expected number of visits to+transient @j@ from transient @i@. Every entry is finite, so the result uses+'Double' rather than 'Expectation'.+'Dtmc.Analysis.VisitCount.totalExpectation' gives the same entries one at a+time and extends to recurrent targets, where the value is infinite.++A chain with no transient states returns @([], [])@ without a solve.+Otherwise the numerical behaviour and errors of the shared @(I - Q)@ solver+apply; @rho(Q) < 1@ holds in exact arithmetic because every transient state+reaches a recurrent one.++Complexity: including first-time graph classification,+@O(n^2 + (n + E) log(n + 1) + t^3)@ time,+@O(n^2 + n + E + t^2)@ temporary space, @O(n + E)@ retained graph-cache+space, and @O(t^2)@ result space.+-}+fundamentalMatrix ::+    (FiniteState state) =>+    TransitionMatrix state ->+    Either LinearSystemError ([state], [[Double]])+fundamentalMatrix p+    | null transient = Right ([], [])+    | otherwise = do+        g <- fundamental (subMatrix transientIdx transientIdx matrix)+        pure (transient, LA.toLists g)+  where+    transient = transientStates p+    transientIdx = map toIndex transient+    matrix = unTransitionMatrix p++{- | Compute absorption probabilities into one recurrent state in canonical+state order. Coordinate @i@ is the probability that the supplied target is+the first recurrent state visited when starting from @i@.++Boundary values are exact and taken without a solve:++* a target that is not recurrent gives an all-zero vector;+* a recurrent starting state has already arrived, so its coordinate is @1@+  when it is the target and @0@ otherwise.++Transient coordinates are the corresponding column of @B = G R'@ and inherit+the numerical behaviour and errors of 'fundamentalMatrix'.++Complexity: including first-time graph classification,+@O(n^2 + (n + E) log(n + 1) + t^3)@ worst-case time,+@O(n^2 + n + E + t^2)@ temporary space, @O(n + E)@ retained graph-cache+space, and @O(n)@ result space. A non-recurrent target avoids the numerical+solve.+-}+probabilityByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    Either LinearSystemError (LA.Vector Double)+probabilityByState p target+    | not (recurrentState p target) =+        Right (LA.fromList (replicate dim 0))+    | null transientIdx =+        Right (LA.fromList [arrived i | i <- [0 .. dim - 1]])+    | otherwise = do+        g <- fundamental (subMatrix transientIdx transientIdx matrix)+        let exits = LA.flatten (subMatrix transientIdx [targetIdx] matrix)+            solved = LA.toList (g LA.#> exits)+            interior :: Unboxed.UArray Int Double+            interior =+                Unboxed.accumArray+                    (\_ x -> x)+                    0+                    (0, dim - 1)+                    (zip transientIdx solved)+            valueAt i+                | transientMask Unboxed.! i = interior Unboxed.! i+                | otherwise = arrived i+        pure (LA.fromList [valueAt i | i <- [0 .. dim - 1]])+  where+    dim = stateCardinalityInt @state+    matrix = unTransitionMatrix p+    targetIdx = toIndex target+    transientIdx = map toIndex (transientStates p)+    transientMask :: Unboxed.UArray Int Bool+    transientMask =+        Unboxed.accumArray+            (\_ x -> x)+            False+            (0, dim - 1)+            [(i, True) | i <- transientIdx]+    arrived i = if i == targetIdx then 1 else 0++{- | Compute, under an arbitrary initial distribution, the probability that+the supplied target is the first recurrent state visited. The result is the+initial-law mixture of the state-conditioned absorption probabilities. A+non-recurrent target gives exactly zero without a numerical solve.++Complexity: excluding 'distributionWeights', @O(n^3 + s)@ worst-case time,+@O(n^2 + s)@ temporary space, and @O(1)@ result space. The matrix may retain+@O(n + E)@ graph-cache space.+-}+probability ::+    ( FiniteState state+    , Distribution distribution+    , DistributionState distribution ~ state+    ) =>+    TransitionMatrix state ->+    state ->+    distribution ->+    Either LinearSystemError Double+probability p target initial =+    probabilityUnderEither initial (probabilityGivenInitialState p target)++{- | Compute the probability that the supplied target is the first recurrent+state visited, conditioned on @X_0 = i@. A recurrent initial state is already+absorbed at time zero.++Partial application shares one lazy all-state table. A non-recurrent target+produces exact zeros without a numerical solve.++Complexity: the first forced query takes @O(n^3)@ worst-case time and+@O(n^2)@ temporary space and may retain an @O(n)@ all-state result and+@O(n + E)@ graph cache. Subsequent shared lookups take @O(1)@ time and+space; the scalar result occupies @O(1)@ space.+-}+probabilityGivenInitialState ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    state ->+    Either LinearSystemError Double+probabilityGivenInitialState p target =+    \i -> (`LA.atIndex` toIndex i) <$> values+  where+    values = probabilityByState p target++{- | Compute the expected number of transitions until the chain first enters+the recurrent states under an arbitrary initial distribution. The value is+mathematically finite for every valid finite chain; numerical failures come+from the checked transient-state solve.++Complexity: excluding 'distributionWeights', @O(n^3 + s)@ worst-case time,+@O(n^2 + s)@ temporary space, and @O(1)@ result space. The matrix may retain+@O(n + E)@ graph-cache space.+-}+expectation ::+    ( FiniteState state+    , Distribution distribution+    , DistributionState distribution ~ state+    ) =>+    TransitionMatrix state ->+    distribution ->+    Either LinearSystemError Expectation+expectation p initial =+    expectationUnderEither initial (expectationGivenInitialState p)++{- | Compute the expected number of transitions until the chain first enters+the recurrent states, conditioned on @X_0 = i@. A recurrent initial state has+expectation zero; every transient state has a mathematically finite value.++Partial application shares the lazy all-state result of the checked+transient-state solve.++Complexity: the first forced query takes @O(n^3)@ worst-case time and+@O(n^2)@ temporary space and may retain an @O(n)@ all-state result and+@O(n + E)@ graph cache. Subsequent shared lookups take @O(1)@ time and+space; the scalar result occupies @O(1)@ space.+-}+expectationGivenInitialState ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    Either LinearSystemError Expectation+expectationGivenInitialState p =+    Hitting.expectationGivenInitialState p (recurrentStates p)
+ src/Dtmc/Analysis/Classification.hs view
@@ -0,0 +1,384 @@+{-# LANGUAGE ExplicitNamespaces #-}++{- |+Module      : Dtmc.Analysis.Classification+Description : Communication, irreducibility, periodicity, and recurrence.++Qualitative DTMC properties derived from the support graph of @P@: there is an+edge @i -> j@ exactly when the stored @P(i,j) > 0@. The comparison has no+tolerance, so a tiny positive value is a transition while zero or a negative+value is not. Results depend on which entries are positive, not their+magnitudes. Recurrence statements assume a finite, valid transition matrix.+Queries accept named state constructors through 'FiniteState'; state lists are+returned in the canonical order of that instance.++For the complexity bounds, @n@ is the number of states and @E@ is the number+of strictly positive entries. The stated per-operation bounds exclude+'FiniteState' method costs and construction of the shared support graph. Its+first use adds @O(n^2)@ time and temporary space and retains @O(n + E)@ cache+space. Strong components, closedness, periods, and phases are also computed+lazily and shared by later queries on the same matrix.++A @0 x 0@ matrix has no communicating classes and is neither irreducible nor+aperiodic here.+-}+module Dtmc.Analysis.Classification (+    -- * Reachability+    supportEdge,+    accessible,+    reachesAny,+    communicates,++    -- * Communicating classes+    type CommClass (..),+    communicatingClasses,+    irreducible,++    -- * Periodicity+    period,+    chainPeriod,+    aperiodic,+    cyclicClasses,++    -- * Recurrence and transience+    recurrentState,+    transientState,+    recurrentStates,+    transientStates,+    absorbingStates,++    -- * Ergodicity+    ergodic,+) where++import Data.Array qualified as Array+import Data.Maybe (+    fromMaybe,+ )+import Dtmc.Analysis.Classification.Internal (+    type Classification (..),+    type CommClass (..),+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.State.Internal (+    stateFromInt,+    stateIndexInt,+ )+import Dtmc.Transition.Matrix.Internal (TransitionMatrix, tmSupport)+import Dtmc.Transition.Matrix.Internal.Graph qualified as G+import Numeric.Natural (Natural)++toState :: (FiniteState state) => Int -> state+toState index =+    fromMaybe+        (error "Dtmc.Analysis.Classification: graph vertex out of bounds")+        (stateFromInt index)++toIndex :: (FiniteState state) => state -> Int+toIndex = stateIndexInt++{- | Test whether @P(i,j) > 0@, so that the support graph contains the direct+edge @i -> j@. No tolerance is applied.++Complexity: excluding shared support-graph construction, @O(d_i)@ time and+@O(1)@ temporary and result space for out-degree @d_i@ of state @i@.+-}+supportEdge ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    state ->+    Bool+supportEdge p i j = G.hasEdge (tmSupport p) (toIndex i) (toIndex j)++{- | Test whether @j@ is reachable from @i@ in zero or more transitions.+Every state is therefore reachable from itself, even without a self-loop.++Complexity: excluding shared support-graph construction, @O(n + E)@ time,+@O(n)@ temporary space, and @O(1)@ result space.+-}+accessible ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    state ->+    Bool+accessible p i j = G.reachable (tmSupport p) (toIndex i) (toIndex j)++{- | Test whether any supplied target is reachable from @i@ in zero or more+transitions. An empty target list gives 'False'; including @i@ gives 'True'.++The graph is traversed once rather than once per target.++Complexity: excluding shared support-graph construction, @O(n + E + t)@+worst-case time, @O(n + t)@ temporary space, and @O(1)@ result space for @t@+supplied targets.+-}+reachesAny ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    [state] ->+    Bool+reachesAny p i targets =+    G.reachesAny (tmSupport p) (toIndex i) (map toIndex targets)++{- | Test whether @i@ and @j@ communicate, meaning that each is reachable+from the other. This is an equivalence relation on the state space.++Complexity: excluding shared support-graph construction, the first query+takes @O(n + E + n log(n + 1))@ time and @O(n + E)@ temporary space and+retains @O(n)@ component-cache space; subsequent queries take @O(1)@ time.+Temporary and result space per cached query are @O(1)@.+-}+communicates ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    state ->+    Bool+communicates p i j =+    G.sameComponent (tmSupport p) (toIndex i) (toIndex j)++{- | Return the communicating classes, equivalently the strongly connected+components of the support graph, each with its period and whether it is+closed. States within each class are ascending, and classes are ordered by+their least member. For the members alone, use+@map 'classMembers' . communicatingClasses@.++Whole-chain queries in this module share one pass over the support graph.++Complexity: excluding shared support-graph construction, the first full+evaluation takes @O(n + E + n log(n + 1))@ time and @O(n + E)@ temporary+space and retains @O(n)@ component cache; subsequent evaluations take+@O(n)@ time and temporary space. Result space is @O(n)@.+-}+communicatingClasses ::+    (FiniteState state) =>+    TransitionMatrix state ->+    [CommClass state]+communicatingClasses = classesOf . classify++{- | Test whether every state communicates with every other state. The empty+chain is not irreducible.++Complexity: excluding shared support-graph construction, the first query+takes @O(n + E + n log(n + 1))@ time and @O(n + E)@ temporary space and+retains @O(n)@ component-cache space; subsequent queries take @O(1)@ time.+Temporary and result space per cached query are @O(1)@.+-}+irreducible :: TransitionMatrix state -> Bool+irreducible = graphIrreducible . tmSupport++graphIrreducible :: G.Graph -> Bool+graphIrreducible graph =+    case G.components graph of+        [component] -> not (null component)+        _ -> False++{- | Return the period of @i@:+@gcd { k >= 1 | (P^k)(i,i) > 0 }@. Returns 'Nothing' when @i@ has no+positive-length return path, necessarily a singleton class without a+self-transition.++Complexity: excluding shared support-graph construction, the first query+takes @O((n + E) log(n + 1))@ time and @O(n + E)@ temporary space and retains+@O(n)@ period-cache space; subsequent queries take @O(1)@ time. Temporary+and result space per cached query are @O(1)@.+-}+period ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    Maybe Natural+period p i = G.periodOf (tmSupport p) (toIndex i)++{- | Test whether every communicating class has period @1@. The empty chain+and a chain containing a class with undefined period are not aperiodic under+this definition.++Complexity: excluding shared support-graph construction, the first query+takes @O((n + E) log(n + 1))@ time and @O(n + E)@ temporary space and retains+@O(n)@ component and period cache; later queries take @O(c)@ time for @c@+communicating classes. Temporary and result space per cached query are+@O(1)@.+-}+aperiodic :: TransitionMatrix state -> Bool+aperiodic = graphAperiodic . tmSupport++graphAperiodic :: G.Graph -> Bool+graphAperiodic graph =+    not (null components)+        && all ((== Just 1) . G.componentPeriod graph) components+  where+    components = G.components graph++{- | Partition an irreducible chain of period @d@ into cyclic classes+@C_0, ..., C_(d-1)@. Every transition from @C_r@ enters+@C_((r+1) mod d)@; @C_0@ contains the least state. Returns 'Nothing' for a+reducible chain or an undefined period.++Complexity: excluding shared support-graph construction, the first full+evaluation takes @O((n + E) log(n + 1))@ time and @O(n + E)@ temporary space+and retains @O(n)@ component, period, and phase cache; later evaluations take+@O(n)@ time and temporary space. Result space is @O(n)@.+-}+cyclicClasses :: (FiniteState state) => TransitionMatrix state -> Maybe [[state]]+cyclicClasses p+    | not (irreducible p) = Nothing+    | otherwise =+        case G.periodOf g 0 of+            Nothing -> Nothing+            Just d ->+                let dInt = fromIntegral d+                    -- One pass buckets every vertex by its phase (@O(V + d)@),+                    -- rather than scanning all vertices once per phase.+                    buckets =+                        Array.accumArray+                            (flip (:))+                            []+                            (0, dInt - 1)+                            [(G.phaseOf g v, toState v) | v <- [0 .. G.graphDim g - 1]]+                 in Just [reverse (buckets Array.! r) | r <- [0 .. dInt - 1]]+  where+    g = tmSupport p++{- | Test whether the chain returns to @i@ with probability one when started+there. For a finite DTMC this holds exactly when @i@ belongs to a closed+communicating class.++Complexity: excluding shared support-graph construction, the first query+takes @O((n + E) log(n + 1))@ time and @O(n + E)@ temporary space and retains+@O(n)@ component-closedness cache; subsequent queries take @O(1)@ time.+Temporary and result space per cached query are @O(1)@.+-}+recurrentState ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    Bool+recurrentState p i = G.inClosedComponent (tmSupport p) (toIndex i)++{- | Test whether @i@ is transient, meaning that its return probability is+less than one. This is the negation of 'recurrentState' for a finite DTMC.++Complexity: excluding shared support-graph construction, the first query+takes @O((n + E) log(n + 1))@ time and @O(n + E)@ temporary space and retains+@O(n)@ component-closedness cache; subsequent queries take @O(1)@ time.+Temporary and result space per cached query are @O(1)@.+-}+transientState ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    Bool+transientState p i = not (recurrentState p i)++{- | Return the members of closed communicating classes, ordered by class and+state index. Every non-empty finite DTMC has at least one; the empty chain+returns the empty list.++Whole-chain queries in this module share one pass over the support graph.++Complexity: excluding shared support-graph construction, the first full+evaluation takes @O((n + E) log(n + 1))@ time and @O(n + E)@ temporary space+and retains @O(n)@ component and closedness cache; later evaluations take+@O(n)@ time and temporary space. Result space is @O(n)@.+-}+recurrentStates :: (FiniteState state) => TransitionMatrix state -> [state]+recurrentStates = recurrentStatesOf . classify++{- | Return the members of non-closed communicating classes, ordered by class+and state index. The result is empty exactly when every class is closed.++Whole-chain queries in this module share one pass over the support graph.++Complexity: excluding shared support-graph construction, the first full+evaluation takes @O((n + E) log(n + 1))@ time and @O(n + E)@ temporary space+and retains @O(n)@ component and closedness cache; later evaluations take+@O(n)@ time and temporary space. Result space is @O(n)@.+-}+transientStates :: (FiniteState state) => TransitionMatrix state -> [state]+transientStates = transientStatesOf . classify++{- | Return the states that form a communicating class on their own and cannot+be left. For exact stochastic rows these are the absorbing states, those with+@P(i,i) = 1@; numerically derived or otherwise unchecked rows are classified+only by strict-positive support.++Whole-chain queries in this module share one pass over the support graph.++Complexity: excluding shared support-graph construction, the first full+evaluation takes @O((n + E) log(n + 1))@ time and @O(n + E)@ temporary space+and retains @O(n)@ component and closedness cache; later evaluations take+@O(n)@ time and temporary space. Result space is @O(n)@.+-}+absorbingStates :: (FiniteState state) => TransitionMatrix state -> [state]+absorbingStates = absorbingStatesOf . classify++{- | Return the period shared by every state of an irreducible chain. Returns+'Nothing' for a reducible chain, where period is a per-class notion and+'period' should be used instead, and for a single class whose period is+undefined.++Whole-chain queries in this module share one pass over the support graph.++Complexity: excluding shared support-graph construction, the first query takes+@O((n + E) log(n + 1))@ time and @O(n + E)@ temporary space and retains @O(n)@+component and period cache; later queries take @O(1)@ time. Temporary and+result space per cached query are @O(1)@.+-}+chainPeriod :: (FiniteState state) => TransitionMatrix state -> Maybe Natural+chainPeriod = chainPeriodOf . classify++{- | Test whether the chain is irreducible and aperiodic. For a finite DTMC+this is the hypothesis under which @P^k@ converges to a matrix whose every row+is the unique stationary distribution, so 'Dtmc.Analysis.Limiting.converges'+holds and 'Dtmc.Analysis.Stationary.stationaryDistributions' returns exactly+one distribution.++Complexity: as 'irreducible' and 'aperiodic' together.+-}+ergodic :: TransitionMatrix state -> Bool+ergodic p = irreducible p && aperiodic p++{- | Build the complete class, period, recurrence, absorbing-state,+irreducibility, and aperiodicity report from one shared support graph. The+standalone whole-chain queries are focused projections of this report; scalar+reachability, period, and recurrence queries remain direct graph lookups.++Complexity: full evaluation on an unforced matrix takes+@O(n^2 + (n + E) log(n + 1))@ time, @O(n^2 + n + E)@ temporary space,+@O(n + E)@ retained graph-cache space, and @O(n)@ result space. With all+graph facts cached, it takes @O(n)@ time and @O(n)@ temporary and result+space.+-}+classify :: (FiniteState state) => TransitionMatrix state -> Classification state+classify p =+    Classification+        { classesOf = cs+        , isIrreducible = irreducible'+        , isAperiodic = aperiodic'+        , isErgodic = irreducible' && aperiodic'+        , chainPeriodOf = chainPeriodOf'+        , recurrentStatesOf = concatMap classMembers (filter classClosed cs)+        , transientStatesOf = concatMap classMembers (filter (not . classClosed) cs)+        , absorbingStatesOf = [i | cc <- cs, classClosed cc, [i] <- [classMembers cc]]+        }+  where+    g = tmSupport p+    cs =+        [ CommClass+            { classMembers = map toState c+            , classPeriod = G.periodOf g v+            , classClosed = G.inClosedComponent g v+            }+        | c@(v : _) <- G.components g+        ]+    irreducible' = graphIrreducible g+    aperiodic' = graphAperiodic g+    chainPeriodOf' = case cs of+        [c] -> classPeriod c+        _ -> Nothing
+ src/Dtmc/Analysis/Classification/Internal.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE ExplicitNamespaces #-}++{- |+Module      : Dtmc.Analysis.Classification.Internal+Description : Internal carriers and graph operations for chain classification.++Raw carrier types and solver-oriented graph operations behind+"Dtmc.Analysis.Classification": the per-class summary t'CommClass' and the+whole-chain structural report t'Classification'. This module exposes the+report constructor for trusted internal use; constructing it here may produce+summary fields inconsistent with its communicating classes.+-}+module Dtmc.Analysis.Classification.Internal (+    type CommClass (..),+    type Classification (..),+    backwardReachable,+) where++import Data.Maybe (+    fromMaybe,+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.State.Internal (+    stateFromInt,+    stateIndexInt,+ )+import Dtmc.Transition.Matrix.Internal (+    TransitionMatrix,+    tmSupport,+ )+import Dtmc.Transition.Matrix.Internal.Graph qualified as G+import Numeric.Natural (+    Natural,+ )++{- | Structural facts about one communicating class. For a finite valid DTMC,+a closed class consists of recurrent states.+-}+data CommClass state = CommClass+    { classMembers :: [state]+    -- ^ Member states in ascending order.+    , classPeriod :: Maybe Natural+    -- ^ Shared state period, or 'Nothing' when the class has no cycle.+    , classClosed :: Bool+    -- ^ Whether no positive-probability transition leaves the class.+    }++deriving instance (Eq state) => Eq (CommClass state)++deriving instance (Show state) => Show (CommClass state)++{- | A consistent structural report built by+'Dtmc.Analysis.Classification.classify'. The constructor is exposed here for+trusted internal use; "Dtmc.Analysis.Classification" keeps it hidden so its+summary fields stay aligned with its communicating classes.+-}+data Classification state = Classification+    { classesOf :: [CommClass state]+    -- ^ The communicating classes, ordered by least member.+    , isIrreducible :: Bool+    -- ^ Whether the states form a single (non-empty) communicating class.+    , isAperiodic :: Bool+    -- ^ Whether every class has period @1@ (and there is at least one class).+    , isErgodic :: Bool+    {- ^ Whether the chain is irreducible and aperiodic. For a finite DTMC this+    implies convergence to its unique stationary distribution.+    -}+    , chainPeriodOf :: Maybe Natural+    {- ^ The period of an irreducible chain (@Just d@), or @Nothing@ for a+    reducible chain, where period is a per-class notion, or when the single+    class has no cycles.+    -}+    , recurrentStatesOf :: [state]+    -- ^ States in closed classes, which are recurrent in a finite chain.+    , transientStatesOf :: [state]+    -- ^ States in non-closed classes, which are transient.+    , absorbingStatesOf :: [state]+    {- ^ Singleton closed classes. For exact stochastic rows these are+    absorbing states with @P(i,i) = 1@; numerically derived or otherwise+    unchecked rows are classified only by strict-positive support.+    -}+    }++type role Classification nominal++deriving instance (Eq state) => Eq (Classification state)++deriving instance (Show state) => Show (Classification state)++toState :: (FiniteState state) => Int -> state+toState index =+    fromMaybe+        (error "Dtmc.Analysis.Classification.Internal: graph vertex out of bounds")+        (stateFromInt index)++toIndex :: (FiniteState state) => state -> Int+toIndex = stateIndexInt++{- | Return states from which an allowed seed is reachable along a support+path containing only states accepted by @allowed@. Disallowed seeds are+ignored; the result is duplicate-free and ordered by state index.++For the complexity bounds, @n@ is the state count, @E@ the support-edge count,+@s@ the number of supplied seeds, and @r@ the number of returned states.++Complexity: excluding @n@ evaluations of @allowed@, 'FiniteState' method+costs, and shared support-graph construction, @O(n + E + s)@ time,+@O(n + E + s)@ temporary space, and @O(r)@ result space. The first reverse+traversal also retains @O(n + E)@ predecessor-cache space.+-}+backwardReachable ::+    (FiniteState state) =>+    TransitionMatrix state ->+    (state -> Bool) ->+    [state] ->+    [state]+backwardReachable p allowed seeds =+    map toState (G.backwardReachable (tmSupport p) (allowed . toState) (map toIndex seeds))
+ src/Dtmc/Analysis/Event.hs view
@@ -0,0 +1,64 @@+{- |+Module      : Dtmc.Analysis.Event+Description : Closed comparisons for discrete analysis quantities.++A small, closed vocabulary for comparing a discrete random quantity with a+finite threshold. Analysis modules use this selector for exact masses, lower+tails, and upper tails without accepting arbitrary predicates or constructing+a general event algebra.+-}+module Dtmc.Analysis.Event (+    DiscreteEvent (..),+    matches,+    includesInfiniteOutcome,+) where++import Numeric.Natural (+    Natural,+ )++{- | A comparison between a non-negative integer-valued quantity and a finite+threshold.++If the quantity can equal infinity, that atom belongs to 'GreaterThan' and+'AtLeast' and to none of the other events. Eventual hitting, eventual return,+and infinitely many visits remain separate queries because this type contains+only finite thresholds.+-}+data DiscreteEvent+    = EqualTo Natural -- ^ The quantity equals the threshold.+    | LessThan Natural -- ^ The quantity is strictly below the threshold.+    | AtMost Natural -- ^ The quantity does not exceed the threshold.+    | GreaterThan Natural -- ^ The quantity is strictly above the threshold.+    | AtLeast Natural -- ^ The quantity is at least the threshold.+    deriving (Eq, Ord, Show)++{- | Test whether a finite value satisfies a 'DiscreteEvent'. This is the+literal closed comparison semantics and performs no probability calculation.+For the separate infinite outcome, use 'includesInfiniteOutcome'.++Complexity: @O(1)@ time and @O(1)@ space.+-}+matches :: DiscreteEvent -> Natural -> Bool+matches event value =+    case event of+        EqualTo threshold -> value == threshold+        LessThan threshold -> value < threshold+        AtMost threshold -> value <= threshold+        GreaterThan threshold -> value > threshold+        AtLeast threshold -> value >= threshold++{- | Test whether the event contains the infinity atom of an extended-natural+quantity. Every finite threshold is below infinity, so precisely the two+upper-tail comparisons contain it.++Complexity: @O(1)@ time and @O(1)@ space.+-}+includesInfiniteOutcome :: DiscreteEvent -> Bool+includesInfiniteOutcome event =+    case event of+        EqualTo _ -> False+        LessThan _ -> False+        AtMost _ -> False+        GreaterThan _ -> True+        AtLeast _ -> True
+ src/Dtmc/Analysis/Expectation.hs view
@@ -0,0 +1,25 @@+{- |+Module      : Dtmc.Analysis.Expectation+Description : Finite and infinite expectations of non-negative quantities.++A shared result type for expectations that may be mathematically infinite.+It is used by hitting-time, return-time, and total visit-count analysis.+-}+module Dtmc.Analysis.Expectation (+    Expectation (..),+) where++{- | An expectation of a non-negative random quantity.++'FiniteExpectation' performs no validation: callers can construct negative,+non-finite, or @NaN@ values. Library functions use 'InfiniteExpectation' for a+structural mathematical infinity, not floating-point overflow. Derived+ordering places every 'FiniteExpectation' before 'InfiniteExpectation'; finite+comparisons inherit the behaviour of 'Double', including @NaN@.+-}+data Expectation+    = -- | A finite expectation represented as a 'Double', without validation.+      FiniteExpectation Double+    | -- | A mathematically infinite expectation.+      InfiniteExpectation+    deriving (Eq, Ord, Show)
+ src/Dtmc/Analysis/FiniteTime.hs view
@@ -0,0 +1,169 @@+{- |+Module      : Dtmc.Analysis.FiniteTime+Description : Transition, event, and conditional probabilities.++Finite-time probability queries shared by dense finite matrices and locally+finite kernels. Kernels implement 'Transition'; initial laws may be either a+dense finite @DistributionVector@ or a @DistributionMap@ through the+'Distribution' abstraction. All calculations use finite reachable support+and perform no truncation, clamping, or renormalisation.+-}+module Dtmc.Analysis.FiniteTime (+    stepProbability,+    nStepProbability,+    probability,+    probabilityGiven,+    Observation (..),+    ConditionalProbabilityError (..),+) where++import Dtmc.Analysis.FiniteTime.Internal (+    NormalisedObservations (..),+    normalise,+ )+import Dtmc.Distribution (+    Distribution (..),+ )+import Dtmc.Distribution.Map (+    pointMass,+ )+import Dtmc.Dynamics (+    evolveN,+ )+import Dtmc.Transition (+    Transition (..),+ )+import Numeric.Natural (+    Natural,+ )++{- | A timed state observation. @At t i@ is the event @X_t = i@. A list of+observations denotes their conjunction; list order has no meaning.+-}+data Observation state+    = At Natural state -- ^ Require the supplied state at the specified time.+    deriving (Eq, Show)++-- | Why a conditional probability query has no defined value.+data ConditionalProbabilityError+    = -- | The condition has probability exactly zero.+      ZeroProbabilityCondition+    deriving (Eq, Show)++{- | Return the one-step transition probability+@P(X_1 = j | X_0 = i)@ through any locally finite 'Transition'.++Complexity: excluding 'transitionLaw', @O(log(s + 1))@ time and @O(1)@+temporary and result space for returned law support size @s@.+-}+stepProbability ::+    (Transition kernel, Ord (TransitionState kernel)) =>+    kernel ->+    TransitionState kernel ->+    TransitionState kernel ->+    Double+stepProbability kernel source =+    probabilityAt (transitionLaw kernel source)++{- | Return the @k@-step transition probability @P(X_k = j | X_0 = i)@. At+@k = 0@ this is the Kronecker delta.++For the complexity bounds, @w@, @e@, and @u@ are per-step upper bounds on+stored source states, traversed transition edges, and accumulated destination+states, and @r@ bounds the final stored support.++Complexity: excluding 'transitionLaw',+@O(k (w + e log(u + 1) + u) + log(r + 1) + 1)@ time, @O(w + u)@ temporary+space, and @O(1)@ result space.+-}+nStepProbability ::+    (Transition kernel, Ord (TransitionState kernel)) =>+    Natural ->+    kernel ->+    TransitionState kernel ->+    TransitionState kernel ->+    Double+nStepProbability steps kernel source =+    probabilityAt (evolveN steps (pointMass source) kernel)++{- | Compute the probability of a conjunction of timed observations.+Observation order has no meaning, duplicates collapse, and an empty+conjunction is exactly one. Contradictory observations at one time give+exactly zero without inspecting the initial distribution or kernel.++A state probability is represented by a singleton observation. A consecutive+path is represented by observations at times zero, one, and so on.++For the complexity bounds, @m@ is the supplied observation count, @q@ the+normalised count, @k@ the greatest observed time, and @s_0@ the initial stored+support size. Across all propagation steps and observation gaps, @w@, @e@,+and @u@ bound stored source states, traversed transition edges, and+accumulated destination states, while @r@ bounds support at each lookup. Let+@C = w + e log(u + 1) + u@.++Complexity: excluding the initial 'distributionWeights' call and all+'transitionLaw' evaluations,+@O(m log(m + 1) + s_0 + k C + q log(r + 1) + 1)@ time,+@O(m + w + u)@ temporary space, and @O(1)@ result space.+-}+probability ::+    ( Distribution distribution+    , Transition kernel+    , DistributionState distribution ~ TransitionState kernel+    , Ord (TransitionState kernel)+    ) =>+    distribution ->+    kernel ->+    [Observation (TransitionState kernel)] ->+    Double+probability initial kernel observations =+    case normalise [(time, state) | At time state <- observations] of+        Impossible -> 0+        Consistent [] -> 1+        Consistent ((firstTime, firstState) : rest) ->+            probabilityAt (evolveN firstTime initial kernel) firstState+                * gaps (firstTime, firstState) rest+  where+    gaps _ [] = 1+    gaps (previousTime, previousState) ((time, state) : more) =+        nStepProbability+            (time - previousTime)+            kernel+            previousState+            state+            * gaps (time, state) more++{- | Compute conditional probability @P(E | C)@ for two conjunctions of timed+observations. An exactly zero-probability condition returns+'ZeroProbabilityCondition' without evaluating the numerator; otherwise the+result is the ordinary 'Double' quotient of the joint and condition+probabilities.++For the complexity bounds, use the parameters from 'probability' across both+probability evaluations: @m@ is the total number of pairs processed, @q@ the+total normalised count, and @k@ the total number of propagation steps.+Let @C = w + e log(u + 1) + u@.++Complexity: excluding up to two initial 'distributionWeights' calls and all+'transitionLaw' evaluations,+@O(m log(m + 1) + s_0 + k C + q log(r + 1) + 1)@ time,+@O(m + w + u)@ temporary space, and @O(1)@ result space.+-}+probabilityGiven ::+    ( Distribution distribution+    , Transition kernel+    , DistributionState distribution ~ TransitionState kernel+    , Ord (TransitionState kernel)+    ) =>+    distribution ->+    kernel ->+    [Observation (TransitionState kernel)] ->+    [Observation (TransitionState kernel)] ->+    Either ConditionalProbabilityError Double+probabilityGiven initial kernel event condition =+    if denominator == 0+        then Left ZeroProbabilityCondition+        else Right (numerator / denominator)+  where+    denominator = probability initial kernel condition+    numerator = probability initial kernel (event <> condition)
+ src/Dtmc/Analysis/FiniteTime/Internal.hs view
@@ -0,0 +1,54 @@+{- |+Module      : Dtmc.Analysis.FiniteTime.Internal+Description : Normalised timed observations (unsafe underbelly).++The private normal form behind the event and conditional probability queries+in "Dtmc.Analysis.FiniteTime". 'normalise' is the intended way to build a+t'NormalisedObservations': it establishes the invariant that a 'Consistent'+list holds exactly one @(time, state)@ entry per distinct time, in ascending+time order. Building 'Consistent' directly can break that invariant and give+the scoring in "Dtmc.Analysis.FiniteTime" a wrong answer.+-}+module Dtmc.Analysis.FiniteTime.Internal (+    NormalisedObservations (..),+    normalise,+) where++import Data.List (+    sortBy,+ )+import Data.Ord (+    comparing,+ )+import Numeric.Natural (+    Natural,+ )++{- | A conjunction of timed state observations after sorting, de-duplication,+and consistency checking.+-}+data NormalisedObservations state+    = -- | Two observations demand different states at one time.+      Impossible+    | -- | Distinct times in ascending order, each with one required state.+      Consistent [(Natural, state)]++{- | Normalise @(time, state)@ pairs by ascending time, collapse exact+duplicates, and detect contradictions. Pairs requiring different states at+the same time yield 'Impossible'; otherwise the result is 'Consistent' with+one entry per distinct time in ascending order, so consecutive entries always+have strictly increasing times.++Complexity: @O(m log(m + 1))@ time, @O(m)@ temporary space, and @O(m)@+worst-case result space for @m@ supplied pairs.+-}+normalise :: (Eq state) => [(Natural, state)] -> NormalisedObservations state+normalise pairs =+    foldr insert (Consistent []) (sortBy (comparing fst) pairs)+  where+    insert _ Impossible = Impossible+    insert step (Consistent []) = Consistent [step]+    insert (t, i) (Consistent ((t', i') : rest))+        | t == t' && i == i' = Consistent ((t', i') : rest)+        | t == t' = Impossible+        | otherwise = Consistent ((t, i) : (t', i') : rest)
+ src/Dtmc/Analysis/HittingTime.hs view
@@ -0,0 +1,616 @@+{- |+Module      : Dtmc.Analysis.HittingTime+Description : Exact, bounded, eventual, competing, and expected hitting times.++Hitting-time quantities for DTMCs. Scalar exact-time and bounded queries work+through any locally finite 'Transition', including kernels on infinite state+spaces. Eventual, competing, and expected queries use a finite+'TransitionMatrix'. For a target set @A@,+@H_A = inf { t >= 0 | X_t in A }@.++Exact-time and strictly bounded queries use finite recurrences. Eventual,+competing, and expected queries use support reachability and checked 'Double'+linear solves. Results are not clamped or renormalised.++Unless stated otherwise, complexity bounds exclude 'FiniteState' method+costs. Bounds over abstract distributions, transitions, or target predicates+also identify the excluded typeclass-method and predicate costs.++For finite-matrix bounds, @n@ is the state count and @E@ the support-edge+count.+-}+module Dtmc.Analysis.HittingTime (+    -- * Result types+    LinearSystemError (..),+    Expectation (..),++    -- * Hitting-time distribution+    probability,+    probabilityGivenInitialState,++    -- * Eventual hitting+    eventualProbability,+    eventualProbabilityGivenInitialState,++    -- * Competing targets+    raceProbability,+    raceProbabilityGivenInitialState,++    -- * Expected hitting time+    expectation,+    expectationGivenInitialState,+) where++import Data.Array qualified as Array+import Data.Array.Unboxed qualified as Unboxed+import Data.Map.Strict (+    Map,+ )+import Data.Map.Strict qualified as Map+import Data.Maybe (+    fromMaybe,+ )+import Dtmc.Analysis.Classification.Internal (+    backwardReachable,+ )+import Dtmc.Analysis.Event (+    DiscreteEvent (..),+ )+import Dtmc.Analysis.Expectation (+    Expectation (..),+ )+import Dtmc.Analysis.Initial.Internal (+    expectationUnderEither,+    probabilityUnder,+    probabilityUnderEither,+ )+import Dtmc.Analysis.LinearSystem (+    LinearSystemError (..),+ )+import Dtmc.Analysis.LinearSystem.Internal (+    rowSums,+    solveIminusQVector,+    subMatrix,+ )+import Dtmc.Distribution (+    Distribution (..),+ )+import Dtmc.Dynamics.Internal (+    pushSparseWeights,+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.State.Internal (+    stateCardinalityInt,+    stateFromInt,+    stateIndexInt,+ )+import Dtmc.Transition (+    Transition (..),+ )+import Dtmc.Transition.Matrix.Internal (+    TransitionMatrix,+    unTransitionMatrix,+ )+import Numeric.LinearAlgebra qualified as LA+import Numeric.Natural (+    Natural,+ )++toIndex :: (FiniteState state) => state -> Int+toIndex = stateIndexInt++toState :: (FiniteState state) => Int -> state+toState index =+    fromMaybe+        (error "Dtmc.Analysis.HittingTime: graph vertex out of bounds")+        (stateFromInt index)++-- Use a mask so duplicates collapse and per-state membership stays O(1).+indexMask :: Int -> [Int] -> Unboxed.UArray Int Bool+indexMask dim indices =+    Unboxed.accumArray (||) False (0, dim - 1) [(i, True) | i <- indices]++advanceUntilTarget ::+    (Transition kernel, Ord (TransitionState kernel)) =>+    kernel ->+    (TransitionState kernel -> Bool) ->+    Map (TransitionState kernel) Double ->+    (Map (TransitionState kernel) Double, Double)+advanceUntilTarget kernel isTarget survivors =+    (remaining, hitMass)+  where+    advanced = pushSparseWeights survivors kernel+    (hits, remaining) = Map.partitionWithKey (\state _ -> isTarget state) advanced+    hitMass = sum (Map.elems hits)++{- | Compute the exact scalar hitting-time probability+@P(H_A = t | X_0 = i)@ through any 'Transition'. The target set is represented+by a membership predicate, which also works when the state space is infinite.+Hitting includes time zero, and newly hit mass is removed after every step.++Complexity: excluding 'transitionLaw' and predicate evaluation,+@O(k (w + e log(u + 1) + u) + 1)@ time, @O(w + u)@ temporary space, and+@O(1)@ result space, where @k = t@ and @w@, @e@, and @u@ bound per-step+survivor states, traversed transition edges, and accumulated destinations.+-}+exactProbabilityAt ::+    ( Transition kernel+    , Ord (TransitionState kernel)+    ) =>+    Natural ->+    kernel ->+    (TransitionState kernel -> Bool) ->+    TransitionState kernel ->+    Double+exactProbabilityAt time kernel isTarget initialState+    | time == 0 = if isTarget initialState then 1 else 0+    | isTarget initialState = 0+    | otherwise = go time (Map.singleton initialState 1)+  where+    go 0 _ = 0+    go _ survivors | Map.null survivors = 0+    go remaining survivors =+        let (next, hitMass) = advanceUntilTarget kernel isTarget survivors+         in if remaining == 1+                then hitMass+                else go (remaining - 1) next++{- | Compute the strict bounded scalar hitting probability+@P(H_A < c | X_0 = i)@ through any 'Transition'. At @c = 0@ the result is+zero; at a positive bound an initial target gives one.++Complexity: excluding 'transitionLaw' and predicate evaluation,+@O(k (w + e log(u + 1) + u) + 1)@ time, @O(w + u)@ temporary space, and+@O(1)@ result space, where @k = c@ and @w@, @e@, and @u@ bound per-step+survivor states, traversed transition edges, and accumulated destinations.+-}+lowerTailProbability ::+    ( Transition kernel+    , Ord (TransitionState kernel)+    ) =>+    Natural ->+    kernel ->+    (TransitionState kernel -> Bool) ->+    TransitionState kernel ->+    Double+lowerTailProbability bound kernel isTarget initialState+    | bound == 0 = 0+    | isTarget initialState = 1+    | otherwise = go (bound - 1) (Map.singleton initialState 1) 0+  where+    go 0 _ total = total+    go _ survivors total | Map.null survivors = total+    go remaining survivors total =+        let (next, hitMass) = advanceUntilTarget kernel isTarget survivors+            cumulative = total + hitMass+         in cumulative `seq` go (remaining - 1) next cumulative++{- | Compute hitting probabilities+@h_i = P(H_A < infinity | X_0 = i)@ in state order. Target order and+duplicates are ignored; an empty target set gives an all-zero vector.++The result is the minimal non-negative solution of @h_i = 1@ on @A@ and+@h_i = sum_j P(i,j) h_j@ elsewhere. Target entries are exactly @1@, and+states from which @A@ is unreachable are exactly @0@. Remaining entries solve+@(I - P[D,D])x = P[D,A]1@ and inherit floating-point error.++Returns 'Left' if the interior solve fails the numerical contract.++Complexity: @O(n^3 + a)@ worst-case time, @O(n^2 + a)@ temporary space,+@O(n + E)@ retained graph-cache space, and @O(n)@ result space for @n@+states, @E@ support edges, and @a@ supplied targets.+-}+eventualProbabilitiesByState ::+    (FiniteState state) =>+    TransitionMatrix state ->+    [state] ->+    Either LinearSystemError (LA.Vector Double)+eventualProbabilitiesByState p targets =+    -- The ordinary hitting problem is the competing problem with no competing+    -- boundary (@H_B = infinity@), so it reuses the same single solve.+    raceProbabilitiesByState p targets []++{- | Compute the probability of ever hitting the target set from one state.+This has the same edge cases, numerical behaviour, and errors as+@eventualProbabilitiesByState@.++Partially applying the matrix and target set shares one lazy all-state solve:+the first forced query computes the table, and later lookups read it directly.++Complexity: the first forced query takes @O(n^3 + a)@ worst-case time and+@O(n^2 + a)@ temporary space for @n@ states and @a@ supplied targets. It may+retain an @O(n)@ all-state result and @O(n + E)@ graph cache; subsequent+shared lookups take @O(1)@ time and space. The scalar result occupies+@O(1)@ space.+-}+eventualProbabilityGivenInitialState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    [state] ->+    state ->+    Either LinearSystemError Double+eventualProbabilityGivenInitialState p targets =+    \i -> (`LA.atIndex` toIndex i) <$> probabilities+  where+    probabilities = eventualProbabilitiesByState p targets++{- | Compute competing hitting probabilities+@h_i = P(H_A < H_B | X_0 = i)@ in state order, for a successful boundary @A@+(first argument) and a competing boundary @B@ (second argument). Hitting times+include time zero, @H_A = inf { t >= 0 | X_t in A }@ and likewise for @B@, and+the comparison is /strict/: @A@ must be reached strictly before @B@.++Target order and duplicate states are ignored in both lists.++Overlap and ties. The two boundaries need not be disjoint. Reaching a state in+both @A@ and @B@ ties the two hitting times (@H_A = H_B@), and a tie fails the+strict inequality, so the competing boundary claims every shared state. Writing+the effective successful set as @A' = A \\ B@:++* states in @A'@ have value exactly @1@;+* states in @B@ -- including states shared with @A@ -- have value exactly @0@;+* if @A@ and @B@ are identical, every result is @0@.++Empty boundaries. Because @H_(empty) = infinity@:++* an empty successful set gives an all-zero vector;+* an empty competing set agrees with 'eventualProbabilitiesByState' on the same+  successful set;+* two empty sets give an all-zero vector.++Reachability is structural. Using the strict-positive support graph, one reverse+traversal from @A'@ that is forbidden to pass through @B@ marks the states that+can reach @A'@ before @B@. This never consults floating-point probabilities, so+a state that cannot reach @A'@ at all, or can reach it only by first entering+@B@, is assigned exactly @0@ without a solve. For the remaining interior states+@D@ the values are the minimal non-negative solution of+@h_i = sum_j P(i,j) h_j@, i.e. @(I - P[D,D]) x = P[D,A'] 1@; these entries come+from the shared 'Double' linear solver, inherit its rounding, and are not+clamped to @[0, 1]@, renormalised, or given any tolerance.++Returns 'Left' if the interior solve fails the numerical contract. For a valid+transition matrix the system is nonsingular in exact arithmetic, but may still+be too ill-conditioned for a reliable 'Double' result. The all-state result+performs at most one linear solve.++Complexity: @O(n^3 + a + b)@ worst-case time and @O(n^2 + a + b)@+temporary space for @n@ states and boundary-list lengths @a@ and @b@. The+matrix retains @O(n + E)@ graph-cache space, and the result occupies @O(n)@+space.+-}+raceProbabilitiesByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    [state] ->+    [state] ->+    Either LinearSystemError (LA.Vector Double)+raceProbabilitiesByState p successful competing = do+    solved <-+        if null interiorIdx+            then Right []+            else+                LA.toList+                    <$> solveIminusQVector+                        (subMatrix interiorIdx interiorIdx matrix)+                        (rowSums (subMatrix interiorIdx effectiveIdx matrix))+    let interiorValues :: Unboxed.UArray Int Double+        interiorValues =+            Unboxed.accumArray+                (\_ x -> x)+                0+                (0, dim - 1)+                (zip interiorIdx solved)+        valueAt i+            | inEffective i = 1+            | canReach i = interiorValues Unboxed.! i+            | otherwise = 0+    pure (LA.fromList [valueAt i | i <- [0 .. dim - 1]])+  where+    dim = stateCardinalityInt @state+    -- Masks keep boundary and solution lookup constant-time during assembly.+    competingMask = indexMask dim (map toIndex competing)+    inCompeting i = competingMask Unboxed.! i+    successfulMask = indexMask dim (map toIndex successful)+    -- Effective successful set A' = A \ B. A state on both boundaries is a+    -- tie, and a tie loses, so the competing boundary claims it.+    inEffective i = successfulMask Unboxed.! i && not (inCompeting i)+    effectiveIdx = [i | i <- [0 .. dim - 1], inEffective i]+    -- One reverse traversal to A', forbidden to cross B, marks every state+    -- that can reach A' before B; this is structural, not numerical.+    reachMask =+        indexMask+            dim+            ( map+                toIndex+                ( backwardReachable+                    p+                    (not . inCompeting . toIndex)+                    (map toState effectiveIdx)+                )+            )+    canReach i = reachMask Unboxed.! i+    interiorIdx = [i | i <- [0 .. dim - 1], not (inEffective i), canReach i]+    matrix = unTransitionMatrix p++{- | Compute the probability of hitting the successful boundary strictly+before the competing boundary from one state, @P(H_A < H_B | X_0 = i)@. This+has the same overlap, empty-set, structural, numerical, and error behaviour as+@raceProbabilitiesByState@.++Partially applying the matrix and both boundaries shares one lazy all-state+solve.++Complexity: the first forced query takes @O(n^3 + a + b)@ worst-case time and+@O(n^2 + a + b)@ temporary space for @n@ states and boundary-list lengths+@a@ and @b@. It may retain an @O(n)@ all-state result and @O(n + E)@ graph+cache; subsequent shared lookups take @O(1)@ time and space. The scalar result+occupies @O(1)@ space.+-}+raceProbabilityGivenInitialState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    [state] ->+    [state] ->+    state ->+    Either LinearSystemError Double+raceProbabilityGivenInitialState p successful competing =+    \i -> (`LA.atIndex` toIndex i) <$> probabilities+  where+    probabilities = raceProbabilitiesByState p successful competing++{- | Compute expected hitting times @E(H_A | X_0 = i)@ in state order.+Targets have exact expectation zero. A non-target state has+'InfiniteExpectation' exactly when the target is not hit with probability+one; this is decided from support reachability, not a floating-point+comparison. An empty target set therefore gives 'InfiniteExpectation' for+every state.++Finite entries are the solution of+@eta_i = 1 + sum_(j not in A) P(i,j) eta_j@. They inherit solver rounding and+are not clamped. Returns 'Left' if the finite-state system fails the numerical+contract.++Complexity: @O(n^3 + a)@ worst-case time, @O(n^2 + a)@ temporary space,+@O(n + E)@ retained graph-cache space, and @O(n)@ result space for @n@+states, @E@ support edges, and @a@ supplied targets.+-}+expectationsByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    [state] ->+    Either LinearSystemError [Expectation]+expectationsByState p targets = do+    solved <-+        if null certainIdx+            then Right []+            else+                LA.toList+                    <$> solveIminusQVector+                        (subMatrix certainIdx certainIdx matrix)+                        (LA.konst 1 (length certainIdx))+    let certainValues :: Unboxed.UArray Int Double+        certainValues =+            Unboxed.accumArray+                (\_ x -> x)+                0+                (0, dim - 1)+                (zip certainIdx solved)+        valueAt i+            | inTarget i = FiniteExpectation 0+            | doomedMask Unboxed.! i = InfiniteExpectation+            | otherwise = FiniteExpectation (certainValues Unboxed.! i)+    pure [valueAt i | i <- [0 .. dim - 1]]+  where+    dim = stateCardinalityInt @state+    targetMask = indexMask dim (map toIndex targets)+    inTarget i = targetMask Unboxed.! i+    -- One reverse traversal replaces a reachability query for every state.+    reachMask =+        indexMask dim (map toIndex (backwardReachable p (const True) targets))+    unreachable =+        [i | i <- [0 .. dim - 1], not (inTarget i), not (reachMask Unboxed.! i)]+    -- Reaching an unreachable state without crossing the target makes the+    -- hitting probability less than one.+    doomed =+        backwardReachable+            p+            (not . inTarget . toIndex)+            (map toState unreachable)+    doomedMask = indexMask dim (map toIndex doomed)+    certainIdx =+        [i | i <- [0 .. dim - 1], not (inTarget i), not (doomedMask Unboxed.! i)]+    matrix = unTransitionMatrix p++{- | Compute the expected time to hit the target set from one state. This has+the same edge cases, numerical behaviour, and errors as @expectationsByState@.++Partial application shares one lazy all-state table: the first forced query+computes the table, and later lookups read it directly.++Complexity: the first forced query takes @O(n^3 + a)@ worst-case time and+@O(n^2 + a)@ temporary space for @n@ states and @a@ supplied targets. It may+retain an @O(n)@ all-state result and @O(n + E)@ graph cache; subsequent+shared lookups take @O(1)@ time and space. The scalar result occupies+@O(1)@ space.+-}+expectationGivenInitialState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    [state] ->+    state ->+    Either LinearSystemError Expectation+expectationGivenInitialState p targets =+    \i -> (Array.! toIndex i) <$> table+  where+    -- Back the shared table with a boxed array so each state query is O(1)+    -- List indexing was linear; the array keeps shared queries constant-time.+    table =+        Array.listArray (0, dim - 1) <$> expectationsByState p targets+    dim = stateCardinalityInt @state++-- Direct survivor mass @P(H_A > t)@ through a locally finite transition.+-- Newly hit paths are removed at every step, so paths that never hit remain+-- in the map and the result naturally includes the infinity atom.+upperTailProbability ::+    ( Transition kernel+    , Ord (TransitionState kernel)+    ) =>+    Natural ->+    kernel ->+    (TransitionState kernel -> Bool) ->+    TransitionState kernel ->+    Double+upperTailProbability time kernel isTarget initialState+    | isTarget initialState = 0+    | otherwise = go time (Map.singleton initialState 1)+  where+    go 0 survivors = sum (Map.elems survivors)+    go _ survivors | Map.null survivors = 0+    go remaining survivors =+        let (next, _) = advanceUntilTarget kernel isTarget survivors+         in next `seq` go (remaining - 1) next++{- | Compute, under an arbitrary initial distribution, the probability of a+finite-threshold event in the hitting time+@H_A = inf { t >= 0 | X_t in A }@. The initial distribution supplies the+probability measure @P_mu@.++'EqualTo' and the two lower tails reuse the direct exact/bounded recurrences.+'GreaterThan' and 'AtLeast' use surviving mass directly rather than subtracting+a cumulative probability from one. Consequently upper tails include the atom+at infinity and avoid cancellation when the surviving probability is small.+'AtLeast' @0@ is exactly one.++This function works through any locally finite 'Transition'. Results use+ordinary 'Double' arithmetic without clamping or renormalisation.++For the complexity bounds, @s@ is the initial stored support size, @k@ the+event threshold, and @w@, @e@, and @u@ are per-step upper bounds on survivor+states, traversed transition edges, and accumulated destinations.++Complexity: excluding 'distributionWeights', 'transitionLaw', and predicate+evaluation, @O(s (k (w + e log(u + 1) + u) + 1))@ time,+@O(s + w + u)@ temporary space, and @O(1)@ result space.+-}+probability ::+    ( Distribution distribution+    , Transition kernel+    , DistributionState distribution ~ TransitionState kernel+    , Ord (TransitionState kernel)+    ) =>+    DiscreteEvent ->+    kernel ->+    (TransitionState kernel -> Bool) ->+    distribution ->+    Double+probability event kernel isTarget initial =+    probabilityUnder initial (probabilityGivenInitialState event kernel isTarget)++{- | Compute the probability of a finite-threshold hitting-time event+conditioned on @X_0 = i@. Hitting includes time zero and follows the event+boundary behaviour documented by 'probability'.++For the complexity bounds, @k@ is the event threshold and @w@, @e@, and @u@+are per-step upper bounds on survivor states, traversed transition edges, and+accumulated destinations.++Complexity: excluding 'transitionLaw' and predicate evaluation,+@O(k (w + e log(u + 1) + u) + 1)@ time, @O(w + u)@ temporary space, and+@O(1)@ result space.+-}+probabilityGivenInitialState ::+    ( Transition kernel+    , Ord (TransitionState kernel)+    ) =>+    DiscreteEvent ->+    kernel ->+    (TransitionState kernel -> Bool) ->+    TransitionState kernel ->+    Double+probabilityGivenInitialState event kernel isTarget initialState =+    case event of+        EqualTo time ->+            exactProbabilityAt time kernel isTarget initialState+        LessThan bound ->+            lowerTailProbability bound kernel isTarget initialState+        AtMost time ->+            lowerTailProbability (time + 1) kernel isTarget initialState+        GreaterThan time ->+            upperTailProbability time kernel isTarget initialState+        AtLeast 0 -> 1+        AtLeast time ->+            upperTailProbability (time - 1) kernel isTarget initialState++{- | Compute, under an arbitrary initial distribution, the probability of ever+hitting the target set. Target order and duplicates do not affect the result;+an empty target set gives zero. Numerical failures come from the checked+all-state linear solve.++Complexity: excluding 'distributionWeights', @O(n^3 + a + s)@ worst-case+time, @O(n^2 + a + s)@ temporary space, and @O(1)@ result space for @n@+states, @a@ supplied targets, and initial stored support size @s@. The matrix+may retain @O(n + E)@ graph-cache space.+-}+eventualProbability ::+    ( FiniteState state+    , Distribution distribution+    , DistributionState distribution ~ state+    ) =>+    TransitionMatrix state ->+    [state] ->+    distribution ->+    Either LinearSystemError Double+eventualProbability matrix targets initial =+    probabilityUnderEither initial (eventualProbabilityGivenInitialState matrix targets)++{- | Compute, under an arbitrary initial distribution, the probability of+hitting the successful boundary strictly before the competing boundary.+Overlap ties lose, and empty-boundary behaviour matches+'raceProbabilityGivenInitialState'.++Complexity: excluding 'distributionWeights', @O(n^3 + a + b + s)@+worst-case time, @O(n^2 + a + b + s)@ temporary space, and @O(1)@ result+space for @n@ states, boundary-list lengths @a@ and @b@, and initial stored+support size @s@. The matrix may retain @O(n + E)@ graph-cache space.+-}+raceProbability ::+    ( FiniteState state+    , Distribution distribution+    , DistributionState distribution ~ state+    ) =>+    TransitionMatrix state ->+    [state] ->+    [state] ->+    distribution ->+    Either LinearSystemError Double+raceProbability matrix successful competing initial =+    probabilityUnderEither initial (raceProbabilityGivenInitialState matrix successful competing)++{- | Compute the expected hitting time under an arbitrary initial+distribution. It is 'InfiniteExpectation' exactly when a state of positive+initial probability does not hit the target almost surely. Numerical failures+come from the checked all-state linear solve.++Complexity: excluding 'distributionWeights', @O(n^3 + a + s)@ worst-case+time, @O(n^2 + a + s)@ temporary space, and @O(1)@ result space for @n@+states, @a@ supplied targets, and initial stored support size @s@. The matrix+may retain @O(n + E)@ graph-cache space.+-}+expectation ::+    ( FiniteState state+    , Distribution distribution+    , DistributionState distribution ~ state+    ) =>+    TransitionMatrix state ->+    [state] ->+    distribution ->+    Either LinearSystemError Expectation+expectation matrix targets initial =+    expectationUnderEither initial (expectationGivenInitialState matrix targets)
+ src/Dtmc/Analysis/Initial/Internal.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE TypeFamilies #-}++{- |+Module      : Dtmc.Analysis.Initial.Internal+Description : Mixing state-conditioned analysis results under an initial law.++Private helpers for turning quantities conditioned on @X_0 = i@ into the+corresponding quantity under an arbitrary finite-support initial distribution.+Weights and query results are combined with ordinary 'Double' arithmetic;+these helpers do not validate, clamp, or renormalise them.+-}+module Dtmc.Analysis.Initial.Internal (+    probabilityUnder,+    probabilityUnderEither,+    expectationUnderEither,+) where++import Control.Monad (+    foldM,+ )+import Dtmc.Analysis.Expectation (+    Expectation (..),+ )+import Dtmc.Distribution (+    Distribution (..),+ )++{- | Compute the initial-law mixture of state-conditioned probabilities.+Every stored state is queried, and an empty weight list sums to zero.++Complexity: excluding 'distributionWeights' and query evaluations, @O(s)@+time, @O(s)@ temporary space, and @O(1)@ result space for @s@ stored weights.+-}+probabilityUnder ::+    (Distribution distribution) =>+    distribution ->+    (DistributionState distribution -> Double) ->+    Double+probabilityUnder initial query =+    sum+        [ weight * query state+        | (state, weight) <- distributionWeights initial+        ]++{- | Compute the initial-law mixture of fallible state-conditioned+probabilities. Queries are evaluated in stored order, and the first 'Left'+is returned without evaluating later queries. On success, values are combined+with ordinary 'Double' arithmetic.++Complexity: excluding 'distributionWeights' and query evaluations, @O(s)@+worst-case time, @O(s)@ temporary space, and @O(1)@ result space for @s@+stored weights.+-}+probabilityUnderEither ::+    (Distribution distribution) =>+    distribution ->+    (DistributionState distribution -> Either error Double) ->+    Either error Double+probabilityUnderEither initial query =+    sum+        <$> traverse+            (\(state, weight) -> (weight *) <$> query state)+            (distributionWeights initial)++{- | Compute the initial-law mixture of fallible non-negative expectations.+A positive-weight 'InfiniteExpectation' makes the result infinite; a+zero-weight infinity is ignored. After the result becomes infinite, remaining+weights are traversed without evaluating their queries. Before that point,+the first query error is returned.++Finite values use ordinary 'Double' arithmetic without validation.++Complexity: excluding 'distributionWeights' and query evaluations, @O(s)@+worst-case time, @O(s)@ temporary space, and @O(1)@ result space for @s@+stored weights.+-}+expectationUnderEither ::+    (Distribution distribution) =>+    distribution ->+    (DistributionState distribution -> Either error Expectation) ->+    Either error Expectation+expectationUnderEither initial query =+    foldM add (FiniteExpectation 0) (distributionWeights initial)+  where+    add InfiniteExpectation _ = Right InfiniteExpectation+    add (FiniteExpectation total) (state, weight) = do+        value <- query state+        pure $+            case value of+                InfiniteExpectation+                    | weight > 0 -> InfiniteExpectation+                    | otherwise -> FiniteExpectation total+                FiniteExpectation x ->+                    FiniteExpectation (total + weight * x)
+ src/Dtmc/Analysis/Limiting.hs view
@@ -0,0 +1,382 @@+{- |+Module      : Dtmc.Analysis.Limiting+Description : Limits of the n-step transition matrix.++Long-run behaviour of @P^n@ for a finite chain. For a target @j@ in a+recurrent class @C@ that is aperiodic,++@lim_(n -> infinity) (P^n)(i,j) = h(i,C) pi^C(j)@,++where @h(i,C)@ is the probability of ever entering @C@ from @i@ and @pi^C@ is+the stationary distribution carried by @C@. A transient target has limit+zero. The limit therefore exists exactly when every recurrent class is+aperiodic; a periodic class makes the entries oscillate forever.++For any finite chain, let @d@ be the least common multiple of its recurrent+class periods. The whole matrix has @d@ subsequential limits, one for each+residue of @n@ modulo @d@, and 'cyclicLimits' returns them. An empty chain uses+@d = 1@.++'limitingMatrix' assembles eventual hitting probabilities and per-class+stationary distributions without powering the matrix. 'cyclicLimits' applies+that decomposition to @P^d@ and rotates its recurrent phase classes. No+truncation or convergence threshold is involved. Class periods are decided+combinatorially; entries inherit the numerical behaviour of the underlying+solves and matrix products.++Unless stated otherwise, complexity bounds exclude 'FiniteState' method+costs. For those bounds, @n@ is the state count, @E@ the support-edge count,+@c@ the number of recurrent classes, and @d@ the least common multiple of+their periods.+-}+module Dtmc.Analysis.Limiting (+    LinearSystemError (..),+    converges,+    limitingMatrix,+    cyclicLimits,+) where++import Data.Array.Unboxed qualified as Unboxed+import Data.List qualified as List+import Dtmc.Analysis.Classification (+    classClosed,+    classMembers,+    classPeriod,+    communicatingClasses,+    transientStates,+ )+import Dtmc.Analysis.LinearSystem (+    LinearSystemError (..),+ )+import Dtmc.Analysis.LinearSystem.Internal (+    rowSums,+    solveIminusQ,+    subMatrix,+ )+import Dtmc.Analysis.Stationary (+    stationaryDistributions,+ )+import Dtmc.Distribution.Vector.Internal (+    DistributionVector,+    unDistributionVector,+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.State.Internal (+    stateCardinalityInt,+    stateIndexInt,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    power,+ )+import Dtmc.Transition.Matrix.Internal (+    unTransitionMatrix,+ )+import Numeric.LinearAlgebra qualified as LA+import Numeric.Natural (+    Natural,+ )++{- | Test whether @P^n@ converges entrywise, equivalently whether every+recurrent class is aperiodic. Transient classes are irrelevant because their+columns tend to zero whatever their period.++The test is combinatorial, taken from the support graph, so it involves no+arithmetic and no tolerance. The empty chain converges vacuously.++Complexity: on an unforced matrix, the first query takes+@O(n^2 + (n + E) log(n + 1))@ time and @O(n^2 + n + E)@ temporary space and+retains @O(n + E)@ graph and classification caches. With those facts cached,+it takes @O(c)@ time, @O(c)@ temporary space, and @O(1)@ result space.+-}+converges :: (FiniteState state) => TransitionMatrix state -> Bool+converges p =+    all+        ((== Just 1) . classPeriod)+        [c | c <- communicatingClasses p, classClosed c]++{- | Compute the entrywise limit of @P^n@, with rows and columns in the+canonical order of the 'FiniteState' instance. Return 'Nothing' exactly when+some recurrent class is periodic and the limit does not exist.++Entry @(i,j)@ is @h(i,C) pi^C(j)@ for @j@ in the recurrent class @C@, and an+exact zero for transient @j@ -- the class distributions vanish there, so the+zero costs no arithmetic. All recurrent-class hitting probabilities are the+columns of one linear system; each recurrent class still contributes one+stationary solve.++Rows sum to one mathematically because a finite chain enters some recurrent+class almost surely. Numerical failures come from the checked hitting and+stationary solves. A periodic chain returns 'Nothing' without those solves.++Complexity: @O(n^3)@ worst-case time, @O(n^2)@ temporary space,+@O(n + E)@ retained graph-cache space, and @O(n^2)@ result space.+-}+limitingMatrix ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    Either LinearSystemError (Maybe [[Double]])+limitingMatrix p+    | not (converges p) = Right Nothing+    | otherwise = Just <$> convergentLimit p++{- | Compute the limiting matrix of a chain already known to have only+aperiodic recurrent classes. Keeping this separate lets 'cyclicLimits' apply+the same class-and-hitting decomposition to @P^d@ without a redundant+convergence branch.++The caller is responsible for the aperiodicity precondition. Numerical+failures come from the checked hitting and stationary solves.++Complexity: @O(n^3)@ worst-case time, @O(n^2)@ temporary space,+@O(n + E)@ retained graph-cache space, and @O(n^2)@ result space.+-}+convergentLimit ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    Either LinearSystemError [[Double]]+convergentLimit p = do+    (classes, entering) <- limitDecomposition p+    if null classes+        then pure (replicate dim (replicate dim 0))+        else+            pure+                ( LA.toLists+                    ( entering+                        LA.<> LA.fromRows+                            [ unDistributionVector distribution+                            | (_, distribution) <- classes+                            ]+                    )+                )+  where+    dim = stateCardinalityInt @state++{- | Compute the recurrent-class stationary distributions and the matrix+@H@ whose entry @(i,C)@ is the probability of eventually entering class @C@+from @i@.++Writing @T@ for the transient states, all transient rows are obtained from the+single multiple-right-hand-side system++@(I - P[T,T]) H[T,*] = B@,++where @B(i,C) = sum_(j in C) P(i,j)@. Recurrent rows are exact zero/one+boundary values supplied from classification.++An empty chain returns no classes and an empty entering matrix. Numerical+failures come from the transient hitting solve or a class stationary solve.++Complexity: @O(n^3)@ worst-case time, @O(n^2)@ temporary space,+@O(n + E)@ retained graph-cache space, and @O(c n)@ result space.+-}+limitDecomposition ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    Either+        LinearSystemError+        ([([state], DistributionVector state)], LA.Matrix Double)+limitDecomposition p = do+    classes <- stationaryDistributions p+    transientSolution <-+        if null transient+            then Right (LA.konst 0 (0, classCount))+            else+                solveIminusQ+                    (subMatrix transientIndices transientIndices matrix)+                    ( LA.fromColumns+                        [ rowSums (subMatrix transientIndices (map toIndex members) matrix)+                        | (members, _) <- classes+                        ]+                    )+    let entering =+            LA.fromLists+                [ [ entryAt stateIndex classIndex+                  | classIndex <- [0 .. classCount - 1]+                  ]+                | stateIndex <- [0 .. dim - 1]+                ]+        entryAt stateIndex classIndex+            | transientPosition Unboxed.! stateIndex >= 0 =+                transientSolution+                    `LA.atIndex` (transientPosition Unboxed.! stateIndex, classIndex)+            | otherwise =+                if recurrentClass Unboxed.! stateIndex == classIndex then 1 else 0+    pure (classes, entering)+  where+    dim = stateCardinalityInt @state+    matrix = unTransitionMatrix p+    transient = transientStates p+    transientIndices = map toIndex transient+    closedClasses =+        [ classMembers recurrentClass'+        | recurrentClass' <- communicatingClasses p+        , classClosed recurrentClass'+        ]+    classCount = length closedClasses++    transientPosition :: Unboxed.UArray Int Int+    transientPosition =+        Unboxed.accumArray+            (\_ position -> position)+            (-1)+            (0, dim - 1)+            (zip transientIndices [0 ..])++    recurrentClass :: Unboxed.UArray Int Int+    recurrentClass =+        Unboxed.accumArray+            (\_ classIndex -> classIndex)+            (-1)+            (0, dim - 1)+            [ (toIndex member, classIndex)+            | (classIndex, members) <- zip [0 ..] closedClasses+            , member <- members+            ]++    toIndex = stateIndexInt++{- | Compute the @d@ subsequential limits of any finite chain, where @d@ is+the least common multiple of its recurrent class periods. Element @r@ is+@lim_(n -> infinity) P^(n d + r)@. When every recurrent class is aperiodic,+@d = 1@ and the single result is the ordinary limiting matrix. The empty chain+also returns one empty matrix.++The powered chain @Q = P^d@ has only aperiodic recurrent classes. Its closed+classes are the cyclic phases of the original recurrent classes. One batched+solve finds the probability of entering every phase at times divisible by+@d@. A transition under @P@ permutes those phase classes, so later residues+are assembled by rotating class indices rather than multiplying dense+matrices. This accounts automatically for multiple recurrent classes,+transient-state hitting probabilities, and entry phases.++Numerical failures come from the checked hitting and stationary solves. An+inconsistent phase-class successor relation produces 'SingularSystem'.++Complexity: @O(n^3 log(d + 1) + d n^2)@ time, @O(n^2)@ temporary space,+@O(n + E)@ retained graph-cache space, and @O(d n^2)@ result space.+-}+cyclicLimits ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    Either LinearSystemError [[[Double]]]+cyclicLimits p+    | dim == 0 = Right [[]]+    | otherwise = do+        (phaseClasses, entering) <- limitDecomposition powered+        let classCount = length phaseClasses+            classBounds = (0, classCount - 1)+            phaseClassByState = classByState phaseClasses+        successors <- traverse (successorOf phaseClassByState . fst) phaseClasses+        if List.sort successors /= [0 .. classCount - 1]+            then Left SingularSystem+            else+                pure+                    ( successiveLimits+                        commonPeriod+                        classBounds+                        classCount+                        (Unboxed.listArray classBounds [0 .. classCount - 1])+                        ( Unboxed.array+                            classBounds+                            [(successor, source) | (source, successor) <- zip [0 ..] successors]+                        )+                        entering+                        phaseClassByState+                        (stationaryMass phaseClasses)+                    )+  where+    dim = stateCardinalityInt @state+    original = unTransitionMatrix p+    powered = power commonPeriod p+    commonPeriod =+        foldr+            lcm+            1+            [ classPeriodValue+            | recurrentClass <- communicatingClasses p+            , classClosed recurrentClass+            , Just classPeriodValue <- [classPeriod recurrentClass]+            ]++    classByState phaseClasses =+        Unboxed.accumArray+            (\_ classIndex -> classIndex)+            (-1)+            (0, dim - 1)+            [ (stateIndexInt member, classIndex)+            | (classIndex, (members, _)) <- zip [0 ..] phaseClasses+            , member <- members+            ]++    stationaryMass phaseClasses =+        Unboxed.accumArray+            (\_ probability -> probability)+            0+            (0, dim - 1)+            [ (memberIndex, vector `LA.atIndex` memberIndex)+            | (members, distribution) <- phaseClasses+            , let vector = unDistributionVector distribution+            , member <- members+            , let memberIndex = stateIndexInt member+            ]++    successorOf phaseClassByState members =+        case destinations of+            successor : rest+                | successor >= 0 && all (== successor) rest -> Right successor+            _ -> Left SingularSystem+      where+        destinations =+            [ phaseClassByState Unboxed.! destination+            | member <- members+            , let source = stateIndexInt member+            , destination <- [0 .. dim - 1]+            , original `LA.atIndex` (source, destination) > 0+            ]++    successiveLimits ::+        Natural ->+        (Int, Int) ->+        Int ->+        Unboxed.UArray Int Int ->+        Unboxed.UArray Int Int ->+        LA.Matrix Double ->+        Unboxed.UArray Int Int ->+        Unboxed.UArray Int Double ->+        [[[Double]]]+    successiveLimits 0 _ _ _ _ _ _ _ = []+    successiveLimits remaining classBounds classCount origins predecessors entering classOf mass =+        [ [ limitEntry initial target+          | target <- [0 .. dim - 1]+          ]+        | initial <- [0 .. dim - 1]+        ]+            : successiveLimits+                (remaining - 1)+                classBounds+                classCount+                ( Unboxed.listArray+                    classBounds+                    [ predecessors Unboxed.! (origins Unboxed.! classIndex)+                    | classIndex <- [0 .. classCount - 1]+                    ]+                )+                predecessors+                entering+                classOf+                mass+      where+        limitEntry initial target+            | targetClass < 0 = 0+            | otherwise =+                entering `LA.atIndex` (initial, origins Unboxed.! targetClass)+                    * (mass Unboxed.! target)+          where+            targetClass = classOf Unboxed.! target
+ src/Dtmc/Analysis/LinearSystem.hs view
@@ -0,0 +1,38 @@+{- |+Module      : Dtmc.Analysis.LinearSystem+Description : Numerical errors shared by finite-state linear-system analyses.++The explicit failure type shared by eventual hitting, return-time expectation,+and stationary-distribution calculations. The solvers themselves remain an+implementation detail; this module owns only their public error contract.+-}+module Dtmc.Analysis.LinearSystem (+    LinearSystemError (..),+) where++{- | Why a numerical linear-system result could not be accepted safely.++The reciprocal condition estimate and relative residual are dimensionless.+Smaller reciprocal condition estimates indicate greater sensitivity; smaller+relative residuals indicate a better computed solution.+-}+data LinearSystemError+    = -- | A required solve or decomposition has no usable unique result.+      SingularSystem+    | -- | The coefficient matrix is too sensitive for the numerical contract.+      IllConditionedSystem+        { reciprocalConditionEstimate :: Double+        -- ^ The backend's estimated reciprocal condition number.+        }+    | -- | A coefficient or right-hand-side entry was @NaN@ or infinite.+      NonFiniteSystem+    | -- | The solver produced a @NaN@ or infinite result.+      NonFiniteSolution+    | -- | The computed solution did not satisfy the equations closely enough.+      ResidualTooLarge+        { relativeResidual :: Double+        -- ^ The scaled residual of the computed solution.+        , residualLimit :: Double+        -- ^ The largest scaled residual accepted by the solver.+        }+    deriving (Eq, Show)
+ src/Dtmc/Analysis/LinearSystem/Internal.hs view
@@ -0,0 +1,170 @@+{- |+Module      : Dtmc.Analysis.LinearSystem.Internal+Description : @(I - Q)@ linear solves and sub-block extraction.++Dynamic linear algebra for DTMC hitting and return calculations: extract+blocks indexed by runtime state sets and solve systems of the form+@(I - Q) x = b@. Public modules convert bounded state indices to 'Int' and+keep dynamically sized matrices inside the implementation.++All arithmetic uses 'Double'. Every solve validates finiteness, rejects a+reciprocal condition estimate below @1e-12@, and verifies a scaled residual+against @1e-9@.+-}+module Dtmc.Analysis.LinearSystem.Internal (+    subMatrix,+    rowSums,+    solveLinearSystem,+    solveIminusQ,+    solveIminusQVector,+    fundamental,+) where++import Dtmc.Analysis.LinearSystem (+    LinearSystemError (..),+ )+import Numeric.LinearAlgebra qualified as LA++conditionLimit :: Double+conditionLimit = 1e-12++residualLimitValue :: Double+residualLimitValue = 1e-9++allFinite :: LA.Matrix Double -> Bool+allFinite = all isFinite . LA.toList . LA.flatten++isFinite :: Double -> Bool+isFinite value = not (isNaN value || isInfinite value)++infinityNorm :: LA.Matrix Double -> Double+infinityNorm = maximum . (0 :) . map (sum . map abs) . LA.toLists++relativeSystemResidual ::+    LA.Matrix Double ->+    LA.Matrix Double ->+    LA.Matrix Double ->+    Double+relativeSystemResidual coefficient solution rightHandSide =+    infinityNorm (coefficient LA.<> solution - rightHandSide)+        / max+            1+            ( infinityNorm coefficient * infinityNorm solution+                + infinityNorm rightHandSide+            )++{- | Solve @A X = B@ by LU decomposition. @A@ must be a non-empty square+matrix, @B@ must have the same number of rows, and all entries must be finite;+incompatible dimensions raise a backend error.++Returns a 'LinearSystemError' when the input or result is non-finite, the+backend reports singularity, the reciprocal condition estimate is below+@1e-12@, or the scaled infinity-norm residual exceeds @1e-9@.++Complexity: @O(n^3 + n^2 r)@ time, @O(n^2 + n r)@ temporary space, and+@O(n r)@ result space for an @n x n@ coefficient matrix and @r@ right-hand+sides.+-}+solveLinearSystem ::+    LA.Matrix Double ->+    LA.Matrix Double ->+    Either LinearSystemError (LA.Matrix Double)+solveLinearSystem coefficient rightHandSide+    | not (allFinite coefficient && allFinite rightHandSide) =+        Left NonFiniteSystem+    | otherwise =+        case LA.linearSolve coefficient rightHandSide of+            Nothing -> Left SingularSystem+            Just solution+                | not (allFinite solution) -> Left NonFiniteSolution+                | not (isFinite reciprocalCondition) -> Left NonFiniteSystem+                | reciprocalCondition < conditionLimit ->+                    Left (IllConditionedSystem reciprocalCondition)+                | residual > residualLimitValue ->+                    Left+                        ( ResidualTooLarge+                            { relativeResidual = residual+                            , residualLimit = residualLimitValue+                            }+                        )+                | otherwise -> Right solution+              where+                residual =+                    relativeSystemResidual coefficient solution rightHandSide+  where+    reciprocalCondition = LA.rcond coefficient++{- | Extract the block of @m@ selected by the row and column indices. Their+order and multiplicity are preserved; an empty list produces a zero-sized+dimension.++Row indices must be in @{0 .. rows(m)-1}@ and column indices in+@{0 .. cols(m)-1}@; otherwise the backend raises an error.++Complexity: @O(R + C + R C)@ time, @O(R + C)@ temporary space, and+@O(R C)@ result space for @R@ selected rows and @C@ selected columns.+-}+subMatrix :: [Int] -> [Int] -> LA.Matrix Double -> LA.Matrix Double+subMatrix rowIdx colIdx m =+    m LA.?? (LA.Pos (LA.idxs rowIdx), LA.Pos (LA.idxs colIdx))++{- | Compute the vector of row sums of @m@, equivalently @m@ applied to a+vector of ones. For a block @P[D, A]@ of a transition matrix, this is the+one-step probability of transitioning from each state in @D@ directly into+@A@. Results use ordinary floating-point summation and are not clamped to+@[0, 1]@.++Complexity: @O(R C + R + C)@ time, @O(C)@ temporary space, and @O(R)@+result space for an @R x C@ matrix.+-}+rowSums :: LA.Matrix Double -> LA.Vector Double+rowSums m = m LA.#> LA.konst 1 (LA.cols m)++{- | Solve @(I - Q) X = B@ by LU decomposition. @Q@ must be @n x n@, @B@+must be @n x r@, and all entries must be finite; incompatible dimensions+raise a backend error.++Returns a 'LinearSystemError' when the input or result is non-finite, the+backend reports singularity, the reciprocal condition estimate is below+@1e-12@, or the scaled infinity-norm residual exceeds @1e-9@. Current DTMC+callers choose @Q@ with spectral radius below one, which guarantees+invertibility in exact arithmetic but not a reliable 'Double' result.++Complexity: @O(n^3 + n^2 r)@ time, @O(n^2 + n r)@ temporary space, and+@O(n r)@ result space for @r@ right-hand sides.+-}+solveIminusQ ::+    LA.Matrix Double ->+    LA.Matrix Double ->+    Either LinearSystemError (LA.Matrix Double)+solveIminusQ q rightHandSide+    | not (allFinite q) = Left NonFiniteSystem+    | otherwise = solveLinearSystem coefficient rightHandSide+  where+    coefficient = LA.ident (LA.rows q) - q++{- | Solve @(I - Q) x = b@ for a vector of length @n@. This has the same+shape requirements, numerical behaviour, and errors as 'solveIminusQ'.++Complexity: @O(n^3)@ time, @O(n^2)@ temporary space, and @O(n)@ result+space.+-}+solveIminusQVector ::+    LA.Matrix Double ->+    LA.Vector Double ->+    Either LinearSystemError (LA.Vector Double)+solveIminusQVector q b =+    LA.flatten <$> solveIminusQ q (LA.asColumn b)++{- | Compute @(I - Q)^-1@ by solving @(I - Q) G = I@. When @Q@ is a+transient-to-transient transition block with spectral radius below one, this+is the fundamental matrix @sum_{k=0}^infinity Q^k@.++This requires a non-empty square matrix with finite entries and inherits the+validation and error behaviour of 'solveIminusQ'.++Complexity: @O(n^3)@ time and @O(n^2)@ temporary and result space.+-}+fundamental :: LA.Matrix Double -> Either LinearSystemError (LA.Matrix Double)+fundamental q =+    solveIminusQ q (LA.ident (LA.rows q))
+ src/Dtmc/Analysis/ReturnTime.hs view
@@ -0,0 +1,434 @@+{- |+Module      : Dtmc.Analysis.ReturnTime+Description : Exact, bounded, eventual, and expected first-return times.++First-return quantities for DTMCs. For state @i@,+@T_i^+ = inf { t >= 1 | X_t = i }@, so time zero is never a return. Scalar+exact-time and bounded queries work through any locally finite 'Transition'.+Eventual and expected queries use a finite 'TransitionMatrix'.++Exact-time and strictly bounded queries use finite recurrences. Eventual+queries use support classification and checked 'Double' linear solves.+Expected return times use class stationary distributions and Kac's formula.+Results are not clamped or renormalised.++Unless stated otherwise, complexity bounds exclude 'FiniteState' method+costs. Bounds over abstract distributions or transitions also identify the+excluded typeclass-method costs.++For finite-matrix bounds, @n@ is the state count and @E@ the support-edge+count.+-}+module Dtmc.Analysis.ReturnTime (+    -- * Result types+    LinearSystemError (..),+    Expectation (..),++    -- * First-return-time distribution+    probability,+    probabilityGivenInitialState,++    -- * Eventual return+    eventualProbability,+    eventualProbabilityGivenInitialState,++    -- * Expected return time+    expectation,+    expectationGivenInitialState,+) where++import Data.Array qualified as Array+import Data.Array.Unboxed qualified as Unboxed+import Data.Map.Strict (+    Map,+ )+import Data.Map.Strict qualified as Map+import Dtmc.Analysis.Classification (+    recurrentState,+    transientStates,+ )+import Dtmc.Analysis.Event (+    DiscreteEvent (..),+ )+import Dtmc.Analysis.Expectation (+    Expectation (..),+ )+import Dtmc.Analysis.Initial.Internal (+    expectationUnderEither,+    probabilityUnder,+    probabilityUnderEither,+ )+import Dtmc.Analysis.LinearSystem (+    LinearSystemError (..),+ )+import Dtmc.Analysis.LinearSystem.Internal (+    fundamental,+    subMatrix,+ )+import Dtmc.Analysis.Stationary (+    stationaryDistributions,+ )+import Dtmc.Distribution (+    Distribution (..),+ )+import Dtmc.Distribution.Vector.Internal (+    unDistributionVector,+ )+import Dtmc.Dynamics.Internal (+    pushSparseWeights,+ )+import Dtmc.State (+    FiniteState,+    finiteStates,+ )+import Dtmc.State.Internal (+    stateCardinalityInt,+    stateIndexInt,+ )+import Dtmc.Transition (+    Transition (..),+ )+import Dtmc.Transition.Matrix.Internal (+    TransitionMatrix,+    unTransitionMatrix,+ )+import Numeric.LinearAlgebra qualified as LA+import Numeric.Natural (+    Natural,+ )++toIndex :: (FiniteState state) => state -> Int+toIndex = stateIndexInt++advanceUntilTarget ::+    (Transition kernel, Ord (TransitionState kernel)) =>+    kernel ->+    (TransitionState kernel -> Bool) ->+    Map (TransitionState kernel) Double ->+    (Map (TransitionState kernel) Double, Double)+advanceUntilTarget kernel isTarget survivors =+    (remaining, hitMass)+  where+    advanced = pushSparseWeights survivors kernel+    (hits, remaining) = Map.partitionWithKey (\state _ -> isTarget state) advanced+    hitMass = sum (Map.elems hits)++{- | Compute the exact first-return probability+@P(T_i^+ = t | X_0 = i)@ through any 'Transition'. Time zero is exactly zero;+a self-loop returns at time one.++Complexity: excluding 'transitionLaw',+@O(k (w + e log(u + 1) + u) + 1)@ time, @O(w + u)@ temporary space, and+@O(1)@ result space, where @k = t@ and @w@, @e@, and @u@ bound per-step+survivor states, traversed transition edges, and accumulated destinations.+-}+exactProbabilityAt ::+    (Transition kernel, Ord (TransitionState kernel)) =>+    Natural ->+    kernel ->+    TransitionState kernel ->+    Double+exactProbabilityAt 0 _ _ = 0+exactProbabilityAt time kernel initialState =+    go time (Map.singleton initialState 1)+  where+    isInitial state = state == initialState++    go 0 _ = 0+    go _ survivors | Map.null survivors = 0+    go remaining survivors =+        let (next, returnMass) = advanceUntilTarget kernel isInitial survivors+         in if remaining == 1+                then returnMass+                else go (remaining - 1) next++{- | Compute the strict bounded first-return probability+@P(T_i^+ < c | X_0 = i)@ through any 'Transition'. Bounds @0@ and @1@ are+exactly zero.++Complexity: excluding 'transitionLaw',+@O(k (w + e log(u + 1) + u) + 1)@ time, @O(w + u)@ temporary space, and+@O(1)@ result space, where @k = c@ and @w@, @e@, and @u@ bound per-step+survivor states, traversed transition edges, and accumulated destinations.+-}+lowerTailProbability ::+    (Transition kernel, Ord (TransitionState kernel)) =>+    Natural ->+    kernel ->+    TransitionState kernel ->+    Double+lowerTailProbability bound kernel initialState =+    go bound (Map.singleton initialState 1) 0+  where+    isInitial state = state == initialState++    go remaining _ total | remaining <= 1 = total+    go _ survivors total | Map.null survivors = total+    go remaining survivors total =+        let (next, returnMass) = advanceUntilTarget kernel isInitial survivors+            cumulative = total + returnMass+         in cumulative `seq` go (remaining - 1) next cumulative++{- | Compute first-return probabilities+@f_i = P(T_i^+ < infinity | X_0 = i)@ in state order. Recurrent states are+exactly @1@ from support classification.++For all transient states, one fundamental-matrix solve computes+@N = (I - Q)^-1@ and @f_i = 1 - 1/N(i,i)@. Transient results inherit solver+rounding and are not clamped to @[0,1]@. Returns 'Left' if the transient system+fails the numerical contract.++Complexity: @O(n^3)@ worst-case time, @O(n^2)@ temporary space,+@O(n + E)@ retained graph-cache space, and @O(n)@ result space for @n@+states and @E@ support edges.+-}+eventualProbabilitiesByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    Either LinearSystemError (LA.Vector Double)+eventualProbabilitiesByState p = do+    transientReturns <-+        if null transient+            then Right []+            else do+                nMatrix <- fundamental (subMatrix transientIdx transientIdx matrix)+                pure+                    [ 1 - 1 / (nMatrix `LA.atIndex` (k, k))+                    | k <- [0 .. length transient - 1]+                    ]+    let transientValues :: Unboxed.UArray Int Double+        transientValues =+            Unboxed.accumArray+                (\_ x -> x)+                0+                (0, dim - 1)+                (zip transientIdx transientReturns)+        valueAt i+            | recurrentState p i = 1+            | otherwise = transientValues Unboxed.! toIndex i+    pure (LA.fromList [valueAt i | i <- finiteStates])+  where+    dim = stateCardinalityInt @state+    transient = transientStates p+    transientIdx = map toIndex transient+    matrix = unTransitionMatrix p++{- | Compute the probability of returning to one state after at least one+transition. A recurrent-state query returns exactly @1@ without forcing the+fundamental-matrix solve. Partial application shares the all-state transient+solve.++Transient queries inherit the numerical behaviour and errors of+@eventualProbabilitiesByState@.++Complexity: the first transient query takes @O(n^3)@ worst-case time and+@O(n^2)@ temporary space and may retain an @O(n)@ all-state result; later+lookups take @O(1)@ time and space. A recurrent query avoids the solve. The+matrix may retain @O(n + E)@ graph-cache space, and the scalar result occupies+@O(1)@ space.+-}+eventualProbabilityGivenInitialState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    Either LinearSystemError Double+eventualProbabilityGivenInitialState p =+    \i ->+        if recurrentState p i+            then Right 1+            else (`LA.atIndex` toIndex i) <$> probabilities+  where+    probabilities = eventualProbabilitiesByState p++{- | Compute the expected first-return time for one state. A transient state+returns 'InfiniteExpectation' without a numerical solve. For a recurrent+state @i@, Kac's formula gives @E_i T_i^+ = 1 / pi_i@, where @pi@ is the+stationary distribution of its closed communicating class.++Partial application shares the stationary distributions and resulting+all-state table. A transient query does not force that table. Numerical+failures are those of 'stationaryDistributions' or a non-positive or+non-finite recurrent stationary probability.++Complexity: the first recurrent query takes @O(n^3)@ worst-case time and+@O(n^2)@ temporary space and may retain an @O(n)@ all-state result; later+lookups take @O(1)@ time and space. A transient query avoids the stationary+solves. The matrix may retain @O(n + E)@ graph-cache space, and the scalar+result occupies @O(1)@ space.+-}+expectationGivenInitialState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    Either LinearSystemError Expectation+expectationGivenInitialState p =+    \i ->+        if recurrentState p i+            then (Array.! toIndex i) <$> recurrentExpectations+            else Right InfiniteExpectation+  where+    recurrentExpectations = recurrentReturnExpectations p++{- | Compute expected return times for all recurrent states from one set of+class-stationary solves. The array also contains infinity at transient+coordinates, although callers decide transience structurally before lookup.++Complexity: @O(n^3)@ worst-case time, @O(n^2)@ temporary space,+@O(n + E)@ retained graph-cache space, and @O(n)@ result space.+-}+recurrentReturnExpectations ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    Either LinearSystemError (Array.Array Int Expectation)+recurrentReturnExpectations p = do+    classes <- stationaryDistributions p+    recurrentEntries <- concat <$> traverse entriesForClass classes+    pure+        ( Array.accumArray+            (\_ value -> value)+            InfiniteExpectation+            (0, stateCardinalityInt @state - 1)+            recurrentEntries+        )+  where+    entriesForClass (members, distribution) =+        traverse (entry vector) members+      where+        vector = unDistributionVector distribution++    entry vector member+        | stationaryProbability <= 0 || not (finite reciprocal) = Left NonFiniteSolution+        | otherwise = Right (index, FiniteExpectation reciprocal)+      where+        index = toIndex member+        stationaryProbability = vector `LA.atIndex` index+        reciprocal = 1 / stationaryProbability++    finite value = not (isNaN value || isInfinite value)++-- Direct survivor mass @P(T_i > t)@ through a locally finite transition.+-- Unlike hitting time, the initial state is not removed at time zero: a first+-- return can occur only after at least one transition.+upperTailProbability ::+    (Transition kernel, Ord (TransitionState kernel)) =>+    Natural ->+    kernel ->+    TransitionState kernel ->+    Double+upperTailProbability time kernel initialState =+    go time (Map.singleton initialState 1)+  where+    isInitial state = state == initialState+    go 0 survivors = sum (Map.elems survivors)+    go _ survivors | Map.null survivors = 0+    go remaining survivors =+        let (next, _) = advanceUntilTarget kernel isInitial survivors+         in next `seq` go (remaining - 1) next++{- | Compute the probability of a finite-threshold event in the first-return+time @T_i^+ = inf { t >= 1 | X_t = i }@.++'EqualTo' and the lower tails reuse the direct exact/bounded recurrences.+'GreaterThan' and 'AtLeast' use surviving mass directly, include the atom at+infinity, and avoid complement cancellation. Because time zero is excluded,+'EqualTo' @0@, 'LessThan' @1@, and 'AtMost' @0@ are exactly zero, while+'GreaterThan' @0@, 'AtLeast' @0@, and 'AtLeast' @1@ are exactly one.++The initial state is sampled from the supplied distribution; each path then+measures return to its own sampled state. The query works through any locally+finite 'Transition'. Results use ordinary 'Double' arithmetic without+clamping or renormalisation.++For the complexity bounds, @s@ is the initial stored support size, @k@ the+event threshold, and @w@, @e@, and @u@ are per-step upper bounds on survivor+states, traversed transition edges, and accumulated destinations.++Complexity: excluding 'distributionWeights' and 'transitionLaw',+@O(s (k (w + e log(u + 1) + u) + 1))@ time, @O(s + w + u)@ temporary+space, and @O(1)@ result space.+-}+probability ::+    ( Distribution distribution+    , Transition kernel+    , DistributionState distribution ~ TransitionState kernel+    , Ord (TransitionState kernel)+    ) =>+    DiscreteEvent ->+    kernel ->+    distribution ->+    Double+probability event kernel initial =+    probabilityUnder initial (probabilityGivenInitialState event kernel)++{- | Compute the probability of a finite-threshold first-return event+conditioned on @X_0 = i@. The return target is that same initial state, and+time zero is not a return.++For the complexity bounds, @k@ is the event threshold and @w@, @e@, and @u@+are per-step upper bounds on survivor states, traversed transition edges, and+accumulated destinations.++Complexity: excluding 'transitionLaw',+@O(k (w + e log(u + 1) + u) + 1)@ time, @O(w + u)@ temporary space, and+@O(1)@ result space.+-}+probabilityGivenInitialState ::+    (Transition kernel, Ord (TransitionState kernel)) =>+    DiscreteEvent ->+    kernel ->+    TransitionState kernel ->+    Double+probabilityGivenInitialState event kernel initialState =+    case event of+        EqualTo time -> exactProbabilityAt time kernel initialState+        LessThan bound -> lowerTailProbability bound kernel initialState+        AtMost time -> lowerTailProbability (time + 1) kernel initialState+        GreaterThan time -> upperTailProbability time kernel initialState+        AtLeast 0 -> 1+        AtLeast time -> upperTailProbability (time - 1) kernel initialState++{- | Compute, under an arbitrary initial distribution, the probability of+eventually returning to the sampled initial state after at least one+transition. Recurrent states contribute exactly one; transient-state values+come from one shared checked fundamental-matrix solve.++Complexity: excluding 'distributionWeights', @O(n^3 + s)@ worst-case time,+@O(n^2 + s)@ temporary space, and @O(1)@ result space for @n@ states and+initial stored support size @s@. The matrix may retain @O(n + E)@ graph-cache+space.+-}+eventualProbability ::+    ( FiniteState state+    , Distribution distribution+    , DistributionState distribution ~ state+    ) =>+    TransitionMatrix state ->+    distribution ->+    Either LinearSystemError Double+eventualProbability matrix initial =+    probabilityUnderEither initial (eventualProbabilityGivenInitialState matrix)++{- | Compute the expected first-return time under an arbitrary initial+distribution. The result is infinite when a transient state has positive+initial probability. Otherwise recurrent-state expectations use shared class+stationary distributions and Kac's formula.++Complexity: excluding 'distributionWeights', @O(n^3 + s)@ worst-case time,+@O(n^2 + s)@ temporary space, and @O(1)@ result space for @n@ states and+initial stored support size @s@. The matrix may retain @O(n + E)@ graph-cache+space.+-}+expectation ::+    ( FiniteState state+    , Distribution distribution+    , DistributionState distribution ~ state+    ) =>+    TransitionMatrix state ->+    distribution ->+    Either LinearSystemError Expectation+expectation matrix initial =+    expectationUnderEither initial (expectationGivenInitialState matrix)
+ src/Dtmc/Analysis/Stationary.hs view
@@ -0,0 +1,259 @@+{- |+Module      : Dtmc.Analysis.Stationary+Description : Stationary distributions of finite chains.++Every finite irreducible DTMC has exactly one stationary distribution,+including periodic chains. A reducible chain has one extremal stationary+distribution per recurrent class and no canonical choice among them.+'stationaryDistributions' returns these class-supported distributions. Every+stationary distribution of the chain is a convex combination of them, and a+chain with two or more recurrent classes therefore has infinitely many.++Each recurrent class is solved by Grassmann-Taksar-Heyman state reduction.+GTH never forms @transpose(P) - I@ and performs no subtraction at all: every+step adds, multiplies, or divides non-negative quantities, avoiding the+cancellation that damages a balance solve on a nearly uncoupled chain. It has+the same @O(m^3)@ asymptotic cost as an LU factorisation.++Every supplied block is irreducible because a closed communicating class+restricted to itself is irreducible. This is exactly the condition under which+no elimination step can divide by zero. An 'IllConditionedSystem' is therefore+unreachable here, unlike in the hitting- and return-time solves that share the+error type. Results are not clamped or renormalised; a non-finite input or+solution, and a residual @|pi P - pi|@ above @1e-9@, are still reported+explicitly. Complexity bounds exclude 'FiniteState' method costs. For the+top-level bound, @n@ is the state count and @E@ the support-edge count.+-}+module Dtmc.Analysis.Stationary (+    LinearSystemError (..),+    stationaryDistributions,+) where++import Control.Monad.ST (+    ST,+    runST,+ )+import Data.Array.MArray (+    newListArray,+    readArray,+    writeArray,+ )+import Data.Array.ST (+    STUArray,+ )+import Data.Array.Unboxed qualified as Unboxed+import Dtmc.Analysis.Classification (+    classClosed,+    classMembers,+    communicatingClasses,+ )+import Dtmc.Analysis.LinearSystem (+    LinearSystemError (..),+ )+import Dtmc.Analysis.LinearSystem.Internal (+    subMatrix,+ )+import Dtmc.Distribution.Vector.Internal (+    DistributionVector (DistributionVector),+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.State.Internal (+    stateCardinalityInt,+    stateIndexInt,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+ )+import Dtmc.Transition.Matrix.Internal (+    unTransitionMatrix,+ )+import Numeric.LinearAlgebra qualified as LA++toIndex :: (FiniteState state) => state -> Int+toIndex = stateIndexInt++{- | Compute the stationary vector of a non-empty irreducible stochastic+block, in the block's own ordering, by Grassmann-Taksar-Heyman state+reduction.++The reduction removes states one at a time. Censoring the chain on+@{1, ..., k-1}@ -- watching it only when it is outside @k@ -- leaves a Markov+chain with the same stationary distribution up to normalisation, and its+transition probabilities are++@P'(i,j) = P(i,j) + P(i,k) P(k,j) / S,   S = sum_(j < k) P(k,j)@,++read as: reach @j@ directly, or by entering @k@ and leaving it at @j@. This is+the same elimination order as Gaussian elimination, arranged so that no+subtraction appears. In particular @S@ is accumulated from the off-diagonal+entries rather than as @1 - P(k,k)@, which is what saves a state that holds+probability close to one: the difference would lose most of its significant+digits while the sum loses none.++The back substitution reads @x(k) = sum_(i < k) x(i) P(i,k)@ off the stored+factors, @x(k)@ being the expected number of visits to @k@ per visit to the+first state in the chain censored on @{1, ..., k}@ -- non-negative, so it does+not cancel either. Normalising gives @pi@.++An irreducible block makes @S > 0@ at every step because the censored chain is+again irreducible and its last state must be able to leave. A reducible block+that reaches @S = 0@ is reported as 'SingularSystem'. Non-finite inputs,+weights, or solutions and an excessive stationarity residual produce the+corresponding 'LinearSystemError'.++Complexity: @O(m^3)@ time, @O(m^2)@ temporary space, and @O(m)@ result+space for an @m x m@ block.+-}+stationaryOfBlock ::+    LA.Matrix Double ->+    Either LinearSystemError (LA.Vector Double)+stationaryOfBlock block+    | dimension == 0 = Left SingularSystem+    | not (all isFinite (LA.toList (LA.flatten block))) = Left NonFiniteSystem+    | otherwise =+        case reduceGth dimension (LA.toList (LA.flatten block)) of+            Nothing -> Left SingularSystem+            Just weights -> normalise weights+  where+    dimension = LA.rows block+    normalise weights+        | not (all isFinite weights) = Left NonFiniteSolution+        | scale <= 0 = Left SingularSystem+        | not (isFinite total) = Left NonFiniteSolution+        | total <= 0 = Left SingularSystem+        | not (all isFinite stationaryWeights) = Left NonFiniteSolution+        | not (isFinite residual) = Left NonFiniteSolution+        | residual > limit =+            Left+                ( ResidualTooLarge+                    { relativeResidual = residual+                    , residualLimit = limit+                    }+                )+        | otherwise = Right stationary+      where+        limit = 1e-9+        scale = maximum weights+        scaledWeights = map (/ scale) weights+        total = sum scaledWeights+        stationaryWeights = map (/ total) scaledWeights+        stationary = LA.fromList stationaryWeights+        residual =+            foldr (max . abs) 0 (LA.toList (LA.tr block LA.#> stationary - stationary))++isFinite :: Double -> Bool+isFinite value = not (isNaN value || isInfinite value)++-- Allocating through a signature that quantifies the state thread keeps the+-- array type unambiguous without local annotations inside 'runST'.+newFlatArray :: (Int, Int) -> [Double] -> ST s (STUArray s Int Double)+newFlatArray = newListArray++{- | Compute the unnormalised GTH weights of an @n x n@ block supplied in+row-major order. Return 'Nothing' when an elimination step finds no positive+way out of the state being removed.++The caller must supply exactly @n^2@ entries. This helper performs no+finiteness, stochasticity, or irreducibility validation.++Complexity: @O(n^3)@ time, @O(n^2)@ temporary space, and @O(n)@ result+space.+-}+reduceGth :: Int -> [Double] -> Maybe [Double]+reduceGth n entries = runST $ do+    a <- newFlatArray (0, n * n - 1) entries+    let index i j = i * n + j++        exitMass k =+            sum <$> mapM (readArray a . index k) [0 .. k - 1]++        absorbRow k s i = do+            entering <- readArray a (index i k)+            let scaled = entering / s+            writeArray a (index i k) scaled+            mapM_+                ( \j -> do+                    leaving <- readArray a (index k j)+                    current <- readArray a (index i j)+                    writeArray a (index i j) (current + scaled * leaving)+                )+                [0 .. k - 1]++        eliminate k+            | k < 1 = pure True+            | otherwise = do+                s <- exitMass k+                if s <= 0+                    then pure False+                    else do+                        mapM_ (absorbRow k s) [0 .. k - 1]+                        eliminate (k - 1)++        -- visits holds x(0) .. x(k-1) in order.+        substitute k visits+            | k >= n = pure visits+            | otherwise = do+                terms <-+                    mapM+                        (\(i, x) -> (x *) <$> readArray a (index i k))+                        (zip [0 ..] visits)+                substitute (k + 1) (visits ++ [sum terms])++    feasible <- eliminate (n - 1)+    if feasible+        then Just <$> substitute 1 [1]+        else pure Nothing++{- | Compute the extremal stationary distributions, one per recurrent class+and paired with the class on which each lives. Classes come in the order of+'Dtmc.Analysis.Classification.communicatingClasses', that is by least member.+An empty chain returns an empty list.++Each distribution is returned over the whole state space, carrying exact zeros+outside its class. This is correct rather than merely convenient: a recurrent+class is closed, so a distribution supported on it satisfies @pi P = pi@ for+the full matrix, and no stationary distribution of a finite chain puts mass on+a transient state.++Every stationary distribution of the chain is a convex combination of these.+The result has exactly one element precisely when the stationary distribution+is unique, including reducible chains with transient states and one recurrent+class. It has two or more elements exactly when the chain has infinitely many+stationary distributions.++Each class is solved separately. The first numerical failure aborts the+traversal, although the error does not identify its class.++Complexity: @O(n^2 + sum_C |C|^3)@ time, at most @O(n^3)@, and @O(n^2)@+temporary space. Result space is @O(c n)@ for @c@ recurrent classes. The+matrix may retain @O(n + E)@ graph-cache space.+-}+stationaryDistributions ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    Either LinearSystemError [([state], DistributionVector state)]+stationaryDistributions p =+    traverse distributionOn closedClasses+  where+    dim = stateCardinalityInt @state+    matrix = unTransitionMatrix p+    closedClasses =+        [classMembers c | c <- communicatingClasses p, classClosed c]+    distributionOn members = do+        solution <- stationaryOfBlock (subMatrix indices indices matrix)+        let placed :: Unboxed.UArray Int Double+            placed =+                Unboxed.accumArray+                    (\_ x -> x)+                    0+                    (0, dim - 1)+                    (zip indices (LA.toList solution))+        pure+            ( members+            , DistributionVector (LA.fromList [placed Unboxed.! i | i <- [0 .. dim - 1]])+            )+      where+        indices = map toIndex members
+ src/Dtmc/Analysis/VisitCount.hs view
@@ -0,0 +1,729 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++{- |+Module      : Dtmc.Analysis.VisitCount+Description : Finite- and infinite-horizon visit-count analysis.++Exact analysis of visit counts. The bounded functions count visits to a state+predicate before a strict time bound and work through any locally finite+'Transition'. The total-count functions analyse visits to one state over the+entire path of a finite 'TransitionMatrix'. Both notions include the initial+state at time zero.++For a target state @i@, the total visit count is+@V_i = sum_(t = 0)^infinity 1_{X_t = i}@. Its law is determined by the+probability of ever hitting @i@ and the probability of returning to @i@. The+implementation uses exact graph classification for zero and infinite cases,+and checked 'Double' linear solves for the remaining probabilities. It does+not simulate, truncate an infinite series, clamp, or renormalise results.++Unless a declaration states otherwise, complexity bounds exclude+'FiniteState' method costs. Bounds for operations over abstract distributions+or transitions also identify excluded typeclass-method and predicate costs.+-}+module Dtmc.Analysis.VisitCount (+    -- * Result types+    LinearSystemError (..),+    Expectation (..),++    -- * Total visits over an infinite horizon+    totalProbability,+    totalProbabilityGivenInitialState,+    infiniteProbability,+    infiniteProbabilityGivenInitialState,+    totalExpectation,+    totalExpectationGivenInitialState,++    -- * Visits within a bounded horizon+    boundedLaw,+    boundedProbability,+    boundedProbabilityGivenInitialState,+    boundedExpectation,+    boundedExpectationGivenInitialState,++    -- * Occupation matrix+    occupationMatrix,+) where++import Data.Array qualified as Array+import Data.Array.Unboxed qualified as Unboxed+import Data.Map.Strict qualified as Map+import Dtmc.Analysis.Absorption (+    fundamentalMatrix,+ )+import Dtmc.Analysis.Classification (+    classClosed,+    classMembers,+    communicatingClasses,+    recurrentState,+ )+import Dtmc.Analysis.Classification.Internal (+    backwardReachable,+ )+import Dtmc.Analysis.Event (+    DiscreteEvent (..),+    matches,+ )+import Dtmc.Analysis.Expectation (+    Expectation (..),+ )+import Dtmc.Analysis.HittingTime qualified as Hit+import Dtmc.Analysis.Initial.Internal (+    expectationUnderEither,+    probabilityUnderEither,+ )+import Dtmc.Analysis.LinearSystem (+    LinearSystemError (..),+ )+import Dtmc.Analysis.ReturnTime qualified as Return+import Dtmc.Distribution (+    Distribution (..),+ )+import Dtmc.Distribution.Map (+    pointMass,+ )+import Dtmc.Distribution.Map.Internal (+    DistributionMap (DistributionMap),+    unDistributionMap,+ )+import Dtmc.Dynamics.Internal (+    pushSparseWeights,+ )+import Dtmc.State (+    FiniteState,+    finiteStates,+ )+import Dtmc.State.Internal (+    stateCardinalityInt,+    stateIndexInt,+ )+import Dtmc.Transition (+    Transition (..),+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+ )+import Numeric.LinearAlgebra qualified as LA+import Numeric.Natural (+    Natural,+ )++toIndex :: (FiniteState state) => state -> Int+toIndex = stateIndexInt++{- | Build a Boolean mask of the states from which at least one seed is+reachable. The reverse support graph is traversed once for the whole seed set.++Complexity: excluding shared support-graph construction, @O(n + E + s)@ time,+@O(n + E + s)@ temporary space, and @O(n)@ result space for @n@ states, @E@+support edges, and @s@ supplied seeds.+-}+backwardReachabilityMask ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    [state] ->+    Unboxed.UArray Int Bool+backwardReachabilityMask matrix seeds =+    Unboxed.accumArray+        (||)+        False+        (0, stateCardinalityInt @state - 1)+        [ (toIndex state, True)+        | state <- backwardReachable matrix (const True) seeds+        ]++{- | Compute probabilities of exactly @n@ total visits in canonical state order.+The count is the first argument and the target is the third; coordinate @j@ is+@P(V_i = n | X_0 = j)@.++Writing @h_ji = P_j(H_i < infinity)@ and+@f_i = P_i(T_i^+ < infinity)@, a transient target has++* @P_j(V_i = 0) = 1 - h_ji@;+* @P_j(V_i = n) = h_ji f_i^(n - 1) (1 - f_i)@ for @n >= 1@;++For a recurrent target, every positive finite count has probability zero.+Recurrence is decided from the support graph, not by comparing a computed+return probability with one.++Structural zero cases avoid a linear solve. Other cases inherit the numerical+behaviour and errors of the state-conditioned eventual hitting and return+queries.++Complexity: @O(m^3 + log(n + 1))@ worst-case time, @O(m^2)@ temporary+space, and @O(m)@ result space for @m@ states.+-}+exactProbabilitiesByState ::+    forall state.+    (FiniteState state) =>+    Natural ->+    TransitionMatrix state ->+    state ->+    Either LinearSystemError (LA.Vector Double)+exactProbabilitiesByState count matrix target+    | count == 0 = mapProbabilities (1 -) <$> hitting+    | recurrentState matrix target = Right zeroProbabilities+    | otherwise = do+        hits <- hitting+        returning <- Return.eventualProbabilityGivenInitialState matrix target+        let finiteMass = returning ^ (count - 1) * (1 - returning)+        pure (mapProbabilities (* finiteMass) hits)+  where+    hitting :: Either LinearSystemError (LA.Vector Double)+    hitting =+        LA.fromList+            <$> traverse+                (Hit.eventualProbabilityGivenInitialState matrix [target])+                finiteStates+    zeroProbabilities = LA.fromList [0 | _ <- finiteStates @state]+    mapProbabilities = LA.cmap++{- | Compute probabilities of infinitely many visits in canonical initial-state+order.+For target @i@, coordinate @j@ is @P(V_i = infinity | X_0 = j)@. A recurrent+target returns its hitting probabilities; a transient target returns an exact+zero vector without a linear solve.++Recurrence is decided from the support graph. The recurrent case inherits the+numerical behaviour and errors of+'Dtmc.Analysis.HittingTime.eventualProbabilityGivenInitialState'.++Complexity: @O(n^3)@ worst-case time, @O(n^2)@ temporary space, and @O(n)@+result space.+-}+infiniteProbabilitiesByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    Either LinearSystemError (LA.Vector Double)+infiniteProbabilitiesByState matrix target+    | recurrentState matrix target =+        LA.fromList+            <$> traverse+                (Hit.eventualProbabilityGivenInitialState matrix [target])+                finiteStates+    | otherwise = Right (LA.fromList [0 | _ <- finiteStates @state])++{- | Compute the probability of infinitely many visits from one initial state.+Argument order is matrix, target, then initial state. Partially applying the+matrix and target shares the all-state computation.++Complexity: the first forced query takes @O(n^3)@ worst-case time,+@O(n^2)@ temporary space, and may retain an @O(n)@ all-state cache;+subsequent shared lookups take @O(1)@ time. The scalar result occupies+@O(1)@ space.+-}+infiniteProbabilityGivenInitialState ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    state ->+    Either LinearSystemError Double+infiniteProbabilityGivenInitialState matrix target =+    \initial -> (`LA.atIndex` toIndex initial) <$> probabilities+  where+    probabilities = infiniteProbabilitiesByState matrix target++{- | Compute expected total visits to the target in canonical initial-state+order.++For a transient target @i@, coordinate @j@ is+@h_ji / (1 - f_i)@. For a recurrent target it is zero when @i@ is+unreachable from @j@ and 'InfiniteExpectation' otherwise. The recurrent case+is decided entirely from the support graph and requires no linear solve.++Transient results inherit the numerical behaviour and errors of+the state-conditioned eventual hitting and return queries.++Complexity: @O(n^3)@ worst-case time, @O(n^2)@ temporary space, and @O(n)@+result space.+-}+totalExpectationsByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    Either LinearSystemError [Expectation]+totalExpectationsByState matrix target+    | recurrentState matrix target =+        Right+            [ if reachingTarget Unboxed.! toIndex initial+                then InfiniteExpectation+                else FiniteExpectation 0+            | initial <- finiteStates @state+            ]+    | otherwise = do+        hits <-+            traverse+                (Hit.eventualProbabilityGivenInitialState matrix [target])+                finiteStates+        returning <- Return.eventualProbabilityGivenInitialState matrix target+        pure+            [ FiniteExpectation (hit / (1 - returning))+            | hit <- hits+            ]+  where+    reachingTarget = backwardReachabilityMask matrix [target]++{- | Compute expected total visits to the target from one initial state.+Argument order is matrix, target, then initial state. Partially applying the+matrix and target shares the all-state computation.++Complexity: the first forced query takes @O(n^3)@ worst-case time,+@O(n^2)@ temporary space, and may retain an @O(n)@ all-state cache;+subsequent shared list lookups take @O(n)@ worst-case time and @O(1)@+temporary space. The scalar result occupies @O(1)@ space.+-}+totalExpectationGivenInitialState ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    state ->+    Either LinearSystemError Expectation+totalExpectationGivenInitialState matrix target =+    \initial -> (!! toIndex initial) <$> expectations+  where+    expectations = totalExpectationsByState matrix target++iterateNatural :: Natural -> (value -> value) -> value -> value+iterateNatural steps advance = go steps+  where+    go 0 value = value+    go remaining value =+        let next = advance value+         in next `seq` go (remaining - 1) next++{- | Construct the distribution of+@N_A(c) = sum_(t = 0)^(c - 1) 1_A(X_t)@, the number of visits to the supplied+state predicate strictly before time @c@.++The time bound is the first argument, consistently with the other+finite-horizon APIs. Bound zero returns a point mass at count zero. At a+positive bound, the initial state at time zero is included. Consequently the+result is supported on counts from zero through the bound.++The result is computed from the exact finite reachable support of the joint+process @(X_t, N_A(t + 1))@. Ordinary 'Double' arithmetic is preserved without+clamping or renormalisation.++For the complexity bounds, @k@ is the time bound, @s@ the initial stored+support size, @j@ an upper bound on live or accumulated joint+@(state, count)@ pairs, @e@ an upper bound on transition edges traversed per+step, and @r@ an upper bound on count keys accumulated before final zero+removal. The returned support contains at most @r@ counts.++Complexity: excluding the initial 'distributionWeights' call,+'transitionLaw', and predicate evaluation,+@O(s log(s + 1) + k (j + e log(j + 1)) + j log(r + 1) + r)@ time,+@O(j + r)@ temporary space, and @O(r)@ result space. At @k = 0@ the function+takes @O(1)@ time and space and does not inspect its other arguments.+-}+boundedLaw ::+    ( Distribution distribution+    , Transition transition+    , DistributionState distribution ~ TransitionState transition+    , Ord (TransitionState transition)+    ) =>+    Natural ->+    distribution ->+    transition ->+    (TransitionState transition -> Bool) ->+    DistributionMap Natural+boundedLaw bound initial transition isVisited+    | bound == 0 = DistributionMap (Map.singleton 0 1)+    | otherwise = DistributionMap (countMarginal finalJoint)+  where+    initialJoint =+        Map.fromList+            [ ((state, if isVisited state then 1 else 0), weight)+            | (state, weight) <- distributionWeights initial+            , weight /= 0+            ]+    finalJoint =+        iterateNatural (bound - 1) advanceJoint initialJoint++    advanceJoint joint =+        Map.filter (/= 0) (Map.foldlWithKey' advanceState Map.empty joint)++    advanceState accumulated (state, count) stateWeight =+        Map.foldlWithKey'+            (advanceDestination count stateWeight)+            accumulated+            (unDistributionMap (transitionLaw transition state))++    advanceDestination count stateWeight accumulated nextState transitionWeight =+        Map.insertWith+            (+)+            (nextState, count + if isVisited nextState then 1 else 0)+            (stateWeight * transitionWeight)+            accumulated++    countMarginal =+        Map.filter (/= 0)+            . Map.foldlWithKey'+                (\counts (_, count) weight -> Map.insertWith (+) count weight counts)+                Map.empty++{- | Compute the expected number of visits before the strict time bound. Using+@E(N_A(c)) = sum_(t = 0)^(c - 1) P(X_t in A)@, this evolves only the state+marginal rather than constructing the joint count distribution. The result+lies mathematically between zero and the bound, subject to ordinary+floating-point error.++For the complexity bounds, @k@ is the time bound, @s@ the initial stored+support size, and @w@, @e@, and @u@ are per-step upper bounds on stored source+states, traversed transition edges, and accumulated destination states.++Complexity: excluding the initial 'distributionWeights' call,+'transitionLaw', and predicate evaluation,+@O(s log(s + 1) + k (w + e log(u + 1) + u))@ time, @O(w + u)@ temporary+space, and @O(1)@ result space. At @k = 0@ the function takes @O(1)@ time and+space and does not inspect its other arguments.+-}+boundedExpectation ::+    ( Distribution distribution+    , Transition transition+    , DistributionState distribution ~ TransitionState transition+    , Ord (TransitionState transition)+    ) =>+    Natural ->+    distribution ->+    transition ->+    (TransitionState transition -> Bool) ->+    Double+boundedExpectation bound initial transition isVisited =+    go bound (Map.fromList (distributionWeights initial)) 0+  where+    go 0 _ expectation = expectation+    go remaining weights expectation =+        let visitProbability =+                Map.foldlWithKey'+                    ( \total state weight ->+                        if isVisited state then total + weight else total+                    )+                    0+                    weights+            cumulative = expectation + visitProbability+         in if remaining == 1+                then cumulative+                else+                    let next = pushSparseWeights weights transition+                     in cumulative `seq` next `seq` go (remaining - 1) next cumulative++{- | Compute, under an arbitrary initial distribution, the probability of a+finite-threshold event in the total number of visits+@V_i = sum_(t = 0)^infinity 1_{X_t = i}@.++The initial state at time zero is included. Upper-tail events include the atom+at infinity. For @h_ji = P_j(H_i < infinity)@ and transient-target return+probability @f_i@, the implementation evaluates+@P_j(V_i > n) = h_ji f_i^n@ directly. Recurrent targets use support+classification, so their positive mass is placed structurally at infinity.++The implementation mixes the internally shared state-conditioned results+under the supplied initial distribution.++For the complexity bounds, @n@ is the state count, @s@ the initial stored+support size, and @k@ the event's numeric threshold.++Complexity: excluding 'distributionWeights', @O(n^3 + s + log(k + 1))@+worst-case time, @O(n^2 + s)@ temporary space, and @O(1)@ result space.+-}+totalProbability ::+    ( FiniteState state+    , Distribution distribution+    , DistributionState distribution ~ state+    ) =>+    DiscreteEvent ->+    TransitionMatrix state ->+    state ->+    distribution ->+    Either LinearSystemError Double+totalProbability event matrix target initial =+    probabilityUnderEither initial (totalProbabilityGivenInitialState event matrix target)++{- | Compute the probability of a total-visit event conditioned on @X_0 = j@.+Partially applying the event, matrix, and target shares the all-state+computation.++Complexity: the first forced query takes @O(n^3 + log(k + 1))@ worst-case+time, @O(n^2)@ temporary space, and may retain an @O(n)@ all-state cache for+event threshold @k@; subsequent shared lookups take @O(1)@ time. The scalar+result occupies @O(1)@ space.+-}+totalProbabilityGivenInitialState ::+    (FiniteState state) =>+    DiscreteEvent ->+    TransitionMatrix state ->+    state ->+    state ->+    Either LinearSystemError Double+totalProbabilityGivenInitialState event matrix target =+    \initial -> (`LA.atIndex` toIndex initial) <$> probabilities+  where+    probabilities = totalProbabilityByState event matrix target++{- | Compute total-visit event probabilities in canonical initial-state order.+Coordinate @j@ is @P_j(V_i in E)@ for the supplied target @i@ and+'DiscreteEvent' @E@. Upper tails are evaluated directly and include infinitely+many visits; lower tails contain finite counts only.++Graph classification and any required checked linear solves are shared across+all initial states. Structural zero and one boundaries avoid a solve.++Complexity: @O(n^3 + log(k + 1))@ worst-case time, @O(n^2)@ temporary+space, and @O(n)@ result space for @n@ states and event threshold @k@.+-}+totalProbabilityByState ::+    forall state.+    (FiniteState state) =>+    DiscreteEvent ->+    TransitionMatrix state ->+    state ->+    Either LinearSystemError (LA.Vector Double)+totalProbabilityByState event matrix target =+    case event of+        EqualTo count -> exactProbabilitiesByState count matrix target+        LessThan 0 -> Right zeros+        LessThan bound -> atMost (bound - 1)+        AtMost count -> atMost count+        GreaterThan count -> after count+        AtLeast 0 -> Right ones+        AtLeast count -> after (count - 1)+  where+    recurrent = recurrentState matrix target+    hits :: Either LinearSystemError (LA.Vector Double)+    hits =+        LA.fromList+            <$> traverse+                (Hit.eventualProbabilityGivenInitialState matrix [target])+                finiteStates+    zeros = LA.fromList [0 | _ <- finiteStates @state]+    ones = LA.fromList [1 | _ <- finiteStates @state]+    mapValues = LA.cmap++    atMost count+        | recurrent = mapValues (1 -) <$> hits+        | otherwise = do+            hitValues <- hits+            returning <- Return.eventualProbabilityGivenInitialState matrix target+            pure+                ( mapValues+                    (\hit -> 1 - hit * returning ^ count)+                    hitValues+                )++    after count+        | recurrent = hits+        | count == 0 = hits+        | otherwise = do+            hitValues <- hits+            returning <- Return.eventualProbabilityGivenInitialState matrix target+            pure (mapValues (* (returning ^ count)) hitValues)++{- | Compute, under an arbitrary initial distribution, the probability of+infinitely many visits to the target. A transient target gives exactly zero;+a recurrent target mixes its state-conditioned hitting probabilities. Any+numerical failure comes from the checked hitting-probability solve.++Complexity: excluding 'distributionWeights', @O(n^3 + s)@ worst-case time,+@O(n^2 + s)@ temporary space, and @O(1)@ result space for @n@ states and+initial stored support size @s@.+-}+infiniteProbability ::+    ( FiniteState state+    , Distribution distribution+    , DistributionState distribution ~ state+    ) =>+    TransitionMatrix state ->+    state ->+    distribution ->+    Either LinearSystemError Double+infiniteProbability matrix target initial =+    probabilityUnderEither initial (infiniteProbabilityGivenInitialState matrix target)++{- | Compute expected total visits under an arbitrary initial distribution.++A recurrent target gives 'InfiniteExpectation' exactly when it is reachable+from a state with positive initial weight. A transient target has a finite+result unless a required checked hitting or return solve fails.++Complexity: excluding 'distributionWeights', @O(n^3 + s n)@ worst-case time,+@O(n^2 + s)@ temporary space, and @O(1)@ result space for @n@ states and+initial stored support size @s@.+-}+totalExpectation ::+    ( FiniteState state+    , Distribution distribution+    , DistributionState distribution ~ state+    ) =>+    TransitionMatrix state ->+    state ->+    distribution ->+    Either LinearSystemError Expectation+totalExpectation matrix target initial =+    expectationUnderEither initial (totalExpectationGivenInitialState matrix target)++{- | Compute the probability of a 'DiscreteEvent' in the number of visits+strictly before a finite time bound. The bounded law has no atom at infinity,+and values outside its support contribute exactly zero.++Use @k@, @s@, @j@, @e@, and @r@ as defined for 'boundedLaw'.++Complexity: excluding the initial 'distributionWeights' call,+'transitionLaw', and predicate evaluation,+@O(s log(s + 1) + k (j + e log(j + 1)) + j log(r + 1) + r)@ time,+@O(j + r)@ temporary space, and @O(1)@ result space. At @k = 0@ the function+takes @O(1)@ time and space.+-}+boundedProbability ::+    ( Distribution distribution+    , Transition transition+    , DistributionState distribution ~ TransitionState transition+    , Ord (TransitionState transition)+    ) =>+    Natural ->+    DiscreteEvent ->+    distribution ->+    transition ->+    (TransitionState transition -> Bool) ->+    Double+boundedProbability bound event initial transition isVisited =+    sum+        [ weight+        | (count, weight) <- distributionWeights law+        , matches event count+        ]+  where+    law = boundedLaw bound initial transition isVisited++{- | Compute the probability of a bounded visit-count event conditioned on+@X_0 = i@.++Use @k@, @j@, @e@, and @r@ as defined for 'boundedLaw'; the initial support+has size one.++Complexity: excluding 'transitionLaw' and predicate evaluation,+@O(k (j + e log(j + 1)) + j log(r + 1) + r)@ time, @O(j + r)@ temporary+space, and @O(1)@ result space. At @k = 0@ the function takes @O(1)@ time and+space.+-}+boundedProbabilityGivenInitialState ::+    ( Transition transition+    , Ord (TransitionState transition)+    ) =>+    Natural ->+    DiscreteEvent ->+    TransitionState transition ->+    transition ->+    (TransitionState transition -> Bool) ->+    Double+boundedProbabilityGivenInitialState bound event initial =+    boundedProbability bound event (pointMass initial)++{- | Compute expected visits before a strict finite time bound conditioned on+@X_0 = i@.++Use @k@, @w@, @e@, and @u@ as defined for 'boundedExpectation'; the initial+support has size one.++Complexity: excluding 'transitionLaw' and predicate evaluation,+@O(k (w + e log(u + 1) + u))@ time, @O(w + u)@ temporary space, and @O(1)@+result space. At @k = 0@ the function takes @O(1)@ time and space.+-}+boundedExpectationGivenInitialState ::+    ( Transition transition+    , Ord (TransitionState transition)+    ) =>+    Natural ->+    TransitionState transition ->+    transition ->+    (TransitionState transition -> Bool) ->+    Double+boundedExpectationGivenInitialState bound initial =+    boundedExpectation bound (pointMass initial)++{- | Compute the occupation matrix of the chain, also known as its Green+function. Entry @(i, j)@ is+@sum_(n >= 0) (P^n)(i,j) = E(V_j | X_0 = i)@, the expected total number of+visits to @j@ started from @i@. Rows and columns follow the canonical order of+the 'FiniteState' instance.++Unlike 'Dtmc.Analysis.Absorption.fundamentalMatrix', which is the finite+@T x T@ block, this is defined on the whole state space and therefore needs+'Expectation': a recurrent target reachable from @i@ is visited infinitely+often almost surely. The four cases are++* @j@ transient and @i@ transient: the corresponding entry of+  @(I - Q)^-1@;+* @j@ transient and @i@ recurrent: exactly zero, because a recurrent class is+  closed and cannot reach a transient state;+* @j@ recurrent and reachable from @i@: 'InfiniteExpectation';+* @j@ recurrent and unreachable from @i@: exactly zero.++Only the transient block needs arithmetic; the infinite and zero entries come+from the support graph, so they are exact.+'Dtmc.Analysis.VisitCount.totalExpectation' computes single entries by a+different route and agrees with this one.++Returns 'Left' when construction of the transient fundamental matrix fails+the checked linear-system contract.++If there are @c@ recurrent classes, reverse reachability is computed once per+class and shared by every target in it.++Complexity: for @n@ states, @t@ transient states, @E@ support edges, and @c@+closed classes, full evaluation takes+@O(n^2 + (n + E) log(n + 1) + t^3 + c (n + E) + n^2 log(t + 1))@ time,+@O(n^2)@ temporary space, @O(n + E)@ retained graph-cache space, and+@O(n^2)@ result space. The time bound is @O(n^3)@ in the worst case.+-}+occupationMatrix ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    Either LinearSystemError [[Expectation]]+occupationMatrix p = do+    (transient, block) <- fundamentalMatrix p+    let table =+            Map.fromList+                [ ((i, j), value)+                | (i, row) <- zip transient block+                , (j, value) <- zip transient row+                ]+        closedClasses =+            [ classMembers recurrentClass+            | recurrentClass <- communicatingClasses p+            , classClosed recurrentClass+            ]+        classCount = length closedClasses+        classByState :: Unboxed.UArray Int Int+        classByState =+            Unboxed.accumArray+                (\_ classIndex -> classIndex)+                (-1)+                (0, stateCardinalityInt @state - 1)+                [ (toIndex member, classIndex)+                | (classIndex, members) <- zip [0 ..] closedClasses+                , member <- members+                ]+        reachesClass :: Array.Array Int (Unboxed.UArray Int Bool)+        reachesClass =+            Array.listArray+                (0, classCount - 1)+                [ backwardReachabilityMask p members+                | members <- closedClasses+                ]+        valueAt i j+            | targetClass >= 0 =+                if (reachesClass Array.! targetClass) Unboxed.! toIndex i+                    then InfiniteExpectation+                    else FiniteExpectation 0+            | otherwise =+                FiniteExpectation (Map.findWithDefault 0 (i, j) table)+          where+            targetClass = classByState Unboxed.! toIndex j+    pure [[valueAt i j | j <- finiteStates] | i <- finiteStates]
+ src/Dtmc/Distribution.hs view
@@ -0,0 +1,75 @@+{- |+Module      : Dtmc.Distribution+Description : Shared abstraction for finite-support probability distributions.++The 'Distribution' class captures the read-only probability operations shared+by concrete distribution representations. Implementations live in+"Dtmc.Distribution.Vector" and "Dtmc.Distribution.Map".+-}+module Dtmc.Distribution (+    Distribution (..),+    DistributionError (..),+) where++import Dtmc.Simplex (+    SimplexError,+ )++{- | A simplex failure while constructing a distribution representation.+For a map-backed law, coordinate indices refer to ascending state order after+duplicate states have been combined and exact-zero weights omitted. The+wrapper keeps distribution failures distinct from transition-matrix row+failures.+-}+newtype DistributionError+    = -- | Wrap the underlying simplex failure.+      DistributionError SimplexError+    deriving (Eq, Show)++{- | A discrete probability distribution with finite stored support.++The class exposes observations common to every representation. Conversions+belong to the target representation module, so this abstraction does not+depend on a particular carrier. A lawful instance has finite, non-negative+weights summing to one and reports each state at most once. Public operations+still validate where an unchecked or numerically derived value could otherwise+cause a backend failure.+-}+class Distribution distribution where+    -- | State type carried by the distribution representation.+    type DistributionState distribution++    {- | Read the stored probability of one state, returning exactly zero when+    the representation does not store that state. The value is returned+    without clamping or revalidation.++    Complexity: implementation-dependent.+    -}+    probabilityAt ::+        (Ord (DistributionState distribution)) =>+        distribution ->+        DistributionState distribution ->+        Double++    {- | Return canonical ascending state weights. Exact-zero weights are+    omitted. Custom instances and numerically derived values are returned+    without revalidation.++    Complexity: implementation-dependent.+    -}+    distributionWeights ::+        distribution ->+        [(DistributionState distribution, Double)]++    {- | Return states with strictly positive stored weight, in ascending+    order. Non-positive coordinates from custom instances or unchecked+    numerical operations are not mathematical support.++    Complexity: implementation-dependent.+    -}+    support :: distribution -> [DistributionState distribution]+    support distribution =+        [ state+        | (state, weight) <- distributionWeights distribution+        , weight > 0+        ]
+ src/Dtmc/Distribution/Map.hs view
@@ -0,0 +1,112 @@+{- |+Module      : Dtmc.Distribution.Map+Description : Map-backed finite-support probability distributions.++t'DistributionMap' stores the nonzero coordinates of a probability law in a+'Data.Map.Strict.Map'. The represented state type is otherwise unrestricted.+-}+module Dtmc.Distribution.Map (+    DistributionMap,+    fromList,+    fromDistribution,+    pointMass,+    mapStates,+    toMap,+) where++import Data.Bifunctor (+    first,+ )+import Data.Map.Strict qualified as Map+import Dtmc.Distribution (+    Distribution (..),+    DistributionError (DistributionError),+ )+import Dtmc.Distribution.Map.Internal (+    DistributionMap (DistributionMap),+    unDistributionMap,+ )+import Dtmc.Simplex.Internal (+    canonicaliseSimplexEntries,+ )++{- | Construct a canonical finite-support probability law. Duplicate states+are combined, entries whose combined weight is exactly zero are removed, and+input order is ignored. Tolerated coordinate error is clamped to @[0, 1]@;+the repaired weights are normalised, and weights repaired to zero are omitted.++Complexity: @O(m log m)@ time for @m@ supplied entries, with @O(s)@ temporary+and result space for @s@ distinct states.+-}+fromList ::+    (Ord state) =>+    [(state, Double)] ->+    Either DistributionError (DistributionMap state)+fromList entries =+    DistributionMap+        . Map.fromDistinctAscList+        . filter ((/= 0) . snd)+        . zip (Map.keys combined)+        <$> first+            DistributionError+            (canonicaliseSimplexEntries (Map.elems combined))+  where+    combined = Map.filter (/= 0) (Map.fromListWith (+) entries)++{- | Construct the point mass concentrated on one state.++Complexity: @O(1)@ time and @O(1)@ result space.+-}+pointMass :: state -> DistributionMap state+pointMass state = DistributionMap (Map.singleton state 1)++{- | Push a distribution through a deterministic state mapping. Weights whose+states map to the same target are added, and an exact-zero combined weight is+removed.++No validation, clamping, or renormalisation is performed. A valid input+therefore remains a probability distribution up to ordinary floating-point+summation error.++Complexity: @O(s log(s + 1))@ time, @O(s)@ temporary space, and @O(r)@+result space for @s@ stored source states and @r@ distinct target states.+-}+mapStates ::+    (Ord target) =>+    (source -> target) ->+    DistributionMap source ->+    DistributionMap target+mapStates transform =+    DistributionMap+        . Map.filter (/= 0)+        . Map.mapKeysWith (+) transform+        . unDistributionMap++{- | Convert any distribution representation to a map without revalidation or+renormalisation. Weights reported for the same state are added and an+exact-zero combined weight is removed, so an instance that reports states out+of order, or reports one twice, still yields a structurally sound map. Whether+the reported weights form a probability law remains the obligation of the+'Distribution' instance.++Complexity: the cost of 'distributionWeights', plus @O(s log s)@ time and+@O(s)@ temporary and result space for @s@ returned weights.+-}+fromDistribution ::+    (Distribution distribution, Ord (DistributionState distribution)) =>+    distribution ->+    DistributionMap (DistributionState distribution)+fromDistribution =+    DistributionMap+        . Map.filter (/= 0)+        . Map.fromListWith (+)+        . distributionWeights++{- | Project the stored coordinates as a strict map. Exact-zero coordinates+are already omitted, so the result carries the mathematical support with its+weights.++Complexity: @O(1)@ time and space; the stored map is shared, not copied.+-}+toMap :: DistributionMap state -> Map.Map state Double+toMap = unDistributionMap
+ src/Dtmc/Distribution/Map/Internal.hs view
@@ -0,0 +1,67 @@+{- |+Module      : Dtmc.Distribution.Map.Internal+Description : Unsafe carrier for map-backed distributions.++The public smart constructor validates and canonicalises the simplex+invariant. Internal callers may construct values only when their operation+preserves that invariant up to floating-point error.+-}+module Dtmc.Distribution.Map.Internal (+    DistributionMap (DistributionMap),+    unDistributionMap,+    denseWeights,+) where++import Data.Map.Strict (+    Map,+ )+import Data.Map.Strict qualified as Map+import Dtmc.Distribution (+    Distribution (..),+ )++{- | A finite-support probability distribution backed by a strict map. The+internal constructor performs no validation.+-}+newtype DistributionMap state+    = -- | Wrap an unchecked state-to-weight map.+      DistributionMap (Map state Double)++type role DistributionMap nominal++deriving instance (Eq state) => Eq (DistributionMap state)+deriving instance (Show state) => Show (DistributionMap state)++{- | Return the canonical state-to-weight map without copying or validation.++Complexity: @O(1)@ time and @O(1)@ space.+-}+unDistributionMap :: DistributionMap state -> Map state Double+unDistributionMap (DistributionMap weights) = weights++{- | Return the weights of a map-backed distribution over a supplied ascending+state list, inserting exact zeros for absent states. Stored states absent from+the supplied list are ignored; lawful 'Dtmc.State.FiniteState' enumerations+contain every value of their state type.++Complexity: @O(n + s)@ time for @n@ requested states and stored support size+@s@, with @O(s)@ temporary space and @O(n)@ result space.+-}+denseWeights :: (Ord state) => [state] -> DistributionMap state -> [Double]+denseWeights states = align states . Map.toAscList . unDistributionMap+  where+    align [] _ = []+    align remaining [] = replicate (length remaining) 0+    align allStates@(state : rest) allWeights@((storedState, weight) : weights) =+        case compare storedState state of+            LT -> align allStates weights+            EQ -> weight : align rest weights+            GT -> 0 : align rest allWeights++instance Distribution (DistributionMap state) where+    type DistributionState (DistributionMap state) = state++    probabilityAt distribution state =+        Map.findWithDefault 0 state (unDistributionMap distribution)++    distributionWeights = Map.toAscList . unDistributionMap
+ src/Dtmc/Distribution/Vector.hs view
@@ -0,0 +1,90 @@+{- |+Module      : Dtmc.Distribution.Vector+Description : Dense probability vectors over finite state types.++t'DistributionVector' stores a probability law over a 'FiniteState' type in an+hmatrix vector. Coordinates follow its canonical state order, so+'fromList' and 'toList' are a positional pair: both speak the same list of+weights, one coordinate per state. 'fromList' checks and canonicalises the+simplex invariant with the @1e-9@ tolerance documented by+'Dtmc.Simplex.SimplexError'.++To build a vector from /labelled/ weights, where duplicates should combine+and missing states should default to zero, use+'Dtmc.Distribution.Map.fromList' and read the coordinates off the result:++> Vector.fromList [probabilityAt m s | s <- finiteStates]+-}+module Dtmc.Distribution.Vector (+    DistributionVector,+    DistributionVectorError (..),+    fromList,+    toList,+) where++import Data.Bifunctor (+    bimap,+ )+import Dtmc.Distribution.Vector.Internal (+    DistributionVector (DistributionVector),+    unDistributionVector,+ )+import Dtmc.Simplex (+    SimplexError,+ )+import Dtmc.Simplex.Internal (+    canonicaliseSimplexEntries,+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.State.Internal (+    stateCardinalityInt,+ )+import Numeric.LinearAlgebra qualified as LA++{- | Why a list of weights was rejected as a state distribution.+-}+data DistributionVectorError+    = -- | The state cardinality and the supplied number of weights.+      WrongLength Int Int+    | -- | The weights failed simplex validation. The coordinate index the+      -- 'SimplexError' carries is zero-based in canonical state order.+      InWeights SimplexError+    deriving (Eq, Show)++{- | Construct a dense state distribution from one weight per state, in+canonical state order. The list must have exactly as many entries as the+state type has inhabitants; tolerated coordinate error is clamped to @[0, 1]@+and the repaired weights are normalised before storage. This is the exact+inverse of 'toList' up to that repair.++For a state type of cardinality zero the only accepted input is @[]@, which+is rejected as @Left (InWeights (SumOffBy 0))@: the empty simplex has no+points.++Complexity: @O(n)@ time and @O(n)@ temporary and result space for state+cardinality @n@.+-}+fromList ::+    forall state.+    (FiniteState state) =>+    [Double] ->+    Either DistributionVectorError (DistributionVector state)+fromList weights+    | supplied /= dimension = Left (WrongLength dimension supplied)+    | otherwise =+        bimap InWeights (DistributionVector . LA.fromList) canonicalised+  where+    dimension = stateCardinalityInt @state+    supplied = length weights+    canonicalised = canonicaliseSimplexEntries weights++{- | Return every stored coordinate in canonical state order, including exact+zeros. This is a representation-neutral copy of the dense vector.++Complexity: @O(n)@ time and @O(n)@ temporary and result space for state+cardinality @n@.+-}+toList :: DistributionVector state -> [Double]+toList = LA.toList . unDistributionVector
+ src/Dtmc/Distribution/Vector/Internal.hs view
@@ -0,0 +1,61 @@+{- |+Module      : Dtmc.Distribution.Vector.Internal+Description : Unsafe carrier for dense distribution vectors.++The public smart constructor validates and canonicalises the simplex+invariant. Internal callers may use the constructor only when their operation+preserves that invariant up to floating-point error.+-}+module Dtmc.Distribution.Vector.Internal (+    DistributionVector (DistributionVector),+    unDistributionVector,+) where++import Dtmc.Distribution (+    Distribution (..),+ )+import Dtmc.State (+    FiniteState,+    finiteStates,+ )+import Dtmc.State.Internal (+    stateIndexInt,+ )+import Numeric.LinearAlgebra qualified as LA++{- | A state distribution vector whose coordinates follow the canonical order+of its finite state type. The internal constructor performs no validation.+-}+newtype DistributionVector state+    = -- | Wrap an unchecked probability vector.+      DistributionVector (LA.Vector Double)++-- Nominal role prevents coercion between distinct state types, including+-- state types with the same cardinality.+type role DistributionVector nominal++deriving instance Show (DistributionVector state)++{- | Return the stored probability vector unchanged. This performs no copy,+validation, clamping, or renormalisation.++Complexity: @O(1)@ time and @O(1)@ space.+-}+unDistributionVector ::+    DistributionVector state ->+    LA.Vector Double+unDistributionVector (DistributionVector vector) = vector++instance (FiniteState state) => Distribution (DistributionVector state) where+    type DistributionState (DistributionVector state) = state++    probabilityAt distribution state =+        unDistributionVector distribution `LA.atIndex` stateIndexInt state++    distributionWeights distribution =+        [ (state, weight)+        | (state, weight) <- zip finiteStates weights+        , weight /= 0+        ]+      where+        weights = LA.toList (unDistributionVector distribution)
+ src/Dtmc/Dynamics.hs view
@@ -0,0 +1,143 @@+{- |+Module      : Dtmc.Dynamics+Description : Deterministic forward evolution of distributions.++Deterministic push-forward of a state distribution through a DTMC. Dense+finite laws use transition matrices; sparse finite-support laws use any+locally finite 'Transition'. In both cases,+@mu'(j) = sum_i mu(i) P(i,j)@.+-}+module Dtmc.Dynamics (+    evolve,+    evolveN,+    evolveVector,+    evolveVectorN,+) where++import Dtmc.Distribution (+    Distribution (..),+ )+import Dtmc.Distribution.Map (+    fromDistribution,+ )+import Dtmc.Distribution.Map.Internal (+    DistributionMap (DistributionMap),+    unDistributionMap,+ )+import Dtmc.Distribution.Vector.Internal (+    DistributionVector (DistributionVector),+ )+import Dtmc.Dynamics.Internal (+    pushSparseWeights,+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.Transition (+    Transition (..),+ )+import Dtmc.Transition.Matrix (+    power,+ )+import Dtmc.Transition.Matrix.Internal (+    TransitionMatrix,+    unTransitionMatrix,+ )+import Numeric.LinearAlgebra qualified as LA+import Numeric.Natural (Natural)++{- | Compute the next-state distribution @mu' = transpose(P) mu@.++Exact probability inputs produce a probability distribution. The result is+wrapped without validation, clamping, or renormalisation, so error from custom+or numerically derived inputs and floating-point rounding is preserved and may+make a subsequent validation fail.++Complexity: @O(n^2)@ time, @O(n^2)@ temporary space in the worst case, and+@O(n)@ result space for state cardinality @n@.+-}+evolveVector ::+    DistributionVector state ->+    TransitionMatrix state ->+    DistributionVector state+evolveVector (DistributionVector v) p =+    DistributionVector (LA.tr (unTransitionMatrix p) LA.#> v)++{- | Compute the distribution after @k@ transitions as+@evolveVector mu (power k p)@. Exponent zero is the original distribution+mathematically.++This powers the matrix rather than iterating 'evolveVector', so the two+calculations may differ by floating-point rounding. The result is not+revalidated.++Complexity: @O(n^2 + n^3 log(k + 1))@ time, @O(n^2)@ temporary space, and+@O(n)@ result space.+-}+evolveVectorN ::+    (FiniteState state) =>+    Natural ->+    DistributionVector state ->+    TransitionMatrix state ->+    DistributionVector state+evolveVectorN k mu p =+    evolveVector mu (power k p)++{- | Push any finite-support 'Distribution' through one locally finite kernel+step. The result uses t'DistributionMap' because a general kernel does not+provide a finite global state enumeration. It is not revalidated, clamped, or+renormalised.++For the complexity bounds, @s@ is the number of source states, @e@ the number+of traversed support edges, @u@ the number of distinct destinations+encountered, and @r@ the number retained after exact-zero removal.++Complexity: excluding 'distributionWeights' and 'transitionLaw' evaluation,+@O(s + e log(u + 1) + u)@ time, @O(s + u)@ temporary space, and @O(r)@ result+space.+-}+evolve ::+    ( Distribution distribution+    , Transition kernel+    , DistributionState distribution ~ TransitionState kernel+    , Ord (TransitionState kernel)+    ) =>+    distribution ->+    kernel ->+    DistributionMap (TransitionState kernel)+evolve distribution kernel =+    DistributionMap+        ( pushSparseWeights+            (unDistributionMap (fromDistribution distribution))+            kernel+        )++{- | Apply 'evolve' exactly @k@ times. At @k = 0@ the initial law is converted+to an equivalent t'DistributionMap' without revalidation. No state-space+enumeration or truncation is performed.++For a positive step count, let @s@, @e@, and @u@ be upper bounds per step on+the source states, traversed support edges, and distinct destinations+encountered; let @r@ be the final support size.++Complexity: excluding the initial 'distributionWeights' call and all+'transitionLaw' evaluations, @O(k (s + e log(u + 1) + u))@ time,+@O(s + u)@ temporary space, and @O(r)@ result space. At @k = 0@, the cost is+that of 'Dtmc.Distribution.Map.fromDistribution'.+-}+evolveN ::+    ( Distribution distribution+    , Transition kernel+    , DistributionState distribution ~ TransitionState kernel+    , Ord (TransitionState kernel)+    ) =>+    Natural ->+    distribution ->+    kernel ->+    DistributionMap (TransitionState kernel)+evolveN steps initial kernel = go steps (fromDistribution initial)+  where+    go 0 distribution = distribution+    go remaining distribution =+        let next = evolve distribution kernel+         in next `seq` go (remaining - 1) next
+ src/Dtmc/Dynamics/Internal.hs view
@@ -0,0 +1,54 @@+{- |+Module      : Dtmc.Dynamics.Internal+Description : Unchecked sparse forward-dynamics primitive.++Sparse weight propagation shared by public evolution and path-analysis+algorithms. Inputs may be sub-probability maps; no simplex invariant is+required or restored here.+-}+module Dtmc.Dynamics.Internal (+    pushSparseWeights,+) where++import Data.Map.Strict (+    Map,+ )+import Data.Map.Strict qualified as Map+import Dtmc.Distribution.Map.Internal (+    unDistributionMap,+ )+import Dtmc.Transition (+    Transition (..),+ )++{- | Push a finite, possibly sub-probability weight map through one locally+finite kernel step. Exact zero results are removed. No validation, clamping,+or renormalisation is performed.++For the complexity bounds, @s@ is the number of source states, @e@ the number+of traversed support edges, @u@ the number of distinct destinations+encountered, and @r@ the number retained after exact-zero removal.++Complexity: excluding 'transitionLaw' evaluation,+@O(s + e log(u + 1) + u)@ time, @O(u)@ temporary space, and @O(r)@ result+space.+-}+pushSparseWeights ::+    (Transition kernel, Ord (TransitionState kernel)) =>+    Map (TransitionState kernel) Double ->+    kernel ->+    Map (TransitionState kernel) Double+pushSparseWeights weights kernel =+    Map.filter (/= 0) (Map.foldlWithKey' pushState Map.empty weights)+  where+    pushState accumulated state stateWeight =+        Map.foldlWithKey'+            ( \next nextState transitionWeight ->+                Map.insertWith+                    (+)+                    nextState+                    (stateWeight * transitionWeight)+                    next+            )+            accumulated+            (unDistributionMap (transitionLaw kernel state))
+ src/Dtmc/Simplex.hs view
@@ -0,0 +1,31 @@+{- |+Module      : Dtmc.Simplex+Description : Probability-simplex construction errors.++Errors shared by the distribution and transition-matrix smart constructors.+Construction uses an absolute tolerance of @1e-9@ for coordinates and the+total.+-}+module Dtmc.Simplex (+    SimplexError (..),+) where++{- | Why a vector failed to be a probability distribution. Bound errors carry+a zero-based index and the offending value; 'NonFiniteEntry' identifies a+@NaN@ or infinite coordinate; 'SumOffBy' carries the computed total.++The first coordinate error takes precedence over the total. Coordinate bounds+accept @[-1e-9, 1 + 1e-9]@; the total succeeds when+@abs (total - 1) <= 1e-9@. Smart constructors clamp accepted coordinates to+@[0, 1]@ and normalise before storage. An empty vector yields @SumOffBy 0@.+-}+data SimplexError+    = -- | Coordinate is @NaN@ or infinite.+      NonFiniteEntry Int+    | -- | Coordinate less than @-1e-9@.+      NegativeEntry Int Double+    | -- | Coordinate greater than @1 + 1e-9@.+      EntryAboveOne Int Double+    | -- | No coordinate error, but the total is outside tolerance.+      SumOffBy Double+    deriving (Eq, Show)
+ src/Dtmc/Simplex/Internal.hs view
@@ -0,0 +1,77 @@+{- |+Module      : Dtmc.Simplex.Internal+Description : Construction and repair of probability-simplex values.++Shared simplex construction for distribution and transition-matrix smart+constructors. Accepted values are made canonical by clamping tolerated bound+error and normalising the repaired total.+-}+module Dtmc.Simplex.Internal (+    simplexTolerance,+    canonicaliseSimplex,+    canonicaliseSimplexEntries,+) where++import Data.List qualified as List+import Dtmc.Simplex (+    SimplexError (..),+ )+import Numeric.LinearAlgebra qualified as LA++-- | The absolute tolerance shared by simplex construction and sampling repair.+simplexTolerance :: Double+simplexTolerance = 1e-9++{- | Construct a canonical simplex vector when every coordinate is in+@[-simplexTolerance, 1 + simplexTolerance]@ and its total is in+@[1 - simplexTolerance, 1 + simplexTolerance]@. Tolerated negative coordinates+are clamped to zero, tolerated coordinates above one are clamped to one, and+the repaired coordinates are divided by their computed total.++Reports the first non-finite or bound error before checking the total. An+empty vector yields @Left (SumOffBy 0)@.++Complexity: @O(n)@ time and @O(n)@ temporary and result space.+-}+canonicaliseSimplex :: LA.Vector Double -> Either SimplexError (LA.Vector Double)+canonicaliseSimplex vector =+    LA.fromList <$> canonicaliseSimplexEntries (LA.toList vector)++{- | Construct a canonical finite list with the same tolerance, repair, and+error ordering as 'canonicaliseSimplex'. Entry indices refer to the supplied+list order.++An empty list yields @Left (SumOffBy 0)@.++Complexity: @O(n)@ time and @O(n)@ temporary and result space.+-}+canonicaliseSimplexEntries :: [Double] -> Either SimplexError [Double]+canonicaliseSimplexEntries entries =+    case firstInvalidEntry 0 entries of+        Just err -> Left err+        Nothing+            | abs (total - 1.0) <= simplexTolerance ->+                Right (map (/ repairedTotal) repaired)+            | otherwise -> Left (SumOffBy total)+  where+    total = List.foldl' (+) 0 entries+    repaired = map repair entries+    repairedTotal = List.foldl' (+) 0 repaired++    repair entry+        | entry < 0 = 0+        | entry > 1 = 1+        | otherwise = entry++-- Scan separately so a coordinate error reports its index before the total.+firstInvalidEntry :: Int -> [Double] -> Maybe SimplexError+firstInvalidEntry _ [] = Nothing+firstInvalidEntry index (entry : rest)+    | isNaN entry || isInfinite entry =+        Just (NonFiniteEntry index)+    | entry < negate simplexTolerance =+        Just (NegativeEntry index entry)+    | entry > 1.0 + simplexTolerance =+        Just (EntryAboveOne index entry)+    | otherwise =+        firstInvalidEntry (index + 1) rest
+ src/Dtmc/Simulation.hs view
@@ -0,0 +1,157 @@+{- |+Module      : Dtmc.Simulation+Description : Sampling states and running the chain forward.++Random sampling from dense or sparse state distributions, plus shared+simulation through any locally finite 'Transition'. Failures are returned as+'SimulationError' values. A validation failure leaves the supplied MWC+generator unchanged; successfully validated sampling passes it to the+categorical backend in any 'PrimMonad'.+-}+module Dtmc.Simulation (+    SimulationError (..),+    sample,+    step,+    simulate,+) where++import Control.Monad.Primitive (+    PrimMonad,+    PrimState,+ )+import Data.List qualified as List+import Dtmc.Distribution (+    Distribution (..),+ )+import Dtmc.Simplex.Internal (+    simplexTolerance,+ )+import Dtmc.Transition (+    Transition (..),+ )+import Numeric.LinearAlgebra qualified as LA+import Numeric.Natural (+    Natural,+ )+import System.Random.MWC qualified as MWC+import System.Random.MWC.Distributions qualified as MWCD++{- | Why sampling could not produce a state. Weight indices refer to the order+returned by 'distributionWeights'. Input errors are detected before the random+generator is used.+-}+data SimulationError+    = -- | The distribution stores no states.+      EmptySupport+    | -- | Zero-based index of a weight that is @NaN@ or infinite.+      NonFiniteWeight Int+    | -- | Zero-based index and value of a weight below @-1e-9@.+      NegativeWeight Int Double+    | -- | Finite individual weights overflowed while being summed.+      NonFiniteTotal+    | -- | The repaired weights have a zero or negative total.+      NonPositiveTotal Double+    | -- | Impossible backend index and the stored support size.+      SampleIndexOutOfBounds Int Int+    deriving (Eq, Show)++{- | Draw a state from any finite-support 'Distribution'. Before sampling,+stored weights in @[-1e-9, 0)@ are replaced by zero; the categorical sampler+scales by the resulting total, so no explicit renormalisation is stored.++Returns 'Left' for empty support, non-finite weights or totals, weights below+@-1e-9@, or a non-positive repaired total. Validation happens before the+generator is advanced.++Complexity: excluding 'distributionWeights', @O(s + 1)@ time and @O(s)@+temporary space for stored support size @s@; result space is @O(1)@.+-}+sample ::+    (Distribution distribution, PrimMonad m) =>+    distribution ->+    MWC.Gen (PrimState m) ->+    m (Either SimulationError (DistributionState distribution))+sample distribution generator =+    case prepareEntries (distributionWeights distribution) of+        Left problem -> pure (Left problem)+        Right (states, weights) -> do+            index <- MWCD.categorical weights generator+            pure+                ( case atMay states index of+                    Nothing -> Left (SampleIndexOutOfBounds index (length states))+                    Just state -> Right state+                )++prepareEntries :: [(state, Double)] -> Either SimulationError ([state], LA.Vector Double)+prepareEntries [] = Left EmptySupport+prepareEntries entries = do+    repaired <- traverse repairWeight (zip [0 ..] (map snd entries))+    let total = List.foldl' (+) 0 repaired+    validateTotal total+    pure (map fst entries, LA.fromList repaired)++validateTotal :: Double -> Either SimulationError ()+validateTotal total+    | isNaN total || isInfinite total = Left NonFiniteTotal+    | total <= 0 = Left (NonPositiveTotal total)+    | otherwise = Right ()++repairWeight :: (Int, Double) -> Either SimulationError Double+repairWeight (index, weight)+    | isNaN weight || isInfinite weight = Left (NonFiniteWeight index)+    | weight < negate simplexTolerance = Left (NegativeWeight index weight)+    | weight < 0 = Right 0+    | otherwise = Right weight++atMay :: [value] -> Int -> Maybe value+atMay _ index | index < 0 = Nothing+atMay values index =+    case drop index values of+        [] -> Nothing+        value : _ -> Just value++{- | Sample one transition from a state through any 'Transition'. Passing each+result back with the same generator advances one trajectory. The returned+finite-support law inherits the checked repair behaviour of 'sample'.++Complexity: excluding 'transitionLaw' and 'distributionWeights', @O(s + 1)@+time and @O(s)@ temporary space for stored support size @s@; result space is+@O(1)@.+-}+step ::+    (PrimMonad m, Transition kernel) =>+    kernel ->+    TransitionState kernel ->+    MWC.Gen (PrimState m) ->+    m (Either SimulationError (TransitionState kernel))+step kernel state =+    sample (transitionLaw kernel state)++{- | Simulate exactly @k@ transitions through any 'Transition'. On success,+return the trajectory including its initial state, with length @k + 1@. Stop+at the first invalid transition law and return its 'SimulationError'. At+@k = 0@, return the initial state without inspecting the kernel or advancing+the generator.++Let @s@ bound the stored support size of every transition law encountered.++Complexity: excluding 'transitionLaw' and 'distributionWeights',+@O(k (s + 1) + 1)@ time, @O(k + s + 1)@ temporary space, and @O(k + 1)@+result space.+-}+simulate ::+    (PrimMonad m, Transition kernel) =>+    Natural ->+    kernel ->+    TransitionState kernel ->+    MWC.Gen (PrimState m) ->+    m (Either SimulationError [TransitionState kernel])+simulate transitions kernel initial generator =+    go transitions initial [initial]+  where+    go 0 _ reversed = pure (Right (reverse reversed))+    go remaining current reversed = do+        result <- step kernel current generator+        case result of+            Left problem -> pure (Left problem)+            Right next -> go (remaining - 1) next (next : reversed)
+ src/Dtmc/State.hs view
@@ -0,0 +1,241 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableSuperClasses #-}++{- |+Module      : Dtmc.State+Description : Canonical indexing for finite named state types.++'FiniteState' identifies a globally finite state type with a canonical total+indexing by @'Finite' ('Cardinality' state)@. The generic implementation+supports enumeration types whose constructors have no fields. Enable+@DeriveAnyClass@ and @DeriveGeneric@, then derive both 'Generic' and+'FiniteState':++@+data Weather = Dry | Wet | Storm+    deriving (Eq, Ord, Show, Generic, FiniteState)+@++After deriving 'Generic', declaring an empty @instance FiniteState Weather@+is a more explicit way to select the same generic defaults.++Constructor declaration order determines vector and matrix order. A stock+derived 'Ord' instance has the same order and is the intended companion;+handwritten 'FiniteState' and 'Ord' instances are trusted to preserve the+documented ordering and bijection laws.+-}+module Dtmc.State (+    type Cardinality,+    type GenericCardinality,+    FiniteState,+    finiteStates,+    stateIndex,+    stateAt,+) where++import Data.Finite (+    Finite,+    finite,+    finites,+    getFinite,+ )+import Data.Kind (+    Type,+ )+import Data.Proxy (+    Proxy (Proxy),+ )+import GHC.Generics (+    C,+    D,+    Generic (Rep, from, to),+    M1 (M1),+    U1 (U1),+    V1,+    type (:+:) (L1, R1),+ )+import GHC.TypeLits (+    ErrorMessage (Text),+    TypeError,+ )+import GHC.TypeNats (+    KnownNat,+    Nat,+    natVal,+    type (+),+ )++{- | The number of inhabitants of a finite state type. For 'Finite', this is+its existing type-level bound; for every other type, it is derived from its+'Generic' representation. Users cannot override this closed family+independently of that representation.++A generic constructor carrying any fields reduces to a custom 'TypeError'.+-}+type family Cardinality (state :: Type) :: Nat where+    Cardinality (Finite n) = n+    Cardinality state = GenericCardinality (Rep state)++{- | A finite state type with a canonical bijection to+@'Finite' ('Cardinality' state)@.++Instances must satisfy:++* @stateAt (stateIndex state) == state@;+* @stateIndex (stateAt index) == index@;+* @finiteStates == map stateAt finites@;+* @finiteStates@ is strictly ascending according to 'Ord'.++The generic defaults satisfy these laws for fieldless enumeration types with+a stock derived 'Ord' instance. Handwritten method implementations are trusted+to satisfy them, but their 'Cardinality' still comes from the supported+'Generic' representation. Empty state types are supported: their state list is+empty and 'stateAt' has an uninhabited 'Finite 0' domain.+-}+class (Ord state, KnownNat (Cardinality state)) => FiniteState state where+    {- | Return every state exactly once, in canonical index order.++    Complexity: implementation-dependent.+    -}+    finiteStates :: [state]++    {- | Convert a state to its total, statically bounded index.++    Complexity: implementation-dependent.+    -}+    stateIndex :: state -> Finite (Cardinality state)++    {- | Recover the state at a statically bounded index.++    Complexity: implementation-dependent.+    -}+    stateAt :: Finite (Cardinality state) -> state++    default finiteStates ::+        ( Generic state+        , GenericFiniteState (Rep state)+        ) =>+        [state]+    finiteStates = map to genericStates++    default stateIndex ::+        ( Generic state+        , GenericFiniteState (Rep state)+        ) =>+        state ->+        Finite (Cardinality state)+    stateIndex = finite . genericIndex . from++    default stateAt ::+        ( Generic state+        , GenericFiniteState (Rep state)+        ) =>+        Finite (Cardinality state) ->+        state+    stateAt = to . genericAt . fromIntegral . getFinite++instance (KnownNat n) => FiniteState (Finite n) where+    finiteStates = finites+    stateIndex = id+    stateAt = id++instance FiniteState ()++instance FiniteState Bool++instance FiniteState Ordering++{- | The type-level cardinality of a 'Generic' representation. This advanced+helper underlies 'Cardinality'; ordinary users should use 'FiniteState'+instead.+-}+type family GenericCardinality (representation :: Type -> Type) :: Nat where+    GenericCardinality (M1 D metadata representation) =+        GenericCardinality representation+    GenericCardinality (left :+: right) =+        GenericCardinality left + GenericCardinality right+    GenericCardinality (M1 C metadata U1) = 1+    GenericCardinality (M1 C metadata fields) =+        TypeError+            ( 'Text+                "FiniteState: constructors with fields are unsupported"+            )+    GenericCardinality V1 = 0++-- Generic machinery implementing the canonical state/index bijection for+-- fieldless enumeration representations.+class GenericFiniteState representation where+    genericStates :: [representation value]+    genericIndex :: representation value -> Integer+    genericAt :: Integer -> representation value++instance+    (GenericFiniteState representation) =>+    GenericFiniteState (M1 D metadata representation)+    where+    genericStates = map M1 genericStates+    genericIndex (M1 value) = genericIndex value+    genericAt = M1 . genericAt++instance+    ( GenericFiniteState left+    , GenericFiniteState right+    , KnownNat (GenericCardinality left)+    ) =>+    GenericFiniteState (left :+: right)+    where+    genericStates =+        map L1 (genericStates @left)+            ++ map R1 (genericStates @right)++    genericIndex (L1 value) = genericIndex value+    genericIndex (R1 value) = genericCardinality @left + genericIndex value++    genericAt index+        | index < genericCardinality @left = L1 (genericAt index)+        | otherwise =+            R1 (genericAt (index - genericCardinality @left))++genericCardinality ::+    forall representation.+    (KnownNat (GenericCardinality representation)) =>+    Integer+genericCardinality =+    fromIntegral (natVal (Proxy @(GenericCardinality representation)))++instance {-# OVERLAPPING #-} GenericFiniteState (M1 C metadata U1) where+    genericStates = [M1 U1]+    genericIndex (M1 U1) = 0+    genericAt _ = M1 U1++instance+    {-# OVERLAPPABLE #-}+    ( TypeError+        ( 'Text+            "FiniteState: constructors with fields are unsupported"+        )+    ) =>+    GenericFiniteState (M1 C metadata fields)+    where+    genericStates = unsupportedConstructorFields+    genericIndex _ = unsupportedConstructorFields+    genericAt _ = unsupportedConstructorFields++-- Required only to complete an instance made unusable by its 'TypeError'.+unsupportedConstructorFields :: value+unsupportedConstructorFields =+    error "Dtmc.State: constructors with fields are unsupported"++instance GenericFiniteState V1 where+    genericStates = []+    genericIndex value = case value of {}+    genericAt _ =+        error "Dtmc.State.stateAt: unreachable Finite 0 index"
+ src/Dtmc/State/Internal.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++{- |+Module      : Dtmc.State.Internal+Description : Checked conversions for finite-state indices.++Shared conversions between named finite states and the integer indices used by+dynamic graph and linear-algebra code. Keeping the reverse conversion here+prevents an arbitrary 'Int' from being passed directly to 'Data.Finite.finite',+which wraps out-of-range values modulo the state-space cardinality.+-}+module Dtmc.State.Internal (+    stateCardinalityInt,+    stateIndexInt,+    stateFromInt,+) where++import Data.Finite (+    finite,+    getFinite,+ )+import Data.Proxy (+    Proxy (Proxy),+ )+import Dtmc.State (+    Cardinality,+    FiniteState,+    stateAt,+    stateIndex,+ )+import GHC.TypeNats (+    natVal,+ )++{- | Return the number of states as a runtime 'Int'.++Complexity: @O(1)@ time and @O(1)@ space.+-}+stateCardinalityInt :: forall state. (FiniteState state) => Int+stateCardinalityInt =+    fromIntegral (natVal (Proxy @(Cardinality state)))++{- | Return the canonical zero-based integer index of a state.++Complexity: the cost of 'stateIndex' plus @O(1)@ time and @O(1)@ space.+-}+stateIndexInt :: (FiniteState state) => state -> Int+stateIndexInt = fromIntegral . getFinite . stateIndex++{- | Recover the state at a runtime integer index. Returns 'Nothing' rather+than wrapping a negative or out-of-range integer modulo the state count.++Complexity: the cost of 'stateAt' plus @O(1)@ time and @O(1)@ space.+-}+stateFromInt :: forall state. (FiniteState state) => Int -> Maybe state+stateFromInt index+    | index < 0 || index >= stateCardinalityInt @state = Nothing+    | otherwise = Just (stateAt (finite (fromIntegral index)))
+ src/Dtmc/Transition.hs view
@@ -0,0 +1,35 @@+{- |+Module      : Dtmc.Transition+Description : Shared abstraction for locally finite transition rules.++'Transition' captures the operation shared by finite transition matrices and+locally finite kernels: obtaining the validated finite-support law of the next+state from a supplied current state. Concrete representations live in+"Dtmc.Transition.Matrix" and "Dtmc.Transition.Kernel".+-}+module Dtmc.Transition (+    Transition (..),+) where++import Dtmc.Distribution.Map (DistributionMap)++{- | A time-homogeneous transition rule whose law from any supplied state has+finite support. The complete state space may be finite or infinite.++This capability is sufficient for exact finite-horizon map-backed algorithms.+It does not imply that states can be enumerated, so it cannot by itself support+generic classification, stationary, eventual-hitting, or expectation+algorithms.+-}+class Transition transition where+    -- | State type governed by this transition representation.+    type TransitionState transition++    {- | Return the validated finite-support law of the next state.++    Complexity: implementation-dependent.+    -}+    transitionLaw ::+        transition ->+        TransitionState transition ->+        DistributionMap (TransitionState transition)
+ src/Dtmc/Transition/Kernel.hs view
@@ -0,0 +1,42 @@+{- |+Module      : Dtmc.Transition.Kernel+Description : Locally finite transition kernels over unrestricted state types.++A t'TransitionKernel' represents a transition rule directly as a function from+each state to its validated map-backed next-state distribution. No global+state-space enumeration is required or attempted.+-}+module Dtmc.Transition.Kernel (+    TransitionKernel,+    fromLaws,+) where++import Dtmc.Distribution.Map (+    DistributionMap,+ )+import Dtmc.Transition (+    Transition (..),+ )++-- | A locally finite transition kernel over a potentially infinite state type.+newtype TransitionKernel state+    = TransitionKernel (state -> DistributionMap state)++type role TransitionKernel nominal++instance Transition (TransitionKernel state) where+    type TransitionState (TransitionKernel state) = state++    transitionLaw (TransitionKernel kernel) = kernel++{- | Construct a kernel from the function that supplies its transition laws.+Each law must already be a validated t'DistributionMap'; no global state-space+traversal is required or attempted.+'Dtmc.Transition.transitionLaw' reads those laws back.++Complexity: @O(1)@ time and @O(1)@ space.+-}+fromLaws ::+    (state -> DistributionMap state) ->+    TransitionKernel state+fromLaws = TransitionKernel
+ src/Dtmc/Transition/Matrix.hs view
@@ -0,0 +1,206 @@+{- |+Module      : Dtmc.Transition.Matrix+Description : Row-stochastic matrices over finite state types.++One-step transition probabilities for a DTMC over a 'FiniteState' type.+'fromRows' builds one from a grid of weights and 'fromKernel' from an+already-validated finite-state kernel; 'compose', 'identity', and 'power'+provide multi-step transitions. 'toRows' reads the stored probabilities back+as plain lists.+-}+module Dtmc.Transition.Matrix (+    -- * Representation+    TransitionMatrix,+    TransitionMatrixError (..),++    -- * Construction and inspection+    fromKernel,+    fromRows,+    toRows,+    rowAt,++    -- * Composition+    compose,+    identity,+    power,+) where++import Data.Bifunctor (+    first,+ )+import Data.Semigroup (+    mtimesDefault,+ )+import Dtmc.Distribution.Map.Internal (+    denseWeights,+ )+import Dtmc.Distribution.Vector.Internal (+    DistributionVector,+ )+import Dtmc.Simplex (+    SimplexError,+ )+import Dtmc.Simplex.Internal (+    canonicaliseSimplexEntries,+ )+import Dtmc.State (+    FiniteState,+    finiteStates,+ )+import Dtmc.State.Internal (+    stateCardinalityInt,+ )+import Dtmc.Transition (+    Transition (transitionLaw),+ )+import Dtmc.Transition.Kernel (+    TransitionKernel,+ )+import Dtmc.Transition.Matrix.Internal (+    TransitionMatrix,+    matrixRowAt,+    unTransitionMatrix,+    unsafeTransitionMatrix,+ )+import Numeric.LinearAlgebra qualified as LA+import Numeric.Natural (+    Natural,+ )++{- | Why a supplied grid of weights is not a transition matrix. Row and column+indices are zero-based and follow the canonical state order of the+'FiniteState' instance.+-}+data TransitionMatrixError+    = -- | A row failed simplex validation: its index and the underlying+      -- failure, whose coordinate index is the zero-based column.+      InRow Int SimplexError+    | -- | The state cardinality and the supplied number of rows.+      WrongRowCount Int Int+    | -- | A row of the wrong width: its index, the state cardinality, and the+      -- supplied width.+      WrongRowWidth Int Int Int+    deriving (Eq, Show)++{- | Construct a row-stochastic matrix from a grid of weights in canonical+state order, stopping at the first problem. Within each accepted row,+tolerated coordinate error is clamped to @[0, 1]@ and the repaired row is+normalised. The support graph remains lazy, and the empty @0 x 0@ matrix is+accepted.++This inverts 'toRows' up to that repair and needs no @hmatrix@ value: the+shape is checked here and reported as 'WrongRowCount' or 'WrongRowWidth'+rather than raised by the array backend.++Complexity: @O(n^2)@ time and @O(n^2)@ temporary and result space.+-}+fromRows ::+    forall state.+    (FiniteState state) =>+    [[Double]] ->+    Either TransitionMatrixError (TransitionMatrix state)+fromRows rows+    | suppliedRows /= dimension = Left (WrongRowCount dimension suppliedRows)+    | otherwise =+        unsafeTransitionMatrix . (dimension LA.>< dimension) . concat+            <$> traverse canonicaliseRow (zip [0 ..] rows)+  where+    dimension = stateCardinalityInt @state+    suppliedRows = length rows++    canonicaliseRow (index, row)+        | width /= dimension = Left (WrongRowWidth index dimension width)+        | otherwise = first (InRow index) (canonicaliseSimplexEntries row)+      where+        width = length row++{- | Materialise a finite-state kernel as a dense transition matrix. Kernel+rows are already validated 'Dtmc.Distribution.Map.DistributionMap' values, so+this conversion is total and performs no additional clamping or+renormalisation. Missing coordinates become exact zeros. The support graph+remains lazy, and the empty @0 x 0@ matrix is accepted.++Complexity: excluding evaluation of 'finiteStates' and the kernel laws,+@O(n^2)@ time and @O(n^2)@ temporary and result space.+-}+fromKernel ::+    forall state.+    (FiniteState state) =>+    TransitionKernel state ->+    TransitionMatrix state+fromKernel kernel =+    unsafeTransitionMatrix $+        (dimension LA.>< dimension)+            [ weight+            | source <- finiteStates+            , let distribution = transitionLaw kernel source+            , weight <- denseWeights finiteStates distribution+            ]+  where+    dimension = stateCardinalityInt @state++{- | Return all stored entries as rows in canonical state order. Exact zeros+are retained. This is a representation-neutral copy of the dense matrix and+does not force its support graph.++Complexity: @O(n^2)@ time and @O(n^2)@ temporary and result space.+-}+toRows :: TransitionMatrix state -> [[Double]]+toRows = LA.toLists . unTransitionMatrix++{- | Compose two transitions: @compose p q@ means take a @p@ step,+then a @q@ step, and stores the matrix product @P Q@.++The product is not revalidated. Row-stochastic matrices are closed under+multiplication mathematically, but floating-point rounding can accumulate.++Complexity: @O(n^3)@ worst-case time and @O(n^2)@ temporary and result space.+The support graph is built lazily.+-}+compose ::+    TransitionMatrix state ->+    TransitionMatrix state ->+    TransitionMatrix state+compose = (<>)++{- | Return the @n x n@ identity: the zero-step transition that leaves every+state unchanged. For @n = 0@ this is the empty matrix.++Complexity: @O(1)@ construction time and @O(1)@ construction space. Forcing+the dense entries or support graph takes @O(n^2)@ time and @O(n^2)@ temporary+space; the support graph itself occupies @O(n)@ space.+-}+identity :: (FiniteState state) => TransitionMatrix state+identity = mempty++{- | Compute the @k@-step transition matrix @p^k@. Exponent zero returns+'identity'; positive exponents use repeated squaring through+'Data.Semigroup.mtimesDefault'.++Chapman-Kolmogorov gives @p^(m+n) = p^m p^n@ mathematically; computed matrices+may differ by floating-point rounding and are not revalidated.++Complexity: @O(n^2 + n^3 log(k + 1))@ time and @O(n^2)@ temporary and result+space.+-}+power ::+    (FiniteState state) =>+    Natural ->+    TransitionMatrix state ->+    TransitionMatrix state+power = mtimesDefault++{- | Return the stored row for a state: its next-state distribution.+'FiniteState' indexing makes the lookup total. The row is wrapped without+revalidation, so any floating-point drift from matrix arithmetic is+preserved.++Complexity: excluding 'Dtmc.State.stateIndex', @O(n)@ time and @O(n)@ result+space for state cardinality @n@.+-}+rowAt ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    DistributionVector state+rowAt = matrixRowAt
+ src/Dtmc/Transition/Matrix/Internal.hs view
@@ -0,0 +1,168 @@+{- |+Module      : Dtmc.Transition.Matrix.Internal+Description : Raw carrier for transition matrices (unsafe underbelly).++Raw carrier behind t'Dtmc.Transition.Matrix.TransitionMatrix': an hmatrix+matrix paired with its lazy support graph. The public smart constructor+validates its square shape and canonicalises rows; this internal module+exposes unchecked construction.++The constructor is positional so the public matrix projection cannot act as a+record-update setter and desynchronise the matrix from its cached graph.+-}+module Dtmc.Transition.Matrix.Internal (+    TransitionMatrix (TransitionMatrix),+    unTransitionMatrix,+    tmSupport,+    unsafeTransitionMatrix,+    matrixRowAt,+) where++import Dtmc.Distribution.Map (+    fromDistribution,+ )+import Dtmc.Distribution.Vector.Internal (+    DistributionVector (DistributionVector),+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.State.Internal (+    stateCardinalityInt,+    stateIndexInt,+ )+import Dtmc.Transition (+    Transition (..),+ )+import Dtmc.Transition.Matrix.Internal.Graph (+    Graph,+    fromAdjacency,+ )+import Numeric.LinearAlgebra qualified as LA++{- | A stored square matrix whose rows and columns follow the canonical order+of its finite state type. Entry @(i,j)@ is the transition probability from+state @i@ to state @j@. 'Dtmc.Transition.Matrix.fromKernel' materialises+already-validated rows, while 'Dtmc.Transition.Matrix.fromRows' applies+tolerant row validation and canonicalisation. The internal constructor and+arithmetic instances do not revalidate.++Each value also carries its support graph as a /lazy/ second argument, so any+graph-based analyses on the same value share one build. Construct internal+values with @unsafeTransitionMatrix@ rather than pairing a matrix and graph+directly.+-}+data TransitionMatrix state+    = -- | Unchecked matrix/cache pair; the graph must match the matrix.+      TransitionMatrix (LA.Matrix Double) Graph++-- Nominal role prevents coercion between distinct state types, including+-- state types with the same cardinality.+type role TransitionMatrix nominal++{- | Return the stored matrix unchanged without forcing the support graph.++Complexity: @O(1)@ time and @O(1)@ space.+-}+unTransitionMatrix ::+    TransitionMatrix state ->+    LA.Matrix Double+unTransitionMatrix (TransitionMatrix matrix _) = matrix++{- | Return the lazy support graph, with edge @i -> j@ exactly when the stored+entry is strictly positive. No tolerance is applied: a tiny positive rounding+value creates an edge, while zero or a negative value does not.++The result is shared by later analyses of the same value.++Complexity: @O(1)@ projection time and @O(1)@ projection space. The first+analysis that forces the graph takes @O(n^2)@ time and @O(n^2)@ temporary+space; the resulting graph occupies @O(n + E)@ space for @E@ support edges.+-}+tmSupport :: TransitionMatrix state -> Graph+tmSupport (TransitionMatrix _ support) = support++-- Manual 'Show': 'Graph' has no 'Show', and the derived cache should not+-- appear in the rendering.+instance Show (TransitionMatrix state) where+    showsPrec d p =+        showParen (d > 10) $+            showString "TransitionMatrix "+                . showsPrec 11 (unTransitionMatrix p)++{- | Pair a raw matrix with its lazy support graph. This performs no+row-stochastic, finiteness, or simplex validation; internal callers must+establish the required invariant.++Complexity: @O(1)@ construction time and @O(1)@ construction space. Forcing+the support graph takes @O(n^2)@ time and @O(n^2)@ temporary space; the graph+occupies @O(n + E)@ space for @E@ support edges.+-}+unsafeTransitionMatrix ::+    LA.Matrix Double ->+    TransitionMatrix state+unsafeTransitionMatrix matrix =+    TransitionMatrix matrix (supportGraphOf matrix)++{- | Wrap one stored matrix row as a distribution vector without revalidation.+The finite-state index makes the lookup total.++Complexity: excluding 'Dtmc.State.stateIndex', @O(n)@ time and @O(n)@ result+space for state cardinality @n@.+-}+matrixRowAt ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    DistributionVector state+matrixRowAt matrix state = DistributionVector row+  where+    stored = unTransitionMatrix matrix+    row =+        LA.flatten+            ( LA.subMatrix+                (stateIndexInt state, 0)+                (1, LA.cols stored)+                stored+            )++instance (FiniteState state) => Transition (TransitionMatrix state) where+    type TransitionState (TransitionMatrix state) = state++    transitionLaw matrix =+        fromDistribution . matrixRowAt matrix++-- Use strict positivity without tolerance so graph queries reflect the stored+-- matrix exactly; keep construction here so the cache cannot become stale.+supportGraphOf ::+    LA.Matrix Double ->+    Graph+supportGraphOf matrix =+    fromAdjacency+        dim+        [ ((i, j), entry > 0)+        | (i, row) <- zip [0 ..] rows+        , (j, entry) <- zip [0 ..] row+        ]+  where+    rows = LA.toLists matrix+    dim = length rows++{- | Matrix multiplication as transition composition: @p '<>' q@ takes a @p@+step followed by a @q@ step. Exact products preserve row-stochasticity and+associativity; 'Double' results are neither revalidated nor exactly+associative.+-}+instance Semigroup (TransitionMatrix state) where+    (<>) ::+        TransitionMatrix state ->+        TransitionMatrix state ->+        TransitionMatrix state+    p <> q = unsafeTransitionMatrix (unTransitionMatrix p LA.<> unTransitionMatrix q)++{- | The identity matrix represents zero transitions and is the unit of the+transition-composition monoid.+-}+instance (FiniteState state) => Monoid (TransitionMatrix state) where+    mempty :: TransitionMatrix state+    mempty = unsafeTransitionMatrix (LA.ident (stateCardinalityInt @state))
+ src/Dtmc/Transition/Matrix/Internal/Graph.hs view
@@ -0,0 +1,496 @@+{- |+Module      : Dtmc.Transition.Matrix.Internal.Graph+Description : Support-graph reachability, components, periods, and phases.++A small DTMC-specific layer over "Data.Graph". It knows nothing about+probabilities: vertices are the integers @{0 .. n-1}@ and edges are the+positive entries of the transition matrix's support.++The graph is stored as adjacency lists in both directions. Keeping the+transpose makes forward and reverse traversals proportional to the graph+actually visited instead of requiring matrix row or column scans.++Unless stated otherwise, every vertex argument must be in @{0 .. V-1}@.+Passing an out-of-range vertex may raise an array-bounds error.++Query complexities assume that the required forward or reverse adjacency+array has already been forced. The first query after 'fromAdjacency' also pays+the documented cost of building that array.+-}+module Dtmc.Transition.Matrix.Internal.Graph (+    Graph,+    graphDim,+    fromAdjacency,+    hasEdge,+    reachable,+    reachesAny,+    backwardReachable,+    components,+    componentOf,+    sameComponent,+    isClosed,+    inClosedComponent,+    componentPeriod,+    periodOf,+    phaseOf,+) where++import Data.Array qualified as Array+import Data.Array.Unboxed qualified as Unboxed+import Data.Graph qualified as DG+import Data.IntMap.Strict qualified as IntMap+import Data.IntSet qualified as IntSet+import Data.List qualified as List+import Data.Sequence qualified as Sequence+import Data.Tree (Tree, flatten)+import Numeric.Natural (Natural)++{- | An immutable directed graph.++'graphSuccessors' contains outgoing neighbours. 'graphPredecessors' is the+transposed graph and therefore contains incoming neighbours. Both describe+the same logical edge set.++Strongly connected components, the component lookup table, the+closed-component table, and the per-vertex period and phase tables are lazy+derived fields. The component structure comes from 'DG.scc'; the period and+phase tables come from one BFS per component. Each field is computed on first+use.+-}+data Graph = Graph+    { graphDim :: Int+    {- ^ Number of vertices @V@.++    Complexity: @O(1)@ time and @O(1)@ space.+    -}+    , graphSuccessors :: DG.Graph+    -- ^ Original graph: the row for @u@ contains every @v@ with @u -> v@.+    , graphPredecessors :: DG.Graph+    -- ^ Transpose: the row for @v@ contains every @u@ with @u -> v@.+    , graphSccs :: [[Int]]+    -- ^ Normalised strongly connected components.+    , graphComponentOf :: Array.Array Int [Int]+    -- ^ Constant-time vertex-to-component lookup after SCC construction.+    , graphComponentId :: Unboxed.UArray Int Int+    {- ^ Constant-time vertex-to-component-index lookup: two vertices share a+    strongly connected component (communicate) iff they map to the same+    index. Backs 'sameComponent'. The table is also used while deriving+    component closedness; retaining it here adds @O(V)@ unboxed storage and+    makes same-component queries @O(1)@.+    -}+    , graphClosedComponentTable :: Unboxed.UArray Int Bool+    {- ^ Per-vertex closedness of its component: @True@ iff the vertex's+    strongly connected component is a sink of the condensation (no edge+    leaves it). Settled in one pass over all edges.+    -}+    , graphPeriodOf :: Array.Array Int (Maybe Natural)+    {- ^ Per-vertex period of its strongly connected component (@Nothing@ when+    the component has no cycles). Filled by one BFS per component.+    -}+    , graphPhaseOf :: Unboxed.UArray Int Int+    {- ^ Per-vertex phase within its component: the BFS level from the+    component's least vertex, modulo the period. Every edge /within a+    component/ advances the phase by one (modulo that period); edges leaving+    a component relate phases across different components and obey no such+    rule. Shares its BFS with 'graphPeriodOf'.+    -}+    }++{- | Build a graph from a complete Boolean adjacency association list. Only+entries whose value is 'True' become edges.++The dimension must be non-negative, and the list is expected to contain+exactly one entry for each pair in @{0 .. V-1}^2@. Completeness and uniqueness+are not validated: missing pairs act as 'False', and repeated 'True' entries+create duplicate edges. A negative dimension raises an error; an out-of-range+endpoint may fail when a lazy field is forced.++Complexity: @O(1)@ initial time and @O(1)@ initial space. For @A@ supplied+entries, forcing the forward adjacency array takes @O(V + A)@ time and+@O(V + E)@ result space; first forcing the transpose takes a further+@O(V + E)@ time and @O(V + E)@ result space. For a complete input, @A = V^2@.+-}+fromAdjacency :: Int -> [((Int, Int), Bool)] -> Graph+fromAdjacency dim entries+    | dim < 0 = error "Dtmc.Transition.Matrix.Internal.Graph.fromAdjacency: negative dimension"+    | otherwise =+        Graph+            { graphDim = dim+            , graphSuccessors = successors+            , graphPredecessors = DG.transposeG successors+            , graphSccs = sccs+            , graphComponentOf = componentTable+            , graphComponentId = componentIds+            , graphClosedComponentTable = closedComponentTable+            , graphPeriodOf = periodTable+            , graphPhaseOf = phaseTable+            }+  where+    successors =+        DG.buildG+            (vertexBounds dim)+            [pair | (pair, present) <- entries, present]++    sccs = normaliseComponents (DG.scc successors)++    componentTable =+        Array.array+            (vertexBounds dim)+            [ (vertex, component)+            | component <- sccs+            , vertex <- component+            ]++    -- A component is closed iff no edge leaves it. Record component ids so one+    -- pass over cross-component edges can mark every open component.+    componentIds :: Unboxed.UArray Int Int+    componentIds =+        Unboxed.array+            (vertexBounds dim)+            [ (vertex, componentIndex)+            | (componentIndex, component) <- zip [0 ..] sccs+            , vertex <- component+            ]++    openComponentIds :: IntSet.IntSet+    openComponentIds =+        IntSet.fromList+            [ componentIds Unboxed.! from+            | from <- [0 .. dim - 1]+            , to <- successors Array.! from+            , componentIds Unboxed.! from /= componentIds Unboxed.! to+            ]++    closedComponentTable :: Unboxed.UArray Int Bool+    closedComponentTable =+        Unboxed.listArray+            (vertexBounds dim)+            [ not (IntSet.member (componentIds Unboxed.! vertex) openComponentIds)+            | vertex <- [0 .. dim - 1]+            ]++    -- One BFS per component yields both its period and each vertex's phase.+    -- The list is a shared thunk, so the period and phase tables never repeat+    -- the traversal.+    componentPhases :: [(Maybe Natural, [(Int, Int)])]+    componentPhases = [componentPhasing successors component | component <- sccs]++    periodTable :: Array.Array Int (Maybe Natural)+    periodTable =+        Array.array+            (vertexBounds dim)+            [ (vertex, period)+            | (period, phases) <- componentPhases+            , (vertex, _) <- phases+            ]++    phaseTable :: Unboxed.UArray Int Int+    phaseTable =+        Unboxed.array+            (vertexBounds dim)+            [ (vertex, phase)+            | (_, phases) <- componentPhases+            , (vertex, phase) <- phases+            ]++vertexBounds :: Int -> (Int, Int)+vertexBounds dim = (0, dim - 1)++vertices :: Graph -> [Int]+vertices graph = [0 .. graphDim graph - 1]++{- | Test whether a direct edge leads from @from@ to @to@.++Algorithms should normally enumerate an adjacency row instead of repeatedly+calling 'hasEdge'.++Complexity: @O(outDegree(from))@ time and @O(1)@ space because a 'Data.Graph'+row is a list.+-}+hasEdge :: Graph -> Int -> Int -> Bool+hasEdge graph from to = to `elem` (graphSuccessors graph Array.! from)++{- | Test whether @to@ is reachable from @from@ in zero or more steps.++This delegates to 'DG.path' and performs a graph search rather than+retaining a quadratic transitive closure.++Complexity: @O(V + E)@ worst-case time and @O(V)@ traversal space per query.+-}+reachable :: Graph -> Int -> Int -> Bool+reachable graph = DG.path (graphSuccessors graph)++{- | Test whether @from@ can reach any supplied target in zero or more steps.++Targets are materialised as a Boolean membership array. The lazy reachable+stream is then consumed until it encounters a target, so the traversal can+terminate early.++Complexity: @O(V + T + E_r)@ worst-case time, where @T@ is the number of+supplied targets and @E_r@ is the portion of the graph examined before+termination; @O(V)@ space.+-}+reachesAny :: Graph -> Int -> [Int] -> Bool+reachesAny _ _ [] = False+reachesAny graph from targets =+    any (targetMask Unboxed.!) reachableVertices+  where+    targetMask :: Unboxed.UArray Int Bool+    targetMask =+        Unboxed.accumArray+            (||)+            False+            (vertexBounds (graphDim graph))+            [(target, True) | target <- targets]++    reachableVertices = DG.reachable (graphSuccessors graph) from++{- | Return the vertices that can reach a seed inside the subgraph induced by+@allowed@.++The allowed predicate is evaluated once per vertex. The transpose is+filtered to the induced subgraph, after which 'DG.dfs' performs one+multi-source traversal. A Boolean result mask restores ascending output+order without an @O(R log R)@ comparison sort.++Complexity: @O(V + E)@ time, excluding the cost of the @V@ predicate calls,+and @O(V + E)@ space for the filtered adjacency lists and traversal state.+-}+backwardReachable :: Graph -> (Int -> Bool) -> [Int] -> [Int]+backwardReachable graph allowed seeds =+    [vertex | vertex <- allVertices, reachedMask Unboxed.! vertex]+  where+    allVertices = vertices graph+    dim = graphDim graph++    allowedMask :: Unboxed.UArray Int Bool+    allowedMask =+        Unboxed.listArray+            (vertexBounds dim)+            (map allowed allVertices)++    isAllowed vertex = allowedMask Unboxed.! vertex++    allowedSeeds = List.filter isAllowed seeds++    restrictedPredecessors :: DG.Graph+    restrictedPredecessors =+        Array.listArray+            (vertexBounds dim)+            [ if isAllowed vertex+                then+                    List.filter+                        isAllowed+                        (graphPredecessors graph Array.! vertex)+                else []+            | vertex <- allVertices+            ]++    reached =+        concatMap flatten (DG.dfs restrictedPredecessors allowedSeeds)++    reachedMask :: Unboxed.UArray Int Bool+    reachedMask =+        Unboxed.accumArray+            (||)+            False+            (vertexBounds dim)+            [(vertex, True) | vertex <- reached]++{- | Return the strongly connected components. Vertices within each component+are in ascending order, and components are ordered by their least vertex.++Complexity: first full evaluation takes @O(V + E + V log V)@ time and @O(V)@+temporary and result space. Later projections take @O(1)@ time and @O(1)@+space before traversal of the cached result.+-}+components :: Graph -> [[Int]]+components = graphSccs++normaliseComponents :: [Tree Int] -> [[Int]]+normaliseComponents =+    List.sortOn componentKey . map (List.sort . flatten)+  where+    componentKey [] = -1+    componentKey (first : _) = first++{- | Return the strongly connected component containing a vertex.++Complexity: the first query takes @O(V + E + V log V)@ time and @O(V)@ cache+space; subsequent queries take @O(1)@ time and @O(1)@ space.+-}+componentOf :: Graph -> Int -> [Int]+componentOf graph vertex+    | vertex < 0 || vertex >= graphDim graph =+        error "Dtmc.Transition.Matrix.Internal.Graph.componentOf: vertex out of bounds"+    | otherwise = graphComponentOf graph Array.! vertex++{- | Test whether two vertices lie in the same strongly connected component;+that is, whether they communicate. This compares their cached component+indices instead of performing two reachability searches.++Complexity: the first query takes @O(V + E + V log V)@ time and @O(V)@ cache+space; subsequent queries take @O(1)@ time and @O(1)@ space.+-}+sameComponent :: Graph -> Int -> Int -> Bool+sameComponent graph a b+    | outOfRange a || outOfRange b =+        error "Dtmc.Transition.Matrix.Internal.Graph.sameComponent: vertex out of bounds"+    | otherwise =+        graphComponentId graph Unboxed.! a == graphComponentId graph Unboxed.! b+  where+    outOfRange v = v < 0 || v >= graphDim graph++{- | Test whether a vertex set is closed: no direct edge leaves it.++Duplicates are ignored, and the empty set is closed.++Complexity: @O(V + S + E_C)@ time, where @S@ is the supplied list length and+@E_C@ is the total out-degree of its vertices; @O(V)@ space for membership.+-}+isClosed :: Graph -> [Int] -> Bool+isClosed graph suppliedVertices =+    all staysInside uniqueVertices+  where+    dim = graphDim graph+    allVertices = vertices graph++    member :: Unboxed.UArray Int Bool+    member =+        Unboxed.accumArray+            (||)+            False+            (vertexBounds dim)+            [(vertex, True) | vertex <- suppliedVertices]++    uniqueVertices =+        [vertex | vertex <- allVertices, member Unboxed.! vertex]++    staysInside from =+        all+            (member Unboxed.!)+            (graphSuccessors graph Array.! from)++{- | Test whether a vertex lies in a closed strongly connected component: a+sink of the condensation with no outgoing edge. In finite-chain terms, this+is exactly recurrence, but that interpretation belongs to the Markov-chain+layer rather than this graph module.++This is the specialised, precomputed form of+@'isClosed' g ('componentOf' g v)@: the open/closed status of every component+is settled once by a pass over all edges and cached, so each later query is a+constant-time array read.++Complexity: the first query takes @O((V + E) log V)@ time and @O(V)@ cache+space; subsequent queries take @O(1)@ time and @O(1)@ space.+-}+inClosedComponent :: Graph -> Int -> Bool+inClosedComponent graph vertex+    | vertex < 0 || vertex >= graphDim graph =+        error "Dtmc.Transition.Matrix.Internal.Graph.inClosedComponent: vertex out of bounds"+    | otherwise = graphClosedComponentTable graph Unboxed.! vertex++{- | Return the period of a strongly connected component: the gcd of the+lengths of all its closed walks. 'Nothing' denotes an empty component or a+singleton with no self-loop.++The input is expected to be a genuine strongly connected component; the value+returned is the period of the component containing its first vertex, read from+the precomputed 'graphPeriodOf' table.++Complexity: an empty input takes @O(1)@ time and @O(1)@ space. The first+non-empty query takes @O((V + E) log V)@ time and @O(V)@ cache space;+subsequent queries take @O(1)@ time and @O(1)@ space.+-}+componentPeriod :: Graph -> [Int] -> Maybe Natural+componentPeriod _ [] = Nothing+componentPeriod graph (root : _) = periodOf graph root++{- | Return the period of the strongly connected component containing the+vertex. Returns 'Nothing' when that component has no cycles. The value is read+from the precomputed table.++Complexity: the first query takes @O((V + E) log V)@ time and @O(V)@ cache+space; subsequent queries take @O(1)@ time and @O(1)@ space.+-}+periodOf :: Graph -> Int -> Maybe Natural+periodOf graph vertex+    | vertex < 0 || vertex >= graphDim graph =+        error "Dtmc.Transition.Matrix.Internal.Graph.periodOf: vertex out of bounds"+    | otherwise = graphPeriodOf graph Array.! vertex++{- | Return the phase of a vertex within its strongly connected component: its+BFS level from the component's least vertex, modulo the component's period+@d@. Every edge @u -> v@ /internal to a component/ satisfies+@phaseOf v == (phaseOf u + 1) `mod` d@. Therefore, grouping a component's+vertices by phase yields its cyclic classes. An edge leaving a component+relates two independent phasings and carries no such relation. A component of+period @d@ has phases in @{0 .. d-1}@; a vertex whose component has no cycles+has phase @0@.++Complexity: the first query takes @O((V + E) log V)@ time and @O(V)@ cache+space; subsequent queries take @O(1)@ time and @O(1)@ space.+-}+phaseOf :: Graph -> Int -> Int+phaseOf graph vertex+    | vertex < 0 || vertex >= graphDim graph =+        error "Dtmc.Transition.Matrix.Internal.Graph.phaseOf: vertex out of bounds"+    | otherwise = graphPhaseOf graph Unboxed.! vertex++-- The sole caller supplies strongly connected components, but retain a+-- defensive fallback for an incomplete BFS: avoid missing-level lookups and+-- assign no period and phase 0. Otherwise one BFS supplies both cached tables.+componentPhasing :: DG.Graph -> [Int] -> (Maybe Natural, [(Int, Int)])+componentPhasing _ [] = (Nothing, [])+componentPhasing successors component@(root : _)+    | not reachedAll = (Nothing, [(vertex, 0) | vertex <- component])+    | period == 0 = (Nothing, [(vertex, 0) | vertex <- component])+    | otherwise =+        ( Just (fromIntegral period)+        , [(vertex, (levels IntMap.! vertex) `mod` period) | vertex <- component]+        )+  where+    member = IntSet.fromList component+    levels = bfsLevels successors member root+    reachedAll = IntMap.size levels == IntSet.size member++    period =+        List.foldl' accumulateVertex 0 (IntSet.toList member)++    accumulateVertex currentGcd from =+        List.foldl'+            (accumulateEdge (levels IntMap.! from))+            currentGcd+            (successors Array.! from)++    accumulateEdge fromLevel currentGcd to+        | not (IntSet.member to member) = currentGcd+        | otherwise =+            gcd currentGcd (abs (fromLevel + 1 - levels IntMap.! to))++-- Breadth-first levels within one component. Vertices are inserted into the+-- level map when enqueued, so each is enqueued exactly once.+bfsLevels :: DG.Graph -> IntSet.IntSet -> Int -> IntMap.IntMap Int+bfsLevels successors member root =+    search (Sequence.singleton root) (IntMap.singleton root 0)+  where+    search queue levels =+        case Sequence.viewl queue of+            Sequence.EmptyL -> levels+            from Sequence.:< rest ->+                search queue' levels'+              where+                fromLevel = levels IntMap.! from+                (queue', levels') =+                    List.foldl'+                        (discover fromLevel)+                        (rest, levels)+                        (successors Array.! from)++    discover fromLevel state@(queue, levels) candidate+        | not (IntSet.member candidate member) = state+        | IntMap.member candidate levels = state+        | otherwise =+            ( queue Sequence.|> candidate+            , IntMap.insert candidate (fromLevel + 1) levels+            )
+ test/Dtmc/Analysis/AbsorptionSpec.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.Analysis.AbsorptionSpec (+    spec,+) where++import Data.Finite (+    Finite,+ )+import Dtmc.Analysis.Absorption qualified as Absorption+import Dtmc.Analysis.Classification (+    recurrentStates,+    transientStates,+ )+import Dtmc.Analysis.Expectation qualified as E+import Dtmc.Analysis.HittingTime qualified as Hitting+import Dtmc.State (+    FiniteState,+ )+import Dtmc.TestSupport+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    TransitionMatrixError,+    fromRows,+ )+import GHC.Generics (+    Generic,+ )+import Test.Hspec+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck++-- The chain of the "transient class {A,B}, recurrent class {C,D}" example in+-- section 3.7 of the notes, which states G, eta and the hit-before+-- probabilities in closed form.+data Four = A | B | C | D+    deriving (Eq, Ord, Show, Generic, FiniteState)++chain :: TransitionMatrix Four+chain =+    either (error . show) id $+        fromRows+            ( chunksOf+                4+                [ 0+                , 1 / 3+                , 2 / 3+                , 0+                , 1 / 2+                , 0+                , 1 / 8+                , 3 / 8+                , 0+                , 0+                , 1 / 2+                , 1 / 2+                , 0+                , 0+                , 3 / 4+                , 1 / 4+                ]+            )++-- Two states in one recurrent class: no transient states at all.+twoCycle :: TransitionMatrix Bool+twoCycle =+    either (error . show) id $+        fromRows (chunksOf 2 [0, 1, 1, 0])++closeTo :: Double -> Double -> Bool+closeTo expected actual = approxEq testTolerance expected actual++finiteCloseTo :: Double -> E.Expectation -> Bool+finiteCloseTo expected (E.FiniteExpectation x) = closeTo expected x+finiteCloseTo _ E.InfiniteExpectation = False++rightCloseTo :: Double -> Either err Double -> Bool+rightCloseTo expected (Right actual) = closeTo expected actual+rightCloseTo _ (Left _) = False++spec :: Spec+spec = do+    describe "canonicalOrder" $+        it "splits the example chain into {A,B} and {C,D}" $+            Absorption.canonicalOrder chain `shouldBe` ([A, B], [C, D])++    describe "fundamentalMatrix" $ do+        it "indexes rows and columns by the transient states" $+            fmap fst (Absorption.fundamentalMatrix chain) `shouldBe` Right [A, B]++        it "matches the closed form of the notes" $+            case Absorption.fundamentalMatrix chain of+                Left err -> expectationFailure ("solve failed: " <> show err)+                Right (_, rows) ->+                    concat rows+                        `shouldSatisfy` ( and+                                            . zipWith closeTo [6 / 5, 2 / 5, 3 / 5, 6 / 5]+                                        )++        it "returns an empty block when no state is transient" $+            Absorption.fundamentalMatrix twoCycle `shouldBe` Right ([], [])++    describe "probability" $ do+        it "reproduces the hit-before probabilities of the notes" $ do+            Absorption.probabilityGivenInitialState chain C A `shouldSatisfy` rightCloseTo (17 / 20)+            Absorption.probabilityGivenInitialState chain D A `shouldSatisfy` rightCloseTo (3 / 20)+            Absorption.probabilityGivenInitialState chain C B `shouldSatisfy` rightCloseTo (11 / 20)+            Absorption.probabilityGivenInitialState chain D B `shouldSatisfy` rightCloseTo (9 / 20)++        it "is exact at a recurrent starting state" $ do+            Absorption.probabilityGivenInitialState chain C C `shouldBe` Right 1+            Absorption.probabilityGivenInitialState chain D C `shouldBe` Right 0++        it "is exactly zero for a transient target" $+            Absorption.probabilityGivenInitialState chain A B `shouldBe` Right 0++        it "differs from ever hitting the same state" $ do+            -- The chain reaches C almost surely, but it enters {C,D} at D+            -- with probability 3/20, so B(A,C) is strictly smaller.+            Hitting.eventualProbabilityGivenInitialState chain [C] A `shouldSatisfy` rightCloseTo 1+            Absorption.probabilityGivenInitialState chain C A `shouldSatisfy` rightCloseTo (17 / 20)++        it "agrees with eventual hitting after summing over the class" $+            case (Absorption.probabilityGivenInitialState chain C A, Absorption.probabilityGivenInitialState chain D A) of+                (Right toC, Right toD) ->+                    Hitting.eventualProbabilityGivenInitialState chain [C, D] A+                        `shouldSatisfy` rightCloseTo (toC + toD)+                other -> expectationFailure ("solve failed: " <> show other)++    describe "expectationByState" $ do+        it "matches the closed form of the notes" $+            case absorptionExpectationByState chain of+                Left err -> expectationFailure ("solve failed: " <> show err)+                Right values ->+                    values+                        `shouldSatisfy` ( and+                                            . zipWith finiteCloseTo [8 / 5, 9 / 5, 0, 0]+                                        )++        it "equals the expected hitting time of the recurrent set" $+            absorptionExpectationByState chain+                `shouldBe` hitExpectationByState chain [C, D]++    describe "absorption probabilities" $+        prop "sum to one from every transient state" $+            forAll (genTransitionRows 3) $ \m ->+                case fromRows m ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left err ->+                        counterexample ("generated matrix rejected: " <> show err) False+                    Right p ->+                        conjoin+                            [ case traverse (\k -> Absorption.probabilityGivenInitialState p k i) (recurrentStates p) of+                                -- A refused solve is a documented outcome, not a+                                -- violated law.+                                Left _ -> property True+                                Right ps ->+                                    counterexample+                                        ("from " <> show i <> ": " <> show ps)+                                        (approxEq 1e-9 1 (sum ps))+                            | i <- transientStates p+                            ]
+ test/Dtmc/Analysis/CanonicalDifferentialSpec.hs view
@@ -0,0 +1,377 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.Analysis.CanonicalDifferentialSpec (+    spec,+) where++import Data.Finite (+    Finite,+    finites,+ )+import Data.Maybe (+    fromMaybe,+ )+import Dtmc.Analysis.Event (+    DiscreteEvent (..),+ )+import Dtmc.Analysis.Expectation (+    Expectation (..),+ )+import Dtmc.Analysis.FiniteTime qualified as FT+import Dtmc.Analysis.HittingTime qualified as Hit+import Dtmc.Analysis.ProbabilityOracle qualified as Oracle+import Dtmc.Analysis.ReturnTime qualified as Return+import Dtmc.Analysis.VisitCount qualified as Visit+import Dtmc.Distribution (+    probabilityAt,+ )+import Dtmc.Distribution.Vector (+    DistributionVector,+ )+import Dtmc.Distribution.Vector qualified as Vector+import Dtmc.TestSupport+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    TransitionMatrixError,+    fromRows,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    counterexample,+    forAll,+    property,+ )++initialWeights :: [(Finite 3, Double)]+initialWeights = zip finites [0.2, 0.3, 0.5]++initialDistribution :: DistributionVector (Finite 3)+initialDistribution =+    checked (Vector.fromList [0.2, 0.3, 0.5])++terminalChain :: TransitionMatrix (Finite 3)+terminalChain =+    checked+        ( fromRows+            ( chunksOf+                3+                [ 0+                , 0.5+                , 0.5+                , 0+                , 0+                , 1+                , 0+                , 0+                , 1+                ]+            )+        )++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++known :: Maybe Double -> Double+known = fromMaybe (error "oracle horizon does not determine this event")++close :: Double -> Double -> Bool+close = approxEq testTolerance++rightClose :: Double -> Either error Double -> Bool+rightClose expected = either (const False) (close expected)++expectationClose :: Maybe Double -> Expectation -> Bool+expectationClose Nothing InfiniteExpectation = True+expectationClose (Just expected) (FiniteExpectation actual) = close expected actual+expectationClose _ _ = False++finiteAndBoundedChecks :: TransitionMatrix (Finite 3) -> Bool+finiteAndBoundedChecks matrix =+    and+        [ transitionChecks+        , trajectoryChecks+        , observationChecks+        , hittingChecks+        , returnChecks+        , visitChecks+        ]+  where+    target state = state == (2 :: Finite 3)+    transitionChecks =+        and+            [ close+                (FT.stepProbability matrix source destination)+                (Oracle.transitionWeight matrix source destination)+            | source <- finites+            , destination <- finites+            ]+            && and+                [ close+                    (FT.nStepProbability time matrix source destination)+                    (Oracle.stateProbability time [(source, 1)] matrix destination)+                | time <- [0 .. 4]+                , source <- finites+                , destination <- finites+                ]+            && and+                [ close+                    (FT.probability initialDistribution matrix [FT.At time destination])+                    (Oracle.stateProbability time initialWeights matrix destination)+                | time <- [0 .. 4]+                , destination <- finites+                ]+    trajectoryChecks =+        close+            ( FT.probability+                initialDistribution+                matrix+                [FT.At 0 0, FT.At 1 1, FT.At 2 2]+            )+            (Oracle.trajectoryProbability initialWeights matrix [0, 1, 2])+    observations = [(1, 1), (3, 2)]+    oracleJoint =+        Oracle.observationProbability 3 initialWeights matrix observations+    observationChecks =+        close+            (FT.probability initialDistribution matrix [FT.At 1 1, FT.At 3 2])+            oracleJoint+            && conditionalChecks+    conditionalChecks =+        let denominator =+                Oracle.observationProbability 1 initialWeights matrix [(1, 1)]+            numerator = oracleJoint+            actual =+                FT.probabilityGiven+                    initialDistribution+                    matrix+                    [FT.At 3 2]+                    [FT.At 1 1]+         in if denominator == 0+                then actual == Left FT.ZeroProbabilityCondition+                else either (const False) (close (numerator / denominator)) actual+    hittingChecks =+        and+            [ let law = Oracle.hittingLaw 4 matrix target source+                  exact = known (Oracle.lawProbability (EqualTo time) law)+                  dense = (hitProbabilityByState (EqualTo time) matrix [2])+               in close (Hit.probabilityGivenInitialState (EqualTo time) matrix target source) exact+                    && close (dense !! fromIntegral source) exact+            | source <- finites+            , time <- [0 .. 4]+            ]+            && and+                [ let law = Oracle.hittingLaw 4 matrix target source+                      bounded = known (Oracle.lawProbability (LessThan bound) law)+                      dense = (hitProbabilityByState (LessThan bound) matrix [2])+                   in close+                        (Hit.probabilityGivenInitialState (LessThan bound) matrix target source)+                        bounded+                        && close (dense !! fromIntegral source) bounded+                | source <- finites+                , bound <- [0 .. 5]+                ]+    returnChecks =+        and+            [ let law = Oracle.returnLaw 4 matrix source+                  exact = known (Oracle.lawProbability (EqualTo time) law)+                  dense = (returnProbabilityByState (EqualTo time) matrix)+               in close (Return.probabilityGivenInitialState (EqualTo time) matrix source) exact+                    && close (dense !! fromIntegral source) exact+            | source <- finites+            , time <- [0 .. 4]+            ]+            && and+                [ let law = Oracle.returnLaw 4 matrix source+                      bounded = known (Oracle.lawProbability (LessThan bound) law)+                      dense = (returnProbabilityByState (LessThan bound) matrix)+                   in close+                        (Return.probabilityGivenInitialState (LessThan bound) matrix source)+                        bounded+                        && close (dense !! fromIntegral source) bounded+                | source <- finites+                , bound <- [0 .. 5]+                ]+    visitChecks =+        and+            [ let law =+                    Oracle.visitLawBefore+                        bound+                        initialWeights+                        matrix+                        target+                  distribution =+                    Visit.boundedLaw+                        bound+                        initialDistribution+                        matrix+                        target+                  expected = known (Oracle.lawFiniteExpectation law)+               in and+                    [ close+                        (probabilityAt distribution count)+                        (known (Oracle.lawProbability (EqualTo count) law))+                        && close+                            ( Visit.boundedProbability+                                bound+                                (EqualTo count)+                                initialDistribution+                                matrix+                                target+                            )+                            (known (Oracle.lawProbability (EqualTo count) law))+                    | count <- [0 .. bound]+                    ]+                    && close+                        ( Visit.boundedExpectation+                            bound+                            initialDistribution+                            matrix+                            target+                        )+                        expected+            | bound <- [0 .. 4]+            ]++terminalChecks :: Bool+terminalChecks =+    and+        [ hittingEventualChecks+        , hittingRaceChecks+        , hittingExpectationChecks+        , returnEventualChecks+        , returnExpectationChecks+        , totalVisitChecks+        ]+  where+    states = finites :: [Finite 3]+    target state = state == (1 :: Finite 3)+    competing state = state == (2 :: Finite 3)+    hitLaws = [Oracle.hittingLaw 1 terminalChain target state | state <- states]+    returnLaws = [Oracle.returnLaw 1 terminalChain state | state <- states]+    eventual law = 1 - Oracle.lawUnresolvedMass law+    hitValues = map eventual hitLaws+    returnValues = map eventual returnLaws+    hittingEventualChecks =+        case hitEventualProbabilityByState terminalChain [1] of+            Left _ -> False+            Right dense ->+                and (zipWith close (dense) hitValues)+                    && and+                        [ rightClose expected (Hit.eventualProbabilityGivenInitialState terminalChain [1] state)+                        | (state, expected) <- zip states hitValues+                        ]+    raceValues =+        [ Oracle.raceProbabilityWithin+            1+            terminalChain+            target+            competing+            state+        | state <- states+        ]+    hittingRaceChecks =+        case hitRaceProbabilityByState terminalChain [1] [2] of+            Left _ -> False+            Right dense ->+                and (zipWith close (dense) raceValues)+                    && and+                        [ rightClose+                            expected+                            (Hit.raceProbabilityGivenInitialState terminalChain [1] [2] state)+                        | (state, expected) <- zip states raceValues+                        ]+    hitExpectations = map Oracle.lawFiniteExpectation hitLaws+    hittingExpectationChecks =+        case hitExpectationByState terminalChain [1] of+            Left _ -> False+            Right actual ->+                and (zipWith expectationClose hitExpectations actual)+                    && and+                        [ either+                            (const False)+                            (expectationClose expected)+                            (Hit.expectationGivenInitialState terminalChain [1] state)+                        | (state, expected) <- zip states hitExpectations+                        ]+    returnEventualChecks =+        case returnEventualProbabilityByState terminalChain of+            Left _ -> False+            Right dense ->+                and (zipWith close (dense) returnValues)+                    && and+                        [ rightClose expected (Return.eventualProbabilityGivenInitialState terminalChain state)+                        | (state, expected) <- zip states returnValues+                        ]+    returnExpectations = map Oracle.lawFiniteExpectation returnLaws+    returnExpectationChecks =+        case returnExpectationByState terminalChain of+            Left _ -> False+            Right actual ->+                and (zipWith expectationClose returnExpectations actual)+                    && and+                        [ either+                            (const False)+                            (expectationClose expected)+                            (Return.expectationGivenInitialState terminalChain state)+                        | (state, expected) <- zip states returnExpectations+                        ]+    visitLaws =+        [ Oracle.visitLawBefore 2 [(state, 1)] terminalChain target+        | state <- states+        ]+    visitExpectations = map Oracle.lawFiniteExpectation visitLaws+    totalVisitChecks =+        and+            [ case visitTotalProbabilityByState (EqualTo count) terminalChain 1 of+                Left _ -> False+                Right dense ->+                    and+                        [ let expected = known (Oracle.lawProbability (EqualTo count) law)+                           in close (dense !! fromIntegral state) expected+                                && rightClose+                                    expected+                                    (Visit.totalProbabilityGivenInitialState (EqualTo count) terminalChain 1 state)+                        | (state, law) <- zip states visitLaws+                        ]+            | count <- [0 .. 2]+            ]+            && case visitInfiniteProbabilityByState terminalChain 1 of+                Left _ -> False+                Right dense ->+                    dense == [0, 0, 0]+                        && all+                            (rightClose 0 . Visit.infiniteProbabilityGivenInitialState terminalChain 1)+                            states+            && case visitTotalExpectationByState terminalChain 1 of+                Left _ -> False+                Right actual ->+                    and (zipWith expectationClose visitExpectations actual)+                        && and+                            [ either+                                (const False)+                                (expectationClose expected)+                                (Visit.totalExpectationGivenInitialState terminalChain 1 state)+                            | (state, expected) <- zip states visitExpectations+                            ]++spec :: Spec+spec = do+    describe "canonical finite-horizon differential baseline" $ do+        prop "all finite and bounded queries match path enumeration (random @3)" $+            forAll (genTransitionRows 3) $ \rawMatrix ->+                case fromRows rawMatrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left problem -> counterexample (show problem) False+                    Right matrix -> property (finiteAndBoundedChecks matrix)++    describe "canonical infinite-horizon differential baseline" $ do+        it "all eventual, race, expectation, and total-visit queries match a completed path law" $+            terminalChecks
+ test/Dtmc/Analysis/ClassificationSpec.hs view
@@ -0,0 +1,603 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.Analysis.ClassificationSpec (+    spec,+) where++import Data.Finite (+    Finite,+    finites,+    getFinite,+ )+import Data.List (+    sort,+ )+import Dtmc.Analysis.Classification (+    CommClass (..),+    absorbingStates,+    accessible,+    aperiodic,+    chainPeriod,+    communicates,+    communicatingClasses,+    cyclicClasses,+    ergodic,+    irreducible,+    period,+    reachesAny,+    recurrentState,+    recurrentStates,+    supportEdge,+    transientState,+    transientStates,+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.TestSupport (+    chunksOf,+    genTransitionRows,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    TransitionMatrixError,+    fromRows,+    toRows,+ )+import GHC.Generics (+    Generic,+ )+import GHC.TypeNats (+    KnownNat,+ )+import Numeric.Natural (Natural)+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    Property,+    conjoin,+    counterexample,+    forAll,+    property,+    (===),+ )++data NamedClassState = ClassA | ClassB | ClassC+    deriving (Eq, Ord, Show, Generic)++instance FiniteState NamedClassState++checked :: (Show e) => Either e a -> a+checked = either (error . show) id++threeCycle :: TransitionMatrix (Finite 3)+threeCycle =+    checked $+        fromRows+            ( chunksOf+                3+                [ 0+                , 1+                , 0+                , 0+                , 0+                , 1+                , 1+                , 0+                , 0+                ]+            )++namedThreeCycle :: TransitionMatrix NamedClassState+namedThreeCycle =+    checked $+        fromRows @NamedClassState+            (chunksOf 3 [0, 1, 0, 0, 0, 1, 1, 0, 0])++selfLoopTwo :: TransitionMatrix (Finite 2)+selfLoopTwo =+    checked $+        fromRows+            ( chunksOf+                2+                [ 0.5+                , 0.5+                , 1.0+                , 0.0+                ]+            )++bipartiteTwo :: TransitionMatrix (Finite 2)+bipartiteTwo =+    checked $+        fromRows+            ( chunksOf+                2+                [ 0+                , 1+                , 1+                , 0+                ]+            )++sevenState :: TransitionMatrix (Finite 7)+sevenState =+    checked $+        fromRows+            ( chunksOf+                7+                [ 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0.4+                , 0+                , 0.6+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0.3+                , 0+                , 0.7+                , 0+                , 0+                , 0+                , 0+                , 0.3+                , 0.4+                , 0+                , 0.3+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0.2+                , 0+                , 0.8+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 1+                ]+            )++identityThree :: TransitionMatrix (Finite 3)+identityThree =+    checked $+        fromRows+            ( chunksOf+                3+                [ 1+                , 0+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 1+                ]+            )++-- Exercise 3.2.2: irreducible, period 2, cyclic classes {A,B} and {C,D}.+fourStateCyclic :: TransitionMatrix (Finite 4)+fourStateCyclic =+    checked $+        fromRows+            ( chunksOf+                4+                [ 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 1+                , 0.5+                , 0.5+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                ]+            )++matrixSupport :: TransitionMatrix (Finite n) -> [[Bool]]+matrixSupport = map (map (> 0)) . toRows++boolMul :: [[Bool]] -> [[Bool]] -> [[Bool]]+boolMul a b =+    [ [or [ai && (b !! k !! j) | (k, ai) <- zip [0 ..] row] | j <- idxs]+    | row <- a+    ]+  where+    idxs = [0 .. length a - 1]++boolIdentity :: Int -> [[Bool]]+boolIdentity dim = [[i == j | j <- [0 .. dim - 1]] | i <- [0 .. dim - 1]]++referencePeriod :: [[Bool]] -> Int -> Maybe Natural+referencePeriod s i =+    case returns of+        [] -> Nothing+        _ -> Just (fromIntegral (foldr1 gcd returns))+  where+    dim = length s+    bound = 4 * dim * dim + 1+    powers = take bound (drop 1 (iterate (boolMul s) (boolIdentity dim)))+    returns = [k | (k, m) <- zip [1 :: Int ..] powers, (m !! i) !! i]++classesAsInts :: (KnownNat n) => TransitionMatrix (Finite n) -> [[Integer]]+classesAsInts = map (map getFinite . classMembers) . communicatingClasses++cyclicClassesAsInts :: (KnownNat n) => TransitionMatrix (Finite n) -> Maybe [[Integer]]+cyclicClassesAsInts = fmap (map (map getFinite)) . cyclicClasses++sortUnique :: (Ord a) => [a] -> [a]+sortUnique = foldr insert []+  where+    insert x [] = [x]+    insert x (y : ys)+        | x < y = x : y : ys+        | x == y = y : ys+        | otherwise = y : insert x ys++periodMatchesReference :: (KnownNat n) => TransitionMatrix (Finite n) -> [Finite n] -> Property+periodMatchesReference p states =+    conjoin+        [ period p i === referencePeriod s (fromIntegral (getFinite i))+        | i <- states+        ]+  where+    s = matrixSupport p++spec :: Spec+spec = do+    describe "communication is an equivalence relation" $ do+        prop "is reflexive, symmetric, and transitive on random support graphs" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p ->+                        let states = finites :: [Finite 4]+                         in conjoin+                                [ conjoin+                                    [ counterexample "reflexivity" (communicates p i i)+                                    | i <- states+                                    ]+                                , conjoin+                                    [ counterexample "symmetry" $+                                        communicates p i j === communicates p j i+                                    | i <- states+                                    , j <- states+                                    ]+                                , conjoin+                                    [ counterexample "transitivity" $+                                        not (communicates p i j && communicates p j k)+                                            || communicates p i k+                                    | i <- states+                                    , j <- states+                                    , k <- states+                                    ]+                                ]+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++        prop "accessibility is reflexive" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p ->+                        conjoin+                            [ property (accessible p i i)+                            | i <- finites :: [Finite 4]+                            ]+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++    describe "reachesAny" $ do+        it "finds a reachable target" $+            reachesAny threeCycle 0 [2] `shouldBe` True++        it "returns false for an empty target set" $+            reachesAny threeCycle 0 [] `shouldBe` False++        it "uses zero-step reachability" $+            reachesAny identityThree 1 [1] `shouldBe` True++    describe "period" $ do+        it "is 3 for every state of the three-cycle" $+            map (period threeCycle) (finites :: [Finite 3])+                `shouldBe` [Just 3, Just 3, Just 3]++        it "is 1 for the self-loop chain (aperiodic)" $ do+            map (period selfLoopTwo) (finites :: [Finite 2])+                `shouldBe` [Just 1, Just 1]+            aperiodic selfLoopTwo `shouldBe` True++        it "is 2 for the bipartite swap (periodic)" $ do+            map (period bipartiteTwo) (finites :: [Finite 2])+                `shouldBe` [Just 2, Just 2]+            aperiodic bipartiteTwo `shouldBe` False++        it "matches the hand-computed periods of the seven-state chain" $+            map (period sevenState) (finites :: [Finite 7])+                `shouldBe` [Just 2, Just 2, Just 1, Just 1, Just 1, Just 1, Just 1]++        prop "agrees with the gcd of return-time lengths (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p -> periodMatchesReference p (finites :: [Finite 4])+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++        prop "agrees with the gcd of return-time lengths (random @3)" $+            forAll (genTransitionRows 3) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Right p -> periodMatchesReference p (finites :: [Finite 3])+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++    describe "communicatingClasses" $ do+        it "splits the seven-state chain into {A,B}, {C,D,E,F}, {G}" $+            classesAsInts sevenState `shouldBe` [[0, 1], [2, 3, 4, 5], [6]]++        it "returns a single class for the irreducible three-cycle" $+            classesAsInts threeCycle `shouldBe` [[0, 1, 2]]++        prop "the classes partition the state space (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p ->+                        property (sortUnique (concat (classesAsInts p)) == [0 .. 3])+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++        prop "communication agrees with the class partition (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p ->+                        let states = finites :: [Finite 4]+                            classIx = map classMembers (communicatingClasses p)+                            sameClass i j = or [i `elem` c && j `elem` c | c <- classIx]+                         in conjoin+                                [ counterexample (show (i, j)) $+                                    communicates p i j === sameClass i j+                                | i <- states+                                , j <- states+                                ]+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++    describe "cyclicClasses" $ do+        it "splits the period-2 four-state chain into {A,B} and {C,D}" $+            cyclicClassesAsInts fourStateCyclic `shouldBe` Just [[0, 1], [2, 3]]++        it "splits the three-cycle into three singletons" $+            cyclicClassesAsInts threeCycle `shouldBe` Just [[0], [1], [2]]++        it "is Nothing for the reducible seven-state chain" $+            cyclicClassesAsInts sevenState `shouldBe` Nothing++        prop "classes partition the states and advance one step (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p ->+                        case cyclicClasses p of+                            Nothing -> property True+                            Just cs ->+                                let d = length cs+                                    states = finites :: [Finite 4]+                                 in conjoin+                                        [ counterexample "partition" (sort (concat cs) === states)+                                        , conjoin+                                            [ counterexample (show (i, j)) $+                                                property (j `elem` (cs !! ((r + 1) `mod` d)))+                                            | (r, c) <- zip [0 ..] cs+                                            , i <- c+                                            , j <- states+                                            , supportEdge p i j+                                            ]+                                        ]+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++    describe "irreducible" $ do+        it "holds for the three-cycle and swap, fails for the seven-state chain" $ do+            irreducible threeCycle `shouldBe` True+            irreducible bipartiteTwo `shouldBe` True+            irreducible sevenState `shouldBe` False++    describe "communicatingClasses details" $ do+        it "records members, periods, and closedness for the seven-state chain" $ do+            let cs = communicatingClasses sevenState+            map (map getFinite . classMembers) cs+                `shouldBe` [[0, 1], [2, 3, 4, 5], [6]]+            map classPeriod cs `shouldBe` [Just 2, Just 1, Just 1]+            map classClosed cs `shouldBe` [True, False, True]++    describe "absorbingStates" $ do+        it "finds the absorbing states" $ do+            map getFinite (absorbingStates sevenState) `shouldBe` [6]+            map getFinite (absorbingStates identityThree) `shouldBe` [0, 1, 2]+            map getFinite (absorbingStates threeCycle) `shouldBe` []++        prop "absorbing states have only a self-loop (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p ->+                        conjoin+                            [ counterexample (show i) $+                                [j | j <- finites :: [Finite 4], supportEdge p i j] === [i]+                            | i <- absorbingStates p+                            ]+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++    describe "whole-chain queries agree with the class summaries" $ do+        -- These are not restatements of one definition: the left-hand sides+        -- reach the support graph through G.components and G.componentPeriod,+        -- the right-hand sides through G.periodOf and per-class closedness.+        prop "on random @4 chains" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p ->+                        let cs = communicatingClasses p+                            closed = filter classClosed cs+                            open = filter (not . classClosed) cs+                         in conjoin+                                [ counterexample "irreducible" $+                                    irreducible p === (length cs == 1)+                                , counterexample "aperiodic" $+                                    aperiodic p+                                        === (not (null cs) && all ((== Just 1) . classPeriod) cs)+                                , counterexample "ergodic" $+                                    ergodic p === (irreducible p && aperiodic p)+                                , counterexample "recurrentStates" $+                                    recurrentStates p+                                        === concatMap classMembers closed+                                , counterexample "transientStates" $+                                    transientStates p+                                        === concatMap classMembers open+                                , counterexample "chainPeriod" $+                                    chainPeriod p+                                        === case cs of+                                            [singleClass] -> classPeriod singleClass+                                            _ -> Nothing+                                ]+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++        prop "chainPeriod is the shared period of an irreducible chain (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p+                        | irreducible p ->+                            conjoin+                                [ counterexample (show i) (chainPeriod p === period p i)+                                | i <- finites :: [Finite 4]+                                ]+                        | otherwise -> property True+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++    describe "recurrence and transience" $ do+        it "matches the closed classes of the seven-state chain" $ do+            map getFinite (recurrentStates sevenState) `shouldBe` [0, 1, 6]+            map getFinite (transientStates sevenState) `shouldBe` [2, 3, 4, 5]++        it "marks every state of the irreducible three-cycle recurrent" $ do+            map getFinite (recurrentStates threeCycle) `shouldBe` [0, 1, 2]+            transientStates threeCycle `shouldBe` []++        it "marks every state of the identity chain recurrent" $ do+            map getFinite (recurrentStates identityThree) `shouldBe` [0, 1, 2]+            transientStates identityThree `shouldBe` []++        prop "recurrent and transient states partition the state space (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p ->+                        sort+                            ( map getFinite (recurrentStates p)+                                <> map getFinite (transientStates p)+                            )+                            === [0 .. 3]+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++        prop "every finite chain has a recurrent state (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p ->+                        property (not (null (recurrentStates p)))+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++        prop "transient iff some reachable state cannot reach back (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p ->+                        let states = finites :: [Finite 4]+                         in conjoin+                                [ transientState p i+                                    === or+                                        [ accessible p i j && not (accessible p j i)+                                        | j <- states+                                        ]+                                | i <- states+                                ]+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++        prop "predicates agree with the state lists (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                case fromRows matrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 4)) of+                    Right p ->+                        let states = finites :: [Finite 4]+                         in conjoin+                                [ recurrentState p i === (i `elem` recurrentStates p)+                                | i <- states+                                ]+                    Left err ->+                        counterexample ("generated matrix was rejected: " <> show err) False++    describe "named finite states" $ do+        it "reports communication and periods with named constructors" $ do+            map classMembers (communicatingClasses namedThreeCycle)+                `shouldBe` [[ClassA, ClassB, ClassC]]+            map (period namedThreeCycle) [ClassA, ClassB, ClassC]+                `shouldBe` replicate 3 (Just 3)++        it "returns named recurrent states in canonical order" $+            recurrentStates namedThreeCycle+                `shouldBe` [ClassA, ClassB, ClassC]++        it "answers whole-chain queries with named constructors" $ do+            map classMembers (communicatingClasses namedThreeCycle)+                `shouldBe` [[ClassA, ClassB, ClassC]]+            recurrentStates namedThreeCycle `shouldBe` [ClassA, ClassB, ClassC]+            absorbingStates namedThreeCycle `shouldBe` []+            chainPeriod namedThreeCycle `shouldBe` Just 3+            ergodic namedThreeCycle `shouldBe` False
+ test/Dtmc/Analysis/EventSpec.hs view
@@ -0,0 +1,97 @@+module Dtmc.Analysis.EventSpec (+    spec,+) where++import Dtmc.Analysis.Event (+    DiscreteEvent (..),+    includesInfiniteOutcome,+    matches,+ )+import Numeric.Natural (+    Natural,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    NonNegative (..),+    property,+ )++asNatural :: NonNegative Integer -> Natural+asNatural (NonNegative value) = fromInteger value++spec :: Spec+spec = do+    describe "matches" $ do+        it "implements every comparison at and around its threshold" $ do+            let values = [2, 3, 4]+            map (matches (EqualTo 3)) values+                `shouldBe` [False, True, False]+            map (matches (LessThan 3)) values+                `shouldBe` [True, False, False]+            map (matches (AtMost 3)) values+                `shouldBe` [True, True, False]+            map (matches (GreaterThan 3)) values+                `shouldBe` [False, False, True]+            map (matches (AtLeast 3)) values+                `shouldBe` [False, True, True]++        it "has the structural zero-threshold boundaries" $ do+            matches (LessThan 0) 0 `shouldBe` False+            matches (AtMost 0) 0 `shouldBe` True+            matches (GreaterThan 0) 0 `shouldBe` False+            matches (AtLeast 0) 0 `shouldBe` True++        prop "AtMost n is LessThan (n + 1)" $ \rawThreshold rawValue ->+            let threshold = asNatural rawThreshold+                value = asNatural rawValue+             in matches (AtMost threshold) value+                    == matches (LessThan (threshold + 1)) value++        prop "AtLeast (n + 1) is GreaterThan n" $ \rawThreshold rawValue ->+            let threshold = asNatural rawThreshold+                value = asNatural rawValue+             in matches (AtLeast (threshold + 1)) value+                    == matches (GreaterThan threshold) value++        prop "upper and lower complements partition every finite value" $+            \rawThreshold rawValue ->+                let threshold = asNatural rawThreshold+                    value = asNatural rawValue+                 in property $+                        and+                            [ matches (GreaterThan threshold) value+                                /= matches (AtMost threshold) value+                            , matches (AtLeast threshold) value+                                /= matches (LessThan threshold) value+                            ]++    describe "includesInfiniteOutcome" $ do+        it "includes infinity exactly in upper-tail events" $ do+            map+                includesInfiniteOutcome+                [ EqualTo 3+                , LessThan 3+                , AtMost 3+                , GreaterThan 3+                , AtLeast 3+                ]+                `shouldBe` [False, False, False, True, True]++        prop "is independent of the finite threshold" $ \rawThreshold ->+            let threshold = asNatural rawThreshold+             in property $+                    and+                        [ not (includesInfiniteOutcome (EqualTo threshold))+                        , not (includesInfiniteOutcome (LessThan threshold))+                        , not (includesInfiniteOutcome (AtMost threshold))+                        , includesInfiniteOutcome (GreaterThan threshold)+                        , includesInfiniteOutcome (AtLeast threshold)+                        ]
+ test/Dtmc/Analysis/FiniteTimeCanonicalSpec.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.Analysis.FiniteTimeCanonicalSpec (+    spec,+) where++import Data.Finite (+    Finite,+    finites,+ )+import Dtmc.Analysis.FiniteTime qualified as FT+import Dtmc.Analysis.ProbabilityOracle qualified as Oracle+import Dtmc.Distribution.Map (+    fromList,+    pointMass,+ )+import Dtmc.Distribution.Vector (+    DistributionVector,+ )+import Dtmc.Distribution.Vector qualified as Vector+import Dtmc.TestSupport (+    approxEq,+    chunksOf,+    genTransitionRows,+    testTolerance,+ )+import Dtmc.Transition.Kernel (+    TransitionKernel,+    fromLaws,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    TransitionMatrixError,+    fromRows,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    counterexample,+    forAll,+    property,+ )++initialWeights :: [(Finite 3, Double)]+initialWeights = zip finites [0.2, 0.3, 0.5]++initialDistribution :: DistributionVector (Finite 3)+initialDistribution =+    checked (Vector.fromList [0.2, 0.3, 0.5])++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++simpleRandomWalk :: TransitionKernel Integer+simpleRandomWalk =+    fromLaws $ \state ->+        checked+            ( fromList+                [(state - 1, 0.5), (state + 1, 0.5)]+            )++close :: Double -> Double -> Bool+close = approxEq testTolerance++canonicalMatchesOracle :: TransitionMatrix (Finite 3) -> Bool+canonicalMatchesOracle matrix =+    and+        [ and+            [ close+                (FT.stepProbability matrix source destination)+                (Oracle.transitionWeight matrix source destination)+            | source <- finites+            , destination <- finites+            ]+        , and+            [ close+                (FT.nStepProbability time matrix source destination)+                (Oracle.stateProbability time [(source, 1)] matrix destination)+            | time <- [0 .. 4]+            , source <- finites+            , destination <- finites+            ]+        , and+            [ close+                (FT.probability initialDistribution matrix [FT.At time destination])+                (Oracle.stateProbability time initialWeights matrix destination)+            | time <- [0 .. 4]+            , destination <- finites+            ]+        , close+            ( FT.probability+                initialDistribution+                matrix+                [FT.At 0 0, FT.At 1 1, FT.At 2 2]+            )+            (Oracle.trajectoryProbability initialWeights matrix [0, 1, 2])+        , close+            ( FT.probability+                initialDistribution+                matrix+                [FT.At 1 1, FT.At 3 2]+            )+            ( Oracle.observationProbability+                3+                initialWeights+                matrix+                [(1, 1), (3, 2)]+            )+        , conditionalMatchesOracle+        ]+  where+    denominator =+        Oracle.observationProbability 1 initialWeights matrix [(1, 1)]+    numerator =+        Oracle.observationProbability+            3+            initialWeights+            matrix+            [(1, 1), (3, 2)]+    conditionalMatchesOracle =+        case FT.probabilityGiven+            initialDistribution+            matrix+            [FT.At 3 2]+            [FT.At 1 1] of+            Left FT.ZeroProbabilityCondition -> denominator == 0+            Right actual -> denominator /= 0 && close actual (numerator / denominator)++spec :: Spec+spec = do+    describe "canonical finite-time namespace" $ do+        it "uses the four grammar-compliant names together" $ do+            let matrix :: TransitionMatrix (Finite 2)+                matrix =+                    checked+                        ( fromRows+                            (chunksOf 2 [0.5, 0.5, 0, 1])+                        )+                initial :: DistributionVector (Finite 2)+                initial =+                    checked+                        (Vector.fromList [1, 0])+            FT.stepProbability matrix 0 1 `shouldBe` 0.5+            FT.nStepProbability 2 matrix 0 1 `shouldBe` 0.75+            FT.probability initial matrix [FT.At 1 1] `shouldBe` 0.5+            FT.probability initial matrix [FT.At 0 0, FT.At 1 1]+                `shouldBe` 0.5+            FT.probabilityGiven+                initial+                matrix+                [FT.At 1 1]+                [FT.At 0 0]+                `shouldBe` Right 0.5++        it "preserves locally finite countable-state support" $ do+            FT.stepProbability simpleRandomWalk 0 1 `shouldBe` 0.5+            FT.nStepProbability 2 simpleRandomWalk 0 0 `shouldBe` 0.5+            FT.probability (pointMass 0) simpleRandomWalk [FT.At 2 0]+                `shouldBe` 0.5+            FT.probability+                (pointMass 0)+                simpleRandomWalk+                [FT.At 0 0, FT.At 1 1, FT.At 2 0]+                `shouldBe` 0.25+            FT.probability+                (pointMass 0)+                simpleRandomWalk+                [FT.At 0 0, FT.At 2 0]+                `shouldBe` 0.5+            FT.probabilityGiven+                (pointMass 0)+                simpleRandomWalk+                [FT.At 2 0]+                [FT.At 1 1]+                `shouldBe` Right 0.5++        prop "matches independent path enumeration (random @3)" $+            forAll (genTransitionRows 3) $ \rawMatrix ->+                case fromRows rawMatrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left problem -> counterexample (show problem) False+                    Right matrix -> property (canonicalMatchesOracle matrix)
+ test/Dtmc/Analysis/FiniteTimeSpec.hs view
@@ -0,0 +1,671 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.Analysis.FiniteTimeSpec (+    spec,+) where++import Data.Finite (+    Finite,+    finites,+    getFinite,+ )+import Dtmc.Analysis.FiniteTime (+    ConditionalProbabilityError (..),+    Observation (..),+    nStepProbability,+    probability,+    probabilityGiven,+    stepProbability,+ )+import Dtmc.Distribution (+    probabilityAt,+ )+import Dtmc.Distribution.Map qualified as DistributionMap+import Dtmc.Distribution.Vector (+    DistributionVector,+ )+import Dtmc.Distribution.Vector qualified as Vector+import Dtmc.Dynamics (+    evolveVector,+    evolveVectorN,+ )+import Dtmc.State qualified+import Dtmc.TestSupport (+    approxEq,+    chunksOf,+    genSimplexPoint,+    genTransitionRows,+    testTolerance,+ )+import Dtmc.Transition.Kernel qualified as Kernel+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    TransitionMatrixError,+    fromRows,+    power,+    rowAt,+    toRows,+ )+import GHC.Generics (+    Generic,+ )+import Numeric.Natural (+    Natural,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+    shouldSatisfy,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    choose,+    conjoin,+    counterexample,+    forAll,+    property,+    (===),+ )++-- A three-state chain with several impossible one-step transitions.+chain :: TransitionMatrix (Finite 3)+chain =+    either (error . show) id $+        fromRows+            ( chunksOf+                3+                [ 0.5+                , 0.5+                , 0.0+                , 0.0+                , 0.2+                , 0.8+                , 1.0+                , 0.0+                , 0.0+                ]+            )++initial :: DistributionVector (Finite 3)+initial =+    either (error . show) id $+        Vector.fromList [0.6, 0.3, 0.1]++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++asTransitionKernel ::+    (Dtmc.State.FiniteState state) =>+    TransitionMatrix state ->+    Kernel.TransitionKernel state+asTransitionKernel matrix =+    Kernel.fromLaws $ \source ->+        checked $+            DistributionMap.fromList+                [ (destination, stepProbability matrix source destination)+                | destination <- Dtmc.State.finiteStates+                ]++kernelChain :: Kernel.TransitionKernel (Finite 3)+kernelChain = asTransitionKernel chain++mapInitial :: DistributionMap.DistributionMap (Finite 3)+mapInitial =+    checked $+        DistributionMap.fromList+            [ (state, probabilityAt initial state)+            | state <- Dtmc.State.finiteStates+            ]++simpleRandomWalk :: Kernel.TransitionKernel Integer+simpleRandomWalk =+    Kernel.fromLaws $ \state ->+        checked+            (DistributionMap.fromList [(state - 1, 0.5), (state + 1, 0.5)])++closeTo :: Double -> Double -> Bool+closeTo = approxEq testTolerance++{- | Hold for a @Right@ whose 'Double' is within 'testTolerance' of the+expected value; fail for any @Left@ or out-of-tolerance value.+-}+rightCloseTo :: Double -> Either ConditionalProbabilityError Double -> Bool+rightCloseTo expected (Right actual) = approxEq testTolerance actual expected+rightCloseTo _ (Left _) = False++rightResultsClose :: Either error Double -> Either error Double -> Bool+rightResultsClose (Right left) (Right right) = closeTo left right+rightResultsClose (Left _) (Left _) = True+rightResultsClose _ _ = False++data NamedPhase = PhaseA | PhaseB | PhaseC+    deriving (Eq, Ord, Show, Generic)++instance Dtmc.State.FiniteState NamedPhase++namedCycle :: TransitionMatrix NamedPhase+namedCycle =+    either (error . show) id $+        fromRows @NamedPhase+            (chunksOf 3 [0, 1, 0, 0, 0, 1, 1, 0, 0])++twoState :: TransitionMatrix (Finite 2)+twoState =+    either (error . show) id $+        fromRows+            (chunksOf 2 [0.9, 0.1, 0.4, 0.6])++twoStateSquared :: TransitionMatrix (Finite 2)+twoStateSquared =+    either (error . show) id $+        fromRows+            (chunksOf 2 [0.85, 0.15, 0.6, 0.4])++closedFormTransition :: TransitionMatrix (Finite 3)+closedFormTransition =+    either (error . show) id $+        fromRows+            ( chunksOf+                3+                [ 0.1+                , 0.5+                , 0.4+                , 0.1+                , 0.8+                , 0.1+                , 0.0+                , 0.5+                , 0.5+                ]+            )++closedFormProbability :: Int -> Double+closedFormProbability n =+    5 / 63 + 5 / 18 * (0.1 ^ n) - 5 / 14 * (0.3 ^ n)++{- | Five-state transition matrix over states @[A, B, C, D, E]@ used by the+probability examples.+-}+observationMatrix :: TransitionMatrix (Finite 5)+observationMatrix =+    either (error . show) id $+        fromRows+            ( chunksOf+                5+                [ 0+                , 0+                , 0+                , 1+                , 0+                , 1 / 3+                , 0+                , 0+                , 0+                , 2 / 3+                , 0+                , 0+                , 0+                , 0+                , 1+                , 0+                , 0+                , 1 / 3+                , 2 / 3+                , 0+                , 1 / 4+                , 1 / 4+                , 0+                , 0+                , 1 / 2+                ]+            )++-- | Initial law @lambda = [1/4, 1/2, 0, 1/4, 0]@ for the probability examples.+observationInitial :: DistributionVector (Finite 5)+observationInitial =+    either (error . show) id $+        Vector.fromList [1 / 4, 1 / 2, 0, 1 / 4, 0]++spec :: Spec+spec = do+    describe "Observation" $ do+        it "is polymorphic in the state type" $+            (At 2 "rain" :: Observation String) `shouldBe` At 2 "rain"++    describe "stepProbability" $ do+        prop "agrees with rowAt then probabilityAt" $+            forAll (genTransitionRows 3) $ \matrix ->+                case fromRows @(Finite 3) matrix of+                    Right p ->+                        conjoin+                            [ stepProbability p i j+                                === probabilityAt (rowAt p i) j+                            | i <- finites+                            , j <- finites+                            ]+                    Left err ->+                        counterexample+                            ("generated matrix was rejected: " <> show err)+                            False++        it "uses named state constructors" $+            stepProbability namedCycle PhaseB PhaseC+                `shouldBe` 1++    describe "nStepProbability" $ do+        it "is the Kronecker delta at exponent zero" $+            let ijs =+                    [(i, j) | i <- finites, j <- finites] ::+                        [(Finite 2, Finite 2)]+             in map (uncurry (nStepProbability 0 twoState)) ijs+                    `shouldBe` map (\(i, j) -> if i == j then 1 else 0) ijs++        prop "agrees with stepProbability at exponent one" $+            forAll (genTransitionRows 3) $ \matrix ->+                case fromRows @(Finite 3) matrix of+                    Right p ->+                        conjoin+                            [ property $+                                approxEq+                                    testTolerance+                                    (nStepProbability 1 p i j)+                                    (stepProbability p i j)+                            | i <- finites+                            , j <- finites+                            ]+                    Left err ->+                        counterexample+                            ("generated matrix was rejected: " <> show err)+                            False++        it "matches a hand-computed square at exponent two" $+            sequence_+                [ nStepProbability 2 twoState i j+                    `shouldSatisfy` closeTo (probabilityAt (rowAt twoStateSquared i) j)+                | i <- finites :: [Finite 2]+                , j <- finites :: [Finite 2]+                ]++        prop "agrees with the corresponding power entry" $+            forAll (genTransitionRows 3) $ \matrix ->+                case fromRows @(Finite 3) matrix of+                    Right p ->+                        let fourStep = toRows (power 4 p)+                         in conjoin+                                [ property $+                                    approxEq+                                        testTolerance+                                        (nStepProbability 4 p i j)+                                        ( fourStep+                                            !! fromIntegral (getFinite i)+                                            !! fromIntegral (getFinite j)+                                        )+                                | i <- finites+                                , j <- finites+                                ]+                    Left err ->+                        counterexample+                            ("generated matrix was rejected: " <> show err)+                            False++        it "preserves named state types" $+            nStepProbability 2 namedCycle PhaseA PhaseC+                `shouldBe` 1++    describe "nStepProbability hand-computed regressions" $ do+        it "gives P^3(E, D) = 3/8 for the five-state chain" $+            nStepProbability 3 observationMatrix 4 3+                `shouldSatisfy` closeTo (3 / 8)++        it "matches the three-state P^n(2, 0) closed form" $+            mapM_+                ( \n ->+                    nStepProbability n closedFormTransition 2 0+                        `shouldSatisfy` closeTo+                            (closedFormProbability (fromIntegral n))+                )+                ([0, 1, 2, 3, 5, 10, 20] :: [Natural])++    describe "probability for state observations" $ do+        it "returns the initial probability at time zero" $+            conjoin+                [ probability initial chain [At 0 state]+                    === probabilityAt initial state+                | state <- finites+                ]++        prop "agrees with probabilityAt of evolveVectorN"+            $ forAll+                ( (,,)+                    <$> choose (0, 6 :: Int)+                    <*> genSimplexPoint 3+                    <*> genTransitionRows 3+                )+            $ \(k, entries, matrix) ->+                case ( Vector.fromList @(Finite 3) entries+                     , fromRows @(Finite 3) matrix+                     ) of+                    (Right mu, Right p) ->+                        conjoin+                            [ property $+                                approxEq+                                    testTolerance+                                    (probability mu p [At (fromIntegral k) state])+                                    (probabilityAt (evolveVectorN (fromIntegral k) mu p) state)+                            | state <- finites+                            ]+                    result ->+                        counterexample+                            ("generated input was rejected: " <> show result)+                            False++        prop "agrees with repeated evolveVector for small exponents"+            $ forAll+                ( (,,)+                    <$> choose (0, 6 :: Int)+                    <*> genSimplexPoint 3+                    <*> genTransitionRows 3+                )+            $ \(k, entries, matrix) ->+                case ( Vector.fromList @(Finite 3) entries+                     , fromRows @(Finite 3) matrix+                     ) of+                    (Right mu, Right p) ->+                        let iterated = iterate (`evolveVector` p) mu !! k+                         in conjoin+                                [ property $+                                    approxEq+                                        testTolerance+                                        (probability mu p [At (fromIntegral k) state])+                                        (probabilityAt iterated state)+                                | state <- finites+                                ]+                    result ->+                        counterexample+                            ("generated input was rejected: " <> show result)+                            False++    describe "Transition realization independence" $ do+        it "computes transition probabilities on an infinite state type" $ do+            nStepProbability 2 simpleRandomWalk 0 0+                `shouldSatisfy` closeTo 0.5+            nStepProbability 3 simpleRandomWalk 0 0+                `shouldBe` 0++        prop "gives matrices and equivalent kernels the same transition powers" $+            forAll (genTransitionRows 3) $ \rawMatrix ->+                case fromRows rawMatrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left problem -> counterexample (show problem) False+                    Right matrix ->+                        let kernel = asTransitionKernel matrix+                         in conjoin+                                [ property $+                                    closeTo+                                        (nStepProbability time matrix source destination)+                                        (nStepProbability time kernel source destination)+                                | source <- finites :: [Finite 3]+                                , destination <- finites :: [Finite 3]+                                , time <- [0 .. 4]+                                ]++        it "matches finite trajectory and observation queries" $ do+            probability mapInitial kernelChain [At 0 0, At 1 1, At 2 2]+                `shouldSatisfy` closeTo+                    (probability initial chain [At 0 0, At 1 1, At 2 2])+            probability+                mapInitial+                kernelChain+                [At 3 2, At 0 0, At 1 1]+                `shouldSatisfy` closeTo+                    (probability initial chain [At 3 2, At 0 0, At 1 1])++        it "matches finite conditional probability queries" $+            rightResultsClose+                (probabilityGiven mapInitial kernelChain [At 2 2] [At 0 0])+                (probabilityGiven initial chain [At 2 2] [At 0 0])+                `shouldBe` True++    describe "probability for consecutive observations" $ do+        it "returns the initial probability for a one-state path" $+            approxEq+                testTolerance+                (probability initial chain [At 0 0])+                (probabilityAt initial 0)+                `shouldBe` True++        it "is lambda_i * P(i, j) for a two-state path" $+            approxEq+                testTolerance+                (probability initial chain [At 0 0, At 1 1])+                (0.6 * 0.5)+                `shouldBe` True++        it "is the product of initial and transition probabilities" $+            approxEq+                testTolerance+                (probability initial chain [At 0 0, At 1 1, At 2 2])+                (0.6 * 0.5 * 0.8)+                `shouldBe` True++        it "is zero for a path with an impossible transition" $ do+            approxEq+                testTolerance+                (probability initial chain [At 0 0, At 1 2])+                0+                `shouldBe` True+            approxEq+                testTolerance+                (probability initial chain [At 0 0, At 1 1, At 2 0])+                0+                `shouldBe` True++        prop "a one-state path equals the initial probability" $+            forAll ((,) <$> genSimplexPoint 3 <*> genTransitionRows 3) $+                \(entries, matrix) ->+                    case ( Vector.fromList @(Finite 3) entries+                         , fromRows @(Finite 3) matrix+                         ) of+                        (Right mu, Right p) ->+                            conjoin+                                [ probability mu p [At 0 i]+                                    === probabilityAt mu i+                                | i <- [0, 1, 2]+                                ]+                        result ->+                            counterexample+                                ("generated input was rejected: " <> show result)+                                False++        prop "a two-state path equals lambda_i * P(i, j)" $+            forAll ((,) <$> genSimplexPoint 3 <*> genTransitionRows 3) $+                \(entries, matrix) ->+                    case ( Vector.fromList @(Finite 3) entries+                         , fromRows @(Finite 3) matrix+                         ) of+                        (Right mu, Right p) ->+                            conjoin+                                [ property $+                                    approxEq+                                        testTolerance+                                        (probability mu p [At 0 i, At 1 j])+                                        ( probabilityAt mu i+                                            * stepProbability p i j+                                        )+                                | i <- [0, 1, 2]+                                , j <- [0, 1, 2]+                                ]+                        result ->+                            counterexample+                                ("generated input was rejected: " <> show result)+                                False++    describe "probability" $ do+        it "returns exactly one for no observations" $+            probability initial chain [] `shouldBe` 1++        it "computes a single state observation" $+            approxEq+                testTolerance+                (probability initial chain [At 1 1])+                (probabilityAt (evolveVectorN 1 initial chain) 1)+                `shouldBe` True++        it "is unchanged by observation order" $+            approxEq+                testTolerance+                (probability initial chain [At 0 0, At 1 1])+                (probability initial chain [At 1 1, At 0 0])+                `shouldBe` True++        it "is unchanged by duplicate observations" $+            approxEq+                testTolerance+                (probability initial chain [At 0 0, At 0 0, At 1 1])+                (probability initial chain [At 0 0, At 1 1])+                `shouldBe` True++        it "is exactly zero for conflicting states at one time" $+            probability initial chain [At 0 0, At 0 1] `shouldBe` 0++        it "agrees with the explicit transition product over times 0, 1, 2" $+            approxEq+                testTolerance+                (probability initial chain [At 0 0, At 1 1, At 2 2])+                (0.6 * 0.5 * 0.8)+                `shouldBe` True++        it "is exactly zero through an impossible transition" $+            probability initial chain [At 0 0, At 1 2] `shouldBe` 0++        it "matches a hand-computed multi-gap example" $+            approxEq+                testTolerance+                ( probability+                    observationInitial+                    observationMatrix+                    [At 2 2, At 3 4, At 6 3]+                )+                (5 / 96)+                `shouldBe` True++        prop "a single observation equals direct evolution" $+            forAll ((,) <$> genSimplexPoint 3 <*> genTransitionRows 3) $+                \(entries, matrix) ->+                    case ( Vector.fromList @(Finite 3) entries+                         , fromRows @(Finite 3) matrix+                         ) of+                        (Right mu, Right p) ->+                            conjoin+                                [ property $+                                    approxEq+                                        testTolerance+                                        (probability mu p [At t i])+                                        (probabilityAt (evolveVectorN t mu p) i)+                                | t <- [0, 1, 2]+                                , i <- [0, 1, 2]+                                ]+                        result ->+                            counterexample+                                ("generated input was rejected: " <> show result)+                                False++        prop "is invariant under observation order" $+            forAll ((,) <$> genSimplexPoint 3 <*> genTransitionRows 3) $+                \(entries, matrix) ->+                    case ( Vector.fromList @(Finite 3) entries+                         , fromRows @(Finite 3) matrix+                         ) of+                        (Right mu, Right p) ->+                            property $+                                approxEq+                                    testTolerance+                                    (probability mu p [At 1 1, At 3 2])+                                    (probability mu p [At 3 2, At 1 1])+                        result ->+                            counterexample+                                ("generated input was rejected: " <> show result)+                                False++    describe "probabilityGiven" $ do+        it "returns the event probability for an empty condition" $+            probabilityGiven initial chain [At 1 1] []+                `shouldSatisfy` rightCloseTo+                    (probability initial chain [At 1 1])++        it "returns one for an empty event and a positive condition" $+            probabilityGiven initial chain [] [At 0 0]+                `shouldSatisfy` rightCloseTo 1++        it "returns one when conditioning an observation on itself" $+            probabilityGiven initial chain [At 1 1] [At 1 1]+                `shouldSatisfy` rightCloseTo 1++        it "ignores observations shared by event and condition" $+            probabilityGiven initial chain [At 1 1] [At 1 1, At 2 2]+                `shouldSatisfy` rightCloseTo 1++        it "returns zero for a conflict against a possible condition" $+            probabilityGiven initial chain [At 1 0] [At 1 1]+                `shouldSatisfy` rightCloseTo 0++        it "reports a zero-probability condition" $+            probabilityGiven initial chain [At 0 0] [At 0 0, At 1 2]+                `shouldBe` Left ZeroProbabilityCondition++        it "reports a contradictory condition" $+            probabilityGiven initial chain [At 0 0] [At 1 1, At 1 2]+                `shouldBe` Left ZeroProbabilityCondition++        it "is unaffected by event and condition ordering" $ do+            probabilityGiven initial chain [At 2 2, At 1 1] [At 0 0]+                `shouldSatisfy` rightCloseTo 0.4+            probabilityGiven initial chain [At 1 1, At 2 2] [At 0 0]+                `shouldSatisfy` rightCloseTo 0.4++    describe "probabilityGiven hand-computed regressions" $ do+        it "gives P(X10=D, X11=D | X3=A, X7=E) = 1/4" $+            probabilityGiven+                observationInitial+                observationMatrix+                [At 10 3, At 11 3]+                [At 3 0, At 7 4]+                `shouldSatisfy` rightCloseTo (1 / 4)++        it "accepts an out-of-order event and gives 15/92" $+            probabilityGiven+                observationInitial+                observationMatrix+                [At 6 3, At 2 2]+                [At 3 4]+                `shouldSatisfy` rightCloseTo (15 / 92)++        it "gives P(X2=C) = 5/36" $+            approxEq+                testTolerance+                (probability observationInitial observationMatrix [At 2 2])+                (5 / 36)+                `shouldBe` True++        it "gives P(X3=E) = 23/72" $+            approxEq+                testTolerance+                (probability observationInitial observationMatrix [At 3 4])+                (23 / 72)+                `shouldBe` True++        it "gives P(X2=C, X3=E, X6=D) = 5/96" $+            approxEq+                testTolerance+                ( probability+                    observationInitial+                    observationMatrix+                    [At 2 2, At 3 4, At 6 3]+                )+                (5 / 96)+                `shouldBe` True
+ test/Dtmc/Analysis/HittingTimeCanonicalSpec.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.Analysis.HittingTimeCanonicalSpec (+    spec,+) where++import Data.Finite (+    Finite,+    finites,+ )+import Data.Maybe (+    fromMaybe,+ )+import Dtmc.Analysis.Event (+    DiscreteEvent (..),+ )+import Dtmc.Analysis.Expectation (+    Expectation (..),+ )+import Dtmc.Analysis.HittingTime qualified as Hit+import Dtmc.Analysis.ProbabilityOracle qualified as Oracle+import Dtmc.Distribution.Map (+    fromList,+ )+import Dtmc.TestSupport+import Dtmc.Transition.Kernel (+    TransitionKernel,+    fromLaws,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    TransitionMatrixError,+    fromRows,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    counterexample,+    forAll,+    property,+ )++terminalChain :: TransitionMatrix (Finite 3)+terminalChain =+    checked+        ( fromRows+            ( chunksOf+                3+                [ 0+                , 0.5+                , 0.5+                , 0+                , 0+                , 1+                , 0+                , 0+                , 1+                ]+            )+        )++simpleRandomWalk :: TransitionKernel Integer+simpleRandomWalk =+    fromLaws $ \state ->+        checked+            (fromList [(state - 1, 0.5), (state + 1, 0.5)])++tinySurvival :: Double+tinySurvival = 1e-12++tinySurvivalKernel :: TransitionKernel Int+tinySurvivalKernel =+    fromLaws $ \state ->+        case state of+            0 ->+                checked+                    ( fromList+                        [(1, 1 - tinySurvival), (2, tinySurvival)]+                    )+            _ -> deterministicLaw state+  where+    deterministicLaw state =+        checked (fromList [(state, 1)])++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++close :: Double -> Double -> Bool+close = approxEq testTolerance++known :: Maybe Double -> Double+known = fromMaybe (error "oracle horizon does not determine this event")++eventsThrough :: Integer -> [DiscreteEvent]+eventsThrough rawHorizon =+    [EqualTo time | time <- [0 .. horizon]]+        <> [LessThan time | time <- [0 .. horizon + 1]]+        <> [AtMost time | time <- [0 .. horizon]]+        <> [GreaterThan time | time <- [0 .. horizon]]+        <> [AtLeast time | time <- [0 .. horizon + 1]]+  where+    horizon = fromInteger rawHorizon++generatedChecks :: TransitionMatrix (Finite 3) -> Bool+generatedChecks matrix =+    and+        [ let law = Oracle.hittingLaw 4 matrix isTarget initial+              oracle = known (Oracle.lawProbability event law)+              scalar = Hit.probabilityGivenInitialState event matrix isTarget initial+              dense = (hitProbabilityByState event matrix [2])+           in close scalar oracle+                && close (dense !! fromIntegral initial) oracle+        | initial <- finites+        , event <- eventsThrough 4+        ]+  where+    isTarget state = state == (2 :: Finite 3)++spec :: Spec+spec = do+    describe "canonical hitting probability" $ do+        it "implements every relation and carries the infinity atom in upper tails" $ do+            let target state = state == (1 :: Finite 3)+            Hit.probabilityGivenInitialState (EqualTo 0) terminalChain target 0 `shouldBe` 0+            Hit.probabilityGivenInitialState (EqualTo 1) terminalChain target 0 `shouldBe` 0.5+            Hit.probabilityGivenInitialState (LessThan 1) terminalChain target 0 `shouldBe` 0+            Hit.probabilityGivenInitialState (AtMost 1) terminalChain target 0 `shouldBe` 0.5+            Hit.probabilityGivenInitialState (GreaterThan 0) terminalChain target 0 `shouldBe` 1+            Hit.probabilityGivenInitialState (GreaterThan 1) terminalChain target 0 `shouldBe` 0.5+            Hit.probabilityGivenInitialState (AtLeast 0) terminalChain target 0 `shouldBe` 1+            Hit.probabilityGivenInitialState (AtLeast 1) terminalChain target 0 `shouldBe` 1+            Hit.probabilityGivenInitialState (AtLeast 2) terminalChain target 0 `shouldBe` 0.5+            (hitProbabilityByState (GreaterThan 1) terminalChain [1])+                `shouldBe` [0.5, 0, 1]+            (hitProbabilityByState (AtMost 1) terminalChain [1])+                `shouldBe` [0.5, 1, 0]++        it "keeps empty-target and time-zero boundaries structural" $ do+            (hitProbabilityByState (EqualTo 3) terminalChain [])+                `shouldBe` [0, 0, 0]+            (hitProbabilityByState (AtMost 3) terminalChain [])+                `shouldBe` [0, 0, 0]+            (hitProbabilityByState (GreaterThan 3) terminalChain [])+                `shouldBe` [1, 1, 1]+            (hitProbabilityByState (AtLeast 0) terminalChain [1])+                `shouldBe` [1, 1, 1]+            Hit.probabilityGivenInitialState (EqualTo 0) terminalChain (== 1) 1 `shouldBe` 1+            Hit.probabilityGivenInitialState (GreaterThan 0) terminalChain (== 1) 1 `shouldBe` 0++        it "preserves locally finite kernels and tiny survivor mass directly" $ do+            Hit.probabilityGivenInitialState (EqualTo 2) simpleRandomWalk (== 2) 0+                `shouldBe` 0.25+            Hit.probabilityGivenInitialState (AtMost 2) simpleRandomWalk (== 2) 0+                `shouldBe` 0.25+            Hit.probabilityGivenInitialState (GreaterThan 2) simpleRandomWalk (== 2) 0+                `shouldBe` 0.75+            Hit.probabilityGivenInitialState (AtLeast 3) simpleRandomWalk (== 2) 0+                `shouldBe` 0.75+            Hit.probabilityGivenInitialState (GreaterThan 1) tinySurvivalKernel (== 1) 0+                `shouldBe` tinySurvival++        prop "matches the path oracle for every relation (random @3)" $+            forAll (genTransitionRows 3) $ \rawMatrix ->+                case fromRows rawMatrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left problem -> counterexample (show problem) False+                    Right matrix -> property (generatedChecks matrix)++    describe "canonical eventual, race, and expectation names" $ do+        it "match the completed defective hitting law" $ do+            let states = finites :: [Finite 3]+            case hitEventualProbabilityByState terminalChain [1] of+                Left problem -> error (show problem)+                Right values -> values `shouldBe` [0.5, 1, 0]+            mapM_+                ( \(state, expected) ->+                    Hit.eventualProbabilityGivenInitialState terminalChain [1] state+                        `shouldBe` Right expected+                )+                (zip states [0.5, 1, 0])+            case hitRaceProbabilityByState terminalChain [1] [2] of+                Left problem -> error (show problem)+                Right values -> values `shouldBe` [0.5, 1, 0]+            mapM_+                ( \(state, expected) ->+                    Hit.raceProbabilityGivenInitialState terminalChain [1] [2] state+                        `shouldBe` Right expected+                )+                (zip states [0.5, 1, 0])+            hitExpectationByState terminalChain [1]+                `shouldBe` Right+                    [ InfiniteExpectation+                    , FiniteExpectation 0+                    , InfiniteExpectation+                    ]+            mapM_+                ( \(state, expected) ->+                    Hit.expectationGivenInitialState terminalChain [1] state+                        `shouldBe` Right expected+                )+                ( zip+                    states+                    [ InfiniteExpectation+                    , FiniteExpectation 0+                    , InfiniteExpectation+                    ]+                )
+ test/Dtmc/Analysis/HittingTimeSpec.hs view
@@ -0,0 +1,13 @@+module Dtmc.Analysis.HittingTimeSpec (+    spec,+) where++import Dtmc.Analysis.TimeSpecSupport (+    hittingTimeSpec,+ )+import Test.Hspec (+    Spec,+ )++spec :: Spec+spec = hittingTimeSpec
+ test/Dtmc/Analysis/LimitingSpec.hs view
@@ -0,0 +1,288 @@+{-# LANGUAGE DataKinds #-}++module Dtmc.Analysis.LimitingSpec (+    spec,+) where++import Data.Finite (+    Finite,+ )+import Dtmc.Analysis.Limiting (+    converges,+    cyclicLimits,+    limitingMatrix,+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.TestSupport (+    approxEq,+    chunksOf,+    testTolerance,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    fromRows,+    identity,+    power,+    toRows,+ )+import Numeric.Natural (+    Natural,+ )+import Test.Hspec (+    Spec,+    describe,+    expectationFailure,+    it,+    shouldBe,+    shouldSatisfy,+ )++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++-- Section 4.2: closed classes {0} and {1,2}, both aperiodic.+twoClosedClasses :: TransitionMatrix (Finite 3)+twoClosedClasses =+    checked+        ( fromRows+            (chunksOf 3 [1, 0, 0, 0, 0.4, 0.6, 0, 0.5, 0.5])+        )++-- State 0 is transient; {1,2} is the only recurrent class.+withTransient :: TransitionMatrix (Finite 3)+withTransient =+    checked+        ( fromRows+            (chunksOf 3 [0, 0.5, 0.5, 0, 0.4, 0.6, 0, 0.5, 0.5])+        )++-- States 0 and 1 are transient and can enter either absorbing class. This+-- exercises the multiple right-hand sides of the batched class-entry solve.+withTwoDestinations :: TransitionMatrix (Finite 4)+withTwoDestinations =+    checked+        ( fromRows+            ( chunksOf+                4+                [ 0+                , 1 / 2+                , 1 / 4+                , 1 / 4+                , 0+                , 1 / 5+                , 3 / 10+                , 1 / 2+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 1+                ]+            )+        )++-- Irreducible, aperiodic, stationary distribution (0.8, 0.2).+twoState :: TransitionMatrix (Finite 2)+twoState =+    checked+        ( fromRows+            (chunksOf 2 [0.9, 0.1, 0.4, 0.6])+        )++-- Irreducible with period 3, so P^n never settles.+threeCycle :: TransitionMatrix (Finite 3)+threeCycle =+    checked+        ( fromRows+            (chunksOf 3 [0, 1, 0, 0, 0, 1, 1, 0, 0])+        )++-- Reducible with disjoint recurrent cycles of periods 2 and 3.+mixedPeriods :: TransitionMatrix (Finite 5)+mixedPeriods =+    checked+        ( fromRows+            ( chunksOf+                5+                [ 0+                , 1+                , 0+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 0+                , 1+                , 0+                , 0+                , 1+                , 0+                , 0+                ]+            )+        )++-- State 0 is transient and enters the recurrent period-2 class {1,2}.+withTransientCycle :: TransitionMatrix (Finite 3)+withTransientCycle =+    checked+        ( fromRows+            (chunksOf 3 [0, 1, 0, 0, 0, 1, 0, 1, 0])+        )++-- An irreducible period-2 chain whose two cyclic phases have different+-- cardinalities and whose non-singleton phase is non-uniform.+unequalPhases :: TransitionMatrix (Finite 3)+unequalPhases =+    checked+        ( fromRows+            (chunksOf 3 [0, 1 / 4, 3 / 4, 1, 0, 0, 1, 0, 0])+        )++powerRows :: (FiniteState state) => Natural -> TransitionMatrix state -> [[Double]]+powerRows steps p =+    toRows (power steps p)++matrixCloseTo :: [[Double]] -> [[Double]] -> Bool+matrixCloseTo expected actual =+    length expected == length actual+        && and (zipWith rowCloseTo expected actual)+  where+    rowCloseTo e a =+        length e == length a && and (zipWith (approxEq testTolerance) e a)++spec :: Spec+spec = do+    describe "converges" $ do+        it "accepts an aperiodic irreducible chain" $+            converges twoState `shouldBe` True++        it "accepts several aperiodic recurrent classes" $+            converges twoClosedClasses `shouldBe` True++        it "rejects a periodic class" $+            converges threeCycle `shouldBe` False++    describe "limitingMatrix" $ do+        it "matches the closed form of the notes" $+            case limitingMatrix twoClosedClasses of+                Right (Just rows) ->+                    rows+                        `shouldSatisfy` matrixCloseTo+                            [ [1, 0, 0]+                            , [0, 5 / 11, 6 / 11]+                            , [0, 5 / 11, 6 / 11]+                            ]+                other -> expectationFailure ("unexpected result: " ++ show other)++        it "repeats the stationary distribution in every row of an ergodic chain" $+            case limitingMatrix twoState of+                Right (Just rows) ->+                    rows `shouldSatisfy` matrixCloseTo [[0.8, 0.2], [0.8, 0.2]]+                other -> expectationFailure ("unexpected result: " ++ show other)++        it "is exactly zero on a transient column" $+            case limitingMatrix withTransient of+                Right (Just rows) -> do+                    map (take 1) rows `shouldBe` [[0], [0], [0]]+                    rows+                        `shouldSatisfy` matrixCloseTo+                            [ [0, 5 / 11, 6 / 11]+                            , [0, 5 / 11, 6 / 11]+                            , [0, 5 / 11, 6 / 11]+                            ]+                other -> expectationFailure ("unexpected result: " ++ show other)++        it "batches entry probabilities for several recurrent classes" $+            case limitingMatrix withTwoDestinations of+                Right (Just rows) ->+                    rows+                        `shouldSatisfy` matrixCloseTo+                            [ [0, 0, 7 / 16, 9 / 16]+                            , [0, 0, 3 / 8, 5 / 8]+                            , [0, 0, 1, 0]+                            , [0, 0, 0, 1]+                            ]+                other -> expectationFailure ("unexpected result: " ++ show other)++        it "reports that a periodic chain has no limit" $+            limitingMatrix threeCycle `shouldBe` Right Nothing++        it "agrees with a high matrix power" $ do+            -- An independent route: repeated squaring rather than the+            -- hitting/stationary decomposition.+            case limitingMatrix twoState of+                Right (Just rows) ->+                    rows `shouldSatisfy` matrixCloseTo (powerRows 256 twoState)+                other -> expectationFailure ("unexpected result: " ++ show other)+            case limitingMatrix twoClosedClasses of+                Right (Just rows) ->+                    rows `shouldSatisfy` matrixCloseTo (powerRows 256 twoClosedClasses)+                other -> expectationFailure ("unexpected result: " ++ show other)++    describe "cyclicLimits" $ do+        it "returns one limit per period and reproduces the powers" $+            case cyclicLimits threeCycle of+                Right [atZero, atOne, atTwo] -> do+                    atZero `shouldSatisfy` matrixCloseTo (powerRows 3 threeCycle)+                    atOne `shouldSatisfy` matrixCloseTo (powerRows 4 threeCycle)+                    atTwo `shouldSatisfy` matrixCloseTo (powerRows 5 threeCycle)+                other -> expectationFailure ("expected three limits: " ++ show other)++        it "collapses to the ordinary limit when aperiodic" $+            case (cyclicLimits twoState, limitingMatrix twoState) of+                (Right [only], Right (Just rows)) ->+                    only `shouldSatisfy` matrixCloseTo rows+                other -> expectationFailure ("unexpected result: " ++ show other)++        it "collapses to the ordinary limit for a reducible aperiodic chain" $+            case (cyclicLimits twoClosedClasses, limitingMatrix twoClosedClasses) of+                (Right [only], Right (Just rows)) ->+                    only `shouldSatisfy` matrixCloseTo rows+                other -> expectationFailure ("unexpected result: " ++ show other)++        it "uses the least common multiple of recurrent class periods" $+            case cyclicLimits mixedPeriods of+                Right limits -> do+                    length limits `shouldBe` 6+                    and+                        ( zipWith+                            matrixCloseTo+                            [powerRows r mixedPeriods | r <- [0 .. 5]]+                            limits+                        )+                        `shouldBe` True+                other -> expectationFailure ("unexpected result: " ++ show other)++        it "accounts for the entry phase of transient states" $+            case cyclicLimits withTransientCycle of+                Right [atZero, atOne] -> do+                    atZero `shouldSatisfy` matrixCloseTo (powerRows 100 withTransientCycle)+                    atOne `shouldSatisfy` matrixCloseTo (powerRows 101 withTransientCycle)+                other -> expectationFailure ("expected two limits: " ++ show other)++        it "rotates non-uniform phase distributions" $+            case cyclicLimits unequalPhases of+                Right [atZero, atOne] -> do+                    atZero `shouldSatisfy` matrixCloseTo (powerRows 100 unequalPhases)+                    atOne `shouldSatisfy` matrixCloseTo (powerRows 101 unequalPhases)+                other -> expectationFailure ("expected two limits: " ++ show other)++        it "returns one empty limit for the empty chain" $+            cyclicLimits (identity @(Finite 0)) `shouldBe` Right [[]]
+ test/Dtmc/Analysis/NamespaceCompileSpec.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE DataKinds #-}++module Dtmc.Analysis.NamespaceCompileSpec (+    spec,+) where++import Data.Finite (+    Finite,+ )+import Dtmc.Analysis.Absorption qualified as Absorption+import Dtmc.Analysis.Event (+    DiscreteEvent (..),+    matches,+ )+import Dtmc.Analysis.Expectation (+    Expectation (..),+ )+import Dtmc.Analysis.FiniteTime qualified as FT+import Dtmc.Analysis.HittingTime qualified as Hit+import Dtmc.Analysis.ReturnTime qualified as Return+import Dtmc.Analysis.VisitCount qualified as Visit+import Dtmc.Distribution.Vector (+    DistributionVector,+ )+import Dtmc.Distribution.Vector qualified as Vector+import Dtmc.TestSupport (+    chunksOf,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    fromRows,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+ )++matrix :: TransitionMatrix (Finite 2)+matrix =+    checked+        ( fromRows+            (chunksOf 2 [0.5, 0.5, 0, 1])+        )++initial :: DistributionVector (Finite 2)+initial =+    checked+        (Vector.fromList [1, 0])++mixedInitial :: DistributionVector (Finite 2)+mixedInitial =+    checked+        (Vector.fromList [0.25, 0.75])++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++spec :: Spec+spec = do+    describe "qualified analysis namespaces" $ do+        it "coexist under the documented aliases" $ do+            FT.stepProbability matrix 0 1 `shouldBe` 0.5+            FT.nStepProbability 2 matrix 0 1 `shouldBe` 0.75+            FT.probability initial matrix [FT.At 1 1] `shouldBe` 0.5+            FT.probability initial matrix [FT.At 0 0, FT.At 1 1]+                `shouldBe` 0.5+            FT.probabilityGiven+                initial+                matrix+                [FT.At 1 1]+                [FT.At 0 0]+                `shouldBe` Right 0.5+            Hit.probability (EqualTo 1) matrix (== 1) initial `shouldBe` 0.5+            length+                [ Hit.probabilityGivenInitialState (AtMost 1) matrix (== 1) 0 `seq` ()+                , Hit.probability (AtMost 1) matrix (== 1) initial `seq` ()+                , Hit.eventualProbabilityGivenInitialState matrix [1] 0 `seq` ()+                , Hit.eventualProbability matrix [1] initial `seq` ()+                , Hit.raceProbabilityGivenInitialState matrix [1] [] 0 `seq` ()+                , Hit.raceProbability matrix [1] [] initial `seq` ()+                , Hit.expectationGivenInitialState matrix [1] 0 `seq` ()+                , Hit.expectation matrix [1] initial `seq` ()+                ]+                `shouldBe` 8+            Return.probability (EqualTo 1) matrix initial `shouldBe` 0.5+            length+                [ Return.probabilityGivenInitialState (AtMost 1) matrix 0 `seq` ()+                , Return.probability (AtMost 1) matrix initial `seq` ()+                , Return.eventualProbabilityGivenInitialState matrix 0 `seq` ()+                , Return.eventualProbability matrix initial `seq` ()+                , Return.expectationGivenInitialState matrix 0 `seq` ()+                , Return.expectation matrix initial `seq` ()+                ]+                `shouldBe` 6+            Visit.boundedProbability 2 (EqualTo 1) initial matrix (== 1)+                `shouldBe` 0.5+            length+                [ Visit.totalProbabilityGivenInitialState (EqualTo 1) matrix 1 0 `seq` ()+                , Visit.totalProbability (AtMost 1) matrix 1 initial `seq` ()+                , Visit.infiniteProbabilityGivenInitialState matrix 1 0 `seq` ()+                , Visit.infiniteProbability matrix 1 initial `seq` ()+                , Visit.totalExpectationGivenInitialState matrix 1 0 `seq` ()+                , Visit.totalExpectation matrix 1 initial `seq` ()+                , Visit.boundedLaw 2 initial matrix (== 1) `seq` ()+                , Visit.boundedProbability 2 (AtMost 1) initial matrix (== 1) `seq` ()+                , Visit.boundedProbabilityGivenInitialState 2 (AtMost 1) 0 matrix (== 1) `seq` ()+                , Visit.boundedExpectation 2 initial matrix (== 1) `seq` ()+                , Visit.boundedExpectationGivenInitialState 2 0 matrix (== 1) `seq` ()+                ]+                `shouldBe` 11+            matches (AtMost 1) 1 `shouldBe` True++        it "distinguishes distribution and initial-state forms" $ do+            Hit.probability (EqualTo 1) matrix (== 1) mixedInitial+                `shouldBe` 0.125+            Hit.probabilityGivenInitialState (EqualTo 1) matrix (== 1) 0+                `shouldBe` 0.5+            Hit.expectation matrix [1] mixedInitial+                `shouldBe` Right (FiniteExpectation 0.5)+            Return.probability (EqualTo 1) matrix mixedInitial+                `shouldBe` 0.875+            Return.eventualProbability matrix mixedInitial+                `shouldBe` Right 0.875+            Return.expectation matrix mixedInitial+                `shouldBe` Right InfiniteExpectation+            Visit.totalProbability (EqualTo 0) matrix 0 mixedInitial+                `shouldBe` Right 0.75+            Visit.totalExpectation matrix 0 mixedInitial+                `shouldBe` Right (FiniteExpectation 0.5)+            Absorption.probability matrix 1 mixedInitial+                `shouldBe` Right 1+            Absorption.expectation matrix mixedInitial+                `shouldBe` Right (FiniteExpectation 0.5)
+ test/Dtmc/Analysis/ProbabilityOracle.hs view
@@ -0,0 +1,261 @@+module Dtmc.Analysis.ProbabilityOracle (+    TruncatedLaw,+    transitionWeight,+    trajectoryProbability,+    stateProbability,+    observationProbability,+    hittingLaw,+    returnLaw,+    visitLawBefore,+    raceProbabilityWithin,+    lawProbability,+    lawUnresolvedMass,+    lawFiniteExpectation,+) where++import Data.Finite (+    getFinite,+ )+import Data.List (+    findIndex,+ )+import Data.Map.Strict (+    Map,+ )+import Data.Map.Strict qualified as Map+import Dtmc.Analysis.Event (+    DiscreteEvent (..),+    includesInfiniteOutcome,+    matches,+ )+import Dtmc.State (+    FiniteState,+    finiteStates,+    stateIndex,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    toRows,+ )+import Numeric.Natural (+    Natural,+ )++data WeightedPath state = WeightedPath [state] Double++{- | A finite prefix of a discrete law. 'lawUnresolvedMass' is the probability+whose event time is strictly beyond the stored horizon, including any atom at+infinity. This test-only type deliberately does not appear in the library API.+-}+data TruncatedLaw = TruncatedLaw+    { lawHorizon :: Natural+    , lawFiniteMasses :: Map Natural Double+    , lawUnresolvedMass :: Double+    }++toIndex :: (FiniteState state) => state -> Int+toIndex = fromIntegral . getFinite . stateIndex++transitionWeight ::+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    state ->+    Double+transitionWeight matrix source destination =+    toRows matrix !! toIndex source !! toIndex destination++iterateNatural :: Natural -> (value -> value) -> value -> value+iterateNatural steps advance = go steps+  where+    go 0 value = value+    go remaining value = go (remaining - 1) (advance value)++weightedTrajectories ::+    (FiniteState state) =>+    Natural ->+    [(state, Double)] ->+    TransitionMatrix state ->+    [WeightedPath state]+weightedTrajectories steps initial matrix =+    iterateNatural steps advance initialPaths+  where+    initialPaths =+        [ WeightedPath [state] weight+        | (state, weight) <- initial+        , weight /= 0+        ]+    advance paths = paths >>= extend+    extend (WeightedPath path weight) =+        [ WeightedPath (path <> [destination]) (weight * probability)+        | destination <- finiteStates+        , let probability = transitionWeight matrix (last path) destination+        , probability /= 0+        ]++trajectoryProbability ::+    (FiniteState state) =>+    [(state, Double)] ->+    TransitionMatrix state ->+    [state] ->+    Double+trajectoryProbability _ _ [] = 0+trajectoryProbability initial matrix (first : rest) =+    initialMass first * go first rest+  where+    initialMass state =+        sum [weight | (candidate, weight) <- initial, candidate == state]+    go _ [] = 1+    go previous (next : more) =+        transitionWeight matrix previous next * go next more++stateProbability ::+    (FiniteState state) =>+    Natural ->+    [(state, Double)] ->+    TransitionMatrix state ->+    state ->+    Double+stateProbability time initial matrix destination =+    sum+        [ weight+        | WeightedPath path weight <- weightedTrajectories time initial matrix+        , last path == destination+        ]++observationProbability ::+    (FiniteState state) =>+    Natural ->+    [(state, Double)] ->+    TransitionMatrix state ->+    [(Natural, state)] ->+    Double+observationProbability horizon initial matrix observations =+    sum+        [ weight+        | WeightedPath path weight <- weightedTrajectories horizon initial matrix+        , all (matchesAt path) observations+        ]+  where+    matchesAt path (time, expected) =+        path !! fromIntegral time == expected++lawFromFirstOccurrence ::+    Natural ->+    [WeightedPath state] ->+    ([state] -> Maybe Natural) ->+    TruncatedLaw+lawFromFirstOccurrence horizon paths occurrence =+    TruncatedLaw horizon masses unresolved+  where+    (masses, unresolved) = foldr addPath (Map.empty, 0) paths+    addPath (WeightedPath path weight) (known, unknown) =+        case occurrence path of+            Nothing -> (known, unknown + weight)+            Just time -> (Map.insertWith (+) time weight known, unknown)++hittingLaw ::+    (FiniteState state) =>+    Natural ->+    TransitionMatrix state ->+    (state -> Bool) ->+    state ->+    TruncatedLaw+hittingLaw horizon matrix isTarget initial =+    lawFromFirstOccurrence horizon paths firstHit+  where+    paths = weightedTrajectories horizon [(initial, 1)] matrix+    firstHit path = fromIntegral <$> findIndex isTarget path++returnLaw ::+    (FiniteState state) =>+    Natural ->+    TransitionMatrix state ->+    state ->+    TruncatedLaw+returnLaw horizon matrix initial =+    lawFromFirstOccurrence horizon paths firstReturn+  where+    paths = weightedTrajectories horizon [(initial, 1)] matrix+    firstReturn path =+        fromIntegral . (+ 1) <$> findIndex (== initial) (drop 1 path)++visitLawBefore ::+    (FiniteState state) =>+    Natural ->+    [(state, Double)] ->+    TransitionMatrix state ->+    (state -> Bool) ->+    TruncatedLaw+visitLawBefore bound initial matrix isVisited =+    TruncatedLaw bound masses 0+  where+    steps+        | bound == 0 = 0+        | otherwise = bound - 1+    paths = weightedTrajectories steps initial matrix+    count path =+        fromIntegral (length (filter isVisited (take (fromIntegral bound) path)))+    masses =+        Map.fromListWith+            (+)+            [(count path, weight) | WeightedPath path weight <- paths]++raceProbabilityWithin ::+    (FiniteState state) =>+    Natural ->+    TransitionMatrix state ->+    (state -> Bool) ->+    (state -> Bool) ->+    state ->+    Double+raceProbabilityWithin horizon matrix isSuccessful isCompeting initial =+    sum+        [ weight+        | WeightedPath path weight <-+            weightedTrajectories horizon [(initial, 1)] matrix+        , wins path+        ]+  where+    wins path =+        case (findIndex isSuccessful path, findIndex isCompeting path) of+            (Just successfulTime, Just competingTime) ->+                successfulTime < competingTime+            (Just _, Nothing) -> True+            _ -> False++lawProbability :: DiscreteEvent -> TruncatedLaw -> Maybe Double+lawProbability event law+    | eventKnown event (lawHorizon law) =+        Just (finiteMass + unresolvedContribution)+    | otherwise = Nothing+  where+    finiteMass =+        sum+            [ mass+            | (value, mass) <- Map.toList (lawFiniteMasses law)+            , matches event value+            ]+    unresolvedContribution+        | includesInfiniteOutcome event = lawUnresolvedMass law+        | otherwise = 0++eventKnown :: DiscreteEvent -> Natural -> Bool+eventKnown event horizon =+    case event of+        EqualTo threshold -> threshold <= horizon+        LessThan threshold -> threshold <= horizon + 1+        AtMost threshold -> threshold <= horizon+        GreaterThan threshold -> threshold <= horizon+        AtLeast threshold -> threshold <= horizon + 1++lawFiniteExpectation :: TruncatedLaw -> Maybe Double+lawFiniteExpectation law+    | lawUnresolvedMass law == 0 =+        Just+            ( sum+                [ fromIntegral value * mass+                | (value, mass) <- Map.toList (lawFiniteMasses law)+                ]+            )+    | otherwise = Nothing
+ test/Dtmc/Analysis/ReturnTimeCanonicalSpec.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.Analysis.ReturnTimeCanonicalSpec (+    spec,+) where++import Data.Finite (+    Finite,+    finites,+ )+import Data.Maybe (+    fromMaybe,+ )+import Dtmc.Analysis.Event (+    DiscreteEvent (..),+ )+import Dtmc.Analysis.Expectation (+    Expectation (..),+ )+import Dtmc.Analysis.ProbabilityOracle qualified as Oracle+import Dtmc.Analysis.ReturnTime qualified as Return+import Dtmc.Distribution.Map (+    fromList,+ )+import Dtmc.TestSupport+import Dtmc.Transition.Kernel (+    TransitionKernel,+    fromLaws,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    TransitionMatrixError,+    fromRows,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    counterexample,+    forAll,+    property,+ )++terminalChain :: TransitionMatrix (Finite 3)+terminalChain =+    checked+        ( fromRows+            ( chunksOf+                3+                [ 0+                , 0.5+                , 0.5+                , 0+                , 0+                , 1+                , 0+                , 0+                , 1+                ]+            )+        )++simpleRandomWalk :: TransitionKernel Integer+simpleRandomWalk =+    fromLaws $ \state ->+        checked+            (fromList [(state - 1, 0.5), (state + 1, 0.5)])++tinySurvival :: Double+tinySurvival = 1e-12++tinyReturnKernel :: TransitionKernel Int+tinyReturnKernel =+    fromLaws $ \state ->+        case state of+            0 ->+                checked+                    ( fromList+                        [(0, 1 - tinySurvival), (1, tinySurvival)]+                    )+            _ -> checked (fromList [(state, 1)])++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++close :: Double -> Double -> Bool+close = approxEq testTolerance++known :: Maybe Double -> Double+known = fromMaybe (error "oracle horizon does not determine this event")++eventsThrough :: Integer -> [DiscreteEvent]+eventsThrough rawHorizon =+    [EqualTo time | time <- [0 .. horizon]]+        <> [LessThan time | time <- [0 .. horizon + 1]]+        <> [AtMost time | time <- [0 .. horizon]]+        <> [GreaterThan time | time <- [0 .. horizon]]+        <> [AtLeast time | time <- [0 .. horizon + 1]]+  where+    horizon = fromInteger rawHorizon++generatedChecks :: TransitionMatrix (Finite 3) -> Bool+generatedChecks matrix =+    and+        [ let law = Oracle.returnLaw 4 matrix initial+              oracle = known (Oracle.lawProbability event law)+              scalar = Return.probabilityGivenInitialState event matrix initial+              dense = (returnProbabilityByState event matrix)+           in close scalar oracle+                && close (dense !! fromIntegral initial) oracle+        | initial <- finites+        , event <- eventsThrough 4+        ]++spec :: Spec+spec = do+    describe "canonical return probability" $ do+        it "enforces the time-zero exclusion exactly" $ do+            (returnProbabilityByState (EqualTo 0) terminalChain)+                `shouldBe` [0, 0, 0]+            (returnProbabilityByState (LessThan 1) terminalChain)+                `shouldBe` [0, 0, 0]+            (returnProbabilityByState (AtMost 0) terminalChain)+                `shouldBe` [0, 0, 0]+            (returnProbabilityByState (GreaterThan 0) terminalChain)+                `shouldBe` [1, 1, 1]+            (returnProbabilityByState (AtLeast 0) terminalChain)+                `shouldBe` [1, 1, 1]+            (returnProbabilityByState (AtLeast 1) terminalChain)+                `shouldBe` [1, 1, 1]++        it "implements every relation and carries non-return mass in upper tails" $ do+            Return.probabilityGivenInitialState (EqualTo 1) terminalChain 2 `shouldBe` 1+            Return.probabilityGivenInitialState (AtMost 1) terminalChain 2 `shouldBe` 1+            Return.probabilityGivenInitialState (GreaterThan 1) terminalChain 2 `shouldBe` 0+            (returnProbabilityByState (AtMost 1) terminalChain)+                `shouldBe` [0, 0, 1]+            (returnProbabilityByState (GreaterThan 1) terminalChain)+                `shouldBe` [1, 1, 0]+            (returnProbabilityByState (AtLeast 2) terminalChain)+                `shouldBe` [1, 1, 0]++        it "preserves locally finite kernels and tiny survivor mass directly" $ do+            Return.probabilityGivenInitialState (EqualTo 2) simpleRandomWalk 0 `shouldBe` 0.5+            Return.probabilityGivenInitialState (AtMost 2) simpleRandomWalk 0 `shouldBe` 0.5+            Return.probabilityGivenInitialState (GreaterThan 2) simpleRandomWalk 0 `shouldBe` 0.5+            Return.probabilityGivenInitialState (AtLeast 3) simpleRandomWalk 0 `shouldBe` 0.5+            Return.probabilityGivenInitialState (GreaterThan 1) tinyReturnKernel 0+                `shouldBe` tinySurvival++        prop "matches the path oracle for every relation (random @3)" $+            forAll (genTransitionRows 3) $ \rawMatrix ->+                case fromRows rawMatrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left problem -> counterexample (show problem) False+                    Right matrix -> property (generatedChecks matrix)++    describe "canonical eventual and expectation names" $ do+        it "match the completed defective return laws" $ do+            let states = finites :: [Finite 3]+            case returnEventualProbabilityByState terminalChain of+                Left problem -> error (show problem)+                Right values -> values `shouldBe` [0, 0, 1]+            mapM_+                ( \(state, expected) ->+                    Return.eventualProbabilityGivenInitialState terminalChain state+                        `shouldBe` Right expected+                )+                (zip states [0, 0, 1])+            returnExpectationByState terminalChain+                `shouldBe` Right+                    [ InfiniteExpectation+                    , InfiniteExpectation+                    , FiniteExpectation 1+                    ]+            mapM_+                ( \(state, expected) ->+                    Return.expectationGivenInitialState terminalChain state+                        `shouldBe` Right expected+                )+                ( zip+                    states+                    [ InfiniteExpectation+                    , InfiniteExpectation+                    , FiniteExpectation 1+                    ]+                )
+ test/Dtmc/Analysis/ReturnTimeSpec.hs view
@@ -0,0 +1,13 @@+module Dtmc.Analysis.ReturnTimeSpec (+    spec,+) where++import Dtmc.Analysis.TimeSpecSupport (+    returnTimeSpec,+ )+import Test.Hspec (+    Spec,+ )++spec :: Spec+spec = returnTimeSpec
+ test/Dtmc/Analysis/StationarySpec.hs view
@@ -0,0 +1,328 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.Analysis.StationarySpec (+    spec,+) where++import Data.Finite (+    Finite,+ )+import Dtmc.Analysis.Expectation (+    Expectation (..),+ )+import Dtmc.Analysis.ReturnTime qualified as Return+import Dtmc.Analysis.Stationary (+    stationaryDistributions,+ )+import Dtmc.Distribution (+    probabilityAt,+ )+import Dtmc.Distribution.Vector qualified as Vector+import Dtmc.Dynamics (+    evolveVector,+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.TestSupport (+    approxDistributionEq,+    approxEq,+    chunksOf,+    genTransitionRows,+    testTolerance,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    fromRows,+ )+import GHC.Generics (+    Generic,+ )+import Test.Hspec (+    Spec,+    describe,+    expectationFailure,+    it,+    shouldBe,+    shouldSatisfy,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    Gen,+    Property,+    choose,+    conjoin,+    counterexample,+    forAll,+    property,+    vectorOf,+ )++data Weather = Dry | Wet+    deriving (Eq, Ord, Show, Generic)++instance FiniteState Weather++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++onlyStationary ::+    (FiniteState state) =>+    TransitionMatrix state ->+    Vector.DistributionVector state+onlyStationary matrix =+    case checked (stationaryDistributions matrix) of+        [(_, distribution)] -> distribution+        _ -> error "test matrix does not have a unique stationary distribution"++twoState :: TransitionMatrix (Finite 2)+twoState =+    checked+        ( fromRows+            (chunksOf 2 [0.9, 0.1, 0.4, 0.6])+        )++singleton :: TransitionMatrix (Finite 1)+singleton =+    checked+        ( fromRows+            (chunksOf 1 [1])+        )++threeCycle :: TransitionMatrix (Finite 3)+threeCycle =+    checked+        ( fromRows+            (chunksOf 3 [0, 1, 0, 0, 0, 1, 1, 0, 0])+        )++namedTwoState :: TransitionMatrix Weather+namedTwoState =+    checked+        ( fromRows+            (chunksOf 2 [0.9, 0.1, 0.4, 0.6])+        )++genPositiveTransitionMatrix :: Gen [[Double]]+genPositiveTransitionMatrix = vectorOf 3 positiveSimplex+  where+    positiveSimplex = do+        weights <- vectorOf 3 (choose (1, 1000 :: Double))+        let total = sum weights+        pure (map (/ total) weights)++stationaryLawsHold :: [[Double]] -> Property+stationaryLawsHold raw =+    case fromRows @(Finite 3) raw of+        Left err -> counterexample (show err) (property False)+        Right matrix ->+            case stationaryDistributions matrix of+                Left err -> counterexample (show err) (property False)+                Right [(_, distribution)] ->+                    conjoin+                        [ counterexample "pi P /= pi" $+                            property+                                ( approxDistributionEq+                                    testTolerance+                                    (evolveVector distribution matrix)+                                    distribution+                                )+                        , counterexample "sum pi /= 1" $+                            property+                                (approxEq testTolerance (sum (Vector.toList distribution)) 1)+                        ]+                Right _ -> counterexample "positive matrix was not uniquely stationary" (property False)++spec :: Spec+spec = do+    describe "stationaryDistributions" $ do+        it "returns the point mass for a singleton chain" $+            Vector.toList (onlyStationary singleton)+                `shouldBe` [1]++        it "matches the closed form for a two-state chain" $+            and+                ( zipWith+                    (approxEq testTolerance)+                    (Vector.toList (onlyStationary twoState))+                    [0.8, 0.2]+                )+                `shouldBe` True++        it "is uniform for a periodic three-cycle" $+            and+                [ approxEq testTolerance actual (1 / 3)+                | actual <- Vector.toList (onlyStationary threeCycle)+                ]+                `shouldBe` True++        it "preserves named-state coordinates" $ do+            let distribution =+                    onlyStationary namedTwoState+            approxEq testTolerance (probabilityAt distribution Dry) 0.8+                `shouldBe` True+            approxEq testTolerance (probabilityAt distribution Wet) 0.2+                `shouldBe` True++        prop "satisfies the balance and normalization equations" $+            forAll genPositiveTransitionMatrix stationaryLawsHold++        it "solves a symmetric nearly uncoupled chain exactly" $ do+            -- The balance system is hopelessly ill conditioned here, but GTH+            -- never forms it: the exit mass is accumulated rather than taken+            -- as 1 - P(k,k), so the answer comes out bit-exact.+            let epsilon = 1e-14+                matrix =+                    checked+                        ( fromRows @(Finite 2)+                            ( chunksOf+                                2+                                [ 1 - epsilon+                                , epsilon+                                , epsilon+                                , 1 - epsilon+                                ]+                            )+                        )+            Vector.toList (onlyStationary matrix)+                `shouldBe` [0.5, 0.5]++        it "solves an asymmetric nearly uncoupled chain" $ do+            -- For [[1-a, a], [b, 1-b]] the stationary law is+            -- (b, a) / (a + b), here (3/4, 1/4) at a scale where forming+            -- transpose(P) - I would destroy every significant digit.+            let leaving = 1e-14+                returning = 3e-14+                matrix =+                    checked+                        ( fromRows @(Finite 2)+                            ( chunksOf+                                2+                                [ 1 - leaving+                                , leaving+                                , returning+                                , 1 - returning+                                ]+                            )+                        )+            Vector.toList (onlyStationary matrix)+                `shouldSatisfy` allCloseTo [0.75, 0.25]++        it "normalises extreme finite GTH weights without overflow" $ do+            let epsilon = 5e-309+                matrix =+                    checked+                        ( fromRows @(Finite 3)+                            ( chunksOf+                                3+                                [ 0+                                , 0.5+                                , 0.5+                                , epsilon+                                , 0+                                , 1+                                , epsilon+                                , 1+                                , 0+                                ]+                            )+                        )+                weights = Vector.toList (onlyStationary matrix)+            weights `shouldSatisfy` all isFinite+            sum weights `shouldSatisfy` approxEq testTolerance 1+            weights `shouldSatisfy` allCloseTo [0, 0.5, 0.5]+            case weights of+                first : _ -> first `shouldSatisfy` (> 0)+                [] -> expectationFailure "expected three stationary weights"++    describe "multiple recurrent classes" $ do+        it "returns one distribution per recurrent class, by least member" $+            fmap (map fst) (stationaryDistributions twoClosedClasses)+                `shouldBe` Right [[0], [1, 2]]++        it "matches the closed form of the notes" $+            case stationaryDistributions twoClosedClasses of+                Right [(_, onFirst), (_, onSecond)] -> do+                    Vector.toList onFirst `shouldSatisfy` allCloseTo [1, 0, 0]+                    Vector.toList onSecond `shouldSatisfy` allCloseTo [0, 5 / 11, 6 / 11]+                other -> expectationFailure ("unexpected result: " ++ show other)++        it "puts exact zero on a transient state" $+            case stationaryDistributions withTransient of+                Right [(members, only)] -> do+                    members `shouldBe` [1, 2]+                    take 1 (Vector.toList only) `shouldBe` [0]+                    Vector.toList only `shouldSatisfy` allCloseTo [0, 5 / 11, 6 / 11]+                other -> expectationFailure ("unexpected result: " ++ show other)++        it "returns one distribution for an irreducible chain" $+            case stationaryDistributions twoState of+                Right [(_, only)] ->+                    Vector.toList only `shouldSatisfy` allCloseTo [0.8, 0.2]+                other -> expectationFailure ("unexpected result: " ++ show other)++        it "inverts the mean return time" $+            -- pi_i m_i = 1 for state 1 of the recurrent class {1, 2}+            case stationaryDistributions twoClosedClasses of+                Right [_, (_, onSecond)] ->+                    Return.expectationGivenInitialState twoClosedClasses 1+                        `shouldSatisfy` inverts (Vector.toList onSecond !! 1)+                other -> expectationFailure ("unexpected result: " ++ show other)++        prop "every returned distribution is stationary and normalised" $+            forAll (genTransitionRows 3) $ \raw ->+                case fromRows @(Finite 3) raw of+                    Left err -> counterexample (show err) (property False)+                    Right matrix ->+                        case stationaryDistributions matrix of+                            -- A refused solve is a documented outcome.+                            Left _ -> property True+                            Right results ->+                                conjoin+                                    [ conjoin+                                        [ counterexample "pi P /= pi" $+                                            property+                                                ( approxDistributionEq+                                                    testTolerance+                                                    (evolveVector d matrix)+                                                    d+                                                )+                                        , counterexample "sum pi /= 1" $+                                            property+                                                (approxEq testTolerance (sum (Vector.toList d)) 1)+                                        ]+                                    | (_, d) <- results+                                    ]++-- Section 4.1: two closed classes, hence infinitely many stationary+-- distributions for the chain as a whole.+twoClosedClasses :: TransitionMatrix (Finite 3)+twoClosedClasses =+    checked+        ( fromRows+            (chunksOf 3 [1, 0, 0, 0, 0.4, 0.6, 0, 0.5, 0.5])+        )++-- State 0 is transient; {1, 2} is the only recurrent class.+withTransient :: TransitionMatrix (Finite 3)+withTransient =+    checked+        ( fromRows+            (chunksOf 3 [0, 0.5, 0.5, 0, 0.4, 0.6, 0, 0.5, 0.5])+        )++allCloseTo :: [Double] -> [Double] -> Bool+allCloseTo expected actual =+    length expected == length actual+        && and (zipWith (approxEq testTolerance) expected actual)++isFinite :: Double -> Bool+isFinite value = not (isNaN value || isInfinite value)++inverts :: Double -> Either error Expectation -> Bool+inverts probability (Right (FiniteExpectation mean)) =+    approxEq testTolerance (probability * mean) 1+inverts _ _ = False
+ test/Dtmc/Analysis/TimeSpecSupport.hs view
@@ -0,0 +1,953 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.Analysis.TimeSpecSupport (+    hittingTimeSpec,+    returnTimeSpec,+) where++import Data.Finite (+    Finite,+    finites,+ )+import Dtmc.Analysis.Classification (+    accessible,+    recurrentState,+ )+import Dtmc.Analysis.Event (+    DiscreteEvent (..),+ )+import Dtmc.Analysis.FiniteTime qualified as FT+import Dtmc.Analysis.HittingTime (+    Expectation (..),+    LinearSystemError (..),+ )+import Dtmc.Analysis.HittingTime qualified as Hit+import Dtmc.Analysis.ReturnTime qualified as Return+import Dtmc.Distribution.Map qualified as DistributionMap+import Dtmc.State (+    FiniteState,+    finiteStates,+ )+import Dtmc.TestSupport+import Dtmc.Transition.Kernel qualified as Kernel+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    TransitionMatrixError,+    fromRows,+    identity,+    toRows,+ )+import GHC.Generics (+    Generic,+ )+import GHC.TypeNats (+    KnownNat,+ )+import Test.Hspec (+    Spec,+    describe,+    expectationFailure,+    it,+    shouldBe,+    shouldSatisfy,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    Property,+    conjoin,+    counterexample,+    forAll,+    property,+    (===),+ )++data NamedRuinState = Ruined | One | Two | Three | Won+    deriving (Eq, Ord, Show, Generic)++instance FiniteState NamedRuinState++checked :: (Show e) => Either e a -> a+checked = either (error . show) id++asTransitionKernel ::+    (FiniteState state) =>+    TransitionMatrix state ->+    Kernel.TransitionKernel state+asTransitionKernel matrix =+    Kernel.fromLaws $ \source ->+        either (error . show) id $+            DistributionMap.fromList+                [ (destination, FT.stepProbability matrix source destination)+                | destination <- finiteStates+                ]++simpleRandomWalk :: Kernel.TransitionKernel Integer+simpleRandomWalk =+    Kernel.fromLaws $ \state ->+        either (error . show) id $+            DistributionMap.fromList [(state - 1, 0.5), (state + 1, 0.5)]++-- Gambler's ruin on {0..4}: win 1 with probability p, lose 1 with+-- probability 1-p; 0 (ruin) and 4 (goal) are absorbing.+gambler :: Double -> TransitionMatrix (Finite 5)+gambler p =+    checked $+        fromRows+            ( chunksOf+                5+                [ 1+                , 0+                , 0+                , 0+                , 0+                , 1 - p+                , 0+                , p+                , 0+                , 0+                , 0+                , 1 - p+                , 0+                , p+                , 0+                , 0+                , 0+                , 1 - p+                , 0+                , p+                , 0+                , 0+                , 0+                , 0+                , 1+                ]+            )++namedGambler :: TransitionMatrix NamedRuinState+namedGambler =+    checked $+        fromRows @NamedRuinState+            ( chunksOf+                5+                [ 1+                , 0+                , 0+                , 0+                , 0+                , 0.5+                , 0+                , 0.5+                , 0+                , 0+                , 0+                , 0.5+                , 0+                , 0.5+                , 0+                , 0+                , 0+                , 0.5+                , 0+                , 0.5+                , 0+                , 0+                , 0+                , 0+                , 1+                ]+            )++-- Oscillator: states 0 and 1 swap with probability 1/2 or exit to+-- their own absorbing state (0 -> 2, 1 -> 3).+oscillator :: TransitionMatrix (Finite 4)+oscillator =+    checked $+        fromRows+            ( chunksOf+                4+                [ 0+                , 0.5+                , 0.5+                , 0+                , 0.5+                , 0+                , 0+                , 0.5+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 1+                ]+            )++twoCycle :: TransitionMatrix (Finite 2)+twoCycle =+    checked $+        fromRows+            ( chunksOf+                2+                [ 0+                , 1+                , 1+                , 0+                ]+            )++nonUniformRecurrent :: TransitionMatrix (Finite 2)+nonUniformRecurrent =+    checked $+        fromRows+            ( chunksOf+                2+                [ 0.9+                , 0.1+                , 0.4+                , 0.6+                ]+            )++-- 0 -> 1 -> 2 (absorbing): reaching 2 requires passing through 1 first.+pathChain :: TransitionMatrix (Finite 3)+pathChain =+    checked $+        fromRows+            ( chunksOf+                3+                [ 0+                , 1+                , 0+                , 0+                , 0+                , 1+                , 0+                , 0+                , 1+                ]+            )++-- Two transient equations with very different scales. The system is+-- nonsingular in exact arithmetic but too ill-conditioned for the public+-- Double-precision numerical contract.+illConditionedChain :: TransitionMatrix (Finite 3)+illConditionedChain =+    checked $+        fromRows+            ( chunksOf+                3+                [ 1 - epsilon+                , 0+                , epsilon+                , 0+                , 0+                , 1+                , 0+                , 0+                , 1+                ]+            )+  where+    epsilon = 1e-14++-- Ruin probability from i with N = 4: (r^i - r^N) / (1 - r^N), r = (1-p)/p.+-- Only for p /= 1/2 (the symmetric case is 1 - i/N).+ruinProbability :: Double -> Int -> Double+ruinProbability p i = (r ^^ i - r ^^ n) / (1 - r ^^ n)+  where+    r = (1 - p) / p+    n = 4 :: Int++-- Expected duration until absorption at 0 or 4, for p /= 1/2:+-- i/(q-p) - (N/(q-p)) (1 - r^i) / (1 - r^N), q = 1-p, r = q/p.+ruinDuration :: Double -> Int -> Double+ruinDuration p i =+    fromIntegral i / (q - p)+        - (fromIntegral n / (q - p)) * (1 - r ^^ i) / (1 - r ^^ n)+  where+    q = 1 - p+    r = q / p+    n = 4 :: Int++closeTo :: Double -> Double -> Bool+closeTo expected x = abs (x - expected) <= testTolerance++expectationCloseTo :: Double -> Expectation -> Bool+expectationCloseTo expected (FiniteExpectation v) = closeTo expected v+expectationCloseTo _ InfiniteExpectation = False++checkedChain ::+    forall n.+    (KnownNat n) =>+    [[Double]] ->+    (TransitionMatrix (Finite n) -> Property) ->+    Property+checkedChain matrix check =+    case fromRows matrix of+        Right p -> check p+        Left err ->+            counterexample ("generated matrix was rejected: " <> show err) False++hittingTimeSpec :: Spec+hittingTimeSpec = do+    describe "numerical analysis errors" $+        it "rejects an ill-conditioned eventual-hitting system explicitly" $+            hitEventualProbabilityByState illConditionedChain [2]+                `shouldSatisfy` isIllConditioned++    describe "eventual hitting probability" $ do+        it "matches the gambler's ruin closed form (p = 0.4)" $ do+            case hitEventualProbabilityByState (gambler 0.4) [0] of+                Left err -> expectationFailure (show err)+                Right result -> do+                    let h = result+                    length h `shouldBe` 5+                    sequence_+                        [ x `shouldSatisfy` closeTo (ruinProbability 0.4 i)+                        | (i, x) <- zip [0 ..] h+                        ]++        it "matches the symmetric closed form 1 - i/4 (p = 0.5)" $ do+            case hitEventualProbabilityByState (gambler 0.5) [0] of+                Left err -> expectationFailure (show err)+                Right result ->+                    sequence_+                        [ x `shouldSatisfy` closeTo (1 - fromIntegral i / 4)+                        | (i, x) <- zip [0 :: Int ..] (result)+                        ]++        it "solves the oscillator race to a single absorbing state" $ do+            case hitEventualProbabilityByState oscillator [2] of+                Left err -> expectationFailure (show err)+                Right result ->+                    sequence_+                        [ x `shouldSatisfy` closeTo v+                        | (x, v) <- zip (result) [2 / 3, 1 / 3, 1, 0]+                        ]++        it "is all zero for an empty target" $+            hitEventualProbabilityByState oscillator []+                `shouldBe` Right [0, 0, 0, 0]++        it "supports a single-state lookup without changing the result" $+            Hit.eventualProbabilityGivenInitialState oscillator [2] 0+                `shouldSatisfy` either (const False) (closeTo (2 / 3))++        prop "is exactly one on the target and zero off its basin (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                checkedChain matrix $ \p ->+                    case hitEventualProbabilityByState p [0] of+                        Left err -> counterexample (show err) False+                        Right result ->+                            conjoin+                                [ counterexample (show (i, x)) $+                                    if+                                        | i == 0 -> x === 1+                                        | accessible p i 0 ->+                                            property+                                                (x >= -testTolerance && x <= 1 + testTolerance)+                                        | otherwise -> x === 0+                                | (i, x) <-+                                    zip (finites :: [Finite 4]) (result)+                                ]++        prop "satisfies the first-step equations off the target (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                checkedChain @4 matrix $ \p ->+                    case hitEventualProbabilityByState p [0] of+                        Left err -> counterexample (show err) False+                        Right h ->+                            let pushed =+                                    [ sum (zipWith (*) row h)+                                    | row <- toRows p+                                    ]+                             in conjoin+                                    [ property (closeTo hi pi_)+                                    | (i, hi, pi_) <-+                                        zip3 (finites :: [Finite 4]) (h) pushed+                                    , i /= 0+                                    ]++    describe "bounded hitting times" $ do+        it "returns an empty result for the empty chain" $+            ((hitProbabilityByState . LessThan) 3 (identity @(Finite 0)) [])+                `shouldBe` []++        it "places all time-zero mass on the target" $+            ((hitProbabilityByState . EqualTo) 0 oscillator [2])+                `shouldBe` [0, 0, 1, 0]++        it "gives zero exact-time mass for an empty target" $+            ((hitProbabilityByState . EqualTo) 5 oscillator [])+                `shouldBe` [0, 0, 0, 0]++        it "matches a one-step gambler's-ruin hit" $+            ((hitProbabilityByState . EqualTo) 1 (gambler 0.5) [0])+                `shouldBe` [0, 0.5, 0, 0, 0]++        it "uses a strict time bound" $ do+            ((hitProbabilityByState . LessThan) 0 oscillator [2])+                `shouldBe` [0, 0, 0, 0]+            ((hitProbabilityByState . LessThan) 1 oscillator [2])+                `shouldBe` [0, 0, 1, 0]+            (Hit.probabilityGivenInitialState . LessThan) 2 (gambler 0.5) (== 0) 1+                `shouldSatisfy` closeTo 0.5++        it "ignores duplicate and reordered targets" $+            ((hitProbabilityByState . LessThan) 4 oscillator [2, 3, 2])+                `shouldBe` ((hitProbabilityByState . LessThan) 4 oscillator [3, 2])++        it "single-state queries look up the all-state results" $ do+            let exact = ((hitProbabilityByState . EqualTo) 3 oscillator [2])+                bounded = ((hitProbabilityByState . LessThan) 4 oscillator [2])+            sequence_+                [ (Hit.probabilityGivenInitialState . EqualTo) 3 oscillator (== 2) i+                    `shouldSatisfy` closeTo exactAt+                | (i, exactAt) <- zip (finites :: [Finite 4]) exact+                ]+            sequence_+                [ (Hit.probabilityGivenInitialState . LessThan) 4 oscillator (== 2) i+                    `shouldSatisfy` closeTo boundedAt+                | (i, boundedAt) <- zip (finites :: [Finite 4]) bounded+                ]++        prop "bounded increments equal exact-time mass (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                checkedChain matrix $ \p ->+                    conjoin+                        [ counterexample (show (t, i, before, after, mass)) $+                            property (closeTo mass (after - before))+                        | t <- [0 .. 4]+                        , i <- finites :: [Finite 4]+                        , let before = (Hit.probabilityGivenInitialState . LessThan) t p (== 0) i+                        , let after = (Hit.probabilityGivenInitialState . LessThan) (t + 1) p (== 0) i+                        , let mass = (Hit.probabilityGivenInitialState . EqualTo) t p (== 0) i+                        ]++        prop "bounded probabilities increase toward the eventual value (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                checkedChain matrix $ \p ->+                    conjoin+                        [ counterexample (show (bound, i, current, next, eventual)) $+                            case eventual of+                                Left err -> counterexample (show err) False+                                Right value ->+                                    property+                                        ( current >= -testTolerance+                                            && current <= next + testTolerance+                                            && next <= value + testTolerance+                                        )+                        | bound <- [0 .. 4]+                        , i <- finites :: [Finite 4]+                        , let current = (Hit.probabilityGivenInitialState . LessThan) bound p (== 0) i+                        , let next = (Hit.probabilityGivenInitialState . LessThan) (bound + 1) p (== 0) i+                        , let eventual = Hit.eventualProbabilityGivenInitialState p [0] i+                        ]++    describe "hitting race probability" $ do+        it "is exactly one on an effective successful state" $+            Hit.raceProbabilityGivenInitialState (gambler 0.5) [4] [0] 4 `shouldBe` Right 1++        it "is exactly zero on a competing state" $+            Hit.raceProbabilityGivenInitialState (gambler 0.5) [4] [0] 0 `shouldBe` Right 0++        it "is exactly zero on an overlapping (tied) state" $+            -- State 2 is in both boundaries, so the tie loses: value zero.+            Hit.raceProbabilityGivenInitialState oscillator [2] [2, 3] 2+                `shouldBe` Right 0++        it "gives all zeros for identical successful and competing sets" $+            ( hitRaceProbabilityByState+                oscillator+                [2, 3]+                [2, 3]+            )+                `shouldBe` Right (replicate 4 0)++        it "gives all zeros for an empty successful set" $+            hitRaceProbabilityByState oscillator [] [2, 3]+                `shouldBe` Right (replicate 4 0)++        it "agrees with eventual hitting for an empty competing set" $ do+            case ( hitRaceProbabilityByState+                    oscillator+                    [2, 3]+                    []+                 , hitEventualProbabilityByState oscillator [2, 3]+                 ) of+                (Left err, _) -> expectationFailure (show err)+                (_, Left err) -> expectationFailure (show err)+                (Right before, Right plain) ->+                    sequence_+                        [ x `shouldSatisfy` closeTo y+                        | (x, y) <- zip (before) (plain)+                        ]++        it "is exactly zero when the successful set is unreachable" $+            -- Absorbing state 3 cannot reach absorbing state 2.+            Hit.raceProbabilityGivenInitialState oscillator [2] [] 3+                `shouldBe` Right 0++        it "is exactly zero when success needs a competitor first" $+            -- 0 -> 1 -> 2 with 1 competing: 2 is reachable only through 1.+            Hit.raceProbabilityGivenInitialState pathChain [2] [1] 0 `shouldBe` Right 0++        it "ignores duplicate targets" $ do+            case ( hitRaceProbabilityByState+                    oscillator+                    [2, 2]+                    [3, 3]+                 , hitRaceProbabilityByState+                    oscillator+                    [2]+                    [3]+                 ) of+                (Left err, _) -> expectationFailure (show err)+                (_, Left err) -> expectationFailure (show err)+                (Right withDuplicates, Right once) ->+                    sequence_+                        [ x `shouldSatisfy` closeTo y+                        | (x, y) <- zip (withDuplicates) (once)+                        ]++        it "ignores target order" $ do+            case ( hitRaceProbabilityByState+                    oscillator+                    [2, 0]+                    [3, 1]+                 , hitRaceProbabilityByState+                    oscillator+                    [0, 2]+                    [1, 3]+                 ) of+                (Left err, _) -> expectationFailure (show err)+                (_, Left err) -> expectationFailure (show err)+                (Right reordered, Right ordered) ->+                    sequence_+                        [ x `shouldSatisfy` closeTo y+                        | (x, y) <- zip (reordered) (ordered)+                        ]++        it "single-state lookups match the all-state vector" $+            case hitRaceProbabilityByState+                oscillator+                [2]+                [3] of+                Left err -> expectationFailure (show err)+                Right result ->+                    sequence_+                        [ Hit.raceProbabilityGivenInitialState+                            oscillator+                            [2]+                            [3]+                            i+                            `shouldSatisfy` either (const False) (closeTo x)+                        | (i, x) <-+                            zip (finites :: [Finite 4]) (result)+                        ]++        it "solves the oscillator race against a competing absorber" $ do+            case hitRaceProbabilityByState oscillator [2] [3] of+                Left err -> expectationFailure (show err)+                Right result ->+                    sequence_+                        [ x `shouldSatisfy` closeTo v+                        | (x, v) <- zip (result) [2 / 3, 1 / 3, 1, 0]+                        ]++        it "matches a hand-computed symmetric race (gambler p = 0.5)" $ do+            case hitRaceProbabilityByState (gambler 0.5) [4] [0] of+                Left err -> expectationFailure (show err)+                Right result ->+                    sequence_+                        [ x `shouldSatisfy` closeTo (fromIntegral i / 4)+                        | (i, x) <- zip [0 :: Int ..] (result)+                        ]++        it "disjoint races sum to one when the union is hit almost surely" $+            sequence_+                [ case ( hitRaceProbabilityByState g [4] [0]+                       , hitRaceProbabilityByState g [0] [4]+                       ) of+                    (Left err, _) -> expectationFailure (show err)+                    (_, Left err) -> expectationFailure (show err)+                    (Right wins, Right losses) ->+                        sequence_+                            [ (x + y) `shouldSatisfy` closeTo 1+                            | (x, y) <- zip (wins) (losses)+                            ]+                | pp <- [0.3, 0.5, 0.7]+                , let g = gambler pp+                ]++    describe "expected hitting time" $ do+        it "returns one entry per state" $ do+            -- The transient come from the linear solve, so they are+            -- compared within tolerance; the target are assigned+            -- exactly and checked exactly.+            case hitExpectationByState oscillator [2, 3] of+                Left err -> expectationFailure (show err)+                Right eta -> do+                    sequence_+                        [ e `shouldSatisfy` expectationCloseTo 2+                        | e <- take 2 eta+                        ]+                    drop 2 eta `shouldBe` [FiniteExpectation 0, FiniteExpectation 0]++        it "matches the gambler duration closed form (p = 0.4)" $ do+            let eta = Hit.expectationGivenInitialState (gambler 0.4) [0, 4]+            sequence_+                [ eta i+                    `shouldSatisfy` either+                        (const False)+                        (expectationCloseTo (ruinDuration 0.4 (fromIntegral i)))+                | i <- finites :: [Finite 5]+                ]++        it "matches the symmetric duration i (4 - i) (p = 0.5)" $ do+            let eta = Hit.expectationGivenInitialState (gambler 0.5) [0, 4]+            sequence_+                [ eta i+                    `shouldSatisfy` either+                        (const False)+                        (expectationCloseTo (fromIntegral i * (4 - fromIntegral i)))+                | i <- finites :: [Finite 5]+                ]++        it "expects two steps to absorption from either oscillator state" $ do+            let eta = Hit.expectationGivenInitialState oscillator [2, 3]+            eta 0 `shouldSatisfy` either (const False) (expectationCloseTo 2)+            eta 1 `shouldSatisfy` either (const False) (expectationCloseTo 2)+            eta 2 `shouldBe` Right (FiniteExpectation 0)+            eta 3 `shouldBe` Right (FiniteExpectation 0)++        it "is infinite when a competing absorbing state is reachable" $ do+            let eta = Hit.expectationGivenInitialState oscillator [2]+            eta 0 `shouldBe` Right InfiniteExpectation+            eta 1 `shouldBe` Right InfiniteExpectation+            eta 2 `shouldBe` Right (FiniteExpectation 0)+            eta 3 `shouldBe` Right InfiniteExpectation++        prop "finite satisfy the first-step equations (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                checkedChain @4 matrix $ \p ->+                    case hitExpectationByState p [0] of+                        Left err -> counterexample (show err) False+                        Right times ->+                            let eta i = times !! fromIntegral i+                                rows = toRows p+                                firstStep i row =+                                    case eta i of+                                        InfiniteExpectation -> property True+                                        FiniteExpectation e ->+                                            case successorExpectations row of+                                                Nothing ->+                                                    counterexample+                                                        "finite state with doomed successor"+                                                        False+                                                Just total ->+                                                    property (closeTo e (1 + total))+                                successorExpectations row =+                                    sum+                                        <$> sequence+                                            [ case eta j of+                                                FiniteExpectation e -> Just (pij * e)+                                                InfiniteExpectation -> Nothing+                                            | (j, pij) <-+                                                zip (finites :: [Finite 4]) row+                                            , pij > 0+                                            , j /= 0+                                            ]+                             in conjoin+                                    [ firstStep i row+                                    | (i, row) <-+                                        zip (finites :: [Finite 4]) rows+                                    , i /= 0+                                    ]++returnTimeSpec :: Spec+returnTimeSpec = do+    describe "bounded first-return times" $ do+        it "returns an empty result for the empty chain" $+            ((returnProbabilityByState . LessThan) 3 (identity @(Finite 0)))+                `shouldBe` []++        it "has no return mass at time zero" $+            ((returnProbabilityByState . EqualTo) 0 oscillator)+                `shouldBe` [0, 0, 0, 0]++        it "uses the transition diagonal at time one" $+            ((returnProbabilityByState . EqualTo) 1 nonUniformRecurrent)+                `shouldBe` [0.9, 0.6]++        it "counts only the first return" $ do+            ((returnProbabilityByState . EqualTo) 1 oscillator)+                `shouldBe` [0, 0, 1, 1]+            ((returnProbabilityByState . EqualTo) 2 oscillator)+                `shouldBe` [0.25, 0.25, 0, 0]+            ((returnProbabilityByState . EqualTo) 2 twoCycle)+                `shouldBe` [1, 1]++        it "uses a strict time bound" $ do+            ((returnProbabilityByState . LessThan) 0 oscillator)+                `shouldBe` [0, 0, 0, 0]+            ((returnProbabilityByState . LessThan) 1 oscillator)+                `shouldBe` [0, 0, 0, 0]+            ((returnProbabilityByState . LessThan) 2 oscillator)+                `shouldBe` [0, 0, 1, 1]+            ((returnProbabilityByState . LessThan) 3 twoCycle)+                `shouldBe` [1, 1]++        it "single-state queries look up the all-state results" $ do+            let exact = ((returnProbabilityByState . EqualTo) 3 oscillator)+                bounded = ((returnProbabilityByState . LessThan) 4 oscillator)+            sequence_+                [ (Return.probabilityGivenInitialState . EqualTo) 3 oscillator i+                    `shouldSatisfy` closeTo exactAt+                | (i, exactAt) <- zip (finites :: [Finite 4]) exact+                ]+            sequence_+                [ (Return.probabilityGivenInitialState . LessThan) 4 oscillator i+                    `shouldSatisfy` closeTo boundedAt+                | (i, boundedAt) <- zip (finites :: [Finite 4]) bounded+                ]++        prop "bounded increments equal exact-time mass (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                checkedChain matrix $ \p ->+                    conjoin+                        [ counterexample (show (t, i, before, after, mass)) $+                            property (closeTo mass (after - before))+                        | t <- [0 .. 4]+                        , i <- finites :: [Finite 4]+                        , let before = (Return.probabilityGivenInitialState . LessThan) t p i+                        , let after = (Return.probabilityGivenInitialState . LessThan) (t + 1) p i+                        , let mass = (Return.probabilityGivenInitialState . EqualTo) t p i+                        ]++        prop "bounded probabilities increase toward the eventual value (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                checkedChain matrix $ \p ->+                    conjoin+                        [ counterexample (show (bound, i, current, next, eventual)) $+                            case eventual of+                                Left err -> counterexample (show err) False+                                Right value ->+                                    property+                                        ( current >= -testTolerance+                                            && current <= next + testTolerance+                                            && next <= value + testTolerance+                                        )+                        | bound <- [0 .. 4]+                        , i <- finites :: [Finite 4]+                        , let current = (Return.probabilityGivenInitialState . LessThan) bound p i+                        , let next = (Return.probabilityGivenInitialState . LessThan) (bound + 1) p i+                        , let eventual = Return.eventualProbabilityGivenInitialState p i+                        ]++    describe "eventual return probability" $ do+        it "returns all state values in one solve" $ do+            -- The transient come from the fundamental-matrix solve,+            -- so they are compared within tolerance; the recurrent entries+            -- are assigned exactly one by the classification and checked+            -- exactly.+            case returnEventualProbabilityByState oscillator of+                Left err -> expectationFailure (show err)+                Right result -> do+                    let f = result+                    sequence_+                        [ x `shouldSatisfy` closeTo 0.25+                        | x <- take 2 f+                        ]+                    drop 2 f `shouldBe` [1, 1]++        prop "agrees with the first-step decomposition (random @4)" $+            -- Two independent theorems for the same quantity: the+            -- implementation computes f_i = 1 - 1/N_ii from the renewal+            -- identity, while conditioning on the first step gives+            -- f_i = sum_j P_ij h_j{i}.+            forAll (genTransitionRows 4) $ \matrix ->+                checkedChain matrix $ \p ->+                    case returnEventualProbabilityByState p of+                        Left err -> counterexample (show err) False+                        Right returns ->+                            let rows = toRows p+                             in conjoin+                                    [ case hitEventualProbabilityByState p [i] of+                                        Left err -> counterexample (show err) False+                                        Right hits ->+                                            let firstStep =+                                                    sum+                                                        ( zipWith+                                                            (*)+                                                            row+                                                            (hits)+                                                        )+                                             in counterexample+                                                    (show (i, f, firstStep))+                                                    (property (closeTo firstStep f))+                                    | (i, row, f) <-+                                        zip3+                                            (finites :: [Finite 4])+                                            rows+                                            (returns)+                                    ]++        it "is one for an absorbing state" $+            Return.eventualProbabilityGivenInitialState (gambler 0.5) 0+                `shouldSatisfy` either (const False) (closeTo 1)++        it "is one quarter for an oscillator state" $+            -- From 0: half the time exit to 2 (never return); otherwise reach+            -- 1, whence the return probability to 0 is 1/2. So f = 1/4.+            Return.eventualProbabilityGivenInitialState oscillator 0+                `shouldSatisfy` either (const False) (closeTo 0.25)++        it "is one for both states of the two-cycle" $ do+            Return.eventualProbabilityGivenInitialState twoCycle 0+                `shouldSatisfy` either (const False) (closeTo 1)+            Return.eventualProbabilityGivenInitialState twoCycle 1+                `shouldSatisfy` either (const False) (closeTo 1)++        prop "is close to one on recurrent states and within [0, 1] (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                checkedChain matrix $ \p ->+                    conjoin+                        [ counterexample (show (i, f)) $+                            case f of+                                Left err -> counterexample (show err) False+                                Right value ->+                                    property+                                        ( value >= -testTolerance+                                            && value <= 1 + testTolerance+                                            && ( not (recurrentState p i)+                                                    || closeTo 1 value+                                               )+                                        )+                        | i <- finites :: [Finite 4]+                        , let f = Return.eventualProbabilityGivenInitialState p i+                        ]++    describe "expected return time" $ do+        it "returns all state values in one table" $+            returnExpectationByState oscillator+                `shouldBe` Right [InfiniteExpectation, InfiniteExpectation, FiniteExpectation 1, FiniteExpectation 1]++        it "is one for an absorbing state" $+            Return.expectationGivenInitialState oscillator 2 `shouldBe` Right (FiniteExpectation 1)++        it "is two for either state of the two-cycle" $ do+            Return.expectationGivenInitialState twoCycle 0+                `shouldSatisfy` either (const False) (expectationCloseTo 2)+            Return.expectationGivenInitialState twoCycle 1+                `shouldSatisfy` either (const False) (expectationCloseTo 2)++        it "handles a non-uniform recurrent class" $ do+            Return.expectationGivenInitialState nonUniformRecurrent 0+                `shouldSatisfy` either (const False) (expectationCloseTo 1.25)+            Return.expectationGivenInitialState nonUniformRecurrent 1+                `shouldSatisfy` either (const False) (expectationCloseTo 5)++        it "is infinite for the oscillator's transient states" $ do+            Return.expectationGivenInitialState oscillator 0 `shouldBe` Right InfiniteExpectation+            Return.expectationGivenInitialState oscillator 1 `shouldBe` Right InfiniteExpectation++        prop "is finite exactly on recurrent states (random @4)" $+            forAll (genTransitionRows 4) $ \matrix ->+                checkedChain matrix $ \p ->+                    conjoin+                        [ counterexample (show i) $+                            case Return.expectationGivenInitialState p i of+                                Left err -> counterexample (show err) False+                                Right result ->+                                    isFinite result === recurrentState p i+                        | i <- finites :: [Finite 4]+                        ]++    describe "Transition realization independence" $ do+        it "uses strict hitting bounds on an infinite random walk" $ do+            (Hit.probabilityGivenInitialState . EqualTo) 2 simpleRandomWalk (== 2) 0+                `shouldSatisfy` closeTo 0.25+            (Hit.probabilityGivenInitialState . LessThan) 2 simpleRandomWalk (== 2) 0+                `shouldBe` 0+            (Hit.probabilityGivenInitialState . LessThan) 3 simpleRandomWalk (== 2) 0+                `shouldSatisfy` closeTo 0.25++        it "distinguishes return time from time-zero hitting" $ do+            (Hit.probabilityGivenInitialState . EqualTo) 0 simpleRandomWalk (== 0) 0+                `shouldBe` 1+            (Return.probabilityGivenInitialState . EqualTo) 0 simpleRandomWalk 0+                `shouldBe` 0+            (Return.probabilityGivenInitialState . EqualTo) 2 simpleRandomWalk 0+                `shouldSatisfy` closeTo 0.5+            (Return.probabilityGivenInitialState . LessThan) 2 simpleRandomWalk 0+                `shouldBe` 0+            (Return.probabilityGivenInitialState . LessThan) 3 simpleRandomWalk 0+                `shouldSatisfy` closeTo 0.5++        prop "matches matrix and equivalent-kernel bounded queries" $+            forAll (genTransitionRows 3) $ \rawMatrix ->+                case fromRows rawMatrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left problem -> counterexample (show problem) False+                    Right matrix ->+                        let kernel = asTransitionKernel matrix+                            target state = state == (2 :: Finite 3)+                         in conjoin+                                [ counterexample (show (state, time)) $+                                    property $+                                        and+                                            [ closeTo+                                                ((Hit.probabilityGivenInitialState . EqualTo) time matrix target state)+                                                ((Hit.probabilityGivenInitialState . EqualTo) time kernel target state)+                                            , closeTo+                                                ((Hit.probabilityGivenInitialState . LessThan) time matrix target state)+                                                ((Hit.probabilityGivenInitialState . LessThan) time kernel target state)+                                            , closeTo+                                                ((Return.probabilityGivenInitialState . EqualTo) time matrix state)+                                                ((Return.probabilityGivenInitialState . EqualTo) time kernel state)+                                            , closeTo+                                                ((Return.probabilityGivenInitialState . LessThan) time matrix state)+                                                ((Return.probabilityGivenInitialState . LessThan) time kernel state)+                                            ]+                                | state <- finites :: [Finite 3]+                                , time <- [0 .. 4]+                                ]++    describe "named finite states" $ do+        it "solves eventual and competing hitting queries by constructor" $ do+            case hitEventualProbabilityByState namedGambler [Ruined, Won] of+                Left err -> expectationFailure (show err)+                Right result ->+                    sequence_+                        [ probability `shouldSatisfy` closeTo 1+                        | probability <- result+                        ]+            Hit.raceProbabilityGivenInitialState namedGambler [Won] [Ruined] Two+                `shouldSatisfy` either (const False) (closeTo 0.5)++        it "solves bounded hitting queries in named state order" $+            ((hitProbabilityByState . LessThan) 3 namedGambler [Won])+                `shouldBe` [0, 0, 0.25, 0.5, 1]++        it "solves named expected hitting and return times" $ do+            Hit.expectationGivenInitialState namedGambler [Ruined, Won] Two+                `shouldSatisfy` either (const False) (expectationCloseTo 4)+            Return.expectationGivenInitialState namedGambler Ruined+                `shouldBe` Right (FiniteExpectation 1)++isFinite :: Expectation -> Bool+isFinite (FiniteExpectation _) = True+isFinite InfiniteExpectation = False++isIllConditioned :: Either LinearSystemError value -> Bool+isIllConditioned (Left (IllConditionedSystem estimate)) =+    estimate < 1e-12+isIllConditioned _ = False
+ test/Dtmc/Analysis/VisitCountCanonicalSpec.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE TypeApplications #-}++module Dtmc.Analysis.VisitCountCanonicalSpec (+    spec,+) where++import Data.Finite (+    Finite,+    finites,+ )+import Data.Maybe (+    fromMaybe,+ )+import Dtmc.Analysis.Event (+    DiscreteEvent (..),+ )+import Dtmc.Analysis.Expectation (+    Expectation (..),+ )+import Dtmc.Analysis.ProbabilityOracle qualified as Oracle+import Dtmc.Analysis.VisitCount qualified as Visit+import Dtmc.Distribution (+    distributionWeights,+ )+import Dtmc.Distribution.Map qualified as DistributionMap+import Dtmc.TestSupport+import Dtmc.Transition.Kernel (+    TransitionKernel,+    fromLaws,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    TransitionMatrixError,+    fromRows,+ )+import Numeric.Natural (+    Natural,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+    shouldSatisfy,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    counterexample,+    forAll,+    property,+ )++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++transientVisitChain :: TransitionMatrix (Finite 3)+transientVisitChain =+    checked+        ( fromRows+            ( chunksOf+                3+                [ 1 / 4+                , 0+                , 3 / 4+                , 1 / 2+                , 0+                , 1 / 2+                , 0+                , 0+                , 1+                ]+            )+        )++recurrentVisitChain :: TransitionMatrix (Finite 4)+recurrentVisitChain =+    checked+        ( fromRows+            ( chunksOf+                4+                [ 0+                , 1 / 2+                , 1 / 2+                , 0+                , 1 / 2+                , 0+                , 0+                , 1 / 2+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 1+                ]+            )+        )++tinyReturn :: Double+tinyReturn = 1e-12++tinyVisitChain :: TransitionMatrix (Finite 2)+tinyVisitChain =+    checked+        ( fromRows+            ( chunksOf+                2+                [ tinyReturn+                , 1 - tinyReturn+                , 0+                , 1+                ]+            )+        )++simpleRandomWalk :: TransitionKernel Integer+simpleRandomWalk =+    fromLaws $ \state ->+        checked+            ( DistributionMap.fromList+                [(state - 1, 0.5), (state + 1, 0.5)]+            )++close :: Double -> Double -> Bool+close = approxEq testTolerance++known :: Maybe Double -> Double+known = fromMaybe (error "oracle horizon does not determine this event")++eventsThrough :: Natural -> [DiscreteEvent]+eventsThrough horizon =+    [EqualTo count | count <- [0 .. horizon]]+        <> [LessThan count | count <- [0 .. horizon + 1]]+        <> [AtMost count | count <- [0 .. horizon]]+        <> [GreaterThan count | count <- [0 .. horizon]]+        <> [AtLeast count | count <- [0 .. horizon + 1]]++generatedTotalChecks :: TransitionMatrix (Finite 3) -> Bool+generatedTotalChecks matrix =+    and+        [ let scalar = checked (Visit.totalProbabilityGivenInitialState event matrix 0 initial)+              dense = (checked (visitTotalProbabilityByState event matrix 0))+           in close (dense !! fromIntegral initial) scalar+                && scalar >= negate testTolerance+                && scalar <= 1 + testTolerance+        | initial <- finites+        , event <- eventsThrough 4+        ]++generatedBoundedChecks :: TransitionMatrix (Finite 3) -> Bool+generatedBoundedChecks matrix =+    and+        [ let initial = DistributionMap.pointMass (0 :: Finite 3)+              oracleLaw = Oracle.visitLawBefore bound [(0, 1)] matrix (== 0)+              expected = known (Oracle.lawProbability event oracleLaw)+              actual = Visit.boundedProbability bound event initial matrix (== 0)+           in close actual expected+        | bound <- [0 .. 4]+        , event <- eventsThrough bound+        ]++spec :: Spec+spec = do+    describe "canonical total visit count" $ do+        it "implements every relation for a transient geometric law" $ do+            let probability event =+                    checked (Visit.totalProbabilityGivenInitialState event transientVisitChain 0 1)+            probability (EqualTo 0) `shouldSatisfy` close (1 / 2)+            probability (EqualTo 1) `shouldSatisfy` close (3 / 8)+            probability (LessThan 2) `shouldSatisfy` close (7 / 8)+            probability (AtMost 1) `shouldSatisfy` close (7 / 8)+            probability (GreaterThan 1) `shouldSatisfy` close (1 / 8)+            probability (AtLeast 2) `shouldSatisfy` close (1 / 8)+            probability (AtLeast 0) `shouldBe` 1++        it "places recurrent positive-count mass structurally at infinity" $ do+            let probabilities event =+                    checked (visitTotalProbabilityByState event recurrentVisitChain 2)+                expectedHit = [2 / 3, 1 / 3, 1, 0]+                expectedMiss = [1 / 3, 2 / 3, 0, 1]+            sequence_+                [ actual `shouldSatisfy` close expected+                | (actual, expected) <- zip (probabilities (GreaterThan 3)) expectedHit+                ]+            sequence_+                [ actual `shouldSatisfy` close expected+                | (actual, expected) <- zip (probabilities (AtMost 3)) expectedMiss+                ]+            probabilities (EqualTo 2) `shouldBe` [0, 0, 0, 0]+            probabilities (AtLeast 0) `shouldBe` [1, 1, 1, 1]++        it "evaluates a tiny upper tail without complement subtraction" $ do+            let actual =+                    checked+                        ( Visit.totalProbabilityGivenInitialState+                            (GreaterThan 1)+                            tinyVisitChain+                            0+                            0+                        )+            actual `shouldSatisfy` (> 0)+            actual `shouldSatisfy` (\value -> abs (value - tinyReturn) < 1e-15)++        prop "keeps scalar and all-state event queries consistent (random @3)" $+            forAll (genTransitionRows 3) $ \rawMatrix ->+                case fromRows rawMatrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left problem -> counterexample (show problem) False+                    Right matrix -> property (generatedTotalChecks matrix)++    describe "canonical bounded visit count" $ do+        it "supports every event relation on a locally finite kernel" $ do+            let initial = DistributionMap.pointMass (0 :: Integer)+                probability event =+                    Visit.boundedProbability 3 event initial simpleRandomWalk (== 0)+            distributionWeights (Visit.boundedLaw 3 initial simpleRandomWalk (== 0))+                `shouldBe` [(1, 0.5), (2, 0.5)]+            probability (EqualTo 1) `shouldBe` 0.5+            probability (LessThan 2) `shouldBe` 0.5+            probability (AtMost 1) `shouldBe` 0.5+            probability (GreaterThan 1) `shouldBe` 0.5+            probability (AtLeast 2) `shouldBe` 0.5+            Visit.boundedExpectation 3 initial simpleRandomWalk (== 0)+                `shouldBe` 1.5++        prop "matches independent path enumeration for every relation (random @3)" $+            forAll (genTransitionRows 3) $ \rawMatrix ->+                case fromRows rawMatrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left problem -> counterexample (show problem) False+                    Right matrix -> property (generatedBoundedChecks matrix)++    describe "canonical infinite and expectation names" $ do+        it "match the completed total-visit law" $ do+            let infiniteValues =+                    checked+                        (visitInfiniteProbabilityByState recurrentVisitChain 2)+            sequence_+                [ actual `shouldSatisfy` close expected+                | (actual, expected) <- zip infiniteValues [2 / 3, 1 / 3, 1, 0]+                ]+            checked (Visit.infiniteProbabilityGivenInitialState recurrentVisitChain 2 0)+                `shouldSatisfy` close (2 / 3)+            visitTotalExpectationByState recurrentVisitChain 2+                `shouldBe` Right+                    [ InfiniteExpectation+                    , InfiniteExpectation+                    , InfiniteExpectation+                    , FiniteExpectation 0+                    ]+            Visit.totalExpectationGivenInitialState recurrentVisitChain 2 3+                `shouldBe` Right (FiniteExpectation 0)
+ test/Dtmc/Analysis/VisitCountSpec.hs view
@@ -0,0 +1,485 @@+{-# LANGUAGE TypeApplications #-}++module Dtmc.Analysis.VisitCountSpec (+    spec,+) where++import Data.Finite (+    Finite,+    finites,+ )+import Dtmc.Analysis.Classification (+    accessible,+    recurrentState,+ )+import Dtmc.Analysis.Event (+    DiscreteEvent (..),+ )+import Dtmc.Analysis.FiniteTime qualified as FT+import Dtmc.Analysis.ReturnTime qualified as Return+import Dtmc.Analysis.VisitCount (+    Expectation (..),+ )+import Dtmc.Analysis.VisitCount qualified as Visit+import Dtmc.Distribution (+    distributionWeights,+ )+import Dtmc.Distribution.Map qualified as DistributionMap+import Dtmc.TestSupport+import Dtmc.Transition.Kernel qualified as Kernel+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    TransitionMatrixError,+    fromRows,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+    shouldSatisfy,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    choose,+    conjoin,+    counterexample,+    forAll,+    property,+    (===),+ )++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++twoCycle :: TransitionMatrix (Finite 2)+twoCycle =+    checked $+        fromRows+            ( chunksOf+                2+                [ 0+                , 1+                , 1+                , 0+                ]+            )++-- Target 0 returns with probability 1/4. State 1 first reaches it with+-- probability 1/2, while absorbing state 2 cannot reach it.+transientVisitChain :: TransitionMatrix (Finite 3)+transientVisitChain =+    checked $+        fromRows+            ( chunksOf+                3+                [ 1 / 4+                , 0+                , 3 / 4+                , 1 / 2+                , 0+                , 1 / 2+                , 0+                , 0+                , 1+                ]+            )++-- States 0 and 1 may enter absorbing target 2; absorbing state 3 cannot.+recurrentVisitChain :: TransitionMatrix (Finite 4)+recurrentVisitChain =+    checked $+        fromRows+            ( chunksOf+                4+                [ 0+                , 1 / 2+                , 1 / 2+                , 0+                , 1 / 2+                , 0+                , 0+                , 1 / 2+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 1+                ]+            )++mixedInitial :: DistributionMap.DistributionMap (Finite 2)+mixedInitial =+    checked (DistributionMap.fromList [(0, 0.25), (1, 0.75)])++asKernel ::+    TransitionMatrix (Finite 2) ->+    Kernel.TransitionKernel (Finite 2)+asKernel matrix =+    Kernel.fromLaws $ \source ->+        checked $+            DistributionMap.fromList+                [ (destination, FT.stepProbability matrix source destination)+                | destination <- finites+                ]++simpleRandomWalk :: Kernel.TransitionKernel Integer+simpleRandomWalk =+    Kernel.fromLaws $ \state ->+        checked $+            DistributionMap.fromList+                [(state - 1, 0.5), (state + 1, 0.5)]++closeTo :: Double -> Double -> Bool+closeTo expected actual = abs (actual - expected) <= testTolerance++expectationCloseTo :: Double -> Expectation -> Bool+expectationCloseTo expected (FiniteExpectation actual) = closeTo expected actual+expectationCloseTo _ InfiniteExpectation = False++spec :: Spec+spec = do+    describe "totalProbabilityByState" $ do+        it "matches the geometric law for a transient target" $ do+            let probabilities count =+                    (checked ((visitTotalProbabilityByState . EqualTo) count transientVisitChain 0))+            sequence_+                [ actual `shouldSatisfy` closeTo expected+                | (actual, expected) <-+                    zip (probabilities 0) [0, 1 / 2, 1]+                ]+            sequence_+                [ actual `shouldSatisfy` closeTo expected+                | (actual, expected) <-+                    zip (probabilities 1) [3 / 4, 3 / 8, 0]+                ]+            sequence_+                [ actual `shouldSatisfy` closeTo expected+                | (actual, expected) <-+                    zip (probabilities 3) [3 / 64, 3 / 128, 0]+                ]+            (checked (visitInfiniteProbabilityByState transientVisitChain 0))+                `shouldBe` [0, 0, 0]++        it "puts all positive recurrent-target mass at infinity" $ do+            checked ((visitTotalProbabilityByState . EqualTo) 1 recurrentVisitChain 2)+                `shouldBe` [0, 0, 0, 0]+            sequence_+                [ actual `shouldSatisfy` closeTo expected+                | (actual, expected) <-+                    zip+                        ((checked (visitInfiniteProbabilityByState recurrentVisitChain 2)))+                        [2 / 3, 1 / 3, 1, 0]+                ]+            sequence_+                [ actual `shouldSatisfy` closeTo expected+                | (actual, expected) <-+                    zip+                        ((checked ((visitTotalProbabilityByState . EqualTo) 0 recurrentVisitChain 2)))+                        [1 / 3, 2 / 3, 0, 1]+                ]++        it "counts the target at time zero" $ do+            checked ((Visit.totalProbabilityGivenInitialState . EqualTo) 0 transientVisitChain 0 0)+                `shouldBe` 0+            checked ((Visit.totalProbabilityGivenInitialState . EqualTo) 1 transientVisitChain 0 0)+                `shouldSatisfy` closeTo (3 / 4)++        prop "scalar queries look up the all-state result (random @3)" $+            forAll (genTransitionRows 3) $ \rawMatrix ->+                case fromRows rawMatrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left err -> counterexample (show err) False+                    Right matrix ->+                        conjoin+                            [ conjoin+                                [ case (visitTotalProbabilityByState . EqualTo) count matrix 0 of+                                    Left err -> counterexample (show err) False+                                    Right probabilities ->+                                        conjoin+                                            [ (Visit.totalProbabilityGivenInitialState . EqualTo) count matrix 0 initial+                                                === Right probability+                                            | (initial, probability) <-+                                                zip (finites :: [Finite 3]) (probabilities)+                                            ]+                                | count <- [0, 1, 3]+                                ]+                            , case visitInfiniteProbabilityByState matrix 0 of+                                Left err -> counterexample (show err) False+                                Right probabilities ->+                                    conjoin+                                        [ Visit.infiniteProbabilityGivenInitialState matrix 0 initial+                                            === Right probability+                                        | (initial, probability) <-+                                            zip (finites :: [Finite 3]) (probabilities)+                                        ]+                            ]++    describe "totalExpectationByState" $ do+        it "matches h / (1 - f) for a transient target" $ do+            let expectations = checked (visitTotalExpectationByState transientVisitChain 0)+            sequence_+                [ expectation `shouldSatisfy` expectationCloseTo expected+                | (expectation, expected) <- zip expectations [4 / 3, 2 / 3, 0]+                ]+            checked (Visit.totalExpectationGivenInitialState transientVisitChain 0 1)+                `shouldSatisfy` expectationCloseTo (2 / 3)++        it "is infinite exactly where a recurrent target is reachable" $ do+            checked (visitTotalExpectationByState recurrentVisitChain 2)+                `shouldBe` [InfiniteExpectation, InfiniteExpectation, InfiniteExpectation, FiniteExpectation 0]+            checked (Visit.totalExpectationGivenInitialState recurrentVisitChain 2 3)+                `shouldBe` FiniteExpectation 0+            checked (visitTotalExpectationByState recurrentVisitChain 3)+                `shouldBe` [InfiniteExpectation, InfiniteExpectation, FiniteExpectation 0, InfiniteExpectation]++        prop "agrees with hitting, return, recurrence, and reachability (random @3)" $+            forAll (genTransitionRows 3) $ \rawMatrix ->+                case fromRows rawMatrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left err -> counterexample (show err) False+                    Right matrix ->+                        case do+                            hits <- hitEventualProbabilityByState matrix [0]+                            returning <- Return.eventualProbabilityGivenInitialState matrix 0+                            zeroVisits <- (visitTotalProbabilityByState . EqualTo) 0 matrix 0+                            oneVisit <- (visitTotalProbabilityByState . EqualTo) 1 matrix 0+                            twoVisits <- (visitTotalProbabilityByState . EqualTo) 2 matrix 0+                            infiniteVisits <- visitInfiniteProbabilityByState matrix 0+                            expectations <- visitTotalExpectationByState matrix 0+                            pure+                                ( hits+                                , returning+                                , zeroVisits+                                , oneVisit+                                , twoVisits+                                , infiniteVisits+                                , expectations+                                ) of+                            Left err -> counterexample (show err) False+                            Right+                                ( hits+                                    , returning+                                    , zeroVisits+                                    , oneVisit+                                    , twoVisits+                                    , infiniteVisits+                                    , expectations+                                    ) ->+                                    let hitValues = hits+                                        zeroValues = zeroVisits+                                        oneValues = oneVisit+                                        twoValues = twoVisits+                                        infiniteValues = infiniteVisits+                                        states = finites :: [Finite 3]+                                        structuralExpectations =+                                            [ if accessible matrix initial 0+                                                then InfiniteExpectation+                                                else FiniteExpectation 0+                                            | initial <- states+                                            ]+                                     in conjoin+                                            [ conjoin+                                                [ property (closeTo (1 - hit) zero)+                                                | (hit, zero) <- zip hitValues zeroValues+                                                ]+                                            , if recurrentState matrix 0+                                                then+                                                    conjoin+                                                        [ oneValues === [0, 0, 0]+                                                        , twoValues === [0, 0, 0]+                                                        , infiniteValues === hitValues+                                                        , expectations === structuralExpectations+                                                        ]+                                                else+                                                    conjoin+                                                        [ infiniteValues === [0, 0, 0]+                                                        , conjoin+                                                            [ property (closeTo (hit * (1 - returning)) one)+                                                            | (hit, one) <- zip hitValues oneValues+                                                            ]+                                                        , conjoin+                                                            [ property (closeTo (one * returning) two)+                                                            | (one, two) <- zip oneValues twoValues+                                                            ]+                                                        , conjoin+                                                            [ case expectation of+                                                                FiniteExpectation value ->+                                                                    property+                                                                        (closeTo (hit / (1 - returning)) value)+                                                                InfiniteExpectation -> property False+                                                            | (hit, expectation) <- zip hitValues expectations+                                                            ]+                                                        ]+                                            ]++    describe "boundedLaw" $ do+        it "is a point mass at zero for bound zero" $+            distributionWeights+                ( Visit.boundedLaw+                    0+                    (DistributionMap.pointMass (0 :: Finite 2))+                    twoCycle+                    (== 0)+                )+                `shouldBe` [(0, 1)]++        it "counts the initial state at a positive bound" $+            distributionWeights+                (Visit.boundedLaw 1 mixedInitial twoCycle (== 0))+                `shouldBe` [(0, 0.75), (1, 0.25)]++        it "counts deterministic visits at times zero through bound minus one" $ do+            let initial = DistributionMap.pointMass (0 :: Finite 2)+            distributionWeights (Visit.boundedLaw 1 initial twoCycle (== 0))+                `shouldBe` [(1, 1)]+            distributionWeights (Visit.boundedLaw 2 initial twoCycle (== 0))+                `shouldBe` [(1, 1)]+            distributionWeights (Visit.boundedLaw 3 initial twoCycle (== 0))+                `shouldBe` [(2, 1)]++        it "computes an exact law on an infinite random walk" $+            distributionWeights+                ( Visit.boundedLaw+                    3+                    (DistributionMap.pointMass (0 :: Integer))+                    simpleRandomWalk+                    (== 0)+                )+                `shouldBe` [(1, 0.5), (2, 0.5)]++        prop "has total mass one and no count above the bound (random @3)" $+            forAll (choose (0, 5 :: Int)) $ \rawBound ->+                forAll (genTransitionRows 3) $ \rawMatrix ->+                    case fromRows rawMatrix ::+                            Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                        Left err -> counterexample (show err) False+                        Right matrix ->+                            let bound = fromIntegral rawBound+                                law =+                                    Visit.boundedLaw+                                        bound+                                        (DistributionMap.pointMass (0 :: Finite 3))+                                        matrix+                                        (== 0)+                                weights = distributionWeights law+                             in conjoin+                                    [ property (closeTo 1 (sum (map snd weights)))+                                    , property (all ((<= bound) . fst) weights)+                                    ]++    describe "boundedProbability" $ do+        it "looks up one coordinate of the count distribution" $ do+            let initial = DistributionMap.pointMass (0 :: Integer)+            Visit.boundedProbability 3 (EqualTo 1) initial simpleRandomWalk (== 0)+                `shouldSatisfy` closeTo 0.5+            Visit.boundedProbability 3 (EqualTo 2) initial simpleRandomWalk (== 0)+                `shouldSatisfy` closeTo 0.5+            Visit.boundedProbability 3 (EqualTo 3) initial simpleRandomWalk (== 0)+                `shouldBe` 0++        it "agrees for a matrix and its equivalent kernel" $ do+            let initial = DistributionMap.pointMass (0 :: Finite 2)+                kernel = asKernel twoCycle+            sequence_+                [ Visit.boundedProbability bound (EqualTo count) initial twoCycle (== 0)+                    `shouldBe` Visit.boundedProbability bound (EqualTo count) initial kernel (== 0)+                | bound <- [0 .. 5]+                , count <- [0 .. bound]+                ]++    describe "boundedExpectation" $ do+        it "is the expectation of the random-walk count law" $+            Visit.boundedExpectation+                3+                (DistributionMap.pointMass (0 :: Integer))+                simpleRandomWalk+                (== 0)+                `shouldSatisfy` closeTo 1.5++        prop "equals the sum of finite-time visit probabilities (random @3)" $+            forAll (choose (0, 5 :: Int)) $ \rawBound ->+                forAll (genTransitionRows 3) $ \rawMatrix ->+                    case fromRows rawMatrix ::+                            Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                        Left err -> counterexample (show err) False+                        Right matrix ->+                            let bound = fromIntegral rawBound+                                initial = DistributionMap.pointMass (0 :: Finite 3)+                                expectation =+                                    Visit.boundedExpectation bound initial matrix (== 0)+                                marginalSum =+                                    sum+                                        [ FT.probability initial matrix [FT.At (fromIntegral time) 0]+                                        | time <- [0 .. rawBound - 1]+                                        ]+                             in property (closeTo marginalSum expectation)++    describe "occupationMatrix" $ do+        it "matches the closed form of the transient block" $+            Visit.occupationMatrix transientVisitChain+                `shouldSatisfy` matchesOccupation+                    [ [Just (4 / 3), Just 0, Nothing]+                    , [Just (2 / 3), Just 1, Nothing]+                    , [Just 0, Just 0, Nothing]+                    ]++        it "is infinite everywhere when no state is transient" $+            Visit.occupationMatrix twoCycle+                `shouldSatisfy` matchesOccupation+                    [ [Nothing, Nothing]+                    , [Nothing, Nothing]+                    ]++        it "shares reachability across each recurrent class" $+            Visit.occupationMatrix recurrentVisitChain+                `shouldSatisfy` matchesOccupation+                    [ [Just (4 / 3), Just (2 / 3), Nothing, Nothing]+                    , [Just (2 / 3), Just (4 / 3), Nothing, Nothing]+                    , [Just 0, Just 0, Nothing, Just 0]+                    , [Just 0, Just 0, Just 0, Nothing]+                    ]++        prop "agrees with totalExpectation entry by entry" $+            forAll (genTransitionRows 3) $ \m ->+                case fromRows m ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left err -> counterexample (show err) False+                    Right p ->+                        case Visit.occupationMatrix p of+                            -- A refused solve is a documented outcome.+                            Left _ -> property True+                            Right rows ->+                                conjoin+                                    [ counterexample+                                        (show (i, j, entry))+                                        (agreesWithSingle entry (Visit.totalExpectationGivenInitialState p j i))+                                    | (i, row) <- zip (finites :: [Finite 3]) rows+                                    , (j, entry) <- zip (finites :: [Finite 3]) row+                                    ]++-- Nothing stands for InfiniteExpectation; Just v for a finite entry near v.+matchesOccupation ::+    [[Maybe Double]] ->+    Either error [[Expectation]] ->+    Bool+matchesOccupation _ (Left _) = False+matchesOccupation expected (Right actual) =+    length expected == length actual+        && and (zipWith matchesRow expected actual)+  where+    matchesRow e a = length e == length a && and (zipWith matchesEntry e a)+    matchesEntry (Just v) x = expectationCloseTo v x+    matchesEntry Nothing InfiniteExpectation = True+    matchesEntry Nothing _ = False++agreesWithSingle :: Expectation -> Either error Expectation -> Bool+agreesWithSingle _ (Left _) = True+agreesWithSingle InfiniteExpectation (Right InfiniteExpectation) = True+agreesWithSingle (FiniteExpectation x) (Right (FiniteExpectation y)) = closeTo x y+agreesWithSingle _ _ = False
+ test/Dtmc/Distribution/InterfaceSpec.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE TypeApplications #-}++module Dtmc.Distribution.InterfaceSpec (+    spec,+) where++import Data.Finite (+    Finite,+ )+import Dtmc.Distribution (+    Distribution (..),+    DistributionError,+ )+import Dtmc.Distribution.Map (+    DistributionMap,+    fromList,+    fromDistribution,+ )+import Dtmc.Distribution.Vector qualified as Vector+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+ )++spec :: Spec+spec =+    describe "Distribution interface" $ do+        let vector =+                either (error . show) id $+                    Vector.fromList @(Finite 3) [0.2, 0, 0.8]+            mapDistribution =+                either+                    (error . show)+                    id+                    ( fromList [(0, 0.2), (2, 0.8)] ::+                        Either DistributionError (DistributionMap (Finite 3))+                    )++        it "exposes the same weights and support for both representations" $ do+            distributionWeights vector `shouldBe` distributionWeights mapDistribution+            support vector `shouldBe` support mapDistribution++        it "converts both representations to the same canonical map" $ do+            fromDistribution vector `shouldBe` mapDistribution+            fromDistribution mapDistribution `shouldBe` mapDistribution++        it "converts a dense law without changing its weights" $+            distributionWeights (fromDistribution vector)+                `shouldBe` [(0, 0.2), (2, 0.8)]
+ test/Dtmc/Distribution/MapSpec.hs view
@@ -0,0 +1,109 @@+module Dtmc.Distribution.MapSpec (+    spec,+) where++import Data.Map.Strict qualified as Map+import Dtmc.Distribution (+    Distribution (..),+    DistributionError (..),+ )+import Dtmc.Distribution.Map (+    DistributionMap,+    fromList,+    mapStates,+    pointMass,+    toMap,+ )+import Dtmc.Simplex (+    SimplexError (..),+ )+import Dtmc.TestSupport (+    approxEq,+ )+import Test.Hspec (+    Spec,+    describe,+    expectationFailure,+    it,+    shouldBe,+    shouldSatisfy,+ )++spec :: Spec+spec =+    describe "DistributionMap" $ do+        it "combines duplicates and stores canonical ascending entries" $ do+            let distribution =+                    either (error . show) id $+                        fromList+                            [('b', 0.2), ('a', 0.5), ('b', 0.3), ('c', 0)]+            distributionWeights distribution `shouldBe` [('a', 0.5), ('b', 0.5)]+            support distribution `shouldBe` ['a', 'b']+            Map.toAscList (toMap distribution)+                `shouldBe` [('a', 0.5), ('b', 0.5)]++        it "returns zero for an absent state" $+            probabilityAt (pointMass "present") "absent"+                `shouldBe` 0++        it "pushes weights through a state mapping" $+            case+                ( fromList [(-1, 0.5), (1, 0.5)] ::+                    Either DistributionError (DistributionMap Int)+                )+            of+                Right steps ->+                    distributionWeights (mapStates (+ 10) steps)+                        `shouldBe` [(9, 0.5), (11, 0.5)]+                Left err ->+                    expectationFailure+                        ("expected acceptance, got " <> show err)++        it "combines weights whose states map to the same target" $+            case+                ( fromList [(0, 0.25), (1, 0.25), (2, 0.5)] ::+                    Either DistributionError (DistributionMap Int)+                )+            of+                Right distribution ->+                    distributionWeights (mapStates (`mod` 2) distribution)+                        `shouldBe` [(0, 0.75), (1, 0.25)]+                Left err ->+                    expectationFailure+                        ("expected acceptance, got " <> show err)++        it "rejects an empty law" $+            (fromList [] :: Either DistributionError (DistributionMap Int))+                `shouldSatisfy` either (const True) (const False)++        it "uses the shared error type" $+            fromList ([] :: [(Int, Double)])+                `shouldBe` Left (DistributionError (SumOffBy 0))++        it "removes weights repaired to zero" $+            case fromList [('a', -1e-17), ('b', 1)] of+                Right distribution ->+                    Map.toAscList (toMap distribution)+                        `shouldBe` [('b', 1)]+                Left err ->+                    expectationFailure+                        ("expected acceptance, got " <> show err)++        it "normalises an accepted combined total near one" $+            case fromList [('a', 0.5), ('b', 0.5 - 5e-10)] of+                Right distribution ->+                    approxEq+                        1e-12+                        (sum (Map.elems (toMap distribution)))+                        1+                        `shouldBe` True+                Left err ->+                    expectationFailure+                        ("expected acceptance, got " <> show err)++        it "reports a non-finite combined weight by ascending state index" $+            case fromList [('b', 1), ('a', 0 / 0), ('a', 0)] of+                Left err ->+                    err `shouldBe` DistributionError (NonFiniteEntry 0)+                Right _ ->+                    expectationFailure "expected rejection"
+ test/Dtmc/Distribution/VectorSpec.hs view
@@ -0,0 +1,305 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.Distribution.VectorSpec (+    spec,+) where++import Data.Finite (+    Finite,+ )+import Dtmc.Distribution (+    Distribution (..),+ )+import Dtmc.Distribution.Map qualified as DistributionMap+import Dtmc.Distribution.Vector (+    DistributionVectorError (..),+    fromList,+    toList,+ )+import Dtmc.Simplex (+    SimplexError (..),+ )+import Dtmc.State (+    FiniteState,+    finiteStates,+ )+import Dtmc.TestSupport (+    approxEq,+    bumpSmallest,+    genSimplexPoint,+    testTolerance,+ )+import GHC.Generics (+    Generic,+ )+import Test.Hspec (+    Spec,+    describe,+    expectationFailure,+    it,+    shouldBe,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    counterexample,+    forAll,+    property,+ )++data NamedState = NamedA | NamedB | NamedC+    deriving (Eq, Ord, Show, Generic)++instance FiniteState NamedState++spec :: Spec+spec = do+    describe "fromList" $ do+        it "reports too few weights against the state cardinality" $+            case fromList @NamedState [0.5, 0.5] of+                Left err ->+                    err `shouldBe` WrongLength 3 2+                Right _ ->+                    expectationFailure "expected rejection"++        it "checks the length before the simplex invariant" $+            case fromList @NamedState [0.5, 0.5, 0.5, 0.5] of+                Left err ->+                    err `shouldBe` WrongLength 3 4+                Right _ ->+                    expectationFailure "expected rejection"++        prop "rejects any length other than the state cardinality" $+            forAll (genSimplexPoint 3) $ \entries ->+                case fromList @(Finite 3) (take 2 entries) of+                    Left err ->+                        counterexample (show err) (err == WrongLength 3 2)+                    Right _ ->+                        counterexample "expected rejection" False++        it "reports a total outside tolerance" $+            case fromList @NamedState [0.8, 0, 0] of+                Left (InWeights (SumOffBy total)) ->+                    total `shouldBe` 0.8+                result ->+                    expectationFailure+                        ("expected InWeights SumOffBy, got " <> show result)++        it "rejects an empty vector" $+            case fromList @(Finite 0) [] of+                Left err ->+                    err `shouldBe` InWeights (SumOffBy 0)+                Right _ ->+                    expectationFailure "expected rejection"++        it "clamps a tiny negative rounding error" $+            case fromList @(Finite 2) [-1e-17, 1] of+                Right distribution ->+                    toList distribution+                        `shouldBe` [0, 1]+                Left err ->+                    expectationFailure+                        ("expected acceptance, got " <> show err)++        it "normalises an accepted total near one" $+            case fromList @(Finite 2) [0.5, 0.5 - 5e-10] of+                Right distribution -> do+                    let stored =+                            toList distribution+                    approxEq 1e-12 (sum stored) 1 `shouldBe` True+                    stored == [0.5, 0.5 - 5e-10] `shouldBe` False+                Left err ->+                    expectationFailure+                        ("expected acceptance, got " <> show err)++        it "reports NaN at its coordinate" $+            case fromList @(Finite 2) [0 / 0, 1] of+                Left err ->+                    err `shouldBe` InWeights (NonFiniteEntry 0)+                Right _ ->+                    expectationFailure "expected rejection"++        it "reports infinity at its coordinate" $+            case fromList @(Finite 2) [1, 1 / 0] of+                Left err ->+                    err `shouldBe` InWeights (NonFiniteEntry 1)+                Right _ ->+                    expectationFailure "expected rejection"++        it "reports an entry above one" $+            case fromList @(Finite 2) [1.5, -0.5] of+                Left err ->+                    err+                        `shouldBe` InWeights (EntryAboveOne 0 1.5)+                Right _ ->+                    expectationFailure "expected rejection"++        prop "accepts normalised vectors" $+            forAll (genSimplexPoint 3) $ \entries ->+                case fromList @(Finite 3) entries of+                    Right _ ->+                        property True+                    Left err ->+                        counterexample+                            ("generated vector was rejected: " <> show err)+                            False++        prop "rejects vectors whose sum is too large" $+            forAll (genSimplexPoint 3) $ \entries ->+                case fromList @(Finite 3) (bumpSmallest 1e-6 entries) of+                    Left (InWeights (SumOffBy _)) ->+                        property True+                    result ->+                        counterexample+                            ("expected InWeights SumOffBy, got " <> show result)+                            False++        prop "rejects genuinely negative entries" $+            forAll (genSimplexPoint 3) $ \entries ->+                let invalid =+                        case entries of+                            _ : rest -> (-1e-6) : rest+                            [] -> []+                 in case fromList @(Finite 3) invalid of+                        Left (InWeights (NegativeEntry 0 _)) ->+                            property True+                        result ->+                            counterexample+                                ("expected InWeights NegativeEntry 0, got " <> show result)+                                False++        prop "stores a canonical vector close to the accepted input" $+            forAll (genSimplexPoint 3) $ \entries ->+                case fromList @(Finite 3) entries of+                    Right distribution ->+                        let stored = toList distribution+                         in counterexample ("stored vector: " <> show stored) $+                                property+                                    ( all (\entry -> entry >= 0 && entry <= 1) stored+                                        && approxEq 1e-12 (sum stored) 1+                                        && and+                                            ( zipWith+                                                (approxEq testTolerance)+                                                stored+                                                entries+                                            )+                                    )+                    Left err ->+                        counterexample+                            ("generated vector was rejected: " <> show err)+                            False++    describe "fromList and toList are a positional pair" $ do+        prop "fromList accepts whatever toList produced (random @3)" $+            forAll (genSimplexPoint 3) $ \entries ->+                case fromList @(Finite 3) entries of+                    Right distribution ->+                        case fromList @(Finite 3) (toList distribution) of+                            Right again ->+                                counterexample (show (toList again)) $+                                    property+                                        ( and+                                            ( zipWith+                                                (approxEq testTolerance)+                                                (toList again)+                                                (toList distribution)+                                            )+                                        )+                            Left err ->+                                counterexample+                                    ("round trip was rejected: " <> show err)+                                    False+                    Left err ->+                        counterexample+                            ("generated vector was rejected: " <> show err)+                            False++    describe "labelled construction through the sparse representation" $ do+        it "combines duplicates and fills missing states with zero" $+            case DistributionMap.fromList+                [(NamedC, 0.5), (NamedA, 0.25), (NamedA, 0.25)] of+                Left err ->+                    expectationFailure+                        ("expected acceptance, got " <> show err)+                Right sparse ->+                    case fromList+                        [probabilityAt sparse state | state <- finiteStates] of+                        Right distribution -> do+                            toList distribution `shouldBe` [0.5, 0, 0.5]+                            distributionWeights distribution+                                `shouldBe` [(NamedA, 0.5), (NamedC, 0.5)]+                        Left err ->+                            expectationFailure+                                ("expected acceptance, got " <> show err)++        prop "agrees with the sparse representation coordinate for coordinate" $+            forAll (genSimplexPoint 3) $ \entries ->+                case DistributionMap.fromList+                    (zip (finiteStates @NamedState) entries) of+                    Left err ->+                        counterexample ("sparse rejected: " <> show err) False+                    Right sparse ->+                        case fromList @NamedState entries of+                            Right dense ->+                                counterexample (show (toList dense)) $+                                    property+                                        ( and+                                            [ approxEq+                                                testTolerance+                                                (probabilityAt sparse state)+                                                (probabilityAt dense state)+                                            | state <- finiteStates+                                            ]+                                        )+                            Left err ->+                                counterexample+                                    ("dense rejected: " <> show err)+                                    False++    describe "probabilityAt" $ do+        let known =+                either (error . show) id $+                    fromList @(Finite 3) [0.2, 0.5, 0.3]++        it "returns each coordinate of a known distribution" $ do+            approxEq testTolerance (probabilityAt known 0) 0.2 `shouldBe` True+            approxEq testTolerance (probabilityAt known 1) 0.5 `shouldBe` True+            approxEq testTolerance (probabilityAt known 2) 0.3 `shouldBe` True++        it "reads the first and last valid states" $ do+            approxEq testTolerance (probabilityAt known minBound) 0.2+                `shouldBe` True+            approxEq testTolerance (probabilityAt known maxBound) 0.3+                `shouldBe` True++        it "returns canonical stored values after tolerated repair" $ do+            let tolerated =+                    either (error . show) id $+                        fromList @(Finite 2) [-1e-17, 1]++            probabilityAt tolerated 0 `shouldBe` 0+            probabilityAt tolerated 1 `shouldBe` 1++    describe "named finite states" $ do+        let namedDistribution =+                either (error . show) id $+                    fromList @NamedState [0.2, 0, 0.8]+            indexedDistribution =+                either (error . show) id $+                    fromList @(Finite 3) [0.2, 0, 0.8]++        it "indexes coordinates by state constructors" $ do+            probabilityAt namedDistribution NamedA `shouldBe` 0.2+            probabilityAt namedDistribution NamedB `shouldBe` 0+            probabilityAt namedDistribution NamedC `shouldBe` 0.8++        it "reports weights and support in constructor order" $ do+            distributionWeights namedDistribution+                `shouldBe` [(NamedA, 0.2), (NamedC, 0.8)]+            support namedDistribution `shouldBe` [NamedA, NamedC]++        it "matches the low-level indexed representation coordinate for coordinate" $+            map (probabilityAt namedDistribution) [NamedA, NamedB, NamedC]+                `shouldBe` map (probabilityAt indexedDistribution) [0, 1, 2]
+ test/Dtmc/DynamicsSpec.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.DynamicsSpec (+    spec,+) where++import Data.Finite (+    Finite,+    finites,+ )+import Dtmc.Analysis.FiniteTime (+    stepProbability,+ )+import Dtmc.Distribution (+    distributionWeights,+    probabilityAt,+ )+import Dtmc.Distribution.Map qualified as DistributionMap+import Dtmc.Distribution.Vector (+    DistributionVector,+ )+import Dtmc.Distribution.Vector qualified as Vector+import Dtmc.Dynamics (+    evolveN,+    evolveVector,+    evolveVectorN,+ )+import Dtmc.State (+    FiniteState,+ )+import Dtmc.TestSupport (+    approxDistributionEq,+    approxEq,+    chunksOf,+    genSimplexPoint,+    genTransitionRows,+    testTolerance,+ )+import Dtmc.Transition.Kernel qualified as Kernel+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    fromRows,+ )+import GHC.Generics (+    Generic,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+    shouldSatisfy,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    choose,+    counterexample,+    forAll,+    property,+ )++data NamedPosition = LowerPosition | UpperPosition+    deriving (Eq, Ord, Show, Generic)++instance FiniteState NamedPosition++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++finiteChain :: TransitionMatrix (Finite 3)+finiteChain =+    checked $+        fromRows+            ( chunksOf+                3+                [ 0.5+                , 0.5+                , 0+                , 0+                , 0.2+                , 0.8+                , 1+                , 0+                , 0+                ]+            )++finiteInitial :: DistributionVector (Finite 3)+finiteInitial =+    checked (Vector.fromList [0.6, 0.3, 0.1])++kernelChain :: Kernel.TransitionKernel (Finite 3)+kernelChain =+    Kernel.fromLaws $ \source ->+        checked $+            DistributionMap.fromList+                [ (destination, stepProbability finiteChain source destination)+                | destination <- finites+                ]++mapInitial :: DistributionMap.DistributionMap (Finite 3)+mapInitial =+    checked $+        DistributionMap.fromList+            [(state, probabilityAt finiteInitial state) | state <- finites]++simpleRandomWalk :: Kernel.TransitionKernel Integer+simpleRandomWalk =+    Kernel.fromLaws $ \state ->+        checked+            (DistributionMap.fromList [(state - 1, 0.5), (state + 1, 0.5)])++closeTo :: Double -> Double -> Bool+closeTo = approxEq testTolerance++twoState :: TransitionMatrix (Finite 2)+twoState =+    either (error . show) id $+        fromRows+            (chunksOf 2 [0.9, 0.1, 0.4, 0.6])++namedInitial :: DistributionVector NamedPosition+namedInitial =+    either (error . show) id $+        Vector.fromList @NamedPosition [1, 0]++namedTwoState :: TransitionMatrix NamedPosition+namedTwoState =+    either (error . show) id $+        fromRows @NamedPosition+            (chunksOf 2 [0.9, 0.1, 0.4, 0.6])++spec :: Spec+spec = do+    describe "evolveVector" $ do+        prop "keeps the distribution on the simplex" $+            forAll ((,) <$> genSimplexPoint 3 <*> genTransitionRows 3) $+                \(vector, matrix) ->+                    case (Vector.fromList @(Finite 3) vector, fromRows matrix) of+                        (Right mu, Right p) ->+                            case Vector.fromList @(Finite 3)+                                (Vector.toList (evolveVector mu p)) of+                                Right _ ->+                                    property True+                                Left err ->+                                    counterexample+                                        ("evolved distribution left the simplex: " <> show err)+                                        False+                        result ->+                            counterexample+                                ("generated input was rejected: " <> show result)+                                False++        it "matches a hand-computed two-state step" $ do+            let mu =+                    either (error . show) id $+                        Vector.fromList @(Finite 2) [1, 0]++            Vector.toList (evolveVector mu twoState)+                `shouldBe` [0.9, 0.1]++        it "preserves named states while evolving the dense vector" $ do+            probabilityAt (evolveVector namedInitial namedTwoState) LowerPosition+                `shouldBe` 0.9+            probabilityAt (evolveVector namedInitial namedTwoState) UpperPosition+                `shouldBe` 0.1++    describe "evolveVectorN" $ do+        it "leaves a distribution unchanged after zero steps" $ do+            let mu =+                    either (error . show) id $+                        Vector.fromList @(Finite 2) [0.25, 0.75]++            approxDistributionEq+                1e-12+                (evolveVectorN 0 mu twoState)+                mu+                `shouldBe` True++        prop "agrees with iterating evolveVector"+            $ forAll+                ( (,,)+                    <$> choose (0, 6 :: Int)+                    <*> genSimplexPoint 3+                    <*> genTransitionRows 3+                )+            $ \(k, vector, matrix) ->+                case (Vector.fromList @(Finite 3) vector, fromRows matrix) of+                    (Right mu, Right p) ->+                        let iterated =+                                iterate (`evolveVector` p) mu !! k+                         in property $+                                approxDistributionEq+                                    1e-9+                                    (evolveVectorN (fromIntegral k) mu p)+                                    iterated+                    result ->+                        counterexample+                            ("generated input was rejected: " <> show result)+                            False++        prop "composes m steps then n steps"+            $ forAll+                ( (,,,)+                    <$> choose (0, 4 :: Int)+                    <*> choose (0, 4 :: Int)+                    <*> genSimplexPoint 3+                    <*> genTransitionRows 3+                )+            $ \(m, n, vector, matrix) ->+                case (Vector.fromList @(Finite 3) vector, fromRows matrix) of+                    (Right mu, Right p) ->+                        property $+                            approxDistributionEq+                                1e-9+                                (evolveVectorN (fromIntegral (m + n)) mu p)+                                ( evolveVectorN+                                    (fromIntegral n)+                                    (evolveVectorN (fromIntegral m) mu p)+                                    p+                                )+                    result ->+                        counterexample+                            ("generated input was rejected: " <> show result)+                            False++    describe "evolve/evolveN" $ do+        it "evolves an infinite-state random walk without enumerating its state space" $+            distributionWeights+                (evolveN 2 (DistributionMap.pointMass 0) simpleRandomWalk)+                `shouldBe` [(-2, 0.25), (0, 0.5), (2, 0.25)]++        it "agrees across equivalent matrix and kernel representations" $+            sequence_+                [ probabilityAt (evolveN time mapInitial kernelChain) state+                    `shouldSatisfy` closeTo+                        (probabilityAt (evolveVectorN time finiteInitial finiteChain) state)+                | time <- [0 .. 4]+                , state <- finites :: [Finite 3]+                ]
+ test/Dtmc/IntegrationSpec.hs view
@@ -0,0 +1,321 @@+{-# LANGUAGE DeriveGeneric #-}++module Dtmc.IntegrationSpec (+    spec,+) where++import Dtmc.Analysis.Classification (+    absorbingStates,+    reachesAny,+ )+import Dtmc.Analysis.Event (+    DiscreteEvent (..),+ )+import Dtmc.Analysis.Expectation (+    Expectation (..),+ )+import Dtmc.Analysis.FiniteTime qualified as FT+import Dtmc.Analysis.HittingTime qualified as Hit+import Dtmc.Analysis.Stationary (+    stationaryDistributions,+ )+import Dtmc.Analysis.VisitCount qualified as Visit+import Dtmc.Distribution (+    Distribution (..),+ )+import Dtmc.Distribution.Vector (+    DistributionVector,+ )+import Dtmc.Distribution.Vector qualified as Vector+import Dtmc.State (+    FiniteState,+ )+import Dtmc.TestSupport (+    chunksOf,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    fromRows,+ )+import GHC.Generics (+    Generic,+ )+import Numeric.Natural (+    Natural,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+ )++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++data CafeState+    = Thinking+    | Menu+    | Drink+    | Food+    | PlainWaffle+    | ChocolateWaffle+    | Leave+    deriving (Eq, Ord, Show, Generic)++instance FiniteState CafeState++data FruitState+    = Apple+    | Pear+    | Banana+    | Mango+    | Kiwi+    | Watermelon+    | Grapefruit+    deriving (Eq, Ord, Show, Generic)++instance FiniteState FruitState++data Weather = Dry | Wet+    deriving (Eq, Ord, Show, Generic)++instance FiniteState Weather++weatherTransition :: TransitionMatrix Weather+weatherTransition =+    checked+        ( fromRows+            (chunksOf 2 [0.9, 0.1, 0.4, 0.6])+        )++weatherStationary :: DistributionVector Weather+weatherStationary =+    case checked (stationaryDistributions weatherTransition) of+        [(_, distribution)] -> distribution+        _ -> error "weather transition does not have a unique stationary distribution"++fruitTransition :: TransitionMatrix FruitState+fruitTransition =+    checked+        ( fromRows+            ( chunksOf+                7+                [ 0+                , 0+                , 1 / 2+                , 1 / 2+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 1 / 3+                , 1 / 3+                , 1 / 3+                , 0+                , 0+                , 0+                , 0+                , 0+                , 2 / 3+                , 1 / 3+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 0+                ]+            )+        )++appleToMangoProbability :: Int -> Double+appleToMangoProbability n =+    5 / 7 - 3 / 14 * ((-(1 / 6)) ^ n)++mangoToPearProbability :: Int -> Double+mangoToPearProbability n =+    3 / 7 - 2 / 21 * ((-(1 / 6)) ^ n)++cafeInitial :: DistributionVector CafeState+cafeInitial =+    checked+        ( Vector.fromList [1, 0, 0, 0, 0, 0, 0]+        )++cafeTransition :: TransitionMatrix CafeState+cafeTransition =+    checked+        ( fromRows+            ( chunksOf+                7+                [ 0+                , 1 / 5+                , 0+                , 1 / 5+                , 1 / 5+                , 1 / 5+                , 1 / 5+                , 1 / 5+                , 0+                , 2 / 5+                , 0+                , 2 / 5+                , 0+                , 0+                , 0+                , 0+                , 0+                , 1 / 2+                , 0+                , 0+                , 1 / 2+                , 1 / 2+                , 0+                , 0+                , 0+                , 0+                , 1 / 2+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 1+                , 0+                , 0+                , 0+                , 0+                , 0+                , 0+                , 1+                ]+            )+        )++spec :: Spec+spec =+    describe "public module integration" $ do+        it "computes a stationary distribution" $ do+            abs (probabilityAt weatherStationary Dry - 0.8) < 1e-12+                `shouldBe` True+            abs (probabilityAt weatherStationary Wet - 0.2) < 1e-12+                `shouldBe` True++        it "matches the apple-to-mango transition closed form" $+            mapM_+                ( \n ->+                    abs+                        ( FT.nStepProbability+                            (3 * n + 1)+                            fruitTransition+                            Apple+                            Mango+                            - appleToMangoProbability (fromIntegral n)+                        )+                        < 1e-12+                        `shouldBe` True+                )+                ([0, 1, 2, 3, 675] :: [Natural])++        it "matches the mango-to-pear transition closed form" $+            mapM_+                ( \n ->+                    abs+                        ( FT.nStepProbability+                            (3 * n + 2)+                            fruitTransition+                            Mango+                            Pear+                            - mangoToPearProbability (fromIntegral n)+                        )+                        < 1e-12+                        `shouldBe` True+                )+                ([0, 1, 2, 3, 4] :: [Natural])++        it "runs the seven-state cafe analysis entirely with named states" $ do+            probabilityAt cafeInitial Thinking `shouldBe` 1+            reachesAny cafeTransition Thinking [Leave] `shouldBe` True+            absorbingStates cafeTransition `shouldBe` [Leave]+            abs+                (checked (Hit.eventualProbabilityGivenInitialState cafeTransition [Leave] Thinking) - 1)+                < 1e-12+                `shouldBe` True+            abs+                ( checked+                    (Hit.eventualProbabilityGivenInitialState cafeTransition [Drink] Thinking)+                    - 4 / 43+                )+                < 1e-12+                `shouldBe` True+            abs+                ( checked+                    ( Hit.raceProbabilityGivenInitialState+                        cafeTransition+                        [PlainWaffle, ChocolateWaffle]+                        [Drink, Leave]+                        Thinking+                    )+                    - 29 / 43+                )+                < 1e-12+                `shouldBe` True++        it "uses qualified finite-horizon visit-count analysis" $+            Visit.boundedExpectation 1 cafeInitial cafeTransition (== Thinking)+                `shouldBe` 1++        it "uses qualified infinite-horizon total visit-count analysis" $ do+            checked (Visit.infiniteProbabilityGivenInitialState weatherTransition Dry Wet)+                `shouldBe` 1+            checked (Visit.totalProbabilityGivenInitialState (EqualTo 1) weatherTransition Dry Wet)+                `shouldBe` 0+            checked (Visit.totalExpectationGivenInitialState weatherTransition Dry Wet)+                `shouldBe` InfiniteExpectation++        it "uses qualified conditional-probability errors" $+            FT.probabilityGiven+                cafeInitial+                cafeTransition+                []+                [FT.At 0 Leave]+                `shouldBe` Left FT.ZeroProbabilityCondition++        it "uses qualified timed-observation probabilities" $+            FT.probability cafeInitial cafeTransition [FT.At 0 Thinking]+                `shouldBe` 1
+ test/Dtmc/SimulationSpec.hs view
@@ -0,0 +1,287 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.SimulationSpec (+    spec,+) where++import Control.Monad (+    replicateM,+ )+import Control.Monad.ST (+    runST,+ )+import Data.Finite (+    Finite,+ )+import Dtmc.Distribution (+    Distribution (..),+ )+import Dtmc.Distribution.Map (+    pointMass,+    fromDistribution,+ )+import Dtmc.Distribution.Vector qualified as Vector+import Dtmc.Simulation (+    SimulationError (..),+    sample,+    simulate,+    step,+ )+import Dtmc.State (FiniteState)+import Dtmc.TestSupport (+    chunksOf,+ )+import Dtmc.Transition.Kernel qualified as Kernel+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    fromRows,+ )+import GHC.Generics (Generic)+import Numeric.Natural (+    Natural,+ )+import System.Random.MWC qualified as MWC+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+ )++data NamedSample = FirstSample | SecondSample | ThirdSample+    deriving (Eq, Ord, Show, Generic)++instance FiniteState NamedSample++newtype UncheckedDistribution+    = UncheckedDistribution [(Int, Double)]++instance Distribution UncheckedDistribution where+    type DistributionState UncheckedDistribution = Int++    probabilityAt (UncheckedDistribution entries) state =+        sum+            [ weight+            | (storedState, weight) <- entries+            , storedState == state+            ]++    distributionWeights (UncheckedDistribution entries) = entries++checkedSimulation :: (Monad m) => m (Either SimulationError value) -> m value+checkedSimulation action = do+    result <- action+    pure (either (error . show) id result)++cyclicThree :: TransitionMatrix (Finite 3)+cyclicThree =+    either (error . show) id $+        fromRows+            ( chunksOf+                3+                [ 0+                , 1+                , 0+                , 0+                , 0+                , 1+                , 1+                , 0+                , 0+                ]+            )++namedCyclicThree :: TransitionMatrix NamedSample+namedCyclicThree =+    either (error . show) id $+        fromRows @NamedSample+            (chunksOf 3 [0, 1, 0, 0, 0, 1, 1, 0, 0])++absorbingTwo :: TransitionMatrix (Finite 2)+absorbingTwo =+    either (error . show) id $+        fromRows+            ( chunksOf+                2+                [ 1+                , 0+                , 0.3+                , 0.7+                ]+            )++threeCycleOrbit :: [Finite 3]+threeCycleOrbit = runST $ do+    generator <- MWC.create+    first <- checkedSimulation (step cyclicThree 0 generator)+    second <- checkedSimulation (step cyclicThree first generator)+    third <- checkedSimulation (step cyclicThree second generator)+    pure [first, second, third]++namedThreeCycleOrbit :: [NamedSample]+namedThreeCycleOrbit = runST $ do+    generator <- MWC.create+    first <- checkedSimulation (step namedCyclicThree FirstSample generator)+    second <- checkedSimulation (step namedCyclicThree first generator)+    third <- checkedSimulation (step namedCyclicThree second generator)+    pure [first, second, third]++absorbingSamples :: [Finite 2]+absorbingSamples = runST $ do+    generator <- MWC.create+    replicateM 50 (checkedSimulation (step absorbingTwo 0 generator))++pointMassSamples :: [Finite 3]+pointMassSamples = runST $ do+    generator <- MWC.create+    let distribution =+            either (error . show) id $+                Vector.fromList @(Finite 3) [0, 1, 0]+    replicateM 20 (checkedSimulation (sample distribution generator))++namedPointMassSamples :: [NamedSample]+namedPointMassSamples = runST $ do+    generator <- MWC.create+    let distribution =+            either (error . show) id $+                Vector.fromList @NamedSample [0, 1, 0]+    replicateM 20 (checkedSimulation (sample distribution generator))++mapPointMassSamples :: [Natural]+mapPointMassSamples = runST $ do+    generator <- MWC.create+    replicateM 20 (checkedSimulation (sample (pointMass 7) generator))++sampleUnchecked :: [(Int, Double)] -> Either SimulationError Int+sampleUnchecked entries = runST $ do+    generator <- MWC.create+    sample (UncheckedDistribution entries) generator++invalidSampleAndGeneratorState :: (Either SimulationError Int, Bool)+invalidSampleAndGeneratorState = runST $ do+    generator <- MWC.create+    before <- MWC.save generator+    result <- sample (UncheckedDistribution []) generator+    after <- MWC.save generator+    pure (result, before == after)++zeroStepAndGeneratorState :: (Either SimulationError [Finite 3], Bool)+zeroStepAndGeneratorState = runST $ do+    generator <- MWC.create+    before <- MWC.save generator+    result <-+        simulate+            0+            ( error "zero-step simulation evaluated its kernel" ::+                TransitionMatrix (Finite 3)+            )+            0+            generator+    after <- MWC.save generator+    pure (result, before == after)++emptyKernel :: Kernel.TransitionKernel Int+emptyKernel =+    Kernel.fromLaws+        (const (fromDistribution (UncheckedDistribution [])))++spec :: Spec+spec = do+    describe "sample" $ do+        it "samples a dense point mass" $+            pointMassSamples `shouldBe` replicate 20 1++        it "samples a dense point mass as a named state" $+            namedPointMassSamples `shouldBe` replicate 20 SecondSample++        it "samples a map-backed point mass through the same function" $+            mapPointMassSamples `shouldBe` replicate 20 7++        it "repairs a tolerated negative weight" $+            sampleUnchecked [(1, -1e-12), (2, 1)]+                `shouldBe` Right 2++        it "rejects empty stored support" $+            sampleUnchecked []+                `shouldBe` Left EmptySupport++        it "rejects a non-finite weight by index" $ do+            sampleUnchecked [(1, 0 / 0), (2, 1)]+                `shouldBe` Left (NonFiniteWeight 0)+            sampleUnchecked [(1, 1), (2, 1 / 0)]+                `shouldBe` Left (NonFiniteWeight 1)++        it "rejects a weight below the repair tolerance" $+            sampleUnchecked [(1, -1e-6), (2, 1)]+                `shouldBe` Left (NegativeWeight 0 (-1e-6))++        it "rejects a non-positive repaired total" $+            sampleUnchecked [(1, 0), (2, -1e-12)]+                `shouldBe` Left (NonPositiveTotal 0)++        it "rejects overflow in the total" $+            sampleUnchecked+                [(1, 1.7976931348623157e308), (2, 1.7976931348623157e308)]+                `shouldBe` Left NonFiniteTotal++        it "does not advance the generator when validation fails" $ do+            let (result, unchanged) = invalidSampleAndGeneratorState+            result `shouldBe` Left EmptySupport+            unchanged `shouldBe` True++    describe "step" $ do+        it "follows a deterministic three-cycle" $+            threeCycleOrbit `shouldBe` [1, 2, 0]++        it "follows a deterministic cycle over named states" $+            namedThreeCycleOrbit+                `shouldBe` [SecondSample, ThirdSample, FirstSample]++        it "never leaves an absorbing state" $+            absorbingSamples `shouldBe` replicate 50 0++        it "runs in ST through PrimMonad" $+            length threeCycleOrbit `shouldBe` 3++        it "returns a transition-law validation failure" $+            runST+                ( do+                    generator <- MWC.create+                    step emptyKernel 0 generator+                )+                `shouldBe` Left EmptySupport++    describe "simulate" $ do+        it "simulates a finite matrix through the shared interface" $+            let trajectory = runST $ do+                    generator <- MWC.create+                    checkedSimulation (simulate 4 cyclicThree 0 generator)+             in trajectory `shouldBe` [0, 1, 2, 0, 1]++        it "returns the initial state plus the requested kernel transitions" $+            let trajectory = runST $ do+                    generator <- MWC.create+                    checkedSimulation+                        ( simulate+                            4+                            ( Kernel.fromLaws+                                (pointMass . (\state -> (state + 1) `mod` (3 :: Int)))+                            )+                            0+                            generator+                        )+             in trajectory `shouldBe` [0, 1, 2, 0, 1]++        it "does not inspect the kernel or advance the generator at zero steps" $ do+            let (result, unchanged) = zeroStepAndGeneratorState+            result `shouldBe` Right [0]+            unchanged `shouldBe` True++        it "stops at the first invalid transition law" $+            runST+                ( do+                    generator <- MWC.create+                    simulate 3 emptyKernel 0 generator+                )+                `shouldBe` Left EmptySupport
+ test/Dtmc/StateSpec.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE EmptyDataDeriving #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.StateSpec (+    spec,+) where++import Data.Finite (+    Finite,+    finites,+    getFinite,+ )+import Data.List (+    sort,+ )+import Data.Proxy (+    Proxy (Proxy),+ )+import Dtmc.State (+    Cardinality,+    FiniteState,+    finiteStates,+    stateAt,+    stateIndex,+ )+import GHC.Generics (+    Generic,+ )+import GHC.TypeNats (+    natVal,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+ )++data Empty+    deriving (Eq, Ord, Show, Generic)++data One = One+    deriving (Eq, Ord, Show, Generic)++data Three = A | B | C+    deriving (Eq, Ord, Show, Generic, FiniteState)++instance FiniteState Empty++instance FiniteState One++spec :: Spec+spec = do+    describe "generic FiniteState" $ do+        it "can be derived directly in the state declaration" $+            finiteStates @Three `shouldBe` [A, B, C]++        it "derives cardinalities for empty, singleton, and sum types" $ do+            natVal (Proxy @(Cardinality Empty)) `shouldBe` 0+            natVal (Proxy @(Cardinality One)) `shouldBe` 1+            natVal (Proxy @(Cardinality Three)) `shouldBe` 3++        it "enumerates states in constructor order" $+            finiteStates @Three `shouldBe` [A, B, C]++        it "uses the same order as a stock Ord instance" $+            finiteStates @Three `shouldBe` sort (finiteStates @Three)++        it "round-trips every state through its finite index" $+            map (stateAt . stateIndex) (finiteStates @Three)+                `shouldBe` finiteStates @Three++        it "round-trips every finite index through its state" $+            map (stateIndex . stateAt @Three) finites `shouldBe` finites++        it "assigns consecutive zero-based indices" $+            map (getFinite . stateIndex) (finiteStates @Three)+                `shouldBe` [0, 1, 2]++        it "supports empty and singleton state types" $ do+            finiteStates @Empty `shouldBe` []+            finiteStates @One `shouldBe` [One]+            stateAt (stateIndex One) `shouldBe` One++        describe "Empty laws" (finiteStateLaws @Empty)+        describe "One laws" (finiteStateLaws @One)+        describe "Three laws" (finiteStateLaws @Three)++    describe "Finite identity instance" $ do+        it "preserves enumeration and both conversions" $ do+            finiteStates @(Finite 3) `shouldBe` finites+            map stateIndex (finites @3) `shouldBe` finites+            map stateAt (finites @3) `shouldBe` finites++        it "supports Finite 0" $+            finiteStates @(Finite 0) `shouldBe` []++        describe "Finite 0 laws" (finiteStateLaws @(Finite 0))+        describe "Finite 3 laws" (finiteStateLaws @(Finite 3))++    describe "base instances" $ do+        it "use their standard constructor order" $ do+            finiteStates @() `shouldBe` [()]+            finiteStates @Bool `shouldBe` [False, True]+            finiteStates @Ordering `shouldBe` [LT, EQ, GT]++        describe "() laws" (finiteStateLaws @())+        describe "Bool laws" (finiteStateLaws @Bool)+        describe "Ordering laws" (finiteStateLaws @Ordering)++finiteStateLaws ::+    forall state.+    (FiniteState state, Show state) =>+    Spec+finiteStateLaws = do+    it "enumerates every finite index in canonical order" $+        finiteStates @state+            `shouldBe` map (stateAt @state) (finites @(Cardinality state))++    it "round-trips every state through its index" $+        map (stateAt . stateIndex) (finiteStates @state)+            `shouldBe` finiteStates @state++    it "round-trips every index through its state" $+        map (stateIndex . stateAt @state) (finites @(Cardinality state))+            `shouldBe` finites @(Cardinality state)++    it "enumerates states in strictly ascending order" $+        and (zipWith (<) states (drop 1 states)) `shouldBe` True+  where+    states = finiteStates @state
+ test/Dtmc/TestSupport.hs view
@@ -0,0 +1,284 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.TestSupport (+    testTolerance,+    approxEq,+    approxDistributionEq,+    approxTransitionMatrixEq,+    genSimplexPoint,+    genTransitionRows,+    chunksOf,+    bumpSmallest,+    bumpSmallestInFirstRow,+    setFirstEntry,+    hitProbabilityByState,+    hitEventualProbabilityByState,+    hitRaceProbabilityByState,+    hitExpectationByState,+    returnProbabilityByState,+    returnEventualProbabilityByState,+    returnExpectationByState,+    visitTotalProbabilityByState,+    visitInfiniteProbabilityByState,+    visitTotalExpectationByState,+    absorptionProbabilityByState,+    absorptionExpectationByState,+) where++import Dtmc.Analysis.Absorption qualified as Absorption+import Dtmc.Analysis.Event (+    DiscreteEvent,+ )+import Dtmc.Analysis.Expectation (+    Expectation,+ )+import Dtmc.Analysis.HittingTime qualified as Hit+import Dtmc.Analysis.LinearSystem (+    LinearSystemError,+ )+import Dtmc.Analysis.ReturnTime qualified as Return+import Dtmc.Analysis.VisitCount qualified as Visit+import Dtmc.Distribution.Vector (+    DistributionVector,+    toList,+ )+import Dtmc.State (+    FiniteState,+    finiteStates,+ )+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    toRows,+ )+import Test.QuickCheck (+    Gen,+    choose,+    frequency,+    vectorOf,+ )++hitProbabilityByState ::+    forall state.+    (FiniteState state) =>+    DiscreteEvent ->+    TransitionMatrix state ->+    [state] ->+    [Double]+hitProbabilityByState event matrix targets =+    [ Hit.probabilityGivenInitialState event matrix (`elem` targets) initial+    | initial <- finiteStates+    ]++hitEventualProbabilityByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    [state] ->+    Either LinearSystemError [Double]+hitEventualProbabilityByState matrix targets =+    traverse+        (Hit.eventualProbabilityGivenInitialState matrix targets)+        finiteStates++hitRaceProbabilityByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    [state] ->+    [state] ->+    Either LinearSystemError [Double]+hitRaceProbabilityByState matrix successful competing =+    traverse+        (Hit.raceProbabilityGivenInitialState matrix successful competing)+        finiteStates++hitExpectationByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    [state] ->+    Either LinearSystemError [Expectation]+hitExpectationByState matrix targets =+    traverse+        (Hit.expectationGivenInitialState matrix targets)+        finiteStates++returnProbabilityByState ::+    forall state.+    (FiniteState state) =>+    DiscreteEvent ->+    TransitionMatrix state ->+    [Double]+returnProbabilityByState event matrix =+    [ Return.probabilityGivenInitialState event matrix initial+    | initial <- finiteStates+    ]++returnEventualProbabilityByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    Either LinearSystemError [Double]+returnEventualProbabilityByState matrix =+    traverse+        (Return.eventualProbabilityGivenInitialState matrix)+        finiteStates++returnExpectationByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    Either LinearSystemError [Expectation]+returnExpectationByState matrix =+    traverse+        (Return.expectationGivenInitialState matrix)+        finiteStates++visitTotalProbabilityByState ::+    forall state.+    (FiniteState state) =>+    DiscreteEvent ->+    TransitionMatrix state ->+    state ->+    Either LinearSystemError [Double]+visitTotalProbabilityByState event matrix target =+    traverse+        (Visit.totalProbabilityGivenInitialState event matrix target)+        finiteStates++visitInfiniteProbabilityByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    Either LinearSystemError [Double]+visitInfiniteProbabilityByState matrix target =+    traverse+        (Visit.infiniteProbabilityGivenInitialState matrix target)+        finiteStates++visitTotalExpectationByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    Either LinearSystemError [Expectation]+visitTotalExpectationByState matrix target =+    traverse+        (Visit.totalExpectationGivenInitialState matrix target)+        finiteStates++absorptionProbabilityByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    state ->+    Either LinearSystemError [Double]+absorptionProbabilityByState matrix target =+    traverse+        (Absorption.probabilityGivenInitialState matrix target)+        finiteStates++absorptionExpectationByState ::+    forall state.+    (FiniteState state) =>+    TransitionMatrix state ->+    Either LinearSystemError [Expectation]+absorptionExpectationByState matrix =+    traverse+        (Absorption.expectationGivenInitialState matrix)+        finiteStates++{- | Absolute slack the tests use when comparing floating-point results. Kept+independent of the library's private validation threshold so a change there+cannot silently mask a regression here; the two happen to share a value.+-}+testTolerance :: Double+testTolerance = 1e-9++{- | Absolute-tolerance comparison of two scalar 'Double' results, matching the+@abs (x - y) <= tolerance@ convention of the vector and matrix helpers.+-}+approxEq :: Double -> Double -> Double -> Bool+approxEq tolerance left right =+    abs (left - right) <= tolerance++genSimplexPoint :: Int -> Gen [Double]+genSimplexPoint dimension = do+    entries <- vectorOf dimension genEntry+    let total = sum entries+    if total == 0+        then genSimplexPoint dimension+        else pure (map (/ total) entries)+  where+    genEntry =+        frequency+            [ (3, pure 0)+            , (7, choose (0, 1000))+            ]++{- | Generate a square grid of weights whose rows are probability vectors,+ready for 'Dtmc.Transition.Matrix.fromRows'.+-}+genTransitionRows :: Int -> Gen [[Double]]+genTransitionRows dimension =+    vectorOf dimension (genSimplexPoint dimension)++-- | Split a flat row-major list into rows of the given width.+chunksOf :: Int -> [value] -> [[value]]+chunksOf width values+    | width <= 0 || null values = []+    | otherwise = row : chunksOf width rest+  where+    (row, rest) = splitAt width values++bumpSmallest :: Double -> [Double] -> [Double]+bumpSmallest _ [] = []+bumpSmallest amount entries =+    zipWith bump [0 :: Int ..] entries+  where+    smallestIndex =+        snd (minimum (zip entries [0 :: Int ..]))++    bump index entry+        | index == smallestIndex = entry + amount+        | otherwise = entry++bumpSmallestInFirstRow ::+    Double ->+    [[Double]] ->+    [[Double]]+bumpSmallestInFirstRow _ [] = []+bumpSmallestInFirstRow amount (row : rows) =+    bumpSmallest amount row : rows++setFirstEntry ::+    Double ->+    [[Double]] ->+    [[Double]]+setFirstEntry value ((_ : rest) : rows) =+    (value : rest) : rows+setFirstEntry _ rows = rows++approxTransitionMatrixEq ::+    Double ->+    TransitionMatrix state ->+    TransitionMatrix state ->+    Bool+approxTransitionMatrixEq tolerance left right =+    and (zipWith close (entries left) (entries right))+  where+    entries = concat . toRows+    close x y = abs (x - y) <= tolerance++approxDistributionEq ::+    Double ->+    DistributionVector state ->+    DistributionVector state ->+    Bool+approxDistributionEq tolerance left right =+    and (zipWith close (entries left) (entries right))+  where+    entries = toList+    close x y = abs (x - y) <= tolerance
+ test/Dtmc/Transition/InterfaceSpec.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE TypeApplications #-}++module Dtmc.Transition.InterfaceSpec (+    spec,+) where++import Data.Finite (+    Finite,+    finites,+ )+import Dtmc.Analysis.FiniteTime (+    stepProbability,+ )+import Dtmc.Distribution qualified as Distribution+import Dtmc.Distribution.Map qualified as DistributionMap+import Dtmc.TestSupport (+    approxEq,+    chunksOf,+    genTransitionRows,+ )+import Dtmc.Transition qualified as Transition+import Dtmc.Transition.Kernel qualified as Kernel+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    TransitionMatrixError,+    fromRows,+ )+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    conjoin,+    counterexample,+    forAll,+ )++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++finiteChain :: TransitionMatrix (Finite 3)+finiteChain =+    checked $+        fromRows+            ( chunksOf+                3+                [ 0.5+                , 0.5+                , 0+                , 0+                , 0.2+                , 0.8+                , 1+                , 0+                , 0+                ]+            )++asTransitionKernel ::+    TransitionMatrix (Finite 3) ->+    Kernel.TransitionKernel (Finite 3)+asTransitionKernel matrix =+    Kernel.fromLaws $ \source ->+        checked $+            DistributionMap.fromList+                [ (destination, stepProbability matrix source destination)+                | destination <- finites+                ]++spec :: Spec+spec =+    describe "Transition interface" $ do+        it "exposes a matrix row as a finite-support transition law" $+            Distribution.distributionWeights (Transition.transitionLaw finiteChain 1)+                `shouldBe` [(1, 0.2), (2, 0.8)]++        it "exposes a source-dependent kernel through the same operation" $+            let kernel =+                    Kernel.fromLaws $ \source ->+                        checked $+                            DistributionMap.fromList+                                [(source, 0.25), (source + 1, 0.75 :: Double)]+             in Distribution.distributionWeights (Transition.transitionLaw kernel (4 :: Int))+                    `shouldBe` [(4, 0.25), (5, 0.75)]++        it "exposes deterministic kernels as point-mass laws" $+            Distribution.distributionWeights+                ( Transition.transitionLaw+                    (Kernel.fromLaws (DistributionMap.pointMass . (+ 1)))+                    (4 :: Int)+                )+                `shouldBe` [(5, 1)]++        prop "gives matrices and equivalent kernels approximately equal laws" $+            forAll (genTransitionRows 3) $ \rawMatrix ->+                case fromRows rawMatrix ::+                        Either TransitionMatrixError (TransitionMatrix (Finite 3)) of+                    Left problem -> counterexample (show problem) False+                    Right matrix ->+                        let kernel = asTransitionKernel matrix+                         in conjoin+                                [ let matrixLaw =+                                        Transition.transitionLaw matrix source+                                      kernelLaw =+                                        Transition.transitionLaw kernel source+                                   in counterexample ("source: " <> show source) $+                                        Distribution.support matrixLaw+                                            == Distribution.support kernelLaw+                                            && and+                                                [ approxEq+                                                    1e-12+                                                    ( Distribution.probabilityAt+                                                        matrixLaw+                                                        destination+                                                    )+                                                    ( Distribution.probabilityAt+                                                        kernelLaw+                                                        destination+                                                    )+                                                | destination <- finites :: [Finite 3]+                                                ]+                                | source <- finites :: [Finite 3]+                                ]
+ test/Dtmc/Transition/KernelSpec.hs view
@@ -0,0 +1,47 @@+module Dtmc.Transition.KernelSpec (+    spec,+) where++import Dtmc.Distribution qualified as Distribution+import Dtmc.Distribution.Map qualified as DistributionMap+import Dtmc.Transition qualified as Transition+import Dtmc.Transition.Kernel qualified as Kernel+import Test.Hspec (+    Spec,+    describe,+    it,+    shouldBe,+ )++checked :: (Show error) => Either error value -> value+checked = either (error . show) id++simpleRandomWalk :: Kernel.TransitionKernel Integer+simpleRandomWalk =+    Kernel.fromLaws $ \state ->+        checked+            (DistributionMap.fromList [(state - 1, 0.5), (state + 1, 0.5)])++spec :: Spec+spec =+    describe "TransitionKernel" $ do+        it "preserves source-dependent transition laws" $+            let kernel =+                    Kernel.fromLaws $ \source ->+                        checked $+                            DistributionMap.fromList+                                [(source - 1, 0.4), (source + 1, 0.6 :: Double)]+             in Distribution.distributionWeights (Transition.transitionLaw kernel (10 :: Integer))+                    `shouldBe` [(9, 0.4), (11, 0.6)]++        it "constructs deterministic point-mass transitions" $+            Distribution.distributionWeights+                ( Transition.transitionLaw+                    (Kernel.fromLaws (DistributionMap.pointMass . (* 2)))+                    (6 :: Integer)+                )+                `shouldBe` [(12, 1)]++        it "supports locally finite laws on an infinite state type" $+            Distribution.distributionWeights (Transition.transitionLaw simpleRandomWalk 0)+                `shouldBe` [(-1, 0.5), (1, 0.5)]
+ test/Dtmc/Transition/MatrixSpec.hs view
@@ -0,0 +1,426 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}++module Dtmc.Transition.MatrixSpec (+    spec,+) where++import Data.Finite (+    Finite,+ )+import Dtmc.Distribution (+    distributionWeights,+ )+import Dtmc.Distribution.Map qualified as DistributionMap+import Dtmc.Distribution.Vector qualified as Vector+import Dtmc.Simplex (SimplexError (..))+import Dtmc.State (+    FiniteState,+ )+import Dtmc.TestSupport (+    approxEq,+    approxTransitionMatrixEq,+    bumpSmallestInFirstRow,+    chunksOf,+    genTransitionRows,+    setFirstEntry,+    testTolerance,+ )+import Dtmc.Transition.Kernel qualified as Kernel+import Dtmc.Transition.Matrix (+    TransitionMatrix,+    TransitionMatrixError (..),+    compose,+    fromKernel,+    fromRows,+    identity,+    power,+    rowAt,+    toRows,+ )+import GHC.Generics (+    Generic,+ )+import Test.Hspec (+    Spec,+    describe,+    expectationFailure,+    it,+    shouldBe,+ )+import Test.Hspec.QuickCheck (+    prop,+ )+import Test.QuickCheck (+    choose,+    conjoin,+    counterexample,+    forAll,+    property,+ )++data NamedPhase = PhaseA | PhaseB | PhaseC+    deriving (Eq, Ord, Show, Generic)++instance FiniteState NamedPhase++cyclicThree :: TransitionMatrix (Finite 3)+cyclicThree =+    either (error . show) id $+        fromRows+            (chunksOf 3 [0, 1, 0, 0, 0, 1, 1, 0, 0])++namedCycle :: TransitionMatrix NamedPhase+namedCycle =+    either (error . show) id $+        fromRows @NamedPhase+            (chunksOf 3 [0, 1, 0, 0, 0, 1, 1, 0, 0])++twoState :: TransitionMatrix (Finite 2)+twoState =+    either (error . show) id $+        fromRows+            (chunksOf 2 [0.9, 0.1, 0.4, 0.6])++twoStateSquared :: TransitionMatrix (Finite 2)+twoStateSquared =+    either (error . show) id $+        fromRows+            (chunksOf 2 [0.85, 0.15, 0.6, 0.4])++spec :: Spec+spec = do+    describe "fromKernel" $ do+        let successor state =+                case state of+                    PhaseA -> PhaseB+                    PhaseB -> PhaseC+                    PhaseC -> PhaseA+            materialised =+                fromKernel+                    (Kernel.fromLaws (DistributionMap.pointMass . successor)) ::+                    TransitionMatrix NamedPhase++        it "materialises a finite deterministic kernel" $+            approxTransitionMatrixEq 0 materialised namedCycle `shouldBe` True++        it "exposes rows without hmatrix types" $+            toRows materialised+                `shouldBe` [[0, 1, 0], [0, 0, 1], [1, 0, 0]]++        it "materialises the empty finite chain" $+            toRows+                ( fromKernel (Kernel.fromLaws DistributionMap.pointMass) ::+                    TransitionMatrix (Finite 0)+                )+                `shouldBe` []++    describe "fromRows" $ do+        it "constructs the empty finite chain" $+            case fromRows @(Finite 0) [] of+                Right transitionMatrix -> toRows transitionMatrix `shouldBe` []+                Left err -> expectationFailure ("expected acceptance, got " <> show err)++        it "reports too few rows before inspecting their widths" $+            case fromRows @(Finite 2) [[1]] of+                Left err -> err `shouldBe` WrongRowCount 2 1+                Right _ -> expectationFailure "expected rejection"++        it "reports too many rows before inspecting their widths" $+            case fromRows @(Finite 2) [[1, 0], [0, 1], [1]] of+                Left err -> err `shouldBe` WrongRowCount 2 3+                Right _ -> expectationFailure "expected rejection"++        it "reports the first row with the wrong width" $+            case fromRows @(Finite 2) [[1, 0, 0], [1]] of+                Left err -> err `shouldBe` WrongRowWidth 0 2 3+                Right _ -> expectationFailure "expected rejection"++        it "reports a later row with the wrong width" $+            case fromRows @(Finite 2) [[1, 0], [1]] of+                Left err -> err `shouldBe` WrongRowWidth 1 2 1+                Right _ -> expectationFailure "expected rejection"++        prop "stores canonical rows close to the accepted input" $+            forAll (genTransitionRows 3) $ \matrix ->+                case fromRows @(Finite 3) matrix of+                    Right transitionMatrix ->+                        let storedRows = toRows transitionMatrix+                            inputRows = matrix+                            closeRow left right =+                                and+                                    ( zipWith+                                        (approxEq testTolerance)+                                        left+                                        right+                                    )+                         in counterexample ("stored rows: " <> show storedRows) $+                                property+                                    ( all+                                        ( \row ->+                                            all+                                                (\entry -> entry >= 0 && entry <= 1)+                                                row+                                                && approxEq 1e-12 (sum row) 1+                                        )+                                        storedRows+                                        && and (zipWith closeRow storedRows inputRows)+                                    )+                    Left err ->+                        counterexample+                            ("generated matrix was rejected: " <> show err)+                            False++        it "canonicalises tolerated error independently in each row" $+            case fromRows @(Finite 2)+                (chunksOf 2 [-5e-10, 1 + 5e-10, 0.5, 0.5 - 5e-10]) of+                Right transitionMatrix -> do+                    let rows = toRows transitionMatrix+                    case rows of+                        firstRow : secondRow : _ -> do+                            firstRow `shouldBe` [0, 1]+                            approxEq 1e-12 (sum secondRow) 1 `shouldBe` True+                        _ ->+                            expectationFailure "expected two rows"+                Left err ->+                    expectationFailure+                        ("expected acceptance, got " <> show err)++        it "reports a non-finite coordinate with its row and column" $+            case fromRows @(Finite 2)+                (chunksOf 2 [1, 0, 0, 1 / 0]) of+                Left err ->+                    err `shouldBe` InRow 1 (NonFiniteEntry 1)+                Right _ ->+                    expectationFailure "expected rejection"++        prop "identifies a row whose sum is invalid" $+            forAll (genTransitionRows 3) $ \matrix ->+                let invalid = bumpSmallestInFirstRow 1e-6 matrix+                 in case fromRows @(Finite 3) invalid of+                        Left (InRow 0 (SumOffBy _)) ->+                            property True+                        result ->+                            counterexample+                                ("expected InRow 0 SumOffBy, got " <> show result)+                                False++        prop "identifies a negative entry by row and column" $+            forAll (genTransitionRows 3) $ \matrix ->+                let invalid = setFirstEntry (-1e-6) matrix+                 in case fromRows @(Finite 3) invalid of+                        Left (InRow 0 (NegativeEntry 0 _)) ->+                            property True+                        result ->+                            counterexample+                                ("expected InRow 0 NegativeEntry 0, got " <> show result)+                                False++    describe "compose" $ do+        prop "is closed under multiplication"+            $ forAll+                ((,) <$> genTransitionRows 3 <*> genTransitionRows 3)+            $ \(left, right) ->+                case (fromRows @(Finite 3) left, fromRows @(Finite 3) right) of+                    (Right leftMatrix, Right rightMatrix) ->+                        case fromRows @(Finite 3)+                            (toRows (compose leftMatrix rightMatrix)) of+                            Right _ ->+                                property True+                            Left err ->+                                counterexample+                                    ("matrix product was rejected: " <> show err)+                                    False+                    result ->+                        counterexample+                            ("generated matrix was rejected: " <> show result)+                            False++        prop "approximately equals itself at zero tolerance" $+            forAll (genTransitionRows 3) $ \matrix ->+                case fromRows @(Finite 3) matrix of+                    Right transitionMatrix ->+                        property+                            ( approxTransitionMatrixEq+                                0+                                transitionMatrix+                                transitionMatrix+                            )+                    Left err ->+                        counterexample+                            ("generated matrix was rejected: " <> show err)+                            False++    describe "TransitionMatrix Semigroup" $ do+        prop "composition is approximately associative"+            $ forAll+                ( (,,)+                    <$> genTransitionRows 3+                    <*> genTransitionRows 3+                    <*> genTransitionRows 3+                )+            $ \(matrixA, matrixB, matrixC) ->+                case ( fromRows @(Finite 3) matrixA+                     , fromRows @(Finite 3) matrixB+                     , fromRows @(Finite 3) matrixC+                     ) of+                    (Right a, Right b, Right c) ->+                        property $+                            approxTransitionMatrixEq+                                1e-9+                                ((a <> b) <> c)+                                (a <> (b <> c))+                    result ->+                        counterexample+                            ("generated matrices were rejected: " <> show result)+                            False++    describe "TransitionMatrix Monoid" $ do+        prop "has a left identity" $+            forAll (genTransitionRows 3) $ \matrix ->+                case fromRows @(Finite 3) matrix of+                    Right p ->+                        property $+                            approxTransitionMatrixEq+                                1e-12+                                (mempty <> p)+                                p+                    Left err ->+                        counterexample+                            ("generated matrix was rejected: " <> show err)+                            False++        prop "has a right identity" $+            forAll (genTransitionRows 3) $ \matrix ->+                case fromRows @(Finite 3) matrix of+                    Right p ->+                        property $+                            approxTransitionMatrixEq+                                1e-12+                                (p <> mempty)+                                p+                    Left err ->+                        counterexample+                            ("generated matrix was rejected: " <> show err)+                            False++        it "uses the identity transition matrix as mempty" $+            approxTransitionMatrixEq+                1e-12+                (mempty :: TransitionMatrix (Finite 2))+                identity+                `shouldBe` True++    describe "power" $ do+        it "returns the identity at exponent zero" $+            approxTransitionMatrixEq+                1e-12+                (power 0 twoState)+                identity+                `shouldBe` True++        it "returns the matrix itself at exponent one" $+            approxTransitionMatrixEq+                1e-12+                (power 1 twoState)+                twoState+                `shouldBe` True++        it "matches a hand-computed square" $+            approxTransitionMatrixEq+                1e-9+                (power 2 twoState)+                twoStateSquared+                `shouldBe` True++        prop "stays stochastic for small exponents" $+            forAll ((,) <$> choose (0, 6 :: Int) <*> genTransitionRows 3) $+                \(k, matrix) ->+                    case fromRows @(Finite 3) matrix of+                        Right p ->+                            case fromRows @(Finite 3)+                                (toRows (power (fromIntegral k) p)) of+                                Right _ ->+                                    property True+                                Left err ->+                                    counterexample+                                        ("power left the stochastic set: " <> show err)+                                        False+                        Left err ->+                            counterexample+                                ("generated matrix was rejected: " <> show err)+                                False++        prop "satisfies the power addition law"+            $ forAll+                ( (,,)+                    <$> choose (0, 6 :: Int)+                    <*> choose (0, 6 :: Int)+                    <*> genTransitionRows 3+                )+            $ \(m, n, matrix) ->+                case fromRows @(Finite 3) matrix of+                    Right p ->+                        property $+                            approxTransitionMatrixEq+                                1e-9+                                (power (fromIntegral (m + n)) p)+                                ( power (fromIntegral m) p+                                    <> power (fromIntegral n) p+                                )+                    Left err ->+                        counterexample+                            ("generated matrix was rejected: " <> show err)+                            False++    describe "rowAt" $ do+        it "reads rows rather than columns" $+            Vector.toList (rowAt cyclicThree 0)+                `shouldBe` [0, 1, 0]++        it "returns each row of the three-cycle" $ do+            let row index = Vector.toList (rowAt cyclicThree index)++            row 0 `shouldBe` [0, 1, 0]+            row 1 `shouldBe` [0, 0, 1]+            row 2 `shouldBe` [1, 0, 0]++        prop "always returns a valid distribution" $+            forAll (genTransitionRows 3) $ \matrix ->+                case fromRows @(Finite 3) matrix of+                    Right transitionMatrix ->+                        conjoin+                            [ case Vector.fromList @(Finite 3)+                                (Vector.toList (rowAt transitionMatrix index)) of+                                Right _ ->+                                    property True+                                Left err ->+                                    counterexample+                                        ("row was rejected: " <> show err)+                                        False+                            | index <- [0 .. 2]+                            ]+                    Left err ->+                        counterexample+                            ("generated matrix was rejected: " <> show err)+                            False++    describe "named finite states" $ do+        it "returns a row labelled by named constructors" $+            distributionWeights (rowAt namedCycle PhaseA)+                `shouldBe` [(PhaseB, 1)]++        it "preserves the named state type through powers" $+            distributionWeights (rowAt (power 2 namedCycle) PhaseA)+                `shouldBe` [(PhaseC, 1)]++        it "provides a named identity matrix" $+            distributionWeights (rowAt (identity @NamedPhase) PhaseB)+                `shouldBe` [(PhaseB, 1)]++        it "composes matrices without changing their named state type" $+            approxTransitionMatrixEq+                0+                (namedCycle <> identity)+                namedCycle+                `shouldBe` True
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}