Topic: Split String With String

[Grrr1337]

Hi guys,
 I've wrote this to handle easier some string manipulation:

Code - Auto/Visual Lisp: [Select]

1. ; SplitStr - String used to split
2. ; TotalStr - total string
3. ; This is whats supposed to do [the delimiter is a string, not a character]:
4. ; (SplitStrWithStr "ABC" "HESJAABCHJE SAABCHJEWABC") -> '("HESJA" "ABC" "HJE SA" "ABC" "HJEWABC")
5. (defun SplitStrWithStr ( SplitStr TotalStr / i->L TrimListFrom stringp L n Nths r sL nStr wait r1 r2 itm rr LastS tmp )
6.  
7.   (defun i->L ( i / L ) (repeat i (setq L (cons (setq i (1- i)) L))) (reverse L))
8.   (defun TrimListFrom ( n L ) (repeat n (setq L (cdr L))) L)
9.   (defun stringp ( s ) (eq 'STR (type s)))
10.  
11.   (setq L (mapcar 'chr (vl-string->list TotalStr)))
12.   (setq n (strlen SplitStr))
13.   (setq Nths (i->L n))
14.   (while L
15.     (and
16.       (setq sL (reverse (vl-remove-if-not 'stringp (mapcar (function (lambda (x) (nth x L))) Nths))))
17.       (setq nStr (apply 'strcat sL))
18.       (cond ; "nStr" - constantly changing string with length equal to the "SplitStr"
19.         ( (= SplitStr nStr)
20.           (and itm (setq r (cons (apply 'strcat (vl-remove-if-not 'stringp (reverse itm))) r)) (setq itm nil))
21.           (setq r (cons nStr r))
22.           (setq L (TrimListFrom n L)) ; Skip it
23.           (and
24.             (setq tmp (vl-remove-if-not 'stringp L)) ; _$ (apply 'strcat nil) -> ""
25.             (setq tmp (apply 'strcat tmp))
26.             (setq LastS tmp)
27.           ); and
28.         )
29.         (T
30.           (setq itm (cons (car L) itm))
31.           (setq L (cdr L)) ; Process one by one
32.         ); T
33.       ); cond
34.     ); and
35.   ); while
36.   (append (reverse r) (if LastS (list LastS)))
37. ); defun
38.  

It should split the TotalStr, using a SplitStr and retain the SplitStr positions.
The problem is that if the last pattern is the SplitStr, it duplicates and fks up the result:

Code: [Select]

; _$ (SplitStrWithStr "$#*" "$#*ABC$#*")
; ("$#*" "ABC" "$#*" "ABC$#*")
; _$ (SplitStrWithStr "$#*" "$#*ABC")
; ("$#*" "ABC")
; _$ (SplitStrWithStr "$#*" "ABC$#*")
; ("ABC" "$#*")
; _$ (SplitStrWithStr "$#*" "$#*ABC$#*DEF$#*GHIJKL$#*MNOP$#*")
; ("$#*" "ABC" "$#*" "DEF" "$#*" "GHIJKL" "$#*" "MNOP" "$#*" "MNOP$#*")
; _$ (SplitStrWithStr "$#*" "ABC$#*DEF$#*GHIJKL$#*MNOP")
; ("ABC" "$#*" "DEF" "$#*" "GHIJKL" "$#*" "MNOP")
; _$ The returns should be as follow:

Code: [Select]

; _$ (SplitStrWithStr "$#*" "$#*ABC$#*")
; ("$#*" "ABC" "$#*")
; _$ (SplitStrWithStr "$#*" "$#*ABC")
; ("$#*" "ABC")
; _$ (SplitStrWithStr "$#*" "ABC$#*")
; ("ABC" "$#*")
; _$ (SplitStrWithStr "$#*" "$#*ABC$#*DEF$#*GHIJKL$#*MNOP$#*")
; ("$#*" "ABC" "$#*" "DEF" "$#*" "GHIJKL" "$#*" "MNOP" "$#*" "MNOP" "$#*")
; _$ (SplitStrWithStr "$#*" "ABC$#*DEF$#*GHIJKL$#*MNOP")
; ("ABC" "$#*" "DEF" "$#*" "GHIJKL" "$#*" "MNOP")
; _$
As you can see this is not a standard "split-string" function, that uses a letter/character delimeter, but a whole string instead. 

[ronjonp]

Here's a quick kludge

Code - Auto/Visual Lisp: [Select]

1. (defun _foo (p s / i out)
2.   (vl-load-com)
3.   (if (vl-string-search p s)
4.     (progn (while (setq i (vl-string-search p s))
5.         (setq out (cons (list (substr s 1 i) p) out))
6.         (setq s (substr s (+ 1 (strlen p) i)))
7.       )
8.       (vl-remove "" (append (apply 'append (reverse out)) (list s)))
9.     )
10.   )
11. )
12. (_foo "$#*" "$#*ABC$#*")
13. (_foo "$#*" "$#*ABC")
14. (_foo "$#*" "ABC$#*")
15. (_foo "$#*" "$#*ABC$#*DEF$#*GHIJKL$#*MNOP$#*")
16. (_foo "$#*" "ABC$#*DEF$#*GHIJKL$#*MNOP")
17. ;;;_$
18. ;;;_FOO
19. ;;;("$#*" "ABC" "$#*")
20. ;;;("$#*" "ABC")
21. ;;;("ABC" "$#*")
22. ;;;("$#*" "ABC" "$#*" "DEF" "$#*" "GHIJKL" "$#*" "MNOP" "$#*")
23. ;;;("ABC" "$#*" "DEF" "$#*" "GHIJKL" "$#*" "MNOP")
24. ;;;_$
25.  

[Grrr1337]

 Wow, Ron! You are such a ninja!

Anyway to reveal what were my ideas/intentions:
1. Some improvement on the algorithm of this thing [it was searching for a pattern of 7 characters (a b c d e f g)]
2. Obviously easy manipulation of the text content from an external file (referring more about DCL),
 which means that (set_attr) function can be created by reloading the dialog - no idea where it would be useful, but why limit ourselves?
 

[Marc'Antonio Alessi]

My version (I have modified an old function):

Code: [Select]

(defun ALE_String2ListWStrDlm (InpStr StrDlm / SttPos TmpPos DlmLng TmpLst TmpStr)
  (cond
    ( (/= (type InpStr) (type StrDlm) 'STR) )
    ( (= InpStr StrDlm) '("") )
    (T
      (setq
        DlmLng (strlen StrDlm)   SttPos 0
        TmpPos (vl-string-search StrDlm InpStr SttPos)
      )
      (while TmpPos
        (if (zerop (- TmpPos SttPos))
          (setq TmpLst  (cons StrDlm TmpLst))
          (setq TmpLst (cons StrDlm (cons (substr InpStr (1+ SttPos) (- TmpPos SttPos)) TmpLst)))
        )
        (setq
          SttPos (+ TmpPos DlmLng)
          TmpPos (vl-string-search StrDlm InpStr SttPos)
        )
      )
      (if (= "" (setq TmpStr (substr InpStr (1+ SttPos))))
        (reverse TmpLst)
        (reverse (cons TmpStr TmpLst))
      )
    )
  )
)

Code: [Select]

(ALE_String2ListWStrDlm "$#*ABC$#*" "$#*") => ("$#*" "ABC" "$#*")
(ALE_String2ListWStrDlm "$#*ABC" "$#*") => ("$#*" "ABC")
(ALE_String2ListWStrDlm "ABC$#*" "$#*") => ("ABC" "$#*")
(ALE_String2ListWStrDlm "$#*ABC$#*DEF$#*GHIJKL$#*MNOP$#*" "$#*") => ("$#*" "ABC" "$#*" "DEF" "$#*" "GHIJKL" "$#*" "MNOP" "$#*")
(ALE_String2ListWStrDlm "ABC$#*DEF$#*GHIJKL$#*MNOP" "$#*") => ("ABC" "$#*" "DEF" "$#*" "GHIJKL" "$#*" "MNOP")

[gile]

Code - Auto/Visual Lisp: [Select]

1. (defun foo (pat str / pos)
2.   (cond
3.     ((= str "") nil)
4.     ((not (setq pos (vl-string-search pat str))) (list str))
5.     ((zerop pos) (cons pat (foo pat (substr str (1+ (strlen pat))))))
6.     ((cons (substr str 1 pos) (foo pat (substr str (1+ pos)))))
7.   )
8. )

[Marc'Antonio Alessi]

Code: [Select]

(defun ALE_String2ListWStrDlm (InpStr StrDlm / SttPos TmpPos DlmLng TmpLst TmpStr)
  ; 20170611 - version 1.01 - just a little improvement 
  (cond
    ( (/= (type InpStr) (type StrDlm) 'STR) )
    ( (= InpStr StrDlm) (list InpStr) )
    (T
      (setq DlmLng (strlen StrDlm)   SttPos 0)
      (if (zerop (setq TmpPos (vl-string-search StrDlm InpStr SttPos)))
        (setq
          TmpLst (cons StrDlm TmpLst)     SttPos DlmLng
          TmpPos (vl-string-search StrDlm InpStr SttPos)
        )
      )
      (while TmpPos
        (setq
          TmpLst (cons StrDlm (cons (substr InpStr (1+ SttPos) (- TmpPos SttPos)) TmpLst))
          SttPos (+ TmpPos DlmLng)
          TmpPos (vl-string-search StrDlm InpStr SttPos)
        )
      )
      (if (= "" (setq TmpStr (substr InpStr (1+ SttPos))))
        (reverse TmpLst)
        (reverse (cons TmpStr TmpLst))
      )
    )
  )
)

[Grrr1337]

Thanks for the input guys!
I see that the main drawback in my code was avoiding the (vl-string-search) function, and rely on list iteration (not string iteration).

[Lee Mac]

Another variation:

Code - Auto/Visual Lisp: [Select]

1. (defun split ( s p / i )
2.     (if (/= "" s)
3.         (if (setq i (vl-string-search p s))
4.             (append (split (substr s 1 i) p) (list p) (split (substr s (+ (strlen p) i 1)) p))
5.             (list s)
6.         )
7.     )
8. )

[Marc'Antonio Alessi]

Code: [Select]

(defun ALE (s d / p m l o r)
  ; version for Speed Test
  (cond
    ( (= s d) (list s) )
    ( (setq l (strlen d))
      (if (zerop (setq m (vl-string-search d s 0)))
        (setq
          o (cons d o)     p l
          m (vl-string-search d s p)
        )
        (setq p 0)
      )
      (while m
        (setq
          o (cons d (cons (substr s (1+ p) (- m p)) o))
          p (+ m l)
          m (vl-string-search d s p)
        )
      )
      (if (= "" (setq r (substr s (1+ p))))
        (reverse o)
        (reverse (cons r o))
      )
    )
  )
)

Code: [Select]

(setq Keys "$#*" String "$#*ABC$#*DEF$#*GHIJKL$#*MNOP$#*")
Benchmark.lsp | © 2005 Michael Puckett | All Rights Reserved
Elapsed milliseconds / relative speed for 131072 iteration(s):
    (ALE STRING KEYS)..........1609 / 1.48 <fastest>
    (_FOO_RON KEYS STRING).....2203 / 1.08
    (SPLIT STRING KEYS)........2250 / 1.06
    (FOO_GILE KEYS STRING).....2375 / 1 <slowest>

[ronjonp]

Interesting .. I come up with completely different results:

SPLIT Benchmarking ...................Elapsed milliseconds / relative speed for 65536 iteration(s):


    (SPLIT "$#*" "$#*ABC$#*DEF$#*GHIJKL$...).....1562 / 1.75 <fastest>
    (ALE_STRING2LISTWSTRDLM "$#*" "$#*AB...).....1797 / 1.52
    (_FOO "$#*" "$#*ABC$#*DEF$#*GHIJKL$#...).....2547 / 1.07
    (FOO "$#*" "$#*ABC$#*DEF$#*GHIJKL$#*...).....2735 / 1.00 <slowest>


 
; 10 forms loaded from #<editor "<Untitled-4> loading...">
_$

[Marc'Antonio Alessi]

Interesting .. I come up with completely different results:...

Strange:

Code: [Select]

(setq Keys "$#*" String "$#*ABC$#*DEF$#*GHIJKL$#*MNOP$#*")
(Benchmark '(
(_foo Keys String)
(foo  Keys String)
(split String Keys)
(ALE String Keys)
(_foo Keys String)
(foo  Keys String)
(split String Keys)
(ALE String Keys)
)           )
 
Benchmark.lsp | © 2005 Michael Puckett | All Rights Reserved
Elapsed milliseconds / relative speed for 131072 iteration(s):

    (ALE STRING KEYS).......1688 / 1.65 <fastest>
    (ALE STRING KEYS).......1719 / 1.62
    (_FOO KEYS STRING)......2562 / 1.09
    (SPLIT STRING KEYS).....2625 / 1.06
    (_FOO KEYS STRING)......2656 / 1.05
    (FOO KEYS STRING).......2656 / 1.05
    (SPLIT STRING KEYS).....2718 / 1.02
    (FOO KEYS STRING).......2782 / 1 <slowest>

Benchmark.lsp | © 2005 Michael Puckett | All Rights Reserved
Elapsed milliseconds / relative speed for 131072 iteration(s):

    (ALE STRING KEYS).......1641 / 1.59 <fastest>
    (ALE STRING KEYS).......1718 / 1.52
    (FOO KEYS STRING).......2515 / 1.04
    (_FOO KEYS STRING)......2532 / 1.03
    (FOO KEYS STRING).......2532 / 1.03
    (_FOO KEYS STRING)......2547 / 1.02
    (SPLIT STRING KEYS).....2609 / 1
    (SPLIT STRING KEYS).....2610 / 1 <slowest>

[Marc'Antonio Alessi]

Ok... take look at the arguments:

Code: [Select]

(_foo  Keys String)
(foo   Keys String)
(split String Keys)
(ALE   String Keys)


[gile]

If speed is the goal, this one should be a little more efficient

Code - Auto/Visual Lisp: [Select]

1. (defun foo (pat str / pos)
2.   (cond
3.     ((= str "") nil)
4.     ((not (setq pos (vl-string-search pat str))) (list str))
5.     ((zerop pos) (cons pat (foo pat (substr str (1+ (strlen pat))))))
6.     ((vl-list* (substr str 1 pos) pat (foo pat (substr str (+ 1 (strlen pat) pos)))))
7.   )
8. )

Code: [Select]

$ (benchmark
  '((ALE_String2ListWStrDlm "$#*ABC$#*DEF$#*GHIJKL$#*MNOP$#*" "$#*")
    (ALE "$#*ABC$#*DEF$#*GHIJKL$#*MNOP$#*" "$#*")
    (_foo "$#*" "$#*ABC$#*DEF$#*GHIJKL$#*MNOP$#*")
    (split "$#*ABC$#*DEF$#*GHIJKL$#*MNOP$#*" "$#*")
    (foo "$#*" "$#*ABC$#*DEF$#*GHIJKL$#*MNOP")
   )
)
Benchmarking ...................Elapsed milliseconds / relative speed for 65536 iteration(s):

    (ALE "$#*ABC$#*DEF$#*GHIJKL$#*MNOP$#...).....1435 / 1.51 <fastest>
    (ALE_STRING2LISTWSTRDLM "$#*ABC$#*DE...).....1576 / 1.38
    (FOO "$#*" "$#*ABC$#*DEF$#*GHIJKL$#*...).....1576 / 1.38
    (SPLIT "$#*ABC$#*DEF$#*GHIJKL$#*MNOP...).....2060 / 1.05
    (_FOO "$#*" "$#*ABC$#*DEF$#*GHIJKL$#...).....2168 / 1 <slowest>

[Marc'Antonio Alessi]

Yes is faster, my test:

Code: [Select]

Elapsed milliseconds / relative speed for 131072 iteration(s):
    (ALE STRING KEYS).......1656 / 1.56 <fastest>
    (ALE STRING KEYS).......1703 / 1.51
    (FOO KEYS STRING).......2000 / 1.29
    (FOO KEYS STRING).......2000 / 1.29
    (_FOO KEYS STRING)......2516 / 1.02
    (_FOO KEYS STRING)......2531 / 1.02
    (SPLIT STRING KEYS).....2562 / 1.01
    (SPLIT STRING KEYS).....2578 / 1 <slowest>

Elapsed milliseconds / relative speed for 131072 iteration(s):
    (ALE STRING KEYS).......1688 / 1.52 <fastest>
    (ALE STRING KEYS).......1719 / 1.49
    (FOO KEYS STRING).......1969 / 1.3
    (FOO KEYS STRING).......2000 / 1.28
    (_FOO KEYS STRING)......2515 / 1.02
    (_FOO KEYS STRING)......2516 / 1.02
    (SPLIT STRING KEYS).....2532 / 1.01
    (SPLIT STRING KEYS).....2562 / 1 <slowest>

[Marc'Antonio Alessi]

Found a little bug:

Code: [Select]

(defun ALE (s d / p m l o r)
  ; 20170613 - version 1.02
  (cond
    ( (setq l (strlen d)  m (vl-string-search d s 0))
      (if (zerop m)
        (setq
          o (cons d o)     p l
          m (vl-string-search d s p)
        )
        (setq p 0)
      )
      (while m
        (setq
          o (cons d (cons (substr s (1+ p) (- m p)) o))
          p (+ m l)
          m (vl-string-search d s p)
        )
      )
      (if (= "" (setq r (substr s (1+ p))))
        (reverse o)
        (reverse (cons r o))
      )
    )
    ( (list s) )
  )
)