|
|
|
(define-module (deliberate utils)
|
|
|
|
#:use-module (srfi srfi-1)
|
|
|
|
#:export (const-list group-by range reorder string-count zip))
|
|
|
|
|
|
|
|
(define (const-list length value)
|
|
|
|
(if (= length 0)
|
|
|
|
'()
|
|
|
|
(cons value (const-list (- length 1) value))))
|
|
|
|
|
|
|
|
;; Return a list of integers in the half-open interval [low, high)
|
|
|
|
(define (range low high)
|
|
|
|
(if (eq? low high)
|
|
|
|
'()
|
|
|
|
(cons low (range (+ 1 low) high))))
|
|
|
|
|
|
|
|
;; Combine lists component-wise
|
|
|
|
;; Similar to python zip()
|
|
|
|
;;
|
|
|
|
;; Parameters:
|
|
|
|
;; args: Any number of lists
|
|
|
|
;;
|
|
|
|
;; Returns:
|
|
|
|
;; A list. The nth element is a list of the
|
|
|
|
;; nth elements of each argument
|
|
|
|
;;
|
|
|
|
(define (zip . args)
|
|
|
|
(if (or (nil? args) (memq '() args))
|
|
|
|
'()
|
|
|
|
(cons (map car args)
|
|
|
|
(apply zip (map cdr args)))))
|
|
|
|
|
|
|
|
;; Reorder one list by another
|
|
|
|
;; A reordering is applied to lst such that the same reordering would
|
|
|
|
;; Put rank in asending oder.
|
|
|
|
;;
|
|
|
|
;; Parameters:
|
|
|
|
;; lst: The list to reorder
|
|
|
|
;; ranks: The list to sort by
|
|
|
|
;;
|
|
|
|
;; Returns:
|
|
|
|
;; A reordered copy of lst
|
|
|
|
;;
|
|
|
|
(define (reorder lst ranks)
|
|
|
|
(let* ((pairs (zip lst ranks))
|
|
|
|
(ranked-pairs
|
|
|
|
(filter (lambda (pair) (not (eq? #f (cadr pair))))
|
|
|
|
pairs))
|
|
|
|
(sorted-pairs
|
|
|
|
(sort ranked-pairs (lambda (a b) (< (cadr a) (cadr b))))))
|
|
|
|
(map car sorted-pairs)))
|
|
|
|
|
|
|
|
;; TODO
|
|
|
|
;;
|
|
|
|
(define (group-by-helper sorted)
|
|
|
|
(if (nil? sorted)
|
|
|
|
'()
|
|
|
|
(let ((elt (car (car sorted))))
|
|
|
|
(define-values (group rest)
|
|
|
|
(span (lambda (x) (equal? (car x) elt)) sorted))
|
|
|
|
(cons (cons elt (map cdr group))
|
|
|
|
(group-by-helper rest)))))
|
|
|
|
|
|
|
|
;; TODO
|
|
|
|
;;
|
|
|
|
(define (group-by proc lst)
|
|
|
|
(let* ((annotated (map (lambda (x) (cons (proc x) x)) lst))
|
|
|
|
(sorted (sort annotated (lambda (x y) (string< (car x) (car y))))))
|
|
|
|
(group-by-helper sorted)))
|
|
|
|
|
|
|
|
;; Counts the number of times each string appears in a list
|
|
|
|
;;
|
|
|
|
;; Parameters:
|
|
|
|
;; values: The list
|
|
|
|
;;
|
|
|
|
;; Returns:
|
|
|
|
;; An alist of the form ((string1 . count1) ...)
|
|
|
|
;;
|
|
|
|
(define (string-count values)
|
|
|
|
(let ((sorted (sort values string<)))
|
|
|
|
(string-count-sorted sorted)))
|
|
|
|
|
|
|
|
;; Same as string-count but assumes parameter is sorted
|
|
|
|
(define (string-count-sorted sorted)
|
|
|
|
(if (nil? sorted)
|
|
|
|
'()
|
|
|
|
(let* ((elt (car sorted))
|
|
|
|
(total-length (length sorted))
|
|
|
|
(rest (find-tail (lambda (x) (not (equal? x elt))) sorted))
|
|
|
|
(rest-length (if rest (length rest) 0)))
|
|
|
|
(cons (cons elt (- total-length rest-length))
|
|
|
|
(string-count-sorted rest)))))
|
|
|
|
|