Forced Drifts in Multiplicative Sequences: Difference between revisions

From Polymath Wiki
Jump to navigationJump to search
← Older edit
OBryant (talk | contribs)
109 edits
mNo edit summary
OBryant (talk | contribs)
109 edits
→‎drift 6: link to data
 
(One intermediate revision by the same user not shown)
Line 728: Line 728:


The data for drift 6 is not complete. Kevin has the data for 2 -> 1, but 2 -> -1 doesn't terminate in reasonable time (it gets stuck around modified the Walters example).
The data for drift 6 is not complete. Kevin has the data for 2 -> 1, but 2 -> -1 doesn't terminate in reasonable time (it gets stuck around modified the Walters example).
The data for 2 -> 1 is now posted (in raw form) at [[Forced Drift of Six in Multiplicative Sequences]].
== The code ==
Here's the Mathematica code that generated the data above. Note that it easier to check the data above than it is to generate it. Also note that the code wasn't carefully optimized for speed, even within Mathematica.
<pre>
maxN = 2^18;
Do[
  Which[n == 1, Subscript[x, n] = 1,
  PrimeQ[n], Null,
  True,
  f = FactorInteger[n];
  f2 = (f /. {a_Integer, b_Integer} :>
      If[EvenQ[b], 1, Subscript[x, a]]);
  Subscript[x, n] = Times @@ f2], {n, 1, maxN}];
Remove[f, f2];
shap[last_, length_] :=
  Sum[Subscript[x, i], {i, last - length + 1, last}];
MakeEffort[pm1_] :=
  Module[{guesses, found, CurrentUpperLimit, counter, s, sign},
  guesses =
    Table[Subscript[x, Prime[i]] -> pm1[[i]], {i, Length[pm1]}];
 
  found = False;
  CurrentUpperLimit =
    seq - 1;(*seq is the bound on drift that we are targeting*)
 
  While[Not[found] && CurrentUpperLimit <= Prime[1 + Length[pm1]]^2 &&
      CurrentUpperLimit <= maxN,
    CurrentUpperLimit++;
    counter = CurrentUpperLimit;
    sign = Subscript[x, counter] /. guesses;
    s = If[IntegerQ[sign], sign, 0];
   
    While[s != 0 && counter > 1 && s != sign*seq,
    counter--;
    newvalue = Subscript[x, counter] /. guesses;
    s += If[IntegerQ[newvalue], newvalue, -sign]];
    If[s == sign*seq, found = True]];
  If[found, {pm1, {CurrentUpperLimit,
      CurrentUpperLimit - counter + 1}, s}, "Not Found"]];
Finish[pm1_] := Module[{temp, p1, m1},
  temp = MakeEffort[pm1];
  If[temp === "Not Found",
  p1 = Append[pm1, 1];
  m1 = Append[pm1, -1];
  AppendTo[VertexSet, p1];
  AppendTo[VertexSet, m1];
  AppendTo[
    EdgeSet, {pm1 -> p1, ToString[Prime[Length[p1]]] <> "+"}];
  AppendTo[
    EdgeSet, {pm1 -> m1, ToString[Prime[Length[m1]]] <> "-"}];
  Join[Finish[p1], Finish[m1]],
  LeafLabel[First[temp]] = temp[[2]];
  PrintTemporary["Finished working on " <> ToString[pm1]];
  {temp}]
  ]
seq = 2;
Clear[LeafLabel];
LeafLabel[_] = "";
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq] = Finish[{}]]
tree[2]=TreePlot[EdgeSet/.{}->"root",Left,"root",VertexLabeling->Tooltip, VertexRenderingFunction-> ({White,EdgeForm[Black],Disk[#,.02],Black,Text[ToString[LeafLabel[#2]],#1+{.1,0}]}&)]
seq = 3;
Clear[LeafLabel];
LeafLabel[_] = "";
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq] = Finish[{}]]
tree[3] =
TreePlot[EdgeSet /. {} -> "root", Left, "root",
  VertexLabeling -> Tooltip,
  VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .02],
      Black, Text[ToString[LeafLabel[#2]], #1 + {.3, 0}]} &)]
seq = 4;
Clear[LeafLabel];
LeafLabel[_] = "";
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq] = Finish[{}]]
tree[4] =
TreePlot[EdgeSet /. {} -> "root", Left, "root",
  VertexLabeling -> Tooltip,
  VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .02],
      Black, Text[ToString[LeafLabel[#2]], #1 + {.22, 0}]} &),
  ImageSize -> 900]
seq = 5;
Clear[LeafLabel];
LeafLabel[_] = "";
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq] = Finish[{}]]
tree[5] =
TreePlot[(EdgeSet /. {} -> "root") /. {Rule[a_, 1] :>
    ToString[a] <> "+", Rule[a_, -1] :> ToString[a] <> "-"}, Left,
  "root", VertexLabeling -> Tooltip,
  VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .02],
      Black, Text[ToString[LeafLabel[#2]], #1 + {.1, 0}]} &),
  ImageSize -> 3000]
$RecursionLimit = Infinity;
$IterationLimit = Infinity;
Finish6[pm1_] := Module[{tempeffort, p1, m1},
  tempeffort = MakeEffort[pm1];
  If[tempeffort === "Not Found",
  p1 = Append[pm1, 1];
  m1 = Append[pm1, -1];
  Finish6[p1];
  Finish6[m1];
  NotebookDelete[tempout];
  tempout = PrintTemporary["Finished working on " <> ToString[pm1]],
  Sow[tempeffort]]
  ]
seq = 6;
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq, {1, 1}] = Reap[Finish6[{1, 1}]][[2, 1]]]
seq = 6;
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq, {1, -1}] = Reap[Finish6[{1, -1}]][[2, 1]]]
seq = 6;
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq, {-1, 1}] = Reap[Finish6[{-1, 1}]][[2, 1]]]
seq = 6;
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq, {-1, -1}] = Reap[Finish6[{-1, -1}]][[2, 1]]]
</pre>

Latest revision as of 19:32, 2 April 2010

Each row of each table below give N,k such that, if a multiplicative function f behaves on the primes as described in that row of that table, then

[math]\displaystyle{ f(N-k+1)+ \dots +f(N) }[/math]

has absolute value at least drift.

Specifically, for each value of drift, the tree of assignments to primes is traversed depth first (exploring 1 before -1). Each time an assignment is made to a prime p, then the values of the implied multiplicative function are updated (they are +1,-1,undetermined). Then for each N (starting with N=1), k (also starting at k=1) is incremented until the interval (N-k,N] contains a sufficient imbalance in +1,-1 to overwhelm the undetermined entries and generate a sufficient drift. If there is no such k, then N is incremented. This continues until a drift is found or [math]\displaystyle{ N=p^2+1 }[/math], in which case the next largest prime is assigned a value.

drift 2

Tree representation of data

Nk23
22+
42-+
32--

drift 3

Tree representation of data

Nk23571113
33++
55+-+
93+--+
73+---
53-++
113-+-++
135-+-+-+
153-+-+--
73-+--
63--+
105---+
87----


drift 4

Tree representation of data

Nk235711131719232931374143
44++
1010+-+
1610+--++
164+--+-+
134+--+--
1710+---+++
524+---++-
1410+---+-
128+----
1210-++++
1614-+++-+
278-+++--
166-++-+
116-++--
124-+-++
354-+-+-++
288-+-+-+-++
304-+-+-+-+-+
4014-+-+-+-+--++
2614-+-+-+-+--+-++
454-+-+-+-+--+-+-
4514-+-+-+-+--+--
3320-+-+-+-+---
196-+-+-+--
284-+-+--
84-+--
74--++
1714--+-+++
566--+-++-
354--+-+-+
1812--+-+--
126--+--
116---++
1712---+-++
254---+-+-++
1174---+-+-+-+
3014---+-+-+--
204---+-+--
144---+--
168----+
164-----+
1312------

drift 5

Tree representation of data

Nk2357111317192329313741434753596167717379838997101103107109113127131
99++
99+-++
1111+-+-+
2121+-+--++
2121+-+--+-+
3333+-+--+--+++
5151+-+--+--++-++
5151+-+--+--++-+-+
13017+-+--+--++-+--
3913+-+--+--++--
5121+-+--+--+-+++
5121+-+--+--+-++-+
13017+-+--+--+-++--
3913+-+--+--+-+-
315+-+--+--+--
4313+-+--+---+++++
939+-+--+---++++-
5121+-+--+---+++-++
955+-+--+---+++-+-
939+-+--+---+++--
3929+-+--+---++-
3121+-+--+---+-
2919+-+--+----
155+-+---
159+--+++
1711+--++-+
1913+--++--+
3125+--++---+++
5145+--++---++-+++
13345+--++---++-++-
519+--++---++-+-++
6517+--++---++-+-+-+
5523+--++---++-+-+--
4311+--++---++-+--
519+--++---++--+++
6517+--++---++--++-+
5523+--++---++--++--
4311+--++---++--+-
419+--++---++---
5145+--++---+-++++
5145+--++---+-+++-+
1895+--++---+-+++--
35213+--++---+-++-+
4311+--++---+-++--
35213+--++---+-+-++
4311+--++---+-+-+-
419+--++---+-+--
3517+--++---+--
279+--++----
175+--+-++
197+--+-+-+
579+--+-+--
185+--+--+
325+--+---++++
3811+--+---+++-+
2895+--+---+++--+
3445+--+---+++---+
445+--+---+++----
665+--+---++-+
2895+--+---++--++
1757+--+---++--+-+
445+--+---++--+--
2895+--+---++---+
4223+--+---++----
245+--+---+-
2213+--+----
1811+---+++
2215+---++-+
2619+---++--+
1207+---++---+
1565+---++----+
2539+---++-----++
4115+---++-----+-
3913+---++------
195+---+-++
239+---+-+-+
357+---+-+--++
379+---+-+--+-+
2097+---+-+--+--+
1895+---+-+--+---++
5511+---+-+--+---+-
5519+---+-+--+----
297+---+-+---
239+---+--++
3911+---+--+-++
395+---+--+-+-+
17111+---+--+-+--+
1725+---+--+-+---+
5735+---+--+-+----
297+---+--+--
379+---+---++++
1559+---+---+++-
5117+---+---++-++
5117+---+---++-+-+
5117+---+---++-+--+
615+---+---++-+---+++
7317+---+---++-+---++-+++
7325+---+---++-+---++-++-
8529+---+---++-+---++-+-+++
9337+---+---++-+---++-+-++-+
999+---+---++-+---++-+-++--+
58411+---+---++-+---++-+-++---
52935+---+---++-+---++-+-+-
7717+---+---++-+---++-+--
699+---+---++-+---++--
1235+---+---++-+---+-+
6359+---+---++-+---+--
5551+---+---++-+----
5111+---+---++--++
5111+---+---++--+-+
3007+---+---++--+--++
34815+---+---++--+--+-+++
7773+---+---++--+--+-++-
6965+---+---++--+--+-+-
6359+---+---++--+--+--
5551+---+---++--+---
4137+---+---++---
2925+---+---+-
2723+---+----
365+----++
3319+----+-+++
3319+----+-++-+
3723+----+-++--+
4329+----+-++---++
5137+----+-++---+-+
535+----+-++---+--+
3725+----+-++---+---
1725+----+-++----+
457+----+-++-----
1217+----+-+-+
2925+----+-+--
335+----+--+++
379+----+--++-+
1907+----+--++--
2925+----+--+-
2319+----+---
139+-----
1311-+++++
1715-++++-+
2119-++++--+
2725-++++---+
295-++++----+
3511-++++-----+
937-++++------
1715-+++-++
2119-+++-+-+
2321-+++-+--+
2927-+++-+---+
3257-+++-+----
289-+++--
155-++-++
177-++-+-+
2717-++-+--++
3713-++-+--+-+++
499-++-+--+-++-+
415-++-+--+-++--
499-++-+--+-+-++
4121-++-+--+-+-+-
3919-++-+--+-+--
499-++-+--+--+++
4121-++-+--+--++-
3919-++-+--+--+-
3111-++-+--+---
3713-++-+---++++
4521-++-+---+++-+
4521-++-+---+++--+
4925-++-+---+++---+
1885-++-+---+++----
4513-++-+---++-++
4513-++-+---++-+-+
4917-++-+---++-+--+
5337-++-+---++-+---++
5921-++-+---++-+---+-
5315-++-+---++-+----
455-++-+---++--++
499-++-+---++--+-+
7113-++-+---++--+--+++++
34859-++-+---++--+--++++-
1365-++-+---++--+--+++-
12613-++-+---++--+--++-
5943-++-+---++--+--+-
5337-++-+---++--+---
4125-++-+---++---
4513-++-+---+-+++
4513-++-+---+-++-+
4917-++-+---+-++--+
3785-++-+---+-++---
37811-++-+---+-+-+
4125-++-+---+-+--
3115-++-+---+--
237-++-+----
165-++--+
207-++---++
2613-++---+-+
4611-++---+--+++++
1767-++---+--++++-
487-++---+--+++-++
1237-++---+--+++-+-+++
8217-++---+--+++-+-++-++
1487-++---+--+++-+-++-+-
13515-++---+--+++-+-++--
2475-++---+--+++-+-+-+
629-++---+--+++-+-+--
587-++---+--+++-+--
4413-++---+--+++--
409-++---+--++-
345-++---+--+-
347-++---+---
817-++----+
589-++-----++
4813-++-----+-+++++
7013-++-----+-++++-++++
13513-++-----+-++++-+++-
1255-++-----+-++++-++-
1269-++-----+-++++-+-
545-++-----+-++++--
7013-++-----+-+++-+++++
35535-++-----+-+++-++++-+
2885-++-----+-+++-++++--
1255-++-----+-+++-+++-
1269-++-----+-+++-++-
545-++-----+-+++-+-
5225-++-----+-+++--
2475-++-----+-++-+++++
8217-++-----+-++-++++-++
8217-++-----+-++-++++-+-+
7425-++-----+-++-++++-+--
6819-++-----+-++-++++--
2475-++-----+-++-+++-+
6213-++-----+-++-+++--
545-++-----+-++-++-
5225-++-----+-++-+-
4417-++-----+-++--
4013-++-----+-+-
325-++-----+--
2419-++------
135-+-+++
2719-+-++-+++
295-+-++-++-+
317-+-++-++--+
4925-+-++-++---+++
1307-+-++-++---++-
939-+-++-++---+-+
4313-+-++-++---+--
399-+-++-++----
295-+-++-+-++
317-+-++-+-+-+
709-+-++-+-+--
2311-+-++-+--
567-+-++--
2315-+-+-++++
2921-+-+-+++-+
3123-+-+-+++--+
355-+-+-+++---
299-+-+-++-++
3111-+-+-++-+-+
355-+-+-++-+--
1207-+-+-++--+
405-+-+-++---++
12411-+-+-++---+-+
527-+-+-++---+--++
6417-+-+-++---+--+-+++
1229-+-+-++---+--+-++-
1207-+-+-++---+--+-+-
6811-+-+-++---+--+--+++
7417-+-+-++---+--+--++-++
4757-+-+-++---+--+--++-+-+
805-+-+-++---+--+--++-+--
35535-+-+-++---+--+--++--
6231-+-+-++---+--+--+-
6029-+-+-++---+--+---
4413-+-+-++---+---
3417-+-+-++----
299-+-+-+-+++
3111-+-+-+-++-+
4121-+-+-+-++--++
997-+-+-+-++--+-++
477-+-+-+-++--+-+-
455-+-+-+-++--+--
997-+-+-+-++---+++
4717-+-+-+-++---++-
4515-+-+-+-++---+-
4515-+-+-+-++----
315-+-+-+-+-++
4115-+-+-+-+-+-++
9111-+-+-+-+-+-+-
1907-+-+-+-+-+--
4115-+-+-+-+--+++
4923-+-+-+-+--++-++
5933-+-+-+-+--++-+-++
6741-+-+-+-+--++-+-+-++
12755-+-+-+-+--++-+-+-+-
6125-+-+-+-+--++-+-+--
6711-+-+-+-+--++-+--+++
7835-+-+-+-+--++-+--++-+
4779-+-+-+-+--++-+--++--++
7913-+-+-+-+--++-+--++--+-
737-+-+-+-+--++-+--++---
6125-+-+-+-+--++-+--+-
7835-+-+-+-+--++-+---+++
855-+-+-+-+--++-+---++-+++
9111-+-+-+-+--++-+---++-++-+
10323-+-+-+-+--++-+---++-++--+++
52537-+-+-+-+--++-+---++-++--++-
12141-+-+-+-+--++-+---++-++--+-++
12141-+-+-+-+--++-+---++-++--+-+-+
12111-+-+-+-+--++-+---++-++--+-+--+
17055-+-+-+-+--++-+---++-++--+-+---++
13541-+-+-+-+--++-+---++-++--+-+---+-
12733-+-+-+-+--++-+---++-++--+-+----
10511-+-+-+-+--++-+---++-++--+--
995-+-+-+-+--++-+---++-++---
7939-+-+-+-+--++-+---++-+-
7333-+-+-+-+--++-+---++--
6929-+-+-+-+--++-+---+-
6121-+-+-+-+--++-+----
455-+-+-+-+--++--
4911-+-+-+-+--+-+++
5921-+-+-+-+--+-++-++
18917-+-+-+-+--+-++-+-+
1237-+-+-+-+--+-++-+--
6711-+-+-+-+--+-++--+++
7519-+-+-+-+--+-++--++-++
4779-+-+-+-+--+-++--++-+-+
52935-+-+-+-+--+-++--++-+--
21617-+-+-+-+--+-++--++--
1245-+-+-+-+--+-++--+-
18917-+-+-+-+--+-++---+
6213-+-+-+-+--+-++----
1907-+-+-+-+--+-+-+
9411-+-+-+-+--+-+--
1907-+-+-+-+--+--++
6413-+-+-+-+--+--+-+++
6125-+-+-+-+--+--+-++-
7625-+-+-+-+--+--+-+-+++
35535-+-+-+-+--+--+-+-++-
12755-+-+-+-+--+--+-+-+-
6231-+-+-+-+--+--+-+--
5423-+-+-+-+--+--+--
4413-+-+-+-+--+---
4813-+-+-+-+---++++
5823-+-+-+-+---+++-+
9035-+-+-+-+---+++--
25913-+-+-+-+---++-
25611-+-+-+-+---+-
3825-+-+-+-+----
207-+-+-+--
2813-+-+--++
277-+-+--+-+
295-+-+--+--+
317-+-+--+---+
355-+-+--+----
277-+-+---++
295-+-+---+-+
317-+-+---+--+
665-+-+---+---
197-+-+----
135-+--++
179-+--+-+
3511-+--+--+++
3511-+--+--++-+
375-+--+--++--+
1177-+--+--++---
237-+--+--+-
215-+--+---
179-+---++
3123-+---+-++++
3729-+---+-+++-+
4133-+---+-+++--+
4335-+---+-+++---+
8815-+---+-+++----
3729-+---+-++-++
1167-+---+-++-+-
3317-+---+-++--
1217-+---+-+-+
2913-+---+-+--
215-+---+--
2719-+----+++
317-+----++-++
439-+----++-+-+++
1369-+----++-+-++-
1725-+----++-+-+-+
4515-+----++-+-+--
399-+----++-+--
439-+----++--++++
1369-+----++--+++-
1725-+----++--++-+
4541-+----++--++--
3935-+----++--+-
3329-+----++---
2117-+----+-
2117-+-----
2017--++++++
3027--+++++-++
3835--+++++-+-++
4441--+++++-+-+-++
3445--+++++-+-+-+-
1257--+++++-+-+--
349--+++++-+--
697--+++++--
3027--++++-+++
3633--++++-++-+
665--++++-++--
1769--++++-+-+
4613--++++-+--+++
827--++++-+--++-
4027--++++-+--+-
3219--++++-+---
229--++++--
2611--+++-+++
307--+++-++-+
4623--+++-++--++
4623--+++-++--+-+
1257--+++-++--+--
3423--+++-++---
2211--+++-+-
187--+++--
249--++-++++
3015--++-+++-+
3257--++-+++--
309--++-++-++
3615--++-++-+-+
3817--++-++-+--+
5433--++-++-+---++++
6443--++-++-+---+++-+
12011--++-++-+---+++--
1885--++-++-+---++-
939--++-++-+---+-
6413--++-++-+----++++
12011--++-++-+----+++-
5631--++-++-+----++-
4823--++-++-+----+-
4419--++-++-+-----
369--++-++--++
3811--++-++--+-+
4619--++-++--+--++
3445--++-++--+--+-
5413--++-++--+---+++
6423--++-++--+---++-++
1227--++-++--+---++-+-
6011--++-++--+---++--
1895--++-++--+---+-
4435--++-++--+----
389--++-++---++
4617--++-++---+-++
5425--++-++---+-+-++
29713--++-++---+-+-+-+
1215--++-++---+-+-+--
29713--++-++---+-+--++
1215--++-++---+-+--+-
5647--++-++---+-+---
1257--++-++---+--
3223--++-++----
189--++-+-
145--++--
2017--+-++++
2421--+-+++-+
707--+-+++--
2421--+-++-++
5613--+-++-+-
577--+-++--
2611--+-+-++
267--+-+-+-+
1565--+-+-+--++
355--+-+-+--+-
359--+-+-+---
257--+-+--++
3113--+-+--+-++
4527--+-+--+-+-+++
13345--+-+--+-+-++-
22511--+-+--+-+-+-+
4313--+-+--+-+-+--
3445--+-+--+-+--++
4313--+-+--+-+--+-
4111--+-+--+-+---
4527--+-+--+--++++
4729--+-+--+--+++-+
5537--+-+--+--+++--+
5941--+-+--+--+++---+
1269--+-+--+--+++----
1257--+-+--+--++-
475--+-+--+--+-+++
9905--+-+--+--+-++-
4317--+-+--+--+-+-
4115--+-+--+--+--
337--+-+--+---
1913--+-+---
2513--+--++
257--+--+-+
1913--+--+--
137--+---
1611---+++
2621---++-+++
697---++-++-
225---++-+-
2211---++--
2419---+-++++
4237---+-+++-++++
12411---+-+++-+++-
1177---+-+++-++-
25611---+-+++-+-++
1725---+-+++-+-+-+
4415---+-+++-+-+--
389---+-+++-+--
1725---+-+++--++++
5337---+-+++--+++-++
5337---+-+++--+++-+-+
7011---+-+++--+++-+--++
1357---+-+++--+++-+--+-
6237---+-+++--+++-+---
4823---+-+++--+++--
1725---+-+++--++-+
4419---+-+++--++--
3813---+-+++--+-
327---+-+++---
3817---+-++-++++
4221---+-++-+++-+
2487---+-++-+++--
967---+-++-++-
427---+-++-+-+++
2487---+-++-+-++-
587---+-++-+-+-++++
607---+-++-+-+-+++-+
6411---+-++-+-+-+++--+
2487---+-++-+-+-+++---
485---+-++-+-+-++-
4621---+-++-+-+-+-
4621---+-++-+-+--
327---+-++-+--
427---+-++--++++
2487---+-++--+++-
8713---+-++--++-++
9035---+-++--++-+-++
6411---+-++--++-+-+-++
2487---+-++--++-+-+-+-
1195---+-++--++-+-+--
4831---+-++--++-+--
2487---+-++--++--
3215---+-++--+-
3013---+-++---
3413---+-+-++++
4221---+-+-+++-++
5433---+-+-+++-+-+++
6443---+-+-+++-+-++-+
645---+-+-+++-+-++--+
2465---+-+-+++-+-++---
485---+-+-+++-+-+-
469---+-+-+++-+--
1297---+-+-+++--++
4617---+-+-+++--+-
4617---+-+-+++---
4221---+-+-++-+++
5433---+-+-++-++-+++
6039---+-+-++-++-++-+
6443---+-+-++-++-++--+
2465---+-+-++-++-++---
485---+-+-++-++-+-
469---+-+-++-++--
5415---+-+-++-+-++++
6021---+-+-++-+-+++-+
6425---+-+-++-+-+++--+
30613---+-+-++-+-+++---
485---+-+-++-+-++-
4621---+-+-++-+-+-
4621---+-+-++-+--
327---+-+-++--
4215---+-+-+-++++
5225---+-+-+-+++-++
5427---+-+-+-+++-+-+
122511---+-+-+-+++-+--
549---+-+-+-+++--++
6419---+-+-+-+++--+-++
12411---+-+-+-+++--+-+-
1185---+-+-+-+++--+--
4811---+-+-+-+++---
1177---+-+-+-++-
4311---+-+-+-+-+++
5523---+-+-+-+-++-+
555---+-+-+-+-++--+
122511---+-+-+-+-++---
5523---+-+-+-+-+-++
555---+-+-+-+-+-+-+
122511---+-+-+-+-+-+--
4529---+-+-+-+-+--
3923---+-+-+-+--
4311---+-+-+--++++
917---+-+-+--+++-
5523---+-+-+--++-++
555---+-+-+--++-+-+
6111---+-+-+--++-+--++
2465---+-+-+--++-+--+-
7121---+-+-+--++-+---+++
9141---+-+-+--++-+---++-++
9111---+-+-+--++-+---++-+-+
915---+-+-+--++-+---++-+--+
8747---+-+-+--++-+---++-+---+
9929---+-+-+--++-+---++-+----
755---+-+-+--++-+---++--
1365---+-+-+--++-+---+-
12411---+-+-+--++-+----
4529---+-+-+--++--
3923---+-+-+--+-
3115---+-+-+---
215---+-+--
2511---+--+++
2915---+--++-+
4127---+--++--+++
2487---+--++--++-
2097---+--++--+-+
2487---+--++--+--
357---+--++---
2111---+--+-
2111---+---
157----++
179----+-+
2517----+--++
3729----+--+-+++
4133----+--+-++-+
2487----+--+-++--
337----+--+-+-
337----+--+--
407----+---
175-----++
2513-----+-+
577-----+--
2613------+
2613-------+
2019--------

drift 6

The data for drift 6 is not complete. Kevin has the data for 2 -> 1, but 2 -> -1 doesn't terminate in reasonable time (it gets stuck around modified the Walters example).

The data for 2 -> 1 is now posted (in raw form) at Forced Drift of Six in Multiplicative Sequences.

The code

Here's the Mathematica code that generated the data above. Note that it easier to check the data above than it is to generate it. Also note that the code wasn't carefully optimized for speed, even within Mathematica. 

maxN = 2^18;

Do[
  Which[n == 1, Subscript[x, n] = 1,
   PrimeQ[n], Null,
   True,
   f = FactorInteger[n];
   f2 = (f /. {a_Integer, b_Integer} :> 
       If[EvenQ[b], 1, Subscript[x, a]]);
   Subscript[x, n] = Times @@ f2], {n, 1, maxN}];
Remove[f, f2];

shap[last_, length_] := 
  Sum[Subscript[x, i], {i, last - length + 1, last}];

MakeEffort[pm1_] := 
  Module[{guesses, found, CurrentUpperLimit, counter, s, sign},
   guesses = 
    Table[Subscript[x, Prime[i]] -> pm1[[i]], {i, Length[pm1]}];
   
   found = False; 
   CurrentUpperLimit = 
    seq - 1;(*seq is the bound on drift that we are targeting*)
   
   While[Not[found] && CurrentUpperLimit <= Prime[1 + Length[pm1]]^2 &&
      CurrentUpperLimit <= maxN,
    CurrentUpperLimit++;
    counter = CurrentUpperLimit;
    sign = Subscript[x, counter] /. guesses;
    s = If[IntegerQ[sign], sign, 0];
    
    While[s != 0 && counter > 1 && s != sign*seq,
     counter--;
     newvalue = Subscript[x, counter] /. guesses;
     s += If[IntegerQ[newvalue], newvalue, -sign]];
    If[s == sign*seq, found = True]];
   If[found, {pm1, {CurrentUpperLimit, 
      CurrentUpperLimit - counter + 1}, s}, "Not Found"]];

Finish[pm1_] := Module[{temp, p1, m1},
  temp = MakeEffort[pm1];
  If[temp === "Not Found",
   p1 = Append[pm1, 1];
   m1 = Append[pm1, -1];
   AppendTo[VertexSet, p1];
   AppendTo[VertexSet, m1];
   AppendTo[
    EdgeSet, {pm1 -> p1, ToString[Prime[Length[p1]]] <> "+"}];
   AppendTo[
    EdgeSet, {pm1 -> m1, ToString[Prime[Length[m1]]] <> "-"}];
   Join[Finish[p1], Finish[m1]],
   LeafLabel[First[temp]] = temp[[2]];
   PrintTemporary["Finished working on " <> ToString[pm1]];
   {temp}]
  ]

seq = 2;
Clear[LeafLabel];
LeafLabel[_] = "";
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq] = Finish[{}]]

tree[2]=TreePlot[EdgeSet/.{}->"root",Left,"root",VertexLabeling->Tooltip, VertexRenderingFunction-> ({White,EdgeForm[Black],Disk[#,.02],Black,Text[ToString[LeafLabel[#2]],#1+{.1,0}]}&)]

seq = 3;
Clear[LeafLabel];
LeafLabel[_] = "";
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq] = Finish[{}]]

tree[3] = 
 TreePlot[EdgeSet /. {} -> "root", Left, "root", 
  VertexLabeling -> Tooltip, 
  VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .02], 
      Black, Text[ToString[LeafLabel[#2]], #1 + {.3, 0}]} &)]

seq = 4;
Clear[LeafLabel];
LeafLabel[_] = "";
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq] = Finish[{}]]

tree[4] = 
 TreePlot[EdgeSet /. {} -> "root", Left, "root", 
  VertexLabeling -> Tooltip, 
  VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .02], 
      Black, Text[ToString[LeafLabel[#2]], #1 + {.22, 0}]} &), 
  ImageSize -> 900]

seq = 5;
Clear[LeafLabel];
LeafLabel[_] = "";
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq] = Finish[{}]]

tree[5] = 
 TreePlot[(EdgeSet /. {} -> "root") /. {Rule[a_, 1] :> 
     ToString[a] <> "+", Rule[a_, -1] :> ToString[a] <> "-"}, Left, 
  "root", VertexLabeling -> Tooltip, 
  VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, .02], 
      Black, Text[ToString[LeafLabel[#2]], #1 + {.1, 0}]} &), 
  ImageSize -> 3000]

$RecursionLimit = Infinity;
$IterationLimit = Infinity;

Finish6[pm1_] := Module[{tempeffort, p1, m1},
  tempeffort = MakeEffort[pm1];
  If[tempeffort === "Not Found",
   p1 = Append[pm1, 1];
   m1 = Append[pm1, -1];
   Finish6[p1];
   Finish6[m1];
   NotebookDelete[tempout];
   tempout = PrintTemporary["Finished working on " <> ToString[pm1]],
   Sow[tempeffort]]
  ]

seq = 6;
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq, {1, 1}] = Reap[Finish6[{1, 1}]][[2, 1]]]

seq = 6;
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq, {1, -1}] = Reap[Finish6[{1, -1}]][[2, 1]]]

seq = 6;
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq, {-1, 1}] = Reap[Finish6[{-1, 1}]][[2, 1]]]

seq = 6;
VertexSet = {{}};
EdgeSet = {};
Timing[data[seq, {-1, -1}] = Reap[Finish6[{-1, -1}]][[2, 1]]]
Retrieved from "https://michaelnielsen.org/polymath/index.php?title=Forced_Drifts_in_Multiplicative_Sequences&oldid=3066"