Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: Peculiar behaviour of Mathematica code

• To: mathgroup at smc.vnet.net
• Subject: [mg57970] Re: Peculiar behaviour of Mathematica code
• From: Maxim <ab_def at prontomail.com>
• Date: Tue, 14 Jun 2005 05:10:39 -0400 (EDT)
• Organization: MTU-Intel ISP
• References: <d8jlau$srs$1@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

On Mon, 13 Jun 2005 09:57:50 +0000 (UTC), Tony King  
<mathstutoring at ntlworld.com> wrote:

> I have some Mathematica code which I borrowed from the Divisors package.
> This code should return True if its argument is semiperfect and False if  
> it
> is not.
>
> Here is the code
>
> SemiperfectQ[n_Integer?Positive]:=Module[{d=Most[Divisors[n]]},
>
>     n==Plus@@#&/@(Or@@Rest[Subsets[d]])
>
> ]
>
> This seems to work fine if the argument is composite. However, if the  
> input
> is prime it returns {False} rather than False.
>
> Similarly the code for returning True if a number is weird behaves in the
> same way
>
> WeirdQ[n_Integer?Positive]:=DivisorSigma[1,n]>2n&&
>
>             n!=Plus@@#&/@(And@@Rest[Subsets[Most[Divisors[n]]]])
>
> Any ideas how these codes could be modified to return False (rather than
> {False}) for prime inputs
>
> Thank you
>
> Tony
>

In[1]:=
semiperfectQ[n_Integer?Positive] := Module[
   {Ld = Most@ Divisors@ n, len},
   len = Length@ Ld;
   DivisorSigma[1, n] >= 2*n &&
     NestWhile[# + 1&,
       1,
       # < 2^len &&
         Ld.IntegerDigits[#, 2, len] != n&
     ] < 2^len
]

In[2]:=
weirdQ[n_Integer?Positive] :=
   DivisorSigma[1, n] > 2*n && !semiperfectQ[n]

In[3]:= semiperfectQ[10^5 + 35] // Timing

Out[3]= {2.515*Second, True}

This way we avoid generating the list of 2^39 subsets of the proper  
divisors of 10^5 + 35. We could use NextSubset from Combinatorica package  
instead of IntegerDigits, but that would be much slower.

It is strange that NextLexicographicSubset and NextGrayCodeSubset both  
break down on certain subsets and NextGrayCodeSubset is useless for  
incrementally generating the power set:

In[1]:= <<discretemath`

In[2]:= NextLexicographicSubset[{a, b, c}, {c}]

Drop::drop: Cannot drop positions -2 through -1 in {c}.

Drop::seqs: Sequence specification (+n, -n, {+n}, {-n}, {m, n}, or {m, n,  
s}) expected at position 3 in Drop[{c}, -2, a].

Out[2]= Drop[{c}, -2, a]

In[3]:= NextGrayCodeSubset[{a, b, c}, {c}]

Part::partw: Part 4 of {a, b, c} does not exist.

Part::partw: Part 4 of {a, b, c} does not exist.

Out[3]= {c, {a, b, c}[[4]]}

Maxim Rytin
m.r at inbox.ru

• Follow-Ups:
  • Re: Re: Peculiar behaviour of Mathematica code
    • From: Andrzej Kozlowski <andrzej@akikoz.net>