# Lift.txt # Version 2.0 # Ken W. Smith # Created in April 2006. # Last modified May 4, 2006. # To run this program, insert the following Read statement # Read("Lift.txt"); Print("Reading file 'Lift.txt' \n"); # We assume that 'DifSets.txt' has already been loaded. Procedures from # that file will be used here. ############################################################ # Lift( CL, partition, refinement, d_multiset, target, upbound, threshold, printflag ) # This procedure takes Cayley table CL acting on [1..v], # a partition of [1..v], # a refinement of it (another partition on [1..v] with the # property that every class of this partition is a subclass # of the original), # an element 'd_multiset' of the group ring on the set 'partition', # written as a multiset, # a target element, 'target' of the group ring on the set 'refinement' # and computes all solutions D in the refinement space # such that D*D = target where * is the operation of CL. # # A preliminary pass removes all D with entries above upbound. # If printflag = 1 then solutions are printed as they occur. # If printflag = 2 then more details are printed. # # If the number of elements in the OrderedPartition search is above # threshold then the OrderedPartition search is broken into two pieces, # OrdPart1 and OrdPart2. Lift := function( CL, partition, refinement, d_multiset, target, upbound, threshold, printflag ) local c1, d_list_0,d_collected,d_col,d1,d2, halfsize,halfsize2, i,ii,iii,iv,ind1,ind2,ind2rep,j, map, max1, multiplier, odometer, parts, pointer, prod,prod1, prod2, prod1_entry, prod2_entry, size, size_OrdPart, ssq_list, ssq, size_OrdPart1, size_OrdPart2, ssq1, ssq2, ssq1_entry, ssq2_entry, solutions, tar1, tsil, vec, x, y, yi, z, CL_small, CL_small_2, OrdPart, OrdPart_0, OrdPart1, OrdPart2, SizeList, SumSqs1, SumSqs2, SsqPart, Starttime; tar1 := Collected( target )[1][2]; # Value of sum of squares # We use this to trim the OrderedPartition search. solutions := [ ]; if printflag >= 2 then Print("\nBeginning run with\nPartition: ", partition, ".\n"); Print("Refinement: ", refinement,".\n"); Print("d_multiset is ", d_multiset,"\n\n"); fi; ############################################################ # We create a list out of d_multiset; call this list d_col. ############################################################ size := Size( partition ); d_collected := Collected( d_multiset ); d_col := ListWithIdenticalEntries( size, 0 ); for x in d_collected do d_col[ x[1] ] := x[2]; od; ############################################################ # We construct a map from partition to refinement in order # to map the elements in the 'lift' of d_col to # the 'refinement' space. ############################################################ map := MapRefinement( partition, refinement ); if printflag >= 2 then Print("map is ", map,".\n"); fi; ############################################################ # We construct a map from the refined partition which maps # indices to representatives (first elements) ############################################################ ind2rep := IndexToRep( refinement ); if printflag >= 2 then Print("ind2rep is ", ind2rep,".\n"); fi; ############################################################ # We create the "inverse" of ind2rep. I will call this "inverse" tsil. # Since the original list (ind2rep) does not represent an onto function # tsil is a list with holes. ############################################################ tsil:=[ ]; for i in [1..Size( ind2rep )] do tsil[ ind2rep[i]]:=i; od; ############################################################ # We construct a Convolution Table on the quotient group ############################################################ CL_small := QuotientGroupConvolution( CL, refinement ); ############################################################ # and replace the elements in the table by their indices ############################################################ parts := Size( refinement ); CL_small_2 := NullMat( parts, parts ); for i in [1..parts] do for j in [1..parts] do CL_small_2[i][j] := tsil[ CL_small[i][j] ]; od;od; if printflag >= 2 then Print("CL_small_2: \n"); PrintArray(CL_small_2); Print("\n");fi; ############################################################ # Now we create the ordered partitions which will be the basis for our choices ############################################################ # OrdPart will be a list of size equal to 'partition'. # In OrdPart[i] will be all the ways to break down a sum of size # d_multiset[i] into pieces to match refinement. # # SsqPart[i][j] will hold the sums of squares of that part of # the solution, in preparation for a later test on the sums # of squares. OrdPart := [ ]; SsqPart := [ ]; ############################################################ # There are two things added (in late April 2006) to speed up this search # First, we reduce the size of the very first partition. # (Second, later, we will look at sums of squares and target[1].) # We reduce the first OrderedPartition so that the entry for 1 # has the largest values. This can be assumed if we are working # on a problem in which the final solution set is closed under translations. c1 := 1; d_list_0 := [ ]; ssq_list := [ ]; OrdPart_0 := OrderedPartitions( d_col[c1]+Size(map[c1]), Size(map[c1]) ); for y in OrdPart_0 do if Maximum( y ) <= upbound+1 then # Rule out sizes bigger than # coset size vec := [ ]; ssq := 0; if y[1] = Maximum(y) then # Assume 1 occurs most often # in the choices for the first # coset. for i in [1..Size( y )] do yi := y[i]-1; vec := Concatenation( vec, ListWithIdenticalEntries( yi, map[c1][i] ) ); ssq := ssq+yi*yi; od; Add( d_list_0, vec ); Add(ssq_list, ssq); fi; # if y[1] = Maximum fi; od; OrdPart[ c1 ] := d_list_0; SsqPart[ c1 ] := ssq_list; ############################################################ # and now fill in the rest of OrdPart. ############################################################ for c1 in [2..size] do d_list_0 := [ ]; ssq_list := [ ]; OrdPart_0 := OrderedPartitions( d_col[c1]+Size(map[c1]), Size(map[c1]) ); for y in OrdPart_0 do if Maximum( y ) <= upbound+1 then vec := [ ]; ssq := 0; for i in [1..Size( y )] do yi := y[i]-1; vec := Concatenation( vec, ListWithIdenticalEntries( yi, map[c1][i] ) ); ssq := ssq+yi*yi; od; Add( d_list_0, vec ); Add(ssq_list, ssq); fi; od; OrdPart[ c1 ] := d_list_0; SsqPart[ c1 ] := ssq_list; od; if printflag >= 2 then Print("OrdPart is ", OrdPart,"\n");fi; ############################################################ # We determine halfsize, the cutoff for filling in OrdPart, # given by threshold. The parameter 'halfsize' will be # the number of cosets filled in the first pass. ############################################################ halfsize := 1; size_OrdPart := 1; SizeList := [ ]; for c1 in [1..size] do SizeList[c1]:=Size(OrdPart[c1]); size_OrdPart := size_OrdPart * SizeList[c1]; if size_OrdPart < threshold then halfsize := c1; fi; od; SumSqs1 := [ ]; SumSqs2 := [ ]; OrdPart1 := [ ]; OrdPart2 := [ ]; # We have SsqPart and OrdPart. for c1 in [1..halfsize] do OrdPart1[c1] := ShallowCopy( OrdPart[c1] ); SumSqs1[c1] := ShallowCopy( SsqPart[c1] ); od; for c1 in [1..size-halfsize] do OrdPart2[c1] := ShallowCopy( OrdPart[halfsize+c1] ); SumSqs2[c1] := ShallowCopy( SsqPart[halfsize+c1] ); od; size_OrdPart1 := 1; for c1 in [1..halfsize] do size_OrdPart1 := size_OrdPart1*Size(OrdPart1[c1]); od; size_OrdPart2 := 1; for c1 in [1..size-halfsize] do size_OrdPart2 := size_OrdPart2*Size(OrdPart2[c1]); od; Print("Working on OrdPart1, OrdPart2 of sizes ", size_OrdPart1," ", size_OrdPart2,"\n"); prod1 := [ ]; prod2 := [ ]; ssq1 := [ ]; ssq2 := [ ]; ######################################## # 'Odometer' # Here we create 'half-length' arrays from the # first part of OrdPart. # This is to cut down on the computational load # of creating 'prod'. Print("SizeList is ", SizeList, "\n"); odometer := ListWithIdenticalEntries( halfsize, 0 ); pointer := halfsize; max1 := SizeList[1]; # counter is really unnecessary # counter := 0; ############################################################ while odometer[1] < max1 do # counter := counter+1; prod1_entry:= [ ]; ssq1_entry := 0; for iv in [1 .. halfsize] do prod1_entry := Concatenation( prod1_entry, OrdPart1[iv][odometer[iv]+1 ] ); ssq1_entry := ssq1_entry + SumSqs1[ iv][odometer[iv]+1 ]; od; Add( prod1, prod1_entry ); Add( ssq1, ssq1_entry ); # Increase rightmost entry odometer[pointer]:= odometer[pointer]+1; # Carry if needed for j in [0.. halfsize-2] do if odometer[halfsize-j] = SizeList[halfsize-j] then odometer[halfsize-j] := 0; odometer[halfsize-j-1] := odometer[halfsize-j-1]+1; fi; od; od; # while ... do ########## # Now we fill in the second half of the products halfsize2 := size - halfsize; if halfsize2 > 0 then odometer := ListWithIdenticalEntries( halfsize2, 0 ); pointer := halfsize2; max1 := SizeList[halfsize+1]; # counter is really unnecessary # counter := 0; while odometer[1] < max1 do # counter:= counter+1; prod2_entry:= [ ]; ssq2_entry := 0; for iv in [1 .. halfsize2] do prod2_entry := Concatenation( prod2_entry, OrdPart2[iv][odometer[iv]+1 ] ); ssq2_entry := ssq2_entry + SumSqs2[ iv][odometer[iv]+1 ]; od; Add( prod2, prod2_entry ); Add( ssq2, ssq2_entry ); # Increase rightmost entry odometer[pointer]:= odometer[pointer]+1; # Carry if needed for j in [0.. halfsize2-2] do if odometer[ halfsize2-j] = SizeList[ size-j ] then odometer[ halfsize2-j] := 0; odometer[ halfsize2-j-1] := odometer[ halfsize2-j-1]+1; fi; od; # for j in ... od; # while do fi; # if halfsize2 > 0 # Is this next line necessary? if size_OrdPart2 = 1 then ssq2 := [0]; prod2 := [ [ ] ];fi; Starttime:= Runtime(); ############################################################ # Main Loop ############################################################ for ind1 in [1..size_OrdPart1] do # We might print intermediate steps in a long run: if (size_OrdPart2 > 500 and RemInt(ind1, 1000) = 0) then Print("Ind for 1st half is ", ind1,". Time used is ", QuoInt(Runtime()-Starttime, 1000)," secs. \n"); fi; prod1_entry := prod1[ind1]; ssq1_entry := ssq1[ind1]; if ssq1_entry <= tar1 then for ind2 in [1..size_OrdPart2] do prod2_entry := prod2[ind2]; ssq2_entry := ssq2[ind2]; if ssq1_entry + ssq2_entry = tar1 then d1 := Concatenation( prod1_entry, prod2_entry ); # Do I need to flatten and sort? d2 := Flat(d1); Sort(d2); z := Convolution_AsMultiset( CL_small_2, d2, d2 ); if printflag >= 3 then Print("d2, Collected(z): ", d2, " ", Collected(z),"\n"); fi; if z=target then if printflag >= 2 then Print("Solution! ",Collected(d2),"\n"); fi; Add( solutions, d2 ); fi; fi; od; fi; od; # End of main loop ############################################################ return solutions; end; ############################################################