PureBoard

Verfasst: **17.12.2006 11:59**

Weil ich grad viel mit der Analyse von möglichen Verbindungspunkten rumhaspel, habe ich eine Routine entworfen, die zwei Felder mit beliebig vielen Punkten vergleicht und die beiden Punkte raussucht, die die geringste Entfernung zueinander haben.

Parameter:
*points1.POINT - Pointer auf 1. Punkt im 1. Feld
*points2.POINT - Pointer auf 1. Punkt im 2. Feld
points1.l - Anzahl Punkte 1. Feld
points2.l - Anzahl Punkte 2. Feld
*result1.POINT - Koordinaten des naheliegendsten Punktes Feld 1
*result2.POINT - Koordinaten des naheliegendsten Punktes Feld w

Code mit Beispiel:

Code: Alles auswählen

EnableExplicit

Procedure GetBestEdge(*points1.POINT, *points2.POINT, points1.l, points2.l, *result1.POINT,*result2.POINT); setzt die infos der am nächsten gelegenen ecken in die in den parametern angebenen variablen!
  Protected bestdist.l, pointcount1.l, pointcount2.l, pointpositions.POINT
  Protected *p1.POINT, *p2.POINT, distance.l, *bestedge1.POINT, *bestedge2.POINT
  bestdist = 2147483647
  If *points1 > 0 And *points2 > 0 And *result1 > 0 And *result2 > 0
    *p1 = *points1
    *p2 = *points2
    ;von den punkten des ersten rechteckes ausgehend, alle punkte des zweiten abfragen
    For pointcount1=0 To points1 Step 1
      *p2 = *points2
      For pointcount2=0 To points2 Step 1
        distance = Abs(*p1\X - *p2\X) + Abs(*p1\Y - *p2\Y)
        If distance < bestdist
          *bestedge1 = *p1
          *bestedge2 = *p2
          bestdist = distance
          Debug "bestdist="+Str(bestdist)
          pointpositions\X = pointcount1
          pointpositions\Y = pointcount2
        EndIf
        *p2 + SizeOf(POINT)
      Next
      *p1 + SizeOf(POINT)
    Next
    If *bestedge1 > 0 And *bestedge2 > 0
      CopyMemory(*bestedge1, *result1, SizeOf(POINT))
      CopyMemory(*bestedge2, *result2, SizeOf(POINT))
    EndIf
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

;kleines beispiel:

Macro offsetX
points*SizeOf(POINT)+OffsetOf(POINT\X)
EndMacro
Macro offsetY
points*SizeOf(POINT)+OffsetOf(POINT\Y)
EndMacro
Macro imgw: 500: EndMacro
Macro imgh: 400: EndMacro
Macro if_in_rect(px,py, rx,ry,rw,rh)
  If px >= rx And py >= ry And px < rx+rw And py < ry+rh
EndMacro
Macro getmouse(struc)
  struc\X = WindowMouseX(0)
  struc\Y = WindowMouseY(0)
EndMacro

Global img.l
img = CreateImage(#PB_Any, imgw,imgh)

OpenWindow(0,0,0,imgw,imgh,"edge test", #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_TitleBar)
CreateGadgetList(WindowID(0))
ImageGadget(0, 0,0, imgw,imgh, ImageID(img))
showcursor_(#False)

Global points.l, event.l, curpos.POINT, lastcurpos.POINT, linebeg.POINT,lineend.POINT
Global *field1.POINT, *field2.POINT, drawpos.POINT

*field1 = AllocateMemory(2*5*SizeOf(POINT))
*field2 = AllocateMemory(2*5*SizeOf(POINT))

For points = 0 To 4
  PokeL(*field1+offsetX, imgw/2-50+Random(100))
  PokeL(*field1+offsetY, imgh/2-50+Random(100))
Next
For points = 0 To 7
  PokeL(*field2+offsetX, Random(100))
  PokeL(*field2+offsetY, Random(100))
Next
getmouse(lastcurpos)

Repeat
  event = WaitWindowEvent(200)
  
  getmouse(curpos)
  For points = 0 To 7
    PokeL(*field2+offsetX, PeekL(*field2+offsetX) + (curpos\X-lastcurpos\X))
    PokeL(*field2+offsetY, PeekL(*field2+offsetY) + (curpos\Y-lastcurpos\Y))
  Next
  CopyMemory(curpos,lastcurpos,SizeOf(POINT))
  StartDrawing(ImageOutput(img))
    Box(0,0, imgw,imgh, 0)
    For points = 0 To 4
      drawpos\X = PeekL(*field1+offsetX)
      drawpos\Y = PeekL(*field1+offsetY)
      if_in_rect(drawpos\X, drawpos\Y, 0,0,imgw,imgh)
        Plot(drawpos\X,drawpos\Y, $0000FF)
      EndIf
    Next
    For points = 0 To 7
      drawpos\X = PeekL(*field2+offsetX)
      drawpos\Y = PeekL(*field2+offsetY)
      if_in_rect(drawpos\X, drawpos\Y, 0,0,imgw,imgh)
        Plot(drawpos\X,drawpos\Y, $00FF00)
      EndIf
    Next
    If GetBestEdge(*field1,*field2, 4,7, @linebeg,@lineend)
      LineXY(linebeg\X,linebeg\Y,lineend\X,lineend\Y, $FFFFFF)
    Else
      Debug "error!"
    EndIf
  StopDrawing()
  SetGadgetState(0, ImageID(img))
Until event = #PB_Event_CloseWindow

FreeImage(img)

Verfasst: **17.12.2006 13:48**

das ist aber sehr kontext-spezifisch. jedenfalls sehe ich bei deinen memory- und Poke-geschichten nicht durch. deine Abs()-verwendung würde ich auch nochmal überdenken.

so würde ich das vielleicht machen zwar mit LLs, aber ich spare einige proc-calls:

Code: Alles auswählen

Procedure.l setClosestElements( a.Point(), b.Point() )
  ;erwartet zwei listen vom typ POINT.
  ;gibt die geringste distanz zwischen einem punkt
  ;der einen liste und einem punkt der anderen
  ;liste zurück.
  ;die beiden punkte, werden aktuelles element ihrer
  ;jeweiligen liste.
  Protected resultDist.l = $7fffffff ;(+LongMax)
  Protected dist.l
  Protected dx.l
  Protected dy.l
  Protected *pa
  Protected *pb
  
  ForEach a()
    ForEach b()
      dx = a()\x - b()\x
      dy = a()\y - b()\y
      dist = dx*dx+dy*dy
      If dist<resultDist
        resultDist=dist
        *pa=a()
        *pb=b()
      EndIf
    Next
  Next
  
  ChangeCurrentElement( a(), *pa )
  ChangeCurrentElement( b(), *pb )
  ProcedureReturn Sqr(resultDist.l)
EndProcedure





;windowsize
ww=800
wh=600
hWin=OpenWindow(0, 50,50,ww,wh, "") 



NewList a.Point()
NewList b.Point()

;FIXIERTE PUNKTE
For i=0 To 7
  AddElement(a())
  a()\x=Random(200)-100 +ww/2
  a()\y=Random(200)-100 +wh/2
Next

;ABSTANDÄNDE DER BEWEGLICHEN PUNKTE UNTEREINANDER (in array speichern)
Dim rand.Point(7)
For i=0 To 7
  AddElement(b())
  rand(i)\x=Random(200)-100
  rand(i)\y=Random(200)-100
Next




Repeat
  mx = WindowMouseX(0)
  my = WindowMouseY(0)
  ;ABSOLUTE POSITIONEN DER BEWEGLICHEN PUNKTE (mit mouse-koordinaten)
  i=0
  ForEach b()
    b()\x = rand(i)\x + mx
    b()\y = rand(i)\y + my
    i+1
  Next
  
  ;#############################################
  ;KLEINSTE DISTANZ FINDEN UND ENTSPRECHENDE ELEMENTE AKTUELL SETZEN
  dist=setClosestElements( a(), b() )
  ;#############################################
  
  StartDrawing( WindowOutput(0) )
    Box(0,0,ww,wh,0)
    DrawText(10,10,"dist: "+Str(dist),$00aa00)
    LineXY( a()\x, a()\y, b()\x, b()\y, $0000ff)
    ForEach a()
      Line( a()\x, a()\y, 1,1, $88ff88 )
    Next
    ForEach b()
      Line( b()\x, b()\y, 1,1, $ff8888 )
    Next
  StopDrawing()
  
Until WaitWindowEvent() = #PB_Event_CloseWindow

Verfasst: **29.12.2006 18:18**

Sieht wirklich schön kurz aus, deine Variante

Mit Listen arbeite ich hier nicht gerne, da ich sehr viele Listen bräuchte (~20)

. Nur verstehe ich nicht, was ihr alle gegen Abs() habt... Geht es euch um den Procedureaufruf? Um die Rechnung, die dahintersteht? Es wird doch lediglich geprüft, ob die Minus ist oder nicht und wird dann multipliziert... Aber Moment, ev. versuchen die das ja auch über Vorzeichen zu ermitteln... Ich würde auf jeden Fall wissen, was daran so schlimm sein soll.

PS: Warum multiplizierst du deine Distanz mit 2? Mir leuchtet das kein wenig ein, höchstens, wenn du sie später ent-multiplizierst...
Edit: Ah, verstehe. Die Distanz wird am Ende entwurzelt, klevere Idee!

PureBoard

Aus 2 Punktfelder die naheliegendsten Punkte raussuchen

Aus 2 Punktfelder die naheliegendsten Punkte raussuchen