;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; This file is part of AIslash. ; ; AIslash is free software: you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation, either version 3 of the License, or ; (at your option) any later version. ; ; AIslash is distributed in the hope that it will be useful, ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; GNU General Public License for more details. ; ; You should have received a copy of the GNU General Public License ; along with AIslash. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;

Combing Distributions

;

We have and,or,not nodes ;that combine influences from other nodes. And we have basic nodes ;that are influenced by zero or one other thing. ;These nodes differ in many ways including whether or not ; they can have zero or one kid or zero or more kids: ;

(defstruct node   (id (incf (wm-id *w*))))
(defstruct (nodes (:include node )) kids)
(defstruct (node1 (:include node )) kid )
(defstruct ($and  (:include nodes))     )
(defstruct ($or   (:include nodes))     )
(defstruct ($not  (:include node1))     )
(defstruct (thing (:include node1))
  name          ; short print name
  description   ; long name
  ako           ; a kind of what?
  (priority 1)  ; how much to stress on achieving this one
  givens        ; known prior distributions
  goals         ; desired future distributions
  computeds     ; what we can achieve
  costs         ; cost of reaching parts parts of the distribitions
  (lockedp t)   ; locked or free (are you allowed to adjust the prior?)
)
; goals not used at proppergation, just at rrepport

; change if goal then delta computeds to goal
;        if given then delta computers to given

;
;

Note that, as far as users are concerned, all their domain ;concepts are the only things in the system (so that is why they have ;more details that anything else). ;

Most nodethings zap their ;computed distrubutions.

(defmethod clear ((x node )) t)
(defmethod clear ((x thing)) (setf (thing-computeds x) nil))
;

Node creation, access, an destruction

(defmethod node+ ((x node))
  (setf (gethash (node-handle x) (wm-verticies *w*)) x)
  x)
(defmethod node+ ((x thing))
  (call-next-method)
  (if (thing-ako x)
      (push (node-handle x) ; add to kinds (if this has an 'ako')
            (gethash (thing-ako x) (wm-kinds *w*)))) 
  x)

(defmethod node= ((x  integer)) (gethash x (wm-verticies *w*)))
(defmethod node= ((x  symbol)) (gethash x (wm-verticies *w*)))
(defmethod node= ((x node))     x)

(deftest test-node+ ()
  (zap)
  (let ((th (make-thing :name        'happiness
                       :description "Happiness is an emotion associated
                                     with feelings ranging from
                                     contentment and satisfaction
                                     to bliss and intense joy."
                       :ako          'emotion
                      :givens        (rare!))))
    (node+ th)
    (let ((out (with-output-to-string (s)
                 (showh (wm-verticies *w*) :stream s))))
      (check
        (samep out 
             "HAPPINESS = #S(THING
                        :ID 1 :KID NIL :NAME HAPPINESS
                        :DESCRIPTION Happiness is an emotion associated
                                     with feelings ranging from
                                     contentment and satisfaction
                                     to bliss and intense joy.
                        :AKO EMOTION       :PRIORITY 1
                        :GIVENS #S(DIST
                                  :BUCKETS ((1 . 0.23529412) (2 . 0.4117647)
                                            (3 . 0.23529412) (4 . 0.11764706) (5 . 0.0)
                                            (6 . 0.0) (7 . 0.0) (8 . 0.0) (9 . 0.0)
                                            (10 . 0.0))
                                  :CARDINALITY 10 :MIN 0 :MAX 100)
                        :GOALS NIL :COMPUTEDS NIL :COSTS NIL :LOCKEDP t)")))))

                                                         

(deftest test-node= ()
  (zap)
  (let ((thing  (make-thing :name        'happiness
                            :description "Happiness is an emotion associated
                                     with feelings ranging from
                                     contentment and satisfaction
                                     to bliss and intense joy."
                           :ako          'emotion
                           :givens        (rare!))))
    (node+ thing)
    (node= (node-id thing))))

(defmethod ! ((x null  )) nil)
(defmethod ! ((x number)) (! (node= x)))
(defmethod ! ((x node))   (error "{!} shouyld be inplemented by sub-class"))

(defmethod ! ((x thing))
  (or (thing-computed x)
      (setf (thing-computed x) (? x))))

(defmethod ? ((x thing)) ; if no kids then just return your our dist
  (if (thing-locked? x)
      (thing-givens x)
      (! (thing-kid x)))) 

(defmethod ? ((x $not)) (dist-not (! x)))
(defmethod ? ((x $and)) (accumulate #'dist-and
                                         (first (nodes-kid x))
                                         (rest  (nodes-kides))))

(defmethod ? ((x $or)) (accumulate #'dist-or
                                         (first (nodes-kid x))
                                         (rest  (nodes-kides))))

(defmethod node-handle ((x node))  (node-id x))
(defmethod node-handle ((x thing)) (thing-name x))

(defmethod node-kid+ (dad kid)
  (if (node1-kid dad)
      (error "~% can't have more than one kid" (node-handle dad))
      (setf (node1-kid dad) (node-handle kid))))

(defun node-kids+ (a b creator)
  (let* ((dad      (node= a))
         (grandkid (node-handle (node= b)))
         (kid      (node1-kid dad)))
    (if kid
        (push grandkid (nodes-kids (node= kid)))
        (setf (node1-kid dad)
              (node-handle
               (node+
                (funcall creator :kids (list grandkid))))))))
        
(defmacro ==  (a b) `(node-kid+ (node= ',a) (node= ',b)))
(defmacro ^   (a b) `(node-kids+ ',a ',b #'make-$and))
(defmacro v   (a b) `(node-kids+ ',a ',b #'make-$or))

(defmacro thing (name &key help ako)
  `(node+ (make-thing :name ',name :description ',help :ako ',ako)))

(defun model1 ()
  (zap)
  (thing happy)
  (thing healthy)
  (thing rich)
  (thing wise)
  (thing poor)
  (^ happy healthy)
  (^ happy rich)
  (^ happy wise)
  (== wise poor) ;XXX or
  )

(deftest test-model1 ()
  (zap)
  (model1)
  (let ((string (with-output-to-string (str) 
                  (showh (wm-verticies *w*) :stream str))))
    (check
      (samep
       string
     "6 = #S($AND :ID 6 :KIDS (WISE RICH HEALTHY))
      HAPPY = #S(THING
                :ID 1 :KID 6   :NAME HAPPY :DESCRIPTION NIL :AKO NIL
                :PRIORITY 1    :GIVENS NIL :GOALS NIL       
                :COMPUTEDS NIL :COSTS NIL  :LOCKEDP T)
      HEALTHY = #S(THING
                :ID 2 :KID NIL :NAME HEALTHY :DESCRIPTION NIL :AKO NIL
                :PRIORITY 1    :GIVENS NIL   :GOALS NIL 
                :COMPUTEDS NIL :COSTS NIL    :LOCKEDP T)
      POOR = #S(THING
                :ID 5 :KID NIL :NAME POOR  :DESCRIPTION NIL :AKO NIL
                :PRIORITY 1    :GIVENS NIL :GOALS NIL  
                :COMPUTEDS NIL :COSTS NIL  :LOCKEDP T)
      RICH = #S(THING
                :ID 3 :KID NIL :NAME RICH  :DESCRIPTION NIL :AKO NIL
                :PRIORITY 1    :GIVENS NIL :GOALS NIL 
                :COMPUTEDS NIL :COSTS NIL  :LOCKEDP T)
      WISE = #S(THING
                :ID 4 :KID POOR :NAME WISE  :DESCRIPTION NIL :AKO NIL
                :PRIORITY 1     :GIVENS NIL :GOALS NIL 
                :COMPUTEDS NIL  :COSTS NIL  :LOCKEDP T)"))))