2
$\begingroup$

There is a sequence of Numbers that satisfies

(1) $a_1+p\geq 0, a_2+p=0, p\in R$
(2) $a_{4n}>a_{4 n-1}, (n=1,2,...)$
(3) $a_{m+n}\in\{a_m+a_n+p, a_m+a_n+p+1\}, (m,n=1,2...)$

I tried to list the first k items using the code below,

k = 6;
eqn = Table[And@@Function[{m,n},And[a[1]+p>=0,a[2]==-p,a[4]>a[3],a[8]>a[7],
 a[m+n]==a[m]+a[n]+p||a[m+n]==a[m]+a[n]+p+1]]@@@IntegerPartitions[i,{2}],{i,2,k}]
Solve[eqn,Array[a,k],Reals]//Normal

{{a[1]->-p,a[2]->-p,a[3]->-p,a[4]->1-p,a[5]->1-p,a[6]->1-p}}

When I set k to be greater than 6, it has been running for a long time. Do you have a faster way to generate more terms of this sequence?

$\endgroup$
5
  • $\begingroup$ Is there a condition for p? If a_n were defined succesfully upto k, (I mean upto k, the sequence a_n satisfies (1),(2),(3)), can we always find a suitable value for a_(k+1) that satisfies (1),(2),(3) ? The second question is about mathematics. $\endgroup$
    – imida k
    Aug 25 at 10:18
  • $\begingroup$ Your main purpose is solving/attacking mathematical problem for a_n, using mathematica? $\endgroup$
    – imida k
    Aug 25 at 10:21
  • $\begingroup$ @imidak p is a real number. I need to list more, try to find patterns. $\endgroup$
    – expression
    Aug 25 at 10:58
  • $\begingroup$ I just ran the case for k=6, and it took 2.5 seconds, yielding {a[1] -> -p, a[2] -> -p, a[3] -> -p, a[4] -> 1 - p, a[5] -> 1 - p, a[6] -> 1 - p}, but k=7 is taking much longer. $\endgroup$
    – march
    Aug 26 at 15:59
  • $\begingroup$ Based on the first few cases (k=2 through k=6), it sure seems like every such sequence consists of a bunch of -p's followed by one or more 1-p's. If there's a good reason to believe that this continues to hold, it might be faster to just check each such sequence to see if it satisfies the conditions, provided that k doesn't need to be too large. $\endgroup$
    – march
    Aug 26 at 15:59
1
$\begingroup$

Here is one suggestion that might work. It seems (on a cursory glance of the conditions making up the sequence) that previous solutions are nested in current ones. For that reason, it probably makes sense to define this recursively. Below, I have worked out a klugey solution based on your current code. It could be made much nicer, but I believe that it works. Part of the kluge is in the following, where in order to make the solutions work, I need to get rid of the conditions a[4] > a[3] and a[8] > a[7] when they are unnecessary:

generateConditions[k_ /; 2 <= k <= 3] := 
 Table[And @@ 
   Function[{m, n}, 
     And[a[1] + p >= 0, a[2] == -p, 
      a[m + n] == a[m] + a[n] + p || 
       a[m + n] == a[m] + a[n] + p + 1]] @@@ 
    IntegerPartitions[i, {2}], {i, 2, k}]
generateConditions[k_ /; 4 <= k <= 7] := 
 Table[And @@ 
   Function[{m, n}, 
     And[a[1] + p >= 0, a[2] == -p, a[4] > a[3], 
      a[m + n] == a[m] + a[n] + p || 
       a[m + n] == a[m] + a[n] + p + 1]] @@@ 
    IntegerPartitions[i, {2}], {i, 2, k}]
generateConditions[k_ /; 8 <= k] := 
 Table[And @@ 
   Function[{m, n}, 
     And[a[1] + p >= 0, a[2] == -p, a[4] > a[3], a[8] > a[7], 
      a[m + n] == a[m] + a[n] + p || 
       a[m + n] == a[m] + a[n] + p + 1]] @@@ 
    IntegerPartitions[i, {2}], {i, 2, k}]

Then, the solutions are recursively defined with the k = 2 case as the base case:

ClearAll@generateSolutions
generateSolutions[2] = Solve[generateConditions[2], Array[a, 2], Reals]

generateSolutions[k_ /; k > 2] := generateSolutions[k] = Module[
   {sols, solOld = generateSolutions[k - 1]}
   , sols = Table[
     Join[sol, #] & /@ 
      Solve[generateConditions[k] /. sol // DeleteDuplicates // 
        Simplify, a[k], Reals]
     , {sol, solOld}]
   ; Cases[sols, {__, a[k] -> _}, Infinity]
   ]

You can run the code to get the following, very quickly. (The k = 7 case is the second one to generate two solutions, and it takes a very long time to solve with the original case, which is why I started there.)

generateSolutions[7]
(* {{a[1] -> -p, a[2] -> -p, a[3] -> -p, a[4] -> 1 - p, a[5] -> 1 - p, a[6] -> 1 - p, a[7] -> 1 - p},
    {a[1] -> -p, a[2] -> -p, a[3] -> -p, a[4] -> 1 - p, a[5] -> 1 - p, a[6] -> 1 - p, a[7] -> 2 - p}} *)

and

generateSolutions[8]
(* {{a[1] -> -p, a[2] -> -p, a[3] -> -p, a[4] -> 1 - p, a[5] -> 1 - p, a[6] -> 1 - p, a[7] -> 1 - p, a[8] -> 2 - p}} *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.