(module perfect-hash mzscheme
  ;; an attempt at the perfect hashing problem defined in 
  ;; http://online-judge.uva.es/p/v1/188.html
  
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
           (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2))
           (only (lib "etc.ss") local)
           (lib "list.ss")
           (only (lib "1.ss" "srfi") append-map))
  
  (provide (all-defined))
  
  ;; First, let's define a function for computing hash values.
  
  ;; compute-hash: positive-number positive-number positive-number ->
  ;; natural
  (define (compute-hash C w n)
    (modulo (quotient C w) n))
  
  ;; We also need a way of converting a word into a number.  Let's do
  ;; that now.
  
  ;; word->number: string -> natural
  ;; Converts a word into some number.
  (define (word->number word)
    (let ([n (string-length word)]
          [ord-a (char->integer #\a)])
      (let loop ([result 0]
                 [i 0])
        (cond
          [(= i n)
           result]
          [else
           (loop (+ (* result 32)
                    (add1 (- (char->integer (string-ref word i))
                             ord-a)))
                 (add1 i))]))))
  
  ;; Going back to the problem, we need to be able to find
  ;; the least C such that the hashes are all distinct.
  ;;
  ;; If there's a conflict, the next largest C that could resolve
  ;; the conflict is at least:
  ;;
  ;; (min (* (+ 1 (floor (quotient C w_i))) w_i)
  ;;      (* (+ 1 (floor (quotient C w_j))) w_j))   

  ;; resolve-conflict: positive-number positive-number positive-number -> positive-number
  ;; Computes the next candidate C that resolves the conflict between w_i and w_j.
  (define (resolve-conflict C w_i w_j)
    (min (* (add1 (quotient C w_i)) w_i)
         (* (add1 (quotient C w_j)) w_j)))
  
  
  ;; pairwise-map: (X X -> Y) (listof X) -> (listof Y)
  ;; computes f across all distinct pairs of elements in l.
  (define (pairwise-map f l)
    (cond
      [(empty? (rest l)) '()]
      [else
       (append
        (map (lambda (y) (f (first l) y)) (rest l))
        (pairwise-map f (rest l)))]))
  
  
  ;; We need some way of finding conflicts among words.
  ;; Let's write a helper function.
  ;;
  ;; find-conflicts: (listof positive-number) positive-number -> 
  ;;     (listof (listof positive-number))
  ;; Returns a partitioning of the word numbers based on their hashes.
  (define (find-conflicts word-numbers C)
    (let ([n (length word-numbers)])
      (hash-table-values
       (partition (lambda (w_i)
                    (compute-hash C w_i n))
                  word-numbers))))
  
  
  ;; partition: (number -> number) (listof numbers) ->
  ;; (hash-table-of number (listof number))
  (define (partition f numbers)
    (local ((define ht (make-hash-table 'equal))
            (define (add! n)
              (let* ([hash (f n)]
                     [table (hash-table-get ht hash '())])
                (hash-table-put! ht hash (cons n table)))))
      (for-each add! numbers)
      ht))
  
  
  ;; hash-table-values: (hash-table-of X Y) -> (listof Y)
  (define (hash-table-values ht)
    (hash-table-map ht (lambda (k v) v)))
  
  
  ;; find-C: (listof positive-number) -> number
  ;; Finds the minimal C that is a perfect hash.
  (define (find-C word-numbers)
    (local ((define (acceptable? parts)
              (andmap (lambda (l) (= (length l) 1)) parts))
            
            (define (next-candidate parts C)
              (apply max
                     (append-map
                      (lambda (p)
                        (pairwise-map (lambda (x y)
                                        (resolve-conflict C x y))
                                      p))
                      parts))))
      (let loop ([C (apply min word-numbers)])
        (let ([parts (find-conflicts word-numbers C)])
          (cond
            [(acceptable? parts) C]
            [else
             (loop (next-candidate parts C))])))))
  
  
  
  (define perfect-hash-tests
    (test-suite
     "perfect-hash.ss"
     (test-equal? "(word->number \"a\")"
                  (word->number "a") 1)
     (test-equal? "(word->number \"bz\")"
                  (word->number "bz")
                  (+ (* 2 32) 26))
     (test-equal? "(word->number \"abc\")"
                  (word->number "abc")
                  (+ (* 1 (expt 32 2))
                     (* 2 (expt 32 1))
                     (* 3 (expt 32 0))))))
  
  (test/text-ui perfect-hash-tests))