(use srfi-1 srfi-13 #;srfi-69 extras)
(use data-structures)
(use test)
(use message-digest)
(use bloom-filter)
(use sha1 md5 sha2)
#;(use tiger-hash ripemd)
#;(use
  APHash
  BKDRHash
  BRPHash
  CRCHash
  DEKHash
  DJBHash
  ELFHash
  FNVAHash
  FNVHash
  ISPLHash
  JSHash
  NDJBHash
  PHSFHash
  PJWHash
  PYHash
  RJL3Hash
  RJMXHash
  RSHash
  SDBMHash
  TWMGMXHash
  TWMXHash
  TWSHMLMXHash
  TWSHMXHash)

(define palindromic-word-list
  '("bob"
    "elle"
    "evil"
    "flow"
    "harrah"
    "hexeh"
    "js"
    "live"
    "map"
    "non"
    "pam"
    "pop"
    "radar"
    "sj"
    "wolf")
  #; ;Compute above from word file
  (let* ((word-list (read-file "bloom-filter-word-list.txt"))
         (word-tbl (alist->hash-table (map (cut cons <> #t) word-list)))
         (other-word-list (map string-reverse word-list)) )
    (fold
      (lambda (wrd ls)
        (if (hash-table-exists? word-tbl wrd) (cons wrd ls) ls) )
      '()
      other-word-list) ))

(define-syntax test-success
  (syntax-rules ()
    ((_ ?expr)
      (test-assert (begin ?expr #t)) )
    ((_ ?mesg ?expr)
      (test-assert ?mesg (begin ?expr #t)) ) ) )

(test-group "Bloom Filter"

  #;(define +gloss+ '())
  #;(define (gloss str) (set! +gloss+ (cons str +gloss+)))
  #;(define (dump-gloss) (print ":Gloss:") (pp +gloss+))
  (define (gloss obj) (print "Gloss: " obj))
  (define (dump-gloss) (void))

  (define word-list (read-file "bloom-filter-word-list.txt"))

  (define mdps (list (sha512-primitive) (md5-primitive) (sha1-primitive)))
  #;(define mdps (list (sha512-primitive) (md5-primitive) (tiger192-primitive)))
  #;(define mdps (list (sha512-primitive) (ripemd160-primitive) (tiger192-primitive)))
  #;(define mdps (list 
    (APHash-primitive)
    (BKDRHash-primitive)
    (BRPHash-primitive)
    (CRCHash-primitive)
    (DEKHash-primitive)
    (DJBHash-primitive)
    (ELFHash-primitive)
    (FNVAHash-primitive)
    (FNVHash-primitive)
    (ISPLHash-primitive)
    (JSHash-primitive)
    (NDJBHash-primitive)
    (PHSFHash-primitive)
    (PJWHash-primitive)
    (PYHash-primitive)
    (RJL3Hash-primitive)
    (RJMXHash-primitive)
    (RSHash-primitive)
    (SDBMHash-primitive)
    (TWMGMXHash-primitive)
    (TWMXHash-primitive)
    (TWSHMLMXHash-primitive)
    (TWSHMXHash-primitive)))
  #;(randomize) #;(set! mdps (shuffle mdps random))

  (gloss (map message-digest-primitive-name mdps))

  (define N (length word-list))
  (define other-word-list (map string-reverse word-list))
  (define P 2.47E-05)

  (let ((MK #f)
        (bf #f)
        (false-positives '()) )
    (test-group "Words In List, All K"

      (test-assert (= 2 (length (receive (optimum-size P N)))))
      (set! MK (receive (optimum-size P N)))
      (gloss (sprintf "N = ~A, M = ~A, K = ~A, P = ~A"
        N (car MK) (cadr MK) P))

      (test-success "Make"
        (set! bf (make-bloom-filter P N mdps)))

      (test-success "Add Bloom Filter"
        (for-each (cut bloom-filter-set! bf <>) word-list))

      (test-assert "Exists in Bloom Filter?"
        (every (cut bloom-filter-exists? bf <>) word-list))

      (test-success "False positives"
        (set! false-positives
          (filter (cut bloom-filter-exists? bf <>) other-word-list)))

      (gloss (sprintf "Calced Palindromic words: ~A" (sort false-positives string<?)))
      (gloss (sprintf "Actual Palindromic words: ~A" palindromic-word-list))
      (test (length palindromic-word-list) (length false-positives))
    ) )

  (let ((MKP* #f)
        (MKP #f)
        (bf #f)
        (false-positives '()) )
    (test-group "Words In List, All K"
      (test-assert (actual-k mdps))
      (gloss (sprintf "K = ~A" (actual-k mdps)))

      (test-assert (= 3 (length (receive (desired-m P N)))))
      (set! MKP* (receive (desired-m P N)))
      (gloss (sprintf "N = ~A, M = ~A, K = ~A, P = ~A"
        N (car MKP*) (cadr MKP*) (caddr MKP*)))

      (test-assert (= 3 (length (receive (desired-m P N (actual-k mdps))))))
      (set! MKP (receive (desired-m P N (actual-k mdps))))
      (gloss (sprintf "N = ~A, M = ~A, K = ~A, P = ~A"
        N (car MKP) (cadr MKP) (caddr MKP)))

      (test-success "Make"
        (set! bf (make-bloom-filter (car MKP) mdps)))

      (test-success "Add Bloom Filter"
        (for-each (cut bloom-filter-set! bf <>) word-list))

      (test-assert "Exists in Bloom Filter?"
        (every (cut bloom-filter-exists? bf <>) word-list))

      (test-success "False positives"
        (set! false-positives
          (filter (cut bloom-filter-exists? bf <>) other-word-list)))

      (gloss (sprintf "Calced Palindromic words: ~A" (sort false-positives string<?)))
      (gloss (sprintf "Actual Palindromic words: ~A" palindromic-word-list))
      (test (length palindromic-word-list) (length false-positives))
    ) )

  (let ((MKP #f)
        (bf #f)
        (false-positives '()) )
    (test-group "Words In List, Optimal K"
      (test-assert (= 3 (length (receive (desired-m P N)))))
      (set! MKP (receive (desired-m P N)))
      (gloss (sprintf "N = ~A, M = ~A, K = ~A, P = ~A"
        N (car MKP) (cadr MKP) (caddr MKP)))
      (test-success "Make"
        (set! bf (make-bloom-filter (car MKP) mdps (cadr MKP))))
      (test-success "Add Bloom Filter"
        (for-each (cut bloom-filter-set! bf <>) word-list))
      (test-assert "Exists in Bloom Filter?"
        (every (cut bloom-filter-exists? bf <>) word-list))
      (test-success "False positives"
        (set! false-positives
          (filter (cut bloom-filter-exists? bf <>) other-word-list)))
      (gloss (sprintf "Calced Palindromic words: ~A" (sort false-positives string<?)))
      (gloss (sprintf "Actual Palindromic words: ~A" palindromic-word-list))
      (test (length palindromic-word-list) (length false-positives))
  ) )

  (dump-gloss)
)

(test-exit)