_______________________________________________________________________________________________________________________________________
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        C A L C U L   D E   L A   F O N C T I O N   F A C T O R I E L L E  :                                                       */
/*                                                                                                                                   */
/*                                                                                                                                   */
/*        Author of '$ximf/produits$FON' :                                                                                           */
/*                                                                                                                                   */
/*                    Jean-Francois COLONNA (LACTAMME, 19870000000000).                                                              */
/*                                                                                                                                   */
/*************************************************************************************************************************************/

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        F A C T O R I E L L E   R E C U R S I V E  :                                                                               */
/*                                                                                                                                   */
/*************************************************************************************************************************************/

BFonctionI

#define   FACTORIELLE_DE_0                                                                                                              \
                    UN                                                                                                                  \
                                        /* Definition a priori de 0! puisqu'on ne peut deduire cette valeur du calcul...             */
#define   CODE_DE_LA_FACTORIELLE_D_UN_NOMBRE_NEGATIF                                                                                    \
                    FACTORIELLE_DE_0                                                                                                    \
                                        /* Pour faire la difference avec 'FACTORIELLE_DE_0', il serait preferable de renvoyer        */ \
                                        /* qulque chose de different ('ZERO' par exemple). Malheureusement, comme la valeur          */ \
                                        /* envoyee par 'factorielle_recursive(...)' est souvent utilisee au denominateur d'une       */ \
                                        /* fraction, il faut eviter les divisions par zero...                                        */

DEFV(Common,DEFV(FonctionI,factorielle_recursive(n)))
                                        /* ATTENTION : on notera bien que la procedure 'FACT(...)' est de type 'Float', alors que    */
                                        /* la fonction 'factorielle_recursive(...)' est de type 'Int'...                             */
DEFV(Argument,DEFV(Int,n));
                                        /* Nombre entier dont on cherche la factorielle.                                             */
                                        /*                                                                                           */
                                        /* ATTENTION, la "portee" de cette fonction est limitee puisqu'elle travaille en entier,     */
                                        /* c'est pourquoi :                                                                          */
                                        /*                                                                                           */
                                        /*                  12!= 479001600   est bon,                                                */
                                        /*                  13!=1932053504   est faux...                                             */
                                        /*                                                                                           */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
     Bblock
     DEFV(Int,INIT(valeur_de_la_factorielle,FACTORIELLE_DE_0));
                                        /* Valeur courante de la factorielle initialisee sur 0!...                                   */
     /*..............................................................................................................................*/
     Test(IZEQ(n))
          Bblock
          EGAL(valeur_de_la_factorielle,FACTORIELLE_DE_0);
          Eblock
     ATes
          Bblock
          Test(IZGT(n))
               Bblock
               Test(IFGE(n,ENTIER_DE_DEBORDEMENT_DE_FACT_Int))
                                        /* Le 20180404135103, 'IFEQ(...)' a ete remplace par 'IFGE(...)' plus logique...             */
                    Bblock
                    PRINT_ERREUR("l'argument de la fonction factorielle est trop grand pour faire le calcul en 'Int'");
                    CAL1(Prer2("(il vaut %d, alors que la valeur maximale est %d, ",n,ENTIER_DE_DEBORDEMENT_DE_FACT_Int));
                    CAL1(Prer1("la valeur %d est donc renvoyee pour la factorielle)\n",valeur_de_la_factorielle));
                                        /* On notera que l'on ecrit :                                                                */
                                        /*                                                                                           */
                                        /*                  Test(IFEQ(n,ENTIER_DE_DEBORDEMENT_DE_FACT_Int))                          */
                                        /*                                                                                           */
                                        /* et non pas :                                                                              */
                                        /*                                                                                           */
                                        /*                  Test(IFGE(n,ENTIER_DE_DEBORDEMENT_DE_FACT_Int))                          */
                                        /*                                                                                           */
                                        /* car la methode etant recursive, on est sur de passer par cette valeur si 'n' est plus     */
                                        /* grand qu'elle ; on limite ainsi le nombre de messages d'erreur...                         */
                    Eblock
               ATes
                    Bblock
                    EGAL(valeur_de_la_factorielle,MUL2(n,factorielle_recursive(PRED(n))));
                                        /* Calcul recursif de la fonction factorielle. ATTENTION, on ne peut bien entendu ecrire :   */
                                        /*                                                                                           */
                                        /*                  ...FACT(PRED(n))...                                                      */
                                        /*                                                                                           */
                                        /* puisque la definition de 'FACT(...)' peut designer 'factorielle_recursive' comme elle     */
                                        /* peut designer 'factorielle_non_recursive'...                                              */
                    Eblock
               ETes
               Eblock
          ATes
               Bblock
               PRINT_ERREUR("l'argument de la fonction factorielle est negatif");
               EGAL(valeur_de_la_factorielle,CODE_DE_LA_FACTORIELLE_D_UN_NOMBRE_NEGATIF);
                                        /* En cas d'erreur, on renvoie une valeur sans danger...                                     */
               Eblock
          ETes
          Eblock
     ETes

     RETU(valeur_de_la_factorielle);
     Eblock

EFonctionI

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        F A C T O R I E L L E   " S I M P L E "   ( S A N S   V A L I D A T I O N )  :                                             */
/*                                                                                                                                   */
/*************************************************************************************************************************************/

BFonctionF

DEFV(Common,DEFV(FonctionF,factorielle_non_recursive_sans_validation(n)))
                                        /* ATTENTION : la fonction 'factorielle_non_recursive_sans_validation(...)' est de type      */
                                        /* 'Float', alors que la fonction 'factorielle_recursive(...)' est de type 'Int'...          */
DEFV(Argument,DEFV(Int,n));
                                        /* Nombre entier dont on cherche la factorielle.                                             */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
     Bblock
     DEFV(Float,INIT(valeur_de_la_factorielle,FLOT(FACTORIELLE_DE_0)));
                                        /* Valeur courante de la factorielle initialisee sur 0!...                                   */
     /*..............................................................................................................................*/
     Test(IZLT(n))
          Bblock
          PRINT_ERREUR("l'argument de la fonction factorielle est negatif");
          EGAL(valeur_de_la_factorielle,CODE_DE_LA_FACTORIELLE_D_UN_NOMBRE_NEGATIF);
                                        /* En cas d'erreur, on renvoie une valeur sans danger...                                     */
          Eblock
     ATes
          Bblock
          Test(IZGT(n))
               Bblock
               Komp(indice_courant,n)
                    Bblock
                    EGAL(valeur_de_la_factorielle,MUL2(FLOT(indice_courant),valeur_de_la_factorielle));
                                        /* Calcul iteratif de la fonction factorielle...                                             */
                    Eblock
               EKom
               Eblock
          ATes
               Bblock
               Eblock
          ETes
          Eblock
     ETes

     RETU(valeur_de_la_factorielle);
     Eblock

EFonctionF

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        F A C T O R I E L L E   N O N   R E C U R S I V E  :                                                                       */
/*                                                                                                                                   */
/*************************************************************************************************************************************/

BFonctionF

DEFV(Common,DEFV(FonctionF,factorielle_non_recursive(n)))
                                        /* ATTENTION : on notera bien que la fonction 'factorielle_non_recursive(...)' est de type   */
                                        /* 'Float', alors que la fonction 'factorielle_recursive(...)' est de type 'Int'...          */
DEFV(Argument,DEFV(Int,n));
                                        /* Nombre entier dont on cherche la factorielle.                                             */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
     Bblock
     DEFV(Float,INIT(valeur_de_la_factorielle,FLOT(FACTORIELLE_DE_0)));
                                        /* Valeur courante de la factorielle initialisee sur 0!...                                   */
                                        /*                                                                                           */
                                        /* ATTENTION, la precision de cette fonction est limitee puisqu'elle travaille en flottant,  */
                                        /* et non pas en precision entiere infinie. Donc au-dela d'un certain entier, le resultat    */
                                        /* sera approxime ; c'est pourquoi :                                                         */
                                        /*                                                                                           */
                                        /*                  21!=  51090942171709440000 est bon,                                      */
                                        /*                  22!=1124000727777607700000 est approxime...                              */
                                        /*                                                                                           */
     /*..............................................................................................................................*/
     Test(IFGE(n,ENTIER_DE_DEBORDEMENT_DE_FACT_Float))
          Bblock
          PRINT_ERREUR("l'argument de la fonction factorielle est trop grand pour faire le calcul en 'Float'");
          CAL1(Prer2("(il vaut %d, alors que la valeur maximale est %d ,",n,PRED(ENTIER_DE_DEBORDEMENT_DE_FACT_Float)));
                                        /* Le 'PRED(...)' manquant a ete introduit (bien tardivement) le 20170515110404...           */
          CAL1(Prer1("la valeur %f est donc renvoyee pour la factorielle)\n",valeur_de_la_factorielle));
          Eblock
     ATes
          Bblock
          EGAL(valeur_de_la_factorielle,factorielle_non_recursive_sans_validation(n));
                                        /* Calcul iteratif de la fonction factorielle sans validation...                             */
          Eblock
     ETes

     RETU(valeur_de_la_factorielle);
     Eblock

EFonctionF

#undef    CODE_DE_LA_FACTORIELLE_D_UN_NOMBRE_NEGATIF
#undef    FACTORIELLE_DE_0

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        C A L C U L   D ' U N   N O M B R E   D E   B E R N O U L L I  :                                                           */
/*                                                                                                                                   */
/*************************************************************************************************************************************/

BFonctionF

DEFV(Common,DEFV(Float,SINT(calcul_des_nombres_de_Bernoulli_____precision,PARE(1.0e-14))));
                                        /* Precision demandee pour calculer les nombre de Bernoulli. On notera que cette precision   */
                                        /* influe grandement sur la qualite du calcul de la fonction 'zeta' pour les valeurs tres    */
                                        /* negatives ; c'est par exemple le cas avec 'v $xtKg/zeta.11$K -8.0'.                       */

#define   PREMIER_INDICE_k_POUR_Bernoulli_B2k                                                                                           \
                    UN
#define   DERNIER_INDICE_k_POUR_Bernoulli_B2k                                                                                           \
                    EXP2(DIX)
                                        /* Definition de l'optimiseur des acces a 'calcul_du_nombre_de_Bernoulli_B2k(...)'.          */
                                        /*                                                                                           */
                                        /* La borne "maximale" est passee de 'CENT' a 'EXP6(DIX)' le 20240625075216 lors du calcul   */
                                        /* de 'v $xiirc/$Fnota Debut_listG_ZETA_21_IdM' avec le format d'image 'TvB'...              */
                                        /*                                                                                           */
                                        /* En fait le 20240626113215, je reviens a 'EXP2(DIX)' suite au gros probleme que j'ai eu    */
                                        /* a cette date ('v $ximcf/operator$FON 20240626111544') et qui s'est vu lors de la mise     */
                                        /* au point de l'image 'v $xiirc/ZETA.21$m.IdM'...                                           */
DEFV(Local,DEFV(Logical,INIT(l_optimiseur_de_calcul_de_nombre_de_Bernoulli_B2k_est_initialise,FAUX)));
                                        /* Pour savoir si l'optimiseur de 'calcul_du_nombre_de_Bernoulli_B2k(...)' est initialise.   */
DEFV(Local,DEFV(Logical,DTb1(le_nombre_de_Bernoulli_B2k_est_deja_connu
                            ,NBRE(PREMIER_INDICE_k_POUR_Bernoulli_B2k,DERNIER_INDICE_k_POUR_Bernoulli_B2k)
                             )
                )
     );
DEFV(Local,DEFV(Float,DTb1(optimiseur_de_calcul_de_nombre_de_Bernoulli_B2k
                          ,NBRE(PREMIER_INDICE_k_POUR_Bernoulli_B2k,DERNIER_INDICE_k_POUR_Bernoulli_B2k)
                           )
                )
     );
                                        /* L'optimiseur est compose pour chaque nombre 'B(2k)' d'un indicateur de validite qui est   */
                                        /* 'FAUX" initialement, puis 'VRAI' des que sa valeur a ete calcule une premiere fois...     */

DEFV(Common,DEFV(FonctionF,calcul_du_nombre_de_Bernoulli_B2k(k)))
DEFV(Argument,DEFV(Int,k));
/*-----------------------------------------------------------------------------------------------------------------------------------*/
     Bblock
     DEFV(Float,INIT(Bernoulli_2k,FLOT__UNDEF));
                                        /* Valeur du nombre de Bernoulli 'B(2k)'. Cette valeur initiale est renvoyee lorsque 'k'     */
                                        /* est negatif...                                                                            */
     /*..............................................................................................................................*/
     Test(NINCff(k,PREMIER_INDICE_k_POUR_Bernoulli_B2k,DERNIER_INDICE_k_POUR_Bernoulli_B2k))
                                        /* Test introduit le 20240625075216...                                                       */
          Bblock
          PRINT_ERREUR("L'optimiseur du calcul des nombres de Bernoulli est mal dimensionne.");
          CAL1(Prer3("(l'indice 'k' vaut %d, alors que ses bornes sont [%d,%d])\n"
                    ,k
                    ,PREMIER_INDICE_k_POUR_Bernoulli_B2k,DERNIER_INDICE_k_POUR_Bernoulli_B2k
                     )
               );
          Eblock
     ATes
          Bblock
          Eblock
     ETes

     Test(EST_FAUX(l_optimiseur_de_calcul_de_nombre_de_Bernoulli_B2k_est_initialise))
          Bblock
          DEFV(Int,INIT(index_de_optimiseur_de_calcul_de_nombre_de_Bernoulli_B2k,UNDEF));
                                        /* Index d'initialisation de l'optimiseur de 'calcul_du_nombre_de_Bernoulli_B2k(...)'.       */

          DoIn(index_de_optimiseur_de_calcul_de_nombre_de_Bernoulli_B2k
              ,PREMIER_INDICE_k_POUR_Bernoulli_B2k
              ,DERNIER_INDICE_k_POUR_Bernoulli_B2k
              ,I
               )
               Bblock
               EGAL(ITb1(optimiseur_de_calcul_de_nombre_de_Bernoulli_B2k
                        ,INDX(index_de_optimiseur_de_calcul_de_nombre_de_Bernoulli_B2k,PREMIER_INDICE_k_POUR_Bernoulli_B2k)
                         )
                   ,FLOT__UNDEF
                    );
                                        /* On donne une valeur indefinie...                                                          */
               EGAL(ITb1(le_nombre_de_Bernoulli_B2k_est_deja_connu
                        ,INDX(index_de_optimiseur_de_calcul_de_nombre_de_Bernoulli_B2k,PREMIER_INDICE_k_POUR_Bernoulli_B2k)
                         )
                   ,FAUX
                    );
                                        /* Et on memorise que ce nombre n'est pas connu...                                           */
               Eblock
          EDoI

          EGAL(l_optimiseur_de_calcul_de_nombre_de_Bernoulli_B2k_est_initialise,VRAI);
                                        /* L'optimiseur est disponible...                                                            */
          Eblock
     ATes
          Bblock
          Eblock
     ETes

     Test(IZGE(k))
          Bblock
          DEFV(Logical,INIT(on_peut_utiliser_l_optimiseur_calcul_du_nombre_de_Bernoulli_B2k,FAUX));
                                        /* A priori, l'optimiseur n'est pas disponible...                                            */

          Test(IFINff(k,PREMIER_INDICE_k_POUR_Bernoulli_B2k,DERNIER_INDICE_k_POUR_Bernoulli_B2k))
               Bblock
               Test(EST_VRAI(ITb1(le_nombre_de_Bernoulli_B2k_est_deja_connu,INDX(k,PREMIER_INDICE_k_POUR_Bernoulli_B2k))))
                    Bblock
                    EGAL(on_peut_utiliser_l_optimiseur_calcul_du_nombre_de_Bernoulli_B2k,VRAI);
                                        /* Lorsque 'k' est dans les limites autorisees, et que 'B(2k)' est connu, rien a faire...    */
                    Eblock
               ATes
                    Bblock
                    Eblock
               ETes
               Eblock
          ATes
               Bblock
               Eblock
          ETes

          Test(EST_FAUX(on_peut_utiliser_l_optimiseur_calcul_du_nombre_de_Bernoulli_B2k))
                                        /* Cas ou 'B(2k)' n'est pas encore connu :                                                   */
               Bblock
               Test(IZEQ(k))
                    Bblock
                    EGAL(Bernoulli_2k,FU);
                                        /* Lorsque 'k' est nul, la valeur est 1.                                                     */
                    Eblock
               ATes
                    Bblock
                    DEFV(Int,INIT(indice_d_evaluation_de_Bernoulli_2k,UN));
                                        /* Indice de la serie de calcul du nombre 'B(2k)'.                                           */
                    DEFV(Logical,INIT(continuer_l_approximation_de_Bernoulli_2k,VRAI));
                                        /* Indicateur de convergence...                                                              */
                    DEFV(Float,INIT(plus_ou_moins_un,NEUT(FU)));
                                        /* Afin d'alterner les termes de la serie...                                                 */

                    EGAL(Bernoulli_2k,FZERO);
                                        /* Initialisation du calcul iteratif de la serie...                                          */

                    Tant(IL_FAUT(continuer_l_approximation_de_Bernoulli_2k))
                         Bblock
                         DEFV(Float,INIT(terme_courant_de_Bernoulli_2k,INVE(PUIX(indice_d_evaluation_de_Bernoulli_2k,DOUB(k)))));
                         INCR(Bernoulli_2k,MUL2(plus_ou_moins_un,terme_courant_de_Bernoulli_2k));
                                        /* Calcul iteratif de 'B(2k)'.                                                               */

                         Test(IFLE(terme_courant_de_Bernoulli_2k,calcul_des_nombres_de_Bernoulli_____precision))
                                        /* On considere que l'erreur commise est de l'ordre du terme courant...                      */
                              Bblock
                              EGAL(continuer_l_approximation_de_Bernoulli_2k,FAUX);
                                        /* Des que la precision est atteinte, on arrete d'iterer...                                  */
                              Eblock
                         ATes
                              Bblock
                              INCR(indice_d_evaluation_de_Bernoulli_2k,I);
                                        /* Tant que la precision n'est pas atteinte, on itere...                                     */
                              EGAL(plus_ou_moins_un,NEGA(plus_ou_moins_un));
                                        /* Et on alterne le facteur multiplicateur...                                                */
                              Eblock
                         ETes
                         Eblock
                    ETan

                    EGAL(Bernoulli_2k
                        ,DIVI(Bernoulli_2k
                             ,DIVI(MUL2(PUIX(PI,FLOT(DOUB(k)))
                                       ,SOUS(PUIX(DEUX,SOUS(DOUB(k),UN)),UN)
                                        )
                                  ,factorielle_non_recursive_sans_validation(DOUB(k))
                                   )
                              )
                         );
                                        /* Calcul de 'B(2k) d'apres la formule numero 19 figurant a la page 443 de l'Aide-Memoire    */
                                        /* de Mathematiques :                                                                        */
                                        /*                                                                                           */
                                        /*                 n=+infini                                                                 */
                                        /*                  _______                                                                  */
                                        /*                  \                 2k 2k-1                                                */
                                        /*                   \        1      p  2                                                    */
                                        /*                   /      ----- = ----------B                                              */
                                        /*                  /______   2k       (2k)!   2k                                            */
                                        /*                           n                                                               */
                                        /*                    n=1                                                                    */
                                        /*                                                                                           */
                                        /* ou 'p' desgine 'pi' et au signe pres qui va etre ajoute ci-apres...                       */
                                        /*                                                                                           */
                                        /* En fait, cette serie converge mal et de facon assez incontrolable. Le 19990617155033,     */
                                        /* j'en suis donc venu a utiliser la serie alternee donnee par la formule numero 20 :        */
                                        /*                                                                                           */
                                        /*                 n=+infini                                                                 */
                                        /*                  _______                                                                  */
                                        /*                  \                        2k  2k-1                                        */
                                        /*                   \          n-1  1      p  (2    -1)                                     */
                                        /*                   /      (-1)   ----- = --------------B                                   */
                                        /*                  /______          2k         (2k)!     2k                                 */
                                        /*                                  n                                                        */
                                        /*                    n=1                                                                    */
                                        /*                                                                                           */

                    Test(EST_IMPAIR(k))
                         Bblock
                                        /* Lorsque 'k' est impair {1,3,5,...}, on utilise '+B(2k)'.                                  */
                         Eblock
                    ATes
                         Bblock
                         EGAL(Bernoulli_2k,NEGA(Bernoulli_2k));
                                        /* Lorsque 'k' est pair {2,4,6,...}, on utilise '-B(2k)'.                                    */
                         Eblock
                    ETes

                    EGAL(ITb1(optimiseur_de_calcul_de_nombre_de_Bernoulli_B2k
                             ,INDX(k,PREMIER_INDICE_k_POUR_Bernoulli_B2k)
                              )
                        ,Bernoulli_2k
                         );
                                        /* On memorise la valeur...                                                                  */
                    EGAL(ITb1(le_nombre_de_Bernoulli_B2k_est_deja_connu
                             ,INDX(k,PREMIER_INDICE_k_POUR_Bernoulli_B2k)
                              )
                        ,VRAI
                         );
                                        /* Puis que ce nombre est enfin connu...                                                     */
                    Eblock
               ETes
               Eblock
          ATes
               Bblock
                                        /* Cas ou 'B(2k)' est deja connu :                                                           */
               EGAL(Bernoulli_2k,ITb1(optimiseur_de_calcul_de_nombre_de_Bernoulli_B2k,INDX(k,PREMIER_INDICE_k_POUR_Bernoulli_B2k)));
                                        /* Le calcul est inutile...                                                                  */
               Eblock
          ETes
          Eblock
     ATes
          Bblock
          PRINT_ERREUR("un nombre de Bernoulli de rang negatif a ete demande");
          Eblock
     ETes

     RETU(Bernoulli_2k);
     Eblock

#undef    DERNIER_INDICE_k_POUR_Bernoulli_B2k
#undef    PREMIER_INDICE_k_POUR_Bernoulli_B2k

EFonctionF

BFonctionF

DEFV(Common,DEFV(FonctionF,calcul_du_nombre_de_Bernoulli_B2k_plus_1(k)))
DEFV(Argument,DEFV(Int,k));
/*-----------------------------------------------------------------------------------------------------------------------------------*/
     Bblock
     DEFV(Float,INIT(Bernoulli_2k_plus_1,FLOT__UNDEF));
                                        /* Valeur du nombre de Bernoulli 'B(2k+1)'. Cette valeur initiale est renvoyee lorsque 'k'   */
                                        /* est negatif ou nul...                                                                     */
     /*..............................................................................................................................*/
     Test(IZGE(k))
          Bblock
          Test(IZEQ(k))
               Bblock
               EGAL(Bernoulli_2k_plus_1,NEGA(FDU));
                                        /* Pour 'k' nul, la valeur est -1/2.                                                         */
               Eblock
          ATes
               Bblock
               EGAL(Bernoulli_2k_plus_1,FZERO);
                                        /* Pour 'k' strictement positif, la valeur est 0.                                            */
               Eblock
          ETes
          Eblock
     ATes
          Bblock
          PRINT_ERREUR("un nombre de Bernoulli de rang negatif a ete demande");
          Eblock
     ETes

     RETU(Bernoulli_2k_plus_1);
     Eblock

EFonctionF

BFonctionF

DEFV(Common,DEFV(FonctionF,calcul_du_nombre_de_Bernoulli_Bk(k)))
DEFV(Argument,DEFV(Int,k));
/*-----------------------------------------------------------------------------------------------------------------------------------*/
     Bblock
     DEFV(Float,INIT(Bernoulli_k,FLOT__UNDEF));
     /*..............................................................................................................................*/
     Test(EST_IMPAIR(k))
          Bblock
          EGAL(Bernoulli_k,calcul_du_nombre_de_Bernoulli_B2k_plus_1(MOIT(k)));
                                        /* Cas ou 'k' est impair.                                                                    */
          Eblock
     ATes
          Bblock
          EGAL(Bernoulli_k,calcul_du_nombre_de_Bernoulli_B2k(MOIT(k)));
                                        /* Cas ou 'k' est pair.                                                                      */
          Eblock
     ETes

     RETU(Bernoulli_k);
     Eblock

EFonctionF

_______________________________________________________________________________________________________________________________________
_______________________________________________________________________________________________________________________________________
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        C A L C U L   D U   N O M B R E   D E   S O M M E T S   D ' U N   H Y P E R - C U B E  :                                   */
/*                                                                                                                                   */
/*************************************************************************************************************************************/

BFonctionI

#define   NOMBRE_DE_SOMMETS_DE_L_HYPER_CUBE_DE_DIMENSION_NULLE                                                                          \
                    ZERO                                                                                                                \
                                        /* Definition a priori de l'yper-cube de dimension nulle...                                  */

DEFV(Common,DEFV(FonctionI,nombre_de_sommets_d_un_hyper_cube(dimension_de_l_hyper_cube)))
                                        /* Fonction introduite le 20160714103903...                                                  */
DEFV(Argument,DEFV(Int,dimension_de_l_hyper_cube));
                                        /* Dimension de l'hyper-cube.                                                                */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
     Bblock
     DEFV(Int,INIT(nombre_de_sommets_de_l_hyper_cube,NOMBRE_DE_SOMMETS_DE_L_HYPER_CUBE_DE_DIMENSION_NULLE));
                                        /* Nombre de sommets de l'hyper-cube.                                                        */
     /*..............................................................................................................................*/
     Test(IZGE(dimension_de_l_hyper_cube))
          Bblock
          EGAL(nombre_de_sommets_de_l_hyper_cube,INTE(PUIX(DEUX,dimension_de_l_hyper_cube)));
          Eblock
     ATes
          Bblock
          PRINT_ERREUR("la dimension de l'espace ne peut etre negative");
          Eblock
     ETes

     RETU(nombre_de_sommets_de_l_hyper_cube);
     Eblock

EFonctionI

#undef    NOMBRE_DE_SOMMETS_DE_L_HYPER_CUBE_DE_DIMENSION_NULLE

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        C A L C U L   D U   N O M B R E   D ' A R E T E S   D ' U N   H Y P E R - C U B E  :                                       */
/*                                                                                                                                   */
/*************************************************************************************************************************************/

BFonctionI

#define   NOMBRE_D_ARETES_DE_L_HYPER_CUBE_DE_DIMENSION_NULLE                                                                            \
                    ZERO                                                                                                                \
                                        /* Definition a priori de l'yper-cube de dimension nulle...                                  */

DEFV(Common,DEFV(FonctionI,nombre_d_aretes_d_un_hyper_cube(dimension_de_l_hyper_cube)))
                                        /* Fonction introduite le 20160714103903...                                                  */
DEFV(Argument,DEFV(Int,dimension_de_l_hyper_cube));
                                        /* Dimension de l'hyper-cube.                                                                */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
     Bblock
     DEFV(Int,INIT(nombre_d_aretes_de_l_hyper_cube,NOMBRE_D_ARETES_DE_L_HYPER_CUBE_DE_DIMENSION_NULLE));
                                        /* Nombre d'aretes de l'hyper-cube.                                                          */
     /*..............................................................................................................................*/
     Test(IZGE(dimension_de_l_hyper_cube))
          Bblock
          DEFV(Int,INIT(dimension_courante,ZERO));

          Repe(dimension_de_l_hyper_cube)
               Bblock
               INCR(dimension_courante,I);

               EGAL(nombre_d_aretes_de_l_hyper_cube
                   ,AXPB(DEUX
                        ,nombre_d_aretes_de_l_hyper_cube
                        ,nombre_de_sommets_d_un_hyper_cube(PRED(dimension_courante))
                         )
                    );
                                        /* Le nombre d'aretes 'A(d)' de l'hyper-cube est calcule recursivement par la formule :      */
                                        /*                                                                                           */
                                        /*                  A(0) = 0                                                                 */
                                        /*                                                                                           */
                                        /*                                     d-1                                                   */
                                        /*                  A(d) = 2.A(d-1) + 2                                                      */
                                        /*                                                                                           */
               Eblock
          ERep
          Eblock
     ATes
          Bblock
          PRINT_ERREUR("la dimension de l'espace ne peut etre negative");
          Eblock
     ETes

     RETU(nombre_d_aretes_de_l_hyper_cube);
     Eblock

EFonctionI

#undef    NOMBRE_D_ARETES_DE_L_HYPER_CUBE_DE_DIMENSION_NULLE

_______________________________________________________________________________________________________________________________________
_______________________________________________________________________________________________________________________________________
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        E X P O N E N T I A T I O N   E N T I E R E   D ' U N   N O M B R E   F L O T T A N T  :                                   */
/*                                                                                                                                   */
/*************************************************************************************************************************************/

BFonctionF

#define   N_A_LA_PUISSANCE_0                                                                                                            \
                    FU                                                                                                                  \
                                        /*                         0                                                                 */ \
                                        /* definition a priori de n  puisqu'on ne peut deduire cette valeur du calcul...             */
#define   N_A_UNE_PUISSANCE_NEGATIVE                                                                                                    \
                    FZERO                                                                                                               \
                                        /* Valeur arbitraire renvoyee lorsque l'exposant est negatif...                              */

DEFV(Common,DEFV(FonctionF,x_a_la_puissance_p(x,p)))
                                        /* Fonction introduite le 20100602091036...                                                  */
DEFV(Argument,DEFV(Float,x));
                                        /* Nombre flottant definissant la base de l'exponentielle.                                   */
DEFV(Argument,DEFV(Int,p));
                                        /* Nombre entier definissant l'exposant.                                                     */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
     Bblock
     DEFV(Float,INIT(valeur_de_l_exponentielle,N_A_LA_PUISSANCE_0));
                                        /*                                                     0                                     */
                                        /* valeur courante de l'exponentielle initialisee sur x .                                    */
     /*..............................................................................................................................*/
     Test(IZLT(p))
          Bblock
          PRINT_ERREUR("l'exposant de la fonction exponentielle entiere est negatif");
          EGAL(valeur_de_l_exponentielle,N_A_UNE_PUISSANCE_NEGATIVE);
                                        /* En cas d'erreur, on renvoie 0 afin de faire la difference...                              */
          Eblock
     ATes
          Bblock

          Test(IZGT(p))
               Bblock
               Komp(indice_courant,p)
                    Bblock
                    EGAL(valeur_de_l_exponentielle,MUL2(x,valeur_de_l_exponentielle));
                                        /* Calcul iteratif de la fonction exponentielle entiere.                                     */
                    Eblock
               EKom
               Eblock
          ATes
               Bblock
               Eblock
          ETes
          Eblock
     ETes

     RETU(valeur_de_l_exponentielle);
     Eblock

#undef    N_A_UNE_PUISSANCE_NEGATIVE
#undef    N_A_LA_PUISSANCE_0

EFonctionF

/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/*                                                                                                                                   */
/*        E X P O N E N T I A T I O N   E N T I E R E   D ' U N   N O M B R E   E N T I E R  :                                       */
/*                                                                                                                                   */
/*************************************************************************************************************************************/

BFonctionI

DEFV(Common,DEFV(FonctionI,n_a_la_puissance_p(n,p)))
                                        /* Cette fonction s'est vue introduite preventivement apres un incident rencontre sur le     */
                                        /* SYSTEME 'SYSTEME_SUN4NCUBE2S_SUNOS_NCC' ('v $Dbugs/SUN4NCUBE2S$D/SUNOS$D/NCC$D/pow.01$c') */
                                        /* qui montre que parfois 'PUIX(...)' avec des arguments entiers peut renvoyer un resultat   */
                                        /* incorrect egal a la valeur attendu moins un (a cause des erreurs d'arrondi...).           */
DEFV(Argument,DEFV(Int,n));
                                        /* Nombre entier definissant la base entiere de l'exponentielle.                             */
DEFV(Argument,DEFV(Int,p));
                                        /* Nombre entier definissant l'exposant.                                                     */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
     Bblock
     /*..............................................................................................................................*/
     RETU(INTE(EXPn(n,p)));
     Eblock

EFonctionI

_______________________________________________________________________________________________________________________________________



Copyright © Jean-François COLONNA, 2019-2024.
Copyright © CMAP (Centre de Mathématiques APpliquées) UMR CNRS 7641 / École polytechnique, Institut Polytechnique de Paris, 2019-2024.