<commit_before>;
; filter.scm
;
; Define API's for filtering the matrixes, e.g. by removing rows,
; columns or individual entries with low counts.
;
; Copyright (c) 2017, 2019 <NAME>
;
; ---------------------------------------------------------------------
; OVERVIEW
; --------
; Large datasets are inherently likely to contain "noise" and spurious
; data that might be unwanted during data analysis. For example, the
; dataset might contain a large number of atoms that were observed only
; once or twice; these are likely to be junk and should be removed
; before data analysis begins.
;
; The code here provides this filtering ability. Several types of
; filters are provided:
; -- a knockout filter, that knocks out designated rows and columns.
; -- a min-count filter, that knocks out rows and columns whose
;    marginal counts are below a minimum, as well as individual matrix
;    entries that are below a per-entry minimum.
; -- a generic callback-defined filter, that knocks out rows, columns
;    and individual entries based on callback predicates.
;
; Note that these filters are all "on demand": they do NOT copy the
; dataset and then compute a smaller version of it.  Instead, they
; overload the "star" API, altering the methods used to fetch rows,
; columns and individual entries.  Since all the other matrix access
; routines use the "star" API to gain access to the matrix and it's
; marginals, this works!
;
; ---------------------------------------------------------------------

(use-modules (srfi srfi-1))
(use-modules (ice-9 optargs)) ; for define*-public

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

(define-public (add-generic-filter LLOBJ
	LEFT-BASIS-PRED RIGHT-BASIS-PRED PAIR-PRED
   ID-STR RENAME)
"
  add-generic-filter LLOBJ - Modify LLOBJ so that only the columns and
  rows and individual entries that satisfy the predicates are retained.

  The LEFT-BASIS-PRED and RIGHT-BASIS-PRED should be functions that
  accept atoms in the left and right basis, and return #t if they
  should be kept. If these predicates return #f, that row or column
  will not appear in the filtered matrix.

  The PAIR-PRED should be a function to that accepts individual matrix
  entries. It is applied whenever the 'get-pair or 'get-count methods
  are invoked.  Like the others, it should return #t to keep the pair.

  The ID-STR should be a string; it is appended to the dataset name and
  id, so that unique identifier names can be constructed for each
  filtered dataset.

  The RENAME argument should be #f or #t, it is used to determine how
  other API's generate predicate keys to obtain values.
"
	(let ((stars-obj (add-pair-stars LLOBJ))
			(l-basis '())
			(r-basis '())
			(l-size 0)
			(r-size 0)
		)

		; ---------------
		; Filter out rows and columns that pass the left and right
		; predicates.
		(define (do-left-basis)
			(filter LEFT-BASIS-PRED (stars-obj 'left-basis)))

		(define (do-right-basis)
			(filter RIGHT-BASIS-PRED (stars-obj 'right-basis)))

		; ---------------
		; Use the cached value, if its there.
		(define (get-left-basis)
			(if (null? l-basis) (set! l-basis (do-left-basis)))
			l-basis)

		(define (get-right-basis)
			(if (null? r-basis) (set! r-basis (do-right-basis)))
			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 only those duals that pass the cutoffs.
		;
		(define (do-left-duals RITEM)
			; Get all the left-elements corresponding to RITEM
			(filter
				(lambda (LITEM)
					(and
						(LEFT-BASIS-PRED LITEM)
						(PAIR-PRED (LLOBJ 'get-pair LITEM RITEM))))
				(stars-obj 'left-duals RITEM)))

		(define (do-right-duals LITEM)
			(filter
				(lambda (RITEM)
					(and
						(RIGHT-BASIS-PRED RITEM)
						(PAIR-PRED (LLOBJ 'get-pair LITEM RITEM))))
				(stars-obj 'right-duals LITEM)))

		; Cache the results above, so that we don't recompute over and over.
		(define cache-left-duals (make-afunc-cache do-left-duals))
		(define cache-right-duals (make-afunc-cache do-right-duals))

		; ---------------
		; Return only those stars that pass the cutoff.
		;
		(define (do-left-stars RITEM)
			; Apply the pair-pred cutoff
			(filter PAIR-PRED
				(map
					; Convert all left-right pairs into real pairs
					(lambda (LBASE) (LLOBJ 'get-pair LBASE RITEM))
					; Get all the left-elements corresponding to RITEM
					(filter LEFT-BASIS-PRED (stars-obj 'left-duals RITEM)))))

		(define (do-right-stars LITEM)
			(filter PAIR-PRED
				(map
					(lambda (RBASE) (LLOBJ 'get-pair LITEM RBASE))
					(filter RIGHT-BASIS-PRED (stars-obj 'right-duals LITEM)))))

		; Cache the results above, so that we don't recompute over and over.
		(define cache-left-stars (make-afunc-cache do-left-stars))
		(define cache-right-stars (make-afunc-cache do-right-stars))

		; ---------------
		; Apply the pair-cut to each pair.
		(define (get-item-pair L-ATOM R-ATOM)
			(if (PAIR-PRED (LLOBJ 'get-pair L-ATOM R-ATOM)) '()))

		(define (get-pair-count PAIR)
			(if (PAIR-PRED (LLOBJ 'get-count PAIR)) 0))

		; ---------------
		(define (get-name)
			(string-append (LLOBJ 'name) " " ID-STR))
		(define (get-id)<commit_msg>Improve filter performance with caching.<commit_after>;
; filter.scm
;
; Define API's for filtering the matrixes, e.g. by removing rows,
; columns or individual entries with low counts.
;
; Copyright (c) 2017, 2019 <NAME>
;
; ---------------------------------------------------------------------
; OVERVIEW
; --------
; Large datasets are inherently likely to contain "noise" and spurious
; data that might be unwanted during data analysis. For example, the
; dataset might contain a large number of atoms that were observed only
; once or twice; these are likely to be junk and should be removed
; before data analysis begins.
;
; The code here provides this filtering ability. Several types of
; filters are provided:
; -- a knockout filter, that knocks out designated rows and columns.
; -- a min-count filter, that knocks out rows and columns whose
;    marginal counts are below a minimum, as well as individual matrix
;    entries that are below a per-entry minimum.
; -- a generic callback-defined filter, that knocks out rows, columns
;    and individual entries based on callback predicates.
;
; Note that these filters are all "on demand": they do NOT copy the
; dataset and then compute a smaller version of it.  Instead, they
; overload the "star" API, altering the methods used to fetch rows,
; columns and individual entries.  Since all the other matrix access
; routines use the "star" API to gain access to the matrix and it's
; marginals, this works!
;
; ---------------------------------------------------------------------

(use-modules (srfi srfi-1))
(use-modules (ice-9 optargs)) ; for define*-public

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

(define-public (add-generic-filter LLOBJ
	LEFT-BASIS-PRED RIGHT-BASIS-PRED PAIR-PRED
   ID-STR RENAME)
"
  add-generic-filter LLOBJ - Modify LLOBJ so that only the columns and
  rows and individual entries that satisfy the predicates are retained.

  The LEFT-BASIS-PRED and RIGHT-BASIS-PRED should be functions that
  accept atoms in the left and right basis, and return #t if they
  should be kept. If these predicates return #f, that row or column
  will not appear in the filtered matrix.

  The PAIR-PRED should be a function to that accepts individual matrix
  entries. It is applied whenever the 'get-pair or 'get-count methods
  are invoked.  Like the others, it should return #t to keep the pair.

  The ID-STR should be a string; it is appended to the dataset name and
  id, so that unique identifier names can be constructed for each
  filtered dataset.

  The RENAME argument should be #f or #t, it is used to determine how
  other API's generate predicate keys to obtain values.
"
	(let ((stars-obj (add-pair-stars LLOBJ))
			(l-basis '())
			(r-basis '())
			(l-size 0)
			(r-size 0)
		)

		; Cache the result of filtering basuis elements
		(define cache-left-pred (make-afunc-cache LEFT-BASIS-PRED))
		(define cache-right-pred (make-afunc-cache RIGHT-BASIS-PRED))

		; ---------------
		; Filter out rows and columns that pass the left and right
		; predicates.
		(define (do-left-basis)
			(filter cache-left-pred (stars-obj 'left-basis)))

		(define (do-right-basis)
			(filter cache-right-pred (stars-obj 'right-basis)))

		; ---------------
		; Use the cached value, if its there.
		(define (get-left-basis)
			(if (null? l-basis) (set! l-basis (do-left-basis)))
			l-basis)

		(define (get-right-basis)
			(if (null? r-basis) (set! r-basis (do-right-basis)))
			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 only those duals that pass the cutoffs.
		;
		(define (do-left-duals RITEM)
			; Get all the left-elements corresponding to RITEM
			(filter
				(lambda (LITEM)
					(and
						(cache-left-pred LITEM)
						(PAIR-PRED (LLOBJ 'get-pair LITEM RITEM))))
				(stars-obj 'left-duals RITEM)))

		(define (do-right-duals LITEM)
			(filter
				(lambda (RITEM)
					(and
						(cache-right-pred RITEM)
						(PAIR-PRED (LLOBJ 'get-pair LITEM RITEM))))
				(stars-obj 'right-duals LITEM)))

		; Cache the results above, so that we don't recompute over and over.
		(define cache-left-duals (make-afunc-cache do-left-duals))
		(define cache-right-duals (make-afunc-cache do-right-duals))

		; ---------------
		; Return only those stars that pass the cutoff.
		;
		(define (do-left-stars RITEM)
			; Apply the pair-pred cutoff
			(filter PAIR-PRED
				(map
					; Convert all left-right pairs into real pairs
					(lambda (LBASE) (LLOBJ 'get-pair LBASE RITEM))
					; Get all the left-elements corresponding to RITEM
					(filter cache-left-pred (stars-obj 'left-duals RITEM)))))

		(define (do-right-stars LITEM)
			(filter PAIR-PRED
				(map
					(lambda (RBASE) (LLOBJ 'get-pair LITEM RBASE))
					(filter cache-right-pred (stars-obj 'right-duals LITEM)))))

		; Cache the results above, so that we don't recompute over and over.
		(define cache-left-stars (make-afunc-cache do-left-stars))
		(define cache-right-stars (make-afunc-cache do-right-stars))

		; ---------------
		; Apply the pair-cut to each pair.
		(define (get-item-pair L-ATOM R-ATOM)
			(if (PAIR-PRED (LLOBJ 'get-pair L-ATOM R-ATOM)) '()))

		(define (get-pair-count PAIR)
			(if (PAIR-PRED (LLOBJ 'get-count PAIR)) 0))

		; ---------------
		(define (get-name)
			(string-append (LLOBJ 'name) " " ID-STR))
		(define (get-id)
{'fraction_non_alphanumeric': 0.15945246022937476, 'fraction_numerical': 0.002774694783573807, 'mean_word_length': 2.5911657256725342, 'pattern_counts': {'":': 2, '<': 5, '<?xml version=': 0, '>': 5, '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': '3679432', 'n_tokens_mistral': 3842, 'n_tokens_neox': 3327, 'n_words': 1268}