From 23d17f946315b4559910520b4d624ae25838f2a4 Mon Sep 17 00:00:00 2001 From: Robert Mayer Date: Wed, 4 Dec 2024 11:55:01 +0100 Subject: [PATCH] mlib: fixed "(incf (gethash..." with default value, added frequencies --- CHANGES | 3 ++- mlib.completions | 3 ++- mlib.html | 10 ++++++++++ mlib.md | 10 ++++++++++ samples.murmel-mlib/mlib-test.lisp | 16 ++++++++++++++++ samples.murmel-mlib/mlib.lisp | 28 ++++++++++++++++++++++++---- 6 files changed, 64 insertions(+), 6 deletions(-) diff --git a/CHANGES b/CHANGES index 80e95cf4..f94e4178 100644 --- a/CHANGES +++ b/CHANGES @@ -9,7 +9,8 @@ Changes in JMurmel-1.5.0 relative to JMurmel-1.4.8 * added fresh-line, make-string-writer, tabulate - * mlib: added format, formatter, error, and*, or* + * mlib: added format, formatter, error, and*, or*, frequencies + * fixed mlib: "(incf (gethash..." with default value Changes in JMurmel-1.4.8 relative to JMurmel-1.4.7 diff --git a/mlib.completions b/mlib.completions index 10f310a9..311226d9 100644 --- a/mlib.completions +++ b/mlib.completions @@ -144,4 +144,5 @@ string-replace string-subseq maphash remhash -gethash \ No newline at end of file +gethash +frequencies \ No newline at end of file diff --git a/mlib.html b/mlib.html index 73679b18..027345a2 100644 --- a/mlib.html +++ b/mlib.html @@ -114,6 +114,8 @@ - [scan](#function-scan), [scan-multiple](#function-scan-multiple), [scan-concat](#function-scan-concat) - strings - [string-trim](#function-string-trim), [string-subseq](#function-string-subseq), [string-replace](#function-string-replace), [string-split](#function-string-split), [string-join](#function-string-join) +- hash tables + - [frequencies](#function-frequencies) ## Description of functions and macros @@ -1020,6 +1022,14 @@ Similar to CL's `maphash` but modifying the hash-table from within `function` is not supported. +### Function: frequencies + (frequencies sequence [test]) -> hash-table + +Since: 1.5 + +Count the number of times each value occurs in the sequence +according to the test function `test` which defaults to `eql`. + ### Function: identity (identity object) -> object diff --git a/mlib.md b/mlib.md index 0cc2eb8d..183e5068 100644 --- a/mlib.md +++ b/mlib.md @@ -105,6 +105,8 @@ as well as the following additional functions and macros: - [scan](#function-scan), [scan-multiple](#function-scan-multiple), [scan-concat](#function-scan-concat) - strings - [string-trim](#function-string-trim), [string-subseq](#function-string-subseq), [string-replace](#function-string-replace), [string-split](#function-string-split), [string-join](#function-string-join) +- hash tables + - [frequencies](#function-frequencies) ## Description of functions and macros @@ -1011,6 +1013,14 @@ Since: 1.4 Similar to CL's `maphash` but modifying the hash-table from within `function` is not supported. +### Function: frequencies + (frequencies sequence [test]) -> hash-table + +Since: 1.5 + +Count the number of times each value occurs in the sequence +according to the test function `test` which defaults to `eql`. + ### Function: identity (identity object) -> object diff --git a/samples.murmel-mlib/mlib-test.lisp b/samples.murmel-mlib/mlib-test.lisp index f2fcddfb..e24268f3 100644 --- a/samples.murmel-mlib/mlib-test.lisp +++ b/samples.murmel-mlib/mlib-test.lisp @@ -1517,6 +1517,22 @@ all the result list to a single list. FUNCTION must return a list." ; => NIL ) +#+murmel +(defun hash-equal (h1 h2) + (if (= (hash-table-count h1) (hash-table-count h2)) + (let ((ok t)) + (maphash (lambda (k v) + (unless (eql v (hashref h2 k)) + (setq ok nil))) + h1) + ok) + nil)) + +#+murmel +(tests frequencies + (hash-equal (frequencies '(1 2 2 3 3 3 4 4 4 4 5 5 5 5 5)) #H(eql 1 1 2 2 3 3 4 4 5 5)) => t + (hash-equal (frequencies #(1 2 2 3 3 3 4 4 4 4 5 5 5 5 5)) #H(eql 1 1 2 2 3 3 4 4 5 5)) => t) + ;;; - higher order diff --git a/samples.murmel-mlib/mlib.lisp b/samples.murmel-mlib/mlib.lisp index f488782a..3323f781 100644 --- a/samples.murmel-mlib/mlib.lisp +++ b/samples.murmel-mlib/mlib.lisp @@ -113,6 +113,8 @@ ;;; - [scan](#function-scan), [scan-multiple](#function-scan-multiple), [scan-concat](#function-scan-concat) ;;; - strings ;;; - [string-trim](#function-string-trim), [string-subseq](#function-string-subseq), [string-replace](#function-string-replace), [string-split](#function-string-split), [string-join](#function-string-join) +;;; - hash tables +;;; - [frequencies](#function-frequencies) ;;; == Description of functions and macros @@ -1462,6 +1464,7 @@ (let ((read-var (gensym "read-var")) (tmp1 (gensym "tmp1")) (tmp2 (gensym "tmp2")) + (tmp3 (gensym "tmp3")) (store-var (gensym "store-var"))) (if (symbolp place) `(nil nil (,read-var) (setq ,place ,read-var) ,place) (let ((op (car place)) @@ -1492,22 +1495,22 @@ ;; hashref with default value: setf (hashref h k def) - eval and ignore default value form ((and (eq 'hashref op) (cddr args)) - `((,tmp1 ,tmp2) + `((,tmp1 ,tmp2 ,tmp3) (,(car args) ,(cadr args) ,(caddr args)) (,store-var) (hashset ,tmp1 ,tmp2 ,store-var) - (hashref ,tmp1 ,tmp2))) + (hashref ,tmp1 ,tmp2 ,tmp3))) ;; hashref w/o default value ((eq 'hashref op) (setf-helper args tmp1 tmp2 store-var 'hashref 'hashset)) ;; gethash with default value: setf (gethash k hash def) - eval and ignore default value form ((and (eq 'gethash op) (cddr args)) - `((,tmp1 ,tmp2) + `((,tmp1 ,tmp2 ,tmp3) (,(cadr args) ,(car args) ,(caddr args)) (,store-var) (hashset ,tmp1 ,tmp2 ,store-var) - (hashref ,tmp1 ,tmp2))) + (hashref ,tmp1 ,tmp2 ,tmp3))) ((eq 'gethash op) `((,tmp1 ,tmp2) @@ -2703,6 +2706,23 @@ (function (car pair) (cdr pair)))) + +;;; = Function: frequencies +;;; (frequencies sequence [test]) -> hash-table +;;; +;;; Since: 1.5 +;;; +;;; Count the number of times each value occurs in the sequence +;;; according to the test function `test` which defaults to `eql`. +(defun frequencies (seq . test) + (let ((counts (make-hash-table (car test)))) + (if (listp seq) + (dolist (x seq counts) + (incf (hashref counts x 0))) + (dovector (x seq counts) + (incf (hashref counts x 0)))))) + + ; higher order ******************************************************** ;;; = Function: identity