Selective thinning of string elements in nested lists

Question

I have a nested list similar to this example list (but much bigger and more messy):

str = {{{"a a-a", "a a-b", "a a-c", "a a-d"}, 
        {"a b-a", "a b-b", "a b-c", "a b-d"}}, 
       {{"b a-a", "b a-b", "b a-c", "b a-d"}, 
        {"b b-a", "b b-b", "b b-c", "b b-d"}}};

I am trying to selectively to remove most of the entries whilst keeping the "...-c" entries within the nested structure so that I end up with something like this:

cstr = {{{"a a-c"}, {"a b-c"}}, {{"b b-c"}, {"b b-c"}}};

or at least this:

cstrflat = {{"a a-c", "a b-c"}, {"b b-c", "b b-c"}};

I can find the positions of the desired entries with:

Position[Map[StringMatchQ[#, ___ ~~ "-c"] &, str, {3}], True]

{{1, 1, 3}, {1, 2, 3}, {2, 1, 3}, {2, 2, 3}}

or use Cases to get a flattened list with:

Cases[str, _?(StringMatchQ[#, ___ ~~ "-c"] &), {3}]

{"a a-c", "a b-c", "b a-c", "b b-c"}

but, I can't work out how to thin-out the existing nested list structure. I think it might be possible with Select but my attempts so far haven't worked.

Any suggestions? Are there other ways to do this sort of thing?

Answer 1

You were almost there; you had the criterion right, but all you needed was DeleteCases[]:

DeleteCases[str, s_String /; ! StringMatchQ[s, ___ ~~ "-c"], ∞]
   {{{"a a-c"}, {"a b-c"}}, {{"b a-c"}, {"b b-c"}}}

Answer 2

You can do this with an iterative expression:

takeel[arr_]:=If[Head[arr[[1]]] === List, takeel[#] & /@ arr, Select[arr, StringMatchQ[#, ___ ~~ "-c"] &]]

and then calculate:

takeel[str]

This should give you:

{{{"a a-c"}, {"a b-c"}}, {{"b a-c"}, {"b b-c"}}}

In the comments I was asked to clarify on how the structure takeel[#] & /@ arr works. This is indeed a self-referential function but this is often what is needed when you have a structure and don't know from the outset how deep you will have to go until you can perform your test on some set of elements.

What is happening is that we are asking whether the first element that we are passing in is a list or not. If the first element is not a list then what we have must be a string and we can perform the StringMatchQ on it. If it is a list then we pass the elements of the list one by one back into the function until we have driven down to things which again are not lists.

In fact the way it is written at the moment will not work if we have something like:

{"a a-c", {{"a a-a", "a a-b", "a a-c", "a a-d"}}}

but for the cases you seem to be describing, it should be sufficient.

If the question was about the syntax of function[#]&/@somelist then this is a functional way of passing the elements of a list one by one into the # slot of a function.

Answer 3

I would probably use DeleteCases or Pick:

Pick[str, str, s_String /; StringMatchQ[s, ___ ~~ "-c"]]

{{{"a a-c"}, {"a b-c"}}, {{"b a-c"}, {"b b-c"}}}

Pick appears to be somewhat faster:

big = ConstantArray[str, {40, 40, 40}];

DeleteCases[big, s_String /; ! StringMatchQ[s, ___ ~~ "-c"], ∞] // Timing // First

Pick[big, big, s_String /; StringMatchQ[s, ___ ~~ "-c"]] // Timing // First

1.42

1.17

---

Exploring other approaches one could write Jonathan's method, without Select, like this:

f[s_String /; StringMatchQ[s, ___ ~~ "-c"]] := s
f[x_List] := f /@ x
f[_] := Sequence[]

f @ str

{{{"a a-c"}, {"a b-c"}}, {{"b a-c"}, {"b b-c"}}}

Or this:

SetAttributes[g, Listable]
g[s_String /; StringMatchQ[s, ___ ~~ "-c"]] := s
g[_] := Sequence[]

g @ str

Or this:

h = Function[, If[Quiet@StringMatchQ[#, ___ ~~ "-c"], #, ## &[]], Listable];
h @ str

Answer 4

Using StringEndsQ: (introduced March 30, 2015)

DeleteCases[str, _String?(Not@StringEndsQ[#, "-c"] &), {-1}]

or

Pick[str, Map[StringEndsQ[#, "-c"] &, str, {-1}]]

---

Result:

{{{"a a-c"}, {"a b-c"}}, {{"b a-c"}, {"b b-c"}}}

Answer 5

Here is another option:

str/.x_String/;StringFreeQ[x,RegularExpression[".*-c"]]-> Sequence[]

If you specify the level it will have a better performance:

Replace[str,x_String/;StringFreeQ[x,RegularExpression[".*-c"]]-> Sequence[],-1]

Answer 6

I like J.M's answer, but here is another way of approaching it. Find the position in the strings where all the "c"'s are, find the indices,

pos = StringPosition[Flatten[str], "c"]
ind = Flatten[Position[Length /@ pos, 1]]

and then extract from the list:

Flatten[str][[ind]]
{"a a-c", "a b-c", "b a-c", "b b-c"}

Answer 7

Using your line while negating the predicate:

pos = Position[Map[! StringMatchQ[#, ___ ~~ "-c"] &, str, {-1}], True];

(This achieves the same.)

pos = Position[str, s_String /; ! StringMatchQ[s, ___ ~~ "-c"]];

And deleting elements at those positions:

Delete[str, pos]

{{{"a a-c"}, {"a b-c"}}, {{"b a-c"}, {"b b-c"}}}

I just read this in a book this morning I'm reading (got it right here off this site), it tells that Position and Delete work well as a team. In place of Delete also MapAt, Extract, Insert, ReplacePart among some others I guess (which, anybody?). Great read that book by the way, considering it's some 15 years old, which also proves how coherent Mma stayed over the years and versions I guess.

Answer 8

In this particular case we can also use StringContainsQ which came with V 10.1

str =
  {{{"a a-a", "a a-b", "a a-c", "a a-d"},
    {"a b-a", "a b-b", "a b-c", "a b-d"}},
   {{"b a-a", "b a-b", "b a-c", "b a-d"},
    {"b b-a", "b b-b", "b b-c", "b b-d"}}};
Map[Select[#, StringContainsQ["c"]] &, str, {2}]

{{{"a a-c"}, {"a b-c"}}, {{"b a-c"}, {"b b-c"}}}