# Extraction of sublists from a list

I have a list consisting of strings and numbers, from which I need to extract sublists.

lis = {k, a, b, cf, e, 1, c, d, 2, z, d, 3, f, g, z, h, a, q, r, 4, s, 5, z, j, a}


The sublists I need are defined as a sequence of four elements bracketed by "a" and "z", and with adjacent string elements joined to each other:

{a, b, cf, e, 1, c, d, 2, z}  -> {bcfe, 1, cd, 2}


So the desired result is:

res = {{bcfe, 1, cd, 2}, {qr, 4, s, 5}}


Thanks for suggestions!

Clear["Global*"];

lis = {k, a, b, cf, e, 1, c, d, 2, z, d, 3, f, g, z, h, a, q, r, 4,
s, 5, z, j, a};


Your lis does not contain any strings

Head /@ lis // Union

(* {Integer, Symbol} *)

DeleteCases[
lis //.
{s___, a, mid___, z, e___} :> {s, SplitBy[{mid}, ! IntegerQ[#] &],
e}, _?AtomQ, 1] /. {{i_Integer} :> i,
sym : {_Symbol ..} :> StringJoin[ToString /@ sym]}

(* {{"bcfe", 1, "cd", 2}, {"qr", 4, "s", 5}} *)


EDIT: If the list has strings instead of symbols,

lis = {"k", "a", "b", "cf", "e", 1, "c", "d", 2, "z", "d", 3, "f", "g", "z",
"h", "a", "q", "r", 4, "s", 5, "z", "j", "a"};

DeleteCases[
lis //. {s___, "a", mid___, "z", e___} :>
{s, SplitBy[{mid}, ! IntegerQ[#] &], e}, _?AtomQ, 1] /.
{{i_Integer} :> i,
str : {_String ..} :> StringJoin[str]}

(* {{"bcfe", 1, "cd", 2}, {"qr", 4, "s", 5}} *)

• Thanks Bob for the reply. My error. I meant strings, not symbols in lis = {"k", "a", "b", "cf", "e", 1, "c", "d", 2, "z", "d", 3, "f", "g", "z", "h", "a", "q", "r", 4, "s", 5, "z", "j", "a"}; a revision of your solution would be welcome. Commented Aug 28, 2022 at 4:19
ClearAll[reShape]
reShape[a_, z_] :=  SequenceCases[#, {a, x : Except[a | z] .., z} :>
SequenceReplace[{x}, {s__String} :> StringJoin @ s]] &


Example:

lis = {"k", "a", "b", "cf", "e", 1, "c", "d", 2, "z", "d", 3, "f",
"g", "z", "h", "a", "q", "r", 4, "s", 5, "z", "j", "a"};

reShape["a", "z"] @ lis

{{"bcfe", 1, "cd", 2}, {"qr", 4, "s", 5}}

blist = {"k", "a", "b", "cf", "e", 1, "c", "d", 2, "z", "d", 3, "f",
"g", "z", "h", "a", "q", "r", 4, "s", 5, "z", "j", "a"};


Define three polymorphic functions with Symbol, Integer, String arguments for list catenation.

Clear[f]
f[k_List /; AllTrue[k, Head[#] == Symbol &]] :=
StringJoin @@ ToString /@ k
f[k_List /; AllTrue[k, IntegerQ]] := k
f[k_List /;
AllTrue[StringJoin @@ Join @@ Characters /@ k,
MemberQ[Alphabet[]] &]] := StringJoin @@ Join @@ Characters /@ k


Using SequenceCases:

Map[Flatten, #, {-3}] &@
Map[f, #, {-2}] &@
SplitBy[#, IntegerQ] & /@
SequenceCases[blist
, {"a", k : Except["z"] .., "z"} :> {k}]


{{"bcfe", 1, "cd", 2}, {"qr", 4, "s", 5}}

lis = {"k", "a", "b", "cf", "e", 1, "c", "d",
2, "z", "d", 3, "f", "g", "z", "h", "a",
"q", "r", 4, "s", 5, "z", "j", "a"};

{ap, zp} = Flatten[Position[lis, #]] & /@ {"a", "z"}

sel = DeleteDuplicatesBy[DeleteCases[Function[av, {av + 1,
SelectFirst[zp, # > av &, 0] - 1}] /@ ap, {_, -1}], Last];

Map[Take[lis, #] &, sel] //.
{h___, i_String, j_String, k___} :> {h, i <> j, k}


{{"bcfe", 1, "cd", 2}, {"qr", 4, "s", 5}}

list = {k, a, b, cf, e, 1, c, d, 2, z, d, 3, f, g, z, h, a, q, r, 4, s, 5, z, j, a};

res = {{bcfe, 1, cd, 2}, {qr, 4, s, 5}};


Using SequenceReplace, SequenceCases and LetterQ

ToExpression /@ SequenceReplace[#, {s__?LetterQ} :> StringJoin[s]] & /@
SequenceCases[list, {a, p : Except[z] .., z} :> (ToString /@ {p})]


{{bcfe, 1, cd, 2}, {qr, 4, s, 5}}

% == res


True

lis = {k, a, b, cf, e, 1, c, d, 2, z, d, 3, f, g, z, h, a, q, r, 4, s, 5, z, j, a};


Grabbing the @eldo's pattern and using SequenceSplit:

 With[{l = ToString /@ lis, patt = {"a", Except["z"] .., "z"}},
ss = Select[SequenceSplit[l, s : patt :> s], #[[1]] === "a" &];
seqs = ss[[All, 2 ;; -2]] /. x_?VectorQ :> SplitBy[x, LetterQ];
Map[ToExpression@*StringJoin, seqs, {2}]]


Result:

{{bcfe, 1, cd, 2}, {qr, 4, s, 5}}

Using SequencePosition on string list

SequenceReplace[#, {a__String} :>
StringJoin[a]] & /@ (Take[
lis, #] & /@ (SequencePosition[
lis, {"a", ii : Except["z"] .., "z"}] + Threaded[{1, -1}]))


Result

{{"bcfe", 1, "cd", 2}, {"qr", 4, "s", 5}}
`