utils: Type multi-split-at.

This commit is contained in:
Sergiu Ivanov 2022-02-11 00:01:07 +01:00
parent 912da811f2
commit 20cc0a27d0
2 changed files with 32 additions and 21 deletions

View file

@ -374,6 +374,18 @@ optional argument @racket[try-order?].
(hash->list/ordered #hash((b . 1) (a . 1))) (hash->list/ordered #hash((b . 1) (a . 1)))
]} ]}
@defproc[(multi-split-at [lists (Listof (Listof a))]
[pos Integer])
(Values (Listof (Listof a)) (Listof (Listof a)))]{
Given a list of lists, splits every single list at the given position, and then
returns two lists of lists: one consisting of the first halves, and the one
consisting of the second halves.
@examples[#:eval utils-evaluator
(multi-split-at '((1 2 3) (a b c)) 2)
]}
@section{Functions and procedures} @section{Functions and procedures}
@section{Randomness} @section{Randomness}

View file

@ -23,7 +23,8 @@
read-org-variable-mapping unorgv read-symbol-list drop-first-last read-org-variable-mapping unorgv read-symbol-list drop-first-last
list-sets->list-strings pretty-print-set pretty-print-set-sets list-sets->list-strings pretty-print-set pretty-print-set-sets
update-vertices/unweighted update-graph dotit collect-by-key update-vertices/unweighted update-graph dotit collect-by-key
collect-by-key/sets ht-values/list->set hash->list/ordered) collect-by-key/sets ht-values/list->set hash->list/ordered
multi-split-at)
(define-type Variable Symbol) (define-type Variable Symbol)
(define-type (VariableMapping A) (Immutable-HashTable Variable A)) (define-type (VariableMapping A) (Immutable-HashTable Variable A))
@ -429,6 +430,21 @@
(test-case "hash->list/ordered" (test-case "hash->list/ordered"
(check-equal? (hash->list/ordered #hash((b . 1) (a . 1))) (check-equal? (hash->list/ordered #hash((b . 1) (a . 1)))
'((a . 1) (b . 1))))) '((a . 1) (b . 1)))))
(: multi-split-at (All (a) (-> (Listof (Listof a)) Integer
(Values (Listof (Listof a)) (Listof (Listof a))))))
(define (multi-split-at lists pos)
(for/fold ([lefts : (Listof (Listof a)) '()]
[rights : (Listof (Listof a)) '()]
#:result (values (reverse lefts) (reverse rights)))
([lst (in-list lists)])
(define-values (left right) ((inst split-at a) lst pos))
(values (cons left lefts) (cons right rights))))
(module+ test
(test-case "multi-split-at"
(define-values (l1 l2) (multi-split-at '((1 2 3) (a b c)) 2))
(check-equal? l1 '((1 2) (a b))) (check-equal? l2 '((3) (c)))))
) )
(require 'typed) (require 'typed)
@ -438,15 +454,14 @@
read-org-variable-mapping unorgv read-symbol-list drop-first-last read-org-variable-mapping unorgv read-symbol-list drop-first-last
list-sets->list-strings pretty-print-set pretty-print-set-sets list-sets->list-strings pretty-print-set pretty-print-set-sets
update-vertices/unweighted update-graph dotit collect-by-key update-vertices/unweighted update-graph dotit collect-by-key
collect-by-key/sets ht-values/list->set hash->list/ordered) collect-by-key/sets ht-values/list->set hash->list/ordered
multi-split-at)
;;; Untyped section. ;;; Untyped section.
(provide (provide
;; Functions ;; Functions
(contract-out [multi-split-at (-> (listof (listof any/c)) number? (contract-out [lists-transpose (-> (listof (listof any/c)) (listof (listof any/c)))]
(values (listof (listof any/c)) (listof (listof any/c))))]
[lists-transpose (-> (listof (listof any/c)) (listof (listof any/c)))]
[procedure-fixed-arity? (-> procedure? boolean?)] [procedure-fixed-arity? (-> procedure? boolean?)]
[in-random (case-> (-> (stream/c (and/c real? inexact? (>/c 0) (</c 1)))) [in-random (case-> (-> (stream/c (and/c real? inexact? (>/c 0) (</c 1))))
(-> (integer-in 1 4294967087) (stream/c exact-nonnegative-integer?)) (-> (integer-in 1 4294967087) (stream/c exact-nonnegative-integer?))
@ -481,22 +496,6 @@
;;; Additional list and hash map utilities ;;; Additional list and hash map utilities
;;; ====================================== ;;; ======================================
;;; Given a list of lists, splits every single list at the given
;;; position, and then returns two lists: one consisting of the first
;;; halves, and the one consisting of the second halves.
(define (multi-split-at lsts pos)
(for/fold ([lefts '()]
[rights '()]
#:result (values (reverse lefts) (reverse rights)))
([lst (in-list lsts)])
(define-values (left right) (split-at lst pos))
(values (cons left lefts) (cons right rights))))
(module+ test
(test-case "multi-split-at"
(define-values (l1 l2) (multi-split-at '((1 2 3) (a b c)) 2))
(check-equal? l1 '((1 2) (a b))) (check-equal? l2 '((3) (c)))))
;;; Given a list of lists of the same length, transposes them. ;;; Given a list of lists of the same length, transposes them.
;;; ;;;
;;; > (lists-transpose '((1 2) (a b))) ;;; > (lists-transpose '((1 2) (a b)))