List rearrangement by rules

Question

The last of this series, an elaboration of a question from yesterday:

I'd like to go from:

startList = {"a-1","a","Z","c","d","e","f","g","Z","a","r","s","a-2",
"q","a","Z","c","d","e","f","a-2","m","Z","p","q","r"}

to:

endList = {{"a-1","a","Z","c","d"},{"a-1","g","Z","a","r"}, 
{"a-2","a","Z","c","d"},{"a-2","m","Z","p","q"}}

So, we make a sublist consisting of one element before "Z", "Z" itself, and the next two elements after each "Z". Then prefix "a-1" in front of each of these sublists, until "a-2" is encountered, at which point "a-2" is prefixed in front of each succeeding sublist, etc.

(The "a-1", "a-2", "a-3" etc. elements can be identified by StringContainsQ[element,"-"], none of the other string elements contain "-".)

Again thanks for your comments.

Answer 1

Join @@ (ReplaceList[# , {beg_, ___, a_, "Z", b_, c_, ___} :> 
  {beg, a, "Z", b, c}] & /@ Split[startList, StringFreeQ[#2, "-"] &])

{{"a-1", "a", "Z", "c", "d"}, {"a-1", "g", "Z", "a", "r"},
{"a-2", "a", "Z", "c", "d"}, {"a-2", "m", "Z", "p", "q"}}

Also:

ReplaceList[startList, {___, beg_?(Not[StringFreeQ[#, "-"]] &), 
 ___?(StringFreeQ[#, "-"] &),  a_, "Z", b_, c_, ___} :> {beg, a, "Z", b, c}]

{{"a-1", "a", "Z", "c", "d"}, {"a-1", "g", "Z", "a", "r"},
{"a-2", "a", "Z", "c", "d"}, {"a-2", "m", "Z", "p", "q"}}

Answer 2

list =
  {"a-1", "a", "Z", "c", "d", "e", "f", "g", "Z", "a", "r", "s", 
   "a-2", "q", "a", "Z", "c", "d", "e", "f", "a-2", "m", "Z", "p", 
   "q", "r"};

Using SequenceCases

Join @@ Map[
  Prepend[First @ #] /@ SequenceCases[Rest @ #, {_, "Z", _, _}] &,
  Split[list, StringLength[#2] == 1 &]]

{{"a-1", "a", "Z", "c", "d"}, {"a-1", "g", "Z", "a", "r"}, {"a-2", "a", "Z", "c", "d"}, {"a-2", "m", "Z", "p", "q"}}

Answer 3

Clear["Global`*"];
startList = {"a-1", "a", "Z", "c", "d", "e", "f", "g", "Z", "a", "r", 
   "s", "a-2", "q", "a", "Z", "c", "d", "e", "f", "a-2", "m", "Z", 
   "p", "q", "r"};

t1 = Split[startList, 
  StringFreeQ[#2, _ ~~ "-" ~~ DigitCharacter ..] &]

g = SequenceCases[#, {a : Except["Z"], b : Except["Z"], "Z", 
      c : Except["Z"], d : Except["Z"]} :> {First@#, b, "Z", c, d}] &;

g /@ t1 // Flatten[#, 1] &

---

For this particular case, partition in groups of five and do the substitutions without elaborate patterns:

f[k_List] := 
 Partition[k, 5, 1] // 
  Cases[#, h : {_, _, "Z", _, _} :> {First@k, Sequence @@ Rest@h}] &

f /@ t1 // Flatten[#, 1] &

---

Result:

{{"a-1", "a", "Z", "c", "d"}, {"a-1", "g", "Z", "a", "r"}, {"a-2", "a", "Z", "c", "d"}, {"a-2", "m", "Z", "p", "q"}}

Answer 4

startList = {"a-1", "a", "Z", "c", "d", "e", "f", "g", "Z", "a", "r", "s", "a-2", "q",
             "a", "Z", "c", "d", "e", "f", "a-2", "m", "Z", "p", "q", "r"};

endList = {{"a-1", "a", "Z", "c", "d"}, {"a-1", "g", "Z", "a", "r"}, 
           {"a-2", "a", "Z", "c", "d"}, {"a-2", "m", "Z", "p", "q"}};

My attempt using SequenceCases:

rearrangementList[l_] := Module[{sp, seqs, felems},
  sp = Split[list, ! StringEndsQ[#2, DigitCharacter] &];
  seqs = SequenceCases[#, {_, "Z", _, _}] & /@ sp;
  felems = MapThread[ConstantArray[#1, #2] &,
           {List /@ First /@ sp, Length /@ seqs}];
  Transpose /@ Thread[{felems, seqs}] /. v_?VectorQ :> Splice@v // Catenate]

rearrangementList[startList] === endList

(*True*)