How do you delete sublists of a desired permutation?

Question

I have a list given as:

d = {{{A1,A2,T3}, {A4,T1,A2}, {T5,A1,A3}}, {{T1,T2,T3}, {A5,A1,A2},{A1,A2,T3}}}

I'm trying to delete sublists of the type:

{A,A,A},{A,T,T},{T,T,T}

that way I'm left with sublists consisting of only:

{A,A,T},{T,A,A},{A,T,A}

I'm also trying to keep the numbers in list "d" so my desired outcome would look something like:

dd={{{A1,A2,T3},{A4,T1,A2}, {T5,A1,A3}},{{A1,A2,T3}}}

I have tried the following:

DeleteCases[d,{A,A,A}|{T,T,T}|{A,T,T},{2}] but nothing seems to change. I think there's an issue with my patterns in DeleteCases where I need to include additional information to exclude the numbers in list "d" and just delete the sublists based upon the criteria of the arrangement of the A's and T's.

Edit: Originally this question was posted with list "d" as a list of symbol, when it should have in fact been a list of strings. I have since rectified that issue by keeping the original question and adding my intended question below, that way answers already provided could be insight for people looking for the same thing.

I have a list given as:

d = {{{"A1","A2","T3"}, {"A4","T1","A2"}, {"T5","A1","A3"}}, {{"T1","T2","T3"}, {"A5","A1","A2"},{"A1","A2","T3"}}}

I'm trying to delete sublists of the type:

{"A","A","A"},{"A","T","T"},{"T","T","T"}

that way I'm left with sublists consisting of only:

{"A","A","T"},{"T","A","A"},{"A","T","A"}

I'm also trying to keep the numbers in list "d" so my desired outcome would look something like:

dd={{{"A1","A2","T3"},{"A4","T1","A2"}, {"T5","A1","A3"}},{{"A1","A2","T3"}}}

I have tried the following:

DeleteCases[d,{A,A,A}|{T,T,T}|{A,T,T},{2}] but nothing seems to change. I think there's an issue with my patterns in DeleteCases where I need to include additional information to exclude the numbers in list "d" and just delete the sublists based upon the criteria of the arrangement of the A's and T's.

Answer 1

undesirable = {{A, A, A}, {A, T, T}, {T, T, T}};
DeleteCases[d,
 {x_, y_, z_} /; 
   MemberQ[undesirable, 
    Symbol@StringTake[SymbolName[#], 1] & /@ {x, y, z}
   ],
 {2}
]

(* Out: {{{A1, A2, T3}, {A4, T1, A2}, {T5, A1, A3}}, {{A1, A2, T3}}} *)

---

If you think that you are going to do a lot of this kind of processing, I'd recommend that you consider switching to indexed variables instead, i.e. something like {{{a[1], a[2], t[3]}, .... It would make the pattern matching much easier.

Here is a function that generates a set of rules to change your expressions into this new format:

varChangeRules =
  Function[{list},
   Symbol[#1 ~~ #2] -> Symbol[ToLowerCase@#1][ToExpression@#2] & @@@ 
    Characters@*SymbolName /@ Variables[list]
  ];

newd = d /. varChange[d]

(* Out: {{{a[1], a[2], t[3]}, {a[4], t[1], a[2]}, {t[5], a[1], a[3]}}, 
         {{t[1], t[2], t[3]}, {a[5], a[1], a[2]}, {a[1], a[2], t[3]}}} *)

The elimination of your unwanted sequences is then easier:

DeleteCases[
  newd, 
  {Repeated[_a, 3]} | {Repeated[_t, 3]} | {_a, _t, _t}, 
  All
]

(* Out: {{{a[1], a[2], t[3]}, {a[4], t[1], a[2]}, {t[5], a[1], a[3]}}, 
         {{a[1], a[2], t[3]}}} *)

Answer 2

delQ = MatchQ[{A, A, A} | {A, T, T} | {T, T, T}] @*
    Map[Symbol @* First @* Characters @* ToString];

DeleteCases[d, _?delQ, {2}]

 {{{A1, A2, T3}, {A4, T1, A2}, {T5, A1, A3}}, {{A1, A2, T3}}}

delQ2 = StringMatchQ["AAA" | "ATT" | "TTT"] @* 
   StringJoin @* Map[StringTake[#, 1] & @* SymbolName];

DeleteCases[d, _?delQ2, {2}]

 {{{A1, A2, T3}, {A4, T1, A2}, {T5, A1, A3}}, {{A1, A2, T3}}}

Update: If the the input list is a nested list of strings as in

d2 = Map[ToString, d, {-1}]

 {{{"A1", "A2", "T3"}, {"A4", "T1", "A2"}, {"T5", "A1", "A3"}},
 {{"T1", "T2", "T3"}, {"A5", "A1", "A2"}, {"A1", "A2", "T3"}}}

you can use

sdelQ = StringMatchQ["AAA"|"ATT"|"TTT"] @* StringJoin @* Map[StringTake[#, 1] &];

DeleteCases[d2, _?sdelQ, {2}]

 {{{"A1", "A2", "T3"}, {"A4", "T1", "A2"}, {"T5", "A1", "A3"}},
  {{"A1", "A2", "T3"}}}