OKlibrary  0.2.1.6
Numbers.mac
Go to the documentation of this file.
```00001 /* Oliver Kullmann, 6.5.2009 (Swansea) */
00002 /* Copyright 2009, 2010 Oliver Kullmann
00003 This file is part of the OKlibrary. OKlibrary is free software; you can redistribute
00004 it and/or modify it under the terms of the GNU General Public License as published by
00005 the Free Software Foundation and included in this library; either version 3 of the
00006 License, or any later version. */
00007
00022 oklib_include("OKlib/ComputerAlgebra/DataStructures/Lisp/Lists.mac")\$
00023 oklib_include("OKlib/ComputerAlgebra/RamseyTheory/Lisp/VanderWaerden/Numbers.mac")\$
00024
00025
00026 /* *********************
00027    * Green-Tao numbers *
00028    *********************
00029 */
00030
00031 /* The main function, which handles all parameter-values (gathering all
00032    knowledge from all our sources). */
00033 /* Prerequisites: L ascendingly sorted list of natural numbers >= 1 */
00034 greentao(L) := if emptyp(L) then 1
00035  elseif first(L) = 1 then greentao(rest(L))
00036  elseif greentaod_a(L)#[] then apply(greentaod,greentaod_a(L))
00037  elseif greentaot_a(L)#[] then apply(greentaot,greentaot_a(L))
00038  elseif greentao3k_a(L)#[] then apply(greentao3k,greentao3k_a(L))
00039  elseif greentao4k_a(L)#[] then apply(greentao4k,greentao4k_a(L))
00040  elseif greentao5k_a(L)#[] then apply(greentao5k,greentao5k_a(L))
00041  /* elseif greentaots_a(L)#[] then apply(greentaots,greentaots_a(L)) */
00042  elseif greentao33k_a(L)#[] then apply(greentao33k,greentao33k_a(L))
00043  elseif greentao34k_a(L)#[] then apply(greentao34k,greentao34k_a(L))
00044  elseif greentao44k_a(L)#[] then apply(greentao44k,greentao44k_a(L))
00045  elseif greentao333k_a(L)#[] then apply(greentao333k,greentao333k_a(L))
00046  elseif greentao334k_a(L)#[] then apply(greentao334k,greentao334k_a(L))
00047  else unknown\$
00048 /* Remark: If L is not sorted, use greentao(sort(L)). */
00049
00050 /* Checking whether L is a valid input: */
00051 greentao_p(L) := vanderwaerden_p(L)\$
00052
00053
00054 /* ****************
00055    * Binary cases *
00056    ****************
00057 */
00058
00059 greentao3k(k) :=
00060  if k <= 7 then [
00061   4,7,23,79,528,[2072,inf-1],[13800+1,inf-1]
00062  ][k]
00063  else unknown\$
00064 greentao3k_a(L) := vanderwaerden3k_a(L)\$
00065
00066 greentao4k(k) :=
00067  if k <= 5 then [
00068   9,14,79,512,[4231+1,inf-1]
00069  ][k]
00070  else unknown\$
00071 greentao4k_a(L) := vanderwaerden4k_a(L)\$
00072
00073 greentao5k(k) :=
00074  if k <= 5 then [
00075   10,31,528,[4231+1,inf-1],[34309,inf-1]
00076  ][k]
00077  else unknown\$
00078 greentao5k_a(L) := vanderwaerden5k_a(L)\$
00079
00080
00081
00082 /* *****************
00083    * Ternary cases *
00084    *****************
00085 */
00086
00087 greentao33k(k) :=
00088  if k <= 5 then [
00089   23,31,137,[434,inf-1],[1989+1,inf-1]
00090  ][k]
00091  else unknown\$
00092 greentao33k_a(L) := vanderwaerden33k_a(L)\$
00093
00094 greentao34k(k) :=
00095  if k <= 5 then [
00096   79,117,[434,inf-1],[1662+1,inf-1],[8300+1,inf-1]
00097  ][k]
00098  else unknown\$
00099 greentao34k_a(L) := vanderwaerden34k_a(L)\$
00100
00101 greentao44k(k) :=
00102  if k <= 4 then [
00103   512,[553,inf-1],[1662+1,inf-1],[5500+1,inf-1]
00104  ][k]
00105  else unknown\$
00106 greentao44k_a(L) := vanderwaerden44k_a(L)\$
00107
00108
00109 /* ********************
00110    * Quaternary cases *
00111    ********************
00112 */
00113
00114 greentao333k(k) :=
00115  if k <= 4 then [
00116   137,151,[384+1,inf-1],[1052+1,inf-1]
00117  ][k]
00118  else unknown\$
00119 greentao333k_a(L) := if length(L)#4 then []
00120  elseif L=[1,3,3,3] then [1]
00121  elseif L=[2,3,3,3] then [2]
00122  elseif rest(L,-1)#[3,3,3] then []
00123  else [last(L)]\$
00124
00125 greentao334k(k) :=
00126  if k <= 4 then [
00127   [434,inf-1],[453,inf-1],[1052+1,inf-1],[2750+1,inf-1]
00128  ][k]
00129  else unknown\$
00130 greentao334k_a(L) := if length(L)#4 then []
00131  elseif L=[1,3,3,4] then [1]
00132  elseif L=[2,3,3,4] then [2]
00133  elseif rest(L,-1)#[3,3,4] then []
00134  else [last(L)]\$
00135
00136
00137 /* *********************
00138    * The diagonal case *
00139    *********************
00140 */
00141
00142 /* The "diagonal case", i.e., m parts, arithmetic progressions of length k: */
00143 greentaod(m,k) := if m=0 then 1
00144  elseif k=1 then 1
00145  elseif k=2 then m+1
00146  elseif m=1 then greentaod1(k)
00147  elseif m=2 then greentaod2(k)
00148  elseif m=3 then greentaod3(k)
00149  elseif k=3 then greentaodap3(m)
00150  elseif k=4 then greentaodap4(m)
00151  else unknown\$
00152 /* The corresponding argument check for a GT parameter-list L,
00153    checking whether a parameter tuple applies, returning [m,k]
00154    in the positive case and [] otherwise: */
00155 greentaod_a(L) := vanderwaerdend_a(L)\$
00156
00157 greentaod1(k) :=
00158  if k <= 21 then [
00159   1,2,4,9,10,37,155,263,289,316,
00160   21966,23060,58464,2253121,9686320,11015837,227225515,755752809,3466256932,22009064470,
00161   220525414079
00162  ][k]
00163  else unknown\$
00164 greentaod1_a(L) := if length(L)=1 then L else []\$
00165 /* For k >= 12 these numbers are obtained by ranking via "RankPrimes" from
00166    sequence A005115 (use "eis_details(A005115)"), available in the following
00167    list ("ur" for "unranked"): */
00168 greentaod1ur : [
00169  2,3,7,23,29,157,907,1669,1879,
00170  2089,249037,262897,725663,36850999,173471351,198793279,4827507229,17010526363,83547839407,572945039351,
00171  6269243827111
00172 ]\$
00173 /* greentaod1(k) is the smallest n such that
00174    arithprog_primes_ohg(k,n)[2] is not empty, i.e., such that
00175    {p_1, ..., p_n} contains an arithmetic progression of length k:
00176 */
00177 compute_greentaod1(k) := block(
00178  [primes_rev_init_seg : [], p : 1],
00179   while emptyp(arithprog_primes_finish_nm(k)) do (
00180     p : next_prime(p),
00181     primes_rev_init_seg : cons(p,primes_rev_init_seg)
00182   ),
00183   return(length(primes_rev_init_seg)))\$
00184 /*
00185   With memoisation this is computed by first_arithprog_primes(k).
00186 */
00187
00188 greentaod2(k) :=
00189   if k <= 5 then [
00190    1,3,23,512,[34309,inf-1]
00191   ][k]
00192   else unknown\$
00193 /* Remark: These numbers have been verified/computed by SAT solving
00194    methods.
00195 */
00196 greentaod2_a(L) := vanderwaerdend2_a(L)\$
00197
00198
00199 greentaod3(k) :=
00200   if k <= 4 then [
00201    1,4,137,[5250+1,inf-1]
00202   ][k]
00203   else unknown\$
00204 /* Remark: These numbers have been verified/computed by SAT solving
00205    methods.
00206 */
00207 greentaod3_a(L) := vanderwaerdend3_a(L)\$
00208
00209 greentaodap3(m) :=
00210  if m <= 4 then [
00211   4,23,137,[384+1,inf-1]
00212  ][m]
00213  else unknown\$
00214 /* Remark: These numbers have been verified/computed by SAT solving
00215    methods.
00216 */
00217 greentaodap3_a(L) := if emptyp(L) then 0
00218  elseif not lconstant_p(L) then []
00219  elseif first(L)#3 then []
00220  else length(L)\$
00221
00222
00223 /* ************************
00224    * The transversal case *
00225    ************************
00226 */
00227
00228 /* Prerequisites: m >= 0, k >= 1: */
00229 greentaot(m,k) := if m=0 then greentaod1(k)
00230  elseif k=1 then m+1
00231  elseif k=2 then m+2
00232  else block([res : greentaottau(m,k)],
00233   if res#unknown then return(res)
00234   else return(unknown))\$
00235 greentaot_a(L) := vanderwaerdent_a(L)\$
00236
00237 /* Only using the list of transversal numbers: */
00238 greentaottau(m,k) := block([n : 1, t],
00239   t : tau_arithprog_primes(k,n),
00240   while not listp(t) and t <= m do (
00241     n : n+1, t : tau_arithprog_primes(k,n)
00242   ),
00243   if listp(t) then return(unknown) else return(n))\$
00244
00245
00246 /* ******************************************************************
00247    * Transversal numbers of hypergraphs of arithmetic progresssions *
00248    ******************************************************************
00249 */
00250
00251 /* For 3 <= k <= exactk_tau_arithprog_primes we provide initial sequences: */
00252 define_variable(
00253   exactk_tau_arithprog_primes,
00254   10,
00255   fixnum)\$
00256 /* Note that these sequences (for tau_arithprog_primes(k,n)) start with n=1. */
00257
00258 /* The following data has been computed by
00259    "GTTransversalsInc 3 1 0 OutputFile" (i.e.,
00260    using SAT solvers):
00261 */
00262 tau_arithprog_primes_seq[3] : [
00263 0,0,0,1,1,1,2,2,3,3,
00264 3,3,4,5,5,6,6,7,7,7,
00265 8,9,10,10,10,10,10,11,12,13,
00266 13,14,15,15,15,16,16,17,18,19,
00267 19,20,21,21,21,21,22,23,24,25,
00268 25,26,26,26,27,28,29,29,30,30,
00269 31,32,32,32,33,33,33,34,35,36,
00270 37,38,39,39,40,41,41,42,42,43,
00271 44
00272 ]\$
00273 /* The following data has been computed by
00274    "GTTransversalsInc 4 1 0 OutputFile":
00275 */
00276 tau_arithprog_primes_seq[4] : [
00277 0,0,0,0,0,0,0,0,1,1,
00278 1,1,1,2,2,2,3,3,3,3,
00279 3,4,4,4,4,5,5,5,5,5,
00280 5,6,6,6,7,8,9,9,9,9,
00281 9,9,9,9,10,11,11,11,11,11,
00282 12,12,12,12,12,13,13,14,14,14,
00283 15,16,16,16,16,16,16,16,16,16,
00284 17,18,19,19,19,19,19,20,21,21,
00285 21,21,22
00286 ]\$
00287
00288 /* Alternative representations using tau-steplists
00289    (the list contains the last entry where tau=0, 1, ...).
00290 */
00291 /* The following data has been computed by
00292    minimum_transversals_decomp_gen(inf,lambda([n],arithprog_primes_hg(5,n)), 'L5),
00293    and then using transform_steps_l(map(lambda([d],d[4][1]),reverse(L5))).
00294 */
00295 tau_steplist_arithprog_primes_seq[5] : [
00296  9,30,31,48,57,60,61,77,86,97,
00297  106,111,120,122,141,142,148,149,153
00298 ]\$
00299 tau_arithprog_primes_seq[5] : transform_threshold_l(tau_steplist_arithprog_primes_seq[5])\$
00300 /* The following data has been computed by
00301    minimum_transversals_decomp_gen(inf,lambda([n],arithprog_primes_hg(6,n)), 'L6),
00302    and then using transform_steps_l(map(lambda([d],d[4][1]),reverse(L6))).
00303 */
00304 tau_steplist_arithprog_primes_seq[6] : [
00305  36,54,63,70,89,96,124,151,161,178,
00306  200,203,210,211,249,291,292,314,322,326,
00307  340,350,351,359,373,407,423,434,443,470,
00308  478,486,516,518,551,589,592,610,611,642,
00309  646,649,652,665,674,731,743,749,753,754,
00310  777,780,782
00311 ]\$
00312 tau_arithprog_primes_seq[6] : transform_threshold_l(tau_steplist_arithprog_primes_seq[6])\$
00313 /* The following data has been computed by
00314    minimum_transversals_decomp_gen(inf,lambda([n],arithprog_primes_hg(7,n)),'L7),
00315    and then using transform_steps_l(map(lambda([d],d[4][1]),reverse(L7))).
00316 */
00317 tau_steplist_arithprog_primes_seq[7] : [
00318  154,213,227,231,322,395,569,640,714,795,
00319  826,871,874,1047,1124,1157,1179,1187,1303,1342,
00320  1372,1397,1423,1451,1507,1541,1555,1563,1571,1687,
00321  1693,1732,1746,1761,1767,1776,1777,1819,1824,1830,
00322  1852,1902,1953,1960,1978,1979,2027,2190,2197,2264,
00323  2316,2364,2371,2410,2467,2502,2503,2560,2567,2650,
00324  2663,2666,2683,2787,2819,2828,2944,2968,2985,2988,
00325  3025,3028,3038,3096,3128,3139,3166,3169,3173,3178,
00326  3179,3207,3240,3274,3292,3327,3379,3419,3421,3499,
00327  3506,3521,3522,3524,3525,3555,3602,3632,3642,3651,
00328  3659,3667,3753,3767,3801,3811,3880,3886
00329 ]\$
00330 tau_arithprog_primes_seq[7] : transform_threshold_l(tau_steplist_arithprog_primes_seq[7])\$
00331 /* The following data has been computed by
00332    minimum_transversals_decomp_gen(inf,lambda([n],arithprog_primes_hg(8,n)),'L8),
00333    and then using transform_steps_l(map(lambda([d],d[4][1]),reverse(L8))).
00334 */
00335 tau_steplist_arithprog_primes_seq[8] : [
00336  262,348,664,788,1322,1427,1446,1472,1554,1800,
00337  1880,1934,1978,2116,2260,2405,2436,2567,2572,2650,
00338  2815,2869,3139,3214,3240,3246,3252,3323,3396,3457,
00339  3482,3488,3492,3543,3698,3771,3772,3899,3993,4180,
00340  4218,4305,4310,4317,4384,4404,4432,4502,4503,4516,
00341  4817,4991,5011,5023,5156,5260,5439,5442,5507,5578,
00342  5646,5664,5674,5682,5791,5832,5856,5985,6052,6089,
00343  6140,6142,6245,6259,6326,6341,6456,6483,6492,6604,
00344  6624,6702,6748,6805,6809,6867,7038,7042,7046,7201,
00345  7329,7358,7523,7676,7692,7792,7825,7920,7944,8010,
00346  8023,8048,8075,8275,8276,8307,8415,8432,8465,8471,
00347  8657,8712,8715,8752,8779,8807,8895,8958,8976,9031,
00348  9086,9095,9214,9245,9268,9279,9287,9329,9352,9356,
00349  9388,9426,9453,9459,9491,9721,9766,9856,9870,9872,
00350  9875,9888,9896,9917,10001,10003,10118,10137,10200,10243,
00351  10264,10560,10627,10801,10807,10858,10867,10886,10937,10971,
00352  10990,11093,11103,11109,11153,11160,11173,11184,11222,11309,
00353  11358,11488,11495,11509,11577,11637,11646,11678,11704,11724,
00354  11741,11925,12020,12178,12240,12252,12260,12285,12301,12332,
00355  12426,12436,12701,12736,12798,12805,12813,12889,12938,12944,
00356  13051,13109,13171,13192,13199,13221,13241,13340,13445,13451,
00357  13461,13478,13521,13524,13588,13591,13632,13660,13666,13759,
00358  13841,13842,13872,13946,14041,14054,14065,14109,14171,14253,
00359  14255,14272,14389,14440,14547,14553,14565,14598,14608,14685,
00360  14836,15003,15065,15138,15196,15224,15255,15338,15356,15405,
00361  15406,15424,15458,15514,15543,15545,15592,15624,15661,15683,
00362  15749,15763,15767
00363 ]\$
00364 tau_arithprog_primes_seq[8] : transform_threshold_l(tau_steplist_arithprog_primes_seq[8])\$
00365 /* The following data has been computed by
00366    minimum_transversals_decomp_gen(inf,lambda([n],arithprog_primes_hg(9,n)),'L9),
00367    and then using transform_steps_l(map(lambda([d],d[4][1]),reverse(L9))).
00368 */
00369 tau_steplist_arithprog_primes_seq[9] : [
00370  288,689,1452,1496,1522,2021,2498,2822,2914,3314,
00371  3601,3774,4136,4550,4652,4710,4773,5121,5629,5704,
00372  6026,6282,6411,6492,6530,6764,6829,6848,6860,7380,
00373  7728,8330,8377,8504,8519,8530,8572,8700,8877,9043,
00374  9153,9180,9341,9396,9457,9526,9681,9755,10129,10424,
00375  10492,10664,10683,11268,11506,11605,11695,11948,12311,12475,
00376  12959,12980,13336,13414,13541,13667,13895,14068,14205,14270,
00377  14279,14736,14836,15088,15431,15433,15789,15861,15900,15966,
00378  16250,16380,16499,16962,17036,17050,17053,17208,17404,17600,
00379  17612,17620,17650,17936,18073,18219,18384,18463,18481,18559,
00380  18580,18596,18680,18736,18853,18959,19452,19560,19717,20020,
00381  20244,20283,20358,20382,20406,20440,20441,20473,20732,20991,
00382  21003,21144,21456,21627,21659,21732,21747,21753,21851,21913,
00383  21965,22198,22387,22761,22771,22796,22819,22882,23133,23214,
00384  23597,23801,23809,23815,24109,24128,24709,24836,24853,25116,
00385  25338,25722,25771,25846,26015,26183,26327,26605,26691,27237,
00386  27276,27485,27631,28081,28159,28247,28410,28830,28957,29109,
00387  29385,29398,29601,29674,29880,30121,30182,30226,30415,30938,
00388  30962,31023,31024,31080,31110,31161,31299,31760,31817,31952,
00389  31969,32051,32235,32412,32475,32623,32930,33098,33118,33258,
00390  33418,33496,33499,33659,33777,33857,34019,34259,34295,34329,
00391  34585,34997,35020,35319,35466,35487,35527,35656,35774,36000,
00392  36014,36279,36284,36323,36400,36877,37066,37361,37666,37702,
00393  37759,37885,38132,38450,38595,38633,38873,38994,39088,39249,
00394  39521,39525,39560,39620,39676,39681,39683,39699,39883,39926,
00395  40012,40109,40334,40378,40618,40635,40691,41024,41047,41215,
00396  41318,41330,41514,41527,41636,41664,41811,41812,41814,42030,
00397  42102,42200,42324,42409,42639,42766,42776,42872,42911,42957,
00398  43059,43360,43368,43488,43584,43821,43951,44121,44122,44148,
00399  44155,44167,44192,44248,44300,44358,44423,44443,44450,44523,
00400  44620,44698,44718,44740,44918,44927,44979,45100,45143,45272,
00401  45333,45412,45784,45874,46059,46100,46160,46271,46305,46482,
00402  46505
00403 ]\$
00404 tau_arithprog_primes_seq[9] : transform_threshold_l(tau_steplist_arithprog_primes_seq[9])\$
00405 /* The following data has been computed by
00406    minimum_transversals_decomp_gen(inf,lambda([n],arithprog_primes_hg(10,n)),'L10),
00407    and then using transform_steps_l(map(lambda([d],d[4][1]),reverse(L10))).
00408 */
00409 tau_steplist_arithprog_primes_seq[10] : [
00410  315,5481,5743,7293,9457,11896,12650,12743,13461,13560,
00411  13645,16524,16535,16595,19134,19601,21271,23059,23688,24145,
00412  24255,24351,25006,25326,25348,25491,27020,27790,29149,29618,
00413  30162,30700,30833,31088,34889,34940,35244,36443,38331,38791,
00414  38930,39009,39275,39676,40148,40504,41533,41621,42526,43143
00415 ]\$
00416 tau_arithprog_primes_seq[10] : transform_threshold_l(tau_steplist_arithprog_primes_seq[10])\$
00417
00418
00419 /* For n <= exactv_tau_arithprog_primes(k) we have stored exact values
00420    in tau_arithprog_primes_seq[k]: */
00421 exactv_tau_arithprog_primes(k) :=
00422  if k<=2 or k > exactk_tau_arithprog_primes then 0
00423  else length(tau_arithprog_primes_seq[k])\$
00424
00425 /* Exact (trivial) formulas (returns unknown if no exact formula applies;
00426    for natural numbers k, n): */
00427 exactf_tau_arithprog_primes(k,n) :=
00428  if n < k then 0
00429  elseif k=1 then n
00430  elseif k=2 then n-1
00431  else unknown\$
00432 /* The following inclusion enables simplification of for example
00433     exactf_tau_arithprog_primes(k,n):
00434 */
00435 oklib_plain_include(boolsimp)\$
00436
00437 /* The pair of nearest n-value downward and its transversal-value where we have
00438    exact values stored (using only stored *transversal-values* besides the
00439    trivial formulas).
00440    Prerequisite: The exact formulas don't apply (directly).
00441 */
00442 nearest_tau_arithprog_primes(k,n) := block(
00443  [maxn : exactv_tau_arithprog_primes(k)],
00444   if n <= maxn then return([n, tau_arithprog_primes_seq[k][n]])
00445   elseif maxn > 0 then return([maxn, tau_arithprog_primes_seq[k][maxn]])
00446   else return([k-1,0]))\$
00447
00448 /* The best known values (using only stored transversal-values): */
00449 /* Prerequisites: k, n natural numbers >= 1 */
00450 tau_arithprog_primes(k,n) := block([e : exactf_tau_arithprog_primes(k,n)],
00451  if e#unknown then return(e),
00452  block([nn,v],
00453    [nn,v] : nearest_tau_arithprog_primes(k,n),
00454    if nn=n then return(v)
00455    else return([v, (n - nn) + v])))\$
00456
00457
00458 /* *********************************
00459    * Analysing transversal numbers *
00460    *********************************
00461 */
00462
00463 /* The initial sequence of transversal GT-numbers for progression-length k
00464    (as far as there are stored tau-values; the number m of 2's starts with 0).
00465    k natural number >= 0.
00466 */
00467 initial_sequence_GTt(k) :=
00468   if k > exactk_tau_arithprog_primes then [greentaod1(k)]
00469   else create_list(greentaot(m,k),m,0,last(tau_arithprog_primes_seq[k])-1)\$
00470
00471
```