(module select-playlist mzscheme
  
  (require (lib "contract.ss")
           "parse-playlist.ss"
           (lib "list.ss"))
  
  (provide/contract [select-playlist
                     (music-db? ; source playlist
                      integer? ; maximum cumulative playlist size
                      . -> .
                      (listof (listof any/c)))])
  
  (define (bin-sort selector records)
    (define ht (make-hash-table))
    (for-each
     (lambda (record)
       (let ([field (selector record)])
         (define my-box (hash-table-get ht field (lambda ()
                                                   (define new-box (box null))
                                                   (hash-table-put! ht field new-box)
                                                   new-box)))
         (set-box! my-box (cons record (unbox my-box)))))
     records)
    ht)
  
  (define (shuffle-boxed-list! boxed-list)
    (set-box! boxed-list
              (let loop ([remaining (length (unbox boxed-list))])
                (if (= remaining 0)
                    null
                    (let ([selected (random remaining)])
                      (cons
                       (if (= selected 0)
                           (let ([result (car (unbox boxed-list))])
                             (set-box! boxed-list (cdr (unbox boxed-list)))
                             result)
                           (let loop ([index (- selected 1)] [last-pair (unbox boxed-list)])
                             (if (= index 0)
                                 (let ([result (cadr last-pair)])
                                   (set-cdr! last-pair (cddr last-pair))
                                   result)
                                 (loop (- index 1) (cdr last-pair)))))
                       (loop (- remaining 1)))))))
    boxed-list)
  
  ;(display (unbox (shuffle-boxed-list! (box `(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))))
  
  (define (select-playlist db max-size)
    (define sorted (bin-sort ((music-db-indexer db) "My Rating") (music-db-records db)))
    (define shuffled-bins (hash-table-map sorted
                                          (lambda (key val)
                                            (list key (unbox (shuffle-boxed-list! val))))))
    (define-struct bin (elts weight size))
    ; one-star songs unused.
    (define twostar (cadr (assq 40 shuffled-bins)))
    (define threestar (cadr (assq 60 shuffled-bins)))
    (define fourstar (cadr (assq 80 shuffled-bins)))
    (define fivestar (cadr (assq 100 shuffled-bins)))
    (define unstarred (cadr (assq #f shuffled-bins)))
    (define bins (list (make-bin fivestar 12 (length fivestar))
                       (make-bin fourstar 10 (length fourstar))
                       (make-bin threestar 6 (length threestar))
                       (make-bin twostar 2 (length twostar))
                       (make-bin unstarred 4 (length unstarred))))
    (define decider (lambda ()
                      (let* ([weighted-sum (apply + (map (lambda (bin)
                                                           (* (bin-weight bin) (bin-size bin)))
                                                         bins))]
                             [ran (random weighted-sum)])
                        (let loop ([bins bins] [ran ran]) 
                          ; should never get to null, by numeric properties
                          (let* ([bin (car bins)]
                                 [weighted-size (* (bin-weight bin) (bin-size bin))])
                            (if (< ran weighted-size)
                                (let ([selected (car (bin-elts bin))])
                                  (set-bin-size! bin (- (bin-size bin) 1))
                                  (set-bin-elts! bin (cdr (bin-elts bin)))
                                  selected)
                              (loop (cdr bins) (- ran weighted-size))))))))
    (define get-size ((music-db-indexer db) "Size"))
    (let loop ([size-left max-size])
      (let ([chosen (decider)])
        (if (> (get-size chosen) size-left)
            null
            (cons chosen (loop (- size-left (get-size chosen))))))))
  
 #;(define (output-playlist db song-list filename)
     (call-with-output-file filename
       (lambda (port)
         ((music-db-outputter db) song-list port))
       'truncate))
  
  #;(let ([library (parse-playlist "/Users/clements/Documents/Library.txt")])
      (output-playlist library
                       (select-playlist library 4600000000)
                       "/Users/clements/Documents/new-list.txt")))