TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Lee Mac on July 25, 2010, 10:36:35 AM
-
The Challenge:
To separate elements of a string by a list of delimiters.
Example:
(MultiParse "This;is.a,Test;String" '(";" "." ","))
==> ("This" "is" "a" "Test" "String")
(MultiParse "This&%is,5%" '("," "&%"))
==> ("This" "is" "5%")
(MultiParse "&This,is,a&Test," '("&" ","))
==> ("This" "is" "a" "Test")
Enjoy!
Lee
-
Here is a quickie. 8-)
(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))
)
-
Nice one Alan 8-)
How about for delims of length > 1 :evil:
(sparserm "This&%is,5%" '("," "&%"))
-
My first entry:
(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
)
-
How about for delims of length > 1 :evil:
Was that in the specifications? :evil:
-
Nice one, Lee.:)
Command: (LM:StringParserM "This;is.a,Test;\String" '(";" "." "," "\\"))
("This" "is" "a" "Test" "String")
Command: (LM:StringParserM "This\nis a test\n " '(" " "\n"))
("This" "is" "a" "test")
-
How about for delims of length > 1 :evil:
Was that in the specifications? :evil:
I hadn't included an example, but it was my intention :wink:
-
Nice one, Lee.:)
Command: (LM:StringParserM "This;is.a,Test;\String" '(";" "." "," "\\"))
("This" "is" "a" "Test" "String")
Command: (LM:StringParserM "This\nis a test\n " '(" " "\n"))
("This" "is" "a" "test")
Thanks Herman :-)
-
;;(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))
)
)
)
)
-
Another,
(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)
)
)
-
Perhaps a slightly more elegant version of my first one :-)
(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))
)
)
-
edited.-
;;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)))))
-
mine :-D
(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" ";.,")
-
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.
-
ah ok, maybe something like
(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 " '(";" "." ","))
-
my code, based on CAB and alanjt 's codes on one delim member
First is to subst all the other delims in the string to the first member of delim
;;;Thanks to alanjt and CAB's codes at : http://www.theswamp.org/index.php?topic=32845.0
;;;add a little by qjchen
(defun q:str:delim(str delimlst / l inc)
(foreach x (cdr delimlst)
(while (vl-string-search x str)
(setq str (vl-string-subst (car delimlst) x str))))
(while (setq inc (vl-string-search (car delimlst) str))
(setq l (cons (substr str 1 inc) l)
str (substr str (+ (strlen (car delimlst)) inc 1)))
)
(vl-remove "" (reverse (cons str l)))
)
(q:str:delim ";;;...This;is.a,Test;abStringab" '("ab" ";" "." ","))
To Daniel, when use (MultiParse ";;;...This;is.a,Test;abStringab" '("ab" ";" "." ","))
=> ("" "" "" "" "" "" "This" "is" "" "" "Test" "" "bString" "b")
-
The dog ate my homework. :roll:
-
The dog ate my homework. :roll:
:D
-
To Daniel, when use (MultiParse ";;;...This;is.a,Test;abStringab" '("ab" ";" "." ","))
=> ("" "" "" "" "" "" "This" "is" "" "" "Test" "" "bString" "b")
:-o sorry, I am very new at lisp :laugh:
-
To Daniel, when use (MultiParse ";;;...This;is.a,Test;abStringab" '("ab" ";" "." ","))
=> ("" "" "" "" "" "" "This" "is" "" "" "Test" "" "bString" "b")
:-o sorry, I am very new at lisp :laugh:
It gets easier after 5 or 6 thousand lines of code ...
... oh, wait, you know that from one app don't you ?? ;-)
-
ok hows this one?
(defun MultiParse (string delims / char cnt flag len lout s tdlim tstr)
(setq tstr ""
tdlim ""
cnt 0
len (strlen string)
flag nil
lout '()
)
(foreach s delims
(setq tdlim (strcat s tdlim)))
(while (<= cnt len)
(setq char (substr string (1+ cnt) 1))
(if (vl-string-search char tdlim)
(progn
(if flag
(progn
(setq lout (append lout (list tstr))
tstr ""
flag nil
)
)
)
)
(progn
(setq tstr (strcat tstr char)
flag t
)
)
)
(setq cnt (1+ cnt))
)
lout
)
(MultiParse ";;;;;;;;;;;;;This;;;is.a,Test;String hi;,,,yes;;." '(";" "." ","))
(MultiParse "This&%is,5%" '("," "&%"))
-
(defun Parse-AJT (s dLst / i l)
(while (setq i (vl-remove nil
(mapcar
(function (lambda (x) (vl-string-search (strcase x) (strcase s))))
dLst
)
)
)
(setq l (cons (substr s 1 (setq i (apply (function min) i))) l)
s (substr s (+ 2 i))
)
)
(vl-remove "" (reverse (cons s l)))
)
Result:
(parse-ajt "1,2,3,4,5,6.7.8.9.10" (list "," "."))
("1" "2" "3" "4" "5" "6" "7" "8" "9" "10")
-
Awseome, but fails here (Parse-AJT "This&%is,5%" '("," "&%"))
-
(parse-ajt "1,2,3,4,5,6.7.8.9.10" (list "," "5" "10" "."))
;;=>> ("1" "2" "3" "4" "6" "7" "8" "9" "0")
oops, Dainiel beat me again.
-
Oops, I forgot to account for strings being longer than one character. :ugly:
-
So far:
Command: (LM:STRINGPARSERM "This\nis a;; test\n" '("\n" " " ";"))
("This" "is" "a" "test")
Command: (LM:STRINGPARSERM "This\nis a;; test\n" '("\n" " " ";;"))
("This" "is" "a" "test")
Command: (mparser '("\n" " " ";") "This\nis a;; test\n")
("This" "is" "a" "; test" "")
Command: (mparser '("\n" " " ";;") "This\nis a;; test\n")
("This" "is" "a" "test" "")
Command: (multiparse "This\nis a;; test\n" '("\n" " " ";"))
("This" "is" "a" "" "" "test")
Command: (multiparse "This\nis a;; test\n" '("\n" " " ";;"))
("This\nis" "a" "" "" "test\n")
-
Command: (parse-ajt "This\nis a;; test\n" '("\n" " " ";"))
("This" "is" "a" "test")
Command: (parse-ajt "This\nis a;; test\n" '("\n" " " ";;"))
("This" "is" "a" ";" "test")
-
and Dan's update:
Command: (multiparse "This\nis a;; test\n" '("\n" " " ";"))
("This" "is" "a" "test")
Command: (multiparse "This\nis a;; test\n" '("\n" " " ";;"))
("This" "is" "a" "test")
Sorry I don't have time to play :( :(
-
Command: (Q:STR:DELIM "This\nis a;; test\n" '("\n" " " ";"))
("This" "is" "a" "test")
Command: (Q:STR:DELIM "This\nis a;; test\n" '("\n" " " ";;"))
("This" "is" "a" "test")
(not claiming the test strings to be anything special, just what popped into my head)
-
(defun Parse-AJT2 (s dLst / i n l)
(while (setq i (vl-remove nil
(mapcar
(function (lambda (x / v)
(if (setq v (vl-string-search (strcase x) (strcase s)))
(cons v (1- (strlen x)))
)
)
)
dLst
)
)
)
(setq l (cons (substr s 1 (setq n (caar (vl-sort i '(lambda (a b) (< (car a) (car b))))))) l)
s (substr s (+ 2 (cdr (assoc n i)) n))
)
)
(vl-remove "" (reverse (cons s l)))
)
-
(defun Parse-AJT3 (s dLst / i n l)
(while (setq i (vl-remove nil
(mapcar
(function (lambda (x / v)
(if (setq v (vl-string-search (strcase x) (strcase s)))
(cons v (strlen x))
)
)
)
dLst
)
)
)
(setq l (cons (substr s 1 (setq n (caar (vl-sort i '(lambda (a b) (< (car a) (car b))))))) l)
s (substr s (+ 1 (cdr (assoc n i)) n))
)
)
(vl-remove "" (reverse (cons s l)))
)
-
.
-
qjchen, that's quite impressive.
-
Thank you Daniel for your test. I am not sure whether there are still bugs in my codes.
And thank you alanjt, my codes are mainly based on yours and CAB's codes. I changed the "2" in your code to "(strlen delim)" to be applicable for multi-char delim
-
i insist that a split function should work like this
(somesplit ";This;;is;a;test;" '(";"))
==>("" "This" "" "is" "a" "test" "")
-
Thank you Daniel for your test. I am not sure whether there are still bugs in my codes.
And thank you alanjt, my codes are mainly based on yours and CAB's codes. I changed the "2" in your code to "(strlen delim)" to be applicable for multi-char delim
Well, I like it! :)
-
a bit faster but not enough
(defun MultiParse2 (string delims / char cnt flag len lout s tstr)
(setq tstr ""
tdlim ""
cnt 0
flag n
lout '()
delim (car delims)
)
(foreach s delims
(setq tdlim (strcat s tdlim))
)
(repeat (strlen tdlim)
(setq tstr (strcat delim tstr))
)
(setq string (vl-string-trim " " (vl-string-translate tdlim tstr string))
tstr ""
len (strlen string)
)
(while (<= cnt len)
(setq cnt (1+ cnt))
(setq char (substr string cnt 1))
(if (= char delim)
(progn
(if flag
(progn
(setq lout (append lout (list tstr))
tstr ""
flag nil
)
)
)
)
(progn
(setq tstr (strcat tstr char)
flag t
)
)
)
)
lout
)
-
does anyone mind that mine doesn't work with "\"" ? :)
(defun msplit (str dList)
(foreach d dList (setq str (vk_StringSubstPat "\" \"" d str nil)))
(read (strcat "(\"" str "\")"))
)
-
Damn I wish I had more time to play around with this :|
-
Minor attempt at optimisation of Chen's
(defun LM:StringParserM3 ( str del / x y z l p )
(setq x (car del) y (1+ (strlen x)))
(while (setq del (cdr del))
(while (vl-string-search (setq z (car del)) str)
(setq str (vl-string-subst x z str))
)
)
(while (setq p (vl-string-search x str))
(setq l (cons (substr str 1 p) l) str (substr str (+ p y)))
)
(vl-remove "" (reverse (cons str l)))
)
-
(defun f1 (s p / i l)
(while (setq i (vl-string-search p s))
(setq l (cons (substr s 1 i) l)
s (substr s (+ 1 i (strlen p)))
)
)
(reverse (cons s l))
)
(defun mpars (s d)
(setq d1 ""
d2 ""
d3 '("\001")
)
(foreach p d
(if (= (substr p 2) "")
(setq d1 (strcat p d1)
d2 (strcat "\001" d2)
)
(setq d3 (cons p d3))
)
)
(setq s (list (vl-string-translate d1 d2 s)))
(foreach p d3
(setq s (apply (function append) (mapcar (function (lambda (a) (f1 a p))) s)))
)
(vl-remove "" s)
)
-
and the results
Elapsed milliseconds / relative speed for 16384 iteration(s):
(LM:STRINGPARSERM3 ";;;;;;;;;;;;;Thi...)......1529 / 6.84 <fastest>
(Q:STR:DELIM ";;;;;;;;;;;;;This;;;is...)......1919 / 5.45
(MPARS ";;;;;;;;;;;;;This;;;is.a,;.T...)......2168 / 4.82
(MULTIPARSE2 ";;;;;;;;;;;;;This;;;is...)......2387 / 4.38
(MULTIPARSE1 ";;;;;;;;;;;;;This;;;is...)......2808 / 3.72
(LM:STRINGPARSERM ";;;;;;;;;;;;;This...)......4633 / 2.26
(LM:STRINGPARSERM2 ";;;;;;;;;;;;;Thi...).....10452 / 1.00 <slowest>
-
and the results
...
Show the arguments of function calls to compare the speed ...
-
and the results
...
Show the arguments of function calls to compare the speed ...
Right, yours is faster with longer strings
(setq _str (strcat "hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to."
"the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you."
"the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you."
"the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you."
"the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you."
"the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you."))
(BenchMark
'(
(LM:StringParserM _str '("." "," ))
(LM:StringParserM2 _str '("." "," ))
(q:str:delim _str '("." "," ))
(MultiParse2 _str '("." "," ))
(MultiParse1 _str '("." "," ))
(LM:StringParserM3 _str '("." ","))
(mpars _str '("." ","))
)
)
Elapsed milliseconds / relative speed for 4096 iteration(s):
(LM:STRINGPARSERM3 _STR (QUOTE ("." ...)......1841 / 6.89 <fastest>
(MPARS _STR (QUOTE ("." ",")))................1872 / 6.78--------------------------------
(Q:STR:DELIM _STR (QUOTE ("." ",")))..........2293 / 5.53
(LM:STRINGPARSERM _STR (QUOTE ("." "...)......4883 / 2.60
(MULTIPARSE2 _STR (QUOTE ("." ",")))..........8877 / 1.43
(MULTIPARSE1 _STR (QUOTE ("." ","))).........10592 / 1.20
(LM:STRINGPARSERM2 _STR (QUOTE ("." ...).....12683 / 1.00 <slowest>
-
I get the opposite results ... :-(
(setq _str (strcat "hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to."
"the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you."
"the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you."
"the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you."
"the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you."
"the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you.welcome.to.the,swamp,hello.how.are.you."))
(BenchMark
'(
(q:str:delim _str '("." "," ))
(LM:StringParserM3 _str '("." ","))
(mpars _str '("." ","))
)
)Benchmarking ..............Elapsed milliseconds / relative speed for 2048 iteration(s):
(MPARS _STR (QUOTE ("." ",")))...............1155 / 1.28 <fastest>
(LM:STRINGPARSERM3 _STR (QUOTE ("." ...).....1248 / 1.19
(Q:STR:DELIM _STR (QUOTE ("." ","))).........1482 / 1 <slowest>
_$
-
Benchmarking ..............Elapsed milliseconds / relative speed for 2048 iteration(s):
(MSPLIT _STR (QUOTE ("." ",")))..............1500 / 1.66 <fastest>
(MPARS _STR (QUOTE ("." ",")))...............2063 / 1.20
(LM:STRINGPARSERM3 _STR (QUOTE ("." ...).....2484 / 1.00 <slowest>