From 273ae720ccaeddc60deb11a1fab42418838f2cd2 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 20 Jul 2019 18:21:20 +0800 Subject: [PATCH] [scm-utilities][API] add sort-and-delete-duplicates this can be used instead of delete-duplicates when the list must also be sorted. the main reason for this function will be for the upcoming aging.scm report which will use it heavily to slice APAR splits into owner list. --- .../test/test-libgnucash-scm-utilities.scm | 26 +++++++++++++++++++ libgnucash/scm/utilities.scm | 15 +++++++++++ 2 files changed, 41 insertions(+) diff --git a/libgnucash/scm/test/test-libgnucash-scm-utilities.scm b/libgnucash/scm/test/test-libgnucash-scm-utilities.scm index b5db94b246..a2e0d4d24d 100644 --- a/libgnucash/scm/test/test-libgnucash-scm-utilities.scm +++ b/libgnucash/scm/test/test-libgnucash-scm-utilities.scm @@ -9,6 +9,7 @@ (test-begin "test-libgnucash-scm-utilities.scm") (test-traverse-vec) (test-substring-replace) + (test-sort-and-delete-duplicates) (test-begin "test-libgnucash-scm-utilities.scm")) (define (test-traverse-vec) @@ -61,3 +62,28 @@ "foo" "xxx" 4 -1)) (test-end "substring-replace")) + +(define (test-sort-and-delete-duplicates) + (test-begin "sort-and-delete-duplicates") + (test-equal "sort-and-delete-duplicates empty" + '() + (sort-and-delete-duplicates '() <)) + (test-equal "sort-and-delete-duplicates 1-element" + '(1) + (sort-and-delete-duplicates '(1) <)) + (test-equal "sort-and-delete-duplicates 2-element, equal" + '(1) + (sort-and-delete-duplicates '(1 1) <)) + (test-equal "sort-and-delete-duplicates 2-element, unequal" + '(1 2) + (sort-and-delete-duplicates '(2 1) <)) + (test-equal "sort-and-delete-duplicates 3-element, equal" + '(1) + (sort-and-delete-duplicates '(1 1 1) <)) + (test-equal "sort-and-delete-duplicates 3-element, 2-equal" + '(1 2) + (sort-and-delete-duplicates '(1 2 1) <)) + (test-equal "sort-and-delete-duplicates 3-element, unequal" + '(1 2 3) + (sort-and-delete-duplicates '(3 1 2) <)) + (test-end "sort-and-delete-duplicates")) diff --git a/libgnucash/scm/utilities.scm b/libgnucash/scm/utilities.scm index 4e3af3fdc6..83a0ab1390 100644 --- a/libgnucash/scm/utilities.scm +++ b/libgnucash/scm/utilities.scm @@ -46,6 +46,7 @@ (export gnc:msg) (export gnc:debug) (export addto!) +(export sort-and-delete-duplicates) ;; Do this stuff very early -- but other than that, don't add any ;; executable code until the end of the file if you can help it. @@ -179,3 +180,17 @@ (lambda args (gnc:warn "strftime may be buggy. use gnc-print-time64 instead.") (apply strftime-old args)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; a basic sort-and-delete-duplicates. because delete-duplicates +;; usually run in O(N^2) and if the list must be sorted, it's more +;; efficient to sort first then delete adjacent elements. guile-2.0 +;; uses quicksort internally. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define* (sort-and-delete-duplicates lst < #:optional (= =)) + (let lp ((lst (sort lst <)) (result '())) + (cond + ((null? lst) '()) + ((null? (cdr lst)) (reverse (cons (car lst) result))) + ((= (car lst) (cadr lst)) (lp (cdr lst) result)) + (else (lp (cdr lst) (cons (car lst) result))))))