You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
sugar/list.rkt

57 lines
2.1 KiB
Racket

#lang racket/base
(require racket/list)
11 years ago
(require "define/contract.rkt" "len.rkt" "coerce/value.rkt")
11 years ago
(define+provide/contract (trim items test-proc)
(list? procedure? . -> . list?)
(dropf-right (dropf items test-proc) test-proc))
11 years ago
11 years ago
(define+provide/contract (list->slices xs len)
(list? integer? . -> . (listof list?))
(cond
[(equal? xs null) null]
[(len . > . (length xs)) (list xs)]
[else (cons (take xs len) (list->slices (drop xs len) len))]))
11 years ago
(define+provide/contract (splitf-at* xs split-test)
(list? predicate/c . -> . (listof list?))
11 years ago
(let loop ([xs (trim xs split-test)] [acc '()])
(if (empty? xs)
11 years ago
(reverse acc) ; because accumulation is happening backward
(let-values ([(item rest)
;; drop matching elements from front
;; then split on nonmatching
;; = nonmatching item + other elements (which will start with matching)
(splitf-at (dropf xs split-test) (compose1 not split-test))])
11 years ago
(loop rest (cons item acc))))))
11 years ago
(define+provide/contract (count-incidence x)
(list? . -> . hash?)
(define counter (make-hash))
(for ([item (flatten x)])
(hash-set! counter item (add1 (hash-ref counter item 0))))
counter)
(define+provide/contract (members-unique? x)
(any/c . -> . boolean?)
(cond
[(list? x) (= (len (remove-duplicates x)) (len x))]
11 years ago
[(vector? x) (members-unique? (vector->list x))]
11 years ago
[(string? x) (members-unique? (string->list x))]
[else (error (format "members-unique cannot be determined for ~a" x))]))
11 years ago
11 years ago
(define+provide/contract (members-unique?/error x)
(any/c . -> . boolean?)
(define result (members-unique? x))
(if (not result)
(let* ([duplicate-keys (filter-not empty? (hash-map (count-incidence x)
(λ(k v) (if (> v 1) k '()))))])
(error (string-append (if (= (len duplicate-keys) 1)
"Item isnt"
"Items arent") " unique:") duplicate-keys))
result))