1############################################################################# 2## 3## 4#W yapb.gi Ferret Package Chris Jefferson 5## 6## Installation file for functions of the Ferret package. 7## 8#Y Copyright (C) 2013-2014 University of St. Andrews, North Haugh, 9#Y St. Andrews, Fife KY16 9SS, Scotland 10## 11 12#### 13# Functions and variables beginning '_YAPB' are only called 14# from C++ by YAPB. 15#### 16 17_YAPB_Globals := []; 18 19# Have a copy of this in each thread in HPCGAP 20# This store references to variables we are using inside ferret, 21# to make sure they don't get garbage collected. 22if IsBound( MakeThreadLocal ) then 23 MakeThreadLocal("_YAPB_Globals"); 24fi; 25 26_YAPB_addRef := function(obj) 27 Add(_YAPB_Globals, obj); 28end; 29 30_YAPB_checkRef := function(obj) 31 return ForAny(_YAPB_Globals, x -> IsIdenticalObj(x, obj)); 32end; 33 34_YAPB_clearRefs := function() 35 _YAPB_Globals := []; 36end; 37 38_YAPB_getPermTo := function(sc, i) 39 local current_perm, current_pos, base_val; 40 base_val := sc.orbit[1]; 41 if not(IsBound(sc.transversal[i])) then 42 return fail; 43 fi; 44 current_perm := sc.transversal[i]; 45 current_pos := i^current_perm; 46 while (current_pos <> base_val) 47 do 48 current_perm := current_perm * sc.transversal[current_pos]; 49 current_pos := i^current_perm; 50 od; 51 return current_perm; 52end; 53 54_YAPB_inGroup := function(p, g) 55 return (p in g); 56end; 57 58_YAPB_isGroupConj := function(p, g) 59 return g^p = g; 60end; 61 62_YAPB_getOrbitPart := function(g, maxval) 63 return OrbitsDomain(Group(g.generators), [1..maxval]); 64end; 65 66_YAPB_getBlockList := function(sc) 67 local blocks, g, orbs, b, o; 68 g := Group(sc.generators); 69 orbs := Orbits(g); 70 blocks := []; 71 for o in orbs 72 do 73 b := RepresentativesMinimalBlocks(g,o); 74 if b[1] <> o then 75 Append(blocks, b); 76 fi; 77 od; 78 79 return List(blocks, x->Orbit(g,Set(x),OnSets)); 80end; 81 82_YAPB_FixedOrbits := function(group, domainsize, fixedpoints) 83 return OrbitsDomain(Stabilizer(group, fixedpoints, OnTuples), [1..domainsize]); 84end; 85 86_YAPB_RepresentElement := function(group, list1, list2) 87 local res; 88 res := RepresentativeAction(group, list1, list2, OnTuples); 89 if(res = fail) then 90 return fail; 91 fi; 92 return ListPerm(res); 93end; 94 95_YAPB_getInfoFerret := function() 96 return InfoLevel(InfoFerret); 97end; 98 99_YAPB_getInfoFerretDebug := function() 100 return InfoLevel(InfoFerretDebug); 101end; 102 103 104_YAPB_fillRepElements := function(G, orb) 105 local val, g, reps, buildorb, gens; 106 reps := []; 107 reps[orb[1]] := (); 108 buildorb := [orb[1]]; 109 gens := GeneratorsOfGroup(G); 110 for val in buildorb do 111 for g in gens do 112 if not IsBound(reps[val^g]) then 113 reps[val^g] := reps[val] * g; 114 Add(buildorb, val^g); 115 fi; 116 od; 117 od; 118 return reps; 119end; 120 121_YAPB_stabTime := 0; 122 123_YAPB_getOrbitalList := function(sc, maxval) 124 local G, cutoff, 125 orb, orbitsG, iorb, graph, graphlist, val, p, i, orbsizes, orbpos, innerorblist, orbitsizes, 126 biggestOrbit, skippedOneLargeOrbit, orbreps, stabtime, timefunc; 127 128 if IsGroup(sc) then 129 G := sc; 130 else 131 G := GroupStabChain(sc); 132 fi; 133 134 cutoff := infinity; 135 136 graphlist := []; 137 orbitsG := Orbits(G,[1..maxval]); 138 139 orbsizes := []; 140 orbpos := []; 141 # Efficently store size of orbits of values 142 for orb in [1..Length(orbitsG)] do 143 for i in orbitsG[orb] do 144 orbsizes[i] := Size(orbitsG[orb]); 145 orbpos[i] := orb; 146 od; 147 od; 148 149 # This gives bad times in 4.8, but I don't really care. Sorry if you ever find this. 150 if IsBoundGlobal("NanosecondsSinceEpoch") then 151 timefunc := ValueGlobal("NanosecondsSinceEpoch"); 152 else 153 timefunc := function() return 0; end; 154 fi; 155 156 stabtime := timefunc(); 157 innerorblist := List(orbitsG, o -> Orbits(Stabilizer(G, o[1]), [1..LargestMovedPoint(G)])); 158 _YAPB_stabTime := _YAPB_stabTime + (timefunc() - stabtime); 159 160 orbitsizes := List([1..Length(orbitsG)], 161 x -> List(innerorblist[x], y -> Size(orbitsG[x])*Size(y))); 162 163 biggestOrbit := Maximum(Flat(orbitsizes)); 164 165 skippedOneLargeOrbit := false; 166 167 for i in [1..Size(orbitsG)] do 168 orb := orbitsG[i]; 169 orbreps := []; 170 for iorb in innerorblist[i] do 171 if (Size(orb) * Size(iorb) = biggestOrbit and not skippedOneLargeOrbit) then 172 skippedOneLargeOrbit := true; 173 else 174 if (Size(orb) * Size(iorb) <= cutoff) and 175 # orbit size unchanged 176 not(Size(iorb) = orbsizes[iorb[1]]) and 177 # orbit size only removed one point 178 not(orbpos[orb[1]] = orbpos[iorb[1]] and Size(iorb) + 1 = orbsizes[iorb[1]]) and 179 # don't want to take the fixed point orbit 180 not(orb[1] = iorb[1] and Size(iorb) = 1) 181 then 182 graph := List([1..LargestMovedPoint(G)], x -> []); 183 if IsEmpty(orbreps) then 184 orbreps := _YAPB_fillRepElements(G, orb); 185 fi; 186 for val in orb do 187 p := orbreps[val]; 188 graph[val] := List(iorb, x -> x^p); 189 od; 190 Add(graphlist, graph); 191 fi; 192 fi; 193 od; 194 od; 195 return graphlist; 196end; 197 198##### 199# END OF FUNCTIONS CALLED FROM C++ CODE 200##### 201 202############################################################################# 203## 204## 205## <#GAPDoc Label="ConStabilize"> 206## <ManSection> 207## <Heading>ConStabilize</Heading> 208## <Func Name="ConStabilize" Arg="object, action" Label="for an object and an action"/> 209## <Func Name="ConStabilize" Arg="object, n" Label="for a transformation or partial perm"/> 210## 211## <Description> 212## In the first form this represents the group which stabilises <A>object</A> 213## under <A>action</A>. 214## The currently allowed actions are OnSets, OnSetsSets, OnSetsDisjointSets, 215## OnSetsTuples, OnTuples, OnPairs and OnDirectedGraph. 216## 217## In the second form it represents the stabilizer of a partial perm 218## or transformation in the symmetric group on <A>n</A> points. 219## 220## Both of these methods are for constructing arguments for the 221## <Ref Func="Solve" /> method. 222## 223## </Description> 224## </ManSection> 225## <#/GAPDoc> 226InstallMethod(ConStabilize, [IsList, IsFunction], 227function(list, op) 228 if op = OnSets then 229 return rec(constraint := "SetStab", 230 arg := list, 231 max := MaximumList(list, 0)); 232 fi; 233 234 if op = OnSetsDisjointSets then 235 return rec(constraint := "SetSetStab", 236 arg := list, 237 max := MaximumList(List(list, x -> MaximumList(x, 0)),0)); 238 fi; 239 240 if op = OnSetsSets then 241 return rec(constraint := "OverlappingSetSetStab", 242 arg := list, 243 max := MaximumList(List(list, x -> MaximumList(x, 0)),0)); 244 fi; 245 246 if op = OnSetsTuples then 247 return rec(constraint := "SetTupleStab", 248 arg := list, 249 max := MaximumList(List(list, x -> MaximumList(x, 0)),0)); 250 fi; 251 252 if op = OnTuples or op = OnPairs then 253 return rec(constraint := "ListStab", 254 arg := list, 255 max := MaximumList(list, 0)); 256 fi; 257 258 if op = OnTuplesTuples then 259 return rec(constraint := "ListStab", 260 arg := Concatenation(list), 261 max := MaximumList(Concatenation(list), 0)); 262 fi; 263 264 if op = OnTuplesSets then 265 return List(list, x -> ConStabilize(x, OnSets)); 266 fi; 267 268 if op = OnDirectedGraph then 269 return rec(constraint := "DirectedGraph", 270 arg := list, 271 max := Length(list)); 272 fi; 273 274 if op = OnEdgeColouredDirectedGraph then 275 return rec(constraint := "EdgeColouredDirectedGraph", 276 arg := list, 277 max := Length(list)); 278 fi; 279 280 Error("Do not understand:", op); 281end); 282 283InstallMethod(ConStabilize, [IsList, IsFunction, IsRecord], 284 function(list, op, useroptions) 285 local con, options; 286 287 if Size(RecNames(useroptions)) = 0 then 288 return ConStabilize(list, op); 289 fi; 290 291 if op = OnEdgeColouredDirectedGraph then 292 con := rec(constraint := "EdgeColouredDirectedGraph", 293 arg := list, 294 max := Length(list)); 295 elif op = OnDirectedGraph then 296 con := rec(constraint := "DirectedGraph", 297 arg := list, 298 max := Length(list)); 299 else 300 ErrorNoReturn("No record argument allowed for " + op); 301 fi; 302 303 useroptions := _FerretHelperFuncs.fillUserValues( 304 rec(start_path_length := 1, 305 normal_path_length := 1), useroptions); 306 307 con.start_path_length := useroptions.start_path_length; 308 con.normal_path_length := useroptions.normal_path_length; 309 310 return con; 311 end); 312 313 314 315InstallMethod(ConStabilize, [IsPosInt, IsFunction], 316function(i, op) 317 if op = OnPoints then 318 return rec(constraint := "SetStab", 319 arg := [i], 320 max := i); 321 fi; 322 323 Error("Do not understand:", op); 324end); 325 326InstallMethod(ConStabilize, [IsTransformation, IsPosInt], 327function(t, i) 328 return ConStabilize(List([1..i], x -> [x^t]), OnDirectedGraph); 329end); 330 331InstallMethod(ConStabilize, [IsPartialPerm, IsPosInt], 332function(pp, m) 333 local l, i; 334 l := List([1..m], x -> []); 335 for i in [1..m] do 336 if i^pp <> 0 then 337 Add(l[i], i^pp); 338 fi; 339 od; 340 return ConStabilize(l, OnDirectedGraph); 341end); 342 343############################################################################# 344## 345## 346## <#GAPDoc Label="ConInGroup"> 347## <ManSection> 348## <Func Name="ConInGroup" Arg="G"/> 349## 350## <Description> 351## Represents the permutation group <A>G</A>, as an argument for 352## <Ref Func="Solve" />. 353## </Description> 354## </ManSection> 355## <#/GAPDoc> 356InstallMethod(ConInGroup, [IsPermGroup], 357function(G) 358 return ConInGroup(G, rec() ); 359end); 360 361# Inefficient, StabChain, BlockStabChain, OrbStabChain, BlockOrbStabChain, UnorderedStabChain 362 363InstallMethod(ConInGroup, [IsPermGroup, IsRecord], 364function(G, useroptions) 365 366 useroptions := _FerretHelperFuncs.fillUserValues( 367 rec(orbits := "always", blocks := "never", orbitals := "never"), useroptions); 368 369 # We special case the identity group, because it is a pain 370 if IsTrivial(G) then 371 return rec(constraint:="FixAllPoints", max := 1); 372 else 373 return rec(constraint:= "Generators_StabChain", 374 arg := G, 375 orbits := useroptions.orbits, 376 blocks := useroptions.blocks, 377 orbitals := useroptions.orbitals, 378 max := LargestMovedPoint(G)); 379 fi; 380end); 381 382 383InstallGlobalFunction( OnDirectedGraph, function(graph, perm) 384 local newgraph, list, i, j; 385 newgraph := []; 386 for i in [1..Length(graph)] do 387 list := []; 388 for j in [1..Length(graph[i])] do 389 Add(list, (graph[i][j])^perm); 390 od; 391 if i^perm > Length(graph) then 392 ErrorNoReturn("perm invalid on graph"); 393 fi; 394 newgraph[i^perm] := Set(list); 395 od; 396 return newgraph; 397end ); 398 399InstallGlobalFunction( OnEdgeColouredDirectedGraph, function(graph, perm) 400 local newgraph, list, i, j; 401 newgraph := []; 402 for i in [1..Length(graph)] do 403 list := []; 404 for j in [1..Length(graph[i])] do 405 Add(list, [(graph[i][j][1])^perm, graph[i][j][2]]); 406 od; 407 if i^perm > Length(graph) then 408 ErrorNoReturn("perm invalid on graph"); 409 fi; 410 newgraph[i^perm] := Set(list); 411 od; 412 return newgraph; 413end ); 414 415_FERRET_DEFAULT_OPTIONS := MakeImmutable(rec(searchValueHeuristic := "RBase", 416 searchFirstBranchValueHeuristic := "RBase", 417 rbaseCellHeuristic := "smallest", 418 rbaseValueHeuristic := "smallest", 419 stats := false, 420 nodeLimit := false, 421 recreturn := false, 422 only_find_generators := true, 423 just_rbase := false 424 )); 425 426############################################################################# 427## 428## 429## <#GAPDoc Label="Solve"> 430## <ManSection> 431## <Func Name="Solve" Arg="constraints [,rec]"/> 432## 433## <Description> 434## Finds the intersection of the list <A>constraints</A>. 435## 436## Each member of <A>constraints</A> should be a group or coset 437## generated by one of <Ref Func="ConInGroup" /> or 438## ConStabilize. 439## 440## The optional second argument allows configuration options to be 441## passed in. These follow options are supported: 442## 443## <List> 444## <Mark><C>rbaseCellHeuristic</C> (default "smallest")</Mark> 445## <Item> 446## The cell to be branched on. This is the option which will most 447## effect the time taken to search. the default is usually best. 448## 449## Other options are: "First" (first cell), "Largest" (largest cell), 450## "smallest2" (the 2nd smallest cell), "random" (a random cell) 451## and "randomsmallest" (one of the smallest cells, choosen randomly) 452## </Item> 453## <Mark><C>rbaseValueHeuristic</C> (default "smallest")</Mark> 454## <Item> 455## Choose which cell to branch on within a cell. While this will 456## generally make a big difference to search, it is hard to predict 457## the best value, and small changes to the problem will change the 458## best heuristic. Options are the same as <C>rbaseCellHeuristic</C>. 459## </Item> 460## <Mark><C>searchValueHeuristic</C> (default <K>RBase</K>)</Mark> 461## <Item> 462## The order to branch during search. In general the best order 463## is very hard to predict. Options are "RBase", "InvRBase", 464## "Random", "Sorted" or "Nosort" (which uses the order the values 465## naturally end up in by the algorithm). 466## </Item> 467## <Mark><C>searchFirstBranchValueHeuristic</C> (default <K>RBase</K>)</Mark> 468## <Item> 469## Choose the search order used just on the left-most branches of 470## search. Allows the same options as <C>searchValueHeuristic</C> 471## </Item> 472## <Mark><C>stats</C> (default <C>false</C>)</Mark> 473## <Item> 474## Change the return value to provide a range of information about how 475## search performed (implies <C>recreturn</C>). This information will 476## change between releases. 477## </Item> 478## <Mark><C>nodeLimit</C> (default <C>false</C>) </Mark> 479## <Item> 480## Either <B>false</B>, or an integer which places a limit on the amount 481## of search which should be performed. WARNING: When this option is set 482## to an integer, Ferret will return the current best answer when the limit 483## is reached, which may be a subgroup of the actual result. To know if this 484## limit was reached, set <C>stats</C> to <B>true</B>, and check the nodes. 485## </Item> 486## <Mark><C>recreturn</C> (default <C>false</C>) </Mark> 487## <Item> 488## Return a record containing private information, rather than the group. 489## </Item> 490## <Mark><C>only_find_generators</C> (default <C>true</C>)</Mark> 491## <Item> 492## By default only find the generators of the group. If false, then 493## find all members of the group. This option is only useful for testing. 494## If 'true', then sets 'recreturn' to true. 495## </Item> 496## </List> 497## 498## 499## </Description> 500## </ManSection> 501## <#/GAPDoc> 502InstallGlobalFunction( Solve, function( arg ) 503 local maxpoint, record, l, options, useroptions, 504 constraints, name, buildStabChain, retgrp; 505 l := Length(arg); 506 if l = 0 or l > 2 then 507 Error( "usage: Solve(<C>[, <options>])"); 508 fi; 509 510 constraints := Filtered(Flat(arg[1]), x -> x.max > 0); 511 512 if Length(constraints) = 0 then 513 Error("Cannot create infinite group in Solve"); 514 fi; 515 516 maxpoint := Maximum(List(constraints, x -> x.max)); 517 518 # YAPB++ requires at least 2 points. We solve this in this way 519 # because it makes sure we return all the various things 520 # users might want (an rbase, etc). 521 if maxpoint < 2 then 522 Add(constraints, rec(constraint:="FixAllPoints", max := 2)); 523 maxpoint := 2; 524 fi; 525 526 if l = 2 then 527 useroptions := arg[2]; 528 else 529 useroptions := rec(); 530 fi; 531 532 options := _FerretHelperFuncs.fillUserValues(_FERRET_DEFAULT_OPTIONS, 533 useroptions); 534 535 options.size := maxpoint; 536 537 if options.stats or options.just_rbase then 538 options.recreturn := true; 539 fi; 540 541_YAPB_stabTime := 0; 542 record := YAPB_SOLVE(constraints, options); 543 if IsBound(record.timing) then 544 record.timing[1].stabInOrbFinding := _YAPB_stabTime; 545fi; 546 _YAPB_clearRefs(); 547 548 # We now stitch together a stabilizer chain from the return values of YAPB++ 549 buildStabChain := function(gens, gen_map) 550 local sc, current_val, start_of_range, i; 551 current_val := gen_map[1][1]; 552 start_of_range := 1; 553 sc := EmptyStabChain(gens, ()); 554 for i in [2..Length(gen_map)] do 555 if gen_map[i][1] <> current_val then 556 InsertTrivialStabilizer(sc, current_val); 557 AddGeneratorsExtendSchreierTree(sc, gens{[start_of_range..i-1]}); 558 current_val := gen_map[i][1]; 559 start_of_range := i; 560 fi; 561 od; 562 InsertTrivialStabilizer(sc, current_val); 563 AddGeneratorsExtendSchreierTree(sc, gens{[start_of_range..Length(gens)]}); 564 return sc; 565 end; 566 567 if options.recreturn then 568 return record; 569 else 570 if record.generators = [()] then # just to avoid having to make code work in this case 571 retgrp := Group(()); 572 StabChainMutable(retgrp); 573 else 574 retgrp := Group(record.generators); 575 SetStabChainMutable(retgrp, buildStabChain(record.generators, record.generators_map)); 576 fi; 577 578 Size(retgrp); 579 return retgrp; 580 fi; 581 582end ); 583 584InstallGlobalFunction( SolveCoset, function( arg ) 585 local maxpoint, record, l, options, useroptions, 586 cCommon, cLeft, cRight, name, buildStabChain, retgrp; 587 l := Length(arg); 588 if l <> 3 and l <> 4 then 589 Error( "usage: Solve(<C-Common>, <C-Left>, <C-Right> [, <options>])"); 590 fi; 591 592 cCommon := Filtered(Flat(arg[1]), x -> x.max > 0); 593 cLeft := Flat(arg[2]); 594 cRight := Flat(arg[3]); 595 596 if Length(cLeft) <> Length(cRight) then 597 Error("Length(cLeft) must equal Length(cRight)"); 598 fi; 599 600 if Length(cCommon) = 0 and Length(cLeft) = 0 then 601 Error("Must have an least one constraint"); 602 fi; 603 604 maxpoint := Maximum(List(Flat([cCommon, cLeft, cRight]), x -> x.max)); 605 606 if l = 2 then 607 useroptions := arg[2]; 608 else 609 useroptions := rec(); 610 fi; 611 612 options := _FerretHelperFuncs.fillUserValues(_FERRET_DEFAULT_OPTIONS, 613 useroptions); 614 615 options.size := maxpoint; 616 617 if options.stats or options.just_rbase then 618 options.recreturn := true; 619 fi; 620 621 record := YAPB_SOLVE_COSET(cCommon, cLeft, cRight, options); 622 _YAPB_clearRefs(); 623 624 # We now stitch together a stabilizer chain from the return values of YAPB++ 625 buildStabChain := function(gens, gen_map) 626 local sc, current_val, start_of_range, i; 627 current_val := gen_map[1][1]; 628 start_of_range := 1; 629 sc := EmptyStabChain(gens, ()); 630 for i in [2..Length(gen_map)] do 631 if gen_map[i][1] <> current_val then 632 InsertTrivialStabilizer(sc, current_val); 633 AddGeneratorsExtendSchreierTree(sc, gens{[start_of_range..i-1]}); 634 current_val := gen_map[i][1]; 635 start_of_range := i; 636 fi; 637 od; 638 InsertTrivialStabilizer(sc, current_val); 639 AddGeneratorsExtendSchreierTree(sc, gens{[start_of_range..Length(gens)]}); 640 return sc; 641 end; 642 643 if options.recreturn then 644 return record; 645 else 646 if record.generators = [()] then # just to avoid having to make code work in this case 647 retgrp := Group(()); 648 StabChainMutable(retgrp); 649 else 650 retgrp := Group(record.generators); 651 SetStabChainMutable(retgrp, buildStabChain(record.generators, record.generators_map)); 652 fi; 653 654 Size(retgrp); 655 return retgrp; 656 fi; 657 658end ); 659#E files.gi . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here 660