Topic: -={ Challenge }=- Multi-Delimiter String Parsing

[Lee Mac]

The Challenge:

To separate elements of a string by a list of delimiters.

Example:

Code: [Select]

(MultiParse "This;is.a,Test;String" '(";" "." ","))

==>  ("This" "is" "a" "Test" "String")


Code: [Select]

(MultiParse "This&%is,5%" '("," "&%"))

==>  ("This" "is" "5%")


Code: [Select]

(MultiParse "&This,is,a&Test," '("&" ","))

==> ("This" "is" "a" "Test")

Enjoy!

Lee

[CAB]

Here is a quickie.

Code: [Select]

(defun sparserm (str delim / ptr lst)
  (while (setq ptr (vl-remove 'nil (mapcar (function (lambda(x) (vl-string-search x str))) delim)))
    (setq ptr (apply 'min ptr))
    (setq lst (cons (substr str 1 ptr) lst))
    (setq str (substr str (+ ptr 2)))
  )
  (reverse(cons str lst))
)

[Lee Mac]

Nice one Alan 

How about for delims of length > 1 

Code: [Select]

(sparserm "This&%is,5%" '("," "&%"))

[Lee Mac]

My first entry:

Code: [Select]

(defun LM:StringParserM ( str del / foo l )

  (defun foo ( str del )
    (if (setq pos (vl-string-search del str))
      (vl-remove ""
        (cons (substr str 1 pos)
          (foo
            (substr str (+ pos 1 (strlen del))) del
          )
        )
      )
      (list str)
    )
  )

  (setq l (foo str (car del)))
 
  (foreach x (cdr del)
    (setq l
      (apply (function append)
        (mapcar (function (lambda ( y ) (foo y x))) l)
      )
    )
  )
  l
)


[CAB]

How about for delims of length > 1 

Was that in the specifications? 

[hermanm]

Nice one, Lee.

Code: [Select]

Command: (LM:StringParserM "This;is.a,Test;\String" '(";" "." "," "\\"))
("This" "is" "a" "Test" "String")


Code: [Select]

Command: (LM:StringParserM "This\nis a test\n     " '(" " "\n"))
("This" "is" "a" "test")


[Lee Mac]

How about for delims of length > 1 

Was that in the specifications? 

I hadn't included an example, but it was my intention 

[Lee Mac]

Nice one, Lee.

Code: [Select]

Command: (LM:StringParserM "This;is.a,Test;\String" '(";" "." "," "\\"))
("This" "is" "a" "Test" "String")


Code: [Select]

Command: (LM:StringParserM "This\nis a test\n     " '(" " "\n"))
("This" "is" "a" "test")


Thanks Herman 

[LE3]

Code: [Select]

;;(mparser '(";" "." "," "\\") "This;is.a,Test;\String")
;;("This" "is" "a" "Test" "String")
;;(mparser '(";" "." ",") "This;is.a,Test;String")
;;("This" "is" "a" "Test" "String")
(defun mparser (pat str / pattern i j n lst)
  (setq p (car pat))
  (setq pattern (vl-remove p pat))
  (setq i 0)
  (repeat (length pattern)
    (setq str (vl-string-subst p (nth i pattern) str))
    (setq i (1+ i))
  )
  (cond
    ((/= (type str) (type p) 'STR))
    ((= str p) '(""))
    (T
     (setq i 0
  n (strlen p)
     )
     (while (setq j (vl-string-search p str i))
       (setq lst (cons (substr str (1+ i) (- j i)) lst)
    i (+ j n)
       )
     )
     (mapcar '(lambda (x) (vl-string-trim " " x))
    (reverse (cons (substr str (1+ i)) lst))
     )
    )
  )
)

[Lee Mac]

Another,

Code: [Select]

(defun LM:StringParserM2 ( str del / pos x )
  ;; © Lee Mac 2010
  (if (setq pos
        (car
          (setq x
            (car
              (vl-sort
                (vl-remove nil
                  (mapcar
                    (function
                      (lambda ( d / p )
                        (if (setq p (vl-string-search d str))
                          (cons p (strlen d))
                        )
                      )
                    )
                    del
                  )
                )
                (function
                  (lambda ( a b ) (< (car a) (car b)))
                )
              )
            )
          )
        )
      )
    (vl-remove ""
      (cons (substr str 1 pos)
        (LM:StringParserM2
          (substr str (+ pos 1 (cdr x))) del
        )
      )
    )
    (list str)
  )
)


[Lee Mac]

Perhaps a slightly more elegant version of my first one 

Code: [Select]

(defun LM:StringParserM ( str del / foo l )

  (defun foo ( str del )
    (if (setq pos (vl-string-search del str))
      (vl-remove ""
        (cons (substr str 1 pos)
          (foo
            (substr str (+ pos 1 (strlen del))) del
          )
        )
      )
      (list str)
    )
  )

  (if (cdr del)
    (apply (function append)
      (mapcar (function (lambda ( x ) (LM:StringParserM x (cdr del))))
        (foo str (car del))
      )
    )
    (foo str (car del))
  )
)


[LE3]

edited.-

Code: [Select]

;;parsermult uses a token character separator to replace
;;all the characters separators in the patterns list
;;will check if the token is not on the patterns or in the string
;;returns= a list of new strings or nil
;;usage:
;;(parsermult "this;is;;a,test\"\"" '(";" "," "\"") "|")
;;("this" "is" "a" "test")
(defun parsermult  (string patterns token / pattern pos lst)
  (if (and (not (vl-position token patterns))
   (not (vl-string-search token string)))
    (progn
      (while (setq pattern (car patterns))
(while (and pattern (vl-string-search pattern string))
  (setq string (vl-string-subst token pattern string)))
(setq patterns (cdr patterns)))
      (while (setq pos (vl-string-search token string))
(setq lst    (cons (substr string 1 pos) lst)
      string (substr string (+ pos 2))))
      (vl-remove "" (reverse lst)))))


[It's Alive!]

mine 

Code: [Select]

(defun MultiParse (string delims / dlist item llout tmpl)
  (setq tmpl '() llout '()  dlist (vl-string->list delims))
  (foreach item (vl-string->list (vl-string-right-trim delims string))
    (if (not (vl-position item dlist))
      (setq tmpl (cons item tmpl))
      (progn
        (setq llout (append llout (list(vl-list->string(reverse tmpl)))) tmpl '())
      )
    )
  )
  (append llout (list(vl-list->string(reverse tmpl))))
)

(MultiParse "This;is.a,Test;String" ";.,")


[Kerry]

Daniel, I have one with similar functionality :

However I think the expectation was that the delimiters be a list of strings, each of which shall be removed from the parent string if existing.

... this should allow the the removal of character patterns like " ex" and "'s " from the parent.

[It's Alive!]

ah ok, maybe something like

Code: [Select]

(defun MultiParse (string delims / item llout s tdlim tmpl tstr)
  (setq tstr "" tdlim "")
  (repeat (length delims)
    (setq tstr (strcat " " tstr)))
  (foreach s  delims
    (setq tdlim (strcat s tdlim)))
  (setq tmpl '() llout '())
  (foreach item (vl-string->list (vl-string-right-trim " "(vl-string-translate tdlim tstr string)))
    (if (/= item 32)
      (setq tmpl (cons item tmpl))
      (progn
        (setq llout (append llout (list(vl-list->string(reverse tmpl)))) tmpl '())
      )
    )
  )
  (append llout (list(vl-list->string(reverse tmpl))))
)

(MultiParse "This;is.a,Test;String " '(";" "." ","))