Algo

Programmation d'applications complexes
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message 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 :-?
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Message par Frenchy Pilou »

@Dri
Pas si simple!
J'ai rempli de quelques points en continu et voilà le résultat :)


Image
Est beau ce qui plaît sans concept :)
Speedy Galerie
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message 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 ;)
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Message par Frenchy Pilou »

mais pas aussi complexes...
9 points ! :D
Est beau ce qui plaît sans concept :)
Speedy Galerie
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

Frenchy Pilou a écrit :
mais pas aussi complexes...
9 points ! :D
Et combien de zones se croisent ?

Dri :jesors:
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Message 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:
Est beau ce qui plaît sans concept :)
Speedy Galerie
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message 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 ;)
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Message 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 :)
Est beau ce qui plaît sans concept :)
Speedy Galerie
Yves Rouquier
Messages : 40
Inscription : mar. 23/mars/2004 10:23

Message 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
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message 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 ^^
Yves Rouquier
Messages : 40
Inscription : mar. 23/mars/2004 10:23

Message 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.
Répondre