From cc686762e0d4fc8f8e31dd09740363b13fa6e219 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 7 Mar 2015 09:51:13 -0800 Subject: [PATCH] average-looseness --- quad/main-typed-tests.rkt | 11 +++++++++-- quad/main-typed.rkt | 10 ++++++++-- 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/quad/main-typed-tests.rkt b/quad/main-typed-tests.rkt index 6060865d..9f67c732 100644 --- a/quad/main-typed-tests.rkt +++ b/quad/main-typed-tests.rkt @@ -1,6 +1,6 @@ #lang typed/racket/base (require typed/rackunit) -(require "main-typed.rkt" "quads-typed.rkt") +(require "main-typed.rkt" "quads-typed.rkt" "world-typed.rkt") (check-equal? (input->nested-blocks (input #f (block #f "1" (block-break) "2"))) @@ -12,4 +12,11 @@ (check-equal? (merge-adjacent-within (line #f (word #f "b") (word #f "a") (word #f "r"))) (line #f (word #f "bar"))) -(check-equal? (hyphenate-quad-except-last-word (line #f "snowman" "snowman")) (line #f "snow\u00ADman" "snowman")) \ No newline at end of file +(check-equal? (hyphenate-quad-except-last-word (line #f "snowman" "snowman")) (line #f "snow\u00ADman" "snowman")) + +(define al-test-line (line (list world:line-looseness-key 42.0) (word #f "bar"))) +(define al-test-line2 (line (list world:line-looseness-key 30.0) (word #f "bar"))) +(check-equal? (average-looseness (list)) 0.0) ; default value for no lines +(check-equal? (average-looseness (list al-test-line)) 0.0) ; default value for one line +(check-equal? (average-looseness (list al-test-line al-test-line2)) 42.0) ; last line excluded by default +(check-equal? (average-looseness (list al-test-line al-test-line2 al-test-line)) 36.0) ; last line excluded by default \ No newline at end of file diff --git a/quad/main-typed.rkt b/quad/main-typed.rkt index 6c42a72c..63512aa8 100644 --- a/quad/main-typed.rkt +++ b/quad/main-typed.rkt @@ -1,5 +1,5 @@ #lang typed/racket/base -(require racket/list) +(require racket/list math/flonum) (require "quads-typed.rkt" "utils-typed.rkt" "wrap-typed.rkt" "measure-typed.rkt" "world-typed.rkt" "logger-typed.rkt") (define-type Block-Type (Listof Quad)) @@ -38,4 +38,10 @@ (define-values (first-quads last-quad) ((inst split-last QuadListItem) (quad-list q))) (quad (quad-name q) (quad-attrs q) (snoc ((inst map QuadListItem QuadListItem) hyphenate-quad first-quads) last-quad))) - +(provide average-looseness) +(define/typed (average-looseness lines) + ((Listof Quad) . -> . Flonum) + (if (<= (length lines) 1) + 0.0 + (let ([lines-to-measure (drop-right lines 1)]) ; exclude last line from looseness calculation + (round-float (/ (foldl fl+ 0.0 ((inst map Flonum Quad) (λ(line) (cast (quad-attr-ref line world:line-looseness-key 0.0) Flonum)) lines-to-measure)) (- (fl (length lines)) 1.0))))))