1 | ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: cl-user -*- |
---|
2 | ;;;; *********************************************************************** |
---|
3 | ;;;; FILE IDENTIFICATION |
---|
4 | ;;;; |
---|
5 | ;;;; Name: sequence-utils.lisp |
---|
6 | ;;;; Version: 0.2 |
---|
7 | ;;;; Project: utilities |
---|
8 | ;;;; Purpose: utilities for working with sequences |
---|
9 | ;;;; |
---|
10 | ;;;; *********************************************************************** |
---|
11 | |
---|
12 | (in-package "CCL") |
---|
13 | |
---|
14 | ;;; ----------------------------------------------------------------- |
---|
15 | ;;; splitting sequences |
---|
16 | ;;; ----------------------------------------------------------------- |
---|
17 | |
---|
18 | ;;; Split a sequence SEQ at each point where TEST is true |
---|
19 | ;;; DIR should be one of :BEFORE, :AFTER or :ELIDE |
---|
20 | |
---|
21 | (defun split-if (test seq &optional (dir :before)) |
---|
22 | (remove-if |
---|
23 | #'(lambda (x) (equal x (subseq seq 0 0))) |
---|
24 | (loop for start fixnum = 0 |
---|
25 | then (if (eq dir :before) stop (the fixnum (1+ (the fixnum stop)))) |
---|
26 | while (< start (length seq)) |
---|
27 | for stop = (position-if |
---|
28 | test seq |
---|
29 | :start (if (eq dir :elide) start (the fixnum (1+ start)))) |
---|
30 | collect (subseq |
---|
31 | seq start |
---|
32 | (if (and stop (eq dir :after)) |
---|
33 | (the fixnum (1+ (the fixnum stop))) |
---|
34 | stop)) |
---|
35 | while stop))) |
---|
36 | |
---|
37 | (defun split-if-char (char seq &optional dir) |
---|
38 | (split-if #'(lambda (ch) (eq ch char)) seq dir)) |
---|
39 | |
---|
40 | (defmethod split-lines ((text string)) |
---|
41 | (delete-if (lambda (x) (string= x "")) |
---|
42 | (mapcar (lambda (s) |
---|
43 | (string-trim '(#\return #\newline) s)) |
---|
44 | (split-if (lambda (c) (member c '(#\return #\newline) :test #'char=)) |
---|
45 | text)))) |
---|
46 | |
---|
47 | ;;; ----------------------------------------------------------------- |
---|
48 | ;;; matching subsequences |
---|
49 | ;;; ----------------------------------------------------------------- |
---|
50 | |
---|
51 | (defun match-subsequence (subseq seq &key (test #'eql) (start 0)) |
---|
52 | (let ((max-index (1- (length seq)))) |
---|
53 | (block matching |
---|
54 | ;; search for mismatches |
---|
55 | (dotimes (i (length subseq)) |
---|
56 | (let ((pos (+ start i))) |
---|
57 | (when (or (> pos max-index) |
---|
58 | (not (funcall test (elt seq pos) |
---|
59 | (elt subseq i)))) |
---|
60 | (return-from matching nil)))) |
---|
61 | ;; no mismatches found; return true |
---|
62 | (return-from matching t)))) |
---|
63 | |
---|
64 | (defun %find-matching-subsequence-backward (subseq seq &key (test #'eql) (start 0) end) |
---|
65 | (let ((end (or end (length seq))) |
---|
66 | (pos end) |
---|
67 | (min-index (or start 0))) |
---|
68 | (block finding |
---|
69 | (dotimes (i (- (length seq) start)) |
---|
70 | (setf pos (- end i)) |
---|
71 | (if (<= pos min-index) |
---|
72 | (return-from finding nil) |
---|
73 | (when (match-subsequence subseq seq :test test :start pos) |
---|
74 | (return-from finding pos)))) |
---|
75 | nil))) |
---|
76 | |
---|
77 | (defun %find-matching-subsequence-forward (subseq seq &key (test #'eql) (start 0) end) |
---|
78 | (let ((pos start) |
---|
79 | (max-index (or end (length seq)))) |
---|
80 | (block finding |
---|
81 | (dotimes (i (- (length seq) start)) |
---|
82 | (setf pos (+ start i)) |
---|
83 | (if (>= pos max-index) |
---|
84 | (return-from finding nil) |
---|
85 | (when (match-subsequence subseq seq :test test :start pos) |
---|
86 | (return-from finding pos)))) |
---|
87 | nil))) |
---|
88 | |
---|
89 | (defun find-matching-subsequence (subseq seq &key (test #'eql) (start 0) end from-end) |
---|
90 | (if from-end |
---|
91 | (%find-matching-subsequence-backward subseq seq :test test :start start :end end) |
---|
92 | (%find-matching-subsequence-forward subseq seq :test test :start start :end end))) |
---|