WolframModelEvolutionObject.m

Package["SetReplace`"]

PackageImport["GeneralUtilities`"]

PackageExport["WolframModelEvolutionObject"]

(* This is an object that is returned by WolframModel. It allows one to query the set at different generations and
   different steps. *)

PackageScope["propertyEvaluate"]
PackageScope["evolutionDataQ"]

PackageScope["$propertiesParameterless"]
PackageScope["$newParameterlessProperties"]

(* Keys in the data association. *)
PackageScope["$version"]
PackageScope["$rules"]
PackageScope["$maxCompleteGeneration"]
PackageScope["$terminationReason"]
PackageScope["$atomLists"]
PackageScope["$eventRuleIDs"]
PackageScope["$eventInputs"]
PackageScope["$eventOutputs"]
PackageScope["$eventGenerations"]
PackageScope["$creatorEvents"]
PackageScope["$destroyerEvents"]
PackageScope["$generations"]

$version = "Version";
$rules = "Rules";
$maxCompleteGeneration = "MaxCompleteGeneration";
$terminationReason = "TerminationReason";
$atomLists = "AtomLists";
$eventRuleIDs = "EventRuleIDs";
$eventInputs = "EventInputs";
$eventOutputs = "EventOutputs";
$eventGenerations = "EventGenerations";

(* Old keys *)
$creatorEvents = "CreatorEvents";
$destroyerEvents = "DestroyerEvents";
$generations = "Generations";

SetUsage @ "
WolframModelEvolutionObject[$$] is an evolution object generated by WolframModel.
WolframModelEvolutionObject[$$][generation$] yields the state at a given generation$.
WolframModelEvolutionObject[$$]['property$', arg$1, arg$2, $$] yields the value of property$ for the given arguments.
WolframModelEvolutionObject[$$]['Properties'] yields the list of all available properties.
";

SyntaxInformation[WolframModelEvolutionObject] = {"ArgumentsPattern" -> {internalData__}};

(* MakeBoxes *)

WolframModelEvolutionObject /:
    MakeBoxes[
      evo : WolframModelEvolutionObject[data_ ? evolutionDataQ],
      format_] := ModuleScope[
  generationsCount = evo["TotalGenerationsCount"];
  maxCompleteGeneration = Replace[evo["CompleteGenerationsCount"], _ ? MissingQ -> "?"];
  generationsDisplay = If[generationsCount === maxCompleteGeneration,
    generationsCount
  ,
    Row[{maxCompleteGeneration, "\[Ellipsis]", generationsCount}]
  ];
  eventsCount = evo["AllEventsCount"];
  terminationReason = evo["TerminationReason"];
  rules = evo["Rules"];
  initialSet = evo[0];
  BoxForm`ArrangeSummaryBox[
    WolframModelEvolutionObject,
    evo,
    style[$lightTheme][$evolutionObjectIcon],
    (* Always grid *)
    {{BoxForm`SummaryItem[{"Generations: ", generationsDisplay}]},
    {BoxForm`SummaryItem[{"Events: ", eventsCount}]}},
    (* Sometimes grid *)
    {If[MissingQ[terminationReason], Nothing, {BoxForm`SummaryItem[{"Termination reason: ", terminationReason}]}],
    {BoxForm`SummaryItem[{"Rules: ", Short[rules]}]},
    {BoxForm`SummaryItem[{"Initial set: ", Short[initialSet]}]}},
    format,
    "Interpretable" -> Automatic
  ]
];

$accessorProperties = <|
  "Version" -> $version,
  "Rules" -> $rules,
  "CompleteGenerationsCount" -> $maxCompleteGeneration,
  "AllEventsEdgesList" -> $atomLists
|>;

$propertyArgumentCounts = Join[
  <|
    "EvolutionObject" -> {0, 0},
    "FinalState" -> {0, 0},
    "FinalStatePlot" -> {0, Infinity},
    "StatesList" -> {0, 0},
    "StatesPlotsList" -> {0, Infinity},
    "EventsStatesPlotsList" -> {0, Infinity},
    "AllEventsStatesEdgeIndicesList" -> {0, 0},
    "AllEventsStatesList" -> {0, 0},
    "GenerationEdgeIndices" -> {1, 1},
    "Generation" -> {1, 1},
    "StateEdgeIndicesAfterEvent" -> {1, 1},
    "StateAfterEvent" -> {1, 1},
    "TotalGenerationsCount" -> {0, 0},
    "PartialGenerationsCount" -> {0, 0},
    "GenerationsCount" -> {0, 0},
    "GenerationComplete" -> {0, 1},
    "AllEventsCount" -> {0, 0},
    "GenerationEventsCountList" -> {0, 0},
    "GenerationEventsList" -> {0, 0},
    "FinalDistinctElementsCount" -> {0, 0},
    "AllEventsDistinctElementsCount" -> {0, 0},
    "VertexCountList" -> {0, 0},
    "EdgeCountList" -> {0, 0},
    "FinalEdgeCount" -> {0, 0},
    "AllEventsEdgesCount" -> {0, 0},
    "AllEventsGenerationsList" -> {0, 0},
    "ExpressionsEventsGraph" -> {0, Infinity},
    "CausalGraph" -> {0, Infinity},
    "LayeredCausalGraph" -> {0, Infinity},
    "TerminationReason" -> {0, 0},
    "AllEventsRuleIndices" -> {0, 0},
    "AllEventsList" -> {0, 0},
    "EventsStatesList" -> {0, 0},
    "EdgeCreatorEventIndices" -> {0, 0},
    "EdgeDestroyerEventsIndices" -> {0, 0},
    "EdgeDestroyerEventIndices" -> {0, 0},
    "EdgeGenerationsList" -> {0, 0},
    "FeatureAssociation" -> {0, 1},
    "FeatureVector" -> {0, 1},
    "ExpressionsSeparation" -> {2, 2},
    "MultiwayQ" -> {0, 0},
    "Properties" -> {0, 0}|>,
  Association[# -> {0, 0} & /@ Keys[$accessorProperties]]];

(* These are here for compatibility with old code. *)
$oldToNewPropertyNames = <|
  "UpdatedStatesList" -> "AllEventsStatesList",
  "AllExpressions" -> "AllEventsEdgesList",
  "CreatorEvents" -> "EdgeCreatorEventIndices",
  "DestroyerEvents" -> "EdgeDestroyerEventIndices",
  "MaxCompleteGeneration" -> "CompleteGenerationsCount",
  "EventGenerations" -> "AllEventsGenerationsList",
  "EventGenerationsList" -> "AllEventsGenerationsList",
  "ExpressionGenerations" -> "EdgeGenerationsList",
  "EventsCount" -> "AllEventsCount",
  "EventsList" -> "AllEventsList",
  "AtomsCountFinal" -> "FinalDistinctElementsCount",
  "AtomsCountTotal" -> "AllEventsDistinctElementsCount",
  "ExpressionsCountFinal" -> "FinalEdgeCount",
  "ExpressionsCountTotal" -> "AllEventsEdgesCount",
  "SetAfterEvent" -> "StateAfterEvent"
|>;

$propertiesParameterless = Join[
  Keys @ Select[#[[1]] == 0 &] @ $propertyArgumentCounts,
  Select[First[$propertyArgumentCounts[$oldToNewPropertyNames[#]]] == 0 &] @ Keys[$oldToNewPropertyNames]
];

$newParameterlessProperties = Intersection[$propertiesParameterless, Keys[$propertyArgumentCounts]];

(* Master options handling *)

declareMessage[
  General::missingMaxCompleteGeneration, "Cannot drop incomplete generations in an object with missing information."];

propertyEvaluate[False, boundary_][evolution_, rest___] :=
  If[MissingQ[evolution["CompleteGenerationsCount"]],
    throw[Failure["missingMaxCompleteGeneration", <||>]];
  ,
    propertyEvaluate[True, boundary][deleteIncompleteGenerations[evolution], rest]
  ];

propertyEvaluate[False, boundary_][evolution_, rest___] :=
  propertyEvaluate[True, boundary][deleteIncompleteGenerations[evolution], rest];

propertyEvaluate[includePartialGenerations : Except[True | False], _][__] := throw[Failure[
  "invalidOptionChoice",
  <|"option" -> "IncludePartialGenerations", "value" -> includePartialGenerations, "choices" -> {True, False}|>]];

includeBoundaryEventsPattern = None | "Initial" | "Final" | All;

propertyEvaluate[_, boundary : Except[includeBoundaryEventsPattern]][__] := throw[Failure[
  "invalidOptionChoice",
  <|"option" -> "IncludeBoundaryEvents", "value" -> boundary, "choices" -> {None, "Initial", "Final", All}|>]];

deleteIncompleteGenerations[WolframModelEvolutionObject[data_]] := ModuleScope[
  maxCompleteGeneration = data[$maxCompleteGeneration];
  eventIndicesToKeep = Position[data[$eventGenerations], _ ? (# <= maxCompleteGeneration &)][[All, 1]];
  newEventOutputs = data[$eventOutputs][[eventIndicesToKeep]];
  expressionIndicesToKeep = Union[Catenate[newEventOutputs]];
  oldToNewExpressionIndices = Dispatch @ Thread[expressionIndicesToKeep -> Range[Length[expressionIndicesToKeep]]];
  WolframModelEvolutionObject[<|$version -> data[$version],
    $rules -> data[$rules],
    $maxCompleteGeneration -> data[$maxCompleteGeneration],
    $terminationReason -> data[$terminationReason],
    $atomLists -> data[$atomLists][[expressionIndicesToKeep]],
    $eventRuleIDs -> data[$eventRuleIDs][[eventIndicesToKeep]],
    $eventInputs -> Replace[data[$eventInputs][[eventIndicesToKeep]], oldToNewExpressionIndices, {2}],
    $eventOutputs -> Replace[newEventOutputs, oldToNewExpressionIndices, {2}],
    $eventGenerations -> data[$eventGenerations][[eventIndicesToKeep]]|>]
];

(* Unknown property *)

propertyEvaluate[masterOptions___][
    obj_WolframModelEvolutionObject, property : Alternatives @@ Keys[$oldToNewPropertyNames], args___] :=
  propertyEvaluate[masterOptions][obj, $oldToNewPropertyNames[property], args];

declareMessage[General::unknownProperty, "Property \"`property`\" should be one of \"Properties\"."];

propertyEvaluate[___][
      WolframModelEvolutionObject[_ ? evolutionDataQ], property : Except[_Integer], ___] /;
    !MemberQ[Keys[$propertyArgumentCounts], property] :=
  throw[Failure["unknownProperty", <|"property" -> property|>]];

(* Check property argument counts *)

declareMessage[
  General::pargx,
  "Property \"`property`\" requested with `givenArgsCount` argument`givenArgsPluralS`; " <>
  "`optionalBetween``minCount``optionalAnd``maxCount` argument`expectedArgsPluralS` `expectedAreOrIs` expected."];

throwPargxFailure[property_, givenArgs_, expectedArgs_] := throw[Failure[
  "pargx",
  <|"property" -> property,
    "givenArgsCount" -> givenArgs,
    "givenArgsPluralS" -> If[givenArgs == 1, "", "s"],
    "optionalBetween" -> If[expectedArgs[[1]] != expectedArgs[[2]], "between ", ""],
    "minCount" -> expectedArgs[[1]],
    "optionalAnd" -> If[expectedArgs[[1]] != expectedArgs[[2]], " and ", ""],
    "maxCount" -> If[expectedArgs[[1]] != expectedArgs[[2]], expectedArgs[[2]], ""],
    "expectedArgsPluralS" -> If[expectedArgs[[1]] != expectedArgs[[2]] || expectedArgs[[1]] != 1, "s", ""],
    "expectedAreOrIs" -> If[expectedArgs[[1]] != expectedArgs[[2]] || expectedArgs[[1]] != 1, "are", "is"]|>
]];

propertyEvaluate[___][
    WolframModelEvolutionObject[_ ? evolutionDataQ], s_String, args___] /;
      With[{argumentsCountRange = $propertyArgumentCounts[s]},
        Not[MissingQ[argumentsCountRange]] &&
        Not[argumentsCountRange[[1]] <= Length[{args}] <= argumentsCountRange[[2]]]] :=
  throwPargxFailure[s, Length[{args}], $propertyArgumentCounts[s]];

declareMessage[
  WolframModelEvolutionObject::invalidNargs,
  "`expr` is called with `argCount` arguments. Either 1 argument is expected for implicit \"Generation\", or a " <>
  "property name is expected as the first argument."];

propertyEvaluate[___][WolframModelEvolutionObject[_ ? evolutionDataQ], g_Integer, args__] :=
  throw[Failure["invalidNargs", <|"argCount" -> Length @ {g, args}|>]];

(* Check options *)

$newCausalGraphOptions = {Background -> Automatic, VertexStyle -> Automatic, EdgeStyle -> Automatic};
$causalGraphOptions = Join[FilterRules[Options[Graph], Except[$newCausalGraphOptions]], $newCausalGraphOptions];

$newLayeredCausalGraphOptions = {GraphLayout -> Automatic};
$layeredCausalGraphOptions =
  Join[FilterRules[$causalGraphOptions, Except[$newLayeredCausalGraphOptions]], $newLayeredCausalGraphOptions];

$newExpressionsEventsGraphOptions = {VertexLabels -> None};
$expressionsEventsGraphOptions = Join[
  FilterRules[$layeredCausalGraphOptions, Except[$newExpressionsEventsGraphOptions]],
  $newExpressionsEventsGraphOptions];

$propertyOptions = <|
  "ExpressionsEventsGraph" -> $expressionsEventsGraphOptions,
  "CausalGraph" -> $causalGraphOptions,
  "LayeredCausalGraph" -> $layeredCausalGraphOptions,
  "StatesPlotsList" -> Options[HypergraphPlot],
  "EventsStatesPlotsList" -> Options[HypergraphPlot],
  "FinalStatePlot" -> Options[HypergraphPlot]
|>;

(* Prevent {}, {{}}, {{}, {}}, etc. being treated as options *)
$nonEmptyOptionsPattern = OptionsPattern[] ? (AllTrue[{##}, Length[Flatten[{#}, Infinity]] > 0 &] &);

propertyEvaluate[True, includeBoundaryEventsPattern][
    WolframModelEvolutionObject[_ ? evolutionDataQ],
    property : Alternatives @@ Keys[$propertyOptions],
    o : $nonEmptyOptionsPattern] := throw[Failure[
  "optx", <|"opt" -> First[Last[Complement[{o}, FilterRules[{o}, Options[$propertyOptions[property]]]]]]|>]];

declareMessage[General::nonopt, StringTemplate[General::nonopt]["`arg`", "`nonoptArgCount`", "`expr`"]];

propertyEvaluate[True, includeBoundaryEventsPattern][
    WolframModelEvolutionObject[_ ? evolutionDataQ], Alternatives @@ Keys[$propertyOptions], o___] :=
  throw[Failure["nonopt", <|"arg" -> Last[{o}], "nonoptArgCount" -> 1|>]];

(* Convert to positive parameter (i.e., generation) number, similar to, e.g., expr[[-1]] *)

declareMessage[General::parameterNotInteger, "`name` `value` must be an integer."];

declareMessage[General::parameterTooLarge, "`name` `value` requested out of `maxValue` total."];

declareMessage[General::parameterTooSmall, "`name` `value` cannot be smaller than `minValue`."];

toPositiveParameter[min_ : 0, total_, requested_, name_] := Switch[requested,
  Except[_Integer],
    throw[Failure["parameterNotInteger", <|"name" -> name, "value" -> requested|>]],
  _ ? (# > total || # < - total - 1 + min &),
    throw[Failure["parameterTooLarge", <|"name" -> name, "value" -> requested, "maxValue" -> total|>]],
  _ ? (0 <= # < min &),
    throw[Failure["parameterTooSmall", <|"name" -> name, "value" -> requested, "minValue" -> min|>]],
  _ ? Negative,
    1 + total + requested,
  _,
    requested
];

(** Properties **)

propertyEvaluate[___][WolframModelEvolutionObject[_ ? evolutionDataQ], "Properties"] := Keys[$propertyArgumentCounts];

(* EvolutionObject *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    WolframModelEvolutionObject[data_ ? evolutionDataQ], "EvolutionObject"] := WolframModelEvolutionObject[data];

(* Rules *)

propertyEvaluate[___][WolframModelEvolutionObject[data_ ? evolutionDataQ], "Rules"] := data[$rules];

(* TotalGenerationsCount *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    WolframModelEvolutionObject[data_ ? evolutionDataQ], "TotalGenerationsCount"] := Max[data[$eventGenerations]];

(* PartialGenerationsCount *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "PartialGenerationsCount"] :=
  If[MissingQ[obj["CompleteGenerationsCount"]],
    obj["CompleteGenerationsCount"]
  ,
    obj["TotalGenerationsCount"] - obj["CompleteGenerationsCount"]
  ];

(* GenerationsCount *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ],
    "GenerationsCount"] := obj /@ {"CompleteGenerationsCount", "PartialGenerationsCount"};

(* GenerationComplete *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ],
    "GenerationComplete",
    generation_Integer] /; generation >= 0 := generation <= obj["CompleteGenerationsCount"];

propertyEvaluate[True, includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "GenerationComplete", generation_ : -1] :=
  toPositiveParameter[
      propertyEvaluate[True, None][obj, "TotalGenerationsCount"], generation, "Generation"] <=
    obj["CompleteGenerationsCount"];

(* AllEventsCount *)

propertyEvaluate[True, includeBoundaryEvents : includeBoundaryEventsPattern][
    WolframModelEvolutionObject[data_ ? evolutionDataQ], "AllEventsCount"] :=
  Length[data[$eventRuleIDs]] + Switch[includeBoundaryEvents, None, -1, "Initial" | "Final", 0, All, 1];

(* GenerationEventsCountList *)

propertyEvaluate[True, includeBoundaryEvents : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "GenerationEventsCountList"] :=
  Length /@ Split[propertyEvaluate[True, includeBoundaryEvents][obj, "AllEventsGenerationsList"]];

(* GenerationEventsList *)

propertyEvaluate[True, includeBoundaryEvents : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "GenerationEventsList"] :=
  TakeList[
    propertyEvaluate[True, includeBoundaryEvents][obj, "AllEventsList"],
    propertyEvaluate[True, includeBoundaryEvents][obj, "GenerationEventsCountList"]];

(* Direct Accessors of object properties *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    WolframModelEvolutionObject[data_ ? evolutionDataQ], property_ ? (MemberQ[Keys[$accessorProperties], #] &)] :=
  Lookup[data, $accessorProperties[property], Missing["NotAvailable"]];

(* StateEdgeIndicesAfterEvents (not a property yet) *)

declareMessage[
  General::multiwayState,
  "Multiple destroyer events found for edge index `edgeIndex`. States are not supported for multiway systems."];

stateEdgeIndicesAfterEvents[WolframModelEvolutionObject[data_], events_] := ModuleScope[
  createdExpressions = Catenate[data[$eventOutputs][[events + 1]]];
  destroyedExpressions = Catenate[data[$eventInputs][[events + 1]]];
  If[DuplicateFreeQ[destroyedExpressions],
    Sort[Complement[createdExpressions, destroyedExpressions]]
  ,
    throw[Failure["multiwayState", <|"edgeIndex" -> Last[Keys[Sort[Counts[destroyedExpressions]]]]|>]]
  ]
];

(* StateEdgeIndicesAfterEvent *)

propertyEvaluate[True, includeBoundaryEventsPattern][
      obj : WolframModelEvolutionObject[data_ ? evolutionDataQ],
      "StateEdgeIndicesAfterEvent",
      s_] := With[{
    positiveEvent = toPositiveParameter[propertyEvaluate[True, None][obj, "AllEventsCount"], s, "Event"]},
  stateEdgeIndicesAfterEvents[obj, Range[0, positiveEvent]]
];

(* StateAfterEvent *)

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[data_ ? evolutionDataQ], "StateAfterEvent", s_] :=
  data[$atomLists][[propertyEvaluate[True, boundary][obj, "StateEdgeIndicesAfterEvent", s]]];

(* FinalState *)

propertyEvaluate[True, boundary: includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "FinalState"] :=
  propertyEvaluate[True, boundary][obj, "StateAfterEvent", -1];

(* FinalStatePlot *)

declareMessage[General::nonHypergraphPlot, "`property` is only supported for states that are hypergraphs."];

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ],
    property : "FinalStatePlot",
    o : $nonEmptyOptionsPattern /; (Complement[{o}, FilterRules[{o}, Options[HypergraphPlot]]] == {})] :=
  Catch[
    hypergraphPlot[propertyEvaluate[True, boundary][obj, "FinalState"], o],
    Failure["invalidEdges", _],
    throw[Failure["nonHypergraphPlot", <|"property" -> property|>]] &];

(* AllEventsStatesEdgeIndicesList & AllEventsStatesList *)

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
    evolution : WolframModelEvolutionObject[data_ ? evolutionDataQ],
    property : "AllEventsStatesList" | "AllEventsStatesEdgeIndicesList"] :=
  propertyEvaluate[True, boundary][
      evolution,
      Replace[
        property,
        {"AllEventsStatesList" -> "StateAfterEvent", "AllEventsStatesEdgeIndicesList" -> "StateEdgeIndicesAfterEvent"}],
      #] & /@
    Range[0, propertyEvaluate[True, None][WolframModelEvolutionObject[data], "AllEventsCount"]];

(* GenerationEdgeIndices *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[data_ ? evolutionDataQ], "GenerationEdgeIndices", g_] := ModuleScope[
  positiveGeneration = toPositiveParameter[
    propertyEvaluate[True, None][obj, "TotalGenerationsCount"], g, "Generation"];
  eventsUpToGeneration = First /@ Position[_ ? (# <= positiveGeneration &)] @ data[$eventGenerations] - 1;
  stateEdgeIndicesAfterEvents[obj, eventsUpToGeneration]
];

(* Generation *)

(* Note that depending on how evaluation was done (i.e., the order of substitutions), it is possible that some
   expressions of a requested generation were not yet produced, and thus expressions for the previous generation would
   be used instead. That, however, should never happen if the evolution object is produced with WolframModel. *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[data_ ? evolutionDataQ], "Generation", g_] :=
  data[$atomLists][[propertyEvaluate[True, None][obj, "GenerationEdgeIndices", g]]];

(* Implicit generation, e.g., object[2] *)

propertyEvaluate[True, includeBoundaryEventsPattern][WolframModelEvolutionObject[data_ ? evolutionDataQ], g_Integer] :=
  propertyEvaluate[True, None][WolframModelEvolutionObject[data], "Generation", g];

(* StatesList *)

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "StatesList"] :=
  propertyEvaluate[True, boundary][obj, "Generation", #] & /@
    Range[0, propertyEvaluate[True, boundary][obj, "TotalGenerationsCount"]];

(* StatesPlotsList *)

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ],
    property : "StatesPlotsList",
    o : $nonEmptyOptionsPattern /; (Complement[{o}, FilterRules[{o}, Options[HypergraphPlot]]] == {})] :=
  Catch[
    hypergraphPlot[#, o] & /@ propertyEvaluate[True, boundary][obj, "StatesList"],
    Failure["invalidEdges", _],
    throw[Failure["nonHypergraphPlot", <|"property" -> property|>]] &];

(* EventsStatesPlotsList *)

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
      obj : WolframModelEvolutionObject[_ ? evolutionDataQ],
      property : "EventsStatesPlotsList",
      o : $nonEmptyOptionsPattern /; (Complement[{o}, FilterRules[{o}, Options[HypergraphPlot]]] == {})] := ModuleScope[
  events = propertyEvaluate[True, boundary][obj, "AllEventsList"][[All, 2]];
  stateIndices = FoldList[
    Function[{currentState, newEvent}, Module[{alreadyDeletedExpressions},
      alreadyDeletedExpressions = Complement[newEvent[[1]], currentState];
      If[alreadyDeletedExpressions =!= {},
        throw[Failure["multiwayState", <|"edgeIndex" -> alreadyDeletedExpressions[[1]]|>]]
      ];
      Join[DeleteCases[currentState, Alternatives @@ newEvent[[1]]], newEvent[[2]]]]],
    If[MatchQ[boundary, "Initial" | All],
      {}
    ,
      propertyEvaluate[True, None][obj, "StateEdgeIndicesAfterEvent", 0]
    ],
    events];
  {destroyedOnlyIndices, createdOnlyIndices, destroyedAndCreatedIndices} = Transpose[MapThread[
    {Complement[##], Complement[#2, #1], Intersection[##]} &,
    {Append[events[[All, 1]], {}], Prepend[events[[All, 2]], {}]}]];
  allEdges = propertyEvaluate[True, None][obj, "AllEventsEdgesList"];

  Catch[
    MapThread[
      hypergraphPlot[
        allEdges[[#]],
        o,
        EdgeStyle -> ReplacePart[
          Table[Automatic, Length[#]],
          Join[
            Thread[Position[#, Alternatives @@ #2][[All, 1]] -> style[$lightTheme][$destroyedEdgeStyle]],
            Thread[Position[#, Alternatives @@ #3][[All, 1]] -> style[$lightTheme][$createdEdgeStyle]],
            Thread[Position[#, Alternatives @@ #4][[All, 1]] ->
              style[$lightTheme][$destroyedAndCreatedEdgeStyle]]]]] &,
      If[MatchQ[boundary, "Initial" | All], Rest /@ # &, # &] @
        If[MatchQ[boundary, All | "Final"], Most /@ # &, # &] @
          {stateIndices, destroyedOnlyIndices, createdOnlyIndices, destroyedAndCreatedIndices}],
    Failure["invalidEdges", _],
    throw[Failure["nonHypergraphPlot", <|"property" -> property|>]] &]
];

(* FinalDistinctElementsCount *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    WolframModelEvolutionObject[data_ ? evolutionDataQ], "FinalDistinctElementsCount"] :=
  Length[Union @ Cases[
    propertyEvaluate[True, None][WolframModelEvolutionObject[data], "StateAfterEvent", -1],
    _ ? AtomQ,
    All]];

(* AllEventsDistinctElementsCount *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    WolframModelEvolutionObject[data_ ? evolutionDataQ], "AllEventsDistinctElementsCount"] :=
  Length[Union @ Cases[data[$atomLists], _ ? AtomQ, All]];

(* VertexCountList *)

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "VertexCountList"] :=
  Length /@ Union /@ Catenate /@ propertyEvaluate[True, boundary][obj, "StatesList"];

(* EdgeCountList *)

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "EdgeCountList"] :=
  Length /@ propertyEvaluate[True, boundary][obj, "StatesList"];

(* FinalEdgeCount *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    WolframModelEvolutionObject[data_ ? evolutionDataQ], "FinalEdgeCount"] :=
  Length[propertyEvaluate[True, None][WolframModelEvolutionObject[data], "StateAfterEvent", -1]];

(* AllEventsEdgesCount *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    WolframModelEvolutionObject[data_ ? evolutionDataQ], "AllEventsEdgesCount"] :=
  Length[data[$atomLists]];

(* AllEventsGenerationsList *)

propertyEvaluate[True, includeBoundaryEvents : includeBoundaryEventsPattern][
    evolution : WolframModelEvolutionObject[data_ ? evolutionDataQ], "AllEventsGenerationsList"] :=
  If[MatchQ[includeBoundaryEvents, All | "Final"], Append[evolution["TotalGenerationsCount"] + 1], Identity] @
    If[MatchQ[includeBoundaryEvents, None | "Final"], Rest, Identity] @
      data[$eventGenerations];

(* Event/expression causal relations, used by both expressions-events and causal graphs *)
(* Returns {<|event -> {output expression, ...}, ...|>, <|expression -> {destroyer event, ...}|> *)

eventsExpressionsRelations[obj_, boundary_] := ModuleScope[
  eventIndices = If[MatchQ[boundary, "Initial" | All], Prepend[0], Identity] @
    If[MatchQ[boundary, All | "Final"], Append[Infinity], Identity] @
      Range[Length[obj[[1]][$eventRuleIDs]] - 1];
  events = propertyEvaluate[True, boundary][obj, "AllEventsList"];
  eventsToOutputs = Association[Thread[eventIndices -> events[[All, 2, 2]]]];

  expressionDestroyers = propertyEvaluate[True, boundary][obj, "EdgeDestroyerEventsIndices"];
  expressionsToDestroyers = Association[Thread[Range[Length[expressionDestroyers]] -> expressionDestroyers]];

  {eventsToOutputs, expressionsToDestroyers}
];

(* ExpressionsEventsGraph *)

rulesList[rule_Association] := rulesList[rule["PatternRules"]];
rulesList[rule : (_Rule | _RuleDelayed)] := {rule};
rulesList[rules_List] := rules;

(* ImageSize -> Automatic (which is the default) causes the size of the output to be reset on reevaluation *)
filterGraphProperties[properties_] := FilterRules[properties, Except[ImageSize]];

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
      obj : WolframModelEvolutionObject[_ ? evolutionDataQ],
      property : "ExpressionsEventsGraph",
      o : $nonEmptyOptionsPattern] /;
        (Complement[{o}, FilterRules[{o}, $propertyOptions[property]]] == {}) := ModuleScope[
  {eventsToOutputs, expressionsToDestroyers} = eventsExpressionsRelations[obj, boundary];
  {labeledEvents, labeledOutputs, labeledExpressions, labeledDestroyers} =
    Function[{list, label, level}, Map[{label, #} &, list, level]] @@@ {
      {Keys[eventsToOutputs], "Event", {1}},
      {Values[eventsToOutputs], "Expression", {2}},
      {Keys[expressionsToDestroyers], "Expression", {1}},
      {Values[expressionsToDestroyers], "Event", {2}}};
  graphVertices = Join[labeledEvents, labeledExpressions];

  allOptionValues = Flatten[Join[{o}, filterGraphProperties[$propertyOptions[property]]]];

  vertexLabelsOptionValue = OptionValue[allOptionValues, VertexLabels];
  automaticVertexLabelsPattern = Automatic | Placed[Automatic, ___];
  If[MatchQ[vertexLabelsOptionValue, automaticVertexLabelsPattern],
    rules = rulesList[propertyEvaluate[True, None][obj, "Rules"]];
    eventRuleIDs = propertyEvaluate[True, None][obj, "AllEventsRuleIndices"];
    allExpressions = propertyEvaluate[True, None][obj, "AllExpressions"];
    placementFunction = Replace[vertexLabelsOptionValue, {
      Automatic -> Identity,
      Placed[Automatic, args___] :> (Placed[#, args] &)
    }];
  ];

  Graph[
    graphVertices,
    Catenate[Function[{key, values}, key -> # & /@ values] @@@
      Catenate[Transpose /@ {{labeledEvents, labeledOutputs}, {labeledExpressions, labeledDestroyers}}]],
    VertexStyle -> Replace[
      OptionValue[allOptionValues, VertexStyle],
      Automatic :> Join[
        {{"Event", _} -> style[$lightTheme][$eventVertexStyle],
         {"Expression", _} -> style[$lightTheme][$tokenVertexStyle]},
        Cases[
          graphVertices,
          v : {"Event", e : 0 | Infinity} :> v -> style[$lightTheme][Switch[e,
            0, $initialEventVertexStyle,
            Infinity, $finalEventVertexStyle]],
          {1}]]],
    EdgeStyle -> Replace[
      OptionValue[allOptionValues, EdgeStyle], Automatic :> style[$lightTheme][$causalEdgeStyle]],
    VertexLabels -> Replace[
      OptionValue[allOptionValues, VertexLabels], {
        automaticVertexLabelsPattern :> Replace[graphVertices, {
          v : {"Event", 0} :> v -> placementFunction["Initial event"],
          v : {"Event", Infinity} :> v -> placementFunction["Final event"],
          v : {"Event", idx_} :> v ->
            If[Length[rules] > 1, placementFunction["Rule " <> ToString[eventRuleIDs[[idx]]]], None],
          v : {"Expression", idx_} :> v -> placementFunction[ToString[allExpressions[[idx]]]]}, {1}],
        "Index" -> Placed["Name", Automatic, Last]}],
    GraphLayout -> Replace[
      OptionValue[allOptionValues, GraphLayout],
      Automatic :> {
        "LayeredDigraphEmbedding",
        "VertexLayerPosition" -> Catenate[{
          2 ("TotalGenerationsCount" - "AllEventsGenerationsList") + 1,
          2 ("TotalGenerationsCount" - "EdgeGenerationsList")} /.
            p_String :> propertyEvaluate[True, boundary][obj, p]]}],
    Background -> Replace[
      OptionValue[allOptionValues, Background], Automatic :> style[$lightTheme][$tokenEventGraphBackground]],
    allOptionValues]
];

(* CausalGraph *)
(* This produces a causal network for the system. This is a Graph with all events as vertices, and directed edges
   connecting them if the same event is a creator and a destroyer for the same expression (i.e., if two events are
   causally related). *)

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], property : "CausalGraph", o : $nonEmptyOptionsPattern] /;
      (Complement[{o}, FilterRules[{o}, $propertyOptions[property]]] == {}) := ModuleScope[
  {eventsToOutputs, expressionsToDestroyers} = eventsExpressionsRelations[obj, boundary];
  eventsToEvents = Catenate /@ Map[expressionsToDestroyers, eventsToOutputs, {2}];
  causalEdges = Catenate[Thread /@ Normal[eventsToEvents]];

  allOptionValues = Flatten[Join[{o}, filterGraphProperties[$propertyOptions[property]]]];
  Graph[
    Keys[eventsToOutputs],
    causalEdges,
    VertexStyle -> Replace[
      OptionValue[allOptionValues, VertexStyle],
      Automatic -> Select[Head[#] =!= Rule || MatchQ[#[[1]], Alternatives @@ Keys[eventsToOutputs]] &] @ {
        style[$lightTheme][$eventVertexStyle],
        0 -> style[$lightTheme][$initialEventVertexStyle],
        Infinity -> style[$lightTheme][$finalEventVertexStyle]}],
    EdgeStyle -> Replace[
      OptionValue[allOptionValues, EdgeStyle], Automatic -> style[$lightTheme][$causalEdgeStyle]],
    Background -> Replace[
      OptionValue[allOptionValues, Background], Automatic -> style[$lightTheme][$tokenEventGraphBackground]],
    allOptionValues]
];

(* LayeredCausalGraph *)

propertyEvaluate[True, includeBoundaryEvents : includeBoundaryEventsPattern][
    evolution : WolframModelEvolutionObject[_ ? evolutionDataQ],
    property : "LayeredCausalGraph",
    o : $nonEmptyOptionsPattern] /;
      (Complement[{o}, FilterRules[{o}, $propertyOptions[property]]] == {}) :=
  Graph[
    propertyEvaluate[True, includeBoundaryEvents][evolution, "CausalGraph", ##] & @@
      FilterRules[FilterRules[{o}, $causalGraphOptions], Except[$newLayeredCausalGraphOptions]],
    GraphLayout -> Replace[
      OptionValue[Flatten[Join[{o}, $propertyOptions[property]]], GraphLayout],
      Automatic -> {
        "LayeredDigraphEmbedding",
        "VertexLayerPosition" ->
          (propertyEvaluate[True, includeBoundaryEvents][evolution, "TotalGenerationsCount"] -
              propertyEvaluate[True, includeBoundaryEvents][evolution, "AllEventsGenerationsList"])}]];

(* TerminationReason *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    WolframModelEvolutionObject[data_ ? evolutionDataQ],
    "TerminationReason"] := Replace[data[[Key[$terminationReason]]], Join[Normal[$stepSpecKeys], {
  $fixedPoint -> "FixedPoint",
  $timeConstraint -> "TimeConstraint",
  $Aborted -> "Aborted",
  x : (_ ? MissingQ | Automatic) :> x,
  _ -> Missing["NotAvailable"]
}]];

(* AllEventsRuleIndices *)

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "AllEventsRuleIndices"] :=
  propertyEvaluate[True, boundary][obj, "AllEventsList"][[All, 1]];

(* AllEventsList *)

finalEvent[WolframModelEvolutionObject[data_]] :=
  {Infinity, Complement[Catenate[data[$eventOutputs]], Catenate[data[$eventInputs]]] -> {}};

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[data_ ? evolutionDataQ], "AllEventsList"] :=
  If[MatchQ[boundary, "Final" | None], Rest, Identity] @
    If[MatchQ[boundary, "Final" | All], Append[finalEvent[obj]], Identity] @
      Transpose[{data[$eventRuleIDs], Thread[data[$eventInputs] -> data[$eventOutputs]]}];

(* EventsStatesList *)

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
      obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "EventsStatesList"] := With[{
    events = propertyEvaluate[True, boundary][obj, "AllEventsList"],
    states = If[MatchQ[boundary, None | "Final"], Rest, # &] @
      If[MatchQ[boundary, All | "Final"], Append[{}], # &] @
      propertyEvaluate[True, boundary][obj, "AllEventsStatesEdgeIndicesList"]},
  Transpose[{events, states}]
];

(* EdgeCreatorEventIndices *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "EdgeCreatorEventIndices"] := ModuleScope[
  events = propertyEvaluate[True, "Initial"][obj, "AllEventsList"];
  eventOutputs = events[[All, 2, 2]];
  Sort[Catenate[Thread /@ Thread[eventOutputs -> Range[Length[events]] - 1]]][[All, 2]]
];

(* EdgeDestroyerEventsIndices *)

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "EdgeDestroyerEventsIndices"] := ModuleScope[
  events = propertyEvaluate[True, "Final"][obj, "AllEventsList"];
  eventInputs = events[[All, 2, 1]];
  edgeToDestroyerRules = Sort[Catenate[Thread /@ Thread[eventInputs -> Append[Range[Length[events] - 1], Infinity]]]];
  resultWithInfinities = Map[Last, Values[GroupBy[edgeToDestroyerRules, First]], {2}];
  If[MatchQ[boundary, None | "Initial"], resultWithInfinities /. Infinity -> Nothing, resultWithInfinities]
];

(* EdgeDestroyerEventIndices *)

eventListToSingleEvent[{event_}, _] := event;

eventListToSingleEvent[{_, __}, expression_] := throw[Failure["multiwayState", <|"edgeIndex" -> expression|>]];

propertyEvaluate[True, includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "EdgeDestroyerEventIndices"] := ModuleScope[
  eventLists = propertyEvaluate[True, "Final"][obj, "EdgeDestroyerEventsIndices"];
  MapIndexed[eventListToSingleEvent[#, #2[[1]]] &, eventLists]
];

(* EdgeGenerationsList *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "EdgeGenerationsList"] := (
  propertyEvaluate[True, "Initial"][obj, "EventGenerations"][[
    propertyEvaluate[True, "Initial"][obj, "EdgeCreatorEventIndices"] + 1]]
);

(* FeatureAssociation *)

nestedToSingleAssociation[association_] :=
  Join @@ (Function[parentKey, KeyMap[StringJoin[parentKey, #] &, association[parentKey]]] /@ Keys[association])
nestedToSingleAssociation[<||>] := <||>

getNumericObjectProperties[obj_, boundary_] := <|# -> propertyEvaluate[True, boundary][obj, #] & /@
  {"EventsCount", "PartialGenerationsCount", "AllEventsDistinctElementsCount", "AllEventsEdgesCount",
    "CompleteGenerationsCount", "TerminationReason", "CausalGraph"}|>

declareMessage[General::invalidFeatureSpec,
               "Feature specification `featureSpec` should be one of `choices`, a list of them, or All."];

declareMessage[General::unknownFeatureGroup, "Feature group `featureGroup` should be one of `choices`."];

fromFeaturesSpec[All] := {"StructurePreservingFinalStateGraph", "ObjectProperties"}
fromFeaturesSpec[featuresSpecs_List] := featuresSpecs
fromFeaturesSpec[featuresSpecs_String] := {featuresSpecs}
fromFeaturesSpec[wrongInput_] :=
  throw[Failure["invalidFeatureSpec", <|"featureSpec" -> wrongInput, "choices" -> fromFeaturesSpec[All]|>]];

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
      obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "FeatureAssociation", featuresSpecs_ : All] := With[{
    featureGroupList = fromFeaturesSpec[featuresSpecs]},
  nestedToSingleAssociation @ AssociationThread[featureGroupList -> Replace[featureGroupList, {
    "StructurePreservingFinalStateGraph" -> If[!propertyEvaluate[True, boundary][obj, "MultiwayQ"],
      <|"" -> HypergraphToGraph[#, "StructurePreserving"] & @
        propertyEvaluate[True, boundary][obj, "FinalState"]|>
    ,
      <|"" -> Missing["NotExistent", {"MultiwaySystem", "FinalState"}]|>
    ],
    "ObjectProperties" -> getNumericObjectProperties[obj, boundary],
    other_ :> throw[Failure["unknownFeatureGroup", <|"featureGroup" -> other, "choices" -> fromFeaturesSpec[All]|>]]
  }, {1}]]
]

(* FeatureVector *)

propertyEvaluate[True, boundary : includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "FeatureVector", featuresSpecs_ : All] :=
  Flatten @ Values @ propertyEvaluate[True, boundary][obj, "FeatureAssociation", featuresSpecs]

(* ExpressionsSeparation *)

propertyEvaluate[True, includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ],
    "ExpressionsSeparation", signedExpr1_, signedExpr2_] := ModuleScope[
  {expr1, expr2} =
    toPositiveParameter[1, propertyEvaluate[True, None][obj, "ExpressionsCountTotal"], #, "Expression"] & /@
      {signedExpr1, signedExpr2};
  expressionsEventsGraph = propertyEvaluate[True, "Initial"][obj, "ExpressionsEventsGraph"];
  If[expr1 === expr2, Return["Identical"]];
  causalCones = VertexInComponent[expressionsEventsGraph, {"Expression", #}] & /@ {expr1, expr2};
  intersection = Intersection @@ causalCones;
  intersectionBoundary =
    intersection[[Position[VertexOutDegree[Subgraph[expressionsEventsGraph, intersection]], 0][[All, 1]]]];
  boundaryExpressions = Cases[intersectionBoundary, {"Expression", expr_} :> expr];
  If[!FreeQ[boundaryExpressions, expr1 | expr2], Return["Timelike"]];
  If[Length[boundaryExpressions] =!= 0, "Branchlike", "Spacelike"]
];

propertyEvaluate[True, includeBoundaryEventsPattern][
    obj : WolframModelEvolutionObject[_ ? evolutionDataQ], "MultiwayQ"] := ModuleScope[
  Max[Length /@ propertyEvaluate[True, None][obj, "EdgeDestroyerEventsIndices"]] > 1
];

(* Public properties call *)

$masterOptions = {
  "IncludePartialGenerations" -> True,
  "IncludeBoundaryEvents" -> None
};

expr : WolframModelEvolutionObject[data_ ? evolutionDataQ][args__] := ModuleScope[
  {property, options} = Replace[
    {args},
    {property__, options : Longest[$nonEmptyOptionsPattern]} :>
      {{property}, {options}}];
  result = Catch[
    (propertyEvaluate @@
        (OptionValue[Join[options, $masterOptions], #] & /@ {"IncludePartialGenerations", "IncludeBoundaryEvents"}))[
      WolframModelEvolutionObject[data],
      Sequence @@ property,
      ##] & @@ Flatten[FilterRules[options, Except[$masterOptions]]],
    _ ? FailureQ,
    message[WolframModelEvolutionObject, #, <|"expr" -> HoldForm[expr]|>] &];
  result /; !FailureQ[result]
];

(** Argument Checks **)
(* Argument Checks should be evaluated after Implementation, otherwise ::corrupt messages will be created while
   assigning SubValues. *)

(* Argument count *)

WolframModelEvolutionObject[args___] := 0 /;
  !CheckArguments[WolframModelEvolutionObject[args], 1] && False;

WolframModelEvolutionObject[data_][] := 0 /;
  Message[WolframModelEvolutionObject::argm, Defer[WolframModelEvolutionObject[data][]], 0, 1];

(* Association has correct fields *)

$currentVersion = 2;

evolutionDataQ[data_Association] := evolutionDataQ[Lookup[data, $version, 1], data];

evolutionDataQ[1, data_Association] :=
  Sort[Keys[data]] === Sort[{
    $creatorEvents, $destroyerEvents, $generations, $atomLists, $rules, $maxCompleteGeneration, $terminationReason,
    $eventRuleIDs}];

evolutionDataQ[2, data_Association] :=
  Keys[data] === {
    $version, $rules, $maxCompleteGeneration, $terminationReason, $atomLists, $eventRuleIDs, $eventInputs,
    $eventOutputs, $eventGenerations};

evolutionDataQ[___] := False;

WolframModelEvolutionObject::migrationInputOrdering =
  "Migrating the evolution object from version 1. The ordering of event inputs may be incorrect.";

migrateEvolutionObjectData[data_, 1, 2] := ModuleScope[
  Message[WolframModelEvolutionObject::migrationInputOrdering];
  {eventsToInputs, eventsToOutputs} =
    GroupBy[Thread[data[#] -> Range[Length[data[#]]]], First][[All, All, 2]] & /@ {$destroyerEvents, $creatorEvents};
  {eventInputs, eventOutputs} = Function[{eventsToExpressions},
    Lookup[eventsToExpressions, #, {}] & /@ Range[0, Length[data[$eventRuleIDs]]]] /@ {eventsToInputs, eventsToOutputs};
  <|$version -> 2,
    $rules -> data[$rules],
    $maxCompleteGeneration -> data[$maxCompleteGeneration],
    $terminationReason -> data[$terminationReason],
    $atomLists -> data[$atomLists],
    $eventRuleIDs -> Join[{0}, data[$eventRuleIDs]],
    $eventInputs -> eventInputs,
    $eventOutputs -> eventOutputs,
    $eventGenerations -> (Max[Append[#, -1]] + 1 &) /@ Map[data[$generations][[#]] &, eventInputs, {2}]|>
];

WolframModelEvolutionObject[data_] /;
    Lookup[data, $version, 1] < $currentVersion && evolutionDataQ[data] :=
  WolframModelEvolutionObject[migrateEvolutionObjectData[data, Lookup[data, $version, 1], 2]];

WolframModelEvolutionObject::future =
  "WolframModelEvolutionObject is produced by a later version of SetReplace. " <>
  "Evaluate PacletInstall[\"SetReplace\"], or check " <>
  "https://github.com/maxitg/SetReplace/blob/master/README.md#getting-started to install manually.";

WolframModelEvolutionObject[data_] /; data[$version] > $currentVersion := 0 /;
  Message[WolframModelEvolutionObject::future];

WolframModelEvolutionObject::corrupt =
  "WolframModelEvolutionObject does not have a correct format. " <>
  "Use WolframModel for construction.";

WolframModelEvolutionObject[data_] /;
    Lookup[data, $version, 1] <= $currentVersion && !evolutionDataQ[data] := 0 /;
  Message[WolframModelEvolutionObject::corrupt];