- ~a" nl) sentence)) (exit (format stream (concat "
- ~a

b.

Return all such pairs found.
(There are also some refinements for some special cases such as handling property values)
|#
;;; [1] If TripleA clones to TripleB clones to TripleC, then (triple-cloned-from TripleC) -> (TripleA TripleB)
(defun triple-cloned-from (triple)
(let* ((f (dereference (first triple)))
(s (second triple))
(v (dereference (third triple))))
(if (and (consp v) (some #'anonymous-instancep (flatten v)))
(triple-cloned-from-complex* f s v)
(triple-cloned-from-simple* f s v))))
(defun triple-cloned-from-simple* (f s v)
(let* ((f-protos (node-cloned-from f))
(v-protos (if (anonymous-instancep v) ; allow for v to be non-anonymous instances
(node-cloned-from v)
(list v))))
(select-real-triples f-protos s v-protos)))
;;; 8/10/12 - Updated to remove-duplicates and also avoid memory overflow with ridiculously many permutations
(defun triple-cloned-from-complex* (f s v)
(let* ((f-protos (node-cloned-from f))
(v-content (remove-duplicates (remove-if-not #'anonymous-instancep (flatten v))))
(v-content-substs (mapcar (lambda (v-node)
(mapcar (lambda (v-node-proto) (cons v-node v-node-proto))
(node-cloned-from v-node)))
v-content))
(v-content-permutations
(cond ((or (<= (length v-content) 5) ; quick lookahead
(let ((n-permutations (apply #'* (mapcar #'length v-content-substs))))
(cond ((<= n-permutations 30000) t)
(t (km-format t "DEBUG: Too many permutations to check doing:~% (triple-cloned-from-complex* ~a ~a ~a)
Assuming result is NIL...~%" f s v)))))
(permute v-content-substs))))
(v-protos (mapcar (lambda (v-permutation)
; (sublis v-permutation v))
(sublis* v-permutation v)) ; smh 2012-06-19
v-content-permutations)))
(select-real-triples f-protos s v-protos)))
;;; GIVEN a set of f, a slot, and a set of v
;;; RETURN ONLY the (f slot v) which actually exist in the KB (are "real")
(defun select-real-triples (fs s vs)
(mapcan #'(lambda (f)
(let ((vals (cond ((protoinstancep f) ; all prototype info necessarily in the global situation
(get-vals f s :situation *global-situation*))
(t (get-vals f s)))))
(mapcan #'(lambda (v)
(when (member v vals :test #'equal)
(list (list f s v))))
vs)))
fs))
;;; ======================================================================
;;; Do similar thing for triple-cloned-to
;(defun triple-cloned-to (triple)
; (let* ((f (dereference (first triple)))
; (s (second triple))
; (v (dereference (third triple)))
; (f-clones (node-cloned-to f))
; (v-clones (node-cloned-to v)))
; (cond
; ((in-prototype triple) ; includes checks the triple exists and is part of a prototype
; (mapcan #'(lambda (f-clone)
; (let ((vals (get-vals f-clone s))) ; is this ok?
; (mapcar #'(lambda (val)
; (list f-clone s val))
; (intersection vals (cons v v-clones))))) ; allow for v to be named instances also
; f-clones)))))
;;; [1] If A clones to B clones to C, then (triple-cloned-to C) -> (A B)
(defun triple-cloned-to (triple)
(let* ((f (dereference (first triple)))
(s (second triple))
(v (dereference (third triple))))
(if (and (consp v) (some #'anonymous-instancep (flatten v)))
(triple-cloned-to-complex* f s v)
(triple-cloned-to-simple* f s v))))
(defun triple-cloned-to-simple* (f s v)
(let* ((f-clones (node-cloned-to f))
(v-clones (if (anonymous-instancep v) ; allow for v to be non-anonymous instances
(node-cloned-to v)
(list v))))
(select-real-triples f-clones s v-clones)))
(defun triple-cloned-to-complex* (f s v)
(let* ((f-clones (node-cloned-to f))
(v-content (remove-duplicates (remove-if-not #'anonymous-instancep (flatten v))))
(v-content-substs (mapcar (lambda (v-node)
(mapcar (lambda (v-node-clone) (cons v-node v-node-clone))
(node-cloned-to v-node)))
v-content))
(v-content-permutations
(cond ((or (<= (length v-content) 5) ; quick lookahead
(let ((n-permutations (apply #'* (mapcar #'length v-content-substs))))
(cond ((<= n-permutations 30000) t)
(t (km-format t "DEBUG: Too many permutations to check doing:~% (triple-cloned-to-complex* ~a ~a ~a)
Assuming result is NIL...~%" f s v)))))
(permute v-content-substs))))
(v-clones (mapcar (lambda (v-permutation)
; (sublis v-permutation v))
(sublis* v-permutation v)) ; smh 2012-06-19
v-content-permutations)))
(select-real-triples f-clones s v-clones)))
;; ======================================================================
;;; ----------------------------------------------------------------------
#|
(triple-cloned-from-originally