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

```

• Prev by Date: Re: Exporting mathematica equations into MathType
• Next by Date: Re: make a set of conditions without the parameters
• Previous by thread: Re: Peculiar behaviour of Mathematica code
• Next by thread: Re: Re: Peculiar behaviour of Mathematica code