; http://geocities.com/n8chz/pvo.txt

; Use of this file is ungoverned by the Cypherpunks Anti-License.
; Do with it as you will.

; This file contains routines for
; attraction/repulsion spacial modeling
; based on abstract "centers"
; and slightly less abstract objects
; representing things.

; One data structure of interest is
; a list of strings that represents
; the attraction of things to a center.
; The car represents the center.
; An example follows:

; ("coffee center" "coffee" "coffee filters" "coffeemaker" "distilled water")

; These so-called centers correspond to
; compound pubwan virtual objects (CPVO's).
; The cddr of such a list is a list of
; simple PVO's (SPVO's).
; The notion of PVO is introduced at:

; http://geocities.com/n8chz/pvo.htm

; Another data structure of interest
; is representation of "repulsive"
; relationships between objects.

; (repel "food preparation center" "waste center")

; Also, a global structure to catalog
; all PVO spatial relationships
; read so far.

; This structure is called a PVW,
; or "pubwan virtual world."

; string2symbol finds the pvo whose name is the input parameter
; in the pvw's list of pvo's
; if it's not already there,
; a pvo with that name is created,
; and added to the pvw's list of pvo's.

(defun string2symbol (name &optional (pvw (make-symbol "pvw")))
 (let*
  ((pvos (get pvw 'pvos))
   (names (mapcar #'(lambda (x) (get x 'name)) pvos))
   (assoc-list (mapcar #'cons names pvos))
   (in (assoc name assoc-list :test #'equal))
   result)
  (if
   in
   (cdar in)
   (prog1
    (setf result (make-symbol "pvo"))
    (setf
     (get result 'name) name
     (get pvw 'pvos) (remove-duplicates (cons result pvos)))))))

; symbolize adds a list of either strings or symbols
; to a pvw's list of pvo's
; as pvo's

(defun symbolize (name &optional (pvw (make-symbol "pvw"))) ; convert strings into symbols, iff necessary
 (cond
  ((listp name)
   (mapcar
    #'(lambda (x) (symbolize x pvw))
    name))
  ((symbolp name)
   (prog1
    name ; return name if it is already a symbol
    (setf
     (get pvw 'pvos)
     (remove-duplicates
      (cons name (get pvw 'pvos)))))) ; make sure named symbol is in pvw's list of pvo's, once
  ((stringp name)
   (string2symbol name pvw))))

; establish a mutual attraction between  2 PVO's

(defun attract-pvos (pvo1 pvo2)
 (setf
  (get pvo1 'attracts) (remove-duplicates (cons pvo2 (get pvo1 'attracts)))
  (get pvo2 'attracts) (remove-duplicates (cons pvo1 (get pvo2 'attracts))))
 t)

(defun repel-pvos (pvo1 pvo2)
 (setf
  (get pvo1 'repels) (remove-duplicates (cons pvo2 (get pvo1 'repels)))
  (get pvo2 'repels) (remove-duplicates (cons pvo1 (get pvo2 'repels))))
 t)

; this establishes attractions for a CPVO
; the car is the CPVO
; the cdr is the list of component SPVO's

(defun cluster-cpvo (pvo-names &optional (pvw (make-symbol "pvw")))
 (let 
  ((pvos (symbolize pvo-names pvw)))
  (setf (get (car pvos) 'compound) t)
  (mapc
   #'(lambda (x) (attract-pvos (car pvos) x))
   (cdr pvos))
  pvw))

; here is a test case to comment or decomment.

(setf a (cluster-cpvo '("coffee center" "coffee" "coffee filters" "coffeemaker" "distilled water")))

; convert.lsp is included for the #'divulge-symbol function
; convert.lsp is at http://geocities.com/n8chz/convert.txt

(load "convert.lsp")

(divulge-symbol a)

; Here we code the "is a" relationship,
; including implementation of the
; sale/use dichotomy.

; The sale/use part is commented out
; because technically it is redundant
; information.

(defun is-a (name1 name2 &optional (pvw (make-symbol "pvw")))
 (let
  ((pvo1 (string2symbol name1))
   (pvo2 (string2symbol name2)))
  (setf (get pvo1 'is-a) (remove-duplicates (cons pvo2 (get pvo1 'is-a))))
;  (repel-pvos
;   (string2symbol (strcat name1 " for use") (strcat name2 " for use") pvw))
;  (attract-pvos
;   (string2symbol (strcat name1 " for sale") (strcat name2 " for sale") pvw))
  pvw))

(defun equivalent (name1 name2 &optional (pvw (make-symbol "pvw")))
 (is-a name1 name2 pvw)
 (is-a name2 name1 pvw)
 pvw)

; This is to identify goods or other items as complementary

(defun complement (name1 name2 (pvw (make-symbol "pvw")))
 (atrract-pvos
  (string2symbol (strcat name1 " for use")) (string2symbol (strcat name2 " for use")) pvw)
 pvw)

; Get all PVO's in a PVW
; Unfortunately, this doesn't work yet.

(defun pvos (pvw &optional (already nil))
 (print already)
 (if
  (symbolp pvw)
  (if
   (equal (symbol-name pvw) "pvo")
   (prog1
    (if (member pvw already) nil (cons pvw (pvos (symbol-plist pvw) already)))
    (setf already (cons pvw already)))
   (pvos (symbol-plist pvw)))
  (if
   (consp pvw)
   (cons (pvos (car pvw) already) (pvos (cdr pvw) already)))))

; This is to merge pvw's

(load "plist.lsp")

;(defun merge-pvws (pvw1 pvw2)