10
$\begingroup$

Suppose I have the following lists:

prod = {{"x1", {"a", "b", "c", "d"}}, {"x2", {"e", "f", 
    "g"}}, {"x3", {"h", "i", "j", "k", "l"}}, {"x4", {"m", 
    "n"}}, {"x5", {"o", "p", "q", "r"}}}

and

sub = {{"m", "n"}, {"o", "p", "r", "q"}, {"g", "f", "e"}};

for each element in sub I want to go through prod and select if the element exist such that I get the following output,

 {{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q","r"}}}

I tried doing:

Table[Select[
  prod[[All, 2]][[i]], # == ContainsAny[Map[Sort, sub]][[i]] &], {i, 
  Length[sub]}]

yet it doesn't work, am I missing something?

$\endgroup$
1

7 Answers 7

14
$\begingroup$

A rule-based approach:

patt = List /@ OrderlessPatternSequence @@@ Alternatives @@ sub;
Cases[prod, {x_, y : patt} :> {x, y}]

{{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q", "r"}}}

And a functional approach:

sel = Outer[ContainsAll, Last /@ prod, sub, 1];
Pick[prod, Or @@@ sel]

{{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q", "r"}}}

A simpler one:

select[{label_, values_}] := MemberQ[sub, {OrderlessPatternSequence @@ values}]
Pick[prod, select /@ prod]

{{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q", "r"}}}

You can use the same approach with Select:

Select[prod, select]

{{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q", "r"}}}

$\endgroup$
5
$\begingroup$
sortedsub = Sort /@ sub;
Select[prod, MemberQ[sortedsub, Sort[#[[2]]]] &]

{{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q", "r"}}}

$\endgroup$
5
$\begingroup$

You can also turn prod into an Association using sorted second elements as keys and then use Lookup:

Lookup[Sort/@sub] @ GroupBy[ Sort@*Last] @ prod

{{{"x4", {"m", "n"}}}, {{"x5", {"o", "p", "q", "r"}}}, {{"x2", {"e", "f", "g"}}}}

Make it a function:

ClearAll[lookUp]

lookUp[keys_] := Lookup[Sort /@ keys] @* GroupBy[Sort@*Last]

lookUp[sub] @ prod

{{{"x4", {"m", "n"}}}, {{"x5", {"o", "p", "q", "r"}}}, {{"x2", {"e", "f", "g"}}}}

$\endgroup$
5
$\begingroup$
getMatches[prod_, sub_] := Module[{test},
  Scan[(test[Sort[#]] = True) &, sub];
  Cases[prod, {_, y_?test}]]

getMatches[prod, sub]

{{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q", "r"}}}

Also

getMatches[prod_, sub_] := Module[{test},
  Scan[(test[Sort[#]] = True) &, sub];
  Select[prod, test@*Last]]
$\endgroup$
1
$\begingroup$
p =
  {{"x1", {"a", "b", "c", "d"}}, 
   {"x2", {"e", "f", "g"}}, 
   {"x3", {"h","i", "j", "k", "l"}},
   {"x4", {"m", "n"}}, 
   {"x5", {"o", "p", "q", "r"}}};

s = {{"m", "n"}, {"o", "p", "r", "q"}, {"g", "f", "e"}};

Using ContainsAll

Pick[p, (x |-> Or @@ Map[ContainsAll[x[[2]], #]&, s]) /@ p]

{{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q", "r"}}}

$\endgroup$
1
$\begingroup$
prod = {{"x1", {"a", "b", "c", "d"}}, {"x2", {"e", "f", "g"}},
        {"x3", {"h", "i", "j", "k", "l"}}, {"x4", {"m", "n"}},
        {"x5", {"o", "p", "q", "r"}}};

sub = {{"m", "n"}, {"o", "p", "r", "q"}, {"g", "f", "e"}};

Grabbing the @C.E. pattern and using SequenceCases:

SequenceCases[prod, {s : {_, patt}} :> s]

(*{{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q", "r"}}}*)

Or using Cases and IntersectionQ:

Cases[prod, x_ /; IntersectingQ[x[[2]], Union @@ sub]]

(*{{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q", "r"}}}*)
$\endgroup$
1
$\begingroup$
prod = {{"x1", {"a", "b", "c", "d"}}, {"x2", {"e", "f", 
    "g"}}, {"x3", {"h", "i", "j", "k", "l"}}, {"x4", {"m", 
    "n"}}, {"x5", {"o", "p", "q", "r"}}};

sub = {{"m", "n"}, {"o", "p", "r", "q"}, {"g", "f", "e"}};

The idea is to create a unique signature which is the product of primes by assigning a unique prime number to each character. These signatures will match, regardless of the order of the characters in a list and uniquely so.

tagSelect[prod_List, sub_List] := Module[
  {chars = Last /@ prod // Flatten // Union,
   primes = Prime[Range@Length@chars],
   rules = Thread[chars -> primes]
   },
  p1 = Last /@ prod /. rules // Map[Apply[Times]];
  p2 = sub /. rules // Map[Apply[Times]];
  Pick[prod, MemberQ[p2, #] & /@ p1 ]
  ]

tagSelect[prod, sub]

{{"x2", {"e", "f", "g"}}, {"x4", {"m", "n"}}, {"x5", {"o", "p", "q",
"r"}}}


On the use of Contain* and set-friendly functions on the page :

The OP states that want to go through prod and select if the element exist and it is not clear if all elements exist or these exist once only.

However, change to: {"x2", {"e", "f", "g", "f"}} as an entry in prod as a test case.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.