Implement Looseness, Threshold Pruning, and Flagged Penalties

Feature 1: Looseness (Complete Implementation)
- Added alt-paths hash table to track alternative paths by (position, line-count)
- Modified DP loop to track all paths reaching each position
- ekp--dp-trace-breaks-with-looseness uses alt-paths to find closest match
- Added ekp--dp-trace-alt-path helper with safety limit

Feature 2: Threshold Pruning
- Added ekp-threshold-factor variable (default 0 = disabled)
- Paths with demerits > best × (1 + factor) are skipped
- Tracks best-end-demerits during DP for pruning decisions

Feature 3: Flagged Penalties (Forced Breaks)
- Added flagged-positions field to ekp-para struct
- Added ekp-flagged-penalty variable (negative = preferred)
- Added ekp--flagged-p with O(log n) binary search
- Modified DP to always accept flagged breaks

Tests:
- ekp-test-unit--hyphenate-p-binary-search
- ekp-test-unit--flagged-p-binary-search
- ekp-test-unit--alt-paths-hash
- ekp-test-unit--threshold-factor
- ekp-test-unit--flagged-penalty
- Updated ekp-test-unit--struct-access for new fields

Co-authored-by: Kinneyzhang <38454496+Kinneyzhang@users.noreply.github.com>

ekp.el

@@ -85,8 +85,21 @@ Applied as: this × (1 - fill-ratio) when fill < ekp-last-line-min-ratio.")
   "Minimum fill ratio for last line (0.0-1.0).")
 
 (defvar ekp-looseness 0
-  "Target line count offset: 0=optimal, +1=looser, -1=tighter.
+  "Target line count offset: 0=optimal, +1=looser (more lines), -1=tighter (fewer lines).
-Note: Full looseness requires tracking multiple paths (not yet implemented).")
+When non-zero, the algorithm tracks multiple paths and selects the one
+whose line count is closest to (optimal + looseness).")
+
+(defvar ekp-threshold-factor 0
+  "Threshold factor for early pruning (0 = disabled).
+When > 0, breakpoints with demerits > best × (1 + factor) are skipped.
+Typical value: 2.0 for moderate pruning, 5.0 for aggressive pruning.
+Reduces computation time for long paragraphs at slight quality cost.")
+
+(defvar ekp-flagged-penalty -10000
+  "Penalty for flagged (forced) breaks.
+Negative value means this break is preferred (mandatory).
+When a box ends with a forced break marker, it will be selected.
+Used for explicit line breaks in poetry, code blocks, etc.")
 
 ;;;; Paragraph Cache Structure
 ;;
@@ -98,6 +111,7 @@ Note: Full looseness requires tracking multiple paths (not yet implemented).")
   string latin-font cjk-font
   boxes boxes-widths boxes-types glues-types
   hyphen-pixel hyphen-positions
+  flagged-positions  ; vector of indices for forced line breaks
   ideal-prefixs min-prefixs max-prefixs
   ;; Store glue params at para creation time for consistent C module calls
   glue-params  ; plist (:lws-ideal :lws-shrink :lws-stretch :mws-* :cws-*)
@@ -531,21 +545,44 @@ Uses binary search for O(log n) lookup instead of O(n) linear search."
                (setq hi mid))))
          (= (aref hyphen-positions lo) n))))
 
+(defun ekp--flagged-p (flagged-positions n)
+  "Return non-nil if position N is a flagged (forced) break.
+FLAGGED-POSITIONS is a sorted vector of indices where forced breaks occur.
+Uses binary search for O(log n) lookup."
+  (and flagged-positions
+       (> (length flagged-positions) 0)
+       (let ((lo 0)
+             (hi (1- (length flagged-positions))))
+         (while (< lo hi)
+           (let ((mid (/ (+ lo hi) 2)))
+             (if (< (aref flagged-positions mid) n)
+                 (setq lo (1+ mid))
+               (setq hi mid))))
+         (= (aref flagged-positions lo) n))))
+
 ;;;; Dynamic Programming Line Breaking
 
 (defun ekp--dp-init-arrays (n)
   "Initialize DP arrays for N boxes.
-Returns (backptrs demerits rests gaps hyphen-counts fitness-classes line-counts)."
+Returns (backptrs demerits rests gaps hyphen-counts fitness-classes line-counts alt-paths).
+When looseness != 0, alt-paths tracks alternative paths by (position . line-count)."
   (let ((backptrs (make-vector (1+ n) nil))
         (demerits (make-vector (1+ n) nil))
         (rests (make-vector (1+ n) nil))
         (gaps (make-vector (1+ n) nil))
         (hyphen-counts (make-vector (1+ n) 0))
         (fitness-classes (make-vector (1+ n) 1))  ; default: decent
-        (line-counts (make-vector (1+ n) 0)))     ; for looseness
+        (line-counts (make-vector (1+ n) 0))      ; for looseness
+        ;; alt-paths: hash (position . line-count) -> (backptr . demerits)
+        ;; Size based on estimated paths: n positions × ~10 possible line counts
+        (alt-paths (when (/= ekp-looseness 0)
+                     (make-hash-table :test 'equal :size (min 1000 (* n 10))))))
     (aset demerits 0 0.0)
+    ;; Initialize alt-paths for position 0
+    (when alt-paths
+      (puthash (cons 0 0) (cons nil 0.0) alt-paths))
     (list backptrs demerits rests gaps
-          hyphen-counts fitness-classes line-counts)))
+          hyphen-counts fitness-classes line-counts alt-paths)))
 
 (defun ekp--dp-line-metrics (para i k glues-types ideal-prefixs min-prefixs max-prefixs)
   "Compute line metrics for boxes I to K using PARA's stored glue params.
@@ -586,11 +623,21 @@ Uses PARA's stored glue params for consistency."
 (defun ekp--dp-compute-line-demerits (para j is-last end-with-hyphenp
                                         ideal-pixel line-pixel
                                         glues-types i k
-                                        prev-hyphen-count prev-fitness)
+                                        prev-hyphen-count prev-fitness
+                                        &optional end-with-flaggedp)
   "Compute line demerits using full K-P formula.
 Uses PARA's stored glue params for consistent badness calculation.
+END-WITH-FLAGGEDP indicates a forced break (very low/negative demerits).
 Returns (demerits gaps fitness new-hyphen-count)."
   (cond
+   ;; Flagged (forced) break: use negative penalty to ensure selection
+   (end-with-flaggedp
+    (let* ((result (ekp--line-badness-and-fitness
+                    para ideal-pixel line-pixel
+                    (seq-subseq glues-types i k)))
+           (line-gaps (plist-get result :gaps)))
+      ;; Use flagged penalty (negative = preferred)
+      (list ekp-flagged-penalty line-gaps 1 0)))
    ;; Single word line
    ((= j 0)
     (let* ((badness (ekp--compute-badness (- line-pixel ideal-pixel) 1))
@@ -635,17 +682,53 @@ Returns (demerits gaps fitness new-hyphen-count)."
           (setq index (1- index)))))
     (cdr breaks)))
 
-(defun ekp--dp-trace-breaks-with-looseness (backptrs line-counts n target-lines)
+(defun ekp--dp-trace-breaks-with-looseness (backptrs line-counts n target-lines
+                                                     &optional alt-paths)
   "Trace breaks, preferring paths with TARGET-LINES line count.
-Used for looseness parameter support."
+Used for looseness parameter support.
-  (if (= ekp-looseness 0)
+ALT-PATHS is a hash table mapping (position . line-count) to (backptr . demerits)
+for alternative paths when looseness != 0."
+  (if (or (= ekp-looseness 0) (null alt-paths))
       (ekp--dp-trace-breaks backptrs n)
     ;; Find path closest to target line count
-    (let ((optimal-lines (aref line-counts n))
+    (let* ((optimal-lines (aref line-counts n))
-          (target (+ optimal-lines ekp-looseness)))
+           (target (+ optimal-lines ekp-looseness))
-      ;; For now, just use optimal path
+           (best-path nil)
-      ;; Full looseness would require tracking multiple paths
+           (best-diff most-positive-fixnum))
-      (ekp--dp-trace-breaks backptrs n))))
+      ;; Search alt-paths for best match at position n
+      (maphash
+       (lambda (key value)
+         (when (= (car key) n)  ; position = n (end)
+           (let* ((line-count (cdr key))
+                  (diff (abs (- line-count target))))
+             (when (< diff best-diff)
+               (setq best-diff diff)
+               (setq best-path (cons line-count (car value)))))))  ; (line-count . backptr)
+       alt-paths)
+      (if best-path
+          ;; Trace back using alt-paths
+          (ekp--dp-trace-alt-path alt-paths n (car best-path))
+        ;; Fallback to optimal path
+        (ekp--dp-trace-breaks backptrs n)))))
+
+(defun ekp--dp-trace-alt-path (alt-paths n target-lines)
+  "Trace alternative path from ALT-PATHS ending at N with TARGET-LINES."
+  (let ((breaks (list n))
+        (index n)
+        (lines target-lines)
+        (max-iterations (* n 2)))  ; Safety limit to prevent infinite loop
+    (while (and (> index 0) (> max-iterations 0))
+      (let* ((key (cons index lines))
+             (entry (gethash key alt-paths)))
+        (if entry
+            (let ((prev (car entry)))
+              (when (> prev 0) (push prev breaks))
+              (setq index prev)
+              (cl-decf lines))
+          ;; No entry found at current line count, give up
+          (setq index 0)))
+      (cl-decf max-iterations))
+    (cdr breaks)))
 
 (defun ekp--dp-store-cache (string line-pixel dp-result)
   "Store DP-RESULT for STRING at LINE-PIXEL in para's dp-cache."
@@ -849,6 +932,7 @@ Uses PARA's stored glue-params for consistency with cached prefix arrays."
          (boxes (ekp-para-boxes para))
          (hyphen-pixel (ekp-para-hyphen-pixel para))
          (hyphen-positions (ekp-para-hyphen-positions para))
+         (flagged-positions (ekp-para-flagged-positions para))
          (n (length boxes))
          (ideal-prefixs (ekp-para-ideal-prefixs para))
          (min-prefixs (ekp-para-min-prefixs para))
@@ -860,61 +944,91 @@ Uses PARA's stored glue-params for consistency with cached prefix arrays."
          (gaps (nth 3 arrays))
          (hyphen-counts (nth 4 arrays))
          (fitness-classes (nth 5 arrays))
-         (line-counts (nth 6 arrays)))
+         (line-counts (nth 6 arrays))
+         (alt-paths (nth 7 arrays))  ; for looseness support
+         ;; Track best demerits at end for threshold pruning
+         (best-end-demerits nil))
     ;; Main DP loop: for each reachable position i
     (dotimes (i (1+ n))
       (when (aref demerits i)
-        (let ((prev-hyphen-count (aref hyphen-counts i))
+        ;; Threshold pruning: skip if demerits already too high
-              (prev-fitness (aref fitness-classes i))
+        (let ((should-process
-              (prev-line-count (aref line-counts i)))
+               (or (<= ekp-threshold-factor 0)
-          (catch 'break
+                   (null best-end-demerits)
-            ;; Try extending line to each position k > i
+                   (<= (aref demerits i)
-            (dotimes (j (- n i))
+                       (* best-end-demerits (1+ ekp-threshold-factor))))))
-              (let* ((k (+ i j 1))
+          (when should-process
-                     (is-last (= k n))
+            (let ((prev-hyphen-count (aref hyphen-counts i))
-                     ;; k is the break position (exclusive), k-1 is the last box index
+                  (prev-fitness (aref fitness-classes i))
-                     (end-with-hyphenp
+                  (prev-line-count (aref line-counts i)))
-                      (ekp--hyphenate-p hyphen-positions (1- k)))
+              (catch 'break
-                     (metrics (ekp--dp-line-metrics
+                ;; Try extending line to each position k > i
-                               para i k glues-types
+                (dotimes (j (- n i))
-                               ideal-prefixs min-prefixs max-prefixs))
+                  (let* ((k (+ i j 1))
-                     (ideal-pixel (nth 0 metrics))
+                         (is-last (= k n))
-                     (min-pixel (nth 1 metrics))
+                         ;; k is the break position (exclusive), k-1 is the last box index
-                     (max-pixel (nth 2 metrics)))
+                         (end-with-hyphenp
-                ;; Add hyphen width if line ends with hyphen
+                          (ekp--hyphenate-p hyphen-positions (1- k)))
-                (when end-with-hyphenp
+                         (end-with-flaggedp
-                  (cl-incf ideal-pixel hyphen-pixel)
+                          (ekp--flagged-p flagged-positions (1- k)))
-                  (cl-incf max-pixel hyphen-pixel)
+                       (metrics (ekp--dp-line-metrics
-                  (cl-incf min-pixel hyphen-pixel))
+                                 para i k glues-types
-                ;; Check if line is too long
+                                 ideal-prefixs min-prefixs max-prefixs))
-                (when (or (> min-pixel line-pixel)
+                       (ideal-pixel (nth 0 metrics))
-                          (and is-last (> ideal-pixel line-pixel)))
+                       (min-pixel (nth 1 metrics))
-                  (when (null (aref demerits (1- k)))
+                       (max-pixel (nth 2 metrics)))
-                    (ekp--dp-force-break
+                  ;; Add hyphen width if line ends with hyphen
-                     para i k arrays glues-types hyphen-positions
+                  (when end-with-hyphenp
-                     ideal-prefixs hyphen-pixel line-pixel))
+                    (cl-incf ideal-pixel hyphen-pixel)
-                  (throw 'break nil))
+                    (cl-incf max-pixel hyphen-pixel)
-                ;; Valid break point: compute demerits
+                    (cl-incf min-pixel hyphen-pixel))
-                (when (or (<= min-pixel line-pixel max-pixel)
+                  ;; Check if line is too long (but allow flagged breaks anyway)
-                          (and is-last (<= ideal-pixel line-pixel)))
+                  (when (and (not end-with-flaggedp)
-                  (pcase-let ((`(,dem ,line-gaps ,fitness ,new-hyphen)
+                             (or (> min-pixel line-pixel)
-                               (ekp--dp-compute-line-demerits
+                                 (and is-last (> ideal-pixel line-pixel))))
-                                para j is-last end-with-hyphenp
+                    (when (null (aref demerits (1- k)))
-                                ideal-pixel line-pixel glues-types i k
+                      (ekp--dp-force-break
-                                prev-hyphen-count prev-fitness)))
+                       para i k arrays glues-types hyphen-positions
-                    (let ((total-dem (+ (aref demerits i) dem)))
+                       ideal-prefixs hyphen-pixel line-pixel))
-                      (when (or (null (aref demerits k))
+                    (throw 'break nil))
-                                (< total-dem (aref demerits k)))
+                  ;; Valid break point: compute demerits
-                        (aset rests k (- line-pixel ideal-pixel))
+                  ;; Flagged breaks are always valid
-                        (aset gaps k line-gaps)
+                  (when (or end-with-flaggedp
-                        (aset demerits k total-dem)
+                            (<= min-pixel line-pixel max-pixel)
-                        (aset backptrs k i)
+                            (and is-last (<= ideal-pixel line-pixel)))
-                        (aset fitness-classes k fitness)
+                    (pcase-let ((`(,dem ,line-gaps ,fitness ,new-hyphen)
-                        (aset hyphen-counts k new-hyphen)
+                                 (ekp--dp-compute-line-demerits
-                        (aset line-counts k (1+ prev-line-count))))))))))))
+                                  para j is-last end-with-hyphenp
+                                  ideal-pixel line-pixel glues-types i k
+                                  prev-hyphen-count prev-fitness
+                                  end-with-flaggedp)))
+                      (let ((total-dem (+ (aref demerits i) dem))
+                            (new-line-count (1+ prev-line-count)))
+                        ;; Update optimal path (always)
+                        (when (or (null (aref demerits k))
+                                  (< total-dem (aref demerits k)))
+                          (aset rests k (- line-pixel ideal-pixel))
+                          (aset gaps k line-gaps)
+                          (aset demerits k total-dem)
+                          (aset backptrs k i)
+                          (aset fitness-classes k fitness)
+                          (aset hyphen-counts k new-hyphen)
+                          (aset line-counts k new-line-count)
+                          ;; Update best end demerits for threshold pruning
+                          (when (= k n)
+                            (when (or (null best-end-demerits)
+                                      (< total-dem best-end-demerits))
+                              (setq best-end-demerits total-dem))))
+                        ;; Track alternative paths for looseness (if enabled)
+                        (when alt-paths
+                          (let* ((key (cons k new-line-count))
+                                 (existing (gethash key alt-paths)))
+                            (when (or (null existing)
+                                      (< total-dem (cdr existing)))
+                              (puthash key (cons i total-dem) alt-paths)))))))))))))))
     ;; Extract optimal solution
     (let* ((breaks (ekp--dp-trace-breaks-with-looseness
-                    backptrs line-counts n (aref line-counts n)))
+                    backptrs line-counts n (aref line-counts n) alt-paths))
            (lines-rests (mapcar (lambda (i) (aref rests i)) breaks))
            (lines-gaps (mapcar (lambda (i) (aref gaps i)) breaks))
            (dp-result (list :rests lines-rests

tests/ekp-tests.el

@@ -175,9 +175,12 @@ Returns time in seconds."
                       nil                    ; boxes-types
                       (vector 'nws 'lws 'lws) ; glues-types
                       5                      ; hyphen-pixel
+                      nil                    ; hyphen-positions
+                      nil                    ; flagged-positions
                       (vector 0 10 38 76)    ; ideal-prefixs
                       (vector 0 10 34 70)    ; min-prefixs
                       (vector 0 10 42 82)    ; max-prefixs
+                      nil                    ; glue-params
                       (make-hash-table :test 'eql)))) ; dp-cache
     (if (and (equal (ekp-para-string para) "test")
              (= (length (ekp-para-boxes para)) 3)
@@ -195,6 +198,62 @@ Returns time in seconds."
           (message "✓ DP cache storage: PASSED")
         (message "✗ DP cache storage: FAILED")))))
 
+;;; New Feature Tests
+
+(defun ekp-test-unit--hyphenate-p-binary-search ()
+  "Test binary search hyphenation lookup."
+  (let ((positions (vector 3 7 12 18 25)))
+    (if (and (ekp--hyphenate-p positions 7)   ; exists
+             (ekp--hyphenate-p positions 25)  ; last element
+             (not (ekp--hyphenate-p positions 10))  ; doesn't exist
+             (not (ekp--hyphenate-p positions 0)))  ; before first
+        (message "✓ Binary search hyphenate-p: PASSED")
+      (message "✗ Binary search hyphenate-p: FAILED"))))
+
+(defun ekp-test-unit--flagged-p-binary-search ()
+  "Test binary search flagged position lookup."
+  (let ((positions (vector 5 10 20)))
+    (if (and (ekp--flagged-p positions 5)     ; exists
+             (ekp--flagged-p positions 20)    ; last element
+             (not (ekp--flagged-p positions 15))  ; doesn't exist
+             (not (ekp--flagged-p positions 1)))  ; before first
+        (message "✓ Binary search flagged-p: PASSED")
+      (message "✗ Binary search flagged-p: FAILED"))))
+
+(defun ekp-test-unit--alt-paths-hash ()
+  "Test alternative paths hash table for looseness."
+  (let ((alt-paths (make-hash-table :test 'equal)))
+    ;; Simulate tracking paths: (position . line-count) -> (backptr . demerits)
+    (puthash (cons 10 3) (cons 5 150.0) alt-paths)
+    (puthash (cons 10 4) (cons 6 200.0) alt-paths)
+    (puthash (cons 20 5) (cons 10 300.0) alt-paths)
+    (let* ((entry1 (gethash (cons 10 3) alt-paths))
+           (entry2 (gethash (cons 10 4) alt-paths)))
+      (if (and entry1
+               (= (car entry1) 5)
+               (= (cdr entry1) 150.0)
+               entry2
+               (= (car entry2) 6))
+          (message "✓ Alt paths hash: PASSED")
+        (message "✗ Alt paths hash: FAILED")))))
+
+(defun ekp-test-unit--threshold-factor ()
+  "Test threshold factor variable."
+  (let ((original ekp-threshold-factor))
+    (setq ekp-threshold-factor 2.0)
+    (let ((result (and (numberp ekp-threshold-factor)
+                       (= ekp-threshold-factor 2.0))))
+      (setq ekp-threshold-factor original)
+      (if result
+          (message "✓ Threshold factor: PASSED")
+        (message "✗ Threshold factor: FAILED")))))
+
+(defun ekp-test-unit--flagged-penalty ()
+  "Test flagged penalty is negative (preferred break)."
+  (if (< ekp-flagged-penalty 0)
+      (message "✓ Flagged penalty negative: PASSED")
+    (message "✗ Flagged penalty negative: FAILED")))
+
 (defun ekp-test-unit-all ()
   "Run all unit tests."
   (interactive)
@@ -202,6 +261,12 @@ Returns time in seconds."
   (ekp-test-unit--hash-consistency)
   (ekp-test-unit--struct-access)
   (ekp-test-unit--dp-cache-storage)
-  (message "=== Unit Tests Complete ==="))
+  ;; New feature tests
+  (ekp-test-unit--hyphenate-p-binary-search)
+  (ekp-test-unit--flagged-p-binary-search)
+  (ekp-test-unit--alt-paths-hash)
+  (ekp-test-unit--threshold-factor)
+  (ekp-test-unit--flagged-penalty)
+  (message "=== Unit Tests Complete ===")))
 
 ;; (ekp-test-unit-all)