PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

Algo

https://www.purebasic.fr/french/viewtopic.php?t=2516

Page 3 sur 3

Publié : jeu. 26/janv./2006 11:37
par Dr. Dri
@Yves Rouquier
Tu avais posté ta solution, et j'avais pas vu que tu cherchais toujours une solution :-?
(je pensais que tu avais ton compte avec la fonction PtInRegion)

Je te poste donc mon algo des droites en version optimisée
(donc si t'as des questions je répond sans problème)

Code : Tout sélectionner

Structure Pts
  Pt.Point[0]
EndStructure

Procedure.l PointInPolygon(*Polygon.Pts, nPoints.l, x.l, y.l)
  Protected InPolygon.l, in.l, i.l
  Protected x1.l, x2.l, y1.l, y2.l
  
  If *Polygon And nPoints >= 3
    
    x1 = *Polygon\Pt[0]\x - x
    y1 = *Polygon\Pt[0]\y - y
    
    Repeat
      i + 1
      If i = nPoints
        i = 0
      EndIf
      
      x2 = *Polygon\Pt[i]\x - x
      y2 = *Polygon\Pt[i]\y - y
      
      If (y1 ! y2) & $80000000
        in = ( (x1 * y2) - (x2 * y1) ) / (y2 - y1)
      EndIf
      
      If in > 0
        InPolygon ! #True
        in = 0
      EndIf
      
      x1 = x2
      y1 = y2
    Until i = 0
    
  EndIf
  
  ProcedureReturn InPolygon
EndProcedure

;-exemple
If OpenWindow(0, 0, 0, 600, 400, #PB_Window_SystemMenu|#PB_Window_ScreenCentered, "Algo des droites")
  CreateGadgetList( WindowID(0) )
  
  CreateImage(0, 320, 240)
  ImageGadget(0, 140, 80, 320, 240, UseImage(0))
  
  ButtonGadget(1, 10, 10, 120, 20, "Ajouter un point")
  ButtonGadget(2, 10, 40, 120, 20, "Dessiner le polygône")
  ButtonGadget(3, 10, 70, 120, 20, "Remise à zéro")
  
  DisableGadget(2, 1)
  
  CreateStatusBar(0, WindowID(0))
  AddStatusBarField(600)
  
  Dim Polygone.Point(0)
  NewList Points.Point()
  
  Repeat
    Event = WaitWindowEvent()
    
    If Event = #PB_Event_Gadget
      
      Gadget = EventGadgetID()
      
      Select Gadget
        Case 0
          If Ajoute
            AddElement( Points() )
            Points()\x = WindowMouseX() - 140
            Points()\y = WindowMouseY() -  80
            
            If StartDrawing( ImageOutput() )
              Plot(Points()\x, Points()\y, $00FFFF)
              StopDrawing()
            EndIf
            
            SetGadgetState(0, ImageID())
            
            If CountList( Points() ) >= 3
              DisableGadget(2, #False)
            EndIf
            
            Ajoute = #False
          EndIf
          
        Case 1
          StatusBarText(0, 0, "Cliquez sur l'image pour ajouter le point")
          Ajoute = #True
          
        Case 2
          n = CountList( Points() )
          Dim Polygone.Point(n - 1)
          
          i = 0
          ForEach Points()
            Polygone(i)\x = Points()\x
            Polygone(i)\y = Points()\y
            i + 1
          Next
          
          If StartDrawing( ImageOutput() )
            Box(0, 0, 320, 240, $000000)
            
            i = 1
            While i <= n
              x1 = Polygone(i%n)\x
              y1 = Polygone(i%n)\y
              x2 = Polygone(i-1)\x
              y2 = Polygone(i-1)\y
              
              LineXY(x1, y1, x2, y2, $00FFFF)
              i + 1
            Wend
            
            StopDrawing()
          EndIf
          
          SetGadgetState(0, ImageID())
          DisableGadget(2, #True)
          Dessine = #True
          
        Case 3
          ClearList( Points() )
          If StartDrawing( ImageOutput() )
            Box(0, 0, 320, 240, $000000)
            StopDrawing()
          EndIf
          SetGadgetState(0, ImageID())
          Dessine = #False
          DisableGadget(2, #True)
        StatusBarText(0, 0, "")
          
      EndSelect
      
      DisableGadget(1, Dessine|Ajoute)
    Else
      
      If Dessine
        
        x = WindowMouseX() - 140
        y = WindowMouseY() -  80
        
        If x >= 0 And y >= 0 And x <320 And y < 240
          
          If PointInPolygon(Polygone(), n, x, y)
            s$ = "Dans le polygône"
          Else
            s$ = "Hors du polygône"
          EndIf
          
        Else
          
          s$ = "Mettez la souris sur l'image"
          
        EndIf
        StatusBarText(0, 0, s$)
      EndIf
      
    EndIf
    
  Until Event = #PB_Event_CloseWindow
EndIf
Dri :-?

Publié : jeu. 26/janv./2006 12:59
par Frenchy Pilou
@Dri
Pas si simple!
J'ai rempli de quelques points en continu et voilà le résultat :)


Image

Publié : jeu. 26/janv./2006 13:48
par Dr. Dri
Telle que je l'utilise la fonction n'a pas besoin de travailler sur les polygones croisés... Quoi qu'il en soit elle fonctionne sur les polygones croisés mais pas aussi complexes...

Dri ;)

Publié : jeu. 26/janv./2006 14:01
par Frenchy Pilou
mais pas aussi complexes...
9 points ! :D

Publié : jeu. 26/janv./2006 14:28
par Dr. Dri
Frenchy Pilou a écrit :
mais pas aussi complexes...
9 points ! :D
Et combien de zones se croisent ?

Dri :jesors:

Publié : jeu. 26/janv./2006 14:48
par Frenchy Pilou
Normalement un algo tout terrain qui examine une image 2D doit pouvoir répondre à ce genre de configuration :D
C'est le fait de considérer ceci en tant que "polygones" qui met le bazar :roll:

Publié : jeu. 26/janv./2006 15:19
par Dr. Dri
voila une version ou le tracé est rempli, plutot qu'en ligne... J'utilise la fonction Polygon_()

Code : Tout sélectionner

Structure Pts
  Pt.Point[0]
EndStructure

Procedure.l PointInPolygon(*Polygon.Pts, nPoints.l, x.l, y.l)
  Protected InPolygon.l, in.l, i.l
  Protected x1.l, x2.l, y1.l, y2.l
  
  If *Polygon And nPoints >= 3
    
    x1 = *Polygon\Pt[0]\x - x
    y1 = *Polygon\Pt[0]\y - y
    
    Repeat
      i + 1
      If i = nPoints
        i = 0
      EndIf
      
      x2 = *Polygon\Pt[i]\x - x
      y2 = *Polygon\Pt[i]\y - y
      
      If (y1 ! y2) & $80000000
        in = ( (x1 * y2) - (x2 * y1) ) / (y2 - y1)
      EndIf
      
      If in > 0
        InPolygon ! #True
        in = 0
      EndIf
      
      x1 = x2
      y1 = y2
    Until i = 0
    
  EndIf
  
  ProcedureReturn InPolygon
EndProcedure

;-exemple
If OpenWindow(0, 0, 0, 600, 400, #PB_Window_SystemMenu|#PB_Window_ScreenCentered, "Algo des droites")
  CreateGadgetList( WindowID(0) )
  
  CreateImage(0, 320, 240)
  ImageGadget(0, 140, 80, 320, 240, UseImage(0))
  
  ButtonGadget(1, 10, 10, 120, 20, "Ajouter un point")
  ButtonGadget(2, 10, 40, 120, 20, "Dessiner le polygône")
  ButtonGadget(3, 10, 70, 120, 20, "Remise à zéro")
  
  DisableGadget(2, 1)
  
  CreateStatusBar(0, WindowID(0))
  AddStatusBarField(600)
  
  Dim Polygone.Point(0)
  NewList Points.Point()
  
  Repeat
    Event = WaitWindowEvent()
    
    If Event = #PB_Event_Gadget
      
      Gadget = EventGadgetID()
      
      Select Gadget
        Case 0
          If Ajoute
            AddElement( Points() )
            Points()\x = WindowMouseX() - 140
            Points()\y = WindowMouseY() -  80
            
            If StartDrawing( ImageOutput() )
              Plot(Points()\x, Points()\y, $00FFFF)
              StopDrawing()
            EndIf
            
            SetGadgetState(0, ImageID())
            
            If CountList( Points() ) >= 3
              DisableGadget(2, #False)
            EndIf
            
            Ajoute = #False
          EndIf
          
        Case 1
          StatusBarText(0, 0, "Cliquez sur l'image pour ajouter le point")
          Ajoute = #True
          
        Case 2
          n = CountList( Points() )
          Dim Polygone.Point(n - 1)
          
          i = 0
          ForEach Points()
            Polygone(i)\x = Points()\x
            Polygone(i)\y = Points()\y
            i + 1
          Next
          
          hDC = StartDrawing( ImageOutput() )
          If hDC
            Box(0, 0, 320, 240, $000000)
            
;             i = 1
;             While i <= n
;               x1 = Polygone(i%n)\x
;               y1 = Polygone(i%n)\y
;               x2 = Polygone(i-1)\x
;               y2 = Polygone(i-1)\y
;               
;               LineXY(x1, y1, x2, y2, $00FFFF)
;               i + 1
;             Wend
            
            FrontColor($FF, $FF, $00)
            Polygon_(hDC, Polygone(), n)
            
            StopDrawing()
          EndIf
          
          SetGadgetState(0, ImageID())
          DisableGadget(2, #True)
          Dessine = #True
          
        Case 3
          ClearList( Points() )
          If StartDrawing( ImageOutput() )
            Box(0, 0, 320, 240, $000000)
            StopDrawing()
          EndIf
          SetGadgetState(0, ImageID())
          Dessine = #False
          DisableGadget(2, #True)
        StatusBarText(0, 0, "")
          
      EndSelect
      
      DisableGadget(1, Dessine|Ajoute)
    Else
      
      If Dessine
        
        x = WindowMouseX() - 140
        y = WindowMouseY() -  80
        
        If x >= 0 And y >= 0 And x <320 And y < 240
          
          If PointInPolygon(Polygone(), n, x, y)
            s$ = "Dans le polygône"
          Else
            s$ = "Hors du polygône"
          EndIf
          
        Else
          
          s$ = "Mettez la souris sur l'image"
          
        EndIf
        StatusBarText(0, 0, s$)
      EndIf
      
    EndIf
    
  Until Event = #PB_Event_CloseWindow
EndIf
Dri ;)

Publié : jeu. 26/janv./2006 16:21
par Frenchy Pilou
Cela ne change rien au problème des surfaces polygoniques "croisée" internes :lol:
En fait c'est un programme qui répond juste à un problème particulier suivant le dessin ordonné des polygones
Mais c'est déjà pas mal :)

Publié : ven. 27/janv./2006 19:33
par Yves Rouquier
bonjour ,
j'ais supprimé un de mes post car j'ais trouvé aprés coup
une petite imprecision .

Les liens pour les sources en c et explication :(solution 2)
http://astronomy.swin.edu.au/~pbourke/g ... nsidepoly/
http://www.owlnet.rice.edu/~comp360/lec ... olygon.pdf

Publié : ven. 27/janv./2006 19:56
par Dr. Dri
Je n'aime pas trop les solutions trigo... C'est beaucoup moins rapide. Avec la version que j'ai postée, on peut facilement traduire ca en réels sans pour autant avoir de gros calculs.

Dri :)

PS. Le lien est tes intéressant, je regarde le 2e

[edit]
Le 2e lien est super, et ca explique même les limites du systeme que j'utilise ^^
je vais faire des tests avec mon petit jeu pour voir si je rencontre ce problème ^^

Publié : ven. 27/janv./2006 20:18
par Yves Rouquier
J'ais besoin d'une version avec des coordonnées en float.

Cette solution est presque parfaite , reste une imprecision quand
le point est exactement sur le contours .
le doute peut être levé en ajoutant un controle " point sur segment ? ".
selon le choix frontiere consideré comme interieur ou exterieur.

voici ma solution :

Code : Tout sélectionner

;----- Def des variables

Structure pt ; point
  
  h.f
  v.f
EndStructure


NewList polygon.pt()

Global pointxy.pt
Global pi.f
pi = 3.14159265


Procedure.f ATan2(y.f,x.f)
  ;atan2 procedure by Paul Dixon
  ;http://www.powerbasic.com/support/forums/Forum4/HTML/009180.html
  ;adapted to PureBasic by Jack
  ! fld dword [Esp]     ;load y
  ! fld dword [Esp+4]   ;load x
  ! fpatan              ;get atan(y/x), put result in ST1. then pop stack to leave result in ST0
  ! ftst                ;test ST0 (that's the top of stack) against zero
  ! fstsw ax            ;put result of test into AX
  ! sahf                ;get the FPU flags into the CPU flags
  ! jae @@skip          ; if above or equal then skip the add 2*pi code
  ! fldpi               ;get pi
  ! fadd st1,st0        ;add pi to result
  ! faddp st1,st0       ;and again, for 2pi, then pop the now unneeded pi from st0
  ! @@skip:
EndProcedure 

Procedure.f Angle2D ( x1.f ,y1.f,x2.f,y2.f) 
  
  dtheta.f
  theta1.f
  theta2.f
   
  theta1 = ATan2(y1,x1)
  
  theta2 = ATan2(y2,x2)
  
  dtheta = theta2 - theta1
   
  While (dtheta > pi)
    dtheta - 2*pi
  Wend
   
  While (dtheta < pi*-1)
    dtheta + 2*pi
  Wend
  
  ProcedureReturn dtheta
   
EndProcedure

Procedure.b InsidePolygon() 
  
  i.l=0
  angle.f =0
  p1.pt : p2.pt
  n.l = CountList(polygon())
   
  
  While i < n
    
    SelectElement(polygon(),i)             ; -----  def du vecteur 1 -------
    
    p1\h = polygon()\h - pointxy\h
   
    p1\v = polygon()\v - pointxy\v
     
    SelectElement(polygon(),(i+1)%n)       ; -----  def du vecteur 2 -------
     
    p2\h = polygon()\h - pointxy\h
     
    p2\v = polygon()\v - pointxy\v
     
    angle + Angle2D(p1\h,p1\v,p2\h,p2\v)   
    
    
     
    i+1
  
  Wend
   
  If Abs(angle)< pi
    ProcedureReturn 0
  Else 
    ProcedureReturn 1
  EndIf
  
EndProcedure
  



;--------  Creation d'un polygone exemple

AddElement(polygon())
polygon()\h = 0
polygon()\v = 0

AddElement(polygon())
polygon()\h = 0
polygon()\v = 5

AddElement(polygon())
polygon()\h = 5
polygon()\v = 5

AddElement(polygon())
polygon()\h = 5
polygon()\v = 0

AddElement(polygon())
polygon()\h = 0
polygon()\v = 0



;--- def du point à tester 

pointxy\h = 5 ; x
pointxy\v = 5 ; y

Debug InsidePolygon()
J'utilise ce code avec une base mysql qui contient mes contours avec "bounds" ( rectangle xmin,ymin,xmax,ymax)
environ 10.000 contours (de 50 à plus 500 sommets )
les temps de reponces sont vraiment excellent !
Dans un proche avenir Mysql integrera cette fonctionalité dans les modules SIG.
Fuseau horaire sur UTC+01:00
Page 3 sur 3

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru