Rosetta Code

Determine if two triangles overlap: Difference between revisions

Page Discussion

Determine if two triangles overlap (view source)

Revision as of 12:00, 12 January 2017

927 bytes removed ,  7 years ago
→‎{{header|ooRexx}}: removed the fraction arithmetic (was a false Alarm?)
(→‎{{header|ooRexx}}: fix one bug (found by more testing)
(→‎{{header|ooRexx}}: removed the fraction arithmetic (was a false Alarm?))
Line 154:
<lang oorexx>/*--------------------------------------------------------------------
* Determine if two triangles overlap
* The fraction arithmetic avoids problems with floating point values
* Fully (?) tested with integer coordinates of the 6 corners
* This was/is an exercise with ooRexx
* Removed the fraction arithmetic
*-------------------------------------------------------------------*/
Parse Version v
Line 162:
oid='trioo.txt'; 'erase' oid
Call o v
case=0
 
cc=0
Call trio_test '0 0 4 0 0 4 1 1 2 1 1 2'
Call trio_test '0 0 0 6 8 3 8 0 8 8 0 3'
Call trio_test '0 0 0 2 2 0 0 0 4 0 0 6'
/* The task's specified input */
Call trio_test '0 0 5 0 0 5 0 0 5 0 0 6'
Line 195 ⟶ 199:
Call trio_test '2 0 2 6 1 8 0 1 0 5 8 3'
Call trio_test '0 0 4 0 0 4 1 1 2 1 1 2'
Say case 'cases tested'
Say cc
Exit
 
trio_test:
Parse Arg tlist
cc+=1
tlist=space(tlist)
::routinetl1=tlist divide /* divide two fractions ; Call trio_t */tl1▼
tl2=reversex(tlist) ; Call trio_t tl2
tl3=''
tl=tlist
Do While tl<>''
Parse Var atl anomx '/'y adenomtl▼
tl3=tl3 y x
End▼
::routine add /* add two fractions */ Call trio_t tl3▼
tl4=reversex(tl3) ; Call trio_t tl4
tl5=subword(tl4,7) subword(tl4,1,6) ; Call trio_t tl5
tl6=subword(tl5,7) subword(tl5,1,6) ; Call trio_t tl6
Return res▼
 
trio_t:
Parse Arg tlist
tlist=space(tlist)
Say tlist
case+=1
Parse Arg ax ay bx by cx cy dx dy ex ey fx fy
/*---------------------------------------------------------------------
Line 282 ⟶ 308:
End
Call o '',1
-- Pull .
Return
End
Line 292 ⟶ 318:
Call o 'Triangles overlap and touch on' bordl,1
Call o ''
-- Pull .
Return
End
Line 385 ⟶ 411:
call o abc 'and' def 'overlap',1
Call o '',1
-- Pull .
End
Return
Line 457 ⟶ 483:
Select
When ka.1='*' Then Do
y2=add(multiply(ka.2,*pp~x),+da.2)
y3=add(multiply(ka.3,*pp~x),+da.3)
res=between(y2,pp~y,y3)
End
When ka.2='*' Then Do
y2=add(multiply(ka.1,*pp~x),+da.1)
res=between(p1~y,y2,p2~y)
End
Otherwise Do
dap=subtract(pp~y,multiply(-ka.1,*pp~x))
If ka.3='*' Then
x3=xa.3
Else
x3=divide(subtract(da.3,-dap),subtract/(ka.1,-ka.3))
x2=divide(subtract(da.2,-dap),subtract/(ka.1,-ka.2))
res=between(x2,pp~x,x3)
End
Line 513 ⟶ 539:
End
Else Do
ka=divide(y2-y1,)/(x2-x1)
da=subtract(y2,multiply(-ka,*x2))
xa='*'
End
Line 527 ⟶ 553:
End
Else Do
ey=add(multiply(k,*p~x),+d)
res=(ey=p~y)&between(p1~x,p~x,p2~x,'I')
End
Line 554 ⟶ 580:
Else Do
Call o 'kb='kb 'xa='||xa 'db='db
yy=add(multiply(kb,*xa),+db)
res=between(q1~y,yy,q2~y)
End
End
When kb='*' Then Do
yy=add(multiply(ka,*xb),+da)
res=between(p1~y,yy,p2~y)
End
Line 575 ⟶ 601:
End
Otherwise Do
x=divide(subtract(db,-da),subtract/(ka,-kb))
y=add(multiply(ka,*x),+da)
Call o 'cross:' x y
res=between(p1~x,x,p2~x)
Line 605 ⟶ 631:
Call o a x b 'res='res
Return res
▲::routine divide /* divide two fractions */
Use Arg a,b▼
▲ Parse Var a anom '/' adenom
Parse Var b bnom '/' bdenom
If adenom='' Then adenom=1
If bdenom='' Then bdenom=1
res=anom*bdenom'/'bnom*adenom
Return reduce(res)▼
::routine multiply /* multiply two fractions */
Use Arg a,b
Parse Var a anom '/' adenom
Parse Var b bnom '/' bdenom
If adenom='' Then adenom=1
If bdenom='' Then bdenom=1
res=anom*bnom'/'adenom*bdenom
Return reduce(res)
::routine subtract /* subtract two fractions */
Use Arg a,b
Parse Var a anom '/' adenom
Parse Var b bnom '/' bdenom
If adenom='' Then adenom=1
If bdenom='' Then bdenom=1
res=(anom*bdenom-bnom*adenom)'/'adenom*bdenom
Return reduce(res)
▲::routine add /* add two fractions */
Use Arg a,b
Parse Var a anom '/' adenom
Parse Var b bnom '/' bdenom
If adenom='' Then adenom=1
If bdenom='' Then bdenom=1
res=(anom*bdenom+bnom*adenom)'/'adenom*bdenom
Return reduce(res)
::routine reduce /* cancel a fraction */
Use Arg a
Parse Var a anom '/' adenom
If adenom<0 Then Do
anom=-anom
adenom=-adenom
▲ End
k=gcd(anom,adenom)
If adenom=k Then
res=anom/k
Else
res=(anom/k)'/'||(adenom/k)
▲ Return res
 
::routine gcd /* greatest common divisor */
Use Arg a,b
if b = 0 then return abs(a)
return gcd(b,a//b)
 
::routine show_g /* show a straight line's forula */
Line 696 ⟶ 672:
::routine draw
Use Arg pixl
Return /* remove to see the triangle corners */
Say 'pixl='pixl
pix.=' '
Line 714 ⟶ 690:
Say ol
End
Return </lang>
::routine reversex
▲ Use Arg a,blist
n=words(list)
res=word(list,n)
Do i=n-1 to 1 By -1
res=res word(list,i)
End
▲ Return reduce(res) </lang>
{{out}}
<pre>Triangle: ABC: (0,0) (5,0) (0,5)
Walterpachl
2,299

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/272382"