#OK to post homework
#Lucy Martinez, 02-02-2024, Assignment 5

with(numtheory):
with(NumberTheory):


# Problem 6: Write a procedure ParaBD(BD,v), that inputs a potential block design with v varieties
# (or points) (i.e. the universal set is {1, ..., v}) and checks whether it is indeed a block design
# (if it is not it should return FAIL). If it is the output should be the 5-tuple
# [b,v,r,k,lambda]
# (see the bottom of p. 21)
# Check your program with the following: ParaBD(BDfano(),7); and ParaBD(BDex212(),11);
ParaBD:=proc(BD,v) local b,k1,i,j,k,r1,r,lam1,lam:
b:=nops(BD):
k1:={}:
for i from 1 to b do
 k1:=k1 union {nops(BD[i])}:
od:
if nops(k1)<>1 then
 return(FAIL):
fi:
k:=k1[1]:

r1:=[0$v]:
for i from 1 to b do
 for j from 1 to v do
  if j in BD[i] then
   r1:=subsop(j=r1[j]+1,r1):
  fi:
 od: 
od:

r1:=convert(r1,set):
if nops(r1)<>1 then
 return(FAIL):
fi:
r:=r1[1]:

lam1:=[]:
for i from 1 to b do
 for j from i+1 to b do
  lam1:=[op(lam1),BD[i] intersect BD[j]]:
 od:
od:

for i from 1 to nops(lam1) do
 for j from i+1 to nops(lam1) do
  if nops(lam[i])<> nops(lam[j]) then
   return(FAIL):
  fi:
 od:
od:
lam:=nops(lam1[1]):

[b,v,r,k,lam]:
end:



# Problem 7, Part 1: Using Ex. 2.21 (p. 29) write a procedure PlotkinBound(n,d)
# For binary codes. For all d from 2 to 20 and n from 2 to 2d find which is bigger, the Sphere-Packing bound or the Plotkin bound?
PlotkinBound:=proc(n,d):
if n<2*d then
 return 2*trunc(d/(2*d-n)):
fi:
end:

# Problem 7, Part 2:
# For all d from 2 to 20 and n from 2 to 2d find which is bigger,
#  the Sphere-Packing bound or the Plotkin bound?

# Answer: The Plotkin bound is bigger. To find this out, I ran the following:
# L:=[];
# for d from 2 to 20 do
#  for n from 2 to 2*d do
#   L:=[op(L),[PlotkinBound(n,d),SPB(2,n,d)]]:
#  od:
# od:
#
# This was the output:
# [[2, 1], [4, 1], [1], [0, 1], [2, 1], [2, 1], [6, 1], [1], [0, 1], [0, 1], [2, 1],
#  [2, 1], [4, 1], [8, 1], [1], [0, 1], [0, 1], [0, 1], [2, 1], [2, 1], [2, 1], [4, 1],
#  [10, 1], [1], [0, 1], [0, 1], [0, 1], [0, 1], [2, 1], [2, 1], [2, 1], [4, 1], [6, 1],
#  [12, 1], [1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [2, 1], [2, 1], [2, 1], [2, 1], 
#  [4, 1], [6, 1], [14, 1], [1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [2, 1],
#  [2, 1], [2, 1], [2, 1], [4, 1], [4, 1], [8, 1], [16, 1], [1], [0, 1], [0, 1], [0, 1],
#  [0, 1], [0, 1], [0, 1], [0, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [4, 1], [6, 1],
#  [8, 1], [18, 1], [1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1],
#  [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [4, 1], [4, 1], [6, 1], [10, 1], [20, 1], [1],
#  [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [2, 1], [2, 1],
#  [2, 1], [2, 1], [2, 1], [2, 1], [4, 1], [4, 1], [6, 1], [10, 1], [22, 1], [1], [0, 1], [0, 1],
#  [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [2, 1], [2, 1], [2, 1], [2, 1],
#  [2, 1], [2, 1], [4, 1], [4, 1], [6, 1], [8, 1], [12, 1], [24, 1], [1], [0, 1], [0, 1], [0, 1],
#  [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [2, 1], [2, 1], [2, 1], [2, 1],
#  [2, 1], [2, 1], [2, 1], [4, 1], [4, 1], [6, 1], [8, 1], [12, 1], [26, 1], [1], [0, 1], [0, 1],
#  [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [2, 1], [2, 1],
#  [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [4, 1], [4, 1], [4, 1], [6, 1], [8, 1], [14, 1], [28, 1],
#  [1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1],
#  [0, 1], [0, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [4, 1], [4, 1],
#  [6, 1], [6, 1], [10, 1], [14, 1], [30, 1], [1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1],
#  [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [2, 1], [2, 1], [2, 1], [2, 1],
#  [2, 1], [2, 1], [2, 1], [2, 1], [4, 1], [4, 1], [4, 1], [6, 1], [8, 1], [10, 1], [16, 1], [32, 1],
#  [1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1],
#  [0, 1], [0, 1], [0, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1],
#  [4, 1], [4, 1], [4, 1], [6, 1], [8, 1], [10, 1], [16, 1], [34, 1], [1], [0, 1], [0, 1], [0, 1],
#  [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1],
#  [0, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [4, 1], [4, 1],
#  [4, 1], [6, 1], [6, 1], [8, 1], [12, 1], [18, 1], [36, 1], [1], [0, 1], [0, 1], [0, 1], [0, 1],
#  [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1],
#  [0, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [4, 1],
#  [4, 1], [4, 1], [6, 1], [6, 1], [8, 1], [12, 1], [18, 1], [38, 1], [1], [0, 1], [0, 1], [0, 1],
#  [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1], [0, 1],
#  [0, 1], [0, 1], [0, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1], [2, 1],
#  [2, 1], [4, 1], [4, 1], [4, 1], [4, 1], [6, 1], [8, 1], [10, 1], [12, 1], [20, 1], [40, 1], [1]]





################################# Old:
BDfano:=proc():
{{1,2,4},{2,3,5},{3,4,6},{4,5,7},{5,6,1},{6,7,2},{7,1,3}}:
end:




BDex212:=proc():
{{1,3,4,5,9},
{2,4,5,6,10},
{3,5,6,7,11},
{1,4,6,7,8},
{2,5,7,8,9},
{3,6,8,9,10},
{4,7,9,10,11},
{1,5,8,10,11},
{1,2,6,9,11},
{1,2,3,7,10},
{2,3,4,8,11}
}
end:


#SPB(q,n,d): The best you can hope for (as far as the size of C) for q-ary (n,2*t+1) code
SPB:=proc(q,n,t) local i:
trunc(q^n/add(binomial(n,i)*(q-1)^i,i=0..t)):
end: