Topic: How to get the same characters from a list of strings

[fools]

As follows, if the same characters exists in a list of strings, returns it, if not, returns empty.
I can't think of a good way to solve it. Thanks for help.

Code: [Select]

(setq str1 '("123abc-de23f" "1abc-f123" "23abc" "23abcd23" "abc31de23"))
(setq str2 '("123abc-de23f" "1abc-f123" "32acd" "23abcd23" "abc31de23"))

(fun str1) ---> ("abc" "23")
(fun str2) ---> nil



[VovKa]

Code: [Select]

(fun str2) ---> nil


why not (fun str2) ---> ("a" "c" "2" "3") ?

[Lee Mac]

Quickly written, not pretty:

Code - Auto/Visual Lisp: [Select]

1. (defun foo ( l / i j n r s x )
2.     (setq x (car l)
3.           l (cdr l)
4.           n (strlen x)
5.           i 1
6.     )
7.     (while (<= i n)
8.         (setq j 1)
9.         (while
10.             (and
11.                 (<= j (- n i -1))
12.                 (setq s (strcat "*" (substr x i j) "*"))
13.                 (vl-every '(lambda ( y ) (wcmatch y s)) l)
14.             )
15.             (setq j (1+ j))
16.         )
17.         (if (< 1 j)
18.             (progn
19.                 (setq j (1- j)
20.                       s (substr x i j)
21.                 )
22.                 (if (not (member s r))
23.                     (setq r (cons (substr x i j) r))
24.                 )
25.             )
26.         )
27.         (setq i (+ i j))
28.     )
29.     (reverse r)
30. )

Code - Auto/Visual Lisp: [Select]

1. _$ (foo str1)
2. ("23" "abc")
3. _$ (foo str2)
4. ("2" "3" "a" "c")

[MP]

Quick and dirty:

Code: [Select]

(defun foo ( strlist / moo tmp ptn result )

    (defun moo ( s / i r )
        (while (< 0 (strlen s))
            (repeat (setq i (strlen s))
                (setq r (cons (substr s 1 i) r) i (1- i))
            )
            (setq s (substr s 2))   
        )
        (reverse r)
    )
   
    (foreach a (setq tmp (mapcar 'moo strlist))
        (foreach i a
            (and
                (vl-every
                    (function (lambda (b) (member i b)))
                    (vl-remove a tmp)
                )
                (null (member i result))
                (setq result (cons i result))
            )           
        )             
    )
   
    (foreach i (vl-sort result (function (lambda (a b) (< (strlen a) (strlen b)))))
        (and
            (setq ptn (strcat "?" i "," i "?"))
            (vl-some
                (function (lambda (s) (wcmatch s ptn)))
                (setq tmp (vl-remove i result))
            )
            (setq result tmp)
        )
    )
   
    (vl-sort result '<)
   
)
(foo str1) >> ("23" "abc")

(foo str2) >> ("2" "3" "a" "c")

[ronjonp]

Another

Code - Auto/Visual Lisp: [Select]

1. (defun foo (l / _every a b c i n out)
2.   (defun _every (s l)
3.     (if (vl-every (function (lambda (x) (wcmatch x (strcat "*" s "*")))) l)
4.       s
5.     )
6.   )
7.   (setq l (mapcar (function (lambda (x) (cons (strlen x) x))) l))
8.   (setq a (car (setq l (mapcar 'cdr (vl-sort l '(lambda (a b) (< (car a) (car b))))))))
9.   (setq i 0)
10.   (repeat (strlen a)
11.     (setq i (1+ i))
12.     (setq n 0)
13.     (setq c nil)
14.     (while
15.       (and (<= (setq n (1+ n)) (strlen a))
16.            (setq b (_every (substr a i n) l))
17.            (not (and (= 1 (strlen b)) (vl-some '(lambda (x) (wcmatch x (strcat "*" b "*"))) out)))
18.            (setq c b)
19.       )
20.     )
21.     (and c (setq out (cons c out)))
22.   )
23.   (acad_strlsort out)
24. )
25. (foo '("123abc-de23f" "1abc-f123" "23abc" "23abcd23" "abc31de23"))
26. (foo '("123abc-de23f" "1abc-f123" "32acd" "23abcd23" "abc31de23"))
27. ;;;_$
28. ;;;
29. ;;;FOO
30. ;;;("23" "abc")
31. ;;;("2" "3" "a" "c")
32. ;;;_$

[Lee Mac]

Another:

Code - Auto/Visual Lisp: [Select]

1. (defun foo ( l )
2.     (baz (bar 1 (car l) (cdr l)))
3. )
4. (defun bar ( n x l )
5.     (cond
6.         (   (< (strlen x) n) nil)
7.         (   (vl-every '(lambda ( y ) (wcmatch y (strcat "*" (substr x 1 n) "*"))) l)
8.             (bar (1+ n) x l)
9.         )
10.         (   (< 1 n)
11.             (cons (substr x 1 (1- n)) (bar 1 (substr x 2) l))
12.         )
13.         (   (bar 1 (substr x 2) l))
14.     )
15. )
16. (defun baz ( l )
17.     (if l (cons (car l) (baz (vl-remove-if '(lambda ( x ) (vl-string-search x (car l))) (cdr l)))))
18. )

[VovKa]

hello guys 
(foo (list "cbc" "abc"))
(foo (list "babac" "ababc"))
what should they return?

[MP]

Mine returns what I imagine it should:

(foo (list "cbc" "abc"))     >> ("bc")
(foo (list "babac" "ababc")) >> ("aba" "bab" "c")

In your mind should it return something else?

Thanks & cheers.

[VovKa]

In your mind should it return something else?

there's nothing on my mind
i just see that functions presented here return different results for the same argument

[fools]

Thanks everybody for kind help.
For me, I got a lot of learning materials at once.

It's my mistake. I didn't make the question clear. In my actual case, scattered single identical characters will be ignored in order to prevent judgment errors.
Even without distinguishing individual characters, all of the above methods are still very helpful to me.

Theswamp is so wonderful.

[MP]

Glad to hear you're learning.

This variant eschews individual chars (changes commented).

Code: [Select]

(defun foo ( strlist / moo tmp ptn result )

    (defun moo ( s / i r )
        (while (< 1 (strlen s)) ;; was (< 0 (strlen s))
            (repeat (setq i (strlen s))
                (if (< 1 i) (setq r (cons (substr s 1 i) r) i (1- i)))
                ;; was (setq r (cons (substr s 1 i) r) i (1- i))
            )
            (setq s (substr s 2))   
        )
        (reverse r)
    )
   
    (foreach a (setq tmp (mapcar 'moo strlist))
        (foreach i a
            (and
                (vl-every
                    (function (lambda (b) (member i b)))
                    (vl-remove a tmp)
                )
                (null (member i result))
                (setq result (cons i result))
            )           
        )             
    )
   
    (foreach i (vl-sort result (function (lambda (a b) (< (strlen a) (strlen b)))))
        (and
            (setq ptn (strcat "?" i "," i "?"))
            (vl-some
                (function (lambda (s) (wcmatch s ptn)))
                (setq tmp (vl-remove i result))
            )
            (setq result tmp)
        )
    )
   
    (vl-sort result '<)
   
)

Code: [Select]

(foreach lst

   '(
        ("123abc-de23f" "1abc-f123" "23abc" "23abcd23" "abc31de23")
        ("123abc-de23f" "1abc-f123" "32acd" "23abcd23" "abc31de23")
        ("cbc" "abc")
        ("babac" "ababc")
    )
   
    (princ
        (strcat "\n"
            (vl-prin1-to-string lst)
            " >> "
            (vl-prin1-to-string (foo lst))
        )
    )
   
    (princ)               
   
)
("123abc-de23f" "1abc-f123" "23abc" "23abcd23" "abc31de23") >> ("23" "abc")
("123abc-de23f" "1abc-f123" "32acd" "23abcd23" "abc31de23") >> nil
("cbc" "abc")                                               >> ("bc")
("babac" "ababc")                                           >> ("aba" "bab")

Cheers.

[fools]

Glad to hear you're learning.

This variant eschews individual chars (changes commented).

Thanks again, MP.
I learned a lot from the programs above , trying to rewrite some of the content.

Code - Auto/Visual Lisp: [Select]

1. ;;https://www.theswamp.org/index.php?topic=53660.0
2. ;;Based on Lee Mac, ronjonp, MP's code
3. ;;(GetSameTxtFromLst '("123abc-de23f" "1abc-f123" "231abcf" "23abcd23f" "abc31de23f") 1) -->("23" "abc" "f")
4. ;;(GetSameTxtFromLst '("123abc-de23f" "1abc-f123" "231abcf" "23abcd23f" "abc31de23f") 2) -->("23" "abc")
5. ;;(GetSameTxtFromLst '("123abc-de23f" "1abc-f123" "231abcf" "23abcd23f" "abc31de23f") 3) -->("abc")
6. ;;(GetSameTxtFromLst '("123abc-de23f" "1abc-f123" "231abcf" "23abcd23f" "abc31de23f") 4) -->nil
7. (defun GetSameTxtFromLst (lst num / I J MINLEN MINLENSTR R S STR TMP)
8.   (setq MinLenStr ((lambda (a b) (assoc (apply 'min a) (mapcar 'list a b))) (mapcar 'strlen lst) lst))
9.   (setq minlen (car MinLenStr)
10.         str    (cadr MinLenStr)
11.         i      1
12.   )
13.   (and (or (zerop num) (minusp num)) (setq num 1))
14.   (while (<= i minlen)
15.     (setq j num)
16.     (while (and (<= j (- minlen i -1))
17.                 (setq tmp (substr str i j))
18.                 (vl-every (function (lambda (y) (wcmatch y (strcat "*" tmp "*")))) lst)
19.            )
20.       (setq j (1+ j)
21.             s tmp
22.       )
23.     )
24.     (if (< num j)
25.       (progn (setq i (+ i j -1))
26.              (if (not (member s r))
27.                (setq r (cons s r))
28.              )
29.       )
30.       (setq i (1+ i))
31.     )
32.   )
33.   (reverse r)
34. )