Re: Help with While Loop Function
- To: mathgroup at smc.vnet.net
- Subject: [mg115991] Re: Help with While Loop Function
- From: Daniel Lichtblau <danl at wolfram.com>
- Date: Fri, 28 Jan 2011 06:15:41 -0500 (EST)
----- Original Message -----
> From: "Peter Pein" <petsie at dordos.net>
> To: mathgroup at smc.vnet.net
> Sent: Thursday, January 27, 2011 2:42:01 AM
> Subject: [mg115960] Re: Help with While Loop Function
> On 26.01.2011 11:04, KenR wrote:
> > Please Help me to Get the following to work as desired
> > t is the triangular number. I increment it repeated ly by adding the
> > counter x to it. When t*((y^2+1)/2)^2 + y^2 is a perfect square i
> > want
> > to append t to my list of trangular numbers with the list starting
> > with {0,1}, and exit the loop when 3 more triangular numbers have
> > been
> > added or when t>= 1000000000000. It is not working for me. I am new
> > to Mathematica. Thanks
> >
> > Clearall[x,y,t,w]
> > x = 2
> > y = 3
> > t = 1
> > w = 0
> > List1 = {0,1}
> > f[t_,y_] ==(Floor(Sqrt ((t/4) (y^2-1)^2 + y^2)))^2 - ((t/4)
> > (y^2-1)^2
> > + y^2)
> f[t_,y_] = Floor[Sqrt[(t/4) (y^2-1)^2 + y^2]]^2 - ((t/4) (y^2-1)^2 +
> y^2)
> > While[t<1000000000000,t = t+x;If[f[t,y] = 0, List1 =
> > Append[list1,t];w
> > = w +1];
> ... , AppendTo[List1,t]; w++ ...
> > If [w = 3,t = 1000000000000, x++]];
> .. w== 3 ..
> > List1
> >
>
> If I didn't miss anything, you want the Sophie Germain triangular
> numbers (http://oeis.org/A124174). This is a problem for which Reduce
> has been made:
>
> In[1]:= t /. {ToRules@
> Reduce[t == n (n + 1)/2 && 2 t + 1 == m (m + 1)/2 &&
> Element[{m, n, t}, Integers] && 0 <= t <= 10^12 && 0 <= n &&
> 0 <= m, t, Backsubstitution -> True]}
>
> Out[1]= {0, 1, 10, 45, 351, 1540, 11935, 52326, 405450, 1777555,
> 13773376, 60384555, 467889345, 2051297326, 15894464365, 69683724540,
> 539943899076}
>
> In[2]:= SophieGermain[n_] = Collect[FindSequenceFunction[%, n] //
> RootReduce, _^n, Simplify]
>
> Out[2]= -(11/32) + 1/64 (-3 - 2 Sqrt[2])^n (1 - Sqrt[2]) +
> 5/64 (3 - 2 Sqrt[2])^n (2 + Sqrt[2]) +
> 1/64 (1 + Sqrt[2]) (-3 + 2 Sqrt[2])^n -
> 5/64 (-2 + Sqrt[2]) (3 + 2 Sqrt[2])^n
>
> hth,
> Peter
I thought it would be faster to do a direct computation. Silly of me. First attempt failed miserably. Using Compile with Listable attribute succeeded.
pred = Compile[{{m, _Real}},
Module[{n = Floor[Sqrt[2.]*m] + 1.},
n^2 + n == 2.*m^2 + 2.*m + 2.], RuntimeAttributes -> Listable,
RuntimeOptions -> "Speed"];
In[62]:= Timing[
With[{rng = Range[0, 10^7]},
Map[(#^2 + #)/2 &, Pick[rng, pred[rng]]]]]
Out[62]= {1.656, {0, 1, 10, 45, 351, 1540, 11935, 52326, 405450,
1777555, 13773376, 60384555, 467889345, 2051297326, 15894464365,
69683724540, 539943899076, 2367195337045, 18342198104230}}
Without that attribute I can get a Select variant to work fast, but not hugely faster than Reduce. I regard this experiment as a victory for Reduce. If only because I had several hours to think about it, whereas Reduce did both the thinking and computing in seconds. Also my method will fizzle around 10^8, when machine precision becomes no longer sufficient for the task.
Daniel Lichtblau
Wolfram Research