Skip to content

Instantly share code, notes, and snippets.

@maruks
Created December 7, 2022 21:13
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save maruks/8f0a85c22571b5cbf700cd018f862e92 to your computer and use it in GitHub Desktop.
Save maruks/8f0a85c22571b5cbf700cd018f862e92 to your computer and use it in GitHub Desktop.
Hash table
(defpackage #:my-hash-table
(:use #:cl #:arrows)
(:export #:new-hash #:put-hash #:get-hash #:hash-keys #:hash-values #:rem-hash))
(in-package #:my-hash-table)
(defun ->hash-code (key)
(-<> (format nil "~A" key)
(coerce <> 'list)
(reduce (lambda (hash elem) (+ (* 31 hash) (char-code elem))) <> :initial-value 0)))
(defun ->position (table-size key)
(rem (->hash-code key) table-size))
(defun new-hash (&optional (size 100))
(make-array (list size) :initial-element nil))
(defun get-hash (table key &optional default)
(let ((pos (->position (length table) key)))
(-<> (aref table pos)
(assoc key <> :test #'eq)
(cdr)
(or <> default))))
(defun put-hash (table key item)
(let* ((pos (->position (length table) key))
(chain (aref table pos))
(pair (assoc key chain :test #'eq)))
(prog1
(cdr pair)
(if (null pair)
(push (cons key item) (aref table pos))
(rplacd pair item)))))
(defun hash-size (table)
(-<>> (coerce table 'list)
(mapcar #'length)
(reduce #'+ <> :initial-value 0)))
(defun rem-hash (table key)
(let* ((pos (->position (length table) key))
(chain (aref table pos)))
(delete-if (lambda (x) (eq key (car x))) chain)))
(defun collect (table fn)
(->> (coerce table 'list)
(mapcar (lambda (xs) (mapcar fn xs)))
(apply #'append)))
(defun hash-keys (table)
(collect table #'car))
(defun hash-values (table)
(collect table #'cdr))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment