simon/dengine
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Nodes cannot hold features directly because of circularity.

Browse source
This commit is contained in:
Simon Brooke 2025-08-16 08:54:02 +01:00
parent a3a69b8439
commit 96539de149
1 changed files with 15 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
src/arboretum/dengine/node.clj
View file

@ -1,14 +1,13 @@
(ns arboretum.dengine.node (ns arboretum.dengine.node
(:require (:require
[arboretum.dengine.kb :refer [!kb]] [arboretum.dengine.kb :refer [!kb find-feature-for]]
[arboretum.dengine.protocols :refer [Feature Node]] [arboretum.dengine.protocols :refer [Feature Node]]))
[clojure.string :as string]))
(defrecord NodeImpl [feature ^Boolean colour ^String fragment children] (defrecord NodeImpl [feature-id ^Boolean colour ^String fragment children]
Node Node
(children [this] "The children of this node" (:children this)) (children [this] "The children of this node" (:children this))
(colour ^Boolean [this] "The colour of this node" (:colour this)) (colour ^Boolean [this] "The colour of this node" (:colour this))
(feature [this] "The feature at this node" (:feature this)) (feature [this] "The feature at this node" (find-feature-for @!kb (:feature-id this)))
(fragment ^String [this] "The explanation fragment at this node" (fragment ^String [this] "The explanation fragment at this node"
(:fragment this)) (:fragment this))
(evaluate [this case-id] (evaluate [this case-id]
@ -31,10 +30,17 @@
(defn make-node (defn make-node
"Make a node. TODO: these wrapper functions will probably disappear once "Make a node. TODO: these wrapper functions will probably disappear once
I'm more comfortable with the architecture." I'm more comfortable with the architecture."
([feature ^Boolean colour ^String fragment] ([feature-id ^Boolean colour ^String fragment]
(make-node feature colour fragment nil)) (make-node feature-id colour fragment nil))
([feature ^Boolean colour ^String fragment children ] ([feature-id ^Boolean colour ^String fragment children ]
(NodeImpl. feature colour fragment children))) (if (and (find-feature-for @!kb feature-id)
(every? #(satisfies? Node %) children))
(NodeImpl. feature-id colour fragment children)
(throw (ex-info "Unexpected item passed as child node"
{:feature-id feature-id
:colour colour
:fragment fragment
:children children})))))
;; Here's the algorithm as published in A Graphical Inference Mechanism, ;; Here's the algorithm as published in A Graphical Inference Mechanism,
;; but it's not real Interlisp code, and I remember there being at least ;; but it's not real Interlisp code, and I remember there being at least