utils: Typed lists-transpose.

This commit is contained in:
Sergiu Ivanov 2022-02-13 19:33:04 +01:00
parent 20cc0a27d0
commit 2af8d9276b
2 changed files with 26 additions and 24 deletions

View file

@ -386,6 +386,20 @@ consisting of the second halves.
(multi-split-at '((1 2 3) (a b c)) 2) (multi-split-at '((1 2 3) (a b c)) 2)
]} ]}
@defproc[(lists-transpose [lists (List (Listof a) ... a)])
(Listof (List a ... a))]{
Transposes a list of lists. The length of the resulting list is the length of
the shortest list in @racket[lists].
This function is essentially @racket[in-parallel], wrapped in
a couple conversions.
@examples[#:eval utils-evaluator
(lists-transpose '((a b) (1 2)))
(lists-transpose '((a b) (1 2 3) (#t)))
]}
@section{Functions and procedures} @section{Functions and procedures}
@section{Randomness} @section{Randomness}

View file

@ -24,7 +24,7 @@
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) multi-split-at lists-transpose)
(define-type Variable Symbol) (define-type Variable Symbol)
(define-type (VariableMapping A) (Immutable-HashTable Variable A)) (define-type (VariableMapping A) (Immutable-HashTable Variable A))
@ -445,6 +445,15 @@
(test-case "multi-split-at" (test-case "multi-split-at"
(define-values (l1 l2) (multi-split-at '((1 2 3) (a b c)) 2)) (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))))) (check-equal? l1 '((1 2) (a b))) (check-equal? l2 '((3) (c)))))
;; https://racket.discourse.group/t/get-to-type-apply-in-parallel-lst/683
(: lists-transpose (All (a ...) (-> (List (Listof a) ... a) (Listof (List a ... a)))))
(define (lists-transpose lists)
(sequence->list (in-values-sequence (apply in-parallel lists))))
(module+ test
(test-case "lists-transpose"
(check-equal? (lists-transpose '((1 2) (a b))) '((1 a) (2 b)))))
) )
(require 'typed) (require 'typed)
@ -455,14 +464,13 @@
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) multi-split-at lists-transpose)
;;; Untyped section. ;;; Untyped section.
(provide (provide
;; Functions ;; Functions
(contract-out [lists-transpose (-> (listof (listof any/c)) (listof (listof any/c)))] (contract-out [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?))
(-> exact-integer? (integer-in 1 4294967087) (-> exact-integer? (integer-in 1 4294967087)
@ -492,26 +500,6 @@
(cons/c key-contract val-contract))) (cons/c key-contract val-contract)))
;;; ======================================
;;; Additional list and hash map utilities
;;; ======================================
;;; Given a list of lists of the same length, transposes them.
;;;
;;; > (lists-transpose '((1 2) (a b)))
;;; '((1 a) (2 b))
;;;
;;; This function is essentially in-parallel, wrapped in a couple
;;; conversions.
(define lists-transpose
(compose sequence->list
in-values-sequence
((curry apply) in-parallel)))
(module+ test
(test-case "lists-transpose"
(check-equal? (lists-transpose '((1 2) (a b))) '((1 a) (2 b)))))
;;; ========= ;;; =========
;;; Functions ;;; Functions
;;; ========= ;;; =========