// Functions used in paper 6:
// _Graded rings and special K3 surfaces_ by Gavin Brown

// Section 6: Simple degenerations of the famous 95

/*
 Input:     Q seq of integers; q,n both integers.
 Procedure: update Q to include (multiple occurrences of) q in
            every element S of Q for which (sum of S) + q <= n.
*/
procedure add_q(~Q, q, n)
  Q := &cat[ [ S cat [ q : i in [1..p] ] :
               p in [0..Floor((n - &+S)/q)] ] : S in Q ];
end procedure;

/*
 Input:   Q seq of integers, n an integer.
 Output:  seqs of elements of Q (with repeats) that sum to n.
*/
function sum_to(Q, n)
  Qout := [ [ Integers() | ] ];
  for q in Q do
    add_q(~Qout, q, n);
  end for;
  return [ S : S in Qout | &+S eq n ];
end function;

/*
 Input:   codimension 1 K3 surface X.
 Output:  a seq of integers for which there may be an irreducible
          simple degeneration of X.
*/
function specialk3s(X)
  d := ApparentEquationDegrees(X)[1];
  W := Weights(X);          /* i.e.  X is (f_d = 0) in PP(W) */
  R<x,y,z,t> := PolynomialRing(Rationals(), W);
  /* Find suitable degrees that divide d. */
  E := [ e : e in [2..d-1] | IsDivisibleBy(d, e) and not e in W ];
  data := [ <d, e, MRe> : e in E | #MRe ge 2
            where MRe is MonomialsOfWeightedDegree(R, e) ];
  return [ [ x[1], x[2] ] : x in data | TotalDegree(GCD(x[3])) eq 0
    and #[ R.i : i in [1..Rank(R)] | IsDivisibleBy(&*x[3], R.i) ] ge 3];
end function;

/*
 Return a sequence of simple degenerations of codimension 1
 K3 surfaces in the sequence of K3 surfaces D.
*/
function degenerations(D)
  degens := [ ];
  for X in D do
    if Codimension(X) ne 1 then continue X; end if;
    W := Weights(X);
    B := RawBasket(X);
    for S in specialk3s(X) do
      d,e := Explode(S);
      if #B eq 0 then
        Append(~degens, <X, e, d>);
      else
        /* check the polarisation of the biggest singularity */
        r := Maximum([ p[1] : p in B ]);
        if r lt e and
          &or[ (d - a) mod r eq 0 : a in W cat [e] ] and
          &or[ (e - a) mod r eq 0 : a in W ]
        then
          Append(~degens, <X, e, d>);
        end if;
      end if;
    end for;
  end for;
  return degens;
end function;


// Section 8: Special K3 surfaces in Fletcher's 84
function unproj_divs(B)
  /* easy cases:  1/r(1,r-1) could be on PP(1,r) */
  result := [ [1,1] ] cat [ [r,1] : r in [1..max_r] | [r,1] in B ]
              where max_r is Maximum([ b[1] : b in B ] cat [ 0 ]);
  /* hard cases:  1/r(s,-s) + 1/s(r,-r) could be on PP(r,s) */
  Bred := SetToSequence(SequenceToSet(B));
  for i in [1..#Bred] do
    p1 := Bred[i]; r := p1[1]; a := p1[2];
    for j in [i+1..#Bred] do
      p2 := Bred[j]; s := p2[1]; b := p2[2];
      if ((r mod s eq b) or (r mod s eq s-b))
        and ((s mod r eq a) or (s mod r eq r-a))
      then
        Append(~result, [r,s]);
      end if;
    end for;
  end for;
  return result;
end function;