ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1317. Град

Why WA #3? It seems so simple.
Послано Maigo Akisame (maigoakisame@yahoo.com.cn) 18 окт 2004 15:33
program ural1317;
const
  maxn=10;
  zero=1e-6;
var
  x,y:array[1..maxn+1]of real;
  n,k,i,ans:longint;
  h,d,a,b,u,v:real;
function cross(xa,ya,xb,yb,xc,yc:real):real;
  var
    x1,y1,x2,y2:real;
  begin
    x1:=xb-xa;y1:=yb-ya;
    x2:=xc-xa;y2:=yc-ya;
    cross:=x1*y2-x2*y1;
  end;
function dist(xa,ya,xb,yb:real):real;
  begin
    dist:=sqrt(sqr(xa-xb)+sqr(ya-yb));
  end;
procedure shoot;
  var
    i:byte;
    l,r:real;
  begin
    for i:=1 to n do
      if cross(a,b,u,v,x[i],y[i])*cross(a,b,u,v,x[i+1],y[i+1])<=0 then begin
        l:=dist(a,b,u,v);
        if l<zero then begin inc(ans);exit;end;
        if d<l then exit;
        r:=abs(cross(a,b,x[i],y[i],x[i+1],y[i+1]))/dist(x[i],y[i],x[i+1],y[i+1]);
        if sqrt(d*d-l*l)/l*r>h then inc(ans);
        exit;
      end;
  end;
begin
  read(n,h);
  for i:=1 to n do
    read(x[i],y[i]);
  x[n+1]:=x[1];y[n+1]:=y[1];
  read(d,a,b,k);
  for i:=1 to k do begin
    readln(u,v);
    shoot;
  end;
  writeln(ans);
end.
Re: Why WA #3? It seems so simple.
Послано TestT 22 фев 2005 07:38
if n==3 then ans:=ans-1;
Re: Why WA #3? It seems so simple.
Послано Oleg Strekalovsky [Vologda SPU] 22 июн 2010 03:53
Maigo Akisame (maigoakisame@yahoo.com.cn) писал(a) 18 октября 2004 15:33
program ural1317;
const
  maxn=10;
  zero=1e-6;
var
  x,y:array[1..maxn+1]of real;
  n,k,i,ans:longint;
  h,d,a,b,u,v:real;
function cross(xa,ya,xb,yb,xc,yc:real):real;
  var
    x1,y1,x2,y2:real;
  begin
    x1:=xb-xa;y1:=yb-ya;
    x2:=xc-xa;y2:=yc-ya;
    cross:=x1*y2-x2*y1;
  end;
function dist(xa,ya,xb,yb:real):real;
  begin
    dist:=sqrt(sqr(xa-xb)+sqr(ya-yb));
  end;
procedure shoot;
  var
    i:byte;
    l,r:real;
  begin
    for i:=1 to n do
      if cross(a,b,u,v,x[i],y[i])*cross(a,b,u,v,x[i+1],y[i+1])<=0 then begin
        l:=dist(a,b,u,v);
        if l<zero then begin inc(ans);exit;end;
        if d<l then exit;
        r:=abs(cross(a,b,x[i],y[i],x[i+1],y[i+1]))/dist(x[i],y[i],x[i+1],y[i+1]);
        if sqrt(d*d-l*l)/l*r>h then inc(ans);
        exit;
      end;
  end;
begin
  read(n,h);
  for i:=1 to n do
    read(x[i],y[i]);
  x[n+1]:=x[1];y[n+1]:=y[1];
  read(d,a,b,k);
  for i:=1 to k do begin
    readln(u,v);
    shoot;
  end;
  writeln(ans);
end.
Your algo to find intersection point is wrong. Use algo to find intersection point of 2 lines with modifications.