; mi-verify.scm — data-level MI tie: opencog matrix `pair-fmi` vs our cpu_mi.
; Tiny hand-computable word-pair dataset -> batch-all-pair-mi -> read pair-fmi,
; compare to log2(count*N/(Nx*·N*y)) which our GPU kernel is verified == to.
(use-modules (srfi srfi-1))
(use-modules (opencog) (opencog matrix))
; --- make-basic-api (verbatim from matrix/tests/matrix/basic-api.scm) ---
(define (make-basic-api)
(define (get-left-type) 'ConceptNode)
(define (get-right-type) 'ConceptNode)
(define (get-pair-type) 'EvaluationLink)
(define (get-pair L-ATOM R-ATOM)
(define maybe-list (cog-link 'ListLink L-ATOM R-ATOM))
(if (not maybe-list) '()
(cog-link 'EvaluationLink (Predicate "foo") maybe-list)))
(define (get-count PAIR)
(cog-value-ref (cog-value PAIR (Predicate "counter")) 2))
(define (get-pair-count L-ATOM R-ATOM)
(define stats-atom (get-pair L-ATOM R-ATOM))
(if (not stats-atom) 0 (get-count stats-atom)))
(define (make-pair L-ATOM R-ATOM)
(EvaluationLink (Predicate "foo") (List L-ATOM R-ATOM)))
(define (get-left-element PAIR) (gadr PAIR))
(define (get-right-element PAIR) (gddr PAIR))
(define (get-left-wildcard ITEM)
(EvaluationLink (Predicate "foo") (ListLink (AnyNode "left-wild") ITEM)))
(define (get-right-wildcard ITEM)
(EvaluationLink (Predicate "foo") (ListLink ITEM (AnyNode "right-wild"))))
(define (get-wild-wild)
(EvaluationLink (Predicate "foo") (ListLink (AnyNode "left-wild") (AnyNode "right-wild"))))
(define (fetch-all-pairs) '())
(lambda (message . args)
(apply (case message
((name) (lambda () "MI verify demo"))
((id) (lambda () "mi-verify"))
((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)))
(define bapi (make-basic-api))
(define sapi (add-pair-stars bapi))
(define fapi (add-pair-freq-api sapi))
; --- tiny dataset: (left right count) ---
(define data '(("the" "cat" 2.0) ("the" "dog" 1.0) ("a" "cat" 1.0)))
; set a count on a pair the way the basic-api reads it (FloatValue index 2)
(define (observe L R cnt)
(define p (bapi 'make-pair (Concept L) (Concept R)))
(cog-set-value! p (Predicate "counter") (FloatValue 0 0 cnt))
p)
(for-each (lambda (row) (apply observe row)) data)
; --- opencog computes marginals, freqs, entropies, MI (in-RAM, no store) ---
(batch-all-pair-mi bapi #f)
; --- our reference marginals from the raw counts (hand/independent) ---
(define (log2 x) (/ (log x) (log 2)))
(define N (fold + 0 (map caddr data)))
(define (Nx* L) (fold + 0 (map caddr (filter (lambda (r) (string=? (car r) L)) data))))
(define (N*y R) (fold + 0 (map caddr (filter (lambda (r) (string=? (cadr r) R)) data))))
(define (cpu-fmi L R cnt) (log2 (/ (* cnt N) (* (Nx* L) (N*y R)))))
; --- compare opencog pair-fmi vs cpu-fmi for each pair ---
(define tol 1e-6)
(define all-ok #t)
(display "pair count Nx* N*y opencog-fmi cpu-fmi diff\n")
(for-each
(lambda (row)
(define L (car row)) (define R (cadr row)) (define cnt (caddr row))
(define p (bapi 'get-pair (Concept L) (Concept R)))
(define oc (fapi 'pair-fmi p))
(define cpu (cpu-fmi L R cnt))
(define d (abs (- oc cpu)))
(if (> d tol) (set! all-ok #f))
(format #t "~a-~a\t ~a ~a ~a ~9,6f ~9,6f ~9,2e\n"
L R cnt (Nx* L) (N*y R) oc cpu d))
data)
(newline)
(display (if all-ok "MI DATA-VERIFY PASS: opencog pair-fmi == cpu_mi (== our GPU kernel)\n"
"MI DATA-VERIFY FAIL\n"))