$$$$ ANALYSER
* ANALYSER  PROCEDUR  PICA      92/07/03    21:15:25     619            
*----------------------------------------------------------------------*
* PROCEDURE ANALYSER                                                   *
*                                                                      *
* CALCUL DE LA DECOMPOSITION D'UN SIGNAL QUELCONQUE EN                 *
* ONDELETTE ORTHOGONALE                                                *
*                                                                      *
* M DECO RESI=ANALYSER ACC (OPTIO);                                    *
*----------------------------------------------------------------------*
* ENTREE                                                               *
*                                                                      *
* ACC   : OBJET DE TYPE EVOLUTION CONTENANT LE SIGNAL                  *
*                                                                      *
* OPTIO : OBJET DE TYPE TABLE CONTENANT LES OPTION                     *
*----------------------------------------------------------------------*
* OPTIONS                                                              *
*                                                                      *
* OPTIO.'PUIS'= ENTIER, 2**PUISS+1=NB DE POINT D'ANALYSE,              *
*               DEFAUT ENGLOBANT TOUT LE SIGNAL COMPLETE PAR DES 0     *
*                                                                      *
* OPTIO.'LDEC'= ENTIER, NOMBRE DE NIVEAU DE DECOMPOSITION SOUHAITE,    *
*               DEFAUT PERMETTANT LE CALCUL MAXIMUM                    *
*                                                                      *
* OPTIO.'BORD'= TEXTE, TRAITEMENT DES CONDITION DE BORD POUR LA        *
*               CORRELATION: SYME(trique) OU PADD(ing) de ZERO         *
*               DEFAUT SYME                                            *
*                                                                      *
* OPTIO.'TYPE'= TEXTE, TYPE D'ONDELETTE: MALL(at) OU DAUB(echie)       *
*               DEFAUT MALL                                            *
*----------------------------------------------------------------------*
* SORTIE                                                               *
*                                                                      *
* M     : ENTIER, NOMBRE DE NIVEAU ATTEINT                             *
*                                                                      *
* DECO  : OBJET DE TYPE EVOLUTION CONTENANT LA DECOMPOSITION EN M      *
*         NIVEAUX, DES BASES VERS LES HAUTES FREQUENCES                *
*                                                                      *
* RESI  : OBJET DE TYPE EVOLUTION CONTENANT LE RESIDU AU NIVEAU M      *
*----------------------------------------------------------------------*
'DEBPROC' ANALYSER ACC*'EVOLUTION' OPTIO/'TABLE';
*----------------------------------------------------------------------*
'SI' ('NON' ('EXISTE' OPTIO));
  LOPTION=FAUX;
'SINON';
  LOPTION=VRAI;
'FINSI';
PUIS=0; LDEC=100; BORD='TEXT' SYME; TYPE= 'TEXT' MALL;
'SI' LOPTION;
  'SI' ('EXISTE' OPTIO 'PUIS'); PUIS=OPTIO.'PUIS'; 'FINSI';
  'SI' ('EXISTE' OPTIO 'LDEC'); LDEC=OPTIO.'LDEC'; 'FINSI';
  'SI' ('EXISTE' OPTIO 'BORD'); BORD='TEXT' OPTIO.'BORD';
                                                     'FINSI';
  'SI' ('EXISTE' OPTIO 'TYPE'); TYPE='TEXT' OPTIO.'TYPE';
                                                     'FINSI';
'FINSI';
*
* Test sur le signal
*
LOK=VRAI;
YY='COPIER' ('EXTR' ACC 'ORDO' 1);
XX='COPIER' ('EXTR' ACC 'ABSC' 1);
NPT='DIME' YY;
XXH='ENLE' XX 1;
XXB='ENLE' XX NPT;
XXDX=XXH-XXB; 
DXSUP='MAXI' XXDX; DXINF='MINI' XXDX;
PAS=('EXTR' 2 XX) - ('EXTR' 1 XX);
'SI' ( (DXSUP - DXINF)/PAS '>' 1.E-5);
  'MESSAGE' 'ANALYSER: le pas de temps du signal n est pas constant';
  LOK=FAUX;
'FINSI';
'SI' LOK;
*
* Filtre en h (MALLAT -erreur signe)
*
  'SI' ('EGA' TYPE ('TEXT' MALL));
    HH='PROG' .542 .307 -.035 -.078 .023 .030 -.012 -.013 
              .006 .006 -.003 -.002;
*
* Calcul des filtres conjugues et en quadrature
*
    HTILDE=HH;
    MMHTILDE= -1;
    HDIM='DIMENSION' HH;
    GG='PROG'; I=HDIM; II=1;
    UU=(-1)**HDIM;
    'REPETER' LABMALL HDIM;
      G='EXTRAIRE' HH I;
      GG='INSERER' GG II (UU*G);
      'SI' (I 'NEG' 1);GG='INSERER' GG II (UU*G); 'FINSI';
      I=I-1; II=II+1; UU=UU*(-1);
    'FIN' LABMALL;
    MMG=HDIM-2;
    GDIM='DIME' GG;
    GTILDE=GG;
    MMGTILDE=GDIM-(MMG+1);
*
  'SINON';
*
* Filtre en h (Daubechie + correction norme)
*
    'SI' ('EGA' TYPE ('TEXT' DAUB));
       HH='PROG' 0.077852054085  0.396539319482  0.729132090846
                 0.469782287405 -0.143906003929 -0.224036184994
                 0.071309219267  0.080612609151 -0.038029936935
                -0.016574541631  0.012550998556  0.000429577973
                -0.001801640704  0.000353713800;
       HH=HH /  (2**.5);
*
* Calcul des filtres conjugues et en quadrature
*
       HDIM='DIME' HH;
       GTILDE='PROG'; HTILDE='PROG'; I=HDIM; II=1;
       UU=-1;
       'REPETER' LABDAUB HDIM;
         H='EXTRAIRE' HH I;
         HTILDE = 'INSERER' HTILDE II H;
         GTILDE = 'INSERER' GTILDE II UU;
          I=I-1; II=II+1; UU=UU*(-1);
       'FIN' LABDAUB;
       MMHTILDE=HDIM-1;
       GTILDE=GTILDE*HH; MMGTILDE=1;
*
    'SINON';
      'MESS' 'ANALYSER: le type' TYPE 'd analyse n existe pas';
      LOK=FAUX;
    'FINSI';
  'FINSI';
'FINSI';
*
* modification du signal original : ajout de 0 avant et apres
* seule la procedure "automatique" respecte au mieu la decomposition en
* ondelette
*
'SI' LOK;
  'SI' (PUIS 'EGA' 0);
     PUIS='ENTIER' ((('LOG' (NPT-1))/('LOG' 2))*0.9999); PUIS=PUIS+1;
  'FINSI';
  NPS=(2**PUIS) + 1;
  NPA=NPS-NPT;
  'SI' (NPA '>' 0);
*
    XDEP='EXTR' XX 1;
    IDEP='ENTIER' ((XDEP/PAS)*1.001);
    IPAM=NPA-IDEP+1;
    'SI' (IPAM '>' 1);
      PUIZ='ENTIER' ((('LOG' (IPAM-1))/('LOG' 2))*0.9999);
      IPAM=2**PUIZ+1;
      NPA=IPAM+IDEP-1;
    'SINON';
      NPA=NPA/2;
    'FINSI';
*
    'MESSAGE' 'ANALYSER: ajout de' NPA 'points nul en tete de signal';
*
    XDEP='EXTR' XX 1;
    XDEP=XDEP-(NPA*PAS);
    XXA=PROG XDEP 'PAS' PAS 'NPAS' (NPA-1);
    XXX=XX;XX=XXA 'ET' XX;
    YYA=PROG NPA*0.;
    YYY=YY;YY=YYA 'ET' YY;
    NPA=(NPS-NPT) - NPA;
*
    'SI' (NPA '>' 0);
      'MESSAGE' 
      'ANALYSER: ajout de' NPA 'points nul en queue de signal';
*
      XDEP=('EXTR' XX (NPS-NPA))+PAS;
      XXA=PROG XDEP 'PAS' PAS 'NPAS' (NPA-1);
      XXX=XX;XX=XX 'ET' XXA ;
      YYA=PROG NPA*0.;
      YYY=YY;YY=YY 'ET' YYA;
    'FINSI';
  'SINON'; 
    'SI' (NPA '<' 0);
      'MESSAGE' 'ANALYSER: analyse limitee a' NPS 'points';
      'MESSAGE' '          implementation non correcte';
    'FINSI';
  'FINSI';
  SIGNAL='EVOL' 'MANU' XX YY;
*
* Decomposition
*
  M DECO RESI=MULTIDEC SIGNAL HTILDE MMHTILDE 
                              GTILDE MMGTILDE BORD LDEC;
  'MESS' 'ANALYSER: nb de niveau d analyse:' M;
*
'FINSI';
*
'FINPROC' M DECO RESI;