(*(*(*Mathematica Code*)*)*)

(*Select m to finds the greatest maximal overhang for the block-set {1,2,...,m}*)

m = 10;
n = Ceiling[
   Replace[p, 
    NSolve[m^2/(m + 1/2 p/2 (p/2 - 1)) == p, p, Reals][[1]]]];
rec[set_, totals_, ind_] := 
 Block[{next, newset, newtotals}, Sow[set];
  next = Complement[Range[ind, n], set];
  Do[newset = Union[set, {j}];
   newtotals = Select[Union[totals, totals + j], # <= n &];
   {newset, newtotals} = necessary[newset, newtotals];
   rec[newset, newtotals, j + 1], {j, next}]]
necessary[set_, totals_] := 
 Block[{missing}, missing = Complement[Rest@totals, set];
  If[Length@missing == 0, {set, totals}, 
   necessary @@ 
    Fold[Function[{settot, miss}, {Union[settot[[1]], {miss}], 
       Select[Union[settot[[2]], 
         settot[[2]] + miss], # <= n &]}], {set, totals}, missing]]]
validPartitions[range_] := 
  Block[{n = range}, Reap[rec[{}, {0}, 1]][[2, 1]]];
y = Map[Reverse, Delete[validPartitions[n], 1]];
JoinFunc[x_] := Join[Reverse[Range[n + 1, m]], x];
y = Map[JoinFunc, y];
Overhang[a_] := (CounterMass = 
    a[[1]] + Total[Complement[Range[m], a]]; 
   2 a[[1]] - a[[1]]^2/(CounterMass) + 
    Sum[a[[k]]^2/(CounterMass + Sum[a[[j]], {j, 2, k}]), {k, 2, 
      Length[a]}]);
HangList = Map[Overhang, y];
{m, Max[HangList]}