How do you apply "Pick" to multiple sublists?

Question

I have the following list:

lis1={{{A3,T3},{A3,T4}},{{A3,T3}},{{A3,T3},{A4,T4},{A3,T1}}}

Which is also accompanied by an Association of:

 assoc = <|A1 -> 10, A2 -> 2, A3 -> 10, A4 -> 10, T1 -> 10, T2 -> 11, 
  T3 -> 10, T4 -> 14|>

If I then do ReplaceAll[lis1,assoc], I get a new list:

lis2={{{10, 10}, {10, 14}}, {{10, 10}}, {{10, 10}, {10, 14}, {10, 10}}}

What I would like to do is use the Pick function and pull out the sublists in lis1 only if their numerical values given by the association are the same. That would yield me the desired list of:

lisfinal={{{A3,T3}},{{A3,T3}},{{A3,T3},{A3,T1}}}

To perform this without any sublists you can use Pick[lis1,Equal@@@(lis1/.assoc)], but I'm having trouble using that same function with multiple sublists present. I've tried both Map and Apply, but I don't think I'm getting the syntax correct.

Edit: I have changed the association values to reflect my question

Answer 1

Try

Pick[lis1, Apply[Equal, lis1 /. assoc, {2}]]

Answer 2

An alternative to Pick, if I understand your parameters:

GatherBy[#, Map[assoc]][[1]] & /@ lis1

{{{A3, T3}}, {{A3, T3}}, {{A3, T3}, {A3, T1}}}

Answer 3

Delete[lis1,Position[lis2, {x_Integer,y_}/;x!=y]]

{{{A3, T3}}, {{A3, T3}}, {{A3, T3}, {A3, T1}}}

Or, independent of lis2

lis1//Delete[#,Position[#/.assoc, {x_Integer,y_}/;x!=y]]&

Answer 4

list = 
 {{{A3, T3}, {A3, T4}}, {{A3, T3}}, {{A3, T3}, {A4, T4}, {A3, T1}}};

asoc = 
 <|A1 -> 10, A2 -> 2, A3 -> 10, A4 -> 10, T1 -> 10, T2 -> 11, T3 -> 10, T4 -> 14|>;

via Position

p = Position[list /. asoc, {x_, y_} /; x != y, {2}]

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

Using ReplaceAt (new in 13.1)

ReplaceAt[_ :> Nothing, p] @ list

{{{A3, T3}}, {{A3, T3}}, {{A3, T3}, {A3, T1}}}

Answer 5

lis1 = {{{A3, T3}, {A3, T4}}, {{A3, T3}}, {{A3, T3}, {A4, T4}, {A3, T1}}};

assoc = <|A1 -> 10, A2 -> 2, A3 -> 10, A4 -> 10, T1 -> 10, T2 -> 11, T3 -> 10, T4 -> 14|>;

---

Using MapAt:

p = Position[lis1 /. assoc, x : {__} /; DuplicateFreeQ[x], {2}]

MapAt[Nothing &, lis1, p]

(*{{{A3, T3}}, {{A3, T3}}, {{A3, T3}, {A3, T1}}}*)

Or using SubsetMap and ReplaceAll:

ReplaceAll[SubsetMap[# - # &, lis1, p], x : {0 ..} :> Nothing]

(*{{{A3, T3}}, {{A3, T3}}, {{A3, T3}, {A3, T1}}}*)

Or using Extract and DeleteCases:

DeleteCases[#, Alternatives @@ Extract[#, p], {2}] &@lis1

(*{{{A3, T3}}, {{A3, T3}}, {{A3, T3}, {A3, T1}}}*)