_______________________________________________________________________________________________________________________________________ /*************************************************************************************************************************************/ /* */ /* 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 _______________________________________________________________________________________________________________________________________