; duplicate items in an array
(define (identity x) x)
(define (make-hash hash eql? size)
(let ((hash-table (make-vector size (list))))
(case-lambda
((lookup key)
(let ((idx (modulo (hash key) size)))
(let loop ((bucket (vector-ref hash-table idx)))
(cond ((null? bucket) bucket)
((eql? (caar bucket) key) (car bucket))
(else (loop (cdr bucket)))))))
((install key value)
(let ((idx (modulo (hash key) size)))
(let loop ((bucket (vector-ref hash-table idx)) (new-bucket (list)))
(cond ((null? bucket)
(vector-set! hash-table idx (cons (cons key value) new-bucket)))
((eql? (caar bucket) key)
(vector-set! hash-table idx
(append (cons (cons key value) (cdr bucket)) new-bucket)))
(else (loop (cdr bucket) (cons (car bucket) new-bucket)))))))
(else (error 'hash-table "unrecognized command")))))
(define (dup-hash xs)
(let ((h (make-hash identity = 97))
(dups (list)))
(do ((xs xs (cdr xs)))
((null? xs) dups)
(when (pair? (h 'get (car xs)))
(set! dups (cons (car xs) dups)))
(h 'put (car xs) (car xs)))))
(define (dup-sort xs)
(let ((xs (sort xs <)))
(let loop ((prev (car xs)) (xs (cdr xs)) (dups (list)))
(if (null? xs) dups
(if (= prev (car xs))
(loop prev (cdr xs) (cons (car xs) dups))
(loop (car xs) (cdr xs) dups))))))
(define xs '(1 2 3 1 4))
(define ys '(1 2 3 1 2 4 1))
(display (dup-hash xs)) (newline)
(display (dup-sort xs)) (newline)
(display (dup-hash ys)) (newline)
(display (dup-hash ys)) (newline)