NKSPILJA - Hang động

Tác giả: ll931110

Ngôn ngữ: Pascal

{$N+}
program spil;
const
  input  = '';
  output = '';
  maxn = 5000;
  maxv = 1000000;
  maxt = 1000000000;
  eps = 1e-6;
type
  point = record
    x,y: extended;
  end;
  line = record
    a,b,c: extended;
  end;
var
  p: array[1..maxn] of point;
  d: array[1..maxn] of line;
  n: longint;
  res: extended;

procedure init;
var
  f: text;
  i: longint;
begin
  assign(f, input);
    reset(f);

  readln(f, n);
  for i := 1 to n do readln(f, p[i].x, p[i].y);

  close(f);
end;

procedure expand(i: longint);
begin
  with d[i] do
    begin
      a := p[i].y - p[i + 1].y;
      b := p[i + 1].x - p[i].x;
      c := -(a * p[i].x + b * p[i].y);
    end;
end;

function ok(q: extended): boolean;
var
  low,high,tmp: extended;
  i: longint;
begin
  low := -maxt;
  high := maxt;

  for i := 1 to n - 1 do if p[i].y = p[i + 1].y then
    begin
      if q < p[i].y then exit(false);
      if q = p[i].y then
        begin
          if low < p[i].x then low := p[i].x;
          if high > p[i].x then high := p[i].x;
        end;
    end
  else
    begin

      with d[i] do
        tmp := -(c + b * q)/a;

      if (p[i].y > p[i + 1].y) and (low < tmp) then low := tmp;
      if (p[i].y < p[i + 1].y) and (high > tmp) then high := tmp;
    end;

  ok := (high >= low);
end;

procedure solve;
var
  inf,sup,med: extended;
  i: longint;
begin
  for i := 1 to n - 1 do expand(i);

  inf := 0;
  sup := maxv;
  repeat
    med := (inf + sup) / 2;
    if ok(med) then
      begin
        res := med;
        sup := med;
      end
    else inf := med;
  until sup - inf < eps;
end;

procedure printresult;
var
  f: text;
begin
  assign(f, output);
    rewrite(f);
    writeln(f, res:0:2);
  close(f);
end;

begin
  init;
  solve;
  printresult;
end.

Download