- Code: Select all
Function LineSegIsect(ax#, ay#, bx#, by#, cx#, cy#, dx#, dy#)
Return (((bx-ax)*(cy-ay)-(by-ay)*(cx-ax))*((bx-ax)*(dy-ay)-(by-ay)*(dx-ax)) < 0)(((dy-cy)*(cx-ax)-(dx-cx)*(cy-ay))*((dx-cx)*(by-cy)-(dy-cy)*(bx-cx)) < 0)
EndFunction
Oman benchmarkkaukseni perusteella SDK:n funktio on lähes kolme kertaa hitaampi.
Pointtini ei ole, että SDK:n funktio olisi huono (päin vastoin!), vaan että kaikkia ongelmia ei kannata ampua tykillä, jos kevyemmälläkin kalustolla pärjää.
Seuraavassa syitä siihen, miksi SDK:n funktio on hidas:
Oma funktioni on optimoitu huippuunsa jättämällä siitä erinäisiä ominaisuuksia pois verrattuna SDK:n vastineeseen: ensinnäkin SDK:n funktio laskee leikkaustapauksessa leikkauspisteen ja palauttaa sen koordinaatit. Lisäksi se pystyy käsittelemään myös tapaukset, joissa toisen janan toinen päätepiste on tasan toisella janalla tai janat ovat yhdensuuntaisina päällekäin.
Käytännössä kumpikaan näistä kahdesta skenaariosta ei koskaan toteudu, kun janojen koordinaatit saavat reaalilukuarvoja (eli desimaalilukuja, kuten käytännössä kaikki data vaikkapa fysiikkasimulaatiossa). Niiden esiintymistodennäköisyys on huomattava ainoastaan silloin, kun koordinaatit ovat aina kokonaislukuja.
Tässä vielä testiohjelma. Janan pää on liimattu hiireen, ja avaruusnäppäin arpoo uudet arvot. LineSegIsect2() on käytännössä sama funktio kuin LineSegIsect1() mutta vaan huomattavasti selkeämpi lukea, mutta vie enemmän tilaa. Suorituskykyero oikeastaan marginaalinen.
- Code: Select all
Const ITR = 10000
Dim ax#, ay#, bx#, by#, cx#, cy#, dx#, dy# As Float
Dim isect1, isect2, isect3, time1, time2, time3, i As Integer
Global IntersX, IntersY As Float
Global LinesOnTop As Integer
Gosub random
Repeat
If KeyHit(cbKeySpace) Then Gosub Random
ax = MouseX() : ay = MouseY()
Wait 5
time1 = Timer()
For i = 1 To ITR
isect1 = LineSegIsect1(ax, ay, bx, by, cx, cy, dx, dy)
Next i
time1 = Timer()-time1
time2 = Timer()
For i = 1 To ITR
isect2 = LineSegIsect2(ax, ay, bx, by, cx, cy, dx, dy)
Next i
time2 = Timer()-time2
time3 = Timer()
For i = 1 To ITR
isect3 = LinesIntersect(ax, ay, bx, by, cx, cy, dx, dy)
Next i
time3 = Timer()-time3
Text 1, 1, "Kustom1: " + time1
Text 1, 14, "Kustom2: " + time2
Text 1, 27, "SDK: " + time3
If isect1 <> isect3 Then End
Color 255*(1-isect3), 255*(1-isect1), 255
Line ax, ay, bx, by
Line cx, cy, dx, dy
DrawScreen
Forever
End
Random:
bx = Rnd(ScreenWidth())
by = Rnd(ScreenHeight())
cx = Rnd(ScreenWidth())
cy = Rnd(ScreenHeight())
dx = Rnd(ScreenWidth())
dy = Rnd(ScreenHeight())
Return
Function LineSegIsect1(ax#, ay#, bx#, by#, cx#, cy#, dx#, dy#)
Return (((bx-ax)*(cy-ay)-(by-ay)*(cx-ax))*((bx-ax)*(dy-ay)-(by-ay)*(dx-ax)) < 0)(((dy-cy)*(cx-ax)-(dx-cx)*(cy-ay))*((dx-cx)*(by-cy)-(dy-cy)*(bx-cx)) < 0)
EndFunction
Function LineSegIsect2(ax#, ay#, bx#, by#, cx#, cy#, dx#, dy#)
Dim ABx#, ABy#, ACx#, ACy#, CDx#, CDy# As Float
Dim ABxAC#, ABxAD#, CDxCA#, CDxCB# As Float
ABx = bx-ax
ABy = by-ay
ACx = cx-ax
ACy = cy-ay
CDx = dx-cx
CDy = dy-cy
ABxAC = ABx*ACy-ABy*ACx
ABxAD = ABx*(dy-ay)-ABy*(dx-ax)
CDxCA = CDy*ACx-CDx*ACy
CDxCB = CDx*(by-cy)-CDy*(bx-cx)
If ABxAC*ABxAD < 0 And CDxCA*CDxCB < 0 Then Return True
Return False
EndFunction
//© CBSDK
// Tarkastaa leikkavatko kaksi janaa ja paluttaa leikauspisteen
Function LinesIntersect(Ax#, Ay#, Bx#, By#, Cx#, Cy#, Dx#, Dy#)
Dim Rn#, Rd#, Sn#, Intersection_AB#, Intersection_CD# As Float
LinesOnTop = False
// Tarkastetaan ovatko suorat toistensa päällä yhdensuuntaisina
If Collinear(Ax#,Ay#,Bx#,By#,Cx#,Cy#) = True And Collinear(Ax#,Ay#,Bx#,By#,Dx#,Dy#) = True Then 'ovatko yhdensuuntaisia
If Between(Ax#,Ay#,Bx#,By#,Cx#,Cy#) = True Or Between(Ax#,Ay#,Bx#,By#,Dx#,Dy#) = True Or Between(Cx#,Cy#,Dx#,Dy#,Ax#,Ay#) = True Or Between(Cx#,Cy#,Dx#,Dy#,Bx#,By#) = True Then 'ovatko sisäkkäin
IntersX = 0
IntersY = 0
LinesOnTop = True
Return True
EndIf
EndIf
Rn# = (Ay#-Cy#)*(Dx#-Cx#) - (Ax#-Cx#)*(Dy#-Cy#)
Rd# = (Bx#-Ax#)*(Dy#-Cy#) - (By#-Ay#)*(Dx#-Cx#)
If Rd# = 0
Return False
Else
Sn# = (Ay#-Cy#)*(Bx#-Ax#) - (Ax#-Cx#)*(By#-Ay#)
Intersection_AB# = Rn# / Rd#
Intersection_CD# = Sn# / Rd#
If Intersection_AB# > 1 Or Intersection_CD# > 1 Or Intersection_AB# < 0 Or Intersection_CD# < 0 Then Return False
IntersX = Ax# + Intersection_AB#*(Bx#-Ax#)
IntersY = Ay# + Intersection_AB#*(By#-Ay#)
Return True
EndIf
End Function
//© CBSDK
// Tarkastaa onko jokin piste kahden pisteen määrittämällä suoralla
Function Collinear(x1#,y1#,x2#,y2#,x3#,y3#)
If x1*(y2-y3) + x2*(y3-y1) + x3*(y1-y2) = 0 Then Return True Else Return False
End Function
//© CBSDK
// Tarkastaa onko jokin piste kahden pisteen määrittämällä janalla
Function Between(x1#,y1#,x2#,y2#,x3#,y3#)
If Collinear(x1#,y1#,x2#,y2#,x3#,y3#) = False Then Return False
If Distance(x1,y1,x3,y3) + Distance(x3,y3,x2,y2) = Distance(x1,y1,x2,y2) Then Return True Else Return False
End Function
