Prime Puzzle with Mathematica

[amzoti]

Hi All,

trying to find an efficient way to this in Mathematica.

I found the answer - but it was a manual list manipulation - and it
was ugly!

Any suggestions?

3 Nice Primes:

Find three 2-digit prime numbers such that:

* The average of any two of the three is a prime number, and
* The average of all three is also a prime number

Thanks!

~A

[Harvey P. Dale]

Amzoti:

okQ[l_]:=Module[{l2=Subsets[l,{2}]},And@@PrimeQ[Mean[#]&/@l2]]

Select[Select[Subsets[Prime[Range[PrimePi[11],PrimePi[100]]],{3}],PrimeQ
[Mean[#]]&],okQ]

This yields: {{11,47,71}}

Best,

Harvey

[Peter Pein]

amzoti schrieb:

Do you think of sth. like

In[1]:= Select[Subsets[Prime[Range[PrimePi[10] + 1, PrimePi[99]]], {3}],
And @@ PrimeQ /@ Mean /@ Subsets[#1, {2, 3}] & ]
Out[1]= {{11, 47, 71}}

?
Look for "Function" and "Select" in the documentation.

Peter

[Andrzej Kozlowski]

On 10 Oct 2008, at 17:35, amzoti wrote:

> Hi All,
>
> trying to find an efficient way to this in Mathematica.
>
> I found the answer - but it was a manual list manipulation - and it
> was ugly!
>
> Any suggestions?
>
> 3 Nice Primes:
>
> Find three 2-digit prime numbers such that:
>
> * The average of any two of the three is a prime number, and
> * The average of all three is also a prime number
>
> Thanks!
>
> ~A
>

I assume that you do not want any repetitions in your lists of three
numbers (i.e. {11,11,11} does not count). So

ls1 = Select[Range[11, 99], PrimeQ];
ls2 = Tuples[ls1, {3}];
ls3 = DeleteCases[Union[Sort /@ ls2], {___, x_, ___, x_, ___}];

Now

AverageIsPrime = Select[ls3, PrimeQ[Mean[#]] &];

Length[AverageIsPrime]
144

The other one is shorter:

AverageOfEachPairIsPrime = Select[ls3, And @@ PrimeQ /@ Mean /@
Partition[#1, 2, 1, {1, 1}] & ]

{{11, 23, 71}, {11, 23, 83}, {11, 47, 71}, {13, 61, 73}, {17, 29, 89},
{23, 59, 83}, {29, 53, 89}}

Andrzej Kozlowski

[Jean-Marc Gulliet]

amzoti wrote:

Select[Subsets[Table[Prime[n], {n, 5, 25}], {3}],
PrimeQ[1/3
Plus @@ #] && (And @@ (PrimeQ[1/2 Plus @@@ Subsets[#, {2}]])) &]

The above expression returns the unique solution to the problem
(assuming I have correctly understood it, of course :-)

Regards,
-- Jean-Marc

[Bob Hanlon]

p = Table[Prime[i], {i, 5, 25}]

{11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97}

Select[Subsets[p, {3}],
And @@ (PrimeQ /@ (Mean /@ Drop[Subsets[#], 4])) &]

{{11, 47, 71}}

Bob Hanlon

---- amzoti <amz...@gmail.com> wrote:

=============
Hi All,

trying to find an efficient way to this in Mathematica.

I found the answer - but it was a manual list manipulation - and it
was ugly!

Any suggestions?

3 Nice Primes:

Find three 2-digit prime numbers such that:

* The average of any two of the three is a prime number, and
* The average of all three is also a prime number

Thanks!

~A

--

Bob Hanlon

[Andrzej Kozlowski]

One can get this with just one more line:

Intersection[AverageIsPrime,AverageOfEachPairIsPrime]

{{11, 47, 71}}

Best regards

Andrzej Kozlowski

On 11 Oct 2008, at 00:04, W F wrote:

> The third vector is the correct and unique answer.
>
> I think the following requirement must not be in the formulas:
>
> (The average of all three is also a prime number.)
>
> Thanks for the clean code!
>
> ~A

>
> On Fri, Oct 10, 2008 at 7:26 AM, Andrzej Kozlowski
> <ak...@mimuw.edu.pl> wrote:
>
> On 10 Oct 2008, at 17:35, amzoti wrote:
>

> Hi All,
>
> trying to find an efficient way to this in Mathematica.
>
> I found the answer - but it was a manual list manipulation - and it
> was ugly!
>
> Any suggestions?
>
> 3 Nice Primes:
>
> Find three 2-digit prime numbers such that:
>
> * The average of any two of the three is a prime number, and
> * The average of all three is also a prime number
>
> Thanks!
>
> ~A
>
>
>

[Tony Harker]

]-> -----Original Message-----
]-> From: amzoti [mailto:amz...@gmail.com]
]-> Sent: 10 October 2008 09:35
]-> To: math...@smc.vnet.net
]-> Subject: Prime Puzzle with Mathematica
]->
]-> Hi All,
]->
]-> trying to find an efficient way to this in Mathematica.
]->
]-> I found the answer - but it was a manual list manipulation
]-> - and it was ugly!
]->
]-> Any suggestions?
]->
]-> 3 Nice Primes:
]->
]-> Find three 2-digit prime numbers such that:
]->
]-> * The average of any two of the three is a prime number, and
]-> * The average of all three is also a prime number
]->
]-> Thanks!
]->
]-> ~A
]->
]->

Here's a brute force method:

Select[Union[Map[Sort, Flatten[Outer[List, #, #, #], 2]]] &[
Select[Range[10, 99], PrimeQ]], (Length[Union[#]] == 3) &&
PrimeQ[(#[[1]] + #[[2]])/2] && PrimeQ[(#[[2]] + #[[3]])/2] &&
PrimeQ[(#[[3]] + #[[1]])/2] &&
PrimeQ[(#[[1]] + #[[2]] + #[[3]])/3] &]

Tony

[Bob Hanlon]

AverageOfEachPairIsPrime should be based on AverageIsPrime rather than ls3

ls1 = Select[Range[11, 99], PrimeQ];
ls2 = Tuples[ls1, {3}];
ls3 = DeleteCases[Union[Sort /@ ls2], {___, x_, ___, x_, ___}];

AverageIsPrime = Select[ls3, PrimeQ[Mean[#]] &];

AverageOfEachPairIsPrime =
Select[AverageIsPrime,

And @@ PrimeQ /@ Mean /@ Partition[#1, 2, 1, {1, 1}] &]

{{11, 47, 71}}

Bob Hanlon

---- Andrzej Kozlowski <ak...@mimuw.edu.pl> wrote:

=============

On 10 Oct 2008, at 17:35, amzoti wrote:

> Hi All,
>

> trying to find an efficient way to this in Mathematica.
>

> I found the answer - but it was a manual list manipulation - and it
> was ugly!
>
> Any suggestions?
>
> 3 Nice Primes:
>

> Find three 2-digit prime numbers such that:
>

> * The average of any two of the three is a prime number, and

> * The average of all three is also a prime number
>

> Thanks!
>
> ~A
>

I assume that you do not want any repetitions in your lists of three
numbers (i.e. {11,11,11} does not count). So

ls1 = Select[Range[11, 99], PrimeQ];
ls2 = Tuples[ls1, {3}];
ls3 = DeleteCases[Union[Sort /@ ls2], {___, x_, ___, x_, ___}];

Now

AverageIsPrime = Select[ls3, PrimeQ[Mean[#]] &];

Length[AverageIsPrime]
144

The other one is shorter:

AverageOfEachPairIsPrime = Select[ls3, And @@ PrimeQ /@ Mean /@
Partition[#1, 2, 1, {1, 1}] & ]

{{11, 23, 71}, {11, 23, 83}, {11, 47, 71}, {13, 61, 73}, {17, 29, 89},
{23, 59, 83}, {29, 53, 89}}

Andrzej Kozlowski

--

Bob Hanlon