cowcycle.pas

Magio牛的usaco源代码

{
ID:maigoak1
PROG:cowcycle
}

program cowcycle;
const
  fs=56;rs=36;
var
  fin,fout:text;
  gear,ans:array[1..fs+rs]of byte;
  f,r,f1,f2,r1,r2,i:byte;
  minvar:real;
procedure update;
  var
    x:array[1..fs+rs]of real;
    total,i,j:integer;
    mean,variance:real;
  procedure qsort(s,t:integer);
    var
      i,j,p:integer;
      tmp:real;
    begin
      if s>=t then exit;
      p:=s+random(t-s+1);
      tmp:=x[p];
      x[p]:=x[s];
      i:=s;j:=t;
      repeat
        while (i<j) and (x[j]>=tmp) do dec(j);
        if i=j then break;
        x[i]:=x[j];inc(i);
        while (i<j) and (x[i]<=tmp) do inc(i);
        if i=j then break;
        x[j]:=x[i];dec(j);
      until i=j;
      x[i]:=tmp;
      qsort(s,i-1);
      qsort(i+1,t);
    end;
  begin
    if gear[f]/gear[f+1]<gear[1]/gear[f+r]*3 then exit;

    total:=0;
    for i:=1 to f do
      for j:=f+1 to f+r do begin
        inc(total);
        x[total]:=gear[i]/gear[j];
      end;

    qsort(1,total);

    dec(total);
    mean:=0;
    for i:=1 to total do begin
      x[i]:=x[i+1]-x[i];
      mean:=mean+x[i];
    end;
    mean:=mean/total;

    variance:=0;
    for i:=1 to total do
      variance:=variance+sqr(x[i]-mean);
    {As total doesn't change, 'variance:=variance/total' is omitted}

    if variance<minvar then begin
      minvar:=variance;
      ans:=gear;
    end;
  end;
procedure search(l:byte);
  var
    start,finish,i:byte;
  begin
    if l=1 then start:=f1 else if l=f+1 then start:=r1 else start:=gear[l-1]+1;
    if l>f then finish:=r2-(f+r)+l else finish:=f2-f+l;
    for i:=start to finish do begin
      if l=1 then if f2/r1<i/r2*3 then exit;
      gear[l]:=i;
      if l=f+1 then if gear[f]/i<gear[1]/r2*3 then exit;
      if (l<>f) or (gear[f]/r1>=gear[1]/r2*3) then
        if l=f+r then update else search(l+1);
    end;
  end;
begin
  assign(fin,'cowcycle.in');
  reset(fin);
  readln(fin,f,r);
  readln(fin,f1,f2,r1,r2);
  close(fin);

  minvar:=maxint;
  search(1);

  assign(fout,'cowcycle.out');
  rewrite(fout);
  for i:=1 to f-1 do
    write(fout,ans[i],' ');
  writeln(fout,ans[f]);
  for i:=f+1 to f+r-1 do
    write(fout,ans[i],' ');
  writeln(fout,ans[f+r]);
  close(fout);
end.