mirror of
https://github.com/Gnucash/gnucash.git
synced 2024-11-27 11:20:27 -06:00
[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:
parent
fdeff65f06
commit
273ae720cc
@ -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"))
|
||||
|
@ -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))))))
|
||||
|
Loading…
Reference in New Issue
Block a user