http://acm.pku.edu.cn/JudgeOnline/problem?id=1066
Код:
program PKU1066; const maxn = 200; maxm = 100000; error = 1e-7; type integer = longint; node = array[1 .. 2] of double; arr = array[1 .. maxm] of integer; var g, q, c, l, r, dep, tow, next, pre, start: arr; w: array[1 .. maxm] of boolean; d: array[1 .. maxm] of double; h: array[0 .. 100, 0 .. 100] of integer; ver: array[1 .. maxm] of node; a: array[1 .. maxn, 1 .. 2] of integer; n, m, len, tot, inside, outside, totnode: integer; treasure: node; function same(i, j: double): boolean; begin same := abs(i - j) < error; end; function find(x, y: double): integer; var u, v, tmp: integer; begin u := trunc(x); v := trunc(y); tmp := h[u, v]; while tmp <> 0 do begin if same(ver[tmp, 1], x) and same(ver[tmp, 2], y) then begin find := tmp; exit; end; tmp := pre[tmp]; end; totnode := totnode + 1; ver[totnode, 1] := x; ver[totnode, 2] := y; pre[totnode] := h[u, v]; h[u, v] := totnode; find := totnode; end; procedure updata; var i, p, q, u, v, x0, y0, x1, y1: integer; begin fillchar(g, sizeof(g), 0); fillchar(h, sizeof(h), 0); read(n); totnode := 0; for i := 1 to n do begin read(x0, y0, x1, y1); u := find(x0, y0); v := find(x1, y1); a[i, 1] := u; a[i, 2] := v; end; u := find(0, 0); v := find(100, 0); p := find(100, 100); q := find(0, 100); a[n + 1, 1] := u; a[n + 1, 2] := v; a[n + 2, 1] := v; a[n + 2, 2] := p; a[n + 3, 1] := p; a[n + 3, 2] := q; a[n + 4, 1] := q; a[n + 4, 2] := u; n := n + 4; readln(treasure[1], treasure[2]); end; function area(var i, j, k: node): double; begin area := (j[1] - i[1]) * (k[2] - i[2]) - (j[2] - i[2]) * (k[1] - i[1]); end; var k1, k2, k3, k4: double; procedure check(i, j: integer); var x0, y0: double; k: integer; begin k1 := area(ver[a[i, 1]], ver[a[i, 2]], ver[a[j, 1]]); k2 := area(ver[a[i, 1]], ver[a[i, 2]], ver[a[j, 2]]); k3 := area(ver[a[j, 1]], ver[a[j, 2]], ver[a[i, 1]]); k4 := area(ver[a[j, 1]], ver[a[j, 2]], ver[a[i, 2]]); if (k1 * k2 <= error) and (k3 * k4 <= error) then begin x0 := (ver[a[j, 1], 1] * k2 - ver[a[j, 2], 1] * k1) / (k2 - k1); y0 := (ver[a[j, 1], 2] * k2 - ver[a[j, 2], 2] * k1) / (k2 - k1); k := find(x0, y0); len := len + 1; c[len] := k; end; end; procedure insert(u, v: integer); begin tot := tot + 1; tow[tot] := v; next[tot] := g[u]; g[u] := tot; end; var temp: integer; temp2: double; procedure swap(var i, j: integer); begin temp := i; i := j; j := temp; end; procedure swapreal(var i, j: double); begin temp2 := i; i := j; j := temp2; end; function compare(i, j: integer): boolean; begin compare := (ver[i, 1] < ver[j, 1] - error) or same(ver[i, 1], ver[j, 1]) and (ver[i, 2] < ver[j, 2] - error); end; procedure sortv(ll, rr: integer); var i, j, mid: integer; begin i := ll; j := rr; mid := c[(ll + rr) shr 1]; while i <= j do begin while compare(c[i], mid) do i := i + 1; while compare(mid, c[j]) do j := j - 1; if i <= j then begin swap(c[i], c[j]); i := i + 1; j := j - 1; end; end; if i < rr then sortv(i, rr); if ll < j then sortv(ll, j); end; procedure sorte(ll, rr: integer); var i, j: integer; mid: double; begin i := ll; j := rr; mid := d[(ll + rr) shr 1]; while i <= j do begin while d[i] < mid - error do i := i + 1; while d[j] > mid + error do j := j - 1; if i <= j then begin swap(c[i], c[j]); swapreal(d[i], d[j]); i := i + 1; j := j - 1; end; end; if i < rr then sorte(i, rr); if ll < j then sorte(ll, j); end; function calc(var p, q: node): double; var x0, y0: double; begin x0 := q[1] - p[1]; y0 := q[2] - p[2]; if same(x0, 0) then if y0 > 0 then calc := pi / 2 else calc := pi * 3 / 2 else begin temp2 := arctan(y0 / x0); if x0 < 0 then temp2 := temp2 + pi; if temp2 < 0 then temp2 := temp2 + pi * 2; if temp2 >= 2 * pi then temp2 := temp2 - pi * 2; calc := temp2; end; end; procedure prepare; var i, j, now, tmp: integer; begin tot := 0; for i := 1 to n do begin len := 0; for j := 1 to n do if i <> j then check(i, j); if len > 1 then sortv(1, len); now := c[1]; for j := 2 to len do if c[j] <> now then begin insert(now, c[j]); insert(c[j], now); now := c[j]; end; end; now := 1; for i := 1 to totnode do begin tmp := g[i]; start[i] := now; while tmp <> 0 do begin c[now] := tow[tmp]; d[now] := calc(ver[i], ver[tow[tmp]]); now := now + 1; tmp := next[tmp]; end; sorte(start[i], now - 1); end; start[totnode + 1] := now; end; procedure bfs; var open, closed, tmp, u, v: integer; begin fillchar(dep, sizeof(dep), 0); open := 0; closed := 1; q[1] := outside; dep[outside] := 1; while (open < closed) and (dep[inside] = 0) do begin open := open + 1; u := q[open]; tmp := g[u]; while tmp <> 0 do begin v := tow[tmp]; if dep[v] = 0 then begin dep[v] := dep[u] + 1; closed := closed + 1; q[closed] := v; end; tmp := next[tmp]; end; end; writeln('Number of doors = ', dep[inside] - 1); end; procedure main; var i, j, u, v, k: integer; begin fillchar(g, sizeof(g), 0); fillchar(l, sizeof(l), 0); fillchar(r, sizeof(r), 0); fillchar(w, sizeof(w), true); m := 0; tot := 0; for i := 1 to totnode do begin for j := start[i] to start[i + 1] - 1 do if l[j] = 0 then begin m := m + 1; l[j] := m; u := i; v := c[j]; repeat if area(ver[u], ver[v], treasure) < error then w[m] := false; for k := start[v] to start[v + 1] - 1 do if c[k] = u then break; r[k] := m; k := k - 1; if k < start[v] then k := start[v + 1] - 1; if l[k] = 0 then l[k] := m else break; u := v; v := c[k]; until false; end; end; u := find(0, 0); for k := start[u] to start[u + 1] - 1 do if ver[c[k], 2] = 0 then break; outside := r[k]; for k := 1 to m do if w[k] and (k <> outside) then inside := k; for k := 1 to start[totnode] - 1 do begin insert(l[k], r[k]); insert(r[k], l[k]); end; bfs; end; begin updata; prepare; main; end.