Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (defun flatten (tree)
- "David S. Toutersky."
- (cond ((atom tree) (list tree))
- (t (append (flatten (car tree))
- (flatten (cdr tree))))))
- (defun pairings (list &optional &key remove-nil)
- "Turn a list into a list of lists, each with pairs of value (n and n+1 on the index). :REMOVE-NIL, if T, removes all the NIL values. Just bite the bullet and use it"
- (let ((out (loop for n from 0 to (length list) append (list (list (nth n list) (nth (1+ n) list))) do (incf n))))
- (if (not (null remove-nil))
- (setf out (remove-if #'(lambda (x) (or (null (car x)) (null (cadr x)))) out)))
- (append out)))
- (defun sequence-from-pairings (input-list pairing-list)
- "Take an INPUT-LIST, split it into many lists using the pair values (START, END) from the lists in PAIRING-LIST."
- (loop for n from 0 to (1- (length pairing-list)) collecting (list-subseq input-list (car (nth n pairing-list)) (cadr (nth n pairing-list)))))
- (defun split-string (string char)
- "Thanks to the Common Lisp Cookbook. http://cl-cookbook.sourceforge.net/strings.html#reverse"
- (let* ((parsed-string (loop for i = 0 then (1+ j)
- as j = (position char string :start i)
- collect (subseq string i j)
- while j)))
- (remove-if #'(lambda (x) (equalp x "")) parsed-string)))
- (defun tokenize (string replacement &key (test #'char=))
- "Thanks to the Common Lisp Cookbook. http://cl-cookbook.sourceforge.net/strings.html#manip
- Returns a new string in which all the occurences of the part
- is replaced with replacement."
- (with-output-to-string (out)
- (loop with part-length = (length "(")
- for old-pos = 0 then (+ pos part-length)
- for pos = (search "(" string
- :start2 old-pos
- :test test)
- do (write-string string out
- :start old-pos
- :end (or pos (length string)))
- when pos do (write-string " ( " out)
- while pos))
- (with-output-to-string (out)
- (loop with part-length = (length ")")
- for old-pos = 0 then (+ pos part-length)
- for pos = (search ")" string
- :start2 old-pos
- :test test)
- do (write-string string out
- :start old-pos
- :end (or pos (length string)))
- when pos do (write-string " ) " out)
- while pos))
- )
- (defun trim-excess-chars (string char)
- "Remove all the instances of CHAR from STRING. CHAR must be a single-character string, not a character."
- (coerce (delete (car (coerce char 'list)) (coerce string 'list)) 'string))
- (defun list-subseq (list start &optional end)
- "Return the items from a LIST between START and (Optionally, defaults to length of string) END."
- (if end (loop for a from start to end collecting (nth a list))
- (loop for a from start to (1- (length list)) collecting (nth a list))))
- (defun collapse-list (list start end)
- "Replace all the items from a LIST between START and END with a list containing said items."
- (nconc (list-subseq list 0 (1- start))
- (list (list-subseq list start end))
- (list-subseq list (1+ end) (1- (length list)))))
- (defun enclose-delimiters (list delimiter &optional expand-left expand-right)
- "Return a list where all items between the first and last instances of DELIMITER have been enclosed into a list, except the delimiters themselves. OPTIONAL: EXPAND-LEFT and EXPAND-RIGHT
- enclose items up to a certain number to the left or right (Respectively) into the output list."
- (let* ((delimiter-list '()))
- (loop for n from 0 to (length list) do
- (if (equalp delimiter (nth n list))
- (push n delimiter-list)
- ))
- (setf delimiter-list (append (list (first (reverse delimiter-list))) (last (reverse delimiter-list))))
- (if expand-left (decf (car delimiter-list) expand-left))
- (if (< (car delimiter-list) 0) (setf (car delimiter-list) 0))
- (if expand-right (incf (car (last delimiter-list)) expand-right))
- (if (> (car (last delimiter-list)) (length list)) (setf (car (last delimiter-list)) (length list)))
- (collapse-list list (car delimiter-list) (car (last delimiter-list)))))
- (defun collect-item-positions (list item &optional &key append-beginning append-end single?)
- "Collect the positions of many instances of ITEM in a LIST. The variable :SINGLE?, if T, tells the interpreter to return after one instance has been found."
- (let ((delimiter-positions '()))
- (loop for n from 0 to (length list) do
- (if (equalp item (nth n list))
- (progn (setf delimiter-positions (nconc delimiter-positions (list n)))
- (if single? (return n)))))
- (append delimiter-positions)))
- (defun list-split-multiple-delimiters (list delimiter)
- "Split a list into many sublists using the instances of DELIMITER as delimiters. The beginning of the list and endpoint are taken as delimiters too."
- (let ((output-list list)
- (item-positions '()))
- (loop for n from 0 to (length output-list) do
- (cond ((equalp delimiter (nth n output-list))
- (setf output-list (nconc (list-subseq output-list 0 (1- n))
- (list delimiter delimiter)
- (list-subseq output-list (1+ n))))
- (incf n 1)
- (setf output-list (remove-if #'null (flatten output-list))))))
- (setf output-list (nconc (list delimiter) output-list (list delimiter)))
- (setf item-positions (collect-item-positions output-list delimiter))
- (setf item-positions (pairings item-positions :remove-nil t))
- (setf output-list (sequence-from-pairings output-list item-positions))
- (setf output-list (reverse (rest (reverse (loop for n from 0 to (length output-list) collecting
- (list-subseq (nth n output-list) 1 (- (length (nth n output-list)) 2)))))))
- ))
- (defun concatenate-list-of-strings (list)
- "Concatenate the strings in LIST into a single string (hurr durr)."
- (apply #'concatenate 'string list))
- (defun concatenate-strings-with-spaces (list)
- "Concatenate the strings in LIST into a single string but separate each string them with a space. Except the last one."
- (loop for n from 0 to (- (length list) 2) do (setf (nth n list) (concatenate 'string (nth n list) " ")))
- (setf list (concatenate-list-of-strings list)))
- ;;TODO: Add optional :test=#' arguments to a bunch of these
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement