Anforderungen  |   Konzepte  |   Entwurf  |   Entwicklung  |   Qualitätssicherung  |   Lebenszyklus  |   Steuerung
 
 
 
 


Quelle  blockdesign.g   Sprache: unbekannt

 
Spracherkennung für: .g vermutete Sprache: Unknown {[0] [0] [0]} [Methode: Schwerpunktbildung, einfache Gewichte, sechs Dimensionen]

############################################################################
##
##    blockdesign.g             Design 1.8.2 Package         Leonard Soicher
##
##
# Functions to study, construct and classify (sub)block designs 
# with given properties, and to partition block designs into 
# block designs with given properties.
# At present there is limited support for non-binary block designs.

# Copyright (C) 2003-2024 Leonard H. Soicher
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#

BindGlobal("DESIGN_VERSION",InstalledPackageVersion("design"));
BindGlobal("DESIGN_INDETERMINATE_RATIONALS_1",Indeterminate(Rationals,1));

BindGlobal("IsSylowTowerGroupOfSomeComplexion",function(G)
#
# Suppose  G  is a finite group, and  p_1,...,p_k  are the distinct 
# (positive) primes dividing |G|, in some order. We say that 
# G is a *Sylow tower group of complexion* (p_1,...,p_k) if 
# G has a normal series 1=T_0<T_1<...<T_n=G such that, for 
# i=1,...,n, T_i/T_{i-1} is isomorphic to a Sylow p_i-subgroup
# of G.  
#
# This function returns  true  if G is a Sylow tower group of some complexion; 
# else  false  is returned. 
#
# See: L.H. Soicher, On classifying objects with specified groups of
# automorphisms, friendly subgroups, and Sylow tower groups, Port. Math. 74
# (2017), 233-242.

local P,T,U,indices,usedindices,found,i;
if not IsGroup(G) or not IsFinite(G) then
   Error("<G> must be a finite group");
fi;
if IsNilpotentGroup(G) then
   return true;
elif not IsSolvableGroup(G) then 
   return false;
fi;
P:=List(Reversed(Set(FactorsInt(Size(G)))),p->SylowSubgroup(G,p));
T:=TrivialSubgroup(G); 
indices:=[1..Length(P)];
usedindices:=[];
while Length(usedindices)<Length(indices)-1 do
   #
   # Loop invariant: T is a normal subgroup of G,
   # and T is a Sylow tower group of complexion 
   # (p_{j_1},...,p_{j_m}), where  usedindices=[j_1,...,j_m],
   # and P[j] is a Sylow p_j-subgroup of G for j=1,...,Length(indices).
   #
   found:=false;
   for i in Difference(indices,usedindices) do
      U:=ClosureGroup(T,P[i]);
      if IsNormal(G,U) then
         found:=true;
         T:=U;
         Add(usedindices,i);
         break;
      fi;
   od;
   if not found then
      return false;
   fi;
od;
return true;
end);

BindGlobal("OnMultisetsRecursive",function(x,g)
#
# Action on multisets of multisets of ... of multisets of points.
# A multiset is given as a sorted list (of multisets or points).
#
local onmultisetsrecursive;

onmultisetsrecursive := function(x,g) 
local C;
if not IsList(x) then
   # x is a point
   return x^g;
fi;
C:=List(x,y->onmultisetsrecursive(y,g));
Sort(C);
return C;
end;

return onmultisetsrecursive(x,g);
end);

BindGlobal("HasLargerEntry",function(v,w)
#
# This boolean function assumes that v and w are equal-length integer vectors,
# and returns true iff v[i]>w[i] for some 1<=i<=Length(v).
#
local i;
for i in [1..Length(v)] do
   if v[i]>w[i] then
      return true;
   fi;
od;
return false;
end);

BindGlobal("BlockIntersectionPolynomial",function(x,m,lambdavec)
#
# Suppose  x  is a rational number or an indeterminate over the rationals, 
# and  m  and  lambdavec  are non-empty lists whose elements are rational 
# numbers  (and/or indeterminates over the rationals), such that 
# Length(lambdavec)<=Length(m). 

# Then this function returns the block intersection polynomial 
# B(x) = B(x,m,lambdavec),  defined in:
# P.J. Cameron and L.H. Soicher, Block intersection polynomials, 
# Bull. London Math. Soc. 39 (2007), 559-564.

local P,s,t,s1,s2,i,j;

P := function(x,k)
local prod,i;
prod:=1*x^0;
for i in [0..k-1] do
   prod:=prod*(x-i);
od;
return prod;
end;

if not ((IsRat(x) or IsPolynomialFunction(x)) and IsList(m) and IsList(lambdavec)) then
   Error("usage: BlockIntersectionPolynomial( <Rat> or <PolynomialFunction>, <List>, <List> )");
fi;
if m=[] or lambdavec=[] or Length(lambdavec)>Length(m) then
   Error("must have <m> and <lambdavec> non-empty, and Length(<lambdavec>)<=Length(<m>)");
fi;
if not ForAll(m,x->IsRat(x) or IsPolynomialFunction(x)) then
   Error("elements of <m> must be rationals or polynomials over the rationals");
fi;
if not ForAll(lambdavec,x->IsRat(x) or IsPolynomialFunction(x)) then
   Error("elements of <lambdavec> must be rationals or polynomials over the rationals");
fi;
s:=Length(m)-1;
t:=Length(lambdavec)-1;
s1:=0*x^0;
for j in [0..t] do
   s2:=0*x^0;
   for i in [j..s] do
      s2:=s2+P(i,j)*m[i+1];
   od;
   s1:=s1+Binomial(t,j)*P(-x,t-j)*(P(s,j)*lambdavec[j+1]-s2);
od;
return s1;
end);

BindGlobal("BlockIntersectionPolynomialCheck",function(m,lambdavec)
#
# Suppose  m  is a list of non-negative integers,
# and  lambdavec  is a list of non-negative rational numbers,
# with Length(lambdavec) odd, and Length(lambdavec)<=Length(m). 

# Then this function checks whether the block intersection polynomial 
# B(x,m,lambdavec) is a polynomial over the integers and 
# has a non-negative value whenever x is an integer. 
# Returns true if all this is so; else false is returned.
#
local c,x,B,D,i,xmin,closestintxmin;
if not IsList(m) or not IsList(lambdavec) then
   Error("usage: BlockIntersectionPolynomialCheck( <List>, <List> )");
fi;
if Length(lambdavec) mod 2 = 0 or Length(lambdavec)>Length(m) then
   Error("Length(<lambdavec>) must be odd and at most Length(<m>)");
fi;
if not ForAll(m,x->IsInt(x) and x>=0) then
   Error("elements of <m> must be non-negative integers");
fi;
if not ForAll(lambdavec,x->IsRat(x) and x>=0) then
   Error("elements of <lambdavec> must be non-negative rationals");
fi;
x:=DESIGN_INDETERMINATE_RATIONALS_1;
B:=BlockIntersectionPolynomial(x,m,lambdavec);
c:=ShallowCopy(CoefficientsOfUnivariatePolynomial(B));
if Length(c)=0 then
   # B is the zero polynomial
   return true;
elif not ForAll(c,IsInt) then
   return false;
elif c[Length(c)]<0 or c[1]<0 or Length(c) mod 2 = 0 then
   # B has negative leading coef or B(0)<0 or B has odd degree.
   return false;
elif Length(c)=1 then
   # B is a constant positive polynomial.
   return true;
elif Length(c)=3 then
   # B is a quadratic with positive leading term.
   # Handle this case as suggested by Rhys Evans.
   xmin:=-c[2]/(2*c[3]); #  B has minimum value at xmin. 
   closestintxmin:=BestQuoInt(NumeratorRat(xmin),DenominatorRat(xmin));
   return Value(B,closestintxmin)>=0;
fi;
# Now apply the bound in [Soicher, MCompSci Thesis] to the absolute
# values of the zeros of B.  See also:  
# P.J. Cameron and L.H. Soicher, Block intersection polynomials, 
# Bull. London Math. Soc. 39 (2007), 559-564.
for i in [1..Length(c)-1] do
   c[i]:=-AbsoluteValue(c[i]);
od;
D:=UnivariatePolynomial(Rationals,c,1);
i:=1;
while Value(D,i)<=0 do
   if Value(B,i)<0 or Value(B,-i)<0 then
      return false;
   fi;
   i:=i+1;
od;
return true;
end);

BindGlobal("PartialDesignCheck",function(designinfo,block,blockbags)
#
# This boolean function returns  false  only if  blockbags  
# (and the points involved in blockbags) cannot be a subdesign 
# of a design with the given  designinfo  and  block.  
# Note: block must be in blockbags.  
#
local s,lambdavec,m,c,bag,intsize;
if not ForAny(blockbags,x->x.comb=block) then
   Error("<block> must be a block in a bag in <blockbags>");
fi;
s:=Length(block); # s>0
lambdavec:=ShallowCopy(designinfo.lambdavec);
if Length(lambdavec)<3 then
   if Length(lambdavec)=0 or not IsBound(designinfo.lambdamat) then
      Error("this should not happen");
   fi;
   if Length(lambdavec)=1 then
      lambdavec[2]:=Sum(List(block,i->designinfo.lambdamat[i][i]))/s;
   fi;
   # at this point, Length(lambdavec)=2
   if s>1 then
      lambdavec[3]:=0;
      for c in Combinations(block,2) do
         lambdavec[3]:=lambdavec[3]+designinfo.lambdamat[c[1]][c[2]];
      od;
      lambdavec[3]:=lambdavec[3]/Binomial(s,2);
   fi;
fi;
if Length(lambdavec)>s+1 then
   lambdavec:=lambdavec{[1..s+1]};
fi;
if Length(lambdavec) mod 2 = 0 then
   lambdavec:=lambdavec{[1..Length(lambdavec)-1]};
fi;
m:=ListWithIdenticalEntries(s+1,0);
for bag in blockbags do    
   intsize:=Size(Intersection(bag.comb,block));
   m[intsize+1]:=m[intsize+1]+bag.mult;
od;
if IsBound(designinfo.blockmmat) and IsBound(designinfo.blockmmat[s]) then
   # designinfo.blockmmat[s] is an integer vector of length s+1 and 
   # designinfo.blockmmat[s][i] is a lower bound on the number
   # of blocks intersecting a block of size s in exactly i-1 points.
   m:=List([1..s+1],i->Maximum(m[i],designinfo.blockmmat[s][i]));
fi;
return BlockIntersectionPolynomialCheck(m,lambdavec);
end);

BindGlobal("CC_PermutationGroupProperties",function(G,n)
#
# Determines the properties rank, isGenerouslyTransitive, isMultiplicityFree,
# and isStratifiable of the permutation group  G  acting on [1..n].
#
local prop,A,P,PP,i,j;
if not IsPermGroup(G) or not IsInt(n) then
   Error("usage: CC_PermutationGroupProperties( <PermGroup>, <Int> )");
fi;   
prop:=rec();
if not IsTransitive(G,[1..n]) then
   prop.rank:=Length(Orbits(G,Cartesian([1..n],[1..n]),OnTuples));
   prop.isGenerouslyTransitive:=false;
   prop.isMultiplicityFree:=false;
   prop.isStratifiable:=false;
   return prop;
fi;
A:=OrbitalGraphColadjMats(G);
prop.rank:=Length(A);
prop.isGenerouslyTransitive:=ForAll([1..Length(A)],i->A[i][i][1]=1);
if prop.isGenerouslyTransitive then
   prop.isMultiplicityFree:=true;
   prop.isStratifiable:=true;
   return prop;
fi;
P:=List(A,TransposedMat); 
# P  is a list of the intersection matrices in the order determined by  A.
prop.isMultiplicityFree:=ForAll(Combinations(P,2),x->x[1]*x[2]=x[2]*x[1]);
if prop.isMultiplicityFree then
   prop.isStratifiable:=true;
   return prop;
fi;
PP:=[];
for i in [1..Length(A)] do
   j:=First([i..Length(A)],j->A[i][j][1]=1); 
   # The orbital corresponding to A[i] is paired with that corresp. to A[j].
   if j<>fail then
      if j=i then 
         # A[i] correpsonds to a self-paired orbital.
         Add(PP,P[i]);
      else
         Add(PP,P[i]+P[j]);
      fi; 
   fi;   
od;   
prop.isStratifiable:=ForAll(Combinations(PP,2),x->x[1]*x[2]=x[2]*x[1]);
return prop;
end);

BindGlobal("IsBlockDesign",function(D)
if not (IsRecord(D) and IsBound(D.isBlockDesign) and D.isBlockDesign=true) then 
   return false;
fi;
# Now perform some easy checks.
# More complete checking is done by the function  BlockDesign.
if not (IsBound(D.v) and IsInt(D.v) and D.v>0) then
   Error("<D>.v must be a positive integer");
fi;
if not (IsBound(D.blocks) and IsList(D.blocks) and D.blocks<>[]) then
   Error("<D>.blocks must be a non-empty (sorted) list");
fi;
if not ForAll(D.blocks,x->Length(x)>0) then
   # We do not allow empty blocks.
   Error("Each block must be a non-empty (sorted) list");
fi;
return true;
end);

BindGlobal("BlockDesign",function(arg)
#
# Let  v=arg[1],  blocks=arg[2],  and  G=arg[3]  (default: Group(())). 
# Then this function returns the block design with point-set {1,...,v},
# and whose block-list is the sorted concatenation of the G-orbits of the
# the elements of  blocks. 
#
# Note: It is no longer required that  blocks  be sorted.
#
local v,block,blocks,G,newblocks;
v:=arg[1];
blocks:=arg[2];
if IsBound(arg[3]) then 
   G:=arg[3];
else
   G:=Group(());
fi;
if not (IsInt(v) and IsList(blocks) and IsPermGroup(G)) then
   Error("usage: BlockDesign( <Int>, <List> [, <PermGroup> ] )");
fi;
if v<1 then
   Error("<v> must be positive");
fi;
if v<LargestMovedPoint(GeneratorsOfGroup(G)) then 
   Error("<G> must be a permutation group on [1..<v>]");
fi;
if blocks=[] then
   Error("<blocks> must be non-empty");
fi;
if not ForAll(blocks,x->x<>[] and IsSortedList(x)) then
   Error("each element of <blocks> must be a non-empty sorted list");
fi;
if not IsSubset([1..v],Set(Flat(blocks))) then
   Error("not all elements of <blocks> are in [1..<v>]");
fi;
if IsTrivial(G) then
   return rec(isBlockDesign:=true, v:=v, blocks:=AsSortedList(blocks));
fi;
# Now handle the case where G is nontrivial.
newblocks:=[];
for block in blocks do 
   if IsSet(block) then
      Append(newblocks,Orbit(G,block,OnSets));
   else 
      Append(newblocks,Orbit(G,block,OnMultisetsRecursive));
   fi;
od;
return rec(isBlockDesign:=true, v:=v, blocks:=AsSortedList(newblocks),
   autSubgroup:=G);
end);

BindGlobal("BlockDesignPoints",function(D)
if not IsBlockDesign(D) then
   Error("usage: BlockDesignPoints( <BlockDesign> )");
fi;
return Immutable([1..D.v]);
end); 

BindGlobal("BlockDesignBlocks",function(D)
if not IsBlockDesign(D) then
   Error("usage: BlockDesignBlocks( <BlockDesign> )");
fi;
return Immutable(D.blocks);
end); 

BindGlobal("NrBlockDesignPoints",function(D)
if not IsBlockDesign(D) then
   Error("usage: NrBlockDesignPoints( <BlockDesign> )");
fi;
return D.v;
end); 

BindGlobal("NrBlockDesignBlocks",function(D)
if not IsBlockDesign(D) then
   Error("usage: NrBlockDesignBlocks( <BlockDesign> )");
fi;
return Length(D.blocks);
end); 

BindGlobal("IsBinaryBlockDesign",function(D)
if not IsBlockDesign(D) then
   Error("usage: IsBinaryBlockDesign( <BlockDesign> )");
fi;
if not IsBound(D.isBinary) then
   D.isBinary:=ForAll(D.blocks,IsSet);
fi;
return D.isBinary;
end); 

BindGlobal("IsSimpleBlockDesign",function(D)
if not IsBlockDesign(D) then
   Error("usage: IsSimpleBlockDesign( <BlockDesign> )");
fi;
if not IsBound(D.isSimple) then
   D.isSimple:=IsSet(D.blocks);
fi;
return D.isSimple;
end); 

BindGlobal("BlockSizes",function(D)
if not IsBlockDesign(D) then
   Error("usage: BlockSizes( <BlockDesign> )");
fi;
if not IsBound(D.blockSizes) then
   D.blockSizes:=AsSet(List(D.blocks,Length));
fi;
return Immutable(D.blockSizes);
end); 

BindGlobal("BlockNumbers",function(D)
if not IsBlockDesign(D) then
   Error("usage: BlockNumbers( <BlockDesign> )");
fi;
if not IsBound(D.blockNumbers) then
   D.blockNumbers:=
      Immutable(List(BlockSizes(D),x->Number(D.blocks,y->Length(y)=x)));
fi;
return Immutable(D.blockNumbers);
end); 

BindGlobal("TSubsetLambdasVector",function(D,t)
local c,i,j,ii,xx,tsubsets,tvector,block;
if not IsBlockDesign(D) or not IsInt(t) then
   Error("usage: TSubsetLambdasVector( <BlockDesign>, <Int> )");
fi;
if t<0 then
   Error("<t> must be non-negative");
elif t>D.v then
   return [];
fi;
tsubsets:=Combinations([1..D.v],t);
tvector:=ListWithIdenticalEntries(Length(tsubsets),0); # initialization
for block in D.blocks do
   if not IsSet(block) then
      xx:=ListWithIdenticalEntries(D.v,0);
      for i in block do 
         xx[i]:=xx[i]+1;
      od;
   fi;
   for c in Combinations(Set(block),t) do
      if IsSet(block) then
         ii:=1;
      else
         ii:=Product(xx{c});
      fi;
      j:=PositionSorted(tsubsets,c);
      tvector[j]:=tvector[j]+ii; 
   od;
od;
return tvector;
end);

BindGlobal("TSubsetStructure",function(D,t)
local tsubsets,tvector,lambdas,partition,tsubsetstructure,i;
if not IsBlockDesign(D) or not IsInt(t) then
   Error("usage: TSubsetStructure( <BlockDesign>, <Int> )");
fi;
if t<0 then
   Error("<t> must be non-negative");
fi;
if IsBound(D.tSubsetStructure) and t=D.tSubsetStructure.t then 
   return Immutable(D.tSubsetStructure);
fi;
if IsBound(D.allTDesignLambdas) and Length(D.allTDesignLambdas)>=t+1 then
   return Immutable(rec(t:=t,lambdas:=[D.allTDesignLambdas[t+1]]));
fi;
tsubsets:=Combinations([1..D.v],t);
tvector:=TSubsetLambdasVector(D,t);
lambdas:=Set(tvector);
tsubsetstructure:=rec(t:=t,lambdas:=lambdas);
if Length(lambdas)>1 then
   partition:=List(lambdas,x->[]);  # initialization
   for i in [1..Length(tvector)] do
      Add(partition[PositionSorted(lambdas,tvector[i])],tsubsets[i]); 
   od;
   tsubsetstructure.partition:=partition;
   return Immutable(tsubsetstructure);
elif not IsBound(D.tSubsetStructure) and
   t>1 and Length(lambdas)=1 and lambdas[1]>0 then
   # this is probably info worth recording 
   D.tSubsetStructure:=Immutable(tsubsetstructure);
   return D.tSubsetStructure;
else
   return Immutable(tsubsetstructure);
fi;
end);

BindGlobal("AllTDesignLambdas",function(D)
local b,k,m,alltdesignlambdas;

alltdesignlambdas:=function(D)
# This function does all the real work.
# It is assumed that D is a binary block design with 
# constant block size.
local all,t,v,k,lambda,b,T,G,DD;
v:=D.v;
k:=Length(D.blocks[1]);
b:=Length(D.blocks);
if IsBound(D.autGroup) then
   G:=D.autGroup;
elif IsBound(D.autSubgroup) then
   G:=D.autSubgroup;
else
   G:=Group(());
fi;
if IsTransitive(G,[1..v]) then
   if k=1 then 
      D.allTDesignLambdas:=Immutable([b,b/v]); 
      return D.allTDesignLambdas;
   fi;
   DD:=BlockDesign(v-1,List(Filtered(D.blocks,x->x[k]=v),y->y{[1..k-1]}));
   # DD is the derived design of D wrt the point v.
   DD.autSubgroup:=Stabilizer(G,v);
   D.allTDesignLambdas:=Immutable(Concatenation([b],alltdesignlambdas(DD)));
   return D.allTDesignLambdas;
fi;
# Now handle the case where G is not point-transitive.
all:=[b];
for t in [1..k] do
   lambda:=b*Binomial(k,t)/Binomial(v,t);
   if not IsInt(lambda) then
      D.allTDesignLambdas:=Immutable(all);
      return D.allTDesignLambdas;
   fi;
   T:=TSubsetLambdasVector(D,t);
   if not ForAll(T,x->x=lambda) then
      D.allTDesignLambdas:=Immutable(all);
      return D.allTDesignLambdas;
   fi;      
   # If we get here then we know that D is a t-(v,k,lambda) design.
   Add(all,lambda);
od;    
D.allTDesignLambdas:=Immutable(all);
return D.allTDesignLambdas;
end;

if not IsBlockDesign(D) then
   Error("usage: AllTDesignLambdas( <BlockDesign> )");
fi;
if IsBound(D.allTDesignLambdas) then
   return Immutable(D.allTDesignLambdas);
fi;
if Length(BlockSizes(D))>1 or not IsBinaryBlockDesign(D) then
   # D is not a t-design for any t.
   D.allTDesignLambdas:=Immutable([]); 
   return D.allTDesignLambdas;
fi;
b:=Length(D.blocks);
k:=BlockSizes(D)[1];
m:=b/Binomial(D.v,k);
if IsInt(m) and ForAll(Collected(D.blocks),x->x[2]=m) then
   # D is m times the trivial design.
   D.allTDesignLambdas:=Immutable(List([0..k],
      i->b*Binomial(k,i)/Binomial(D.v,i))); 
   return D.allTDesignLambdas;
else 
   return alltdesignlambdas(D);
fi;
end); 
   
BindGlobal("PossibleTDesignLambdasFromParameters",function(t,v,k,lambda)
local b;
if not (IsInt(t) and IsInt(v) and IsInt(k) and IsInt(lambda)) then
   Error("usage: PossibleTDesignLambdasFromParameters( <Int>, <Int>, <Int>, <Int> )");
fi;
if v<=0 or k<=0 or lambda<=0 then
   Error("must have <v>,<k>,<lambda> > 0");
fi;
if 0>t or t>k or k>v then
   Error("must have 0 <= <t> <= <k> <= <v>");
fi;
#
# Now 0<=t<=k<=v and v,k,lambda>0.
#
b:=lambda*Binomial(v,t)/Binomial(k,t);
return List([0..k],i->b*Binomial(k,i)/Binomial(v,i)); 
end);

BindGlobal("IsPossiblySBIBD",function(v,k,lambda)
#
# This boolean function returns false only if there is no
# (v,k,lambda)-SBIBD.
#
local n,p,p1,p2,num;
if not (IsInt(v) and IsInt(k) and IsInt(lambda)) then
   Error("usage: IsPossiblySBIBD( <Int>, <Int>, <Int> )");
fi;
if not (2<=k and k<v and lambda>0) then
   Error("must have 2 <= <k> < <v>, and  <lambda> > 0"); 
fi;
if lambda*(v-1)/(k-1) <> k then
   return false;
fi;
# Parameters are admissible, and  r=k, b=v.
# Now check the Bruck-Ryser-Chowla condition.
n:=k-lambda;
if v mod 2 = 0 then
   # return true iff  n  is the square of an integer.
   return n=RootInt(n,2)^2; 
fi;
# For v odd, we test BRC by applying Theorem 2.5 in 
# E.S. Lander, Symmetric Designs: An Algebraic Approach, CUP, 1983. 
p1:=List(Filtered(Collected(FactorsInt(lambda)),x->x[2] mod 2 <> 0),y->y[1]);
# now p1 is a list of the distinct primes dividing the 
# squarefree part of  lambda.
p2:=List(Filtered(Collected(FactorsInt(n)),x->x[2] mod 2 <> 0),y->y[1]);
# now p2 is a list of the distinct primes dividing the 
# squarefree part of  n.
for p in Difference(p1,Union([2],p2)) do 
   if not Legendre(n,p)=1 then
      # BRC condition does not hold
      return false;
   fi;
od;
num:=(-1)^((v-1)/2)*Product(p1);
for p in Difference(p2,Union([2],p1)) do 
   if not Legendre(num,p)=1 then
      # BRC condition does not hold
      return false;
   fi;
od;
num:=(-1)^((v+1)/2)*Product(p1)*Product(p2);
for p in Difference(Intersection(p1,p2),[2]) do 
   if not Legendre(num/p^2,p)=1 then
      # BRC condition does not hold
      return false;
   fi;
od;
# BRC condition holds.
return true;
end);

BindGlobal("IsPossiblyBIBD",function(v,k,lambda)
#
# This boolean function returns false only if there is no
# (v,k,lambda)-BIBD.
#
local b,r;
if not (IsInt(v) and IsInt(k) and IsInt(lambda)) then
   Error("usage: IsPossiblyBIBD( <Int>, <Int>, <Int> )");
fi;
if not (2<=k and k<v and lambda>0) then
   Error("must have 2 <= <k> < <v>, and  <lambda> > 0"); 
fi;
if lambda*(v-1) mod (k-1) <> 0 then
   return false;
fi;
r:=lambda*(v-1)/(k-1);
if v*r mod k <> 0 then
   return false;
fi;
b:=v*r/k;
if b<v then 
   # Fisher's inequality does not hold.
   return false;
fi; 
if b=v then
   return IsPossiblySBIBD(v,k,lambda);
fi;
if r=k+lambda and lambda<=2 then
   # We are looking for embeddable quasiresidual BIBDs.
   # If lambda=1 then we are looking for affine planes 
   # (embeddable in projective planes), and if lambda=2 then
   # embeddablity is by the Hall-Connor theorem. 
   if not IsPossiblySBIBD(v+r,r,lambda) then
      # no SBIBDs to embed the required designs.
      return false;
   fi;
fi;
return true;
end);

BindGlobal("TDesignLambdas",function(t,v,k,lambda)
local lambdas;
if not (IsInt(t) and IsInt(v) and IsInt(k) and IsInt(lambda)) then
   Error("usage: TDesignLambdas( <Int>, <Int>, <Int>, <Int> )");
fi;
if v<=0 or k<=0 or lambda<=0 then
   Error("must have <v>,<k>,<lambda> > 0");
fi;
if 0>t or t>k or k>v then
   Error("must have 0 <= <t> <= <k> <= <v>");
fi;
#
# Now 0<=t<=k<=v and v,k,lambda>0.
#
lambdas:=List([0..t],s->lambda*Binomial(v-s,t-s)/Binomial(k-s,t-s));
if not ForAll(lambdas,IsInt) then
   # parameters t-(v,k,lambda) are inadmissible
   return fail;
fi;
return lambdas;
end);

BindGlobal("TDesignIntersectionTriangle",function(t,v,k,lambda)
local lambdas,T,i,j;
if not (IsInt(t) and IsInt(v) and IsInt(k) and IsInt(lambda)) then
   Error("usage: TDesignIntersectionTriangle( <Int>, <Int>, <Int>, <Int> )");
fi;
if v<=0 or k<=0 or lambda<=0 then
   Error("must have <v>,<k>,<lambda> > 0");
fi;
if 0>t or t>k or k>v then
   Error("must have 0 <= <t> <= <k> <= <v>");
fi;
#
# Now 0<=t<=k<=v and v,k,lambda>0.
#
lambdas:=TDesignLambdas(t,v,k,lambda);
if lambdas=fail then
   return fail;
fi;
# Make first column of T.
T:=List(lambdas,x->[x]);
# Make remaining columns of T.
for j in [1..t] do
   for i in [0..t-j] do
      T[i+1][j+1]:=T[i+1][j]-T[i+2][j];
   od;
od;
return T;
end);

BindGlobal("SteinerSystemIntersectionTriangle",function(t,v,k)
local lambdas,T,i,j;
if not (IsInt(t) and IsInt(v) and IsInt(k)) then
   Error("usage: SteinerSystemIntersectionTriangle( <Int>, <Int>, <Int> )");
fi;
if v<=0 or k<=0 then
   Error("must have <v>,<k> > 0");
fi;
if 0>t or t>k or k>v then
   Error("must have 0 <= <t> <= <k> <= <v>");
fi;
#
# Now 0<=t<=k<=v and v,k>0.
#
lambdas:=TDesignLambdas(t,v,k,1);
if lambdas=fail then
   return fail;
fi;
# Make first column of T.
T:=List(lambdas,x->[x]);
for i in [t+1..k] do
   T[i+1]:=[1];
od;
# Make remaining columns of T.
for j in [1..k] do
   for i in [0..k-j] do
      T[i+1][j+1]:=T[i+1][j]-T[i+2][j];
   od;
od;
return T;
end);

BindGlobal("TDesignLambdaMin",function(t,v,k)
#
# Returns the minimum lambda such that TDesignLambdas(t,v,k,lambda)<>fail.
#
local s,numer,denom,lambdamin;
if not (IsInt(t) and IsInt(v) and IsInt(k)) then
   Error("usage: TDesignLambdaMin( <Int>, <Int>, <Int> )");
fi;
if v<=0 or k<=0 then
   Error("must have <v>,<k> > 0");
fi;
if 0>t or t>k or k>v then
   Error("must have 0 <= <t> <= <k> <= <v>");
fi;
#
# Now 0<=t<=k<=v and v,k>0.
#
lambdamin:=1;
for s in [0..t] do
   numer:=lambdamin*Binomial(v-s,t-s);
   denom:=Binomial(k-s,t-s);
   lambdamin:=lambdamin*denom/Gcd(denom,numer);
od;
return lambdamin;
end);

BindGlobal("TDesignBlockMultiplicityBound",function(t,v,k,lambda)

local blockmultiplicitybound;

blockmultiplicitybound:=function(t,v,k,lambda)
#
# This function does most of the work.
# It is assumed that t,v,k,lambda are integers, with
# v,k,lambda>0 and 0<=t<=k<=v, but this is not checked.
#
local newlambda,lambdavec,multbound,m,lower,upper,mid;
if t=0 or k=v then
   return lambda;
elif k>v/2 and v-k>=t then
   # consider the design with the blocks complemented
   newlambda:=lambda*Binomial(v-k,t)/Binomial(k,t);
   if not IsInt(newlambda) then
      # no design
      return 0;
   else
      return blockmultiplicitybound(t,v,v-k,newlambda);
   fi;
fi;
lambdavec:=TDesignLambdas(t,v,k,lambda);
if lambdavec=fail then
   # parameters t-(v,k,lambda) inadmissible
   return 0;
elif t=1 then 
   return lambda;
fi;
# Now 2<=t<=k<v.
if t=2 then
   if not IsPossiblyBIBD(v,k,lambda) then
      return 0;
   fi;
   multbound:=lambda;
else
   # consider the derived design
   multbound:=blockmultiplicitybound(t-1,v-1,k-1,lambda);
fi;
if t mod 2 <> 0 or multbound=0 then
   return multbound;
fi;
# Now t>=2 is even.
# Refine bound using block intersection polynomials and binary search.
m:=ListWithIdenticalEntries(k+1,0);
lower:=0;
upper:=multbound+1;
# The bound on the multiplicity of a block is  >= lower  and  < upper.
while upper-lower>1 do
   mid:=Int((lower+upper)/2); 
   m[k+1]:=mid;
   if BlockIntersectionPolynomialCheck(m,lambdavec) then
      lower:=mid;
   else
      upper:=mid;
   fi;
od;
return lower;
end;

if not (IsInt(t) and IsInt(v) and IsInt(k) and IsInt(lambda)) then
   Error("usage: TDesignBlockMultiplicityBound( <Int>, <Int>, <Int>, <Int> )");
fi;
if v<=0 or k<=0 or lambda<=0 then
   Error("must have <v>,<k>,<lambda> > 0");
fi;
if 0>t or t>k or k>v then
   Error("must have 0 <= <t> <= <k> <= <v>");
fi;
return blockmultiplicitybound(t,v,k,lambda);
end);

BindGlobal("OARunMultiplicityBound",function(N,k,s,t)
#
# Suppose N is a positive integer, and k and s are non-empty
# lists of the same length, w say, of positive integers, with 
# each element of s >1, and t is a non-negative integer <= Sum(k). 
#
# Then this function returns an upper bound on the multiplicity of 
# any run in a (mixed) orthogonal array OA(N,s[1]^k[1],...,s[w]^k[w],t). 
#
# If k is given as an integer, it is replaced by [k].
# If s is given as an integer, it is replaced by [s].
#
# The technique used is based on the results in: 
# P.J. Cameron and L.H. Soicher, Block intersection polynomials, 
# Bull. London Math. Soc. 39 (2007), 559-564.
#

local runmultiplicitybound,S,i,j;

runmultiplicitybound:=function(N,S,t)
#
# This function does most of the work.
# S is a nonempty list whose length is the number of factors, and 
# with S[i] being the size of the symbol set for the i-th factor.
#
local lambdavec,m,i,C,c,count,nrtuples,nrfactors,num,
   symbolsetsizes,maxsymbolsetsize;
if t=0 then
   return N;
fi; 
nrfactors:=Length(S);
symbolsetsizes:=Set(S); # the set of the sizes of the symbol sets
maxsymbolsetsize:=symbolsetsizes[Length(symbolsetsizes)];
if t=1 then
   if ForAny(symbolsetsizes,size->N mod size <> 0) then
      return 0;
   else
      return N/maxsymbolsetsize;
   fi;
fi;
# Now Length(S) >= t >= 2. 
if t mod 2 <> 0 then
   return Minimum(List(symbolsetsizes,size->
      runmultiplicitybound(N/size,S{Difference([1..nrfactors],[Position(S,size)])},t-1)));
fi;
# Now t>=2 is even, and we determine the bound using
# block intersection polynomials.
num:=ListWithIdenticalEntries(maxsymbolsetsize,0);
for i in [1..nrfactors] do
   num[S[i]]:=num[S[i]]+1;
od;
# So now, num[j] is the number of factors having a symbol set of size j.
lambdavec:=[N];
for i in [1..t] do
   #
   # determine lambdavec[i+1]
   #
   lambdavec[i+1]:=0;
   C:=Combinations(S,i); # the set of submultisets of S of size i 
   for c in C do
      nrtuples:=Product(c);
      # nrtuples is the number of i-tuples where the first element
      # is from a symbol set of size c[1], the second from a symbol
      # set of size c[2], and so on.
      if N mod nrtuples <> 0 then
         return 0;
      fi;
      count:=Product(Collected(c),x->Binomial(num[x[1]],x[2]));
      # count is the number of times the multiset  c  occurs over 
      # all choices of  i  elements from  S.
      #
      # Now add in their contribution.
      # 
      lambdavec[i+1]:=lambdavec[i+1]+count*(N/nrtuples);
   od;
   # Now take the average contribution.
   lambdavec[i+1]:=lambdavec[i+1]/Binomial(nrfactors,i); 
od;
m:=ListWithIdenticalEntries(nrfactors+1,0);
m[nrfactors+1]:=1;
while BlockIntersectionPolynomialCheck(m,lambdavec) do
   m[nrfactors+1]:=m[nrfactors+1]+1;
od;
return m[nrfactors+1]-1;
end;

if IsInt(k) then
   k:=[k];
fi;
if IsInt(s) then
   s:=[s];
fi;
if not (IsInt(N) and IsList(k) and IsList(s) and IsInt(t)) then
   Error("usage: OARunMultiplicityBound( <Int>, <Int> or <List>, <Int> or <List>, <Int> )");
fi;
if N<1 or t<0 then
   Error("<N> must be positive and <t> must be non-negative");
fi;
if Length(s)<>Length(k) or Length(s)=0 then
   Error("<s> and <k> must have equal positive length");
fi;
if ForAny(k,x->not IsPosInt(x)) or t>Sum(k) then
   Error("<k> must be a list of positive integers, with Sum(<k>) >= <t>");
fi;
if ForAny(s,x->not IsInt(x) or x<2) then
   Error("each element of <s> must be an integer > 1");
fi;
S:=[];
for i in [1..Length(s)] do
   for j in [1..k[i]] do
      Add(S,s[i]);
   od;
od;
return runmultiplicitybound(N,S,t);
end);

BindGlobal("ResolvableTDesignBlockMultiplicityBound",function(t,v,k,lambda)

local multbound,r,lambdavec,m,lower,upper,mid;
if not (IsInt(t) and IsInt(v) and IsInt(k) and IsInt(lambda)) then
   Error("usage: ResolvableTDesignBlockMultiplicityBound( <Int>, <Int>, <Int>, <Int> )");
fi;
if v<=0 or k<=0 or lambda<=0 then
   Error("must have <v>,<k>,<lambda> > 0");
fi;
if 0>t or t>k or k>v then
   Error("must have 0 <= <t> <= <k> <= <v>");
fi;
#
# Now 0<=t<=k<=v and v,k,lambda>0.
#
if (v mod k <> 0) then
   # resolvable t-(v,k,lambda) design cannot exist
   return 0;
elif k=v then
   # complete blocks
   return lambda;
fi;
lambdavec:=TDesignLambdas(t,v,k,lambda);
if lambdavec=fail then
   # parameters t-(v,k,lambda) inadmissible
   return 0;
fi;
if t=0 then 
   r:=lambdavec[1]*k/v;
   if not IsInt(r) then
      # design cannot be resolvable
      return 0;
   else
      return r;
   fi;
elif t=1 then
   return lambda;
fi;
# Now 2<=t<=k<v. 
if lambdavec[1]<v+lambdavec[2]-1 then
   # Bose's inequality does not hold
   return 0;
fi;
multbound:=TDesignBlockMultiplicityBound(t,v,k,lambda); # initialize
if t mod 2 <> 0 or multbound=0 then
   return multbound;
fi;
# Now t>=2 is even.
# Refine bound using block intersection polynomials and binary search.
m:=ListWithIdenticalEntries(k+1,0);
lower:=0;
upper:=multbound+1;
# The bound on the multiplicity of a block is  >= lower  and  < upper.
while upper-lower>1 do
   mid:=Int((lower+upper)/2); 
   m[k+1]:=mid;
   m[1]:=mid*(v/k-1);
   if BlockIntersectionPolynomialCheck(m,lambdavec) then
      lower:=mid;
   else
      upper:=mid;
   fi;
od;
return lower;
end);

BindGlobal("IncidenceGraphSupportBlockDesign",function(D)
local G,supportblocks,gamma,pointnames;
if not IsBlockDesign(D) then
   Error("usage: IncidenceGraphSupportBlockDesign( <BlockDesign> )");
fi;
if IsBound(D.autGroup) then
   G:=D.autGroup;
elif IsBound(D.autSubgroup) then
   G:=D.autSubgroup;
else
    G:=Group(());
fi;
if IsSimpleBlockDesign(D) then
   supportblocks:=D.blocks;
else
   supportblocks:=Set(D.blocks);
fi;
gamma:=Graph(G,Concatenation([1..D.v],supportblocks),OnMultisetsRecursive,
             function(x,y)
             if IsInt(x) then
                return IsList(y) and x in y;
             else
                return IsInt(y) and y in x;
             fi;
             end,true);
if IsBound(D.pointNames) then
   pointnames:=D.pointNames;
else
   pointnames:=[1..D.v];
fi;
gamma.names:=Immutable(Concatenation(pointnames,
                          List(supportblocks,x->pointnames{x})));
return gamma;
end);
   
BindGlobal("IsConnectedBlockDesign",function(D)
if not IsBlockDesign(D) then
   Error("usage: IsConnectedBlockDesign( <BlockDesign> )");
fi;
if not IsBound(D.isConnected) then 
   D.isConnected:=IsConnectedGraph(IncidenceGraphSupportBlockDesign(D));
fi;
return D.isConnected;
end); 
   
BindGlobal("ReplicationNumber",function(D)
#
# If the block design  D  is equireplicate, then this function
# returns its replication number  r;  otherwise  fail  is returned.
#
local count,blocks,block,point;
if not IsBlockDesign(D) then
   Error("usage: ReplicationNumber( <BlockDesign> )");
fi;
if IsBound(D.r) then
   return D.r;
fi;   
count:=ListWithIdenticalEntries(D.v,0); 
for block in D.blocks do
   for point in block do
      count[point]:=count[point]+1;
   od;
od;
if ForAll(count,x->x=count[1]) then 
   # D is equireplicate
   D.r:=count[1];
   return D.r;
else
   # D is not equireplicate 
   return fail;
fi;   
end);

BindGlobal("PairwiseBalancedLambda",function(D)
local lambdas;
if not IsBinaryBlockDesign(D) then
   Error("usage: PairwiseBalancedLambda( <BinaryBlockDesign> )");
fi;
if D.v<2 then
   return fail;
fi;
lambdas:=TSubsetStructure(D,2).lambdas;
if Length(lambdas)=1 and lambdas[1]>0 then 
   # D is pairwise balanced
   return lambdas[1]; 
else
   # D is not pairwise balanced
   return fail;
fi;
end);

BindGlobal("IsVarianceBalanced",function(D)
local vec,j,c,twosubsets,block;
if not IsBinaryBlockDesign(D) then
   Error("<D> must be a binary block design");
fi;
if D.v=1 or not IsConnectedBlockDesign(D) then
   # this function is not applicable
   return fail;
fi;   
twosubsets:=Combinations([1..D.v],2);
vec:=ListWithIdenticalEntries(Length(twosubsets),0); # initialization
for block in D.blocks do 
   for c in Combinations(block,2) do
      j:=PositionSorted(twosubsets,c);
      vec[j]:=vec[j]+1/Length(block);
   od;
od;
return ForAll(vec,x->x=vec[1]);
end);

BindGlobal("AffineResolvableMu",function(D)
#
# A block design is *affine resolvable* if the design is resolvable 
# and any two blocks not in the same parallel class of a resolution 
# meet in a constant number mu of points. 
#
# If the block design  <D>  is affine resolvable, then this function
# returns its  mu;  otherwise  `fail'  is returned.

# The value 0 is returned iff  <D>  consists of a single parallel class.
#
local blocks_remaining,mu,A,B,AA,m;
if not IsBlockDesign(D) then
   Error("usage: AffineResolvableMu( <BlockDesign> )");
fi;
if not IsBinaryBlockDesign(D) then
   #  D  not resolvable
   return fail;
fi;
if not IsSimpleBlockDesign(D) then
   if ForAll(D.blocks,x->Length(x)=D.v) then
      return D.v;
   else
      return fail;
   fi;
fi;
blocks_remaining:=ShallowCopy(D.blocks);
mu:=0;
while blocks_remaining <> [] do
   A:=blocks_remaining[1];
   RemoveSet(blocks_remaining,A);
   AA:=[]; # build in AA the elements other than A in the parallel class of A
   for B in blocks_remaining do
      m:=Length(Intersection(A,B));
      if m=0 then
         if ForAny(AA,x->Intersection(B,x)<>[]) then
            return fail;
         else
            Add(AA,B);
         fi;
      elif mu=0 then
         mu:=m;
      elif m<>mu then
         # non-constant mu
         return fail;
      fi; 
   od;
   if Length(A)+Sum(List(AA,Length))<>D.v then
      # [A] union AA is not a parallel class
      return fail;
   else
      SubtractSet(blocks_remaining,AA);
      # at this point mu>0 or blocks_remaining=[] 
      if ForAny(AA,x->ForAny(blocks_remaining,
                         y->Length(Intersection(x,y))<>mu)) then
         return fail;
      fi;
   fi;
od;
return mu;
end);

BindGlobal("AutGroupBlockDesign",function(D)
local collectedblocks,blockmultiplicities,vertexpartition,i,gamma;
if not IsBlockDesign(D) then
   Error("usage: AutGroupBlockDesign( <BlockDesign> )");
fi;
if IsBound(D.autGroup) then
   return D.autGroup;
fi;
if not IsBinaryBlockDesign(D) then
   Error("aut group not yet implemented for non-binary block designs");
fi;
gamma:=IncidenceGraphSupportBlockDesign(D);
collectedblocks:=Collected(D.blocks);
blockmultiplicities:=Set(List(collectedblocks,x->x[2]));
vertexpartition:=List(blockmultiplicities,x->[]); # initialization
for i in [1..Length(collectedblocks)] do
   Add(vertexpartition[PositionSorted(blockmultiplicities,collectedblocks[i][2])],D.v+i);
od;
vertexpartition:=Concatenation([[1..D.v]],vertexpartition);
D.autGroup:=Action(AutGroupGraph(gamma,vertexpartition),[1..D.v]);
return D.autGroup;
end); 
   
InstallOtherMethod(AutomorphismGroup,"for block design",[IsRecord],10,
function(D)
  if not IsBlockDesign(D) then
     TryNextMethod();
  fi;
  return AutGroupBlockDesign(D);
end);

BindGlobal("BlockDesignIsomorphismClassRepresentatives",function(L)
#
# Given a list  L  of binary block designs, this function returns
# a list containing pairwise non-isomorphic elements of  L,  representing
# all the isomorphism classes of elements of  L. 
#
local graphs,i,designs,reps;
if not IsList(L) then
   Error("usage: BlockDesignIsomorphismClassRepresentatives( <List> )");
fi;
if not ForAll(L,x->IsBlockDesign(x) and IsBinaryBlockDesign(x)) then
   Error("each element of <L> must be a binary block design");
fi;
designs:=ShallowCopy(L);
if Length(designs)<=1 then
   return designs;
fi;
graphs:=List(designs,A->Graph(Group(()),[1..A.v+Length(A.blocks)],
                 function(x,g) return x; end,
                 function (x,y) 
                 if x<=A.v then
                    if y<=A.v then 
                       return x=y;  # put loops on point-vertices
                    fi;
                    return x in A.blocks[y-A.v];
                 else 
                    return y<=A.v and y in A.blocks[x-A.v];
                 fi;
                 end,true));
for i in [1..Length(graphs)] do
   SetAutGroupCanonicalLabelling(graphs[i]);
   if not IsBound(designs[i].autGroup) then
      designs[i].autGroup:=Action(AutGroupGraph(graphs[i]),[1..designs[i].v]);
   fi;
   graphs[i]:=DirectedEdges(
      GraphImage(graphs[i],graphs[i].canonicalLabelling^(-1)));
   # Now  graphs[i]  is the set of directed edges of the canonical 
   # representative of the incidence graph of  designs[i]
   # (these directed edges determine this canonical graph since 
   # we assume no block design has an empty block).
od;
SortParallel(graphs,designs);
reps:=[designs[1]];
for i in [2..Length(graphs)] do
   if graphs[i]<>graphs[i-1] then
      # new isomorphism class representative
      Add(reps,designs[i]);
   fi;
od;
return reps;
end); 
   
BindGlobal("IsEqualBlockDesign",function(A,B)
#
# This boolean function returns true iff block designs  A  and  B 
# are equal (i.e. A.v=B.v and A and B have equal block-multisets).  
#
if not IsBlockDesign(A) or not IsBlockDesign(B) then
   Error("usage: IsEqualBlockDesign( <BlockDesign>, <BlockDesign> )");
fi;
return A.v=B.v and A.blocks=B.blocks;
end); 

BindGlobal("IsIsomorphicBlockDesign",function(A,B)
#
# This boolean function returns true iff block designs  A  and  B 
# are isomorphic.  The case where both  A  and   B   are non-binary is 
# not yet fully implemented.
#
if not IsBlockDesign(A) or not IsBlockDesign(B) then
   Error("usage: IsIsomorphicBlockDesign( <BlockDesign>, <BlockDesign> )");
fi;
if IsEqualBlockDesign(A,B) then
   return true;
fi;
if A.v<>B.v or BlockSizes(A)<>BlockSizes(B) or BlockNumbers(A)<>BlockNumbers(B) then 
   return false;
fi;
if IsBinaryBlockDesign(A) and not IsBinaryBlockDesign(B) or 
   IsBinaryBlockDesign(B) and not IsBinaryBlockDesign(A) then
   return false;
fi;
if not IsBinaryBlockDesign(A) and not IsBinaryBlockDesign(B) then
   Error("isomorphism test not yet fully implemented for non-binary block designs");
fi;
return Length(BlockDesignIsomorphismClassRepresentatives([A,B]))=1;
end); 

BindGlobal("DualBlockDesign",function(D)
#
# Suppose  D  is a block design for which every point
# lies on at least one block.  Then this function returns
# the dual of  D,  the block design in which the 
# roles of points and blocks are interchanged, but incidence
# (including repeated incidence) stays the same.  Note
# that, since lists of blocks are always sorted, the dual of the
# dual of  D  may not equal  D. 
#
local i,j,dualblocks,dual;
if not IsBlockDesign(D) then
   Error("usage: DualBlockDesign( <BlockDesign> )");
fi;
dualblocks:=List([1..D.v],x->[]);
for i in [1..Length(D.blocks)] do
   for j in D.blocks[i] do
      Add(dualblocks[j],i);
   od;
od;
if ForAny(dualblocks,x->Length(x)=0) then
   Error("each point of <D> must lie on at least one block");
fi;
dual:=BlockDesign(Length(D.blocks),dualblocks);
if IsBound(D.pointNames) then
   dual.pointNames:=Immutable(List(D.blocks,x->D.pointNames{x}));   
else 
   dual.pointNames:=Immutable(D.blocks);   
fi;
return dual;
end); 

BindGlobal("ComplementBlocksBlockDesign",function(D)
#
# Suppose  D  is a binary incomplete-block design.
# Then this function returns the block design on the same
# point-set as  D,  whose blocks are the complements of
# those of  D.
#
local newblocks,newdesign;
if not IsBinaryBlockDesign(D) then
   Error("usage: ComplementBlocksBlockDesign( <BinaryBlockDesign> )");
fi;
if ForAny(D.blocks,x->Length(x)=D.v) then
   Error("<D> must not contain a complete block");
fi;
newblocks:=List(D.blocks,x->Difference([1..D.v],x));
newdesign:=BlockDesign(D.v,newblocks);
if IsBound(D.pointNames) then
   newdesign.pointNames:=Immutable(D.pointNames);   
fi;
if IsBound(D.autGroup) then
   newdesign.autGroup:=D.autGroup;
fi;
return newdesign;
end); 

BindGlobal("DeletedPointsBlockDesign",function(D,Y)
#
# Suppose  D  is a block design, and  Y  is a proper subset of the 
# point-set of  D.

# Then this function returns a block design  F  obtained from  D 
# by deleting the points in  Y  from the point-set of  D,  and
# removing the points in  Y  from each block of  D.
# It is an error if  F  then contains an empty block. 
# The points of  F  are relabelled with   [1..D.v-Length(Y)], 
# preserving the order of the corresponding points in  D. 
# The corresponding point-names of D become the point-names of F.
#
local newblocks,newpoints,newlabels,i,newdesign;
if not (IsBlockDesign(D) and IsSet(Y)) then
   Error("usage: DeletedPointsBlockDesign( <BlockDesign>, <Set> )");
fi;
if Y=[] then
   # no points to delete
   return StructuralCopy(D);
fi;
if not IsSubset([1..D.v],Y) or Length(Y)=D.v then 
   Error("<Y> must be a proper subset of [1..<D>.v]");
fi;
newblocks:=List(D.blocks,x->Filtered(x,y->not (y in Y)));
if ForAny(newblocks,x->x=[]) then
   Error("cannot create a block design with empty blocks");
fi;
newpoints:=Difference([1..D.v],Y);
newlabels:=[];
for i in [1..Length(newpoints)] do
   newlabels[newpoints[i]]:=i;
od;
# now relabel the points in the new blocks
newblocks:=List(newblocks,x->newlabels{x});
newdesign:=BlockDesign(Length(newpoints),newblocks);
if not IsBound(D.pointNames) then 
   newdesign.pointNames:=Immutable(newpoints);
else
   newdesign.pointNames:=Immutable(D.pointNames{newpoints});
fi;
return newdesign;
end); 

BindGlobal("DeletedBlocksBlockDesign",function(D,Y)
#
# Suppose  D  is a block design, and  Y  is a proper sublist of the 
# block-list of  D.  Y  need not be sorted.

# Then this function returns a block design  F  obtained from  D 
# by deleting the blocks in  Y  (counting repeats) from the block-list 
# of  D. 
#
local blocks,newblocks,i,j,jj,newdesign;
if not (IsBlockDesign(D) and IsList(Y)) then
   Error("usage: DeletedBlocksBlockDesign( <BlockDesign>, <List> )");
fi;
if Y=[] then 
   # no blocks to delete
   return StructuralCopy(D);
fi;
blocks:=D.blocks;
if Length(Y)=Length(blocks) then 
   Error("<Y> must be a proper sublist of <D>.blocks");
fi;
if not IsSortedList(Y) then
   Y:=SortedList(Y);
fi;
newblocks:=[];
i:=1;
j:=1;
while i<=Length(Y) and j<=Length(blocks) do
   if Y[i]<blocks[j] then
      Error("<Y> is not a sublist of <D>.blocks");
   elif Y[i]=blocks[j] then
      # deleted block
      i:=i+1;
      j:=j+1;
   else
      # blocks[j] is not deleted
      Add(newblocks,blocks[j]);
      j:=j+1;
   fi;
od;
if i<=Length(Y) then
   # not all elements of  Y  are in  blocks.
   Error("<Y> is not a sublist of <D>.blocks");
fi;
for jj in [j..Length(blocks)] do
   Add(newblocks,blocks[jj]);
od;
newdesign:=BlockDesign(D.v,newblocks);
if IsBound(D.pointNames) then 
   newdesign.pointNames:=Immutable(D.pointNames);
fi;
return newdesign;
end); 

BindGlobal("AddedPointBlockDesign",function(arg)
#
# Suppose  D=arg[1]  is a block design, and  Y=arg[2]  is a sublist 
# of the block-list of  D.  Y  need not be sorted.

# Then this function returns the block design  F  obtained from  D 
# by adding the new point  D.v+1,  and adding this point (once) to each 
# block in  Y  (including repeats).  
#
# The optional parameter  arg[3]  is used to specify a point-name for 
# the new point.
#
local D,Y,newpoint,blocks,i,j,newdesign,pointname;
D:=arg[1];
Y:=arg[2];
if not (IsBlockDesign(D) and IsList(Y)) then
   Error("usage: AddedPointBlockDesign( <BlockDesign>, <List> [, <Obj> ] )");
fi;
if not IsSortedList(Y) then
   Y:=SortedList(Y);
fi;
newpoint:=D.v+1;
blocks:=ShallowCopy(D.blocks);
i:=1;
j:=1;
while i<=Length(Y) and j<=Length(blocks) do
   if Y[i]<blocks[j] then
      Error("<Y> is not a sublist of <D>.blocks");
   elif Y[i]=blocks[j] then
      # add the new point to  blocks[j]
      blocks[j]:=SortedList(Concatenation(blocks[j],[newpoint]));
      i:=i+1;
      j:=j+1;
   else
      # blocks[j] is not altered
      j:=j+1;
   fi;
od;
if i<=Length(Y) then
   # not all elements of  Y  are in  blocks.
   Error("<Y> is not a sublist of <D>.blocks");
fi;
newdesign:=BlockDesign(D.v+1,blocks);
if IsBound(arg[3]) then
   pointname:=arg[3];
else
   pointname:=newpoint;
fi;
if IsBound(D.pointNames) then 
   newdesign.pointNames:=Immutable(Concatenation(D.pointNames,[pointname]));
elif IsBound(arg[3]) then
   newdesign.pointNames:=Immutable(Concatenation([1..D.v],[pointname]));
fi;
return newdesign;
end); 

BindGlobal("AddedBlocksBlockDesign",function(D,Y)
#
# Suppose  Y  is a list of multisets of points of the block design  D.
# Then this function returns a new block design, whose point-set
# is that of  D,  and whose block list is that of  D  with
# the elements of  Y  (including repeats)  added.
#
local newdesign;
if not (IsBlockDesign(D) and IsList(Y)) then
   Error("usage: AddedBlocksBlockDesign( <BlockDesign>, <List> )");
fi;
if Y=[] then 
   # no blocks to add
   return StructuralCopy(D);
fi;
newdesign:=BlockDesign(D.v,Concatenation(D.blocks,Y));
if IsBound(D.pointNames) then 
   newdesign.pointNames:=Immutable(D.pointNames);
fi;
return newdesign;
end); 

BindGlobal("DerivedBlockDesign",function(D,x)
#
# Suppose  D  is a block design, and  x  is a point or block of  D.
# Then this function returns the derived block design  DD  of  D,
# with respect to  x.
#
# If  x  is a point then  DD  is the block design whose blocks 
# are those of  D  containing  x,  but with  x  deleted from these
# blocks, and the points of  DD  are those which occur in some block
# of  DD.
#
# If  x  is a block, then the points of  DD  are the points in  x,  and 
# the blocks of  DD  are the blocks of  D  other than  x  containing 
# at least one point of  x,  but with all points not in  x  deleted from 
# these blocks.  Note that any repeat of  x,  but not  x  itself, 
# is a block of  DD.
#
# It is an error if the resulting block design  DD  has 
# no blocks or an empty block.
#
# The points of  DD  are relabelled with  1,2,...,
# preserving the order of the corresponding points in  D. 
# The corresponding point-names of D become the point-names of DD.
#
local newpoints,newblocks,DD; 
if not (IsBlockDesign(D) and (IsInt(x) or IsList(x))) then
   Error("usage: DerivedBlockDesign( <BlockDesign>, <Int> or <List> )");
fi;
if not (x in BlockDesignPoints(D)) and not (x in BlockDesignBlocks(D)) then
   Error("<x> must be a point or block of <D>");
fi; 
if IsInt(x) then
   # x is a point
   newblocks:=List(Filtered(D.blocks,A->x in A),A->Filtered(A,y->y<>x));
   if newblocks=[] or ForAny(newblocks,x->x=[]) then
      Error("cannot create a block design with no blocks or with empty blocks");
   fi;
   newpoints:=Union(newblocks); 
else 
   # x is a block
   newpoints:=ShallowCopy(x);
   newblocks:=ShallowCopy(D.blocks);
   Remove(newblocks,PositionSorted(newblocks,x));
   newblocks:=Filtered(List(newblocks,A->Filtered(A,y->y in x)),A->A<>[]); 
   if newblocks=[] then
      Error("cannot create a block design with no blocks");
   fi;
fi;
DD:=BlockDesign(D.v,newblocks);
if IsBound(D.pointNames) then 
   DD.pointNames:=Immutable(D.pointNames);
fi;
# now strip out the points not in newpoints, and relabel the points
DD:=DeletedPointsBlockDesign(DD,Difference(BlockDesignPoints(DD),newpoints));
return DD;
end); 

BindGlobal("ResidualBlockDesign",function(D,x)
#
# Suppose  D  is a block design, and  x  is a point or block of  D.
# Then this function returns the residual block design  RD  of  D,
# with respect to  x.
#
# If  x  is a point then  RD  is the block design whose blocks 
# are those of  D  not containing  x,  and the points of  RD  are those 
# which occur in some block of  RD.
#
# If  x  is a block, then the points of  RD  are those of  D  not in  x,  
# and the blocks of  RD  are the blocks of  D  (including repeats) 
# containing at least one point not in  x,  but with all points in  x  
# deleted from these blocks.  
#
# It is an error if the resulting block design  RD  has no blocks.
#
# The points of  RD  are relabelled with  1,2,...,
# preserving the order of the corresponding points in  D. 
# The corresponding point-names of D become the point-names of RD.
#
local newpoints,newblocks,RD; 
if not (IsBlockDesign(D) and (IsInt(x) or IsList(x))) then
   Error("usage: ResidualBlockDesign( <BlockDesign>, <Int> or <List> )");
fi;
if not (x in BlockDesignPoints(D)) and not (x in BlockDesignBlocks(D)) then
   Error("<x> must be a point or block of <D>");
fi; 
if IsInt(x) then
   # x is a point
   newblocks:=Filtered(D.blocks,A->not(x in A));
   if newblocks=[] then
      Error("cannot create a block design with no blocks");
   fi;
   newpoints:=Union(newblocks); 
else 
   # x is a block
   newpoints:=Difference(BlockDesignPoints(D),x);
   newblocks:=Filtered(List(D.blocks,A->Filtered(A,y->not (y in x))),A->A<>[]);
   if newblocks=[] then
      Error("cannot create a block design with no blocks");
   fi;
fi;
RD:=BlockDesign(D.v,newblocks);
if IsBound(D.pointNames) then 
   RD.pointNames:=Immutable(D.pointNames);
fi;
# now strip out the points not in newpoints, and relabel the points
RD:=DeletedPointsBlockDesign(RD,Difference(BlockDesignPoints(RD),newpoints));
return RD;
end); 

BindGlobal("TDesignFromTBD",function(D,t,K)
#
# Let  D  be a  t-(v,K,lambda)  design, where  t  is a positive integer 
# and  K  is a nonempty set of integers such that 
# t <= K[1] < K[2] < ... < K[Length(K)] <= v, and let  k = K[1].  
# Then this function returns a certain   t-(v,k,n*lambda)  design,
# where  n = Lcm(Binomial(K[1]-t,k-t),...,Binomial(K[Length(K)]-t,k-t)). 
#
# If  K  is not a set, then it must be an integer,  k  say, such that 
# t <= k <= Minimum(BlockSizes(D)),  and then this function returns 
# TDesignFromTBD(D, t, Union([k],BlockSizes(D) ),  which is the
# design  D*(t,k),  described and studied in
# J.P. McSorley and L.H. Soicher, Constructing t-designs from t-wise 
# balanced designs, European J. Combinatorics, to appear. 

local k,lambdas,lambda,newblocks,block,n,c,j,newdesign;
if not (IsBinaryBlockDesign(D) and IsInt(t) and (IsInt(K) or IsSet(K))) then
   Error("usage: TDesignFromTBD( <BinaryBlockDesign>, <Int>, <Int> or <Set> )");
fi;
if t<=0 then 
   Error("<t> must be positive");
fi;
if IsInt(K) then 
   k:=K;
   if k<t or k>Minimum(BlockSizes(D)) then 
      Error("must have <t> <= <k> <= Minimum(BlockSizes(<D>))");
   fi;
   K:=Union([k],BlockSizes(D));
else
   #  K  is a set.
   if K=[] or not ForAll(K,IsInt) or K[1]<t or K[Length(K)]>D.v 
      or not IsSubset(K,BlockSizes(D)) then
      Error("invalid <K>");
   fi;
   k:=K[1];
fi;
lambdas:=TSubsetStructure(D,t).lambdas;
if Length(lambdas) <> 1 then
   Error("<D> is not <t>-wise balanced");
fi;
lambda:=lambdas[1];
n:=Lcm(List(K,x->Binomial(x-t,k-t)));
newblocks:=[];
for block in D.blocks do
   for c in Combinations(block,k) do
      for j in [1..n/Binomial(Length(block)-t,k-t)] do 
         Add(newblocks,c);
      od;
   od;
od;
newdesign:=BlockDesign(D.v,newblocks);
if IsBound(D.pointNames) then
   newdesign.pointNames:=Immutable(D.pointNames);
fi;
if lambda=1 and t<k and IsBound(D.autGroup) then
   newdesign.autGroup:=D.autGroup;
elif IsBound(D.autGroup) then
   newdesign.autSubgroup:=D.autGroup;
elif IsBound(D.autSubgroup) then
   newdesign.autSubgroup:=D.autSubgroup;
fi;
return newdesign;
end);

BindGlobal("PGPointFlatBlockDesign",function(n,q,d)
#
# Returns the block design whose points are the (projective) points
# of  PG(n,q)  and whose blocks are the  d-flats  of  PG(n,q) 
# (i.e. the subspaces of projective dimension d). 

local F,V,points,i,flat,block,normedpoints,gens,frobaut,zerovec,
      flatbasis,G,D;
if not IsInt(n) or not IsInt(q) or not IsInt(d) then
   Error("usage: PGPointFlatBlockDesign( <Int>, <Int>, <Int> )");
fi;
if n<0 then 
   Error("<n> must be non-negative");
elif d<0 or d>n then
   Error("<d> must be in [0..<n>]");
fi;
F:=GaloisField(q);
V:=F^(n+1);
points:=AsSet(Subspaces(V,1));
normedpoints:=List(points,x->NormedRowVectors(x)[1]);
# Now calculate a block-transitive group  G  of automorphisms of the design.
gens:=ShallowCopy(GeneratorsOfGroup(Action(GL(n+1,q),normedpoints,OnLines)));
if not IsPrimeInt(q) then
   # Add to  gens  the Frobenius automorphism of  F,  acting on the
   # (indices of the) points.
   frobaut:=FrobeniusAutomorphism(F);
   Add(gens,PermList(List(normedpoints,x->
      PositionSorted(points,SubspaceNC(V,[List(x,y->y^frobaut)],"basis"))))); 
fi;
G:=Group(gens);
# Now make one block of the design.
zerovec:=ListWithIdenticalEntries(n+1,Zero(F));
flatbasis:=[];
for i in [1..d+1] do
   flatbasis[i]:=ShallowCopy(zerovec);
   flatbasis[i][i]:=One(F);
od;
flat:=Subspace(V,flatbasis,"basis");
block:=Filtered([1..Length(points)],i->normedpoints[i] in flat); 
D:=BlockDesign(Length(points),[block],G); 
D.pointNames:=points;
return D;
end);

BindGlobal("AGPointFlatBlockDesign",function(n,q,d)
#
# Returns the block design whose points are the points
# of  AG(n,q)  and whose blocks are the  d-flats  of  AG(n,q) 
# (i.e. the cosets of the subspaces of dimension d). 

local F,V,G,points,zerovec,flatbasis,flat,i,block,gens,translation,
      frobaut,vec,D;
if not IsInt(n) or not IsInt(q) or not IsInt(d) then
   Error("usage: AGPointFlatBlockDesign( <Int>, <Int>, <Int> )");
fi;
if n<1 then 
   Error("<n> must be positive");
elif d<0 or d>n then
   Error("<d> must be in [0..<n>]");
fi;
F:=GaloisField(q);
V:=F^n;
points:=AsSet(Elements(V)); 
# Now calculate a block-transitive group  G  of automorphisms of the design.
gens:=ShallowCopy(GeneratorsOfGroup(Action(GL(n,q),points)));
# Now add to  gens  the translation by  [1,0,0,...,0]. 
vec:=ListWithIdenticalEntries(n,Zero(F));
vec[1]:=One(F); 
translation:=PermList(List(points,x->PositionSorted(points,x+vec)));
Add(gens,translation);
if not IsPrimeInt(q) then
   # Add to  gens  the Frobenius automorphism of  F,  acting on the
   # (indices of the) points.
   frobaut:=FrobeniusAutomorphism(F);
   Add(gens,PermList(List(points,x->
               PositionSorted(points,List(x,y->y^frobaut))))); 
fi;
G:=Group(gens);
# Now make one block of the design.
zerovec:=ListWithIdenticalEntries(n,Zero(F));
flatbasis:=[];
for i in [1..d] do
   flatbasis[i]:=ShallowCopy(zerovec);
   flatbasis[i][i]:=One(F);
od;
flat:=Subspace(V,flatbasis,"basis");
block:=Filtered([1..Length(points)],i->points[i] in flat); 
D:=BlockDesign(Length(points),[block],G); 
D.pointNames:=points;
return D;
end);

BindGlobal("WittDesign",function(n)
local M12,M24,W12,W24,W,i;
if not IsInt(n) then
   Error("usage: WittDesign( <Int> )");
fi;
if not (n in [9,10,11,12,21,22,23,24]) then
   Error("must have <n> in [9,10,11,12,21,22,23,24]");
fi;
if n<=12 then
   M12:=Group( [ (1,2,3,4,5,6,7,8,9,10,11), 
      (3,7,11,8)(4,10,5,6), (1,12)(2,11)(3,6)(4,8)(5,9)(7,10) ] );
   W12:=BlockDesign(12,[[1,2,3,4,5,7]],M12);
   W12.autGroup:=M12;
   Unbind(W12.autSubgroup);
   W12.allTDesignLambdas:=Immutable(TDesignLambdas(5,12,6,1));
   W:=W12;
   for i in Reversed([n+1..12]) do
      W:=DerivedBlockDesign(W,i);
   od;
else
   M24:=Group([ (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23), 
      (3,17,10,7,9)(4,13,14,19,5)(8,18,11,12,23)(15,20,22,21,16), 
      (1,24)(2,23)(3,12)(4,16)(5,18)(6,10)(7,20)(8,14)(9,21)(11,17)(13,22)
      (15,19) ]);
   W24:=BlockDesign(24,[[1,2,3,4,5,8,11,13]],M24);
   W24.autGroup:=M24;
   Unbind(W24.autSubgroup);
   W24.allTDesignLambdas:=Immutable(TDesignLambdas(5,24,8,1));
   W:=W24;
   for i in Reversed([n+1..24]) do
      W:=DerivedBlockDesign(W,i);
   od;
fi;
return W;
end);

BindGlobal("BlockDesigns",function(param)
#
# Function to classify block designs with given properties. 
#
# These block designs need not be simple and block sizes 
# need not be constant.  These block designs need not even be
# binary, although this is the default.
#
local t,v,b,blocksizes,k,lambda,blocknumbers,blockmaxmultiplicities,
   r,blockintersectionnumbers,isolevel,C,G,B,N,ntflags,
   act,rel,weightvector,gamma,KK,L,S,s,hom,GG,CC,NN,leastreps,
   clique,ans,blockbags,c,d,i,j,jj,issimple,allbinary,tsubsetstructure,
   blocks,blockdesign,A,kk,AA,tsubsets,maxlambda,targetvector,weightvectors,
   designinfo,lambdavec,lambdamat,m,T,bb,justone,isnormal,issylowtowergroup,
   testfurther;

act := function(x,g) 
# The boolean variable  allbinary  is global, and  allbinary=true 
# iff all possible blocks are sets.
if allbinary or IsSet(x.comb) then
   return rec(comb:=OnSets(x.comb,g),mult:=x.mult); 
else
   return rec(comb:=OnMultisetsRecursive(x.comb,g),mult:=x.mult); 
fi;
end;
             
weightvector := function(x)
# param, v, t, blocksizes, and tsubsets are global
local wv,c,i,xx;
wv:=ListWithIdenticalEntries(Length(tsubsets),0);
xx:=ListWithIdenticalEntries(v,0);
for i in x.comb do 
   xx[i]:=xx[i]+1;
od;
for c in Combinations(Set(x.comb),t) do
   wv[PositionSorted(tsubsets,c)]:=x.mult*Product(xx{c});
od;
if IsBound(param.r) then 
   Append(wv,x.mult*xx);
fi;
if IsBound(param.blockNumbers) then 
   for i in [1..Length(blocksizes)] do
      if Length(x.comb)=blocksizes[i] then
         Add(wv,x.mult);
      else
         Add(wv,0);
      fi;
   od;
fi;
if IsBound(param.b) then
   Add(wv,x.mult);
fi;
return wv;
end;

rel := function(x,y) 
# v, blocksizes, targetvector, blockbags, weightvectors, 
# and blockintersectionnumbers are global.
# The parameters x and y are indices into blockbags (and weightvectors).
local i,xx,yy,s;
if blockbags[x].comb=blockbags[y].comb then
   return false;
fi;
s:=weightvectors[x]+weightvectors[y];
if HasLargerEntry(s,targetvector) then
   return false;
fi;
if allbinary or (IsSet(x) and IsSet(y)) then
   s:=Size(Intersection(blockbags[x].comb,blockbags[y].comb));
else 
   xx:=ListWithIdenticalEntries(v,0);
   yy:=ListWithIdenticalEntries(v,0);
   for i in blockbags[x].comb do 
      xx[i]:=xx[i]+1;
   od;
   for i in blockbags[y].comb do 
      yy[i]:=yy[i]+1;
   od;
   s:=0;
   for i in [1..v] do
      s:=s+Minimum(xx[i],yy[i]);
   od;
fi;
return 
   s in blockintersectionnumbers[Position(blocksizes,Length(blockbags[x].comb))][Position(blocksizes,Length(blockbags[y].comb))]; 
end;

#
# begin BlockDesigns

if not IsRecord(param) then
   Error("usage: BlockDesigns( <Record> )");
fi;
param:=ShallowCopy(param);
if not IsSubset(["v","blockSizes","tSubsetStructure","blockDesign",
                 "blockMaxMultiplicities","blockIntersectionNumbers",
   "r","blockNumbers","b","isoLevel","isoGroup",
   "requiredAutSubgroup"], 
                RecNames(param)) then
   Error("<param> contains an invalid component-name");
fi;   
if not IsSubset(RecNames(param),["v","blockSizes","tSubsetStructure"]) then
   Error("<param> missing a required component");
fi;   
v:=param.v;
if not IsPosInt(v) then
   Error("<param>.v must be positive integer");
fi;
blocksizes:=ShallowCopy(param.blockSizes);
if not (IsSet(blocksizes) and blocksizes<>[] and ForAll(blocksizes,IsPosInt)) then
   Error("<param>.blockSizes must be a non-empty set of positive integers"); 
fi;
if Length(blocksizes)=1 then 
   k:=blocksizes[1];
fi;
if not IsBound(param.blockDesign) then
   allbinary:=true;
else
   allbinary:=IsBinaryBlockDesign(param.blockDesign);
fi;
# Note: allbinary=true iff all possible blocks are sets.
tsubsetstructure:=ShallowCopy(param.tSubsetStructure);
if not ForAll(tsubsetstructure.lambdas,x->IsInt(x) and x>=0) then
   Error("all <param>.tSubsetStructure.lambdas must be non-negative integers");
fi;
if not IsDuplicateFree(tsubsetstructure.lambdas) then
   Error("<param>.tSubsetStructure.lambdas must not contain duplicates");
fi;
if IsBound(tsubsetstructure.partition) then
   if Length(tsubsetstructure.partition)<>Length(tsubsetstructure.lambdas) then
      Error("<param>.tSubsetStructure.partition must have the same length\n",
            "as <param>.tSubsetStructure.lambdas");
   fi;
elif Length(tsubsetstructure.lambdas)<>1 then
   Error("must have Length(<param>.tSubsetStructure.lambdas)=1\n",
         "if <param>.tSubsetStructure.partition is unbound");
fi;
t:=tsubsetstructure.t;
if not (IsInt(t) and t>=0 and t<=v) then
   Error("<t> must be an integer with 0<=<t><=<v>");
fi;
if not ForAll(blocksizes,x->x>=t) then 
   Error("each element of <blocksizes> must be >= <t>");
fi;
if IsBound(tsubsetstructure.partition) then
   # check it
   if not ForAll(tsubsetstructure.partition,x->IsSet(x) and x<>[]) then 
      Error("the parts of the t-subset partition must be non-empty sets");
   fi;
   c:=Concatenation(tsubsetstructure.partition);
   if not ForAll(c,x->IsSet(x) and Size(x)=t) then
      Error("the parts of the t-subset partition must be sets of t-subsets");
   fi;
   if Length(c)<>Binomial(v,t) or Length(Set(c))<>Binomial(v,t) then
      Error("t-subset partition is not a partition of the t-subsets");
   fi;
fi;
maxlambda:=Maximum(tsubsetstructure.lambdas);
if maxlambda<1 then
   Error("at least one element of <param>.tSubsetStructure.lambdas must be positive");
fi;
if Length(tsubsetstructure.lambdas)=1 then
   # constant lambda 
   lambda:=tsubsetstructure.lambdas[1];
fi;
tsubsets:=Combinations([1..v],t);
if IsBound(param.blockMaxMultiplicities) then
   blockmaxmultiplicities:=ShallowCopy(param.blockMaxMultiplicities);
   if not (IsList(blockmaxmultiplicities) and ForAll(blockmaxmultiplicities,x->IsInt(x) and x>=0)) then
      Error("<param>.blockMaxMultiplicities must be a list of non-negative integers");
   fi;   
   if Length(blockmaxmultiplicities)<>Length(blocksizes) then 
      Error("must have Length(<param>.blockMaxMultiplicities)=Length(<param>.blockSizes)");
   fi;
   blockmaxmultiplicities:=List(blockmaxmultiplicities,x->Minimum(x,maxlambda));
   # since *every* possible block is required to contain at least 
   # t  distinct points.
else 
   blockmaxmultiplicities:=ListWithIdenticalEntries(Length(blocksizes),maxlambda);
fi;
if IsBound(param.blockIntersectionNumbers) then
   blockintersectionnumbers:=StructuralCopy(param.blockIntersectionNumbers);
   if Length(blockintersectionnumbers)<>Length(blocksizes) then 
      Error("must have Length(<param>.blockIntersectionNumbers>)=Length(<param>.blockSizes>)");
   fi;
   blockintersectionnumbers:=List(blockintersectionnumbers,x->List(x,Set));
   if blockintersectionnumbers<>TransposedMat(blockintersectionnumbers) then
      Error("<blockintersectionnumbers> must be a symmetric matrix");
   fi;
else 
   blockintersectionnumbers:=List([1..Length(blocksizes)],x->List([1..Length(blocksizes)],
                      y->[0..Minimum(blocksizes[x],blocksizes[y])]));
fi;
if allbinary and maxlambda<=1 then 
   blockintersectionnumbers:=List(blockintersectionnumbers,x->List(x,y->Intersection(y,[0..t-1])));
fi;
# Compute the number  ntflags  of (t-subset,block)-flags 
# (counting multiplicities). 
if IsBound(lambda) then
   ntflags:=lambda*Binomial(v,t); 
else
   ntflags:=tsubsetstructure.lambdas*List(tsubsetstructure.partition,Length);
fi;
if IsBound(param.blockNumbers) then
   blocknumbers:=ShallowCopy(param.blockNumbers);
   # We will require  blocknumbers[i]  blocks of size  blocksizes[i] 
   # for i=1,...,Length(blocknumbers).
   if not (IsList(blocknumbers) and ForAll(blocknumbers,x->IsInt(x) and x>=0)) then
      Error("<param>.blockNumbers must be a list of non-negative integers"); 
   fi;
   if Length(blocknumbers)<>Length(blocksizes) then
      Error("must have Length(<param>.blockNumbers)=Length(<param>.blockSizes)");
   fi;
   b:=Sum(blocknumbers);
   if b=0 then
      Error("At least one element of <param>.blockNumbers must be positive");  
   fi;
   if allbinary and IsBound(ntflags) then 
      # compute the number  s  of (t-subset,block)-flags and compare to  ntflags
      s:=Sum([1..Length(blocknumbers)],i->blocknumbers[i]*Binomial(blocksizes[i],t));
      if s<>ntflags then
         return [];
      fi;
   fi;
   if t=0 and tsubsetstructure.lambdas[1]<>Sum(blocknumbers) then 
      # contradictory blocknumbers
       return [];
   fi;
fi;
if IsBound(param.b) then
   # We will require exactly  param.b > 0 blocks.
   if not IsPosInt(param.b) then
      Error("<param>.b must be a positive integer");  
   fi;
   if IsBound(b) and b<>param.b then
      # required block design cannot have  param.b  blocks. 
      return [];
   fi;
   b:=param.b;
   if IsBound(k) and allbinary and IsBound(ntflags) and
      b<>ntflags/Binomial(k,t) then
      # required block design cannot exist. 
      return [];
   fi;
fi;
if IsBound(param.r) then
   # We will require constant replication number = param.r > 0.
   if not IsPosInt(param.r) then
      Error("<param>.r must be a positive integer");
   fi;
   r:=param.r;
fi;
if t>=1 and allbinary and IsBound(k) and IsBound(lambda) and k<=v then
   # compute the replication number  s  (and compare to  r,  if bound).
   s:=lambda*Binomial(v-1,t-1)/Binomial(k-1,t-1);
   if not IsInt(s) or IsBound(r) and r<>s then
      # no possible design
      return [];
   else 
      r:=s;
   fi;
fi;
if t=1 and IsBound(lambda) then
   # compute the replication number  s  (and compare to  r,  if bound).
   s:=lambda;
   if IsBound(r) and r<>s then
      # no possible design
      return [];
   else 
      r:=s;
   fi;
fi;
if allbinary and IsBound(k) and IsBound(lambda) then
   if k>v then
      # requirements force at least one block, but this is impossible
      return [];
   fi;
   #
   # We now have v,k,lambda>0, 0<=t<=k<=v, 
   # and are looking for t-(v,k,lambda) designs. 
   #
   s:=TDesignLambdas(t,v,k,lambda);
   if s=fail then
      # parameters t-(v,k,lambda) inadmissible
      return [];
   fi;
   blockmaxmultiplicities[1]:=Minimum(blockmaxmultiplicities[1],
      TDesignBlockMultiplicityBound(t,v,k,lambda));
   if blockmaxmultiplicities[1]<1 then
      return [];
   fi;
   if t>=2 then 
      if k<v and s[1]=v then
         # Possible SBIBD; each pair of distinct blocks must meet 
         # in exactly  s[3]  points.
         blockintersectionnumbers[1][1]:=
            Intersection(blockintersectionnumbers[1][1],[s[3]]);
      fi;
      designinfo:=rec(lambdavec:=Immutable(s));
      if lambda=1 then
         # We are looking for Steiner systems, so we know how many blocks
         # intersect a given block in a given number of points.
         designinfo.blockmmat:=[];
         T:=SteinerSystemIntersectionTriangle(t,v,k);
         T:=List([1..k+1],i->Binomial(k,i-1)*T[i][k+2-i]);
         designinfo.blockmmat[k]:=Immutable(T);
         for i in [0..k-1] do
            if T[i+1]=0 then
               RemoveSet(blockintersectionnumbers[1][1],i);
            fi;
         od;
      fi;
   fi;   
   if blockintersectionnumbers[1][1]=[] and s[1]>1 then
      return [];
   fi;
elif allbinary and t=2 and IsBound(lambda) then
   # We are looking for pairwise-balanced designs. 
   if (lambda*(v-1)) mod Gcd(List(blocksizes,x->x-1)) <> 0 then
      return [];
   fi;
   if (lambda*v*(v-1)) mod Gcd(List(blocksizes,x->x*(x-1))) <> 0 then
      return [];
   fi;
   if IsBound(b) then
      if b<lambda*Binomial(v,2)/Binomial(Maximum(blocksizes),2) 
         # b is too small
         or b>lambda*Binomial(v,2)/Binomial(Minimum(blocksizes),2) then
         # or b is too big
         return [];
      fi;
      if not (v in blocksizes) and b<v then
         # Generalized Fisher inequality is not satisfied.
         return [];
      fi;
   elif not (v in blocksizes) and 
      lambda*Binomial(v,2)/Binomial(Minimum(blocksizes),2)<v then
      # Generalized Fisher inequality is not satisfied.
      return [];
   fi;
   if IsBound(r) and IsBound(b) then
      designinfo:=rec(lambdavec:=Immutable([b,r,lambda]));
   fi;
elif allbinary and t=2 and IsBound(k) then
   lambdamat:=NullMat(v,v,Rationals);
   for i in [1..Length(tsubsetstructure.partition)] do
      for c in tsubsetstructure.partition[i] do
         lambdamat[c[1]][c[2]]:=tsubsetstructure.lambdas[i];
         lambdamat[c[2]][c[1]]:=lambdamat[c[1]][c[2]];
      od;
   od;
   for i in [1..v] do
      lambdamat[i][i]:=Sum(lambdamat[i])/(k-1);
      if not IsInt(lambdamat[i][i]) or 
        (IsBound(r) and lambdamat[i][i]<>r) then
         return [];
      fi;
   od; 
   if ForAll([1..v],i->lambdamat[i][i]=lambdamat[1][1]) then
      r:=lambdamat[1][1];
   fi;
   bb:=Sum(List([1..v],i->lambdamat[i][i]))/k;
   if not IsInt(bb) or (IsBound(b) and b<>bb) then 
      return [];
   else
      b:=bb;
   fi;
   if IsBound(r) then
      designinfo:=
         rec(lambdavec:=Immutable([b,r]),lambdamat:=Immutable(lambdamat));
   else
      designinfo:=
         rec(lambdavec:=Immutable([b]),lambdamat:=Immutable(lambdamat));
   fi;
fi;
for i in [1..Length(blockmaxmultiplicities)] do 
   if blockmaxmultiplicities[i]>1 and 
      not (blocksizes[i] in blockintersectionnumbers[i][i]) then 
      blockmaxmultiplicities[i]:=1;
   fi;
od;
if IsBound(designinfo) and Length(designinfo.lambdavec)>=3 then
   # Apply bound of Cameron and Soicher to each block max-multiplicity, 
   # and each block intersection size. 
   if Length(designinfo.lambdavec) mod 2 = 0 then
      lambdavec:=designinfo.lambdavec{[1..Length(designinfo.lambdavec)-1]};
   else
      lambdavec:=designinfo.lambdavec;
   fi;
   for i in [1..Length(blockmaxmultiplicities)] do
      m:=ListWithIdenticalEntries(blocksizes[i]+1,0);
      while m[blocksizes[i]+1]<=blockmaxmultiplicities[i] and 
         BlockIntersectionPolynomialCheck(m,lambdavec) do
         m[blocksizes[i]+1]:=m[blocksizes[i]+1]+1;
      od;
      blockmaxmultiplicities[i]:=m[blocksizes[i]+1]-1;
      if blockmaxmultiplicities[i]<0 then
         return [];
      fi;
      for jj in [0..blocksizes[i]] do
         m:=ListWithIdenticalEntries(blocksizes[i]+1,0);
         m[blocksizes[i]+1]:=1;
         m[jj+1]:=m[jj+1]+1;
         if not BlockIntersectionPolynomialCheck(m,lambdavec) then
            for j in [1..Length(blockmaxmultiplicities)] do
               RemoveSet(blockintersectionnumbers[i][j],jj);
            od;
         fi;
      od;
   od;
fi;
if ForAll(blockmaxmultiplicities,x->x=0) then
   # no blocks, but the given parameters force at least one block
   return [];
fi;
if IsBound(param.isoLevel) then 
   isolevel:=param.isoLevel;
else
   isolevel:=2;
fi;
if IsBound(param.blockDesign) then
   # We are computing subdesigns of  param.blockDesign
   if not IsBlockDesign(param.blockDesign) then
      Error("<param>.blockDesign must be a block design");
   fi;
   if v<>param.blockDesign.v then
      Error("must have <param>.v=<param>.blockDesign.v");
   fi;
fi;
if IsBound(param.isoGroup) then
   G:=param.isoGroup;
   # 
   # G  must preserve the point-set structure of the required subdesign(s),
   # as well as the multiset  param.blockDesign.blocks  
   # (if  param.blockDesign is given).  
   #
   if not IsPermGroup(G) or v<LargestMovedPoint(GeneratorsOfGroup(G)) then 
      Error("<param>.isoGroup must be a permutation group on [1..<v>]");
   fi;
   if IsBound(tsubsetstructure.partition) then
      for i in [1..Length(tsubsetstructure.partition)-1] do
         s:=tsubsetstructure.partition[i];
         if not ForAll(GeneratorsOfGroup(G),x->OnSetsSets(s,x)=s) then
            Error("t-subset structure not invariant under <param>.isoGroup");
         fi;
      od;
   fi;
   if IsBound(param.blockDesign) then 
      s:=param.blockDesign.blocks;
      if not ForAll(GeneratorsOfGroup(G),x->OnMultisetsRecursive(s,x)=s) then
         Error("<param>.blockDesign.blocks not invariant under <param>.isoGroup");
      fi;
   fi;
else
   if IsBound(param.blockDesign) then
      G:=AutGroupBlockDesign(param.blockDesign);
   else
      G:=SymmetricGroup(v);
      SetSize(G,Factorial(v));
   fi;
   if IsBound(tsubsetstructure.partition) and 
      Length(tsubsetstructure.partition)>1 then
      # G:=the subgroup of G fixing the t-subset structure (ordered) partition
      hom:=ActionHomomorphism(G,tsubsets,OnSets,"surjective");
      GG:=Image(hom);
      StabChainOp(GG,rec(limit:=Size(G)));
      for i in [1..Length(tsubsetstructure.partition)-1] do
         GG:=Stabilizer(GG,
             List(tsubsetstructure.partition[i],x->PositionSorted(tsubsets,x)),
             OnSets);
      od;
      G:=PreImage(hom,GG);
   fi;
fi;
if IsBound(param.requiredAutSubgroup) then 
   if not IsSubgroup(G,param.requiredAutSubgroup) then
      Error("<param>.requiredAutSubgroup must be a subgroup of <G>");
   fi;
   C:=param.requiredAutSubgroup;
else
   C:=Group(());
fi;
C:=AsSubgroup(G,C);
if IsBound(param.blockDesign) then
   B:=Collected(param.blockDesign.blocks);
   blockbags:=[]; # initialize list of possible blocks and multiplicities
   for c in B do 
      if IsSet(c[1]) then
         s:=c[1];
      else 
         s:=Set(c[1]);
      fi;
      if Length(s)<t then
         Error("cannot give possible block with fewer than <t> distinct elements");
      fi;
      if Length(c[1]) in blocksizes then
         # cannot reject this possible block out of hand
         d:=blockmaxmultiplicities[Position(blocksizes,Length(c[1]))];
         for i in Reversed([1..Minimum(c[2],d)]) do 
            Add(blockbags,rec(comb:=c[1],mult:=i)); 
         od;
      fi;
   od;
else 
   for i in [1..Length(blocksizes)] do
      if blocksizes[i]>v then
         blockmaxmultiplicities[i]:=0;
         # since allbinary=true here
      fi;
   od;
   if ForAll(blockmaxmultiplicities,x->x=0) then
      # no blocks, but the given parameters force at least one block
      return [];
   fi;
   blockbags:=Concatenation(List(Reversed([1..Length(blocksizes)]),i->
       List(Cartesian(Reversed([1..blockmaxmultiplicities[i]]),
               Combinations([1..v],blocksizes[i])),
               x->rec(mult:=x[1],comb:=x[2]))));
fi;
if IsBound(lambda) then 
   targetvector:=ListWithIdenticalEntries(Length(tsubsets),lambda);
else
   targetvector:=[];
   for i in [1..Length(tsubsetstructure.lambdas)] do
      for c in tsubsetstructure.partition[i] do
         targetvector[PositionSorted(tsubsets,c)]:=tsubsetstructure.lambdas[i];
      od;
   od;
fi;
if IsBound(param.r) then 
   targetvector:=Concatenation(targetvector,ListWithIdenticalEntries(v,r));
fi;
if IsBound(param.blockNumbers) then 
   Append(targetvector,blocknumbers);
fi;
if IsBound(param.b) then 
   Add(targetvector,b);
fi;
hom:=ActionHomomorphism(G,blockbags,act,"surjective");
GG:=Image(hom);
StabChainOp(GG,rec(limit:=Size(G)));
weightvectors:=List(blockbags,weightvector); # needed for function  rel
# Determine the least C-orbit representatives for the action
# of C on the positions in weightvectors.
L:=List(OrbitsDomain(C,tsubsets,OnSets),Minimum);
leastreps:=Set(List(L,x->PositionSorted(tsubsets,x)));
s:=Length(tsubsets);
if IsBound(param.r) then
   Append(leastreps,Set(List(OrbitsDomain(C,[1..v]),x->s+Minimum(x)))); 
   s:=s+v;
fi;
if IsBound(param.blockNumbers) then
   Append(leastreps,[s+1..s+Length(blocknumbers)]);
   s:=s+Length(blocknumbers);
fi;
if IsBound(param.b) then
   Add(leastreps,s+1);
fi;
# Make graph on "appropriate" collapsed Image(hom,C)-orbits.
CC:=Image(hom,C);
StabChainOp(CC,rec(limit:=Size(C)));
N:=Normalizer(G,C);
NN:=Image(hom,N);
StabChainOp(NN,rec(limit:=Size(N)));
S:=OrbitsDomain(NN,[1..Length(blockbags)]);
L:=[]; # initialize list of appropriate CC-orbits
for s in S do
   c:=Orbit(CC,s[1]);
   # check if  c  is appropriate
   if (not IsBound(designinfo) or PartialDesignCheck(designinfo,blockbags[c[1]].comb,blockbags{c})) and
      ForAll([2..Length(c)],x->rel(c[1],c[x])) and
      not HasLargerEntry(Sum(weightvectors{c}),targetvector) then
      #  c  is appropriate 
      Append(L,Orbit(NN,Set(c),OnSets));
   fi;
od;
testfurther:=IsBound(designinfo) and Size(NN)/Size(CC)>=Length(L); 
gamma:=Graph(NN,L,OnSets,
   function(x,y)
   local c;
   if not ForAll(y,z->rel(x[1],z)) or HasLargerEntry(
      Sum(weightvectors{x})+Sum(weightvectors{y}),targetvector) then
      return false;
   fi;
   if not testfurther then
      return true;
   fi;
   c:=Concatenation(blockbags{x},blockbags{y});
   return PartialDesignCheck(designinfo,blockbags[x[1]].comb,c) and 
      PartialDesignCheck(designinfo,blockbags[y[1]].comb,c); 
   end,
  true);     
KK:=CompleteSubgraphsMain(gamma,targetvector{leastreps},isolevel,
      false,true,
      List(gamma.names,x->Sum(weightvectors{x}){leastreps}),
      [1..Length(leastreps)]);
KK:=List(KK,x->rec(clique:=Union(List(x,y->gamma.names[y]))));
if isolevel=0 and Length(KK)>0 then
   # Compute the G-stabilizer of the single design.
   KK[1].stabpreim:=PreImage(hom,Stabilizer(GG,KK[1].clique,OnSets));
fi;
if isolevel=2 then
   #
   # Compute the G-stabilizers of the designs, and perform
   # any GG-isomorph rejection which is not already known to 
   # have been performed by  Image(hom,Normalizer(G,C)).
   #
   justone:=Length(KK)=1;
   if not justone then
      isnormal:=IsNormal(G,C);
      if not isnormal then
         issylowtowergroup:=IsSylowTowerGroupOfSomeComplexion(C);
      fi;
   fi;
   L:=[];
   S:=[];
   for kk in KK do
      AA:=Stabilizer(GG,kk.clique,OnSets);
      A:=PreImage(hom,AA);
      kk.stabpreim:=A;
      if justone or isnormal or Size(C)=Size(A) or 
         Gcd(Size(C),Size(A)/Size(C))=1 and (issylowtowergroup or IsSolvableGroup(A)) or
         IsCyclic(C) and IsNilpotentGroup(A) and 
            ForAll(Set(FactorsInt(Size(C))),
               p->Index(A,SubgroupNC(A,List(GeneratorsOfGroup(A),g->g^p)))=p) or
         IsSimpleGroup(C) and IsNormal(A,C) and (Size(A) mod (Size(C)^2) <> 0) 
            then
         # KK  has just one element  or  C is normal in G  or  
         # C=A  or  C is a Hall subgroup of A and C has a Sylow tower  or
         # A is solvable and C is a Hall subgroup of A  or
         # A is nilpotent and C is contained in a cyclic
         # Hall pi(C)-subgroup of A  or
         # C is a simple normal subgroup of A and is the only
         # subgroup of A of its isomorphism type. 
         # Thus, Length(KK)=1  or  C is normal in G,  or
         # C is a "friendly" subgroup of A
         # (see: L.H. Soicher, On classifying objects with specified 
         # groups of automorphisms, friendly subgroups, and Sylow tower 
         # groups, Port. Math. 74 (2017), 233-242,  and
         # P. Hall, Theorems like Sylow's, Proc. London Math. Soc. (3) 6
         # (1956), 286-304.)
         # It follows that isomorph-rejection of GG-images of kk.clique 
         # has already been handled by  Image(hom,Normalizer(G,C)),  
         # and so no further isomorph-rejection (using GG) is needed.
         Add(L,kk);
      else
         s:=SmallestImageSet(GG,kk.clique,AA);
         if not (s in S) then 
            Add(S,s);
            Add(L,kk);
         fi;
      fi;
   od;
   KK:=L; 
fi;
ans:=[];
for kk in KK do
   blocks:=[];
   issimple:=true;
   for c in kk.clique do
      if blockbags[c].mult>1 then 
         issimple:=false;
      fi;
      for d in [1..blockbags[c].mult] do
         Add(blocks,blockbags[c].comb);
      od;
   od;
   blockdesign:=rec(isBlockDesign:=true,v:=v,blocks:=AsSortedList(blocks),
      tSubsetStructure:=Immutable(tsubsetstructure),  
      isBinary:=allbinary or ForAll(blocks,IsSet),isSimple:=issimple);
   blockdesign.blockSizes:=BlockSizes(blockdesign); 
   blockdesign.blockNumbers:=BlockNumbers(blockdesign);
   c:=ReplicationNumber(blockdesign);
   if c<>fail then
      blockdesign.r:=c;
   fi;
   if isolevel<>1 then
      if not IsBound(param.isoGroup) and 
         ( not IsBound(param.blockDesign) or 
            IsBound(param.blockDesign.autGroup) and 
               param.blockDesign.autGroup=SymmetricGroup(v) ) then
         blockdesign.autGroup:=kk.stabpreim;
      else 
         blockdesign.autSubgroup:=kk.stabpreim;
      fi;
   fi;
   if IsBound(param.blockDesign) and IsBound(param.blockDesign.pointNames) then
      blockdesign.pointNames:=Immutable(param.blockDesign.pointNames);
   fi;
   Add(ans,blockdesign);
od;
return ans;
end);

BindGlobal("PartitionsIntoBlockDesigns",function(param)
local t,v,b,blocksizes,k,r,lambda,tvector,tsubsets,tsubsetstructure,s,bb,rr,
      isolevel,blocknumbers,G,CC,nparts,count,orbs,orb,
      blockdesign,B,Belements,Bmults,D,BD,bd,BDind,bdc,m,
      KK,L,P,hom,BB,GG,ans,c,i,kk,partition,subdesignparam;
#
# Returns partitions of  param.blockDesign  into block designs with the given 
# parameters.  If  param.isoLevel=2  then the partitions are 
# classified up to the action of the group  G,  with G=param.isoGroup  if
# the latter is bound and G=AutGroupBlockDesign(param.blockDesign) otherwise.
#
if not IsRecord(param) then
   Error("usage: PartitionsIntoBlockDesigns( <Record> )");
fi;
param:=ShallowCopy(param);
if not IsSubset(["v","blockSizes","tSubsetStructure","blockDesign",
                 "blockMaxMultiplicities","blockIntersectionNumbers",
   "r","blockNumbers","b","isoLevel","isoGroup",
   "requiredAutSubgroup"], RecNames(param)) then
   Error("<param> contains an invalid component-name");
fi;   
if not IsSubset(RecNames(param),
                ["v","blockSizes","tSubsetStructure","blockDesign"]) then
   Error("<param> missing a required component");
fi;   
blockdesign:=param.blockDesign;
if not IsBlockDesign(blockdesign) then 
   Error("<param>.blockDesign must be a blockdesign");
fi;
v:=param.v;
if v<>blockdesign.v then
   Error("<param>.v must be equal to <param>.blockDesign.v");
fi;
blocksizes:=ShallowCopy(param.blockSizes);
if not (IsSet(blocksizes) and blocksizes<>[] and ForAll(blocksizes,IsPosInt)) then
   Error("<param>.blockSizes must be a non-empty set of positive integers"); 
fi;
if not IsSubset(blocksizes,BlockSizes(blockdesign)) then
   # no partition possible
   return [];
fi;
if Length(blocksizes)=1 then 
   k:=blocksizes[1];
fi;
tsubsetstructure:=ShallowCopy(param.tSubsetStructure);
t:=tsubsetstructure.t;
if not IsInt(t) or t<0 or t>v or not ForAll(blocksizes,x->x>=t) then 
   Error("must have <t> a non-negative integer <= <v>,\nand each element of <blocksizes> >= <t>");
fi;
if Maximum(tsubsetstructure.lambdas)<=0 then
   Error("at least one of <param>.tSubsetStructure.lambdas must be > 0");
fi;
if Length(tsubsetstructure.lambdas)=1 then
   lambda:=tsubsetstructure.lambdas[1];
fi;
B:=Collected(blockdesign.blocks);
Belements:=List(B,x->x[1]);
IsSet(Belements);
Bmults:=List(B,x->x[2]);
bb:=Length(blockdesign.blocks); 
tsubsets:=Combinations([1..v],t);
count:=TSubsetLambdasVector(blockdesign,t);
if IsBound(lambda) then
   tvector:=ListWithIdenticalEntries(Length(tsubsets),lambda);
else
   tvector:=ListWithIdenticalEntries(Length(tsubsets),0); # initialization
   for i in [1..Length(tsubsetstructure.partition)] do
      for c in tsubsetstructure.partition[i] do
         tvector[PositionSorted(tsubsets,c)]:=tsubsetstructure.lambdas[i];
      od;
   od;
fi;
i:=First([1..Length(tvector)],x->tvector[x]>0);
nparts:=count[i]/tvector[i];
if not IsInt(nparts) or nparts=0 or 
   not ForAll([1..Length(tsubsets)],x->count[x]=nparts*tvector[x]) then
   return [];
fi;
if IsBound(param.b) then
   b:=param.b;
   # We will require each subdesign to have exactly  b  blocks. 
   if not IsPosInt(b) then
      Error("<param>.b must be a positive integer");  
   fi; 
   if nparts<>bb/b then
      # no partition is possible
      return [];
   fi;
fi;
if IsBound(param.blockNumbers) then
   blocknumbers:=ShallowCopy(param.blockNumbers);
   # We will require each subdesign to have blocknumbers[i] blocks 
   # of size  blocksizes[i],  for i=1,...,Length(blocksizes).
   if IsBound(b) and b<>Sum(blocknumbers) then
      # contradictory  b
      return [];
   else
      b:=Sum(blocknumbers);
   fi;
   if b<=0 then
      Error("Must have Sum( <param>.blockNumbers ) > 0");  
   fi; 
   blocksizes:=blocksizes{Filtered([1..Length(blocknumbers)],x->blocknumbers[x]<>0)};
   blocknumbers:=Filtered(blocknumbers,x->x<>0); 
   if blocksizes<>BlockSizes(blockdesign) or nparts*blocknumbers<>BlockNumbers(blockdesign) then
      # no partition is possible
      return [];
   fi;
fi;
if IsBound(param.r) then 
   if not IsPosInt(param.r) then
      Error("<param>.r must be a positive integer");
   fi;
   r:=param.r;
   rr:=ReplicationNumber(blockdesign); 
   if rr=fail then
      # param.blockDesign is not equireplicate, but required subdesigns are,
      # so no partition.
      return [];
   fi;
   if rr/r<>nparts then
      return [];
   fi;
fi;
if t=1 and IsBound(lambda) and lambda=1 then
   # We are looking for resolutions.
   if not IsBinaryBlockDesign(blockdesign) then
      # no resolution
      return [];
   fi;
   if IsBound(k) then
      if v mod k <> 0 then 
         # no parallel classes
         return [];
      fi;
   fi;
fi; 
if IsBinaryBlockDesign(blockdesign) and IsBound(k) and IsBound(lambda) then
   if k>v or TDesignBlockMultiplicityBound(t,v,k,lambda)<1 then
      # no required subdesigns
      return [];
   fi;
   s:=TDesignLambdas(t,v,k,lambda); 
   if s=fail then
      # parameters t-(v,k,lambda) inadmissible 
      return [];
   fi;
   if IsBound(b) and b<>s[1] then
      # contradictory  b 
      return [];
   elif nparts<>bb/s[1] then
      # no partition
      return [];
   else
      b:=s[1];
   fi;
   if t>=1 then
      if IsBound(r) and r<>s[2] then
         # contradictory  r 
         return [];
      else
         r:=s[2];
         if not IsBound(rr) then
            rr:=ReplicationNumber(blockdesign);
            if rr=fail then
               # param.blockDesign is not equireplicate, but required 
               # subdesigns are, so no partition.
               return [];
            fi;
         fi;
         if rr/r<>nparts then
            return [];
         fi;
      fi;
   fi;
fi;
if IsBound(r) 
   # we are partitioning into  nparts  equireplicate designs
   and IsBinaryBlockDesign(blockdesign) and not (v in BlockSizes(blockdesign)) 
   and PairwiseBalancedLambda(blockdesign)<>fail  
   # blockdesign is a pairwise balanced design with no complete blocks
   and NrBlockDesignBlocks(blockdesign)-nparts+1 < v then
   # Generalized Bose inequality for a PBD partitioned into  nparts
   # equireplicate designs fails; no required partition exists.
   return [];
fi;  
if IsBound(param.isoGroup) then 
   G:=param.isoGroup;
else 
   G:=AutGroupBlockDesign(blockdesign);
fi;
subdesignparam:=ShallowCopy(param);
subdesignparam.isoLevel:=1;
subdesignparam.requiredAutSubgroup:=Group(());
subdesignparam.isoGroup:=G;
D:=BlockDesigns(subdesignparam);
if D=[] then 
   # no required partition exists (since the block multiset 
   # of param.blockDesign is non-empty)
   return [];
fi;
BD:=List(D,x->x.blocks);
BDind:=List(BD,x->List(x,y->PositionSorted(Belements,y)));
hom:=ActionHomomorphism(G,Belements,OnMultisetsRecursive,"surjective");
GG:=Image(hom);
StabChainOp(GG,rec(limit:=Size(G)));
orbs:=Orbits(GG,BDind,OnMultisetsRecursive);
BB:=[]; # Initialize multiset of possible multisets of block(-indice)s.
for orb in orbs do
   bdc:=Collected(orb[1]);
   m:=Minimum(List(bdc,x->QuoInt(Bmults[x[1]],x[2])));
   for c in orb do
      for i in [1..m] do 
         Add(BB,c); 
      od;
   od;
od;
Sort(BB);
L:=Set(Bmults);
P:=List([1..Length(L)],x->[]); # initialize 1-subset partition
for i in [1..Length(Belements)] do
   Add(P[PositionSorted(L,Bmults[i])],[i]);
od;
if IsBound(param.isoLevel) then
   isolevel:=param.isoLevel;
else
   isolevel:=2;
fi;
if IsBound(param.requiredAutSubgroup) then 
   if not IsSubgroup(G,param.requiredAutSubgroup) then 
      Error("<param>.requiredAutSubgroup must be a subgroup of <G>");
   fi;
   CC:=Image(hom,param.requiredAutSubgroup);
else
   CC:=Group(());
fi;
KK:=BlockDesigns(rec(v:=Length(Belements),blockSizes:=Set(List(BD,Length)),
       tSubsetStructure:=rec(t:=1,partition:=P,lambdas:=L),
       isoLevel:=isolevel,requiredAutSubgroup:=CC,isoGroup:=GG,
       blockDesign:=rec(isBlockDesign:=true,v:=Length(Belements),blocks:=BB)));
ans:=[];
for kk in KK do
   partition:=List(kk.blocks,block->Belements{block});
   # now convert  partition  to a list of block designs
   partition:=List(partition,part->rec(isBlockDesign:=true,
                                        v:=param.blockDesign.v,
                                        blocks:=Immutable(part)));
   if IsBound(param.blockDesign.pointNames) then
      for c in partition do
         c.pointNames:=Immutable(param.blockDesign.pointNames);
      od;
   fi;
   if isolevel=1 then
      Add(ans,rec(partition:=partition));
   elif not IsBound(param.isoGroup) then 
      Add(ans,rec(partition:=partition,autGroup:=PreImage(hom,kk.autSubgroup)));
   else
      Add(ans,rec(partition:=partition,autSubgroup:=PreImage(hom,kk.autSubgroup)));
   fi;
od;
return ans;
end);

BindGlobal("SemiLatinSquareDuals",function(arg)
#
# Function to classify the (n x n)/k semi-Latin squares
# with given properties. Returns a list of the duals 
# of these squares.
#
local n,k,blockmaxmultiplicity,blockintersectionsizes,isolevel,
   tau,Sngens,C,G,W,B,S,s,i,blockdesign,pointnames,WW;

n:=arg[1];
if not IsPosInt(n) then 
   Error("<n> must be a positive integer");
fi;
k:=arg[2];
if not IsPosInt(k) then 
   Error("<k> must be a positive integer");
fi;
if IsBound(arg[3]) and arg[3]<>"default" then
   blockmaxmultiplicity:=arg[3];
   if not IsPosInt(blockmaxmultiplicity) then
      Error("<blockmaxmultiplicity> must be a positive integer");
   fi;
   blockmaxmultiplicity:=Minimum(blockmaxmultiplicity,k);
else 
   blockmaxmultiplicity:=k; 
fi;
if IsBound(arg[4]) and arg[4]<>"default" then
   blockintersectionsizes:=arg[4];
   if not (IsList(blockintersectionsizes) and 
      ForAll(blockintersectionsizes,IsInt)) then
      Error("<blockintersectionsizes> must be a list of integers");
   fi;
   blockintersectionsizes:=Intersection(blockintersectionsizes,[0..n]);
else
   blockintersectionsizes:=[0..n];
fi;
if n>=2 and k>=n and IsSubset([0,1],blockintersectionsizes) then
   return [];
fi;
if blockmaxmultiplicity>1 and not (n in blockintersectionsizes) then
   blockmaxmultiplicity:=1;
fi;
if IsBound(arg[5]) and arg[5]<>"default" then 
   isolevel:=arg[5];
   if not (isolevel in [0,1,2,3,4]) then
      Error("must have <isolevel> in [0,1,2,3,4]");
   fi;
else
   isolevel:=2;
fi;
pointnames:=Immutable(Cartesian([1..n],[1..n]));
Sngens:=GeneratorsOfGroup(SymmetricGroup([1..n]));
tau:=Product(List([1..n],i->(i,i+n)));
if isolevel in [0,1,2] then
   # for weak isomorphism
   WW:=Group(Concatenation(Sngens,[tau]),());
else
   # for strong isomorphism
   WW:=Group(Concatenation(Sngens,List(Sngens,g->g^tau)),());
fi;
W:=Action(WW,pointnames,
      function(x,g) 
      #
      # Product action of the standard imprimitive wreath product Sn wr C2.
      # n  is global.
      #
      local y;
      y:=OnSets([x[1],x[2]+n],g);
      return [y[1],y[2]-n];
      end); 
if isolevel in [0,1,2] and n>1 then
   SetSize(W,2*Factorial(n)^2); 
fi;
if isolevel in [3,4] then
   # W has been set up so that isomorphism means strong
   # isomorphism, and we now reset isolevel to its usual meaning.
   # Note that the concept of isomorphism may be further refined
   # by the use of an isogroup.
   SetSize(W,Factorial(n)^2); 
   isolevel:=isolevel-2;
fi;
if IsBound(arg[6]) and arg[6]<>"default" then 
   C:=arg[6];
   if not IsPermGroup(C) then
      Error("the requiredautsubgroup <C> must be a permutation group");
   fi;
else
   C:=Group(());
fi;
if IsBound(arg[7]) and arg[7]<>"default" then
   G:=arg[7];
   if not (IsPermGroup(G) and IsSubgroup(W,G)) then
      Error("the isogroup <G> must be a subgroup of <W>");
   fi;
else
   G:=W;
fi;
if not IsSubgroup(G,C) then
   Error("the requiredautsubgroup <C> must be a subgroup of the isogroup <G>");
fi;
if IsBound(arg[8]) and arg[8]<>"default" then
   # arg[8] contains the multiset of possible blocks 
   # (in the sorted list of sorted lists format).  
   blockdesign:=BlockDesign(n^2,arg[8]); # provides checks
else
   B:=[];
   S:=Set(Orbit(W,List([1..n],i->(i-1)*n+i),OnSets));
   for s in S do 
      for i in [1..blockmaxmultiplicity] do 
         Add(B,s);
      od;
   od;
   blockdesign:=rec(isBlockDesign:=true,v:=n^2,blocks:=Immutable(B));
fi;
S:=BlockDesigns(rec(v:=n^2,blockSizes:=[n],
      tSubsetStructure:=rec(t:=1,lambdas:=[k]),
      blockMaxMultiplicities:=[blockmaxmultiplicity],
      blockIntersectionNumbers:=[[blockintersectionsizes]],
      isoLevel:=isolevel,
      requiredAutSubgroup:=C,
      isoGroup:=G,
      blockDesign:=blockdesign));
for s in S do
   s.pointNames:=pointnames;
od;
return S;
end);

BindGlobal("MakeResolutionsComponent",function(arg)
#
# This function determines resolutions of the block design  D=arg[1],
# and uses the result of its computation to add (or replace) the 
# `resolutions' component of  D.  
#
# The parameter isolevel=arg[2]  (default: 2)  determines how many 
# resolutions are computed.  isolevel=2 means to classify up to the action
# of AutGroupBlockDesign(D), isolevel=1 means to determine at
# least one representative from each AutGroupBlockDesign(D)-orbit, 
# and isolevel=0 means to determine whether or not  D  has a resolution.  
#
# This function computes the record `<D>.resolutions', which 
# has the following three components: 
#    `pairwiseNonisomorphic' (boolean or "unknown"), 
#    `allClassesRepresented' (boolean or "unknown"), and 
#    `list' (of distinct partitions into block designs forming resolutions).
#
local D,isolevel,L,resolutions;
D:=arg[1];
if not IsBound(arg[2]) or arg[2]="default" then 
   isolevel:=2;
else
   isolevel:=arg[2];
fi;
if not IsBlockDesign(D) or not IsInt(isolevel) then 
   Error("usage: MakeResolutionsComponent( <BlockDesign> [, <Int> ] )");
fi;
if not isolevel in [0,1,2] then
   Error("<isolevel> must be 0, 1, or 2");
fi;   
L := PartitionsIntoBlockDesigns(rec(
   blockDesign:=D, v:=D.v, blockSizes:=BlockSizes(D),
   tSubsetStructure:=rec(t:=1,lambdas:=[1]),
   isoLevel:=isolevel));
resolutions:=rec(list:=L);
if isolevel=0 then  
   resolutions.pairwiseNonisomorphic:=true;
   if L=[] or BlockSizes(D)=[D.v/2] or AffineResolvableMu(D)<>fail then 
      # D has at most one resolution
      resolutions.allClassesRepresented:=true;
   else  
      resolutions.allClassesRepresented:="unknown";
   fi;  
elif isolevel=1 then   
   if Length(L)<=1 then
      resolutions.pairwiseNonisomorphic:=true;
   else  
      resolutions.pairwiseNonisomorphic:="unknown";
   fi;  
   resolutions.allClassesRepresented:=true;
else 
   # isolevel=2   
   resolutions.pairwiseNonisomorphic:=true;
   resolutions.allClassesRepresented:=true;
fi;   
D.resolutions:=Immutable(resolutions);
end);

BindGlobal("PointBlockIncidenceMatrix",function(D)
#
# Returns the (immutable) point-block incidence matrix of the block design D.
#
local v,b,i,j,blocks,N;
if not IsBlockDesign(D) then
   Error("usage: PointBlockIncidenceMatrix( <BlockDesign> )");
fi;
v:=NrBlockDesignPoints(D);
b:=NrBlockDesignBlocks(D);
blocks:=BlockDesignBlocks(D);
N:=NullMat(v,b,Rationals);
for j in [1..b] do
   for i in blocks[j] do
      N[i][j]:=N[i][j]+1;
   od;
od;
return Immutable(N);
end);

BindGlobal("ConcurrenceMatrix",function(D)
#
# Returns the (immutable) point-concurrence matrix of the block design D.
#
local N;
if not IsBlockDesign(D) then
   Error("usage: ConcurrenceMatrix( <BlockDesign> )");
fi;
N:=PointBlockIncidenceMatrix(D);
return Immutable(N*TransposedMat(N));
end);

BindGlobal("InformationMatrix",function(D)
#
# Returns the (immutable) information matrix of the block design D.
#
local blocks,T,i,N;
if not IsBlockDesign(D) then
   Error("usage: InformationMatrix( <BlockDesign> )");
fi;
blocks:=BlockDesignBlocks(D);
N:=PointBlockIncidenceMatrix(D);
T:=TransposedMatMutable(N);
for i in [1..Length(blocks)] do
   T[i]:=Length(blocks[i])^(-1)*T[i];
od;
return Immutable(DiagonalMat(TSubsetLambdasVector(D,1))-N*T);
end);

BindGlobal("DESIGN_IntervalForLeastRealZero",function(f,a,b,eps)
#
# Suppose that  f  is a univariate polynomial over the rationals, 
# a,b are rational numbers with a<=b, and eps is a positive rational. 

# If  f  has no real zero in the closed interval  [a,b],  then this
# function returns the empty list  [].  Otherwise, let  alpha  be
# the least real zero of  f  such that  a<=alpha<=b.  Then this function
# returns a list  [c,d]  of rational numbers, with  c<=d,  d-c<=eps, 
# and  c<=alpha<=d.  Moreover,  c=d  if and only if  alpha  is rational
# (in which case  alpha=c=d).
#
local SturmSequence,NrRealZeros,c,d,rationalzeros,minrationalzero,z,x,s,nr,mid;

SturmSequence := function(f) 
#
# Returns the Sturm sequence for  f,  when  f  is a non-zero
# univariate polynomial over the rationals.
#
local s,g,r;
if not IsUnivariatePolynomial(f) then
   Error("usage: SturmSequence( <UnivariatePolynomial> )");
elif not ForAll(CoefficientsOfUnivariatePolynomial(f),IsRat) then
   Error("<f> must be a polynomial over the rationals");
elif IsZero(f) then
   Error("<f> must be a non-zero polynomial");
fi;
s:=[f]; # initialize the Sturm sequence
g:=Derivative(f);
while not IsZero(g) do
   Add(s,g);
   r:=-EuclideanRemainder(f,g);
   f:=g;
   g:=r;
od;
return s;
end;

NrRealZeros := function(s,a,b)
#
# Assume that  s  is the Sturm sequence for  f:=s[1], where  f  is a non-zero
# square-free univariate polynomial over the rationals.
#
# Additionally suppose that  a  and  b  are rational numbers, neither of 
# which is a zero of  f. 
#
# Then this function returns the number of real zeros of  f  in the 
# interval  [a,b].  

local f,lastterm,i,va,vb,ca,cb;
f:=s[1];
if Value(f,a)=0 or Value(f,b)=0 then
   Error("neither <a> nor <b> should be a zero of f:=<s>[1]");
fi;
lastterm:=s[Length(s)]; 
if IsZero(lastterm) or not IsConstantRationalFunction(lastterm) then
   Error("<s> must be the Sturm sequence of a square-free polynomial");
fi;
if a>=b then
   return 0;
fi;
va:=Filtered(List(s,g->Value(g,a)),v->v<>0);
vb:=Filtered(List(s,g->Value(g,b)),v->v<>0);
ca:=0;
for i in [2..Length(va)] do 
   if (va[i-1]<0 and va[i]>0) or (va[i-1]>0 and va[i]<0) then
      ca:=ca+1;
   fi;
od;
cb:=0;
for i in [2..Length(vb)] do 
   if (vb[i-1]<0 and vb[i]>0) or (vb[i-1]>0 and vb[i]<0) then
      cb:=cb+1;
   fi;
od;
return ca-cb; 
end;

if not (IsUnivariatePolynomial(f) and IsRat(a) and IsRat(b) and IsPosRat(eps)) then
   Error("usage: DESIGN_IntervalForLeastRealZero( <UnivariatePolynomial>, <Rat>, <Rat>, <PosRat> )");
elif not ForAll(CoefficientsOfUnivariatePolynomial(f),IsRat) then
   Error("<f> must be a polynomial over the rationals");
elif a>b then
   Error("must have <a> <= <b>");
fi;
if Value(f,a)=0 then
   return [a,a];
elif a=b or DegreeOfLaurentPolynomial(f)=0 then
   return [];
fi;
f:=f/Gcd(f,Derivative(f)); # make  f  squarefree
rationalzeros:=RootsOfUPol(Rationals,f);
x:=IndeterminateOfUnivariateRationalFunction(f);
for z in rationalzeros do
   f:=f/(x-z);
od;
# Now  f  is squarefree and has no rational zero.
rationalzeros:=Filtered(rationalzeros,z->a<=z and z<=b);
s:=SturmSequence(f);
if rationalzeros<>[] then
   minrationalzero:=Minimum(rationalzeros); 
   nr:=NrRealZeros(s,a,minrationalzero);
   if nr=0 then
      # alpha=minrationalzero
      return [minrationalzero,minrationalzero];
   else
      # alpha<minrationalzero, so set new upper bound for search for  alpha
      b:=minrationalzero;
   fi;
else
   nr:=NrRealZeros(s,a,b);
   if nr=0 then
      return [];
   fi;
fi;
# Now we know that the  alpha  we seek is in the interval  [a,b]  and is
# not rational.  We find the required interval  [c,d]  containing  alpha
# using bisection.
c:=a;
d:=b;
while d-c>eps do
   mid:=(c+d)/2;
   nr:=NrRealZeros(s,c,mid);
   if nr=0 then
      c:=mid;
   else
      d:=mid;
   fi;
od;
return [c,d];
end);
   
BindGlobal("BlockDesignEfficiency",function(arg)
#
# Suppose that  D:=arg[1]  is a  1-(v,k,r)  design with v >= 2.
# Then this function returns a record containing the  A,  Dpowered,
# and  Einterval  efficiency measures of  D,  as well as the monic
# polynomial whose zeros (counting multiplicities) are the canonical
# efficiency factors of  D.
#
# Note that the  Dpowered  efficiency measure is just 
# the  D  efficiency measure raised to the power  v-1 
# (to avoid irrationalities).  The interval  Einterval  (containing
# the E efficiency measure) has length <= eps:=arg[2] (default 10^(-6)).
# This length is in fact zero if the E-measure is rational. 
#
# If  includeMV:=arg[3]  is true  (default: false)  then the 
# MV efficiency measure must also be included. (It may be included
# even if  includeMV=false,  as a byproduct).  
#
local D,F,eps,v,b,r,k,cef,CEF,x,includeMV,P,M,pv,maxpv,i,j,eff;
D:=arg[1];
if IsBound(arg[2]) then 
   eps:=arg[2];
else
   eps:=10^(-6);
fi;
if IsBound(arg[3]) then 
   includeMV:=arg[3];
else
   includeMV:=false;
fi;
if not (IsBlockDesign(D) and IsPosRat(eps) and IsBool(includeMV)) then
   Error("usage: BlockDesignEfficiency( <BlockDesign> [, <PosRat> [, <Bool> ] ] )");
fi;
v:=NrBlockDesignPoints(D);
b:=NrBlockDesignBlocks(D);
if v<2 then
   Error("<D> must have at least two points");
fi;
r:=ReplicationNumber(D);
if r=fail or not IsBinaryBlockDesign(D) or Length(BlockSizes(D))<>1 then
   Error("<D> must be a 1-design");
fi;
if IsBound(D.efficiency) and IsBound(D.efficiency.CEFpolynomial) and 
   IsBound(D.efficiency.A) and IsBound(D.efficiency.Dpowered) then
   eff:=ShallowCopy(D.efficiency);
   if not IsBound(eff.Einterval) or eff.Einterval[2]-eff.Einterval[1]>eps then
      eff.Einterval:=
         DESIGN_IntervalForLeastRealZero(D.efficiency.CEFpolynomial,0,1,eps);
   fi;
   if IsBound(eff.MV) or not includeMV then 
      D.efficiency:=Immutable(eff);
      return D.efficiency;
   fi;
else
   # Make  eff.
   x:=Indeterminate(Rationals,1); 
   if b<v and b>1 and Length(BlockSizes(D))=1 then
      # Make the  CEFpolynomial  for  D  from that of its dual.
      k:=BlockSizes(D)[1];
      F:=k^(-1)*InformationMatrix(DualBlockDesign(D));  
      CEF:=(x-1)^(v-b)*(CharacteristicPolynomial(F,1)/x);
   else 
      F:=r^(-1)*InformationMatrix(D);
      CEF:=CharacteristicPolynomial(F,1)/x;
   fi;
   cef:=CoefficientsOfUnivariatePolynomial(CEF);
   # CEF  is the monic polynomial of degree  v-1  whose zeros (counting 
   # multiplicities) are the canonical efficiency factors of  D,  and
   # cef  is the vector of coefficients of  CEF  (in ascending order of 
   # the powers of the indeterminate).
   if cef[1]=0 then
      # The constant term of  CEF  is 0, so the design  D  is not connected.
      D.isConnected:=false;
      eff:=rec(A:=0,Dpowered:=0,Einterval:=[0,0],CEFpolynomial:=CEF,MV:=0);
      D.efficiency:=Immutable(eff);
      return D.efficiency;
   fi;
   # At this point, we know that  D  is connected. 
   eff:=rec(A:=(v-1)/(-cef[2]/cef[1]),
      Dpowered:=(-1)^(v-1)*cef[1],
      CEFpolynomial:=CEF, 
      Einterval:=DESIGN_IntervalForLeastRealZero(CEF,0,1,eps));
fi;
if includeMV then 
   F:=r^(-1)*InformationMatrix(D);
   P:=List([1..v],row->ListWithIdenticalEntries(v,1/v));
   M:=(F+P)^(-1)-P;  # M := Moore-Penrose inverse of F;
   maxpv:=0;  # max pairwise variance so far
   for i in [1..v] do 
      for j in [1..v] do
         if i<>j then
            pv:=M[i][i]+M[j][j]-M[i][j]-M[j][i];
            if pv>maxpv then
               maxpv:=pv;
            fi;
         fi;
      od;
   od;
   eff.MV:=2/maxpv;
fi;
D.efficiency:=Immutable(eff); 
return D.efficiency;
end);

[zur Elbe Produktseite wechseln0.90QuellennavigatorsAnalyse erneut starten2026-04-30]

                                                                                                                                                                                                                                                                                                                                                                                                     


Neuigkeiten

     Aktuelles
     Motto des Tages

Software

     Produkte
     Quellcodebibliothek

Aktivitäten

     Artikel über Sicherheit
     Anleitung zur Aktivierung von SSL

Muße

     Gedichte
     Musik
     Bilder

Jenseits des Üblichen ....

Besucherstatistik

Besucherstatistik

Monitoring

Montastic status badge