3
$\begingroup$

Well, I have the following code:

Select[PowersRepresentations[n, a, b], 
 DuplicateFreeQ[#] && ! MemberQ[#, 0] &]

This code finds PowersRepresentations a makes a list of the solution. Then DuplicateFreeQ[#] and MemberQ[#, 0] remove the ones that contain a duplicate or a $0$.

Question: I want to add to the Select option that when a certain number shows up once in the entire list that element must be removed.


Example 1:

In[1]:=Select[PowersRepresentations[206, 3, 2], 
 DuplicateFreeQ[#] && ! MemberQ[#, 0] &]

Out[1]={{1, 3, 14}, {1, 6, 13}, {2, 9, 11}, {5, 9, 10}, {6, 7, 11}}

We can see that the numbers $2$, $3$, $5$, $7$, $10$, $13$ and $14$ turn up once. So the sets where they turn up must be removed from the list. So the code must give the following output:

{}

Example 2:

In[2]:=Select[PowersRepresentations[965, 3, 2], 
 DuplicateFreeQ[#] && ! MemberQ[#, 0] &]

Out[2]={{1, 8, 30}, {4, 7, 30}, {4, 18, 25}, {6, 20, 23}, {8, 15, 26}, {9, 
  10, 28}, {9, 20, 22}, {10, 17, 24}, {12, 14, 25}, {15, 16, 22}}

We can see that the numbers $1$, $6$, $7$, $12$, $16$, $17$, $18$, $23$, $24$, $26$ and $28$ turn up once. So the sets where they turn up must be removed from the list. So the code must give the following output:

{{9, 20, 22}}
$\endgroup$

1 Answer 1

4
$\begingroup$
ClearAll[f]
f[x_] := Select[Min[Counts[Flatten @ x] /@ #] > 1 &] @ x

Examples:

f @ Select[DuplicateFreeQ[#] && FreeQ[#, 0] &] @ PowersRepresentations[206, 3, 2]
{}
f @ Select[DuplicateFreeQ[#] && FreeQ[#, 0] &] @ PowersRepresentations[965, 3, 2]

{{9, 20, 22}}

$\endgroup$

Your Answer

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

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