MathGroup Archive 2007

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

Search the Archive

Re: Working with factors of triangular numbers.

  • To: mathgroup at smc.vnet.net
  • Subject: [mg78606] Re: Working with factors of triangular numbers.
  • From: "Jean-Marc Gulliet" <jeanmarc.gulliet at gmail.com>
  • Date: Thu, 5 Jul 2007 04:05:02 -0400 (EDT)
  • References: <f6d4ll$hka$1@smc.vnet.net> <468AC019.1040906@gmail.com>

On 7/4/07, Diana Mecum <diana.mecum at gmail.com> wrote:
> Jean-Marc,
>
> It is great that you can calculate more values.
>
> You show the fourth term as 561. It is actually 253 ?
>
> Thanks for your time.
>
> Diana

Oops! Sorry, my mistake: I had left a too optimistic test in the code
before posting it. Here is the fixed version. Also, I have added a
message in case the function does not find any match within the
specified range of indices for the triangular numbers.

In[1]:= T[n_Integer /; n > 0] := Binomial[n + 1, 2]
seek[m_Integer /; m > 0, min_Integer /; min > 1, max_Integer] :=
   Module[{numb, divs, prod, comb}, For[i = min, i <= max, i++,
       numb = T[i] - 1; divs = Most[Rest[Divisors[numb]]];
        comb = Binomial[Length[divs], m]; If[comb > 0,
          For[j = 1, j <= comb, j++,

      prod = First[Apply[Times, Subsets[divs, {m}, {j}], {1}]];
                If[prod == numb,
                 Return[numb + 1]]; ]; ]; ];
  Print["No match found"];]

In[3]:= seek[2, 2, 50]

Out[3]= 15

In[4]:= seek[3, 2, 50]

Out[4]= 55

In[5]:= seek[4, 2, 50]

Out[5]= 253

In[6]:= seek[5, 2, 50]

Out[6]= 1081

In[7]:= seek[6, 2, 50]

During evaluation of In[7]:= No match found

HTH,
Jean-Marc

> On 7/4/07, Jean-Marc Gulliet <jeanmarc.gulliet at gmail.com> wrote:
> > On 7/4/07, Diana Mecum <diana.mecum at gmail.com> wrote:
> > > Jean-Marc,
> > >
> > > It seems to stop working at 5. I can't get seek[6,t] to display
> anything.
> > >
> > > Thanks,
> > >
> > > Diana
> >
> > The following version of the function seek is memory efficient and
> > allows range of triangular numbers.
> >
> > In[1]:= T[n_Integer /; n > 0] := Binomial[n + 1, 2]
> > seek[m_Integer /; m > 0, min_Integer /; min > 1, max_Integer] :=
> >    Module[{numb, divs, prod, comb}, For[i = min, i <= max, i++,
> >        numb = T[i] - 1; divs = Most[Rest[Divisors[numb]]];
> >         comb = Binomial[Length[divs], m]; If[comb > 0,
> >           For[j = 1, j <= comb, j++,
> >
> >       prod = First[Apply[Times, Subsets[divs, {m}, {j}], {1}]];
> >                If[prod > numb, Break[]]; If[prod == numb,
> >                  Return[numb + 1]]; ]; ]; ]]
> >
> > In[3]:= seek[4, 2, 50]
> >
> > Out[3]= 561
> >
> > In[4]:= seek[5, 46, 46]
> >
> > Out[4]= 1081
> >
> > In[5]:= seek[5, 22, 50]
> >
> > Out[5]= 1081
> >
> > In[6]:= seek[6, 100, 200]
> >
> > Out[6]= 18145
> >
> > In[7]:= seek[7, 100, 1000]
> >
> > Out[7]= 115921
> >
> > Regards,
> > Jean-Marc
> >
> > > On 7/3/07, Jean-Marc Gulliet <jeanmarc.gulliet at gmail.com> wrote:
> > > > Diana wrote:
> > > > > Math folks,
> > > > >
> > > > > I first generate a list of triangular numbers:
> > > > >
> > > > > 1, 3, 6, 10, 15, 21, ...
> > > > >
> > > > > and then subtract one from each as:
> > > > >
> > > > > 0, 2, 5, 9, 14, 20, ...
> > > > >
> > > > > I am trying to find the smallest triangular number (minus one) which
> > > > > can be written as a product of "n" distinct factors, each factor >
> 1.
> > > > >
> > > > > For example:
> > > > >
> > > > > a(2) = 15, because 2*7 + 1 = 15.
> > > > > a(3) = 55, because 2*3*9 + 1 = 55.
> > > > >
> > > > > I have worked with Divisors and FactorInteger, but am getting bogged
> > > > > down with repeated terms. Can someone think of a neat trick to work
> > > > > this problem?
> > > > >
> > > > > Diana M.
> > > >
> > > > Hi Diana,
> > > >
> > > > To me, your requirements are crystal clear, so I may not have
> correctly
> > > > understood what you are trying to achieve; nevertheless, the following
> > > > function 'seek' should return the expected results. (Note that this
> code
> > > > is not memory efficient.)
> > > >
> > > > In[1]:= T[n_Integer /; n > 0] := Binomial[n + 1, 2]
> > > >
> > > > In[2]:= t = T /@ Range[30]
> > > >
> > > > Out[2]= {1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 66, 78, 91, 105, 120,
> 136,
> > > > 153, 171, 190, 210, 231, 253, 276, 300, 325, 351, 378, 406, 435, 465}
> > > >
> > > > In[3]:= seek[m_Integer /; m > 0, p_] :=
> > > >   Module[{l = p - 1 /. 0 -> Sequence[], prod, target},
> > > >       prod = (Union[Apply[Times,
> > > Subsets[Most[Rest[Divisors[#1]]], {m}],
> > > >                   {1}]] & ) /@ l;
> > > >       target = Transpose[{l, prod}];
> > > >       Select[Transpose[{l, prod}], MemberQ[#1[[2]], #1[[1]]] & ,
> > > >      1] /. q_ /; Length[q] > 0 :> q[[1, 1]] + 1]
> > > >
> > > > In[4]:= seek[2, t]
> > > >
> > > > Out[4]= 15
> > > >
> > > > In[5]:= seek[3, t]
> > > >
> > > > Out[5]= 55
> > > >
> > > > In[6]:= seek[4, t]
> > > >
> > > > Out[6]= 253
> > > >
> > > > Regards,
> > > > Jean-Marc
> > > >
> > > >
> > >
> > >
> > >
> > > --
> > > "God made the integers, all else is the work of man."
> > > L. Kronecker, Jahresber. DMV 2, S. 19.
> >
>
>
>
> --
>
> "God made the integers, all else is the work of man."
> L. Kronecker, Jahresber. DMV 2, S. 19.


  • Prev by Date: Re: Working with factors of triangular numbers.
  • Next by Date: Re: Compiled function changes somehow.
  • Previous by thread: Re: Working with factors of triangular numbers.
  • Next by thread: Re: Working with factors of triangular numbers.