Pathwise Complexity is one technique to measure complexity (and by inference quality) of business processes, but is dependent on rigour in the modelling process, and needs to be amended when a less mature approach has been adopted. In an earlier blog I demonstrated that pathwise complexity can drive the need to move beyond back-box process interactions and highlight the wider collaboration needed with counterparties.
A common pattern in long value-chains is to use intermediate event (like of-page connectors in a flow-chart) to extenuate a customer journey: in these scenarios the technique needs to be amended to meet site-specific conventions. Algorithmic precision can be traded for greater coverage of immature process maps – it is recommended to add start/end events to value-chains because intermediate events (in mature maps) highlight service interactions rather off-page links. The Enterprise Hub facilitates this with scripted workflows that can be evolved as the site becomes more mature. Included with the server are three variants of script to calculate the metric
The script is either run real-time (from update triggers) or overnight for an entire model. Pathwise Complexity is calculated and stored as metric objects for processes. From the spread of complexity score three bands derived and stored as indicator properties; then for ‘high’ complexity processes issues are created to feed into continuous improvement efforts
The full implementation is 250 lines of functional F# code (* F# is used for economy of expression, and because it avoids the errors common with imperative languages). EA.Gen.Model provides the database binding to view a Sparx repository as a graph of interconnected nodes.
The core algorithm is a recursively searches through the connections on a diagram from each start-event accumulating a lists of paths each time an end-event is found. Rather than a simple recursive search with re-entry checking that would filter loops, the cycle function breaks the path into splices of routes delimited by the current node, then if there are any duplicates the path can be rejected.
// start elements
let starts =
diagRefs
|> List.filter (fun i -> i.Stereotype = "StartEvent" )
// Find number of cycles of the same pattern
let cycle (e : Element) (l : Element list) =
if l = [] then 0
else
let id = e.Id
let state : (int list list * int list) = ([[id]],[])
let splice =
l
|> List.filter (fun i -> not (i.Stereotype = "StartEvent" || i.Stereotype = "EndEvent"))
|> List.fold (fun (h,w) y -> if y.Id = id then ([[y.Id] @ w] @ h, []) else (h, [y.Id] @ w)) state
let t = List.rev (fst splice)
let sets =
List.tail t @ [List.head t @ (snd splice)]
List.map (fun i -> List.fold (fun x y -> if i = y then x + 1 else x) 0 sets) sets
|> List.fold (fun e y -> (e + y - 1)) 0
// seek recursively until EndEvents are found or cycle detected
let rec findEnd (e : Element) (l : Element list) (paths : Element list list) = //: Element list list =
let reenter = List.filter (fun (i : Element) -> i.Id = e.Id) l |> List.length
if reenter >= 1 && ((cycle e l) > 0) then // skip path if it loops
paths
[([e] @ l)] @ paths // add this path to the sets
else
e.StartConnectors
|> Seq.toArray
|> Array.filter (fun c -> c.ConnectorType = "ControlFlow" && c.EndElementId.HasValue)
|> Array.map (fun c -> c.EndElementId.Value)
|> Array.filter (fun c -> refMap.ContainsKey (c))
|> Array.map (fun i -> refMap.[i]) // only connctions on the decomposition diagrams
|> Array.fold (fun a v -> (findEnd v ([e] @ l) a)) paths
starts
|> List.fold (fun a v -> (findEnd v [] a)) []
|> Seq.map (fun i -> Seq.ofList i)
A two line amendment to the starts list and EndEvent stereotype filter allows for paths between intermediate events to be included, while addition of && c.Stereotype = "SequenceFlow" to the connector type filter blocks traversal of message-flow paths
Deployment
The script is deployed to the enterprise hub by adding a scheduled job (for the whole-repository: load balanced by Quart.net in a cluster) or as a trigger on a connection for real-time service-side update.
<job name="PathwiseComplexity" startup="true" startAt="01:00" interval="01:00" frequency="Daily" connections="ER">
<trigger class="EA.Gen.Hub.Script.ScriptJob" assembly="EA.Gen.Hub.Script" description="validation" workflow="C:\Users\steve\source\repos\EA.Gen\EA.Gen.Hub.Script\PathwiseComplexity.fs" />
</job>
Pathwise Complexity is an example of the kind of complex data-intensive analysis/metrics that really need to run unattended on a server. Pathwise Complexity is an architype for the kind of quantitative enterprise architecture that is possible with {Sparx Enterprise Architect, EA.Gen.Model graph view of data, Enterprise Hub hosting environment. Full code will be familiar to any programmer familiar with {F#, OCaml, Haskell, Scala} – it is worth the effort to use functional languages to avoid unexpected side-effects.
namespace EA.Gen.Hub.Script
open EA.Gen.Hub.Model
open EA.Gen.Model
open System.Linq
open System
open Quartz
open System.Threading.Tasks
open Serilog
(*
Summary : Calculate the Pathwise complexity of the an element from the decomosition diagram of the object
*)
type PathwiseComplexity () =
class
let findPaths (element : Element) (diagrams : Diagram seq) : Element seq seq =
// all references from diagrams
let diagRefs =
let els (d : Diagram) =
d.Elements
|> Seq.map (fun i -> i.Element)
|> Seq.filter (fun i -> not ( i = null))
|> Seq.toList
diagrams
|> Seq.fold (fun a y -> (els y) @ a) []
// referenes as a dictionary for lookup
let refMap =
diagRefs
|> List.map (fun i -> (i.Id, i))
|> Map.ofList
// start elements
let starts =
diagRefs
|> List.filter (fun i -> i.Stereotype = "StartEvent" )
// Find number of cycles of the same pattern
let cycle (e : Element) (l : Element list) =
if l = [] then 0
else
let id = e.Id
let state : (int list list * int list) = ([[id]],[])
let splice =
l
|> List.filter (fun i -> not (i.Stereotype = "StartEvent" || i.Stereotype = "EndEvent"))
|> List.fold (fun (h,w) y -> if y.Id = id then ([[y.Id] @ w] @ h, []) else (h, [y.Id] @ w)) state
let t = List.rev (fst splice)
let sets =
List.tail t @ [List.head t @ (snd splice)]
List.map (fun i -> List.fold (fun x y -> if i = y then x + 1 else x) 0 sets) sets
|> List.fold (fun e y -> (e + y - 1)) 0
// seek recursively until EndEvents are found or cycle detected
let rec findEnd (e : Element) (l : Element list) (paths : Element list list) = //: Element list list =
let reenter = List.filter (fun (i : Element) -> i.Id = e.Id) l |> List.length
if reenter >= 1 && ((cycle e l) > 0) then // skip path if it loops
paths
elif e.Stereotype = "EndEvent" then
[([e] @ l)] @ paths // add this path to the sets
else
e.StartConnectors
|> Seq.toArray
|> Array.filter (fun c -> c.ConnectorType = "ControlFlow" && c.EndElementId.HasValue)
|> Array.map (fun c -> c.EndElementId.Value)
|> Array.filter (fun c -> refMap.ContainsKey (c))
|> Array.map (fun i -> refMap.[i]) // only connctions on the decomposition diagrams
|> Array.fold (fun a v -> (findEnd v ([e] @ l) a)) paths
starts
|> List.fold (fun a v -> (findEnd v [] a)) []
|> Seq.map (fun i -> Seq.ofList i)
(* Summary : apply the complexity metric to database *)
let metric (db : Sparx) (e : Element) values : unit =
let set = query {for r in e.Metrics do
where (r.MetricType = "Complexity")
select (r.Metric,r)}
|> Map.ofSeq
let findOrCreate name =
match set.TryFind name with
| Some m -> m
| None -> let o = new ObjectMetric()
o.Metric <- name
o.MetricType <- "Complexity"
e.Metrics.Add (o)
o
let apply (p,m,t) =
(findOrCreate "Paths").EValue <- Nullable<float>(float(p))
(findOrCreate "Longest Path").EValue <- Nullable<float>(float(m))
(findOrCreate "Total Path Length").EValue <- Nullable<float>(float(t))
apply values
let fromMetric (m : ObjectMetric) =
match m with
| p when m.Metric = "Paths" -> (int(m.EValue.Value),0,0)
| l when m.Metric = "Longest Path" -> (0,int(l.EValue.Value),0)
| t when m.Metric = "Total Path Length" -> (0,0,int(t.EValue.Value))
| _ -> (0,0,0)
let createProperty (id : int) (rag : string) =
let o = new ObjectProperty ()
o.ElementId <- Nullable<int>(id)
o.Property <- "Pathwise Complexity"
o.Value <- rag
o
let createIssue (id : int) (db : Sparx) =
let o = new ObjectProblem()
o.ElementId <- id
o.Problem <- "High Pathwise Complexity"
o.ProblemType <- "Issue"
o.DateReported <- new Nullable<DateTime> (DateTime.Now)
o.Status <- "New"
db.ObjectProblems.Add o |> ignore
let createIssues (db : Sparx) =
query {for p in query {for p in db.ObjectProperties do
where (p.Property = "Pathwise Complexity" && p.Value = "High" && p.ElementId.HasValue)
select p} do
leftOuterJoin i in query {for p in db.ObjectProblems do
where (p.Problem = "High Pathwise Complexity")
select p} on (p.ElementId.Value = i.ElementId) into g
for r in g do
select (p.ElementId.Value,r)}
|> Seq.iter (fun (p,r) -> if r = null then createIssue p db)
let measure (e : Element) (db : Sparx) =
let agregatetPaths e d =
let pathmap = findPaths e d
let paths =
pathmap |> Seq.fold (fun a y -> a + 1) 0
let totalmax =
let length l =
l |> Seq.fold (fun a y -> a + 1) 0
pathmap
|> Seq.map (fun i -> length i)
|> Seq.fold (fun (m,t) y -> ((if y > m then y else m),(t + y))) (0,0) (*max,total*)
(paths, (fst totalmax), (snd totalmax))
Serilog.Log.Information ("Measuring {0} {1}", e.Name, e.GUID)
let diagrams =
let did = if not (e.PDATA1 = null) && (Seq.fold (fun a y -> if a then a else Char.IsDigit(y)) false e.PDATA1) then int e.PDATA1 else 0
if did > 0 then
query {for d in db.Diagrams do
where (d.Id = did)
select d}
|> Seq.toArray
elif e.ObjectType = "Package" then
query {for p in db.Packages do
join d in db.Diagrams on (p.Id = d.PackageId.Value)
where (p.GUID = e.GUID)
select d}
|> Seq.toArray
else
[||]
let aggregate = agregatetPaths e diagrams
if not (aggregate = (0,0,0)) then
Serilog.Log.Information ("Measured {0} {1}", e.Name, aggregate)
metric db e aggregate
// Summary: Execute the measurement for the activity elements
let execute (elementClass : ElementClass) (repo: string) (guid : string ) : unit =
use db = new Sparx(repo)
query {for e in db.Elements do
where (e.GUID = guid && (e.ObjectType = "Activity" || e.ObjectType = "Package"))
select e}
|> Seq.iter (fun i -> measure i db |> ignore)
// Summary: Execute the measurement for all packages that contain measures
let executeAll (repo: string) : unit =
use db = new Sparx(repo)
try
let childMetrics pid =
let max a b = if a > b then a else b
query {for e in db.Elements do
join m in db.ObjectMetrics on (e.Id = m.ElementId)
where (e.PackageId.Value = pid)
select m}
|> Seq.map (fun i -> fromMetric i)
|> Seq.fold (fun (ap,am,at) (p,m,t) -> (ap + p,max am m, at + t)) (0,0,0)
// measure all activities
let elements =
query {for e in query {for e in db.Elements do
where (e.ObjectType = "Activity" || e.ObjectType = "Package")
select e} do
leftOuterJoin i in query {for p in db.ObjectProblems do
where (p.Problem = "High Pathwise Complexity")
select p} on (e.Id = i.ElementId) into g
for r in g do
select (e,r)}
|> Seq.toArray
elements |> Array.iter (fun (e,r) -> if r = null then measure e db)
let complexitySet =
query {for m in db.ObjectMetrics do
where (m.Metric = "Paths" && m.MetricType = "Complexity")
select (m.ElementId, m.EValue.Value)}
|> Seq.toArray
let avg = (Array.fold (fun a (e,v) -> a + v ) (0.0) complexitySet) / float complexitySet.Length
let stdev = sqrt ((Array.fold (fun a (e,v)-> a + (float v - avg) ** 2.0) 0.0 complexitySet) / float complexitySet.Length)
let low = avg - stdev
let high = avg + stdev
let Rag v =
if (v > high) then
"High"
elif (v < low) then
"Low"
else
"Normal"
let curTag =
query {for t in db.ObjectProperties do
where (t.Property = "Pathwise Complexity" && t.ElementId.HasValue)
select (t.ElementId.Value,t)}
|> Map.ofSeq
complexitySet
|> Array.filter (fun (e,v) -> curTag.ContainsKey(e))
|> Array.iter (fun (e,v) -> curTag.[e].Value <- (Rag v))
complexitySet
|> Array.filter (fun (e,v) -> not (curTag.ContainsKey(e)))
|> Array.map (fun (e,v) -> createProperty e (Rag v))
|> (fun p -> db.ObjectProperties.AddRange (p))
|> ignore
createIssues db
db.SaveChanges () |> ignore
with
| :? Exception as e -> Serilog.Log.Error (e, "Pathwise Complexity error {0}", e.Message )
(* Implement the trigger methods that would be called by the dynamic script job*)
interface ITriggerScript with
member this.ExecuteTrigger ( elementClass: ElementClass, repo : string, guid : string) =
execute elementClass repo guid
member this.ExecuteAll ( repo : string, onlyModified : bool ) =
executeAll repo
end