source: release/1.9/source/library/sequence-utils.lisp @ 15706

Last change on this file since 15706 was 9541, checked in by mikel, 11 years ago

udpated sequence utils

File size: 3.5 KB
Line 
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)))
Note: See TracBrowser for help on using the repository browser.