Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2001
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2001

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

Search the Archive

Can this be made cleaner and more efficient?

  • To: mathgroup at smc.vnet.net
  • Subject: [mg29807] Can this be made cleaner and more efficient?
  • From: Flip at safebunch.com
  • Date: Wed, 11 Jul 2001 01:26:56 -0400 (EDT)
  • Sender: owner-wri-mathgroup at wolfram.com

Hi All,

finally I got this algorithm working, but it is "ugly" and "slow" code.

Can an experienced Mathematica user help clean this up and make it more efficient.

By the way, this is an implementation of the Lucas Primality Test.

Notes:
1. Is it possible to move the sequence inside of the module and calculate it one
step at time? (it usually converges on the 2nd or 3rd try in finding D).
2. A check should be done on "n" and verify it is not a perfect odd sqaure
(i.e., n = 9 or n = 25, for example, will cause no solution for finding D and
this should really be checked).  If n is a perfect square, terminate the test.
3. If one encounters a JacobiSymbol = 0 while searching for a d with
JacobiSymbol = -1, terminate the test as this means that n has factors (i.e., it
is composite).

Can someone here help?  Thank you for any inputs ... Wilson

*** Here is the code ***

In[206]:=
Clear[a]

In[207]:=
a[1] =5;

In[208]:=
a[n_]:= a[n] = (-1)^(n+1) (Abs[a[n-1]]+2)

In[209]:=
(*find the first D in a[n] for which JS[a,n] = -1 *)

In[210]:=
findD[a_,b_]:=Module[{n=a, lst=b},
i=1;
While[JacobiSymbol[lst[[i]],n]
!= -1, i++];lst[[i]]]

In[211]:=
lpt1[a_,b_,c_]:=Module[{d=a, p=b, n=c},
Clear[u,v,k,w,r];
k = n+1;w = Reverse[IntegerDigits[k,2]];
r = Length[w]-2;q = (1-d)/4;
Print["n, k, r, d, q = ",{n,k,r,d,q}];
Print["w = ", w];t= 2n;
u = 1;v = p;
Print["u, v = ", {u,v}];
While[r > -1 ,
x = Mod[u*v, t];
y = Mod[(v^2+ d*u^2)/2, t];
{u,v}={x,y};
Print["u, v = ", {u,v}]; Print["r = ",r];
Print["Kr = ",w[[r+1]]];
If[w[[r+1]]==1,
u = Mod[(p*x+y)/2, t];
v = Mod[(p*y+ d*x)/2, t]];
(*Print["u, v = ", {u,v}]*);{u,v}={u,v};
r=r-1];
Print["u, v = ", {u,v}];
Print["For n = ",n];
If[Mod[u,n]==0, Print["LPT says Prime"],Print["LPT says Not Prime"]]]

In[212]:=
c=Table[a[n],{n,1,100}];

In[213]:=
p=1;

In[214]:=
n=5;

In[215]:=
d = findD[n,c]

Out[215]=
-7

In[216]:=
lpt1[d,p,n]



  • Prev by Date: RE: Can Anyone Help With This?
  • Next by Date: Re: Exponential Equations
  • Previous by thread: Re: same plot for continous and discrete function
  • Next by thread: Re: Exponential Equations