Spracherkennung für: .g vermutete Sprache: Masm {Masm[62] Apollo[58] Postscript[58]} [Methode: maximale Elemente, drei Dimensionen]
#############################################################################
##
## blockdesign_io.g Design
1.
8.
2 Package Leonard Soicher
##
##
# The
"GAP Expander/Writer" to expand the information about
# given (lists of) binary block designs,
and to print
#
this information in DTRS external representation XML-format.
#
# The
"GAP Reader" to read in (lists of) binary block designs in
# DTRS external representation XML-format,
and to convert these
# block designs into GAP-format.
#
# 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
#
DESIGN_DTRS_PROTOCOL :=
"2.0";
BindGlobal(
"extrep_index",function(i)
#
# Returns the external representation index corresponding to the GAP index i.
#
return i-
1;
end)
;
BindGlobal(
"extrep_lessthan_onelevel",function(x,y)
#
#
This function assumes that the elements of the lists x
and y are GAP-sorted
#
and that
for these elements, GAP less than is the same as extrep less than.
# Under these assumptions,
this boolean function returns true iff
# x is less than y in the (length-first, lex) extrep ordering.
#
return Length(x) < Length(y)
or (Length(x) = Length(y)
and x < y)
;
end)
;
BindGlobal(
"extrep_ordered_blocks",function(D)
#
# Returns the blocks of the block design D, ordered correctly
#
for the external representation.
#
local extrep_blocks
;
extrep_blocks := ShallowCopy(D.blocks)
;
Sort(extrep_blocks,extrep_lessthan_onelevel)
;
return extrep_blocks
;
end)
;
BindGlobal(
"infoXML",function(software,reference,note)
local info,x
;
info:=
"<info>\n";
for x in software do
Append(info,
"<software>\n")
;
Append(info,x)
;
Append(info,
"\n</software>\n")
;
od
;
for x in reference do
Append(info,
"<reference>\n")
;
Append(info,x)
;
Append(info,
"\n</reference>\n")
;
od
;
for x in note do
Append(info,
"<note>\n")
;
Append(info,x)
;
Append(info,
"\n</note>\n")
;
od
;
Append(info,
"</info>\n")
;
return info
;
end)
;
BindGlobal(
"zXML",function(i)
#
# Returns a
string giving the external representation of the
# integer i.
#
if not IsInt(i) then
Error(
"<i> must be an integer")
;
fi
;
return Concatenation(
"<z>",
String(i),
"</z>\n")
;
end)
;
BindGlobal(
"index_flagXML",function(index,flag)
return Concatenation(
"<index_flag\n",
" index=\"",String(index),"\
"\n flag=\"",String(flag),"\
"/>\n")
;
end)
;
BindGlobal(
"permutationXML",function(g,n)
#
# Returns the permutation g of degree n in external representation format.
#
local perm,x
;
perm:=
"<permutation>\n";
for x in [
1..n] do
Append(perm,zXML(extrep_index(x^g)))
;
od
;
Append(perm,
"</permutation>\n")
;
return perm
;
end)
;
BindGlobal(
"functionXML",function(domain_info,n,k,
title,preimages,images)
#
# (pseudo) functions with codomain = integers.
#
#
For an actual function, it is assumed that each preimage is already
# sorted in lexicographic order, but no ordering of these preimages is assumed
# (a shallow copy of these preimages is sorted
for external representation
# output).
#
local f,pre,im,i,x,y,on_indices,ordered
;
on_indices:=not IsInt(k)
or k<
0;
pre:=ShallowCopy(preimages)
;
im:=ShallowCopy(images)
;
if ForAll(pre,x->IsList(x)
and x<>
"blank") then
ordered:=true
;
# possibly pre=[
"entire_domain"]
if Length(pre)>
1 then
# Sort preimages
and images in parallel according to the
# explicit preimages. It is assumed that each preimage is already
# sorted in lexicographic order.
SortParallel(pre,im,extrep_lessthan_onelevel)
;
fi
;
else
# Do not
assume anything about the order of the (virtual) preimages.
ordered:=
"unknown";
fi
;
if on_indices then
# function on indices
f:=Concatenation(
"<function_on_indices\n domain=\"",
domain_info,
"\"\n n=\
"",
String(n),
"\"\n
");
else
# function on the k-subsets of indices
f:=Concatenation(
"<function_on_ksubsets_of_indices\n domain_base=\"",
domain_info,
"\"\n n=\
"",
String(n),
"\"\n k=\
"",
String(k),
"\"\n
");
fi
;
if title<>
"" then
Append(f,Concatenation(
" title=\"",title,"\
"\n"))
;
fi
;
Append(f,Concatenation(
" ordered=\"",String(ordered),"\
">\n"))
;
for i in [
1..Length(pre)] do
Append(f,
"<map>\n")
;
if pre[i]=
"blank" then
Append(f,
"<blank/>\n")
;
elif IsInt(pre[i]) then
Append(f,Concatenation(
"<preimage_cardinality>\n",zXML(pre[i]),
"</preimage_cardinality>\n"))
;
else
Append(f,
"<preimage>\n")
;
if Length(pre)=
1 then
Append(f,
"<entire_domain/>\n")
;
else
for x in pre[i] do
if on_indices then
Append(f,zXML(extrep_index(x)))
;
else
# on k-subsets of indices
Append(f,
"<ksubset>\n")
;
for y in x do
Append(f,zXML(extrep_index(y)))
;
od
;
Append(f,
"</ksubset>\n")
;
fi
;
od
;
fi
;
Append(f,
"</preimage>\n")
;
fi
;
Append(f,Concatenation(
"<image>\n",zXML(im[i]),
"</image>\n"))
;
Append(f,
"</map>\n")
;
od
;
if on_indices then
Append(f,
"</function_on_indices>\n")
;
else
# on k-subsets of indices
Append(f,
"</function_on_ksubsets_of_indices>\n")
;
fi
;
return f
;
end)
;
BindGlobal(
"point_concurrencesXML",function(D,T,full_preimages)
#
# Given a binary block design D,
this function returns the external
# representation of the t-wise point concurrences.
# full_preimages is boolean: it is true
if we want
# to
record full preimages
; false if we want to record
# preimage cardinalities only.
#
local t,tsubsetstructure,preimages,concur,
title;
if not IsBinaryBlockDesign(D) then
Error(
"<D> must be a binary block design")
;
fi
;
if T=[] then
return
"";
fi
;
concur:=
"<point_concurrences>\n";
T:=Set(T)
;
for t in T do
tsubsetstructure:=TSubsetStructure(D,t)
;
if Length(tsubsetstructure.lambdas)>
1 then
preimages:=tsubsetstructure.partition
;
else
preimages:=[
"entire_domain"]
;
fi
;
if t=
0 then
title:=
"number_of_blocks";
elif t=
1 then
title:=
"replication_numbers";
elif t=
2 then
title:=
"pairwise_point_concurrences";
else
title:=
"";
fi
;
if not full_preimages then
if Length(preimages)=
1 then
# entire domain, which is a special case
preimages:=[NrCombinations([
1..D.v],t)]
;
else
preimages:=List(preimages,Length)
;
fi
;
fi
;
Append(concur,
functionXML(
"points",D.v,t,
title,preimages,tsubsetstructure.lambdas))
;
od
;
Append(concur,
"</point_concurrences>\n")
;
return concur
;
end)
;
BindGlobal(
"block_concurrencesXML",function(D,T,full_preimages)
#
# Given a binary block design D,
this function returns the external
# representation of the t-wise block concurrences (intersection sizes)
# of the blocks.
# full_preimages is boolean: it is true
if we want
# to
record full preimages
; false if we want to record
# preimage cardinalities only.
#
local t,preimages,images,concur,
title,extrep_blocks,comb,pos,im
;
if not IsBinaryBlockDesign(D) then
Error(
"<D> must be a binary block design")
;
fi
;
if T=[] then
return
"";
fi
;
extrep_blocks:=extrep_ordered_blocks(D)
;
concur:=
"<block_concurrences>\n";
T:=Set(T)
;
for t in T do
preimages:=[]
;
images:=[]
;
if t=
0 then
preimages[
1]:=[[]]
;
images[
1]:=D.v
;
else
for comb in Combinations([
1..Length(extrep_blocks)],t) do
im:=Length(Intersection(extrep_blocks{comb}))
;
pos:=Position(images,im)
;
if pos=fail then
pos:=Length(images)+
1;
preimages[pos]:=[comb]
;
images[pos]:=im
;
else
Add(preimages[pos],comb)
; # maintaining preimages[pos] as a set
fi
;
od
;
fi
;
if t=
0 then
title:=
"number_of_points";
elif t=
1 then
title:=
"block_sizes";
elif t=
2 then
title:=
"pairwise_block_intersection_sizes";
else
title:=
"";
fi
;
if not full_preimages then
preimages:=List(preimages,Length)
;
fi
;
Append(concur,
functionXML(
"blocks",Length(extrep_blocks),t,
title,preimages,images))
;
od
;
Append(concur,
"</block_concurrences>\n")
;
return concur
;
end)
;
BindGlobal(
"t_design_propertiesXML",function(D)
local t_des,chosen_t,v,b,r,k,all_lambdas,steiner_system,steiner_system_t
;
all_lambdas:=AllTDesignLambdas(D)
;
if Length(all_lambdas)<=
2 then
# D is not a t-design with t>=
2
return
"";
fi
;
t_des:=
"<t_design_properties>\n";
chosen_t:=
2; # We regard D as a (chosen_t)-design.
# chosen_t can be any integer from
2 to the maximum t
for
# which D is a t-design.
#
For the
time being we fix chosen_t to be
2.
v:=D.v
;
b:=Length(D.blocks)
;
r:=all_lambdas[
2]
;
k:=BlockSizes(D)[
1]
;
Append(t_des,Concatenation(
"<parameters\n",
" t=\"",String(chosen_t),"\
"\n",
" v=\"",String(v),"\
"\n",
" b=\"",String(b),"\
"\n",
" r=\"",String(r),"\
"\n",
" k=\"",String(k),"\
"\n",
" lambda=\"",String(all_lambdas[chosen_t+1]),"\
"/>\n"))
;
Append(t_des,Concatenation(
"<square flag=\"",String(v=b),"\
"/>\n"))
;
Append(t_des,Concatenation(
"<projective_plane flag=\"",
String(v=(k-
1)^
2+k
and all_lambdas[
3]=
1),
"\"/>\n
"));
Append(t_des,Concatenation(
"<affine_plane flag=\"",
String(v=k^
2 and all_lambdas[
3]=
1),
"\"/>\n
"));
# We regard D as a Steiner system iff it is a t-(v,k,
1)
for some t>=
2.
steiner_system :=
1 in all_lambdas{[
3..Length(all_lambdas)]}
;
Append(t_des,Concatenation(
"<steiner_system flag=\"",
String(steiner_system),
"\""));
if steiner_system then
steiner_system_t:=Position(all_lambdas{[
3..Length(all_lambdas)]},
1)+
1;
Append(t_des,Concatenation(
"\n t=\"",String(steiner_system_t),"\
""))
;
fi
;
Append(t_des,
"/>\n")
;
Append(t_des,Concatenation(
"<steiner_triple_system flag=\"",
String(k=
3 and all_lambdas[
3]=
1),
"\"/>\n
"));
Append(t_des,
"</t_design_properties>\n")
;
return t_des
;
end)
;
BindGlobal(
"blocksXML",function(D)
local blocks,block,x
;
blocks:=
"<blocks ordered=\"true\
">\n";
for block in extrep_ordered_blocks(D) do
Append(blocks,
"<block>\n")
;
for x in block do
Append(blocks,zXML(extrep_index(x)))
;
od
;
Append(blocks,
"</block>\n")
;
od
;
Append(blocks,
"</blocks>\n")
;
return blocks
;
end)
;
BindGlobal(
"indicatorsXMLBlockDesign",function(D,
include)
local ind,equireplicate,r,constant_blocksize,k,resolvable,mu,
lambda,no_components,all_lambdas,t_design,maximum_t,
C,cyclic,one_rotational
;
if not (
"indicators" in
include) then
return
"";
fi
;
ind:=
"<indicators>\n";
Append(ind,Concatenation(
"<repeated_blocks flag=\"",
String(not IsSimpleBlockDesign(D)),
"\"/>\n
"));
constant_blocksize:=Length(BlockSizes(D))=
1;
if constant_blocksize then
k:=BlockSizes(D)[
1]
;
fi
;
r:=ReplicationNumber(D)
;
equireplicate := r<>fail
;
if equireplicate then
if constant_blocksize
and (D.v
mod k <>
0) then
resolvable:=false
;
fi
;
else
resolvable:=false
;
fi
;
if not IsBound(resolvable)
and IsBound(D.resolutions) then
if Length(D.resolutions.list)>
0 then
resolvable:=true
;
elif D.resolutions.allClassesRepresented in [true,
"true"] then
resolvable:=false
;
fi
;
fi
;
mu:=AffineResolvableMu(D)
;
if mu<>fail then
# D is affine resolvable
if IsBound(resolvable)
and resolvable=false then
Error(
"internal error: contradiction in value of <resolvable>")
;
fi
;
resolvable:=true
;
fi
;
if not IsBound(resolvable) then
if "resolutions" in
include then
MakeResolutionsComponent(D,
2)
;
resolvable:=D.resolutions.list<>[]
;
elif
"resolvable" in
include then
MakeResolutionsComponent(D,
0)
;
resolvable:=D.resolutions.list<>[]
;
fi
;
fi
;
if IsBound(resolvable) then
Append(ind,Concatenation(
"<resolvable flag=\"",String(resolvable),"\
"/>\n"))
;
fi
;
Append(ind,Concatenation(
"<affine_resolvable flag=\"",String(mu<>fail),"\
""))
;
if mu<>fail
and mu<>
0 then
Append(ind,Concatenation(
"\n mu=\"",String(mu),"\
""))
;
fi
;
Append(ind,
"/>\n")
;
Append(ind,Concatenation(
"<equireplicate flag=\"",
String(equireplicate),
"\""));
if equireplicate then
Append(ind,Concatenation(
"\n r=\"",String(r),"\
""))
;
fi
;
Append(ind,
"/>\n")
;
Append(ind,Concatenation(
"<constant_blocksize flag=\"",
String(constant_blocksize),
"\""));
if constant_blocksize then
Append(ind,Concatenation(
"\n k=\"",String(k),"\
""))
;
fi
;
Append(ind,
"/>\n")
;
all_lambdas:=AllTDesignLambdas(D)
;
t_design:=Length(all_lambdas)>
2; # we require t>=2
if t_design then
maximum_t:=Length(all_lambdas)-
1;
fi
;
Append(ind,Concatenation(
"<t_design flag=\"",String(t_design),"\
""))
;
if t_design then
Append(ind,Concatenation(
"\n maximum_t=\"",String(maximum_t),"\
""))
;
fi
;
Append(ind,
"/>\n")
;
no_components:=Length(ConnectedComponents(IncidenceGraphSupportBlockDesign(D)))
;
Append(ind,Concatenation(
"<connected flag=\"",String(no_components=1),
"\"\n no_components=\
"",
String(no_components),
"\"/>\n
"));
#
# balance properties
#
if D.v>
1 then
lambda:=PairwiseBalancedLambda(D)
;
Append(ind,Concatenation(
"<pairwise_balanced flag=\"",
String(lambda<>fail),
"\""));
if lambda<>fail then
Append(ind,Concatenation(
"\n lambda=\"",String(lambda),"\
""))
;
fi
;
Append(ind,
"/>\n")
;
if IsConnectedBlockDesign(D) then
Append(ind,Concatenation(
"<variance_balanced flag=\"",
String(IsVarianceBalanced(D)),
"\"/>\n
"));
if t_design then
# t>=
2,
and so our design is pairwise-balanced, as well as
# being binary, connected, equireplicate,
and having constant
# block-size.
Append(ind,
"<efficiency_balanced flag=\"true\
"/>\n")
;
elif Length(all_lambdas)=
2 then
# At
this point D is binary, connected, equireplicate,
and has
# constant blocksize, but is not pairwise-balanced.
Append(ind,
"<efficiency_balanced flag=\"false\
"/>\n")
;
#
else *** <efficiency_balanced> t.b.d.
fi
;
fi
;
fi
;
# # Now we do what can be done easily
for <partially_balanced>.
#
if t_design then
# # D is a
2-design
# Append(ind,
"<partially_balanced flag=\"true\
"/>\n")
;
# elif Length(all_lambdas)<
2 then
# # D is not a
1-design,
and so is not partially balanced.
# Append(ind,
"<partially_balanced flag=\"false\
"/>\n")
;
#
else
# # D *is* a
1-design
#
if CC_PermutationGroupProperties(
# AutGroupBlockDesign(D),D.v).isStratifiable=true then
# Append(ind,
"<partially_balanced flag=\"true\
"/>\n")
;
#
else
# # ***
for now
# Append(ind,
"<partially_balanced flag=\"unknown\
"/>\n")
;
# fi
;
# fi
;
# *** More needs to done about <efficiency_balanced>
and <partially_balanced>
# ***
for arbitrary (binary) block designs.
#
C:=ConjugacyClasses(AutGroupBlockDesign(D))
;
cyclic:=ForAny(C,x->CycleLengths(Representative(x),[
1..D.v])=[D.v])
;
one_rotational:=ForAny(C,x->
SortedList(CycleLengths(Representative(x),[
1..D.v]))=[
1,D.v-
1])
;
Append(ind,Concatenation(
"<cyclic flag=\"",String(cyclic),"\
"/>\n"))
;
Append(ind,Concatenation(
"<one_rotational flag=\"",
String(one_rotational),
"\"/>\n
"));
Append(ind,
"</indicators>\n")
;
return ind
;
end)
;
BindGlobal(
"permutation_groupXML",function(G,n,domain,include_properties)
local grp,g,x,C,c,i,pos,cyctypes,cyctypeinfos,flag,prop
;
grp:=Concatenation(
"<permutation_group\n degree=\"",String(n),
"\"\n order=\
"",
String(Size(G)),
"\"\n domain=\
"",domain,
"\">\n
");
Append(grp,
"<generators>\n")
;
for g in GeneratorsOfGroup(G) do
Append(grp,permutationXML(g,n))
;
od
;
Append(grp,
"</generators>\n")
;
if include_properties then
Append(grp,
"<permutation_group_properties>\n")
;
prop:=CC_PermutationGroupProperties(G,n)
;
Append(grp,Concatenation(
"<primitive flag=\"",
String(IsPrimitive(G,[
1..n])),
"\"/>\n
"));
Append(grp,Concatenation(
"<generously_transitive flag=\"",
String(prop.isGenerouslyTransitive),
"\"/>\n
"));
Append(grp,Concatenation(
"<multiplicity_free flag=\"",
String(prop.isMultiplicityFree),
"\"/>\n
"));
Append(grp,Concatenation(
"<stratifiable flag=\"",
String(prop.isStratifiable),
"\"/>\n
"));
Append(grp,Concatenation(
"<no_orbits value=\"",
String(Length(Orbits(G,[
1..n]))),
"\"/>\n
"));
Append(grp,Concatenation(
"<degree_transitivity value=\"",
String(Transitivity(G,[
1..n])),
"\"/>\n
"));
Append(grp,Concatenation(
"<rank value=\"",
String(prop.rank),
"\"/>\n
"));
# Compute cycle-type information
C:=ConjugacyClasses(G)
;
cyctypes:=[]
;
cyctypeinfos:=[]
;
for i in [
1..Length(C)] do
c:=SortedList(CycleLengths(Representative(C[i]),[
1..n]))
;
pos:=Position(cyctypes,c)
;
if pos=fail then
Add(cyctypes,c)
;
Add(cyctypeinfos,rec(
rep:=Representative(C[i]),count:=Size(C[i])))
;
else
cyctypeinfos[pos].count:=cyctypeinfos[pos].count+Size(C[i])
;
fi
;
SortParallel(cyctypes,cyctypeinfos,extrep_lessthan_onelevel)
;
od
;
Append(grp,
"<cycle_type_representatives>\n")
;
for i in [
1..Length(cyctypes)] do
Append(grp,
"<cycle_type_representative>\n")
;
Append(grp,permutationXML(cyctypeinfos[i].
rep,n))
;
Append(grp,
"<cycle_type ordered=\"true\
">\n")
;
for x in cyctypes[i] do
Append(grp,zXML(x))
;
od
;
Append(grp,
"</cycle_type>\n")
;
Append(grp,
"<no_having_cycle_type>\n")
;
Append(grp,zXML(cyctypeinfos[i].count))
;
Append(grp,
"</no_having_cycle_type>\n")
;
Append(grp,
"</cycle_type_representative>\n")
;
od
;
Append(grp,
"</cycle_type_representatives>\n")
;
Append(grp,
"</permutation_group_properties>\n")
;
fi
;
Append(grp,
"</permutation_group>\n")
;
return grp
;
end)
;
BindGlobal(
"automorphism_groupXMLBlockDesign",function(D,
include)
local aut,A,value,flag
;
if not (
"automorphism_group" in
include) then
return
"";
fi
;
A:=AutGroupBlockDesign(D)
;
aut:=
"<automorphism_group>\n";
Append(aut,permutation_groupXML(A,D.v,
"points",true))
;
Append(aut,
"<automorphism_group_properties>\n")
;
if IsSimpleBlockDesign(D) then
flag:=
String(IsPrimitive(A,D.blocks,OnSets))
;
else
flag:=
"not_applicable";
fi
;
Append(aut,Concatenation(
"<block_primitive flag=\"",flag,"\
"/>\n"))
;
if IsSimpleBlockDesign(D) then
value:=
String(Length(Orbits(A,D.blocks,OnSets)))
;
else
value:=
"not_applicable";
fi
;
Append(aut,Concatenation(
"<no_block_orbits value=\"",value,"\
"/>\n"))
;
if IsSimpleBlockDesign(D) then
value:=
String(Transitivity(A,D.blocks,OnSets))
;
else
value:=
"not_applicable";
fi
;
Append(aut,Concatenation(
"<degree_block_transitivity value=\"",value,"\
"/>\n"))
;
Append(aut,
"</automorphism_group_properties>\n")
;
Append(aut,
"</automorphism_group>\n")
;
return aut
;
end)
;
BindGlobal(
"resolutionsXML",function(D,
include)
local res,R,S,s,extrep_blocks,A,aut,g,Rlist,allrep,noniso
;
if not (
"resolvable" in
include)
and not (
"available_resolutions" in
include)
and not (
"resolutions" in
include) then
return
"";
fi
;
if "resolutions" in
include then
if not IsBound(D.resolutions)
or
not (D.resolutions.allClassesRepresented in [true,
"true"])
or
not (D.resolutions.pairwiseNonisomorphic in [true,
"true"]) then
MakeResolutionsComponent(D,
2)
;
fi
;
elif
"resolvable" in
include then
if not IsBound(D.resolutions)
or (D.resolutions.list=[]
and not (D.resolutions.allClassesRepresented in [true,
"true"])) then
MakeResolutionsComponent(D,
0)
;
fi
;
fi
;
if not IsBound(D.resolutions)
or D.resolutions.list=[] then
return
"";
fi
;
if "resolutions" in
include then
Rlist:=D.resolutions.list
;
allrep:=true
;
noniso:=true
;
elif
"available_resolutions" in
include then
Rlist:=D.resolutions.list
;
if D.resolutions.allClassesRepresented in [true,
"true"] then
allrep:=true
;
else
allrep:=
"unknown";
fi
;
if D.resolutions.pairwiseNonisomorphic in [true,
"true"] then
noniso:=true
;
else
noniso:=
"unknown";
fi
;
else
# we shall write out just one resolution
Rlist:=[D.resolutions.list[
1]]
;
if Length(D.resolutions.list)=
1 and
(D.resolutions.allClassesRepresented in [true,
"true"]) then
allrep:=true
;
else
allrep:=
"unknown";
fi
;
noniso:=true
;
fi
;
res:=Concatenation(
"<resolutions\n pairwise_nonisomorphic=\"",String(noniso),"\
"",
"\n all_classes_represented=\"",String(allrep),"\
">\n")
;
for R in Rlist do
Append(res,
"<resolution>\n")
;
extrep_blocks:=extrep_ordered_blocks(D)
;
S:=List(R.partition,x->List(x.blocks,
y->PositionSorted(extrep_blocks,y,extrep_lessthan_onelevel)))
;
for s in S do
Sort(s)
;
od
;
Sort(S,extrep_lessthan_onelevel)
;
Append(res,functionXML(
"blocks",Length(D.blocks),
"",
"resolution",S,
List([
1..Length(S)],extrep_index)))
;
if IsBound(R.autGroup) then
A:=R.autGroup
;
aut:=
"<automorphism_group>\n";
Append(aut,permutation_groupXML(A,D.v,
"points",false))
;
Append(aut,
"</automorphism_group>\n")
;
Append(res,aut)
;
fi
;
Append(res,
"</resolution>\n")
;
od
;
Append(res,
"</resolutions>\n")
;
return res
;
end)
;
BindGlobal(
"combinatorial_propertiesXML",function(D,
include)
local comb,i,r,
alpha;
if not (
"combinatorial_properties" in
include) then
return
"";
fi
;
comb:=
"<combinatorial_properties>\n";
if D.v=
1 then
# special case
Append(comb,point_concurrencesXML(D,[
1],true))
;
elif Length(AllTDesignLambdas(D))>
2 then
# D is a t-design with t>=
2
Append(comb,
point_concurrencesXML(D,[
1..Length(AllTDesignLambdas(D))-
1],true))
;
else
Append(comb,point_concurrencesXML(D,[
1,
2],true))
;
fi
;
if Length(D.blocks)=
1 then
# special case
Append(comb,block_concurrencesXML(D,[
1],false))
;
else
Append(comb,block_concurrencesXML(D,[
1,
2],false))
;
fi
;
Append(comb,t_design_propertiesXML(D))
;
#
r:=ReplicationNumber(D)
;
if r<>fail then
# D is equireplicate
Append(comb,
"<alpha_resolvable>\n")
;
if IsBound(D.resolutions)
and Length(D.resolutions.list)>
0 then
# D is
1-resolvable,
and so D is
alpha-resolvable
for all
# divisors
alpha of r.
for alpha in DivisorsInt(r) do
Append(comb,index_flagXML(
alpha,true))
;
od
;
else
#
for now
Append(comb,index_flagXML(r,true))
;
fi
;
Append(comb,
"</alpha_resolvable>\n")
;
fi
;
# ***
alpha resolvability needs to be worked on further.
#
Append(comb,
"<t_wise_balanced>\n")
;
if D.v=
1 then
# special case
Append(comb,index_flagXML(
1,true))
;
elif Length(AllTDesignLambdas(D))>
2 then
# D is a t-design with t>=
2
for i in [
1..Length(AllTDesignLambdas(D))-
1] do
Append(comb,index_flagXML(i,true))
;
od
;
else
Append(comb,index_flagXML(
1,ReplicationNumber(D)<>fail))
;
Append(comb,index_flagXML(
2,PairwiseBalancedLambda(D)<>fail))
;
fi
;
Append(comb,
"</t_wise_balanced>\n")
;
Append(comb,
"</combinatorial_properties>\n")
;
return comb
;
end)
;
BindGlobal(
"block_designXML",function(D,
include,id)
#
# Returns the binary block design D in external representation format.
#
# The list
include gives information on the combinatorial
and
# group-theoretical information to be exanded
for D.
#
This list should contain
zero or more of the strings
#
"indicators",
"resolvable",
"combinatorial_properties",
#
"automorphism_group",
and "resolutions".
#
# id is used as the id of the output design.
#
local block_design
;
if not IsBinaryBlockDesign(D) then
Error(
"<D> must be a binary block design")
;
fi
;
block_design:=Concatenation(
"<block_design\n id=\"", id, "\
"\n",
" v=\"", String(D.v), "\
"\n b=\"", String(Length(D.blocks)), "\
">\n")
;
Append(block_design,blocksXML(D))
;
if IsBound(D.point_labelsXML) then
Append(block_design,D.point_labelsXML)
;
# How to handle D.pointNames (
if bound) ???
fi
;
Append(block_design,indicatorsXMLBlockDesign(D,
include))
;
Append(block_design,combinatorial_propertiesXML(D,
include))
;
Append(block_design,automorphism_groupXMLBlockDesign(D,
include))
;
Append(block_design,resolutionsXML(D,
include))
;
if IsBound(D.statistical_propertiesXML) then
Append(block_design,D.statistical_propertiesXML)
;
fi
;
if IsBound(D.alternative_representationsXML) then
Append(block_design,D.alternative_representationsXML)
;
fi
;
if IsBound(D.infoXML) then
Append(block_design,D.infoXML)
;
fi
;
Append(block_design,
"</block_design>\n")
;
return block_design
;
end)
;
BindGlobal(
"BlockDesignsToXMLFile",function(arg)
#
# Let
filename = arg[
1], designs = arg[
2].
# Then
filename is a
string and designs a list
or record.
#
If designs is a list then designs := rec(list:=designs).
#
#
This function expands
and writes the external representation of the list
# designs.list of (assumed distinct) binary block designs to the file
# with name
filename.
#
# designs.pairwiseNonisomorphic (
if bound) should be `true
' or `false' or
# the
string "unknown", specifying the pairwise-nonisomorphism status
# of the designs in designs.list.
# designs.infoXML (
if bound) should contain a
string in XML format
for
# the info element of the list_of_designs which is written.
#
# The information output
for each design depends on
include = arg[
3],
# which should be the
string "all" or a list containing
zero or more of
# the strings
"indicators",
"resolvable",
"combinatorial_properties",
#
"automorphism_group",
"resolutions",
and "available_resolutions".
# A shorthand
for a list implying all these strings
# is
"all". The default
for include is [].
#
#
If list_id = arg[
4] is bound, then the id
's of the output designs
# will be
"list_id-0",
"list_id-1",
"list_id-2", ...
#
local filename,designs,
include,list_id,i,stream,design_id
;
filename:=arg[
1]
;
designs:=arg[
2]
;
if IsList(designs) then
designs:=rec(list:=designs)
;
fi
;
if not IsString(
filename)
or not IsRecord(designs) then
Error(
"usage: BlockDesignsToXMLFile( <String>, <List> or <Record> [, ... ] )")
;
fi
;
designs:=ShallowCopy(designs)
;
if not IsBound(designs.pairwiseNonisomorphic) then
if Length(designs.list)<
2 then
designs.pairwiseNonisomorphic:=true
;
else
designs.pairwiseNonisomorphic:=
"unknown";
fi
;
fi
;
if not IsBound(designs.infoXML) then
designs.infoXML:=infoXML(
[Concatenation(
"[ DESIGN-",InstalledPackageVersion(
"design"),
", GRAPE-",InstalledPackageVersion(
"grape"),
", GAPDoc-",InstalledPackageVersion(
"gapdoc"),
", GAP-",GAPInfo.
Version,
" ]")],
[],[])
;
fi
;
if IsBound(arg[
3]) then
if not IsList(arg[
3]) then
Error(
"<arg[3]> must be a list or the string \"all\
"")
;
fi
;
if arg[
3]=
"all" then
include:=[
"indicators",
"resolvable",
"combinatorial_properties",
"automorphism_group",
"resolutions"]
;
else
include:=arg[
3]
;
fi
;
if not IsSubset([
"indicators",
"resolvable",
"combinatorial_properties",
"automorphism_group",
"resolutions",
"available_resolutions"],
include) then
Error(
"<include> contains an invalid option")
;
fi
;
else
include:=[]
;
fi
;
if IsBound(arg[
4]) then
if not IsString(arg[
4]) then
Error(
"<arg[4]> must be a string")
;
fi
;
list_id:=arg[
4]
;
fi
;
stream:=OutputTextFile(
filename,false)
;
SetPrintFormattingStatus(stream,false)
;
PrintTo(stream,
"<?xml version=\"1.
0\
"?>\n")
; # starts file with XML header
AppendTo(stream,
"<list_of_designs\n",
" xmlns=\"http://designtheory.org/xml-namespace\
"\n",
" dtrs_protocol=\"",DESIGN_DTRS_PROTOCOL,"\
"\n",
" design_type=\"block_design\
"\n",
" pairwise_nonisomorphic=\"",String(designs.pairwiseNonisomorphic),"\
"\n",
" no_designs=\"",String(Length(designs.list)),"\
">\n")
;
if designs.infoXML<>
"" then
AppendTo(stream,designs.infoXML)
;
fi
;
AppendTo(stream,
"<designs>\n")
;
for i in [
1..Length(designs.list)] do
if IsBound(list_id) then
design_id:=Concatenation(list_id,
"-",
String(extrep_index(i)))
;
elif IsBound(designs.list[i].id) then
design_id:=designs.list[i].id
;
else
design_id:=Concatenation(
"design-",
String(extrep_index(i)))
;
fi
;
AppendTo(stream,block_designXML(designs.list[i],
include,design_id))
;
od
;
AppendTo(stream,
"</designs>\n")
;
AppendTo(stream,
"</list_of_designs>\n")
;
CloseStream(stream)
;
end)
;
#
# The Reader
#
BindGlobal(
"gap_index",function(i)
#
# Returns the GAP index corresponding to the external representation index i.
#
return i+
1;
end)
;
BindGlobal(
"IntFromParseTree",function(T)
local n,t,ch,C
;
n:=
"";
C:=Set([
'-',
'0',
'1',
'2',
'3',
'4',
'5',
'6',
'7',
'8',
'9'])
;
for t in T.content do
if t.name<>
"PCDATA" then
Error(
"should be PCDATA here")
;
fi
;
for ch in t.content do
if ch in C then
Add(n,ch)
;
fi
;
od
;
od
;
n:=
Int(n)
;
return n
;
end)
;
BindGlobal(
"BlockFromParseTree",function(T)
local t,block
;
block:=[]
;
for t in T.content do
if t.name=
"z" or t.name=
"n" then
Add(block,gap_index(IntFromParseTree(t)))
;
fi
;
od
;
return AsSortedList(block)
;
end)
;
BindGlobal(
"BlocksFromParseTree",function(T)
local t,blocks
;
blocks:=[]
;
for t in T.content do
if t.name=
"block" then
Add(blocks,BlockFromParseTree(t))
;
fi
;
od
;
return AsSortedList(blocks)
;
end)
;
BindGlobal(
"BlockDesignFromParseTree",function(T,str)
#
# Converts the (binary) block design in the parse tree <T> to
# a block design in GAP Design package format,
and returns the
# result.
#
local t,D
;
D:=rec(isBlockDesign:=true, v:=
Int(T.attributes.v))
;
D.id:=Immutable(T.attributes.id)
;
for t in T.content do
if t.name=
"blocks" then
D.blocks:=Immutable(BlocksFromParseTree(t))
;
elif t.name=
"point_labels" then
D.point_labelsXML:=Immutable(str{[t.start..t.stop]})
;
elif t.name=
"statistical_properties" then
D.statistical_propertiesXML:=Immutable(str{[t.start..t.stop]})
;
elif t.name=
"alternative_representations" then
D.alternative_representationsXML:=Immutable(str{[t.start..t.stop]})
;
elif t.name=
"info" then
D.infoXML:=Immutable(str{[t.start..t.stop]})
;
fi
;
od
;
BlockDesign(D.v,D.blocks)
; # does some checks
if not IsBinaryBlockDesign(D) then
Error(
"<D> must be a binary block design")
;
fi
;
return D
;
end)
;
BindGlobal(
"BlockDesignsFromXMLFile",function(
filename)
#
#
This function reads a file with name <
filename>, containing a
# list of (binary) block designs in external representation XML-format,
#
and returns a
record <designs> in GAP format containing the essential
# information in
this file.
#
# The
record <designs> contains the following components:
# `list
': a list of block designs in GAP Design package format of
# the list of block designs in the file
;
# `pairwiseNonisomorphic
':
# is set appropriately according to the attribute pairwise_nonisomorphic:
# `false
' if this attribute = "false",
# `true
' if this attribute = "true",
#
"unknown" otherwise
;
# `infoXML
':
# bound iff the info element occurs in the XML
# list_of_designs element,
and if bound, contains
#
this info element in a
string.
#
local T,t,u,str,designs
;
if not IsString(
filename) then
Error(
"usage: BlockDesignsFromXMLFile( <String> );");
fi
;
str:=StringFile(
filename)
;
T:=ParseTreeXMLString(str)
;
if T.name<>
"list_of_designs" then
for t in T.content do
if t.name=
"list_of_designs" then
T:=t
;
break
;
fi
;
od
;
fi
;
if T.attributes.design_type<>
"block_design" then
Error(
"the design_type must be block_design")
;
fi
;
designs:=rec(list:=[])
;
if T.attributes.pairwise_nonisomorphic=
"false" then
designs.pairwiseNonisomorphic:=false
;
elif T.attributes.pairwise_nonisomorphic=
"true" then
designs.pairwiseNonisomorphic:=true
;
else
designs.pairwiseNonisomorphic:=
"unknown";
fi
;
for t in T.content do
if t.name=
"info" then
designs.infoXML:=Immutable(str{[t.start..t.stop]})
;
elif t.name=
"designs" then
for u in t.content do
if u.name=
"block_design" then
Add(designs.list,BlockDesignFromParseTree(u,str))
;
fi
;
od
;
elif t.name=
"block_design" then #
for dtrs protocol
1.x compatibility
Add(designs.list,BlockDesignFromParseTree(t,str))
;
fi
;
od
;
return designs
;
end)
;