Re: Working with factors of triangular numbers.
- To: mathgroup at smc.vnet.net
- Subject: [mg78723] Re: [mg78490] Working with factors of triangular numbers.
- From: Andrzej Kozlowski <akoz at mimuw.edu.pl>
- Date: Sat, 7 Jul 2007 06:14:41 -0400 (EDT)
- References: <200707030923.FAA17995@smc.vnet.net>
On 3 Jul 2007, at 18:23, 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. > > I wil start with a grumble. Unfortunately your problem is not, in my judgment, solvable by means of any nice mathematics, because you do not require the factors to be mutually prime, that is, not to be divisible by the same prime. Without that one can't make use of uniqueness of prime decomposition and that in this kind of problems generally means that brute force has to be used. (I have a much nicer solution of the same problem when the factors are required to be mutually prime) So now I will present a 'brute force" argument, whose main virtue is that it can be much improved (but I will not do so). I will use the combinatorica package, which, in Mathematica 6.0 is loaded like this: << Combinatorica` I want to make use of the Backtrack function in this package. (This is the main weakness of this approach and the point which can be greatly improved). Here is an auxiliary function, which uses backtracking: FF[n_] := Module[{u = FactorInteger[n], s, k, partialQ, finalQ, space, sp}, s = u[[All,2]]; k = Length[u]; sp[m_] := Tuples[Range[0, m], {k}]; partialQ[l_List] := And @@ Flatten[ { !MemberQ[IdentityMatrix[k], Last[l]], Last[l] == Array[0 & , k] || !MemberQ[Most[l], Last[l]], Thread[Total[l] <= s - 1]}]; finalQ[l_List] := And @@ Flatten[{ !MemberQ[IdentityMatrix[k], Last[l]], Last[l] == Array[0 & , k] || !MemberQ[Most[l], Last[l]], Thread[Total[l] == s - 1]}]; space = sp /@ (s - 1); k + Max[0, Length /@ DeleteCases[Backtrack[space, partialQ, finalQ, All], Array[0 & , k], Infinity]]] For any positive integer n this computes the length of the largest factorization of n into distinct factors. For example: FF[2*3*9*11] 4 which is obviously right. There is some minor problem in the code that causes a Part error message to appear sometimes, without however affecting the result: FF[3] Part::partw:Part 2 of {1} does not exist. >> Part::partw:Part 2 of ( { {{0}} } ) does not exist. >> Set::partw:Part 2 of {1} does not exist. >> 1 However, I don't to spend time on trying to find out the cause of this message so on my main program I will simply suppress all messages: So now here is the main function T: T[n_] := Block[{k = 1, $Messages}, While[k++; FF[k*((k + 1)/2) - 1] < n, Null]; k*((k + 1)/2)] which for a given n looks for the smallest triangular number with n- distinct factors: Map[T, Range[8]] {3, 15, 55, 253, 1081, 13861, 115921, 1413721} I can't say that this is really fast, but the good news is that it certainly could be greatly improved. The Combinatorica general- purpose Backtrack function is very slow, and if someone writes a custom-made backtracking version suited to the problem at hand and compiles it, it will certainly become orders of magnitude faster. This has been done on this list in various situations several times. Unfortunately I can't spare the time necessary to do this. . Writing backtracking programs requires careful procedural programming and I am really out of practice in procedural programming, but there are several excellent examples in the archives written by Fred Simons and Maxim Rytin, and if this is important for you, you should either learn to do it yourself by studying these programs or persuade one of them to do it for you ;-) Andrzej Kozlowski ------------------------------------------ Your proposition may be good But let's have one thing understood -- Whatever it is, I'm against it! And even when you've changed it or condensed it, I'm against it. Professor Quincy Adams Wagstaff President of Huxley College
- References:
- Working with factors of triangular numbers.
- From: Diana <diana.mecum@gmail.com>
- Working with factors of triangular numbers.