[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.
This commit is contained in:
Christopher Lam 2019-07-20 18:21:20 +08:00
parent fdeff65f06
commit 273ae720cc
2 changed files with 41 additions and 0 deletions

View File

@ -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"))

View File

@ -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))))))