<commit_before>;
; object-api.scm
;
; Define object-oriented class API's for correlation matrices of atoms.
;
; Copyright (c) 2017 <NAME>
;
; ---------------------------------------------------------------------
; OVERVIEW
; --------
; In this project, there's a generic theme of "pairs of things" that
; are statistically related. These can be pairs of words, they can be
; connector-sets, which are a pair of (word, disjunct), or they can
; be other things.
;
; More precisely, we are generally interested in pairs (x,y) of atoms
; (that is, where x and y are atoms), and we have some sort of count
; N(x,y) of how often that particular pair was observed.  We typically
; are then interested in various statistical measures: usually starting
; with the normalized frequency (probability, likelihood) of how often
; the pair (x,y) occurred,
;
; For all of these pairs (x,y), we typically need to get the count
; N(x,y), the partial sums N(x,*) = sum_y N(x,y), and likewise N(*,y)
; and N(*,*).   We need to compute frequencies of observations, such
; as p(x,y) = N(x,y)/N(*,*).  We also need to compute entropies and
; mutual information, which can be inferred from these frequencies.
; We also can compute cosine-similarity and other metrics of similarity,
; derived solely from the observed frequency counts.
;
; All of these formulas are independent of the actual objects in the
; pairs.  Thus, it is useful to separate the various algorithms from
; the data that they operate on. Towards this end, this file defines
; some object-oriented OO API's for pairs, which the algos can assume,
; and the different types of pairs can implement.
;
; The object-system being used here is a roll-your-own type system,
; really quite simple, as it's well-suited for the desired task.
; It's simple, and minimal. The reasons for this are explained here:
;    http://community.schemewiki.org/?object-oriented-programming
; Basically, "object-oriented programming" is a mish-mash of more
; than half-a-dozen distinct concepts, almost all of which are
; not needed for this particular project.  The only thing we need
; is the ability to decorate objects with additional methods, kind-of
; like class inheritance, except that we really really need dynamic
; inheritance, i.e. arbitrary base classes, rather than a single,
; static base class, and so its totally unlike C++ inheritance, which
; is static, and a lot like C++ templates, which are dynamic.
; Basically, what is needed, and what is implemented here is called
; "parametric polymorphism".
;
; From what I can tell, tiny-CLOS and thus GOOPS does not support
; parametric polymorphism... !?? and so I go it alone. The system here
; is really really simple...
;
; The object system here is almost identical to this one:
;    http://community.schemewiki.org/?simple-object
; Read this URL to understand what is happening here.
;
; There are several API's here. The lowest-level ones are listed first.
;
; XXX FIXME ... the calling sequence is exactly backwards. In order
; for overloading to work correctly, attempts must be made to call
; methods on the base object first, and only later on the wrapper.
; For now, we blow this off, but in the long run, this needs to be
; fixed.
;
; ---------------------------------------------------------------------
;
; Example low-level API class. It has only six methods; these
; return atoms on which observation counts are stored as values.
; Higher-level objects use this object to fetch counts, store them
; into the database, or to return various statistics.
;
; The `add-pair-count-api` class, below, is a typical user of this
; class; it provides getters and setters for the counts.
;
; See `make-any-link-api` for a working example.
;
; When called, this will create a new instance of the class
; i.e. will create a new object.
;
;  (define (make-ll-object-api-example)
;
;     ; Return the atom-type of the matrix rows, i.e. the type of
;     ; the left side of the (row, column) pairs.
;     (define (get-left-type) 'WordNode)
;
;     ; Return the atom-type of the matrix columns, i.e. the type of
;     ; the right side of the (row, column) pairs.
;     (define (get-right-type) 'WordNode)
;
;     ; Return the type of the link that holds the pair.  In this
;     ; example, each pair will be held in the form
;     ;  (Evaluation (Predicate "foo") (List (Word "row") (Word "col")))
;     (define (get-pair-type) 'EvaluationLink)
;
;     ; Return the atom for a matrix (row,column) pair, if it exists,
;     ; else return nil. In this example, the matrix is defined by an
;     ; EvaluationLink holding the ListLink. This atom is where all
;     ; values associated with this matrix are held.  This includes not
;     ; only the count (the number of observations of the pair) but also
;     ; any derived values, such as frequency, mutual information, and
;     ; so on. Users are free to (are encouraged to) use this atom to
;     ; attach additional information and statistics.
;     ;
;     (define (get-pair L-ATOM R-ATOM)
;        (define maybe-list (cog-link 'ListLink L-ATOM R-ATOM))
;        (if (null? maybe-list) '()
;           (cog-link 'EvaluationLink (Predicate "foo") maybe-list)))
;
;     ; Return the observed count for the pair PAIR.
;     (define (get-count PAIR)
;        (cog-value-ref (cog-value PAIR (Predicate "counter")) 42))
;
;     ; Return the observed count for the pair (L-ATOM, R-ATOM), if it
;     ; exists, else return zero.
;     (define (get-pair-count L-ATOM R-ATOM)
;        (define stats-atom (get-pair L-ATOM R-ATOM))
;        (if (null? stats-atom) 0 (get-count stats-atom)))
;
;     ; Return the atom holding the count, creating it if it does
;     ; not yet exist.  Returns the same structure as the 'get-pair
;     ; method (the get-pair function, above).
;     (define (make-pair L-ATOM R-ATOM)
;        (Evaluation (Predicate "foo") (List L-ATOM R-ATOM)))
;
;     ; Return the left member of the pair. Given the pair-atom,
;     ; locate the left-side atom.
;     (define (get-left-element PAIR)
;        (gadr PAIR))
;
;     (define (get-right-element PAIR)
;        (gddr PAIR))
;
;     ; Return an atom to which column subtotals can be attached,
;     ; such as, for example, the subtotal `N(*,y)`. Thus, `y`
;     ; denotes a column, and the star is on the left (the star
;     ; ranging over all rows).
;     (define (get-left-wildcard ITEM)
;        (EvaluationLink (Predicate "foo")
;           (ListLink (AnyNode "left-wild") ITEM)))
;
;     ; Return an atom to which row subtotals can be attached,
;     ; such as, for example, the subtotal `N(x,*)`. Thus, `x`
;     ; denotes a row, and the star is on the right (the star
;     ; ranging over all columns).
;     (define (get-right-wildcard ITEM)
;        (EvaluationLink (Predicate "foo")
;           (ListLink ITEM (AnyNode "right-wild"))))
;
;     ; Return an atom to which matrix totals can be attached,
;     ; such as, for example, the total `N(*,*)`. This can be any
;     ; atom, but must be unique to the specific matrix. It's
;     ; convenient to use the same style as the subtotals.
;     (define (get-wild-wild)
;        (EvaluationLink (Predicate "foo")
;           (ListLink (AnyNode "left-wild") (AnyNode "right-wild"))))
;
;     ; Retrieve, from storage, the entire matrix, including the
;     ; subtotal and total anchor atoms.  In this example, its enough
;     ; to get the incoming set of (Predicate "foo"), but this need
;     ; not generally be the case.
;     (define (fetch-all-pairs)
;        (fetch-incoming-by-type (Predicate "foo") 'EvaluationLink))
;
;     ; Methods on the class. To call these, quote the method name.
;     ; Example: (OBJ 'left-wildcard WORD) calls the
;     ; get-left-wildcard function, passing WORD as the argument.
;     ;
;     ; The name is a string printed at the top of generated reports.
;     ; The id is a short string used to create unique filter ids and names.
;     (lambda (message . args)
;        (apply (case message
;              ((name) (lambda () "A Kind of Demonstration Object"))
;              ((id)   (lambda () "demo"))
;              ((left-type) get-left-type)
;              ((right-type) get-right-type)
;              ((pair-type) get-pair-type)
;              ((pair-count) get-pair-count)
;              ((get-pair) get-pair)
;              ((get-count) get-count)
;              ((make-pair) make-pair)
;              ((left-element) get-left-element)
;              ((right-element) get-right-element)
;              ((left-wildcard) get-left-wildcard)
;              ((right-wildcard) get-right-wildcard)
;              ((wild-wild) get-wild-wild)
;              ((fetch-pairs) fetch-all-pairs)
;              ((provides) (lambda (symb) #f))
;              ((filters?) (lambda () #f))
;              (else (error "Bad method call on low-level API")))
;           args)))
;
;
; ---------------------------------------------------------------------

(use-modules (srfi srfi-1))
(use-modules (ice-9 optargs)) ; for define*-public
(use-modules (ice-9 atomic))  ; for atomic-box
(use-modules (ice-9 threads)) ; for mutex locks
(use-modules (opencog) (opencog exec))

; ---------------------------------------------------------------------

(define-public (add-pair-stars LLOBJ)
"
  add-pair-stars LLOBJ - Extend LLOBJ with row and column access
  methods (aka wildcard methods); specifically, to get all non-zero
  elements in a given row or column.

  The supported methods are:
  'left-basis - Return all items (atoms) that can be used to index
      a row in the matrix.  That is, given a matrix N(x,y), this
      returns the set {x | (x,y) exists in the atomspace for some y}.
      All of the elements of this set will be atoms of type
      (LLOBJ 'left-type).  A check is made to verify that (x,y) is
      a valid pair, viz that it is an atom whose type is
      (LLOBJ 'pair-type) and that y is of type (LLOBJ 'right-type).
      This only verifies that such pairs exist in the atomspace; it
      does NOT verify that they have a nonzero count!

  'right-basis - Likewise, but for columns.

  'left-basis-size - the size of the 'left-basis set; i.e. the number
      of unique, distinct atoms in that set.

  'right-basis-size - Likewise.

  'left-stars COL - Return the set of pairs (row, column) for
      which the column is COL, and the pair exists in the atomspace.
      That is, return the set
         (*, COL) == { (x,COL) | (x,COL) exists in the atomspace }
      The returned pairs will all be of type (LLOBJ 'pair-type),
      and the x's will all be of type (LLOBJ 'left-type). The
      input COL atom must be of type (LLOBJ 'right-type).  This does
      NOT verify that these pairs have a non-zero count.

  'right-stars ROW - Likewise, but returns the set (ROW, *).

  Here, the LLOBJ is expected to be an object, with methods for
  'left-type, 'right-type and 'pair-type on it. It is assumed that
  the pairs are arity-two links having the form
     (pair-type (left-type right-type))
  That is, the pair-type is the low-level pair type.
"
	(let ((l-basis '())
			(r-basis '())
			(l-size 0)
			(r-size 0)

			; Caches for the left and right stars
			(l-hit (make-atomic-box '()))
			(l-miss (make-atomic-box '()))
			(r-hit (make-atomic-box '()))
			(r-miss (make-atomic-box '()))

#! ============ Alternate variant, not currently used.
			; Temporary atomspaces
			(l-asp (make-fluid))
			(r-asp (make-fluid))
=============== !#

			; Temporary atomspaces, non-fluid style.
			(l-mtx (make-mutex))
			(r-mtx (make-mutex))
			(l-ase (cog-new-atomspace (cog-atomspace)))
			(r-ase (cog-new-atomspace (cog-atomspace)))

			(pair-type (LLOBJ 'pair-type))
			(left-type (LLOBJ 'left-type))
			(right-type (LLOBJ 'right-type))
		)

		; Perform a query to find all atoms that might appear on
		; the left, or the right of a pair.  Return a list of them.
		(define (do-get-basis LEF)
			(define uleft (uniquely-named-variable))
			(define uright (uniquely-named-variable))
			(define term (LLOBJ 'make-pair uleft uright))
			(define setlnk (cog-execute! (Bind
				(VariableList
					(TypedVariable uleft (Type (symbol->string left-type)))
					(TypedVariable uright (Type (symbol->string right-type))))
				term (if LEF uleft uright))))
			(define basis (cog-outgoing-set setlnk))
			(cog-extract setlnk)
			(cog-extract-recursive uleft)
			(cog-extract-recursive uright)
			basis)

		; Return a list of all of the atoms that might ever appear on
		; the left-hand-side of a pair.  This is the set of all possible
		; items x from the pair (x,y) for any y.
		;
		(define (get-left-basis)
			(if (null? l-basis) (set! l-basis (do-get-basis #t)))
			l-basis)

		(define (get-right-basis)
			(if (null? r-basis) (set! r-basis (do-get-basis #f)))
			r-basis)

		(define (get-left-size)
			(if (eq? 0 l-size) (set! l-size (length (get-left-basis))))
			l-size)

		(define (get-right-size)
			(if (eq? 0 r-size) (set! r-size (length (get-right-basis))))
			r-size)

		;-------------------------------------------
		; Return a list of all pairs with the ITEM on the right side,
		; and an object of type (LLOBJ 'left-type) on the left.
		; The point of this function is to find and return the complete
		; wild-card set (*,y) = {(x,y) | there-exists pair (x,y) for some x}
		; The pairs are Links of type 'pair-type, as would be returned by
		; 'get-pair. That is, this returns a list of atoms of the form
		;
		;    (LLOBJ 'make-pair $variable ITEM)
		;
		; ITEM should be an atom of (LLOBJ 'right-type); if it isn't,
		; the the behavior is undefined.
		;
		(define (do-get-left-stars ITEM)
			(let* ((lock (lock-mutex l-mtx))
					(old-as (cog-set-atomspace! l-ase))
					(uniqvar (VariableNode "$obj-api-left-star"))
					(term (LLOBJ 'make-pair uniqvar ITEM))
					(setlnk (cog-execute! (Bind (TypedVariable
						uniqvar (Type (symbol->string left-type)))
						term term)))
					(stars (cog-outgoing-set setlnk)))
				(cog-atomspace-clear l-ase)
				(cog-set-atomspace! old-as)
				(unlock-mutex l-mtx)
				stars))

		; Same as above, but on the right.
		(define (do-get-right-stars ITEM)
			(let* ((lock (lock-mutex r-mtx))
					(old-as (cog-set-atomspace! r-ase))
					(uniqvar (VariableNode "$obj-api-right-star"))
					(term (LLOBJ 'make-pair ITEM uniqvar))
					(setlnk (cog-execute! (Bind (TypedVariable
						uniqvar (Type (symbol->string right-type)))
						term term)))
					(stars (cog-outgoing-set setlnk)))
				(cog-atomspace-clear r-ase)
				(cog-set-atomspace! old-as)
				(unlock-mutex r-mtx)
				stars))

#! ============ Alternate variant, not currently used.
Yes, this actually works -- its just not being used.
		; Use a temporary atomspace for performing the query.
		; This is thread-safe, but quite slow when threads are
		; being constantly created/destroyed, as it results in
		; the temp atomspace being created/destroyed, which is
		; just inefficient and slow, in the end.
		(define (tmp-as-do-get-left-stars ITEM)
			(let* ((tmp-asp
						(let ((asp (fluid-ref l-asp)))
							(if asp asp<commit_msg>Start work on resource-instantiation-is-acquistion<commit_after>;
; object-api.scm
;
; Define object-oriented class API's for correlation matrices of atoms.
;
; Copyright (c) 2017 <NAME>
;
; ---------------------------------------------------------------------
; OVERVIEW
; --------
; In this project, there's a generic theme of "pairs of things" that
; are statistically related. These can be pairs of words, they can be
; connector-sets, which are a pair of (word, disjunct), or they can
; be other things.
;
; More precisely, we are generally interested in pairs (x,y) of atoms
; (that is, where x and y are atoms), and we have some sort of count
; N(x,y) of how often that particular pair was observed.  We typically
; are then interested in various statistical measures: usually starting
; with the normalized frequency (probability, likelihood) of how often
; the pair (x,y) occurred,
;
; For all of these pairs (x,y), we typically need to get the count
; N(x,y), the partial sums N(x,*) = sum_y N(x,y), and likewise N(*,y)
; and N(*,*).   We need to compute frequencies of observations, such
; as p(x,y) = N(x,y)/N(*,*).  We also need to compute entropies and
; mutual information, which can be inferred from these frequencies.
; We also can compute cosine-similarity and other metrics of similarity,
; derived solely from the observed frequency counts.
;
; All of these formulas are independent of the actual objects in the
; pairs.  Thus, it is useful to separate the various algorithms from
; the data that they operate on. Towards this end, this file defines
; some object-oriented OO API's for pairs, which the algos can assume,
; and the different types of pairs can implement.
;
; The object-system being used here is a roll-your-own type system,
; really quite simple, as it's well-suited for the desired task.
; It's simple, and minimal. The reasons for this are explained here:
;    http://community.schemewiki.org/?object-oriented-programming
; Basically, "object-oriented programming" is a mish-mash of more
; than half-a-dozen distinct concepts, almost all of which are
; not needed for this particular project.  The only thing we need
; is the ability to decorate objects with additional methods, kind-of
; like class inheritance, except that we really really need dynamic
; inheritance, i.e. arbitrary base classes, rather than a single,
; static base class, and so its totally unlike C++ inheritance, which
; is static, and a lot like C++ templates, which are dynamic.
; Basically, what is needed, and what is implemented here is called
; "parametric polymorphism".
;
; From what I can tell, tiny-CLOS and thus GOOPS does not support
; parametric polymorphism... !?? and so I go it alone. The system here
; is really really simple...
;
; The object system here is almost identical to this one:
;    http://community.schemewiki.org/?simple-object
; Read this URL to understand what is happening here.
;
; There are several API's here. The lowest-level ones are listed first.
;
; XXX FIXME ... the calling sequence is exactly backwards. In order
; for overloading to work correctly, attempts must be made to call
; methods on the base object first, and only later on the wrapper.
; For now, we blow this off, but in the long run, this needs to be
; fixed.
;
; ---------------------------------------------------------------------
;
; Example low-level API class. It has only six methods; these
; return atoms on which observation counts are stored as values.
; Higher-level objects use this object to fetch counts, store them
; into the database, or to return various statistics.
;
; The `add-pair-count-api` class, below, is a typical user of this
; class; it provides getters and setters for the counts.
;
; See `make-any-link-api` for a working example.
;
; When called, this will create a new instance of the class
; i.e. will create a new object.
;
;  (define (make-ll-object-api-example)
;
;     ; Return the atom-type of the matrix rows, i.e. the type of
;     ; the left side of the (row, column) pairs.
;     (define (get-left-type) 'WordNode)
;
;     ; Return the atom-type of the matrix columns, i.e. the type of
;     ; the right side of the (row, column) pairs.
;     (define (get-right-type) 'WordNode)
;
;     ; Return the type of the link that holds the pair.  In this
;     ; example, each pair will be held in the form
;     ;  (Evaluation (Predicate "foo") (List (Word "row") (Word "col")))
;     (define (get-pair-type) 'EvaluationLink)
;
;     ; Return the atom for a matrix (row,column) pair, if it exists,
;     ; else return nil. In this example, the matrix is defined by an
;     ; EvaluationLink holding the ListLink. This atom is where all
;     ; values associated with this matrix are held.  This includes not
;     ; only the count (the number of observations of the pair) but also
;     ; any derived values, such as frequency, mutual information, and
;     ; so on. Users are free to (are encouraged to) use this atom to
;     ; attach additional information and statistics.
;     ;
;     (define (get-pair L-ATOM R-ATOM)
;        (define maybe-list (cog-link 'ListLink L-ATOM R-ATOM))
;        (if (null? maybe-list) '()
;           (cog-link 'EvaluationLink (Predicate "foo") maybe-list)))
;
;     ; Return the observed count for the pair PAIR.
;     (define (get-count PAIR)
;        (cog-value-ref (cog-value PAIR (Predicate "counter")) 42))
;
;     ; Return the observed count for the pair (L-ATOM, R-ATOM), if it
;     ; exists, else return zero.
;     (define (get-pair-count L-ATOM R-ATOM)
;        (define stats-atom (get-pair L-ATOM R-ATOM))
;        (if (null? stats-atom) 0 (get-count stats-atom)))
;
;     ; Return the atom holding the count, creating it if it does
;     ; not yet exist.  Returns the same structure as the 'get-pair
;     ; method (the get-pair function, above).
;     (define (make-pair L-ATOM R-ATOM)
;        (Evaluation (Predicate "foo") (List L-ATOM R-ATOM)))
;
;     ; Return the left member of the pair. Given the pair-atom,
;     ; locate the left-side atom.
;     (define (get-left-element PAIR)
;        (gadr PAIR))
;
;     (define (get-right-element PAIR)
;        (gddr PAIR))
;
;     ; Return an atom to which column subtotals can be attached,
;     ; such as, for example, the subtotal `N(*,y)`. Thus, `y`
;     ; denotes a column, and the star is on the left (the star
;     ; ranging over all rows).
;     (define (get-left-wildcard ITEM)
;        (EvaluationLink (Predicate "foo")
;           (ListLink (AnyNode "left-wild") ITEM)))
;
;     ; Return an atom to which row subtotals can be attached,
;     ; such as, for example, the subtotal `N(x,*)`. Thus, `x`
;     ; denotes a row, and the star is on the right (the star
;     ; ranging over all columns).
;     (define (get-right-wildcard ITEM)
;        (EvaluationLink (Predicate "foo")
;           (ListLink ITEM (AnyNode "right-wild"))))
;
;     ; Return an atom to which matrix totals can be attached,
;     ; such as, for example, the total `N(*,*)`. This can be any
;     ; atom, but must be unique to the specific matrix. It's
;     ; convenient to use the same style as the subtotals.
;     (define (get-wild-wild)
;        (EvaluationLink (Predicate "foo")
;           (ListLink (AnyNode "left-wild") (AnyNode "right-wild"))))
;
;     ; Retrieve, from storage, the entire matrix, including the
;     ; subtotal and total anchor atoms.  In this example, its enough
;     ; to get the incoming set of (Predicate "foo"), but this need
;     ; not generally be the case.
;     (define (fetch-all-pairs)
;        (fetch-incoming-by-type (Predicate "foo") 'EvaluationLink))
;
;     ; Methods on the class. To call these, quote the method name.
;     ; Example: (OBJ 'left-wildcard WORD) calls the
;     ; get-left-wildcard function, passing WORD as the argument.
;     ;
;     ; The name is a string printed at the top of generated reports.
;     ; The id is a short string used to create unique filter ids and names.
;     (lambda (message . args)
;        (apply (case message
;              ((name) (lambda () "A Kind of Demonstration Object"))
;              ((id)   (lambda () "demo"))
;              ((left-type) get-left-type)
;              ((right-type) get-right-type)
;              ((pair-type) get-pair-type)
;              ((pair-count) get-pair-count)
;              ((get-pair) get-pair)
;              ((get-count) get-count)
;              ((make-pair) make-pair)
;              ((left-element) get-left-element)
;              ((right-element) get-right-element)
;              ((left-wildcard) get-left-wildcard)
;              ((right-wildcard) get-right-wildcard)
;              ((wild-wild) get-wild-wild)
;              ((fetch-pairs) fetch-all-pairs)
;              ((provides) (lambda (symb) #f))
;              ((filters?) (lambda () #f))
;              (else (error "Bad method call on low-level API")))
;           args)))
;
;
; ---------------------------------------------------------------------

(use-modules (srfi srfi-1))
(use-modules (ice-9 optargs)) ; for define*-public
(use-modules (ice-9 atomic))  ; for atomic-box
(use-modules (ice-9 threads)) ; for mutex locks
(use-modules (opencog) (opencog exec))

; ---------------------------------------------------------------------

(define-public (add-pair-stars LLOBJ)
"
  add-pair-stars LLOBJ - Extend LLOBJ with row and column access
  methods (aka wildcard methods); specifically, to get all non-zero
  elements in a given row or column.

  The supported methods are:
  'left-basis - Return all items (atoms) that can be used to index
      a row in the matrix.  That is, given a matrix N(x,y), this
      returns the set {x | (x,y) exists in the atomspace for some y}.
      All of the elements of this set will be atoms of type
      (LLOBJ 'left-type).  A check is made to verify that (x,y) is
      a valid pair, viz that it is an atom whose type is
      (LLOBJ 'pair-type) and that y is of type (LLOBJ 'right-type).
      This only verifies that such pairs exist in the atomspace; it
      does NOT verify that they have a nonzero count!

  'right-basis - Likewise, but for columns.

  'left-basis-size - the size of the 'left-basis set; i.e. the number
      of unique, distinct atoms in that set.

  'right-basis-size - Likewise.

  'left-stars COL - Return the set of pairs (row, column) for
      which the column is COL, and the pair exists in the atomspace.
      That is, return the set
         (*, COL) == { (x,COL) | (x,COL) exists in the atomspace }
      The returned pairs will all be of type (LLOBJ 'pair-type),
      and the x's will all be of type (LLOBJ 'left-type). The
      input COL atom must be of type (LLOBJ 'right-type).  This does
      NOT verify that these pairs have a non-zero count.

  'right-stars ROW - Likewise, but returns the set (ROW, *).

  Here, the LLOBJ is expected to be an object, with methods for
  'left-type, 'right-type and 'pair-type on it. It is assumed that
  the pairs are arity-two links having the form
     (pair-type (left-type right-type))
  That is, the pair-type is the low-level pair type.
"
	(let ((l-basis '())
			(r-basis '())
			(l-size 0)
			(r-size 0)

			; Caches for the left and right stars
			(l-hit (make-atomic-box '()))
			(l-miss (make-atomic-box '()))
			(r-hit (make-atomic-box '()))
			(r-miss (make-atomic-box '()))

#! ============ Alternate variant, not currently used.
			; Temporary atomspaces
			(l-asp (make-fluid))
			(r-asp (make-fluid))
=============== !#

			; Temporary atomspaces, non-fluid style.
			(l-mtx (make-mutex))
			(r-mtx (make-mutex))
			(l-ase (cog-new-atomspace (cog-atomspace)))
			(r-ase (cog-new-atomspace (cog-atomspace)))

			(pair-type (LLOBJ 'pair-type))
			(left-type (LLOBJ 'left-type))
			(right-type (LLOBJ 'right-type))
		)

		; Perform a query to find all atoms that might appear on
		; the left, or the right of a pair.  Return a list of them.
		(define (do-get-basis LEF)
			(define uleft (uniquely-named-variable))
			(define uright (uniquely-named-variable))
			(define term (LLOBJ 'make-pair uleft uright))
			(define setlnk (cog-execute! (Bind
				(VariableList
					(TypedVariable uleft (Type (symbol->string left-type)))
					(TypedVariable uright (Type (symbol->string right-type))))
				term (if LEF uleft uright))))
			(define basis (cog-outgoing-set setlnk))
			(cog-extract setlnk)
			(cog-extract-recursive uleft)
			(cog-extract-recursive uright)
			basis)

		; Return a list of all of the atoms that might ever appear on
		; the left-hand-side of a pair.  This is the set of all possible
		; items x from the pair (x,y) for any y.
		;
		(define (get-left-basis)
			(if (null? l-basis) (set! l-basis (do-get-basis #t)))
			l-basis)

		(define (get-right-basis)
			(if (null? r-basis) (set! r-basis (do-get-basis #f)))
			r-basis)

		(define (get-left-size)
			(if (eq? 0 l-size) (set! l-size (length (get-left-basis))))
			l-size)

		(define (get-right-size)
			(if (eq? 0 r-size) (set! r-size (length (get-right-basis))))
			r-size)

		;-------------------------------------------
		; Return a list of all pairs with the ITEM on the right side,
		; and an object of type (LLOBJ 'left-type) on the left.
		; The point of this function is to find and return the complete
		; wild-card set (*,y) = {(x,y) | there-exists pair (x,y) for some x}
		; The pairs are Links of type 'pair-type, as would be returned by
		; 'get-pair. That is, this returns a list of atoms of the form
		;
		;    (LLOBJ 'make-pair $variable ITEM)
		;
		; ITEM should be an atom of (LLOBJ 'right-type); if it isn't,
		; the the behavior is undefined.
		;
		(define (do-get-stars VAR TYPE TERM ASPACE)
			(let* ((old-as (cog-set-atomspace! ASPACE))
					(setlnk (cog-execute! (Bind (TypedVariable
						VAR (Type (symbol->string TYPE)))
						TERM TERM)))
					(stars (cog-outgoing-set setlnk)))
				(cog-atomspace-clear ASPACE)
				(cog-set-atomspace! old-as)
				stars))

		(define (do-get-left-stars ITEM)
			(let* ((lock (lock-mutex l-mtx))
					(uniqvar (VariableNode "$obj-api-left-star"))
					(term (LLOBJ 'make-pair uniqvar ITEM))
					(stars (do-get-stars uniqvar left-type term l-ase)))
				(unlock-mutex l-mtx)
				stars))

		; Same as above, but on the right.
		(define (do-get-right-stars ITEM)
			(let* ((lock (lock-mutex r-mtx))
					(uniqvar (VariableNode "$obj-api-right-star"))
					(term (LLOBJ 'make-pair ITEM uniqvar))
					(stars (do-get-stars uniqvar right-type term r-ase)))
				(unlock-mutex r-mtx)
				stars))

#! ============ Alternate variant, not currently used.
Yes, this actually works -- its just not being used.
		; Use a temporary atomspace for performing the query.
		; This is thread-safe, but quite slow when threads are
		; being constantly created/destroyed, as it results in
		; the temp atomspace being created/destroyed, which is
		; just inefficient and slow, in the end.
		(define (tmp-as-do-get-left-stars ITEM)
			(let* ((tmp-asp
						(let ((asp (fluid-ref l-asp)))
							(if asp asp
{'fraction_non_alphanumeric': 0.13944501815516838, 'fraction_numerical': 0.0009993670675239015, 'mean_word_length': 2.6811771919068055, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 12, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6861544', 'n_tokens_mistral': 10026, 'n_tokens_neox': 9254, 'n_words': 3724}