Aggregation of values over a hierarchy

Question

I have a number of objects of a type Workplace that exist in a hierarchy that is given by some properties (Department, CostCenter, Group and Station of the type); there is no data structure that represents the hierarchy as such. Above the explicitly given hierarchy levels, an additional Root level is implied that is unique over all items.

The Workplace objects have some additional properties which are to be aggregated for each node of the hierarchy, each by its own rules:

• CycleTime is a number; each hierarchy node keeps the minimum and maximum values of its subordinate nodes.
• OrderFilter is (essentially) a string; each hierarchy node knows whether either
  • its subordinate nodes all have an empty string
  • its subordinate nodes and the subordinate nodes of all its siblings have the same non-empty strings
  • its subordinate nodes have the same non-empty string, but its siblings' at least partially differ
  • its own subordinate nodes have different OrderFilter values
• ShiftModel is not a direct property, but can be retrieved from an additional service via the Workplace object's ID value. For the details of the type, see below; the aggregation rules are similar, but not exactly identical to those for OrderFilter: Each node knows whether either
  • any of its subordinate nodes has an "empty" ShiftModel
  • all of its subordinate nodes have non-empty ShiftModels, but they are not all identical
  • its own and all of its siblings' subordinate nodes have the same non-empty ShiftModel
  • its subordinate nodes all have the same non-empty ShiftModel, but its siblings' at least partially differ

The aggregated nodes, as the original values, are not placed within a hierarchical data structure, because random access via an ID value is required. Also, the hierarchy order Root/Department/CostCenter/Group/Station is not set in stone and thus must not be hard coded in the structure of the algorithm.

Hierarchical data of course lends itself well to recursive processing, which is what I did; in this case, there is the small twist that in some cases, both the upper level node needs to know something about the hierarchy below it, and the subordinate nodes need information from above.

I am posting all the code that is required to make this compile (but not run).

These types exist outside the F# project, so they are "normal" CLR classes. They are complete here only as far as their relevant API surface goes, so there are no ambiguities about that.

type HierarchyLevel =
    | Root = 0
    | Department = 1
    | CostCenter = 2
    | MaintenanceArea = 3
    | Group = 4
    | Station = 5
    | Lane = 6
    | Workplace = 7
    | Other = 8

type DailyShifts(early : float, late : float, night : float) =
    member this.EarlyShift = early
    member this.LateShift = late
    member this.NightShift = night

type ShiftModel(shiftsDetermineCycleTime : bool, shifts : DailyShifts seq) =
    member this.ShiftsDetermineCycleTime = shiftsDetermineCycleTime
    member this.Shifts = shifts

type OrderFilter(filter : string) =
    override this.ToString() = filter

type Workplace() =
    member this.ID = 0u
    member this.Department = ""
    member this.CostCenter = ""
    member this.Group = ""
    member this.Station = ""
    member this.Name = ""
    member this.CycleTime = 0.
    member this.OrderFilter = OrderFilter("")

type IGetShiftModelForWorkplace =
    abstract member WithId : workplaceId:uint32 -> ShiftModel

These two types just map the respective types from the C# code. The reason is mostly laziness with regard to implementing structural equality for those, but it has the nice additional benefit of non-nullability. (Yes, there are structs in C#, but at least DailyShifts can't be a struct for certain reasons.) Oh, and I pattern match on ShiftModelInternal once at least, so there's that too.

type DailyShiftsInternal =
    { EarlyShift : float; LateShift : float; NightShift : float } with
    static member fromDailyShifts (dailyShifts : DailyShifts) =
        {
            EarlyShift = dailyShifts.EarlyShift
            LateShift = dailyShifts.LateShift
            NightShift = dailyShifts.NightShift
        }

    static member toDailyShifts shifts =
        DailyShifts(shifts.EarlyShift, shifts.LateShift, shifts.NightShift)

type ShiftModelInternal =
    { ShiftsDetermineCycleTime : bool; Shifts : DailyShiftsInternal list } with
    static member fromShiftModel (shiftModel : ShiftModel) =
        {
            ShiftsDetermineCycleTime = shiftModel.ShiftsDetermineCycleTime
            Shifts = shiftModel.Shifts
                     |> Seq.map DailyShiftsInternal.fromDailyShifts
                     |> Seq.toList
        }

    static member toShiftModel shiftModelInternal =
        ShiftModel(shiftModelInternal.ShiftsDetermineCycleTime,
                   shiftModelInternal.Shifts |> Seq.map DailyShiftsInternal.toDailyShifts)

    static member empty = { ShiftsDetermineCycleTime = false; Shifts = [] }

These are my "local domain" types:

type ShiftsStatus =
    | CommonShifts of ShiftModelInternal
    | CommonOnUpperLevel of ShiftModelInternal
    | DivergingShifts
    | ShiftsMissing

type OrderFiltersStatus =
    | CommonOrderFilter of string
    | CommonOnUpperLevel of string
    | DivergingOrderFilters
    | NoOrderFilter

type CycleTimes = { MinTime : float; MaxTime : float }

type HierarchyNode =
    {
        Level : HierarchyLevel
        Id : string
        ShiftsStatus : ShiftsStatus
        CycleTimes : CycleTimes
        OrderFiltersStatus : OrderFiltersStatus
        ParentId : string
    }

A small bit of auxiliary code:

let idSeparator = '•'
let rootName = "Everything"

let addLevel previous current =
    if previous = "" || previous = rootName then current
    else sprintf "%s %c %s" previous idSeparator current

This is all that defines the actual hierarchy to be used. It's not really nice that this is in two parts, but I can't think of a good way to bundle this up more.

let identifierSelectors =
    [
        HierarchyLevel.Root, fun (wp : Workplace) -> rootName
        HierarchyLevel.Department, fun (wp : Workplace) -> wp.Department
        HierarchyLevel.CostCenter, fun (wp : Workplace) -> wp.CostCenter
        HierarchyLevel.Group, fun (wp : Workplace) -> wp.Group
        HierarchyLevel.Station, fun (wp : Workplace) -> wp.Station
    ]

let lowerLevel =
    function
    | HierarchyLevel.Root -> HierarchyLevel.Department
    | HierarchyLevel.Department -> HierarchyLevel.CostCenter
    | HierarchyLevel.CostCenter -> HierarchyLevel.Group
    | HierarchyLevel.Group -> HierarchyLevel.Station
    | HierarchyLevel.Station -> HierarchyLevel.Workplace
    | _ -> HierarchyLevel.Other // This currently won't actually be reached, but it makes the compiler happier

This is the actual algorithm with a recursive inner function:

let getStatusNodes (getShiftModelForWorkplace : IGetShiftModelForWorkplace) (workplaces : Workplace seq) =
    let getCommonShiftsStatus hierarchy =
        hierarchy
        |> List.map (fun node -> node.ShiftsStatus)
        |> Seq.distinct
        |> Seq.toList
        |> function
            | [ single ] -> single
            | multiple ->
                if multiple |> List.exists (fun status -> status = ShiftsMissing) then ShiftsMissing
                else DivergingShifts

    let getCommonOrderFiltersStatus hierarchy =
        hierarchy
        |> List.map (fun node -> node.OrderFiltersStatus)
        |> Seq.distinct
        |> Seq.toList
        |> function
            | [ single ] -> single
            | _ -> DivergingOrderFilters

    let rec getStatusNodesInternal selectors currentKey (workplaces : Workplace seq) =
        match selectors with
        | (selectorKey, selector) :: remainingSelectors ->
            workplaces
            |> Seq.groupBy selector
            |> Seq.collect (fun (groupKey, groupWorkplaces) ->
                let newKey = addLevel currentKey groupKey

                let subordinateHierarchy =
                    getStatusNodesInternal remainingSelectors newKey groupWorkplaces

                // The following code creates two new subordinate hierarchy lists that
                // supersede `subordinateHierarchy` and each other respectively. I'm
                // wondering if shadowing would be more appropriate here, although I'm
                // generally a bit wary of shadowing because it seems too much like
                // using mutable "variables".

                let shiftsStatus =
                    subordinateHierarchy
                    |> List.filter (fun node -> node.Level = lowerLevel selectorKey)
                    |> getCommonShiftsStatus
                let subordinateHierarchyWithCorrectedShiftStatuses =
                    match shiftsStatus with
                    | CommonShifts shifts ->
                        subordinateHierarchy
                        |> List.map (fun node -> { node with ShiftsStatus = ShiftsStatus.CommonOnUpperLevel shifts })
                    | _ -> subordinateHierarchy

                let orderFiltersStatus =
                    subordinateHierarchyWithCorrectedShiftStatuses
                    |> List.filter (fun node -> node.Level = lowerLevel selectorKey)
                    |> getCommonOrderFiltersStatus
                let subordinateHierarchyWithCorrectedOrderFiltersStatuses =
                    match orderFiltersStatus with
                    | CommonOrderFilter filter ->
                        subordinateHierarchyWithCorrectedShiftStatuses
                        |> List.map (fun node -> { node with OrderFiltersStatus = CommonOnUpperLevel filter })
                    | _ -> subordinateHierarchyWithCorrectedShiftStatuses

                {
                    Level = selectorKey
                    Id = newKey
                    ShiftsStatus = shiftsStatus
                    // Not fond of this; apart from putting it in its own function,
                    // can this be done better?
                    CycleTimes = { MinTime =
                                       subordinateHierarchyWithCorrectedShiftStatuses
                                       |> List.map (fun node -> node.CycleTimes.MinTime)
                                       |> List.min
                                   MaxTime =
                                       subordinateHierarchyWithCorrectedShiftStatuses
                                       |> List.map (fun node -> node.CycleTimes.MaxTime)
                                       |> List.max }
                    OrderFiltersStatus = orderFiltersStatus
                    ParentId = currentKey
                } :: subordinateHierarchyWithCorrectedOrderFiltersStatuses)
            |> Seq.toList
        | [] ->
            workplaces
            |> Seq.map (fun wp ->
                let shiftsStatus =
                    getShiftModelForWorkplace.WithId wp.ID
                    |> ShiftModelInternal.fromShiftModel
                    |> function
                        | { Shifts = [] } -> ShiftsMissing
                        | shiftModel -> CommonShifts shiftModel

                {
                    Level = HierarchyLevel.Workplace
                    Id = wp.Name
                    ShiftsStatus = shiftsStatus
                    CycleTimes = { MinTime = wp.CycleTime; MaxTime = wp.CycleTime }
                    OrderFiltersStatus =
                        match wp.OrderFilter.ToString() with
                        | "" -> NoOrderFilter
                        | filter -> CommonOrderFilter filter
                    ParentId = currentKey
                })
            |> Seq.toList

    getStatusNodesInternal identifierSelectors "" workplaces

I'm looking for critique on anything (except the initial "external" types); idiomaticity(?!), the local domain types, the main algorithm (performance too, if there's something obvious), naming, formatting etc.

Edit
svick's question made me realize I didn't mention what the point of this is.

This code supports a WPF UI where the nodes are presented in a tree-like interface in their original hierarchy that shows the status values aggregated here. The list of status nodes built by this code is a cache that provides that information for the UI, so that each node's status has to be determined only once and not every time it is needed for that of any other node.

That is also the reason why a node is not "oblivious" of its siblings' states - the display for a node that shares identical ShiftModel/OrderFilter values with its siblings is different from one that doesn't.