deltaq 1.0.1.0 → 1.1.0.0

raw patch · 16 files changed

+1244/−45 lines, 16 filesdep +diagrams-libdep +diagrams-svgdep ~QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies added: diagrams-lib, diagrams-svg

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• deltaq.cabal +14/−2
• images/hops.svg +3/−0
• src/DeltaQ.hs +28/−1
• src/DeltaQ/Class.hs +66/−39
• src/DeltaQ/Diagram.hs +19/−0
• src/DeltaQ/Diagram/Internal.hs +502/−0
• src/DeltaQ/Expr.hs +356/−0
• src/DeltaQ/Methods.hs +1/−0
• src/DeltaQ/PiecewisePolynomial.hs +5/−2
• src/DeltaQ/Plot.hs +2/−1
• test/DeltaQ/DiagramSpec.hs +84/−0
• test/DeltaQ/ExprSpec.hs +69/−0
• test/DeltaQ/Gen/Term.hs +81/−0
• test/DeltaQ/MethodsSpec.hs +1/−0
• test/DeltaQ/PiecewisePolynomialSpec.hs +1/−0

@@ -1,5 +1,17 @@ # Revision history for `deltaq` +## 1.1.0.0 — 2025-10-14++### Added++* Add `DeltaQ.Expr` with a data type `O` that represents outcome expressions.+* Add `DeltaQ.Diagram` for rendering outcome expressions as diagrams.++### Changed++* Add a new class `ProbabilisticOutcome` and remove its fields+  `Probability`, `choice` and `choices` from the `DeltaQ` class.+ ## 1.0.1.0 — 2025-09-26  ### Added

@@ -5,7 +5,7 @@ -- PVP summary:  +-+------- breaking API changes --               | | +----- non-breaking API additions --               | | | +--- code changes with no API change-version:         1.0.1.0+version:         1.1.0.0 synopsis:        Framework for ∆Q System Development description:   ∆Q System Development is a paradigm for developing distributed systems@@ -22,17 +22,21 @@   * outcomes and their combinations   * evaluating the performance characteristics of outcomes,     specifically the probability distribution of their completion times+  * rendering outcomes as diagrams  category:        DeltaQ, Distributed Systems, Probability homepage:        https://github.com/DeltaQ-SD/deltaq license:         BSD-3-Clause license-file:    LICENSE-copyright:       Predictable Network Solutions Ltd., 2003-2025+copyright:+  Predictable Network Solutions Ltd., 2003-2025+  PLWORKZ R&D, 2025 author:          Neil Davies, Heinrich Apfelmus maintainer:      neil.davies@pnsol.ccom extra-doc-files:   CHANGELOG.md   README.md+  images/hops.svg  tested-with:     GHC ==8.10.7 || ==9.6.7 || ==9.10.3 @@ -54,10 +58,15 @@     , deepseq                 >=1.4.4.0  && <1.6     , lattices                >=2.2      && <2.3     , probability-polynomial  >=1.0.1    && <1.1+    , diagrams-lib            >=1.4.5    && <1.6+    , diagrams-svg            >=1.5      && <1.6    exposed-modules:     DeltaQ     DeltaQ.Class+    DeltaQ.Diagram+    DeltaQ.Diagram.Internal+    DeltaQ.Expr     DeltaQ.Methods     DeltaQ.PiecewisePolynomial     DeltaQ.Plot@@ -78,6 +87,9 @@   main-is:            Spec.hs   other-modules:     DeltaQ.ClassSpec+    DeltaQ.DiagramSpec+    DeltaQ.ExprSpec+    DeltaQ.Gen.Term     DeltaQ.MethodsSpec     DeltaQ.PiecewisePolynomialSpec 

@@ -0,0 +1,3 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"+    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"><svg font-size="1" viewBox="0.0 0.0 700.0 234.34782608695656" stroke="rgb(0,0,0)" xmlns="http://www.w3.org/2000/svg" width="700.0000" stroke-opacity="1" height="234.3478" version="1.1" xmlns:xlink="http://www.w3.org/1999/xlink"><defs></defs><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 616.3043,41.0870 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 654.3478,41.0870 l -38.0435,152.1739 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 654.3478,41.0870 l -38.0435,76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 654.3478,41.0870 h -38.0435 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 540.2174,193.2609 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" fill="rgb(255,255,255)" stroke="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="4.0"><path d="M 611.7391,193.2609 c 0.0000,-18.4895 -14.9887,-33.4783 -33.4783 -33.4783c -18.4895,-0.0000 -33.4783,14.9887 -33.4783 33.4783c -0.0000,18.4895 14.9887,33.4783 33.4783 33.4783c 18.4895,0.0000 33.4783,-14.9887 33.4783 -33.4783Z"/></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="22.826086956521742px" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,578.2609,193.2609)" stroke="none" dominant-baseline="middle" text-anchor="middle">long</text></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 540.2174,117.1739 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" fill="rgb(255,255,255)" stroke="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="4.0"><path d="M 611.7391,117.1739 c 0.0000,-18.4895 -14.9887,-33.4783 -33.4783 -33.4783c -18.4895,-0.0000 -33.4783,14.9887 -33.4783 33.4783c -0.0000,18.4895 14.9887,33.4783 33.4783 33.4783c 18.4895,0.0000 33.4783,-14.9887 33.4783 -33.4783Z"/></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="22.826086956521742px" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,578.2609,117.1739)" stroke="none" dominant-baseline="middle" text-anchor="middle">mid</text></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 540.2174,41.0870 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" fill="rgb(255,255,255)" stroke="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="4.0"><path d="M 611.7391,41.0870 c 0.0000,-18.4895 -14.9887,-33.4783 -33.4783 -33.4783c -18.4895,-0.0000 -33.4783,14.9887 -33.4783 33.4783c -0.0000,18.4895 14.9887,33.4783 33.4783 33.4783c 18.4895,0.0000 33.4783,-14.9887 33.4783 -33.4783Z"/></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="22.826086956521742px" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,578.2609,41.0870)" stroke="none" dominant-baseline="middle" text-anchor="middle">short</text></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 464.1304,41.0870 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="15.217391304347828px" fill="rgb(0,128,128)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,517.3913,185.6522)" stroke="none" dominant-baseline="middle" text-anchor="middle">0.33</text></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="15.217391304347828px" fill="rgb(0,128,128)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,517.3913,109.5652)" stroke="none" dominant-baseline="middle" text-anchor="middle">0.33</text></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="15.217391304347828px" fill="rgb(0,128,128)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,517.3913,18.2609)" stroke="none" dominant-baseline="middle" text-anchor="middle">0.33</text></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 502.1739,41.0870 l 38.0435,152.1739 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 502.1739,41.0870 l 38.0435,76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 502.1739,41.0870 h 38.0435 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" fill="rgb(255,255,255)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 517.3913,56.3043 l -0.0000,-30.4348 h -30.4348 l -0.0000,30.4348 Z"/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.7"><path d="M 502.1739,44.1304 h -10.0435 h 18.2609 l -6.0870,4.5652 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.7"><path d="M 502.1739,38.0435 h 10.0435 h -18.2609 l 6.0870,-4.5652 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 388.0435,41.0870 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 426.0870,41.0870 l -38.0435,152.1739 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 426.0870,41.0870 l -38.0435,76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 426.0870,41.0870 h -38.0435 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 311.9565,193.2609 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" fill="rgb(255,255,255)" stroke="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="4.0"><path d="M 383.4783,193.2609 c 0.0000,-18.4895 -14.9887,-33.4783 -33.4783 -33.4783c -18.4895,-0.0000 -33.4783,14.9887 -33.4783 33.4783c -0.0000,18.4895 14.9887,33.4783 33.4783 33.4783c 18.4895,0.0000 33.4783,-14.9887 33.4783 -33.4783Z"/></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="22.826086956521742px" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,193.2609)" stroke="none" dominant-baseline="middle" text-anchor="middle">long</text></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 311.9565,117.1739 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" fill="rgb(255,255,255)" stroke="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="4.0"><path d="M 383.4783,117.1739 c 0.0000,-18.4895 -14.9887,-33.4783 -33.4783 -33.4783c -18.4895,-0.0000 -33.4783,14.9887 -33.4783 33.4783c -0.0000,18.4895 14.9887,33.4783 33.4783 33.4783c 18.4895,0.0000 33.4783,-14.9887 33.4783 -33.4783Z"/></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="22.826086956521742px" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,117.1739)" stroke="none" dominant-baseline="middle" text-anchor="middle">mid</text></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 311.9565,41.0870 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" fill="rgb(255,255,255)" stroke="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="4.0"><path d="M 383.4783,41.0870 c 0.0000,-18.4895 -14.9887,-33.4783 -33.4783 -33.4783c -18.4895,-0.0000 -33.4783,14.9887 -33.4783 33.4783c -0.0000,18.4895 14.9887,33.4783 33.4783 33.4783c 18.4895,0.0000 33.4783,-14.9887 33.4783 -33.4783Z"/></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="22.826086956521742px" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,41.0870)" stroke="none" dominant-baseline="middle" text-anchor="middle">short</text></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 235.8696,41.0870 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="15.217391304347828px" fill="rgb(0,128,128)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,289.1304,185.6522)" stroke="none" dominant-baseline="middle" text-anchor="middle">0.33</text></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="15.217391304347828px" fill="rgb(0,128,128)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,289.1304,109.5652)" stroke="none" dominant-baseline="middle" text-anchor="middle">0.33</text></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="15.217391304347828px" fill="rgb(0,128,128)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,289.1304,18.2609)" stroke="none" dominant-baseline="middle" text-anchor="middle">0.33</text></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 273.9130,41.0870 l 38.0435,152.1739 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 273.9130,41.0870 l 38.0435,76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 273.9130,41.0870 h 38.0435 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" fill="rgb(255,255,255)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 289.1304,56.3043 l -0.0000,-30.4348 h -30.4348 l -0.0000,30.4348 Z"/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.7"><path d="M 273.9130,44.1304 h -10.0435 h 18.2609 l -6.0870,4.5652 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.7"><path d="M 273.9130,38.0435 h 10.0435 h -18.2609 l 6.0870,-4.5652 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 159.7826,41.0870 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 197.8261,41.0870 l -38.0435,152.1739 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 197.8261,41.0870 l -38.0435,76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 197.8261,41.0870 h -38.0435 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 83.6957,193.2609 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" fill="rgb(255,255,255)" stroke="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="4.0"><path d="M 155.2174,193.2609 c 0.0000,-18.4895 -14.9887,-33.4783 -33.4783 -33.4783c -18.4895,-0.0000 -33.4783,14.9887 -33.4783 33.4783c -0.0000,18.4895 14.9887,33.4783 33.4783 33.4783c 18.4895,0.0000 33.4783,-14.9887 33.4783 -33.4783Z"/></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="22.826086956521742px" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,121.7391,193.2609)" stroke="none" dominant-baseline="middle" text-anchor="middle">long</text></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 83.6957,117.1739 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" fill="rgb(255,255,255)" stroke="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="4.0"><path d="M 155.2174,117.1739 c 0.0000,-18.4895 -14.9887,-33.4783 -33.4783 -33.4783c -18.4895,-0.0000 -33.4783,14.9887 -33.4783 33.4783c -0.0000,18.4895 14.9887,33.4783 33.4783 33.4783c 18.4895,0.0000 33.4783,-14.9887 33.4783 -33.4783Z"/></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="22.826086956521742px" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,121.7391,117.1739)" stroke="none" dominant-baseline="middle" text-anchor="middle">mid</text></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 83.6957,41.0870 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" fill="rgb(255,255,255)" stroke="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="4.0"><path d="M 155.2174,41.0870 c 0.0000,-18.4895 -14.9887,-33.4783 -33.4783 -33.4783c -18.4895,-0.0000 -33.4783,14.9887 -33.4783 33.4783c -0.0000,18.4895 14.9887,33.4783 33.4783 33.4783c 18.4895,0.0000 33.4783,-14.9887 33.4783 -33.4783Z"/></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="22.826086956521742px" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,121.7391,41.0870)" stroke="none" dominant-baseline="middle" text-anchor="middle">short</text></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 7.6087,41.0870 h 76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="15.217391304347828px" fill="rgb(0,128,128)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,60.8696,185.6522)" stroke="none" dominant-baseline="middle" text-anchor="middle">0.33</text></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="15.217391304347828px" fill="rgb(0,128,128)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,60.8696,109.5652)" stroke="none" dominant-baseline="middle" text-anchor="middle">0.33</text></g><g stroke-linejoin="miter" fill-opacity="1.0" font-size="15.217391304347828px" fill="rgb(0,128,128)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,60.8696,18.2609)" stroke="none" dominant-baseline="middle" text-anchor="middle">0.33</text></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 45.6522,41.0870 l 38.0435,152.1739 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 45.6522,41.0870 l 38.0435,76.0870 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 45.6522,41.0870 h 38.0435 "/></g><g stroke-linejoin="miter" fill-opacity="1.0" fill="rgb(255,255,255)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.6200912481011414"><path d="M 60.8696,56.3043 l -0.0000,-30.4348 h -30.4348 l -0.0000,30.4348 Z"/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.7"><path d="M 45.6522,44.1304 h -10.0435 h 18.2609 l -6.0870,4.5652 "/></g><g stroke-linejoin="miter" fill-opacity="0.0" fill="rgb(0,0,0)" stroke="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-opacity="1.0" stroke-width="1.7"><path d="M 45.6522,38.0435 h 10.0435 h -18.2609 l 6.0870,-4.5652 "/></g></svg>

@@ -9,7 +9,8 @@      * type classes in "DeltaQ.Class" -        * 'Outcome' for outcomes and their combinations+        * 'Outcome' for outcomes and their sequential and parallel composition+        * 'ProbabilisticOutcome' for probabilistic composition of outcomes         * 'DeltaQ' for probability distribution of completion times      * type class instance in "DeltaQ.PiecewisePolynomial"@@ -25,6 +26,13 @@         * 'plotCDFWithQuantiles' for plotting an instance of 'DeltaQ'         with quantiles highlighted. +    * type class instance in "DeltaQ.Expr"++        * @'O'@ represents an outcome expression, that is a symbolic+          representation of an outcome.+    +    * rendering of outcome expressions in "DeltaQ.Diagram"+ -} module DeltaQ     ( -- * Example@@ -32,12 +40,16 @@        -- * Modules       module DeltaQ.Class+    , module DeltaQ.Expr+    , module DeltaQ.Diagram     , module DeltaQ.Methods     , module DeltaQ.Plot     , module DeltaQ.PiecewisePolynomial     ) where  import DeltaQ.Class+import DeltaQ.Expr+import DeltaQ.Diagram import DeltaQ.Methods import DeltaQ.PiecewisePolynomial import DeltaQ.Plot@@ -110,5 +122,20 @@ > > fromRational (successWithin (hops 5) 2) :: Double > 0.9547325102880658 +Besides computing delay times numerically with the type 'DQ',+we can also represent the underlying model __symbolically__+using the type 'O'.+For example, here is a diagram that represents a sequence of three hops:++> hop' :: O+> hop' = choices [(1/3, var "short"), (1/3, var "mid"), (1/3, var "long")]+>+> hops' :: O+> hops' = hop' .>>. hop' .>>. hop'+>+> renderedHops :: Diagram SVG+> renderedHops = renderOutcomeDiagram hops'++<< images/hops.svg >>  -}

@@ -8,7 +8,8 @@  Type classes -* 'Outcome' — outcomes their combinations.+* 'Outcome' — outcomes and their combinations.+* 'ProbabilisticOutcome' — outcomes with random choice. * 'DeltaQ' — probability distributions of completion times.  -}@@ -17,6 +18,9 @@       -- ** Outcome       Outcome (..) +    -- ** ProbabilisticOutcome+    , ProbabilisticOutcome (..)+     -- ** DeltaQ     , Eventually (..)     , eventually@@ -31,6 +35,9 @@     -- ** Outcome     -- $properties-outcome +    -- ** ProbabilisticOutcome+    -- $properties-probabilisticoutcome+     -- ** DeltaQ     -- $properties-deltaq     ) where@@ -89,6 +96,52 @@     (./\.) :: o -> o -> o     (./\.) = lastToFinish +-- | A 'ProbabilisticOutcome' is a discrete probability distribution+-- of activities that take time.+--+-- The 'Outcome' class supports composition of activities+-- such that all parts of the composite are performed.+--+-- In contrast, the 'ProbabilisticOutcome' class also supports+-- random choice between activities, which means that either+-- one activity or the other are performed (with given probabilities),+-- but not both.+class   ( Ord  (Probability o)+        , Enum (Probability o)+        , Num  (Probability o)+        , Fractional (Probability o)+        , Outcome o+        )+    => ProbabilisticOutcome o+  where+    -- | Numerical type representing probabilities in \( [0,1] \).+    --+    -- For example 'Double' or 'Rational'.+    type Probability o++    -- | Left-biased random choice.+    --+    -- @choice p@ chooses the left argument with probablity @p@+    -- and the right argument with probability @(1-p)@.+    choice :: Probability o -> o -> o -> o++    -- | Random choice between multiple alternatives+    --+    -- @choices [(w_1, o_1), (w_2, o_2), …]@ chooses randomly between multiple+    -- outcomes. The probability @p_i@ for choosing the outcome @o_i@ is+    -- determined by the weights as @p_i = w_i / (w_1 + w_2 + …)@.+    --+    -- Note: The weights @w_i@ have the numeric type @Probability o@,+    -- but for convenience, and unlike probabilities,+    -- they are not restricted to the unit interval \( [0,1] \).+    choices :: [(Probability o, o)] -> o+    choices [] = never+    choices wos =+        foldr (uncurry choice) never+        $ zipWith (\wtot (w, o) -> (w / wtot, o)) ws wos+      where+        ws = scanr1 (+) (map fst wos)+ {-----------------------------------------------------------------------------     Eventually ------------------------------------------------------------------------------}@@ -152,42 +205,7 @@ -- -- Specifically, 'DeltaQ' is the probability distribution -- of finish times for an outcome.-class   ( Ord (Probability o)-        , Enum (Probability o)-        , Num (Probability o)-        , Fractional (Probability o)-        , Outcome o-        )-    => DeltaQ o-  where-    -- | Numerical type representing probabilities in \( [0,1] \).-    ---    -- For example 'Double' or 'Rational'.-    type Probability o--    -- | Left-biased random choice.-    ---    -- @choice p@ chooses the left argument with probablity @p@-    -- and the right argument with probability @(1-p)@.-    choice :: Probability o -> o -> o -> o--    -- | Random choice between multiple alternatives-    ---    -- @choices [(w_1, o_1), (w_2, o_2), …]@ chooses randomly between multiple-    -- outcomes. The probability @p_i@ for choosing the outcome @o_i@ is-    -- determined by the weights as @p_i = w_i / (w_1 + w_2 + …)@.-    ---    -- Note: The weights @w_i@ have the numeric type @Probability o@,-    -- but for convenience, and unlike probabilities,-    -- they are not restricted to the unit interval \( [0,1] \).-    choices :: [(Probability o, o)] -> o-    choices [] = never-    choices wos =-        foldr (uncurry choice) never-        $ zipWith (\wtot (w, o) -> (w / wtot, o)) ws wos-      where-        ws = scanr1 (+) (map fst wos)-+class (ProbabilisticOutcome o, Outcome o) => DeltaQ o where     -- | Uniform probability distribution on a time interval.     uniform :: Duration o -> Duration o -> o @@ -222,12 +240,18 @@     Properties ------------------------------------------------------------------------------} {-$properties-All instances of the above type classes are expected to satisfy+Numerical instances of the above type classes are expected to satisfy the following properties. +Symbolic instances, such as a term algebra, typically cannot satisfy+the following properties, but any normalization of terms should+be compatible with these properties.+ For instances that use approximate arithmetic such as floating point arithmetic or fixed precision arithmetic, equality may be up to numerical accuracy.++#p:Outcome# -}  {-$properties-outcome@@ -266,7 +290,7 @@  -} -{-$properties-deltaq+{-$properties-probabilisticoutcome  'choice' @@ -282,6 +306,9 @@ > choices [] = never > choices ((w,o) : wos) = choice p o (choices wos) >   where  p = w / (w + sum (map fst wos))+-}++{-$properties-deltaq  'uniform' 

@@ -0,0 +1,19 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}++{-|+Copyright   : PLWORKZ R&D, 2025+License     : BSD-3-Clause+Description : Render outcome diagrams.++Render outcome expressions as outcome diagrams.+-}+module DeltaQ.Diagram+    ( -- * Outcome diagrams+      renderOutcomeDiagram+    ) where++import DeltaQ.Diagram.Internal+    ( renderOutcomeDiagram+    )

@@ -0,0 +1,502 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-}++{-|+Copyright   : PLWORKZ R&D, 2025+License     : BSD-3-Clause+Description :+INTERNAL MODULE. USE "DeltaQ.Diagram" INSTEAD!++Render outcome expressions as outcome diagrams.+-}+module DeltaQ.Diagram.Internal where++import DeltaQ.Class+    ( Outcome (..)+    , ProbabilisticOutcome (..)+    )+import DeltaQ.Expr+    ( O+    , Term (..)+    , isLoc+    , isSeq+    , loc+    , termFromOutcome+    , var+    )+import Diagrams.Prelude hiding (Empty, First, Last, Loc, op, loc)+import Diagrams.Backend.SVG+import Text.Printf+    ( printf+    )+out :: O -> IO ()+out =+    renderSVG "xoutcomes.svg" (mkWidth 700)+    . renderOutcomeDiagram++-- | Render an outcome expression as an outcome diagram.+renderOutcomeDiagram :: O -> Diagram SVG+renderOutcomeDiagram = renderTiles . layout . termFromOutcome++{-----------------------------------------------------------------------------+    Diagram rendering+------------------------------------------------------------------------------}+type X = Int+type Y = Int+type Prob = Rational+type Description = String++data Op+    = OFirst+    | OLast+    | OChoices [Prob]+    deriving (Eq, Ord, Show)++-- | Tiles representing predefined outcomes+data Op0+    = ONever+    | OWait0+    | OWait Rational+    deriving (Eq, Ord, Show)++-- | Data attached to a 'Tile'.+data Token+    = VarT String+    | Outcome Op0+    | Location Description+    | Horizontal+    | Close (Maybe Description) [Y]+    | Open Op [Y]+    deriving (Eq, Ord, Show)++data Tile = Tile X Y Token+    deriving (Eq, Ord, Show)++-- | Render a collection of tiles.+renderTiles :: [Tile] -> Diagram SVG+renderTiles = frame 0.1 . position . map renderTile+  where+    renderTile (Tile x y token) =+        ( p2 (fromIntegral x, negate $ fromIntegral y)+        , renderToken token+        )++-- | Render a single 'Token' associated with a 'Tile'.+renderToken :: Token -> Diagram SVG+renderToken (VarT s) =+    scale 0.3 (text s)+    <> (circle 0.44 & lc orange & lw 4 & fc white)+    <> hrule 1+renderToken (Outcome OWait0) =+    hrule 1+renderToken (Outcome o) =+    scale 0.3 (renderOp0Symbol o)+    <> (circle 0.44 & lc orange & lw 4 & fc white)+    <> hrule 1+renderToken (Location s) =+    (scale 0.2 (text s) & fc teal & translate (r2 (0,0.2)))+    <> (square 0.2 & fc white)+    <> hrule 1+renderToken Horizontal = hrule 1+renderToken (Close mlocation ds) =+    maybe mempty (renderToken . Location) mlocation+    <> mconcat (map (renderLine . fromIntegral . negate) ds)+    <> hrule 1+  where+    renderLine d = fromVertices [p2 (0, 0), p2 (-0.5, d)] & strokeLine+renderToken (Open op ds) =+    scale 0.4 ((renderOpSymbol op & lw 1.7) <> (square 1 & fc white))+    <> mconcat (map renderLine ys)+    <> mconcat (renderLineAnnotations op ys)+    <> hrule 1+  where+    ys = map (fromIntegral . negate) ds++    renderLine d = fromVertices [p2 (0, 0), p2 (0.5, d)] & strokeLine++    renderLineAnnotations (OChoices ws) =+        zipWith renderLineAnnotation ps+      where+        ps = map (/ sum ws) ws+    renderLineAnnotations _ = const []++    posLineAnnotation _ 0 = p2 (0.2, 0.3)+    posLineAnnotation _ d = p2 (0.2, 0.1 + d)+    renderLineAnnotation p d =+        position+            [(posLineAnnotation p d+            , scale 0.2 (text $ showProb p) & fc teal+            )]++-- | Render the symbol that represents a known outcome.+renderOp0Symbol :: Op0 -> Diagram SVG+renderOp0Symbol ONever    = text "⊥"+renderOp0Symbol OWait0    = mempty+renderOp0Symbol (OWait t) =+    text $ "wait " <> printf "%.2f" (fromRational t :: Double)++-- | Render the symbol that represents an operation with multiple arguments+renderOpSymbol :: Op -> Diagram SVG+renderOpSymbol OFirst =+    (fromVertices [p2 (-0.35,0.25), p2 (0,0.25), p2 (0,-0.25), p2 (-0.35,-0.25)]+        & strokeLine & translate (r2 (-0.35/2, 0.25)))+    <> (fromOffsets [r2 (-0.35,0)] & strokeLine & translate (r2 (0.35/2, 0)))+renderOpSymbol OLast  =+    (fromOffsets [r2 (-0.16, 0), r2 (2*0.16, 0)] & strokeLine)+    <>+    (((fromOffsets [r2 (-0.25, 0.6)] & strokeLine)+        <> (fromOffsets [r2 (0.25, 0.6)] & strokeLine))+        & translate (r2 (0,-0.35))+    ) & translate (r2 (0, 0.03))+renderOpSymbol (OChoices _) =+    (fromOffsets [r2 (0.33, 0), r2 (-0.6, 0), r2 (0.2, 0.15)]+        & strokeLine & translate (r2 (0,0.1)))+    <>+    (fromOffsets [r2 (-0.33, 0), r2 (0.6, 0), r2 (-0.2, -0.15)]+        & strokeLine & translate (r2 (0,-0.1)))++-- | Show a probability in scientific notation with two digits of precision.+showProb :: Rational -> String+showProb r+    | r >= 0.01 = printf "%.2f" x+    | otherwise = printf "%.2e\n" x+  where+    x = fromRational r :: Double++{-----------------------------------------------------------------------------+    Diagram Layout+------------------------------------------------------------------------------}+{- Note [LayoutComputation]++In order to compute the layout for an outcome diagram,+we use a data structure called 'Shrub', which is a tree with labels+on the edges (as opposed to on the leaves).+The 'Shrub' represents the data that we still need to layout,+we think of the leaves as being located to the left,+and the root to the right, like this:++ leaf+ o----+      \+       o----o----o root+      /+ o----++-}++-- | Outcome-related data that we associate with an edge.+data EdgeOutcome+    = Empty+        -- ^ No outcome is associated with this edge.+    | Term (Term String) (Maybe Description)+        -- ^ Term with maybe a description of its ending observation location.+    deriving (Eq, Ord, Show)++type EdgeData = (Y, EdgeOutcome)++-- | Layout an outcome diagram.+layout :: Term String -> [Tile]+layout t = go 0 $ twig (0, Term t Nothing)+  where+    go !x0 s0+        | isRoot s0 = []+        | otherwise = tiles <> go x1 s1+      where+        (tiles, s1) = emitColumn x0 s0+        x1 = if null tiles then x0 else x0 + 1++-- | Emit the next column, possible empty.+emitColumn :: X -> Shrub EdgeData -> ([Tile], Shrub EdgeData)+emitColumn x s+    | any (onExpr isSeq)        (foliage s) = ([], expandSeq s)+    | hasIsolatedTwigs s                    = ([], dropIsolatedTwigs s)+    | hasGroupClose s                       = emitGroupClose x s+    | any (onExpr isVertical)   (foliage s) = emitVertical x s+    | any (onExpr isLoc)        (foliage s) = emitLoc x s+    | any (onExpr isVarOrKnown) (foliage s) = emitVar x s+    | otherwise = error "emitColumn: unreachable"+  where+    onExpr p (_, Term t _) = p t+    onExpr _ _ = False++-- | Check that a given Term is a 'Var' or known constant.+isVarOrKnown :: Term v -> Bool+isVarOrKnown (Var _)  = True+isVarOrKnown Never    = True+isVarOrKnown Wait0    = True+isVarOrKnown (Wait _) = True+isVarOrKnown _ = False++-- | Check that a given 'EdgeData' contains no outcome-related data.+isEmpty :: EdgeData -> Bool+isEmpty (_, Empty) = True+isEmpty _ = False++-- | Expand all 'Seq' in the 'foliage' as a sequence of twigs.+--+-- Merge observation locations that follow after a vertical term+-- into the term annotation.+expandSeq :: Shrub EdgeData -> Shrub EdgeData+expandSeq = updateFoliage expand+  where+    expand (y, Term (Seq exprs) _) = mkBranches y root exprs+    expand edge = twig edge++    mkBranches _ acc [] = acc+    mkBranches y acc (t:Loc description:ts)+        | isVertical t =+            mkBranches y (Branch [((y, Term t (Just description)), acc)]) ts+    mkBranches y acc (t:ts) =+        mkBranches y (Branch [((y, Term t Nothing), acc)]) ts++-- | Emit a column with the next observation locations.+emitLoc :: X -> Shrub EdgeData -> ([Tile], Shrub EdgeData)+emitLoc x s =+    (concatMap emit $ foliage s, updateFoliage dropit s)+  where+    dropit (y, Term (Loc _) _) = twig (y, Empty)+    dropit edge                = twig edge++    emit (y, Term (Loc l) _) = [Tile x y $ Location l]+    emit (y, _             ) = [Tile x y Horizontal]++-- | Emit a column with the next named items.+emitVar :: X -> Shrub EdgeData -> ([Tile], Shrub EdgeData)+emitVar x s =+    (map emit $ foliage s, updateFoliage dropit s)+  where+    dropit (y, Term t _) | isVarOrKnown t = twig (y, Empty)+    dropit edge                           = twig edge++    emit (y, Term (Var v)  _) = Tile x y $ VarT v+    emit (y, Term Never    _) = Tile x y $ Outcome ONever+    emit (y, Term Wait0    _) = Tile x y $ Outcome OWait0+    emit (y, Term (Wait t) _) = Tile x y $ Outcome $ OWait t+    emit (y, _              ) = Tile x y Horizontal++-- | Emit a column with the next vertical items.+emitVertical :: X -> Shrub EdgeData -> ([Tile], Shrub EdgeData)+emitVertical x s =+    (map emit $ foliage s, updateFoliage dropit s)+  where+    dropit (y, Term (Last    exprs ) ml) = close y ml exprs+    dropit (y, Term (First   exprs ) ml) = close y ml exprs+    dropit (y, Term (Choices wexprs) ml) = close y ml (map snd wexprs)+    dropit edge                         = twig edge++    mkLocation Nothing  = Empty+    mkLocation (Just l) = Term (Loc l) Nothing+    close y ml exprs =+        Branch [+          ( (y, mkLocation ml)+          , Branch [(e, root) | e <- verticals y exprs])+        ]+    verticals y exprs =+        zipWith (\z t -> (y + z, Term t Nothing)) (distances exprs) exprs +    distances = init . scanl (+) 0 . map maxVertical++    emit (y, Term (Last    exprs ) _) =+        Tile x y $ Open OLast $ distances exprs+    emit (y, Term (First   exprs ) _) =+        Tile x y $ Open OFirst $ distances exprs+    emit (y, Term (Choices wexprs) _) =+        Tile x y $ Open (OChoices ws) $ distances exprs+      where (ws, exprs) = unzip wexprs+    emit (y, _) = Tile x y Horizontal++-- | Outcomes that open a new vertical.+isVertical :: Term v -> Bool+isVertical (Last    _) = True+isVertical (First   _) = True+isVertical (Choices _) = True+isVertical _           = False++-- | Maximal number of outcomes that are shown vertically.+-- Parallel operations are shown vertically, but also 'Choices'.+maxVertical :: Term v -> Int+maxVertical (Seq   ts)    = maximum $ map maxVertical ts+maxVertical (Last  ts)    = sum $ map maxVertical ts+maxVertical (First ts)    = sum $ map maxVertical ts+maxVertical (Choices wts) = sum $ map (maxVertical . snd) wts+maxVertical _             = 1+++-- | Check whether there is a group of silent foliage that should+-- be closed.+hasGroupClose :: Shrub EdgeData -> Bool+hasGroupClose = any isGroupClose . foliageBushes+  where+    isGroupClose (Branch ts) =+        length ts > 1 && all isEmpty (map fst ts)++-- | Check whether there are any foliage edges that+-- have no expressions and no siblings.+hasIsolatedTwigs :: Shrub EdgeData -> Bool+hasIsolatedTwigs = any isIsolatedTwig . foliageBushes++-- | 'foliageBushes' returns the collection of all subtrees+-- that consist only of foliage. (These trees have height 1).+--+-- Trees where the immediate children of a root contain both+-- foliage and non-foliage are not returned here!+foliageBushes :: Shrub a -> [Shrub a]+foliageBushes (Branch []) = []+foliageBushes (Branch ts)+    | all isRoot (map snd ts) = [ Branch ts ]+    | otherwise               = concatMap (foliageBushes . snd) ts++-- | Emit a column that closes all groups that can be closed+-- at the moment.+--+-- Special case: If the next-higher branch is an observation+-- location with a label, we merge that location into the close.+emitGroupClose :: X -> Shrub EdgeData -> ([Tile], Shrub EdgeData)+emitGroupClose x shrub = goBranch shrub+  where+    goBranch (Branch []) = ([], Branch [])+    goBranch (Branch ts) = (concat tiless, Branch edges)+      where (tiless, edges) = unzip $ map (uncurry goEdge) ts++    goEdge (y, term) (Branch []) =+        ( [Tile x y Horizontal]+        , ((y, term), Branch [])+        )+    goEdge (y, term) (Branch ts)+        | isGroupClose ts =+            ( [Tile x y $ Close mlocation $ map (subtract y) ys]+            , ((y, Empty), root)+            )+        | otherwise =+            let (tiles, branch') = goBranch (Branch ts)+            in  ( tiles+                , ((y, term), branch')+                )+      where+        mlocation = case term of+            Term (Loc s) _ -> Just s+            _ -> Nothing+        ys = map (fst . fst) ts++    isGroupClose ts+        = all isRoot (map snd ts) && all isEmpty (map fst ts) && length ts > 1++-- | Drop all foliage edges that have no expressions and have no siblings.+dropIsolatedTwigs :: Shrub EdgeData -> Shrub EdgeData+dropIsolatedTwigs (Branch []) = Branch []+dropIsolatedTwigs (Branch ts)+    | isIsolatedTwig (Branch ts) = Branch []+    | otherwise = Branch $ zip labels $ map dropIsolatedTwigs children+  where+    labels   = map fst ts+    children = map snd ts++-- | Check whether a 'Shrub' is a twig without expression.+isIsolatedTwig :: Shrub EdgeData -> Bool+isIsolatedTwig (Branch [((_,Empty), Branch [])]) = True+isIsolatedTwig _ = False++{-----------------------------------------------------------------------------+    Shrub+    data structure+------------------------------------------------------------------------------}+-- | A 'Shrub' is a rooted tree that has labels (only) on the edges+-- (as opposed to on the leaves).+newtype Shrub a = Branch { unBranch :: [(a, Shrub a)] }+    deriving (Eq, Ord, Show)++instance Functor Shrub where+    fmap f (Branch bs) = Branch [ (f x, fmap f b) | (x, b) <- bs ]++-- | Test whether a 'Shrub' is an isolated root.+isRoot :: Shrub a -> Bool+isRoot (Branch []) = True+isRoot _ = False++-- | The 'Shrub' that is an isolated root.+root :: Shrub a+root = Branch []++-- | Test whether a 'Shrub' is a single edge.+isTwig :: Shrub a -> Bool+isTwig (Branch [(_, b)]) = isRoot b+isTwig _ = False++-- | Construct a 'Shrub' with a single edge.+twig :: a -> Shrub a+twig x = Branch [(x, root)]++-- | The 'foliage' of a 'Shrub' is the collection of+-- edges that end in a leaf.+--+-- This function returns the labels of the foliage of the given 'Shrub'.+foliage :: Shrub a -> [a]+foliage (Branch []) = []+foliage (Branch bs) = concatMap go bs+  where+    go (x, Branch []) = [x]+    go (_, Branch cs) = concatMap go cs++-- | Replace the foliage by news 'Shrub's.+--+-- Each edge in the foliage is replaced by the new 'Shrub'+-- whose root is attached to the end of the edge that is not a leaf.+--+-- Special cases:+--+-- * If the new 'Shrub' is 'root', the foliage edge will be removed.+-- * If the new 'Shrub' is a 'twig', the foliage edge will get a new label.+updateFoliage :: (a -> Shrub a) -> Shrub a -> Shrub a+updateFoliage _ (Branch []) = Branch []+updateFoliage f (Branch bs) = Branch $ concatMap update bs+  where+    update (x, Branch []) = unBranch $ f x+    update (x, Branch cs) = [(x, Branch $ concatMap update cs)]++{-----------------------------------------------------------------------------+    Example expressions+------------------------------------------------------------------------------}+example0 :: O+example0 = hops'+  where+    hop' :: O+    hop' = choices [(1/3, var "short"), (1/3, var "mid"), (1/3, var "long")]++    hops' :: O+    hops' = hop' .>>. hop' .>>. hop'++example1 :: O+example1 =+    var "AZ"+    ./\. (var "AB" .>>. (var "BZ" .\/. (var "BC" .>>. var "CZ")))++example2 :: O+example2 =+    var "AB"+    .>>. (var "BX" .\/. (var "BC" .>>. var "CX"))+    .>>. var "XY"+    .>>. (var "YZ" .\/. (var "YQ" .>>. var "QZ"))++exampleS :: O+exampleS = (var "S1" .\/. var "S2") .>>. var "S3"++example3 :: O+example3 =+    (exampleS .>>. exampleS)+    .\/. exampleS+    .\/. (example1 .>>. var "ZQ")++exampleCache :: O+exampleCache =+    loc "read"+    .>>. choices+        [ (95, var "c-hit" .>>. loc "hit")+        , ( 5, var "c-miss" .>>. loc "miss" .>>. (net .\/. timeout) .>>. loc "")+        ]+    .>>. loc "return"+  where+    net = var "net"+        .>>. loc "mread"+        .>>. var "main"+        .>>. loc "mreturn"+        .>>. var "net"+    timeout = var "t-out"

@@ -0,0 +1,356 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}++{-|+Copyright   :+    Predictable Network Solutions Ltd., 2020-2024+    PLWORKZ R&D, 2025+License     : BSD-3-Clause+Description : Outcome expressions.++The type 'O' represents outcome expressions that can be++* inspected,+* rendered as outcome diagrams, and+* converted to a probability distribution of completion times.++-}+module DeltaQ.Expr+    ( -- * Outcome expressions+      O+    , var+    , loc+    , substitute+    , toDeltaQ++    -- * Outcome terms+    , termFromOutcome+    , outcomeFromTerm+    , Term (..)+    , isVar+    , isLoc+    , isSeq+    , isLast+    , isFirst+    , isParallel+    , isChoices+    , maxParallel+    , everywhere+    , everything+    , isNormalizedAssoc+    , normalizeAssoc+    ) where++import Control.Monad+    ( ap+    )+import Control.DeepSeq+    ( NFData+    )+import Data.List+    ( foldl'+    )+import DeltaQ.Class+    ( Outcome (..)+    , ProbabilisticOutcome (..)+    )+import DeltaQ.PiecewisePolynomial+    ( DQ+    )+import GHC.Generics+    ( Generic+    )++{-----------------------------------------------------------------------------+    O+------------------------------------------------------------------------------}+-- | Outcome expression.+--+-- This type includes graphical annotations for the rendering+-- as outcome diagram.+newtype O = O { unO :: Term String }+    -- INVARIANT: Terms satisfy 'isNormalizedAssoc'.+    deriving (Show, Generic, NFData)++-- | Outcome variable, given by a unique name.+var :: String -> O+var = O . Var++-- | Observation location, with a label.+--+-- Rendered as a box with a label in the outcome diagram.+-- Put this in sequence with other outcome expressions to highlight+-- their observation locations.+loc :: String -> O+loc = O . Loc++-- | Substitute all variables by outcome expressions.+substitute+    :: (String -> O)+        -- ^ Assignment of variable names to outcome expressions.+    -> O+        -- ^ Outcome expression in which we substitute.+    -> O+substitute f (O term) = O $ normalize1Assoc $ term >>= unO . f++-- | Map an outcome expression 'O' to+-- probability distributions of completion times 'DQ',+-- given a basic mapping from 'var' names to completion times.+toDeltaQ :: (String -> DQ) -> O -> DQ+toDeltaQ f (O term) = go term+  where+    go (Var v)  = f v+    go Never    = never+    go Wait0    = wait 0+    go (Wait t) = wait t+    go (Loc  _) = wait 0+    go (Seq   xs) = foldr1 (.>>.) $ map go xs+    go (Last  xs) = foldr1 (./\.) $ map go xs+    go (First xs) = foldr1 (.\/.) $ map go xs+    go (Choices wxs) = choices [ (w, go x) | (w, x) <- wxs ]++-- | Outcome expressions can be combined sequentially and in parallel.+instance Outcome O where+    type Duration O = Rational++    never = O Never+    wait = O . Wait+    sequentially  (O x) (O y) = O . normalize1Assoc $ Seq [x,y]+    firstToFinish (O x) (O y) = O . normalize1Assoc $ First [x,y]+    lastToFinish  (O x) (O y) = O . normalize1Assoc $ Last [x,y]++-- | Outcome expressions can be combined with random choice.+instance ProbabilisticOutcome O where+    type Probability O = Rational++    choice p (O x) (O y) = O $ Choices [(p, x), (1-p, y)]+    choices wos = O $ Choices [ (w, x) | (w, O x) <- wos ]++{-----------------------------------------------------------------------------+    Terms+------------------------------------------------------------------------------}+-- | Term representation for outcome expressions.+--+-- Different terms may represent equal outcomes.+data Term v+    = Var v+        -- ^ Variable, to be substituted by a more concrete outcome.+    | Never+        -- ^ Outcome that never finishes.+    | Wait0+        -- ^ Succeed immediately. Equivalent to @Wait 0@,+        -- but with a straight line as graphical representation.+    | Wait Rational+        -- ^ Succeed after waiting for a fixed amount of time.+    | Loc String+        -- ^ Outcome location with a label.+        -- Equivalent to @Wait 0@, but with a labeled box+        -- as graphical representation.+    | Seq [Term v]+        -- ^ Sequential composition.+    | Last [Term v]+        -- ^ Parallel composition, last to finish.+    | First [Term v]+        -- ^ Parallel composiiton, first to finish.+    | Choices [(Rational, Term v)]+        -- ^ Probabilistic choice.+        -- The probabilities are proportional to the given weights.+    deriving (Show, Eq, Ord, Generic, Functor, NFData)++instance Applicative Term where+    pure = Var+    (<*>) = ap++-- | '(>>=)' is substitution.+instance Monad Term where+    m >>= g = go m+      where+        go (Var v)    = g v+        go Never      = Never+        go Wait0      = Wait0+        go (Wait t)   = Wait t+        go (Loc  s)   = Loc s+        go (Seq   xs) = Seq   $ map go xs+        go (Last  xs) = Last  $ map go xs+        go (First xs) = First $ map go xs+        go (Choices wxs) = Choices [ (w, go x) | (w, x) <- wxs ]++-- | Inspect an outcome expression 'O' through its 'Term' representation.+--+-- The result 'Term' satisfies 'isNormalizedAssoc'.+termFromOutcome :: O -> Term String+termFromOutcome (O term) = term++-- | Construct an outcome expression 'O' from an outcome 'Term'.+outcomeFromTerm :: Term String -> O+outcomeFromTerm = O . normalizeAssoc++-- | Predicate that defines the \"associative normal form\" for a 'Term'.+--+-- Specifically, a 'Term' is said to be in \"associative normal form\"+-- if the arguments to the constructors 'Seq', 'Last', and 'First'+--+-- * are nonempty lists, and+-- * their list elements do not have an outermost constructor of the same+--   kind, i.e. @Seq [Seq …, First …]@ is not allowed because+--   one of the list elements for a 'Seq' constructor+--   is also a 'Seq' constructor.+--+-- and if the argument to the constructor 'Choices'+--+-- * is a nonempty list+--+isNormalizedAssoc ::Term v -> Bool +isNormalizedAssoc (Seq xs) =+    not (null xs)+    && all (not . isSeq) xs+    && all isNormalizedAssoc xs+isNormalizedAssoc (Last xs) =+    not (null xs)+    && all (not . isLast) xs+    && all isNormalizedAssoc xs+isNormalizedAssoc (First xs) =+    not (null xs)+    && all (not . isFirst) xs+    && all isNormalizedAssoc xs+isNormalizedAssoc (Choices wxs) =+    not (null wxs)+    && all isNormalizedAssoc (map snd wxs)+isNormalizedAssoc _ =+    True++-- | Check whether a 'Term' is a 'Var'.+isVar :: Term v -> Bool+isVar (Var _) = True+isVar _       = False++-- | Check whether a 'Term' is a 'Loc'.+isLoc :: Term v -> Bool+isLoc (Loc _) = True+isLoc _       = False++-- | Check whether a 'Term' is a 'Seq'.+isSeq :: Term v -> Bool+isSeq (Seq _) = True+isSeq _ = False++-- | Check whether a 'Term' is a 'Last'.+isLast :: Term v -> Bool+isLast (Last _) = True+isLast _ = False++-- | Check whether a 'Term' is a 'First'.+isFirst :: Term v -> Bool+isFirst (First _) = True+isFirst _ = False++-- | Check whether a 'Term' is a 'Choices'.+isChoices :: Term v -> Bool+isChoices (Choices _) = True+isChoices _ = False++-- | Check whether a 'Term' is a parallel operation,+-- i.e. 'Last' or 'First'.+isParallel :: Term v -> Bool+isParallel (First ts) = not (null ts)+isParallel (Last  ts) = not (null ts)+isParallel _          = False++-- | Maximal number of outcomes that run in parallel.+--+-- * The arguments of 'First' and 'Last' run in parallel.+-- * The arguments of 'Seq' and 'Choices' do __not__ run in parallel.+maxParallel :: Term v -> Int+maxParallel (Seq   ts)    = maximum $ map maxParallel ts+maxParallel (Last  ts)    = sum $ map maxParallel ts+maxParallel (First ts)    = sum $ map maxParallel ts+maxParallel (Choices wts) = maximum $ map (maxParallel . snd) wts+maxParallel _             = 1++-- | Normalize a term to \"associative normal form\".+normalizeAssoc :: Term v -> Term v+normalizeAssoc = everywhere normalize1Assoc++-- | Apply a transformation everywhere; bottom-up.+--+-- See also [Scrap your boilerplate+-- ](https://www.microsoft.com/en-us/research/wp-content/uploads/2003/01/hmap.pdf)+-- .+everywhere :: (Term v -> Term v) -> Term v -> Term v+everywhere f = every+  where+    every = f . recurse++    recurse a@(Var _) = a+    recurse a@Never = a+    recurse a@Wait0 = a+    recurse a@(Wait _) = a+    recurse a@(Loc  _) = a+    recurse (Seq   xs) = Seq $ map every xs+    recurse (Last  xs) = Last $ map every xs+    recurse (First xs) = First $ map every xs+    recurse (Choices wxs) = Choices $ [ (w, every x) | (w, x) <- wxs]++-- | Summarize all nodes; top-down, left-to-right.+--+-- See also [Scrap your boilerplate+-- ](https://www.microsoft.com/en-us/research/wp-content/uploads/2003/01/hmap.pdf)+-- .+everything :: (r -> r -> r) -> (Term v -> r) -> (Term v -> r)+everything combine f = recurse+  where+    recurse x@(Var _)  = f x+    recurse x@Never    = f x+    recurse x@Wait0    = f x+    recurse x@(Wait _) = f x+    recurse x@(Loc  _) = f x+    recurse x@(Seq   xs) =+        foldl' combine (f x) $ map recurse xs+    recurse x@(Last  xs) =+        foldl' combine (f x) $ map recurse xs+    recurse x@(First xs) =+        foldl' combine (f x) $ map recurse xs+    recurse x@(Choices wxs) =+        foldl' combine (f x) $ [ recurse y | (_, y) <- wxs]++-- | Normalize a term to \"associative normal form\"+-- under the assumptions+-- that the arguments to the outermost constructor are already normalized.+normalize1Assoc :: Term v -> Term v+normalize1Assoc = id+    . normalizeEmpty+    . normalize1Assoc'++-- | Ensure that the lists in 'Seq', 'Last', 'First'+-- do not contain a term with the same constructor.+normalizeEmpty :: Term v -> Term v+normalizeEmpty (Seq   []) = Wait0+normalizeEmpty (Last  []) = Wait0+normalizeEmpty (First []) = Wait0+normalizeEmpty (Choices []) = Wait0+normalizeEmpty x = x++-- | Ensure that the lists in 'Seq', 'Last', 'First'+-- do not contain a term with the same constructor.+normalize1Assoc' :: Term v -> Term v+normalize1Assoc' (Seq xs) = Seq (concatMap f xs)+  where+    f Wait0 = []+    f (Seq ys) = ys+    f o = [o]+normalize1Assoc' (Last xs) = Last (concatMap f xs)+  where+    f Wait0 = []+    f (Last ys) = ys+    f o = [o]+normalize1Assoc' (First xs) = First (concatMap f xs)+  where+    f Wait0 = []+    f (First ys) = ys+    f o = [o]+normalize1Assoc' o = o

@@ -27,6 +27,7 @@     ( DeltaQ (..)     , Eventually (..)     , Outcome (..)+    , ProbabilisticOutcome (..)     , eventually     ) import DeltaQ.PiecewisePolynomial

@@ -6,7 +6,7 @@ {-| Copyright   : Predictable Network Solutions Ltd., 2020-2024 License     : BSD-3-Clause-Description : Instances via piecewise polynomials.+Description : Distributions of completion times via piecewise polynomials.  @'DQ'@ is a probability distribution of completion time using the numeric type @Rational@.@@ -39,6 +39,7 @@ import DeltaQ.Class     ( DeltaQ (..)     , Outcome (..)+    , ProbabilisticOutcome (..)     , eventuallyFromMaybe     ) import Control.DeepSeq@@ -133,13 +134,15 @@      lastToFinish = onDistribution2 "lastToFinish" (*) -instance DeltaQ DQ where+instance ProbabilisticOutcome DQ where     type Probability DQ = Rational      choice p = onDistribution2 "choice" $ \x y ->         scale p x + scale (1 - p) y       where         scale = Piecewise.mapPieces . Poly.scale++instance DeltaQ DQ where      uniform a = DQ . Measure.uniform a 

@@ -4,7 +4,7 @@ {-| Copyright   : Predictable Network Solutions Ltd., 2003-2024 License     : BSD-3-Clause-Description : Plot 'DeltaQ'.+Description : Plot distributions of completion times.  Plot instances of 'DeltaQ' using "Graphics.Rendering.Chart". -}@@ -20,6 +20,7 @@ import DeltaQ.Class     ( Outcome (Duration)     , DeltaQ (..)+    , ProbabilisticOutcome (Probability)     , Eventually (..)     , eventually     , maybeFromEventually

@@ -0,0 +1,84 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-}++{-|+Copyright   : PLWORKZ R&D, 2025+License     : BSD-3-Clause+-}+module DeltaQ.DiagramSpec+    ( spec+    ) where++import Prelude++import Data.List+    ( sort+    )+import DeltaQ.Diagram.Internal+    ( Tile (..)+    , Token (..)+    , layout+    )+import DeltaQ.Expr+    ( O+    , Term (..)+    , everything+    , outcomeFromTerm+    )+import DeltaQ.Gen.Term+    ( genTerm+    )+import Test.Hspec+    ( Spec+    , describe+    , it+    )+import Test.QuickCheck+    ( Gen+    , Arbitrary+    , (===)+    , arbitrary+    , property+    , scale+    , vector+    )++{-----------------------------------------------------------------------------+    Tests+------------------------------------------------------------------------------}+spec :: Spec+spec = do+    describe "layout" $ do+        it "all 'Var' are rendered" $ property $+            \(o :: Term String) ->+                let fromVarTile (Tile _ _ (VarT name)) = [name]+                    fromVarTile _ = []++                    fromVarTerm (Var name) = [name]+                    fromVarTerm _ = []+                in+                    sort (everything (<>) fromVarTerm o)+                        === sort (concatMap fromVarTile $ layout o)++        it "all 'Loc' are rendered" $ property $+            \(o :: Term String) ->+                let fromLocTile (Tile _ _ (Close (Just s) _)) = [s]+                    fromLocTile (Tile _ _ (Location s)) = [s]+                    fromLocTile _ = []++                    fromLocTerm (Loc name) = [name]+                    fromLocTerm _ = []+                in+                    sort (everything (<>) fromLocTerm o)+                        === sort (concatMap fromLocTile $ layout o)++{-----------------------------------------------------------------------------+    Random generators+------------------------------------------------------------------------------}+instance Arbitrary (Term String) where+    arbitrary = scale (`div` 11) (genTerm genName)+      where genName = vector 2 :: Gen String++instance Arbitrary O where+    arbitrary = outcomeFromTerm <$> arbitrary

@@ -0,0 +1,69 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-}++{-|+Copyright   : PLWORKZ R&D, 2025+License     : BSD-3-Clause+-}+module DeltaQ.ExprSpec+    ( spec+    ) where++import Prelude++import DeltaQ.Expr+    ( O+    , Term (..)+    , everything+    , isNormalizedAssoc+    , isVar+    , normalizeAssoc+    , outcomeFromTerm+    , termFromOutcome+    )+import DeltaQ.Gen.Term+    ( genTerm+    )+import Test.Hspec+    ( Spec+    , describe+    , it+    )+import Test.QuickCheck+    ( Gen+    , Arbitrary+    , arbitrary+    , property+    , scale+    , vector+    )++{-----------------------------------------------------------------------------+    Tests+------------------------------------------------------------------------------}+spec :: Spec+spec = do+    describe "Term normalization" $ do+        it "isNormalizedAssoc . normalizeAssoc" $ property $+            \(t :: Term String) ->+                isNormalizedAssoc (normalizeAssoc t)++        it "isNormalizedAssoc . termFromOutcome" $ property $+            \o ->+                isNormalizedAssoc (termFromOutcome o)++    describe "Bulk operations" $ do+        it "(>>=) substitutes" $ property $+            \(t :: Term String) ->+                everything (&&) (not . isVar) (t >>= const Never)++{-----------------------------------------------------------------------------+    Random generators+------------------------------------------------------------------------------}+instance Arbitrary (Term String) where+    arbitrary = scale (`div` 11) (genTerm genName)+      where genName = vector 2 :: Gen String++instance Arbitrary O where+    arbitrary = outcomeFromTerm <$> arbitrary

@@ -0,0 +1,81 @@+{-|+Copyright   : PLWORKZ R&D, 2025+License     : BSD-3-Clause+-}+module DeltaQ.Gen.Term+    ( genProbability+    , genTerm+    ) where++import Prelude++import Data.Ratio+    ( (%)+    )+import DeltaQ.Expr+    ( Term (..)+    )+import Test.QuickCheck+    ( Gen+    , NonNegative (..)+    , arbitrary+    , choose+    , chooseInteger+    , frequency+    , getSize+    , oneof+    , vectorOf+    )++{-----------------------------------------------------------------------------+    Random generators+------------------------------------------------------------------------------}+-- | Generate a random outcome expression.+genTerm :: Gen v -> Gen (Term v)+genTerm genName = do+    size <- getSize+    genDeltaQFromList =<< vectorOf size (genSimpleOutcome genName)++-- | Generate a deterministic outcome 'wait'.+genWait :: Gen (Term v)+genWait = do+    NonNegative a <- arbitrary+    pure $ Wait a++-- | Generate a 'var' with a short name.+genVar :: Gen v -> Gen (Term v)+genVar = fmap Var++-- | Generate a simple outcome.+genSimpleOutcome :: Gen v -> Gen (Term v)+genSimpleOutcome genName =+    frequency+        [ (20, genVar genName)+        , ( 4, genWait)+        , ( 2, pure Wait0)+        , ( 4, pure Never)+        , ( 1, pure $ Loc "test")+        ]++-- | Generate a random probability between (0,1) an+genProbability :: Gen Rational+genProbability = do+    denominator <- chooseInteger (1,2^(20 :: Int))+    numerator <- chooseInteger (0, denominator)+    pure (numerator % denominator)++-- | Generate a random 'DeltaQ' by combining a given list+-- of outcomes with random operations.+genDeltaQFromList :: [Term v] -> Gen (Term v)+genDeltaQFromList [] = pure Never+genDeltaQFromList [x] = pure x+genDeltaQFromList xs = do+    n <- choose (1, length xs - 1)+    let (ys, zs) = splitAt n xs+    genOp <*> genDeltaQFromList ys <*> genDeltaQFromList zs+  where+    ops = [\a b -> Seq [a,b], \a b -> First [a,b], \a b -> Last [a,b]]+    genChoice = do+        p <- genProbability+        pure $ \a b -> Choices [(1-p, a), (p, b)]+    genOp = oneof $ map pure ops <> [genChoice]

@@ -15,6 +15,7 @@     ( Eventually (..)     , DeltaQ (..)     , Outcome (..)+    , ProbabilisticOutcome (..)     ) import DeltaQ.PiecewisePolynomial     ( DQ

@@ -25,6 +25,7 @@     ( DeltaQ (..)     , Eventually (..)     , Outcome (..)+    , ProbabilisticOutcome (..)     ) import DeltaQ.PiecewisePolynomial     ( DQ