Discussion :

[rvzip64]

salut tout le monde,

Suite a cette discussion http://www.developpez.net/forums/d47...etection-pics/

Je cherche à trouver un code identique pour faire une détection de pics.

Quelqu'un aurait il une piste ?

Merci d'avance

[Linkin]

Pour une détection de pic, le plus simple est de comparer le signe de la différence f(x)-f(x+1) et de le comparer avec celui de la différence précédente. S'il y a changement de signe, on a atteint un pic (montant ou descendant). Pour filtrer, il faut juste vérifier que le signe précédent soit positif et que celui de la différence soit négatif (il faut bien sûr gérer les bornes de l'interval).

[Archimède]

j'ai fait un petit essai pour voir avec un graphique simple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
 
type TRPoint=record
  x,y:extended;
end;
 
type TRCourbe=array of TRpoint;
type TCourbe=array of Tpoint;
 
type
  TmainForm = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Déclarations privées }
    dim,gradx,grady:integer;
    O:Tpoint;
    Rcourbe,mespics:TRCourbe;
    function pt(x,y:extended):TRpoint;
    function Xe(x:extended):integer;
    function Ye(y:extended):integer;
    function transfert(RCourbe:TRcourbe):TCourbe;
  public
    { Déclarations publiques }
  end;
 
var
  mainForm: TmainForm;
 
implementation
 
{$R *.dfm}
 
procedure TmainForm.FormCreate(Sender: TObject);
var i:integer;
begin
 setlength(Rcourbe,160);
 for i:=0 to 159 do Rcourbe[i]:=pt(i/5,5*sin(i/5)); //fonction quelconque ou tableau de points à définir
  for i :=low(RCourbe)+1 to high(RCourbe)-1 do
  if  (RCourbe[i+1].y-RCourbe[i].y<0) and  (RCourbe[i].y-RCourbe[i-1].y>0) then
  begin
   inc(dim);
   setlength(mespics,dim);
   mespics[dim-1]:=RCourbe[i];
  end;
end;
 
procedure TmainForm.FormResize(Sender: TObject);
begin
 gradx:=paintbox1.ClientWidth div 20;
 grady:=paintbox1.ClientWidth div 20;;
 o:=point(paintbox1.ClientWidth div 20,paintbox1.ClientHeight div 2);
end;
 
procedure TmainForm.PaintBox1Paint(Sender: TObject);
var i:integer;
begin
 with Paintbox1.canvas do
 begin
  pen.Width:=3;
 
  moveto(0,clientheight div 2);
  lineto(clientwidth,clientheight div 2);
  moveto(clientwidth div 20,0);
  lineto(clientwidth div 20,clientheight);
  //axes arbitraires
  pen.Width:=1;
  polyline(Transfert(RCourbe));
  //tracé courbe
  brush.Style:=bsclear;
  for i:=low(mespics)to high(mespics) do  textout(transfert(mespics)[i].x,transfert(mespics)[i].y,'pic n° '+inttostr(i+1));
  //pics signalés par des textouts
 end;
end;
 
function TMainForm.pt(x: Extended; y: Extended):TRpoint;
begin
 result.x:=x;
 result.y:=y;
end;
 
 
Function TMainForm.Xe(x:extended):integer;
begin
 result:=Round(o.X+x*gradx);
end;
 
Function TMainForm.Ye(y:extended):integer;
begin
 result:=Round(o.Y-y*grady);
end;
 
 
function TMainForm.transfert(RCourbe:TRcourbe):TCourbe;
var i:integer;
begin
  setlength(Result,length(RCourbe));
  for i:=low(result)  to High(result) do
  begin
    result[i].x:=Xe(RCourbe[i].x);
    result[i].y:=Ye(RCourbe[i].y);
  end;
end;
 
end.

ça marche... à adapter pour détecter les minimums.

la courbe peut être un tableau de points quelconque en coord mathématiques

[rvzip64]

J'utilise le même style de code, avec des adaptations à cause de mon algo.

Merci à tous pour votre aide