On Mon, Jul 18, 2011 at 2:56 PM, Bill Gosper <billgosper@gmail.com> wrote:
[Veit's packings:> http://milou.msc.cornell.edu/images/ ] [David's packings: http://www2.stetson.edu/~efriedma/cirRcir/ ]
[...] rwg>And my proposed Calculus I problem for "12" is obviated--David finds the optimal Möbius transformation is the identity. He sent the polynomial for the exact Sum(radii), which factors into nasty cubics.
David did not have the exact polynomials for "22", which also factor (over {sqrt 7,(-1)^(1/7)}) down to nasty cubics, tasting which Corey's denester suffers bovine parturition.
rwg>David's packings go all the way to "32", with "31" perhaps the most amazing, for
lack of the D(ihedral)_5 symmetry that "32" almost has. Talk about a sucker bet-- who would believe the "31" concentric shell packing was suboptimal?
Given the consistent superiority of symmetric packings in the smaller
cases, I couldn't resist checking David's numbers by exactly solving the D_5 "31" case, which proved challenging. It's easy to write six trig and pythagorean equations for the six unknown radii, but not so easy (at least for me) to clear the radicals, after which Reduce has been working for days to "univariablize" (triangularize, then back substitute) the six polynomials.
But there's a workaround: Guess the radius equations (they're all degree 20, the one for the center disk being reciprocal) with PSLQ and then vet them with RootReduce, which is even now busily checking that sum(radii) is also degree 20. Stay tuned for algebraic details.
Here are the radii, with a in the center, a+2b+2c+2f being a straight unit radius, with 5*(f+2e) forming a circumference: Dialog) In[37]:= Reduce[% == 0 && .103 < a < .104]
(Dialog) Out[37]= a == Root[5 + 1300 #1 - 4562410 #1^2 - 158581900 #1^3 + 38225760161 #1^4 + 1160154611344 #1^5 - 18558684754040 #1^6 - 313371350668080 #1^7 + 5879514571952986 #1^8 - 28480038103460840 #1^9 + 46379337453065924 #1^10 - 28480038103460840 #1^11 + 5879514571952986 #1^12 - 313371350668080 #1^13 - 18558684754040 #1^14 + 1160154611344 #1^15 + 38225760161 #1^16 - 158581900 #1^17 - 4562410 #1^18 + 1300 #1^19 + 5 #1^20 &, 12] (Dialog) In[39]:= Reduce[% == 0 && .135 < f < .136] (Dialog) Out[39]= f == Root[25 - 500 #1 + 1750 #1^2 + 25500 #1^3 - 212515 #1^4 + 54640 #1^5 + 4636040 #1^6 - 15689360 #1^7 - 7344414 #1^8 + 140378408 #1^9 - 270738940 #1^10 + 33586760 #1^11 + 474875986 #1^12 - 464301520 #1^13 - 117910264 #1^14 + 328645040 #1^15 - 49176379 #1^16 - 77849300 #1^17 + 14927510 #1^18 + 5998332 #1^19 + 113681 #1^20 &, 10] (Dialog) In[41]:= Reduce[ 0 == Factor[FromDigits[Reverse[%33], c]] && .165 < c < .166] (Dialog) Out[41]= c == Root[73205 - 18747740 #1 + 715094070 #1^2 + 23064064580 #1^3 - 786331367119 #1^4 + 5796248169936 #1^5 + 4792674733576 #1^6 - 142870587784176 #1^7 + 18452902010042 #1^8 + 1215888047908344 #1^9 + 1126476379605636 #1^10 - 1456761588689288 #1^11 - 1822788184250246 #1^12 + 219584660326672 #1^13 + 535230298229768 #1^14 - 13386588924720 #1^15 - 49922248180399 #1^16 + 3137833407620 #1^17 + 722640686390 #1^18 - 12243878300 #1^19 + 568405 #1^20 &, 14] (Dialog) In[42]:= Reduce[ 0 == Factor[FromDigits[Reverse[%34], d]] && .167 < d < .168] (Dialog) Out[42]= d == Root[3125 - 16082500 #1 + 2896896750 #1^2 + 1382645545900 #1^3 - 13193777505799 #1^4 - 28497889063888 #1^5 + 266227492070120 #1^6 + 624798231084080 #1^7 - 652264074899494 #1^8 - 2162731990811960 #1^9 + 271595621339156 #1^10 + 2805112554272040 #1^11 + 477596615026026 #1^12 - 1468787123224080 #1^13 - 438563965245080 #1^14 + 225798789317488 #1^15 + 102491645841841 #1^16 + 10564624397660 #1^17 + 411574739630 #1^18 + 5669861260 #1^19 + 8515805 #1^20 &, 16] (Dialog) In[43]:= Reduce[ 0 == Factor[FromDigits[Reverse[%35], e]] && .191 < e < .192] (Dialog) Out[43]= e == Root[125 - 2500 #1 - 26750 #1^2 + 766500 #1^3 - 4279675 #1^4 - 6189200 #1^5 + 122788600 #1^6 - 209492400 #1^7 - 1111141510 #1^8 + 3653981320 #1^9 + 3229414060 #1^10 - 22034344200 #1^11 + 4342203826 #1^12 + 58105460912 #1^13 - 31023449416 #1^14 - 66250711152 #1^15 + 23852953001 #1^16 + 35544549660 #1^17 + 7041286690 #1^18 + 98391300 #1^19 + 42025 #1^20 &, 12] And here is the sum of all 31 radii: (Dialog) In[45]:= RootReduce[ a + 5*(b + c + d + 2*e + f) /. ({%43, %42, %41, %40, %39, %37} /. Equal -> Rule)] (Dialog) Out[45]= Root[-1420422914555742315579237580166767687895 + 986698570134623752019718445500199526980 #1 + 29500554236063157182483620663202840050 #1^2 - 149707320150923789108393415730476553140 #1^3 + 22402939277976882703556106744155369881 #1^4 + 6381306719751558250584122460830478224 #1^5 - 1693700702675487417920500871791330440 #1^6 - 35309349791131700058455860099349520 #1^7 + 38981029246829481827764941759491826 #1^8 - 2122793423456157043515638726091400 #1^9 - 234604932318709661740722122337716 #1^10 + 17199818186413063901717573711400 #1^11 + 672971253568050367752568404186 #1^12 - 36144272641837305041458024880 #1^13 - 1252583495947208761965493960 #1^14 - 8664849523701754438888016 #1^15 + 38200310480412059474501 #1^16 + 455729543056862323300 #1^17 + 811211149087190290 #1^18 + 376509003678700 #1^19 + 14315068205 #1^20 &, 14] They factor over sqrt5 down to 10th, the one for a down to 5th. Does Lagrange's resolvent sextic apply to extension to sqrt5? A full RootReduce vetting would probably take many days. This took nearly an hour: (Dialog) In[44]:= RootReduce[ a + 2*(b + c + f) /. ({%43, %42, %41, %40, %39, %37} /. Equal -> Rule)] (Dialog) Out[44]= 1 And this (stating that five b's surrounf the a) took several hours: (Dialog) In[47]:= RootReduce[ 5 a^4 + 20 a^3 b + 10 a^2 b^2 - 20 a b^3 + b^4 /. ({%37, %40} /. Equal -> Rule)] (Dialog) Out[47]= 0 This is almost certainly the largest polynomial system I've ever solved. With much help from Neil and Corey. And much hindrance from Firefox? OS-X? WRI? It looks likely that sending these two emails doomed the direct Reduce attack on the six polynomials. In the interest of memory, I had jettisoned as many applications as possible. With the Reduce in its 2nd day, I noticed Free Memory bouncing between a scary 9MB and a comfortable 480MB, so I waited for it to be 480, paused Mma, started Firefox (which took about 360), and sent the first half of this email. But while I was typing it, Free Memory continued to disappear, until there was almost none left by the time I clicked Send and closed and quit Firefox! And then Free only went back to 360! Those 120 that disappeared while I was typing didn't come back! These days, does the only way to actually own your own computer require that you run Unix? If this second Firefox foray steals another 120, the Reduce computation is doomed. (After quitting Firefox the first time, there were no processes with names like Firefox and Flash. In fact, the only questionable process > 120MB was JavaApplicationStub, which I thought was part of Mma.)
--rwg
During these calculations, there were several times Mma appeared to be running out of memory, but miraculously didn't. Has Mma actually grown smart enough to check, and make space/speed tradeoffs to avoid disaster?