(* How to do the hexagonal cases *) (* Start with this file on the hexagonal cases *) f[i_] := ( exceptStem = "SHORT/HEX/LP/cplexE.lp"; Initialize[6,i]; Array[(Print[{i, #1}]; WRITEOUTexcept[6,i, Length[GBLregions], #1]) & , Length[AllHex]] ); Map[f,lhexhi]; optText[n_,i_]:= Module[{}, Initialize[n,i]; Array[{"read ", fileText["cplexE.lp",n,i,Length[GBLregions],#], " lp\n", "opt\n" }&, Length[AllHex] ]//StringJoin ]; Module[{vv,stream}, vv = Map[optText[6,#]&,lhexhi]//StringJoin; stream=OpenWrite["SHORT/HEX/cplexE.exec"]; WriteString[stream, "set logfile cplexE.log\n"<> "set preprocessing presolve no\n" ]; WriteString[stream,vv]; Close[stream] ]; (* << SHORT/HEX/cplexE.sum; *) hh = Select[values,#[[1]]>0.4429&] shortHex=Union[Map[#[[3]]&,hh]]; Length[shortHex]==13 type[i_]:= Module[{}, Initialize[6,i]; Map[Length,Select[GBLregions,Length[#]>3&]] ]; nonPent= Select[shortHex,Count[type[#],5]==0&]; Complement[shortHex,nonPent] == {226, 363}; val[i_]:= Map[First,Select[values,#[[3]]==i&]]//Max; (* RUN 2.696-TEST on HEIGHT *) (* Everything that follows for a while is devoted exclusively to the cases with upright quarters *) noups = PSelect[AllHex,Min[#]>0&] == Join[Range[31],Range[47,60]]; NoUprightTypes = Select[hh,Inside[Last[#],noups]&] UprightTypes = Select[hh,!Inside[Last[#],noups]&]; upPair = Map[{#[[3]],#[[5]]}&,UprightTypes]; (* function in MathToCplexPent.m; *) vv=Map[DisplayHexLiftSinglet,Map[First,upPair]//Union]; vv//Max == 0.388174. So all upright diagonals have height at most 2.696. vvu=Map[LPdisplay[ "SHORT/HEX/LP/cplexE.lp6."<>S[#[[3]]]<>".F"<>S[#[[4]]]<>".C"<>S[#[[5]]], "slack{"<>S[#[[4]]]<>"}2696=0\n" ]&, UprightTypes ]; pA= PSelect[vvu,#>0.4429&] == {4, 6, 8, 16, 17, 18, 19, 20, 21, 22, 23, 24, 26, 28, 31, 32, 33, 34}; UprightTypesA = UprightTypes[[pA]]; Note: {Map[#[[3]]&,UprightTypesA],Map[#[[3]]&,NoUprightTypes]}//Flatten//Union == {59, 70, 131, 146, 226, 248}; so at this point there are only these 6 planar maps left. (* try heights *) vvh=Map[(Initialize[6,#[[3]]]; Table[ LPmax[ "SHORT/HEX/LP/cplexE.lp6."<>S[#[[3]]]<>".F"<>S[#[[4]]]<>".C"<>S[#[[5]]], StringVar["y",i], "slack{"<>S[#[[4]]]<>"}2696=0\n" ],{i,1,Max[GBLregions]}]//Max)&, UprightTypesA ]; vvht213=PSelect[vvh,#<2.13&] == {3, 12, 13, 14}; vvhtA = Map[Drop[#,1]&,UprightTypesA[[vvht213]] ]; (* We can use ht213=0 on these *) Band[6,59]= {12,11,16,10,13,4,5,1,2,3}//Sort; Band[6,70]= {18,17,11,12,3,4,13,16,15,14}//Sort; Band[6,104]= {1,2,6, 4,5,10, 11,12}//Sort; Band[6,111]= {1,2,3,4, 10,11,8,9,6,5}//Sort; Band[6,131]={3,4,7,8,9,12,13,16}//Sort; Band[6,146]= {2,4,3,1,10,11,12,9,5,6}//Sort; Band[6,226]= {4,5,10,9, 1,2,3, 8,13,12}//Sort; Band[6,248]= {1500,1501,1,2,3,4,5,9,10,14}//Sort; Band[6,296]= {1500,1501,3,6,7,8,4,5,10,11}//Sort; (* Band[6,302]= {1,2,3,4,6,12,13,14,5,11}//Sort; 6/15/98; *) Band[6,302]= {1500,1501,1,2,3,4}//Sort; (* Band[6,303]= {2,3,9,8,14,13,12,11,4,10}//Sort; 6/15/98; *) Band[6,303]= {1500,1501,3,2,8,9, 14,13,12,11}//Sort; Band[6,310]= {1500,1501,5,4,11,12,2,3,8,9}//Sort; Band[6,363]= {3,10,9,8, 1,4, 2,6,5}//Sort; (* Band[6,385]= {11,12,13,14,1,2,3,4,5,10}//Sort; 6/15/98; *) Band[6,385]= {1500,1501,1,2,3,4,11,13,14}//Sort; branchText[u_]:= Module[{j,h}, h=If[Inside[Drop[u,1],vvhtA],"ht213=0\n",""]; Table[{ "read ",fileText["cplexE.lp",6,u[[3]],u[[4]],u[[5]]]," lp\n", "add \n", "slack{"<>S[u[[4]]]<>"}2696=0\n", h, Branch[Band[6,u[[3]]],j], "end \n", "opt \n" }//StringJoin,{j,1,2^Length[Band[6,u[[3]]]]}] //StringJoin ]; Module[{stream,vv}, vv=Map[branchText,UprightTypesA]//StringJoin; stream=OpenWrite["SHORT/HEX/cplexBu.exec"]; WriteString[stream, "set logfile cplexBu.log\n"<> "set preprocessing presolve no\n" ]; WriteString[stream,vv]; Close[stream]; ]; (* << SHORT/HEX/cplexBu.sum; *) valHex=values; valHexHi=Select[valHex,#[[1]]>0.4429&]; Length[valHexHi]==892 Map[#[[3]]&,valHexHi]//Union == {131, 226, 248}; pHH=Map[Drop[#,1]&,valHexHi]//Union == {{6, 131, 17, 33}, {6, 131, 17, 41}, {6, 131, 17, 68}, {6, 131, 17, 71}, {6, 131, 17, 85}, {6, 131, 17, 88}, {6, 131, 17, 105}, {6, 131, 17, 112}, {6, 131, 17, 114}, {6, 226, 15, 68}, {6, 226, 15, 94}, {6, 248, 16, 66}, {6, 248, 16, 96}} PM[6,226]; PM[6,226].F15.C68. Select[valHexHi,#[[3]]==226&] == {{0.443231, 6, 226, 15, 68}, {0.44323, 6, 226, 15, 94}}; list68 = Select[valHex,#[[3]]==226&&#[[5]]==68&]; Length[list68]==1024; PSelect[list68,#[[1]]>0.4429&] == {1}; Initialize[6,226]; Array[ LPdisplay[ "SHORT/HEX/LP/cplexE.lp6.226.F15.C68", Branch[Band[6,226],1]<> Branch[{6,7,11},#]<> "ht213=0\n"<> (* cf vvhtA *) "slack{15}2696=0\n"]&, 2^3 ]//Max == 0.4399. PM[6,226].F15.C68 done PM[6,226].F15.C94 list94 = Select[valHex,#[[3]]==226&&#[[5]]==94&]; Length[list94]==1024; PSelect[list94,#[[1]]>0.4429&] == {1}; Array[ LPdisplay[ "SHORT/HEX/LP/cplexE.lp6.226.F15.C94", Branch[Band[6,226],1]<> Branch[{6,7,11},#]<> "ht213=0\n"<> (* cf vvhtA *) "slack{15}2696=0\n"]&, 2^3 ]//Max == 0.4399 PM[6,226].F15.C94 done PM[6,226] done (upright cases) PM[6,248]; PM[6,248].F16.C66. Map[Last,Select[valHexHi,#[[3]]==248&]]//Union == {66, 96} list66 = Select[valHex,#[[3]]==248&&#[[5]]==66&]; Length[list66]==1024; PSelect[list66,#[[1]]>0.4429&] == {6, 134}; Initialize[6,248]; Table[Array[ LPmax[ "SHORT/HEX/LP/cplexE.lp6.248.F16.C66", StringVar["y",#], Branch[Band[6,248],{6,134}[[i]]]<> "slack{16}2696=0\n"]&, Max[GBLregions] ],{i,1,2}] //Max == 2.0732350937 Table[Array[ LPdisplay[ "SHORT/HEX/LP/cplexE.lp6.248.F16.C66", Branch[Band[6,248],{6,134}[[i]]]<> Branch[{6, 7, 8, 11, 12, 13},#]<> "ht213=0\n"<> "slack{16}2696=0\n"]&, 2^6], {i,1,2}]//Max == 0.439711 PM[6,248].F16.C66 done PM[6,248].F16.C96. list96 = Select[valHex,#[[3]]==248&&#[[5]]==96&]; Length[list96]==1024; PSelect[list96,#[[1]]>0.4429&] == {2,6}; Initialize[6,248]; Table[Array[ LPmax[ "SHORT/HEX/LP/cplexE.lp6.248.F16.C96", StringVar["y",#], Branch[Band[6,248],{2,6}[[i]]]<> "slack{16}2696=0\n"]&, Max[GBLregions] ],{i,1,2}] //Max == 2.1013850518 Table[Array[ LPdisplay[ "SHORT/HEX/LP/cplexE.lp6.248.F16.C96", Branch[Band[6,248],{2,6}[[i]]]<> Branch[{6, 7, 8, 11, 12, 13},#]<> "ht213=0\n"<> "slack{16}2696=0\n"]&, 2^6], {i,1,2}]//Max == 0.439711 PM[6,248].F16.C96 Now we know that the only hexagonal planar map that might have an upright quarter is PM[6,131]. The branches that appear here are summarized in cplexBu.sum; (#[[3]]==131&&#[[1]]>0.4429&) (* << cplexBu.sum *) Initialize[6,131]; vv=Select[valHex,#[[3]]==131&&#[[1]]>0.4429&]; Map[Drop[#,1]&,vv]//Union === {{6, 131, 17, 33}, {6, 131, 17, 41}, {6, 131, 17, 68}, {6, 131, 17, 71}, {6, 131, 17, 85}, {6, 131, 17, 88}, {6, 131, 17, 105}, {6, 131, 17, 112}, {6, 131, 17, 114}}; (* 114, is new *) cases =Map[Last,%] == {33, 41, 68, 71, 85, 88, 105, 112, 114}; Map[AllHex[[#]]/.VertexSub[17]&,cases]== {{{0, 5, 10}, {0, 5, 11}, {0, 12, 11}, {0, 10, 9, 8, 12}}, {{0, 10, 9}, {0, 9, 8}, {0, 8, 12}, {0, 10, 5, 11, 12}}, {{0, 5, 10}, {0, 5, 11}, {0, 10, 12}, {0, 12, 11}, {10, 9, 8, 12}}, {{0, 5, 10}, {0, 5, 11}, {0, 12, 11}, {9, 8, 12}, {0, 10, 9, 12}}, {{0, 10, 9}, {0, 10, 12}, {0, 9, 8}, {0, 8, 12}, {5, 10, 12, 11}}, {{0, 10, 9}, {0, 9, 8}, {0, 8, 12}, {5, 10, 11}, {0, 10, 11, 12}}, {{0, 5, 10}, {0, 5, 11}, {0, 10, 12}, {0, 12, 11}, {10, 9, 12}, {9, 8, 12}}, {{0, 10, 9}, {0, 10, 12}, {0, 9, 8}, {0, 8, 12}, {5, 10, 11}, {10, 12, 11}}, {{0, 10, 9}, {0, 10, 11}, {0, 9, 12}, {0, 12, 11}, {5, 10, 11}, {9, 8, 12}}}; The automorphism of the graph carries Case 33 -- 41 Case 68 -- 85 Case 71 -- 88 Case 105 -- 112 Case 114 -- 114 So it is enough to look at cases {33,68,71,105,114}; PM[6,131].F17.C33; Initialize[6,131]; bf = "SHORT/HEX/LP/cplexE.lp6.131.F17.C33"; LPdisplay[bf,"slack{17}2696=0\n"]==0.489067 LPdisplay[bf,"slack{17}2696=0\n"<>"slkG{17}55488=0\n"]== 0.466523 AllHex[[33]]/.VertexSub[17]== {{0, 5, 10}, {0, 5, 11}, {0, 12, 11}, {0, 10, 9, 8, 12}}; Map[StringVar["sigE",17,#]&,%]== {sigma{17}50575, sigma{17}55488, sigma{17}62135, sigma{17}106019} (* If the anchored simplex has small faces we have *) LPdisplay[bf,"slack{17}2696=0\n"<>"slkG{17}55488=0\n"<> "slkG{17}50575=0\n"<> "slkG{17}62135=0\n" ]== 0.435644 (* So the anchored simplex has a big face. *) LPdisplay[bf,"slack{17}2696=0\n"<>"slkG{17}55488=0\n"<> (* -0.073 from VI.4.5.7 *) (* -0.137 from VI.4.6.9 (proof) from the quad region , -0.210, but we only need -0.161 of it *) "sigma{17}106019 < -0.161\n"]== 0.442702 PM[6,131].F17.C33, done PM[6,131].F17.C68; Initialize[6,131]; bf = "SHORT/HEX/LP/cplexE.lp6.131.F17.C68"; LPdisplay[bf,"slack{17}2696=0\n"]==0.507304 AllHex[[68]]/.VertexSub[17]== {{0, 5, 10}, {0, 5, 11}, {0, 10, 12}, {0, 12, 11}, {10, 9, 8, 12}}; Map[StringVar["sigE",17,#]&,%]== {sigma{17}50575, sigma{17}55488, sigma{17}61846, sigma{17}62135, sigma{17}171742} LPdisplay[bf,"slack{17}2696=0\n"<>"slkG{17}55488=0\n"]== 0.483764 list = Select[valHex,#[[3]]==131&&#[[5]]==68&]; Length[list]==256; pp=PSelect[list,#[[1]]>0.4429&] ; Length[pp]==119; (* If the anchored simplex has small faces, we have *) LPdisplay[bf,"slack{17}2696=0\n"<>"slkG{17}55488=0\n"<> "slkG{17}50575=0\n"<> "slkG{17}62135=0\n" ]== 0.45455 vv=Map[LPdisplay[bf,Branch[Band[6,131],#]<> "slack{17}2696=0\n"<>"slkG{17}55488=0\n"<> "slkG{17}50575=0\n"<> "slkG{17}62135=0\n" ]&,pp] PSelect[vv,#>0.4429&]== {89} vv[[89]]== 0.444885 pp[[89]]== 212 vv2=Array[LPmax[bf,StringVar["y",#],Branch[Band[6,131],212]<> "slack{17}2696=0\n"<>"slkG{17}55488=0\n"<> "slkG{17}50575=0\n"<> "slkG{17}62135=0\n" ]&,Max[GBLregions]]//Max == 2.040677152 LPdisplay[bf,Branch[Band[6,131],212]<> "slack{17}2696=0\n"<>"slkG{17}55488=0\n"<> "ht213=0\n"<> "slkG{17}50575=0\n"<> "slkG{17}62135=0\n" ] == 0.438174 (* So the anchored simplex has a large face *) LPdisplay[bf,"slack{17}2696=0\n"<>"slkG{17}55488=0\n"<> "sigma{17}61846 < -0.119\n" (* VI.4.5.5 *) ]== 0.414764 PM[6,131].F17.C68, done. PM[6,131].F17.C71; Initialize[6,131]; bf = "SHORT/HEX/LP/cplexE.lp6.131.F17.C71"; LPdisplay[bf,"slack{17}2696=0\n"]==0.484109 LPdisplay[bf,"slack{17}2696=0\n"<>"slkG{17}55488=0\n"]== 0.460792 AllHex[[71]]/.VertexSub[17]== {{0, 5, 10}, {0, 5, 11}, {0, 12, 11}, {9, 8, 12}, {0, 10, 9, 12}} Map[StringVar["sigE",17,#]&,%]== {sigma{17}50575, sigma{17}55488, sigma{17}62135, sigma{17}61693, sigma{17}166982} (* If the anchored simplex has small faces *) LPdisplay[bf,"slack{17}2696=0\n"<>"slkG{17}55488=0\n"<> "slkG{17}50575=0\n"<> "slkG{17}62135=0\n" ]== 0.428824 (* So the anchored simplex has a large face *) LPdisplay[bf,"slack{17}2696=0\n"<>"slkG{17}55488=0\n"<> (* -0.073 from VI.4.5.7 *) (* -0.084 from VI.4.6.11 (proof) -0.157 *) "sigma{17}166982 < -0.157\n" ]== 0.387792 PM[6,131].F17.C71, done PM[6,131].F17.C105; Initialize[6,131]; bf = "SHORT/HEX/LP/cplexE.lp6.131.F17.C105"; LPdisplay[bf,"slack{17}2696=0\n"]==0.499139 LPdisplay[bf,"slack{17}2696=0\n"<>"slkG{17}55488=0\n"]== 0.475599 AllHex[[105]]/.VertexSub[17]== {{0, 5, 10}, {0, 5, 11}, {0, 10, 12}, {0, 12, 11}, {10, 9, 12}, {9, 8, 12}} Map[StringVar["sigE",17,#]&,%]== {sigma{17}50575, sigma{17}55488, sigma{17}61846, sigma{17}62135, sigma{17}61999, sigma{17}61693} (* If the faces of the anchored simplex are small *) LPdisplay[bf,"slack{17}2696=0\n"<>"slkG{17}55488=0\n"<> "slkG{17}50575=0\n"<> "slkG{17}62135=0\n" ]== 0.448727 (* almost *) list = Select[valHex,#[[3]]==131&&#[[5]]==105&]; Length[list]==256; pp=PSelect[list,#[[1]]>0.4429&] ; Length[pp]==150; Map[LPdisplay[bf,Branch[Band[6,131],#]<> "slack{17}2696=0\n"<>"slkG{17}55488=0\n"<> "slkG{17}50575=0\n"<> "slkG{17}62135=0\n" ]&,pp]//Max == 0.435098 (* So a face of the anchored simplex is large *) LPdisplay[bf,"slack{17}2696=0\n"<>"slkG{17}55488=0\n"<> "sigma{17}61846 < -0.119\n" (* VI.4.5.5 *) ]== 0.406599 PM[6,131].F17.C105; PM[6,131].F17.C114; Initialize[6,131]; bf = "SHORT/HEX/LP/cplexE.lp6.131.F17.C114"; LPdisplay[bf,"slack{17}2696=0\n"]==0.463556 list = Select[valHex,#[[3]]==131&&#[[5]]==114&]; Length[list]==256; pp=PSelect[list,#[[1]]>0.4429&] ; Length[pp]==6; Array[LPmax[bf,StringVar["y",#],"slack{17}2696=0\n"]&, Max[GBLregions]]//Max == 2.0886908028 (* so we have ht213=0 *) Table[Map[LPdisplay[bf,Branch[Band[6,131],#]<> Branch[{14,15,11},i]<> "slack{17}2696=0\n"<>"ht213=0\n" ]&,pp],{i,1,2^3}] //Max == 0.43833 PM[6,131].F17.C114; (* no new hypotheses *) PM[6,131].F17 (all cases with uprights are done *)