MathGroup Archive 2008

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Prime Puzzle with Mathematica

  • To: mathgroup at smc.vnet.net
  • Subject: [mg92707] Re: [mg92680] Prime Puzzle with Mathematica
  • From: Andrzej Kozlowski <akoz at mimuw.edu.pl>
  • Date: Sat, 11 Oct 2008 06:43:04 -0400 (EDT)
  • References: <200810100835.EAA07106@smc.vnet.net>

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





  • Prev by Date: Re: Re: Color coding a Table entry
  • Next by Date: Re: I can plot a function but when I try FindRoot it complains
  • Previous by thread: RE: Prime Puzzle with Mathematica
  • Next by thread: Re: Prime Puzzle with Mathematica