I always get wrong answer.
Could anybody help me?
Here is my programme:

var n,k,c,d,f,g,h:word; t:text;
    a,b:array[0..500] of word; e:array[1..500,1..500] of word;
begin
  assign(t,''); reset(t);
  readln(t,n,k);
  a[0]:=0; b[0]:=0;
  for c:=1 to n do begin
    readln(t,d);
    if d=0 then begin
      a[c]:=a[c-1]+1; b[c]:=b[c-1];
    end else begin
      a[c]:=a[c-1]; b[c]:=b[c-1]+1;
    end;
  end;
  close(t);
  for c:=1 to n do for d:=1 to k do e[c,d]:=65535;
  for c:=1 to n do begin
    e[c,1]:=a[c]*b[c];
    for d:=1 to c-1 do begin
      h:=(a[c]-a[d])*(b[c]-b[d]);
      if d<k-1 then f:=d else f:=k-1;
      for g:=1 to f do
        if e[c,g+1]>e[d,g]+h then e[c,g+1]:=e[d,g]+h;
    end;
  end;
  writeln(e[n,k]);
end.

This is really very strange, but if you do the following, you'll get
AC. In part Var make a new variable i, and change cycle
      for g:=1 to f do
        if e[c,g+1]>e[d,g]+h then e[c,g+1]:=e[d,g]+h;
to this:
      for i:=1 to f do begin
        g:=i;
        if e[c,g+1]>e[d,g]+h then e[c,g+1]:=e[d,g]+h;
      end;
This should be the same, of course, but this way you'll get AC.
Actually, I don't know why:)

{Submit this program, you'll get Time Limit Exceeded!}

var
  i,j,k:integer;
  p:array [1..2,1..1] of integer;
begin
  p[1,1]:=1; p[2,1]:=0;
  for i:=1 to 1 do begin
    j:=1;
    while p[i,j]=0 do inc(j);
    for j:=2 to 2 do begin
      for k:=1 to 1 do p[j,k]:=p[i,k];
      if p[2,1]=0 then repeat until false;
    end;
  end;
end.

I've got AC. :)
Thank you very much indeed.