ABBYY Cup 2.0 problem F solution

{$R-,S-,Q-,I-,O+}
const inf = round(1e9);
var
  s: array [0..2010] of ansistring;
  f: array [0..4010,0..2010] of longint;
  lcp: array [0..2010] of longint;
  n,k,i,j,q,cnt: longint;

procedure Sort(l,r:longint);
var
  i,j: longint;
  x,tmp: ansistring;
begin
  i:=l; j:=r;
  x:=s[l+random(r-l+1)];
  repeat
    while s[i] < x do inc(i);
    while x < s[j] do dec(j);
    if i <= j then
    begin
      tmp:=s[i]; s[i]:=s[j]; s[j]:=tmp;
      inc(i); dec(j);
    end;
  until i > j;
  if l < j then Sort(l,j);
  if i < r then Sort(i,r);
end;

function rec(l,r:longint):longint;
var
  id,i,j,p,left,right,cur: longint;
begin
  inc(cnt);
  id:=cnt;
  for i:=0 to r-l+1 do f[id,i]:=0;
  if l < r then
  begin
    p:=l;
    for i:=l+1 to r-1 do
      if lcp[i] < lcp[p] then p:=i;
    left:=rec(l,p);
    right:=rec(p+1,r);
    for i:=0 to p-l+1 do
      for j:=0 to r-p do
      begin
        cur:=f[left,i]+f[right,j]+lcp[p]*i*j;
        if cur > f[id,i+j] then f[id,i+j]:=cur;
      end;
  end;
  rec:=id;
end;

begin
  randomize;
  readln(n,k);
  assert((1 <= k) and (k <= n) and (n <= 2000));
  for i:=1 to n do readln(s[i]);
  Sort(1,n);
  for i:=1 to n-1 do
  begin
    q:=length(s[i]);
    if length(s[i+1]) < q then q:=length(s[i+1]);
    lcp[i]:=0;
    for j:=1 to q do
      if s[i,j] = s[i+1,j] then inc(lcp[i])
      else break;
  end;
  cnt:=0;
  rec(1,n);
  writeln(f[1,k]);
end.