Change background image
Chuyên Tin - Lê Khiết

Go downThông điệp [Trang 1 trong tổng số 1 trang]

© FMvi.vn

on Fri Aug 31, 2012 10:09 pm
Admin

Code - Huyền Thoại

Cho tam giác ABC và đoạn thẳng MN . Tính phần đoạn thẳng nằm trong tam giác .
Code:


Const fi='doanthang.inp'; fo='doanthang.out';

 Type diem=record x,y:Integer; End;
 Type dt=Record  a,b,c:Integer; End;

 Var M,N:diem;
    dem,t:Integer;
    s2,s:real;
    Tg:Array[1..3] Of diem;
    f,g:text;

Procedure doctep;
 Var i:Integer;
  Begin
  Assign(f,fi);
  Reset(f);
  Readln(f,n.x,n.y);
  Readln(f,m.x,m.y);
  t:=3;
  For i:=1 to t do
    Read(f,tg[i].x,tg[i].y);
  Close(f);
  Assign(g,fo);
  Rewrite(g);
  End;

Function Line(M1,A1,B1:Diem):Integer;
 Begin
  Line:=(B1.y-M1.y)*(A1.x-M1.x)-(A1.y-M1.y)*(B1.x-M1.x);
 End;

Procedure XDDT(a2,b2:diem; Var t1:dt);
 Begin
  t1.a:=A2.y-B2.y;
  t1.b:=B2.x-A2.x;
  t1.c:=A2.x*B2.y-A2.y*B2.x;
 End;

Function xuly(x1,x2:diem):boolean;
 Var j1,i,j,k:Integer; v1,v2,v3:diem; t2,t1:dt; s3,s4:Real;
    chon:Array[1..3] Of boolean;
  Begin
  xuly:=false;
{-----K-tra Neu mot diem trung voi dinh tam giac-----}
  For i:=1 to t do
  If (tg[i].x=x1.x) and (tg[i].y=x1.y) then
    Begin
    If i=1 then begin v1:=tg[i]; v2:=tg[i+1]; v3:=tg[i+2]; End
    Else Begin v1:=tg[i]; v2:=tg[i-1]; v3:=tg[i+1]; End;
    For j:=1 to t-1 do
      If (tg[j].x=x2.x) and (tg[j].y=x2.y) then Begin xuly:=true; Exit; End;
    If (Line(x2,v2,v3)*Line(x1,v2,v3)>0) then
      If (Line(x2,v1,v3)*Line(v2,v1,v3)<0) or (Line(x2,v1,v2)*Line(v3,v1,v2)<0) then
      begin xuly:=true; Exit; End;
    If (Line(x2,v1,v3)=0) or (Line(x2,v1,v2)=0) then
      Begin xuly:=true;  Exit; End;
    If (Line(x2,v2,v3)=0) or( (Line(x2,v2,v3)*Line(x1,v2,v3) >0) and (Line(x2,v1,v2)*Line(v3,v1,v2) >0) and (Line(x2,v1,v3)*Line(v2,v1,v3)>0))  then
      Begin Writeln(g,sqrt(sqr(x1.x-x2.x)+sqr(x1.y-x2.y)):3:2); exit; End;
    If Line(x1,v2,v3)*Line(x2,v2,v3) <0 then
      Begin
      xddt(v2,v3,t1);
      Writeln(g,abs(t1.a*x1.x+T1.b*x1.y+t1.c)/sqrt(sqr(t1.a)+sqr(t1.b)):3:2); Exit;
      End;
    End;
{-----K-tra Neu mot diem nam tren canh tam giac-----}
    For i:=2 to t do
    For j:=1 to i-1 do
    If Line(x1,tg[i],tg[j])=0 then
      Begin
      For j1:=1 to t-1 do If (j1<>i) and (J1<>j) then k:=j1;
      If Line(x2,tg[i],tg[j])=0 then begin xuly:=true; Exit; End;
      If (Line(x2,tg[i],tg[k])=0) or (Line(x2,tg[j],tg[k])=0) then
      Begin  Writeln(g,sqrt(sqr(x1.x-x2.x)+sqr(x1.y-x2.y)):3:2); exit; End;
      If Line(x1,tg[i],tg[k])*Line(x2,tg[i],tg[k]) <0 then
      Begin xddt(tg[i],tg[k],t1);
        Writeln(g,abs(t1.a*x1.x+T1.b*x1.y+t1.c)/sqrt(sqr(t1.a)+sqr(t1.b)):3:2); Exit;
      End;
      If Line(x1,tg[j],tg[k])*Line(x2,tg[j],tg[k]) <0 then
        Begin xddt(tg[j],tg[k],t1);
        Writeln(g,abs(t1.a*x1.x+T1.b*x1.y+t1.c)/sqrt(sqr(t1.a)+sqr(t1.b)):3:2); Exit;
        End;
      End;
{-----K-tra 1 diem nam trong tam giac------}
    v1:=tg[1];v2:=tg[2];v3:=tg[3];
    If( Line(x1,v1,v2)*Line(v3,v1,v2) >0)  and (Line(x1,v1,v3)*Line(v2,v1,v3)>0) and (Line(x1,v2,v3)*Line(v1,v2,v3)>0) then
    Begin
        If( Line(x2,v1,v2)*Line(v3,v1,v2) >0)  and (Line(x2,v1,v3)*Line(v2,v1,v3)>0) and (Line(x2,v2,v3)*Line(v1,v2,v3)>0) then
        Begin xuly:=true;  Exit; End;
        If (Line(x2,v1,v2)=0) or (Line(x2,v1,v3)=0) or (Line(x2,v2,v3)=0) then
        Begin  Writeln(g,sqrt(sqr(x1.x-x2.x)+sqr(x1.y-x2.y)):3:2);  exit; End;
        For i:=2 to t do
        For k:=1 to i-1 do
            If Line(x1,tg[i],tg[k])*Line(x2,tg[i],tg[k]) <0 then
      Begin xddt(tg[i],tg[k],t1); Writeln(g,abs(t1.a*x1.x+T1.b*x1.y+t1.c)/sqrt(sqr(t1.a)+sqr(t1.b)):3:2); Exit;  End;
    End;
{-----K-Tra Neu mot diem nam ngoai-----}
  For i:=2 to t do
  For j:=1 to i-1 do
    Begin For j1:=1 to t do If (j1<>i) and (j1<>j) then k:=j1;
    v1:=tg[i];v2:=tg[j];v3:=tg[k];
    If (Line(x1,v1,v2)*Line(v3,v1,v2)<0) and (Line(x1,v1,v3)*Line(v2,v1,v3)>0) and (Line(x1,v2,v3)*Line(v1,v2,v3)>0) then
      Begin If Line(x2,tg[i],tg[j])=0 then begin xuly:=true; Exit; End;
      If (Line(x2,tg[i],tg[k])=0) then
        Begin xddt(tg[i],tg[k],t1); Writeln(g,abs(t1.a*x2.x+T1.b*x2.y+t1.c)/sqrt(sqr(t1.a)+sqr(t1.b)):3:2); Exit; End;
      If (Line(x2,tg[j],tg[k])=0) then
        Begin xddt(tg[j],tg[k],t1);
        Writeln(g,abs(t1.a*x2.x+T1.b*x2.y+t1.c)/sqrt(sqr(t1.a)+sqr(t1.b)):3:2); Exit; End;
      If (Line(x2,v1,v2)*Line(v3,v1,v2)>0) and (Line(x2,v1,v3)*Line(v2,v1,v3)>0) and (Line(x2,v2,v3)*Line(v1,v2,v3)>0) then
        Begin xddt(v1,v2,t1);
          Writeln(g,abs(t1.a*x2.x+T1.b*x2.y+t1.c)/sqrt(sqr(t1.a)+sqr(t1.b)):3:2); Exit; End;
      If (Line(x2,v1,v3)*Line(v2,v1,v3)<0) and (Line(x2,v1,v2)*Line(v3,v1,v2)>0) and (Line(x2,v2,v3)*Line(v1,v2,v3)>0) then
        Begin
        xddt(v1,v3,t2);xddt(v1,v2,t1);
        s3:=abs(t1.a*x1.x+T1.b*x1.y+t1.c)/sqrt(sqr(t1.a)+sqr(t1.b));
        s4:=abs(t2.a*x2.x+T2.b*x2.y+t2.c)/sqrt(sqr(t2.a)+sqr(t2.b));
        Writeln(g,sqrt(sqr(x1.x-x2.x)+sqr(x1.y-x2.y))-s3-s4:3:2);
        Exit;
        End;
        If (Line(x2,v2,v3)*Line(v2,v2,v3)<0) and (Line(x2,v1,v2)*Line(v3,v1,v2)>0) and (Line(x2,v1,v3)*Line(v1,v1,v3)>0) then
        Begin
        xddt(v2,v3,t2);xddt(v1,v2,t1);
        s3:=abs(t1.a*x1.x+T1.b*x1.y+t1.c)/sqrt(sqr(t1.a)+sqr(t1.b));
        s4:=abs(t2.a*x2.x+T2.b*x2.y+t2.c)/sqrt(sqr(t2.a)+sqr(t2.b));
        Writeln(g,sqrt(sqr(x1.x-x2.x)+sqr(x1.y-x2.y))-s3-s4:3:2);
        Exit;
        End;
      End;
  End;
  End;

Begin
 doctep;
 If  xuly(N,M)  then Writeln(g,0);
 Close(g);
End.
Link : [You must be registered and logged in to see this link.]
http://chuyentinlk.123.st

Thích

Báo xấu [0]

Gửi một bình luận lên tường nhà Admin
Trả lời nhanh
on Sun Sep 02, 2012 11:06 pm
Tường

Tập Code

ôi đm...mày làm cái thuật đó thằng nào nhìn mà hiểu cho cả gia sản nhà tao @@ điều kiện gì mà dễ sợ vậy bố@@
Code:
const fi='bt1.inp';
fo='bt.out';
type diem=record x,y:real;
end;
type dt=record a,b,c:real;
end;
var p:array[0..4] of diem;
luudt:array[0..4] of dt;
m,n:diem;
res:real;
f:text;
procedure doc;
var i:longint;
begin
assign(f,fi);
reset(f);
for i:=1 to 3 do
readln(f,p[i].x,p[i].y);
Readln(f,n.x,n.y);
Readln(f,m.x,m.y);
close(f);
assign(f,fo);
rewrite(f);
end;
procedure xddt(u,v:diem;var t:dt);
begin
t.a:=u.y-v.y;
t.b:=v.x-u.x;
t.c:=u.x*v.y-u.y*v.x;
end;
procedure diemchung(t1,t2:dt;var bien:string;var gd:diem);
var i,j:longint;
d,dx,dy:real;
begin
bien:='';
d:=t1.a*t2.b-t2.a*t1.b;
dx:=t1.b*t2.c-t2.b*t1.c;
dy:=t1.c*t2.a-t2.c*t1.a;
//writeln(f,d:0:3,' ',dx:0:3,' ',dy:0:3);
if (d=0) and (dx=0) and (dy=0) then
begin
bien:='trungcmnr';
exit;
end;
if d<>0 then
begin
gd.x:=dx/d;
gd.y:=dy/d;
end
else bien:='none';
end;
function gt(h:diem;t:dt):real;
begin
gt:=t.a*h.x+t.b*h.y+t.c;
end;
function cungphia(h1,h2:diem;t:dt):boolean;
begin
if gt(h1,t)*gt(h2,t)>=0 then exit(true)
else exit(false);
end;
function cs(x1:longint):longint;
begin
if (x1=1)  then exit(3);
if (x1=2)  then exit(1);
if (x1=3)  then exit(2);
end;
function kc(m1,m2:diem):real;
begin
kc:=sqrt(sqr(m1.x-m2.x)+sqr(m1.y-m2.y));
end;
function namtrong(m1:diem):boolean;
var i:longint;
t:dt;
begin
for i:=1 to 3 do
begin
xddt(p[i],p[i+1],t);
if not cungphia(m1,p[cs(i)],t) then
exit(false);
end;
exit(true);
end;
procedure process;
var i:longint;
gd,gd1,gd2:diem;
t,t1,t2,t3:dt;
tt1,tt2,ok1,ok2:boolean;
vai:string;
begin
res:=0;
xddt(n,m,t);
xddt(p[1],p[2],luudt[1]);
xddt(p[2],p[3],luudt[2]);
xddt(p[3],p[1],luudt[3]);
for i:=1 to 3 do
begin
diemchung(t,luudt[i],vai,gd);
if vai='trungcmnr' then
begin
res:=0;
exit;
end;
end;
tt1:=namtrong(m);
tt2:=namtrong(n);
if (tt1) and (tt2) then
begin
res:=kc(m,n);
exit;
end;
if (tt1=true) and  (tt2=false) then
begin
for i:=1 to 3 do
begin
diemchung(t,luudt[i],vai,gd);
if vai<>'none' then
if (namtrong(gd)) and ((gd.x<>m.x) or (gd.y<>m.y)) then
begin
res:=kc(m,gd);
exit;
end;
end;
end;
if (tt2=true) and (tt1=false) then
begin
for i:=1 to 3 do
begin
diemchung(t,luudt[i],vai,gd);
if vai<>'none' then
if (namtrong(gd)) and ((gd.x<>n.x) or (gd.y<>n.y))then
begin
res:=kc(gd,n);
end;
end;
end;
ok1:=false;ok2:=false;
if (not tt1) and (not tt2) then
begin
for i:=1 to 3 do
begin
diemchung(t,luudt[i],vai,gd);
if vai<>'none' then
if namtrong(gd) then
begin
if ok1=true then
begin
res:=kc(gd1,gd);
exit;
end
else
begin
ok1:=true;
gd1:=gd;
end;
end;
end;
end;
end;
begin
doc;
process;
write(f,res:0:5);
close(f);
end.



Spoiler:
thẻ ẩn

Thích

Báo xấu [0]

Gửi một bình luận lên tường nhà Tường
Trả lời nhanh
on Sun Sep 02, 2012 11:11 pm
Admin

Code - Huyền Thoại



tao làm kiểu khác cô mà =="



Mà cách mày công nhận làm ngắn hơn

_________________


[You must be registered and logged in to see this link.]
http://chuyentinlk.123.st

Thích

Báo xấu [0]

Gửi một bình luận lên tường nhà Admin
Trả lời nhanh
Sponsored content

Thích

Báo xấu [0]

Gửi một bình luận lên tường nhà Sponsored content
Trả lời nhanh

Về Đầu TrangThông điệp [Trang 1 trong tổng số 1 trang]

  © FMvi.vn

|_-Diễn Đàn Tin Học - Lê Khiết-_|

« Xem bài trước | Xem bài kế tiếp »

Bài viết liên quan

    Quyền hạn của bạn:

    Bạn không có quyền trả lời bài viết