brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Row normalization.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-22 10:13:22 +01:00
parent 44ae1a2339
commit fb7701869d
1 changed files with 16 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

23
table.scm
View file

@ -43,10 +43,10 @@
(define (string->rows str) (define (string->rows str)
(string-split str "\n" #t)) (string-split str "\n" #t))
;; Creates procedure that ensures a row has given number of elements ;; Creates procedure that ensures a list has given number of elements
;; filling the missing elements with given filler (defaults to empty ;; filling the missing elements with given filler (defaults to empty
;; string). ;; string).
(define ((make-row-extender ds . ofl) row) (define ((make-list-extender ds . ofl) row)
(let ((fl (if (null? ofl) "" (car ofl)))) (let ((fl (if (null? ofl) "" (car ofl))))
(let ((rs (length row))) (let ((rs (length row)))
(if (< rs ds) (if (< rs ds)
@ -62,7 +62,7 @@
;; number of elements using empty strings as filler. ;; number of elements using empty strings as filler.
(define (table-rectangularize tbl) (define (table-rectangularize tbl)
(let ((mrl (apply max (map length tbl)))) (let ((mrl (apply max (map length tbl))))
(map (make-row-extender mrl) tbl))) (map (make-list-extender mrl) tbl)))
;; Accepts list of lists of anything and returns a list of lists of ;; Accepts list of lists of anything and returns a list of lists of
;; strings. ;; strings.
@ -80,6 +80,12 @@
(map string->rows r)) (map string->rows r))
tbl)) tbl))
;; Accepts a list of cells which are list of strings and returns a
;; new list with all cells having the same number of text lines.
(define (table-normalize-row row)
(let ((ml (apply max (map length row))))
(map (make-list-extender ml) row)))
;; Ensures the table is rectangular and each cell is a list of strings. ;; Ensures the table is rectangular and each cell is a list of strings.
(define (table-prepare tbl) (define (table-prepare tbl)
(table-prepare-cells (table-prepare-cells
@ -96,11 +102,11 @@
(test-equal? string->rows (string->rows "asdf") '("asdf")) (test-equal? string->rows (string->rows "asdf") '("asdf"))
(test-equal? string->rows (string->rows "asdf\nqwer") '("asdf" "qwer")) (test-equal? string->rows (string->rows "asdf\nqwer") '("asdf" "qwer"))
(test-equal? string->rows (string->rows "\nasdf\nqwer") '("" "asdf" "qwer")) (test-equal? string->rows (string->rows "\nasdf\nqwer") '("" "asdf" "qwer"))
(test-equal? make-row-extender (test-equal? make-list-extender
((make-row-extender 5) '("test")) ((make-list-extender 5) '("test"))
'("test" "" "" "" "")) '("test" "" "" "" ""))
(test-equal? make-row-extender (test-equal? make-list-extender
((make-row-extender 5 "x") '("test")) ((make-list-extender 5 "x") '("test"))
'("test" "x" "x" "x" "x")) '("test" "x" "x" "x" "x"))
(test-equal? table-rectangularize (test-equal? table-rectangularize
(table-rectangularize '(("x" "y" "z") ("a" "b") ("1" "2" "3" "4"))) (table-rectangularize '(("x" "y" "z") ("a" "b") ("1" "2" "3" "4")))
@ -111,6 +117,9 @@
(test-equal? table-prepare-cells (test-equal? table-prepare-cells
(table-prepare-cells '(("x" "y" "z" "") ("a" "b" "" "") ("1" "2" "3" "4"))) (table-prepare-cells '(("x" "y" "z" "") ("a" "b" "" "") ("1" "2" "3" "4")))
'((("x") ("y") ("z") ("")) (("a") ("b") ("") ("")) (("1") ("2") ("3") ("4")))) '((("x") ("y") ("z") ("")) (("a") ("b") ("") ("")) (("1") ("2") ("3") ("4"))))
(test-equal? table-normalize-row
(table-normalize-row '(("") ("a" "b")))
'(("" "") ("a" "b")))
)) ))
) )