Accueil | Cast3M

* fichier : ajuste2.dgibi
************************************************************************
************************************************************************
 
 
GRAPH=faux ;
*  EXEMPLE :
*
*   On cherche a interpoler un nuage de points avec la fonction
*   suivante:
*   the given sets of points ( x , f(x)) must be adjusted with
*   a function as follows :
*
*       f(x) =( A * (x**B ))+ (C * sin(D*x + B)) + (E * x)
*
*   les deux parametres p1 et p2 non linéaires sont B et D.
*   The two non linear parameters p1 and p2 are B and D.
*
*   les autres A,C,E  sont linéaires. On peut donc mettre la
*   fonction sous la forme :
*   A,C,E are linear parameters. It is possible to write the function
*   in the following way :
*
*      f(x)= A*f1(x) +C*f2(x)+E*f3(x)
*
*  PROCEDURE :  FCT
*
   DEBPROC FCT  xtab*'TABLE'  p*'LISTREEL' ;
       tab1       = 'TABLE'; 
       tab1 . 'F' = 'TABLE'; 
       x    = xtab . 1;
       n    = 'DIME' x;
*      fonction f1
       tab1 . 'F' . 1 = x**('EXTR' p 1);
*      fonction f2
       aa   = ((('EXTR' p 2)*x) + ('PROG' n*('EXTR' p 1)))*180. / PI;
       tab1 . 'F' . 2 = 'SIN' aa ;
*      fonction f3
       tab1 . 'F' . 3 = x;
*      useless to give fonction g
*       tab1 . 'G' = 'PROG' N*0;
   FINPROC tab1;
 
*  PROCEDURE :  DERI
*
   DEBPROC DERI xtab*'TABLE' p*'LISTREEL';
 
       tab           = 'TABLE' ;
       tab . 'F'     = 'TABLE' ;
       tab . 'F' . 1 = 'TABLE' ; 
       tab . 'F' . 2 = 'TABLE' ;
       x    = xtab . 1; 
       N    = DIME x;
*      fonction df1/dp1
       tab . 'F' . 1 . 1 = ('LOG' x)*(x**('EXTR' p 1));
*      fonction df2/dp1
       aa = ((('EXTR' p 2)*x) + ('PROG' n*('EXTR' p 1)))*180. / PI;
       tab . 'F' . 1 . 2 = 'COS' aa ;
*      fonction df3/dp1
       tab . 'F' . 1 . 3 = 'PROG' N*0;
 
*      fonction df1/dp2
       tab . 'F' . 2 . 1 = 'PROG' N*0;
*      fonction df2/dp2
       tab . 'F' . 2 . 2 = x * ('COS' aa);
*      fonction df3/dp2
       tab . 'F' . 2 . 3 = 'PROG' N*0;
 
*      useless to give dg/dpj
*       tab . 'G'     = 'TABLE' ;
*       tab . 'G' . 1 = 'PROG' N*0;
*       tab . 'G' . 2 = 'PROG' N*0;
 
   FINPROC tab;
 
*  Programme principal
*
*  définition de la fonction pour le calcul des couples x,F(x)
   x   = prog  0.01 pas 0.01 1.;
 
*  posons A = 1 ; B=0.5 ; C=1; D=1; E=3.14159...(pi)
   af1 = x ** 0.5;
   aa  = (X + ('PROG' 100*0.5))* 180./PI;
   cf2 = 'SIN' aa;
   ef3 = pi * x;
   y   = af1 + cf2 + ef3;
 
   k=2; 
   l=3; 
   xtab = 'TABLE'; 
   xtab . 1 = x;
   tab1=table;
   tab1.'X' = xtab;
   tab1.'F' = y;
   tab1.'K' = k;
   tab1.'L' = l;
   tab1.'PMIN'  = 'PROG' K*0;
   tab1.'PMAX'  = 'PROG' K*10;
   tab1.'POIDS' = 'PROG' 0.75 'PAS' 0.01 1.74;
 
   q p = AJUSTE tab1;
 
*  recalcul de F(x) pour comparaison avec courbe initiale
*  computation of f(x) for comparison with initial curve
   n   = DIME x;
   B   = 'EXTR' p 1;
   D   = 'EXTR' p 2;
   A   = 'EXTR' q 1;
   C   = 'EXTR' q 2;
   E   = 'EXTR' q 3;
   f1  =  A * (x **B);
   aa  = ((D*x) + ('PROG' N*B)) * 180. / PI;
   f2  = C * ('SIN' aa);
   f3  = E * x;
   y1  = f1 + f2 + f3;
 
*  Tracé   
   ev  = 'EVOL' 'ROUGE' 'MANU' 'X' x 'Y'  y ;
   ev1 = 'EVOL' 'BLEU'  'MANU' 'X' x 'Y1' y1;
   evt = ev 'ET' ev1;
   'SI' (GRAPH) ;
     'DESSIN' evt;
   'FINSI' ;
 
*  Test d'efficacité
   err = 'SOMM' ('ABS' (y1 - y)) ;
   'SI' (err > 1.d-5) ;
      'ERREUR' 5 ;
   'SINON' ;
      'ERREUR' 0 ;
   'FINSI' ;
 
'FIN' ;