_______________________________________________________________________________________________________________________________________
/*************************************************************************************************************************************/
/* */
/* F O N C T I O N S R E L A T I V E S A U X N O M B R E S E N T I E R S : */
/* */
/* */
/* Definition : */
/* */
/* Ce fichier contient toutes les fonctions */
/* de base de generation de champs utilisant les */
/* nombre entiers. */
/* */
/* */
/* Author of '$ximf/nombres$FON' : */
/* */
/* Jean-Francois COLONNA (LACTAMME, 19880000000000). */
/* */
/*************************************************************************************************************************************/
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* R E C H E R C H E D E S N O M B R E S P R E M I E R S */
/* E T P L U S G E N E R A L E M E N T D E S D I V I S E U R S D I F F E R E N T S : */
/* */
/*************************************************************************************************************************************/
#define PREMIER_NOMBRE_ENTIER \
UN \
/* Premier nombre entier non nul. */
#define NOMBRE_DE_NOMBRES_A_TESTER \
QUOE(ADD2(dimXY,DOUB(ADD2(dimX,dimY))),MUL2(pasX,pasY)) \
/* Ainsi, on ajoute une "bordure" autour de l'image compensant le fait que si */ \
/* l'on prend juste 'dimXY', etant donne la position de (Xcentre,Ycentre), on */ \
/* risque de laisser deux cotes de l'image incomplets... */
BFonctionP
DEFV(Common,DEFV(Logical,SINT(Inombres_premiers_____visualiser_le_nombre_de_diviseurs_du_point_courant,VRAI)));
/* Introduit le 20150331100103 pour plus de generalite... */
DEFV(Common,DEFV(genere_p,SINT(Inombres_premiers_____niveau_de_marquage_des_nombres_non_premiers__________,GRIS_0)));
DEFV(Common,DEFV(genere_p,SINT(Inombres_premiers_____niveau_de_marquage_du_premier_nombre_________________,GRIS_2)));
DEFV(Common,DEFV(genere_p,SINT(Inombres_premiers_____niveau_de_marquage_des_nombres_____premiers__________,GRIS_8)));
DEFV(Common,DEFV(genere_p,SINT(Inombres_premiers_____niveau_de_marquage_des_nombres_____premiers_jumeaux_1,GRIS_4)));
DEFV(Common,DEFV(genere_p,SINT(Inombres_premiers_____niveau_de_marquage_des_nombres_____premiers_jumeaux_2,GRIS_5)));
/* Niveaux a utiliser lorsque l'on ne visualise que les nombres premiers (introduit */
/* le 20150331100103). */
DEFV(Common,DEFV(Positive,SINT(Inombres_premiers_____distance_entre_deux_nombres_premiers_jumeaux,DEUX)));
/* Distance entre deux nombres premiers jumeuax (introduite le 20150331173218). */
DEFV(Common,DEFV(FonctionP,POINTERp(Inombres_premiers(imageR,dernier_nombre_a_tester,pas_entre_les_nombres))))
DEFV(Argument,DEFV(image,imageR));
/* Image Resultat, telle que : imageR[X][Y]=nombre de diviseurs du nombre valant */
/* le rang du point {X,Y} sur une spirale carree centree. */
DEFV(Argument,DEFV(Positive,dernier_nombre_a_tester));
/* Dernier nombre entier que l'on testera, */
DEFV(Argument,DEFV(Int,pas_entre_les_nombres));
/* Et pas de passage d'un nombre entier au suivant... */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
DEFV(Int,INIT(numero_du_point_courant,UNDEF));
/* Numero du point courant dans [PREMIER_NOMBRE_ENTIER,dernier_nombre_a_tester]. */
DEFV(Int,INIT(diviseur_courant,UNDEF));
/* Diviseur courant du numero du point courant dans */
/* [PREMIER_NOMBRE_ENTIER,numero_du_point_courant]. */
DEFV(Int,INIT(nombre_de_diviseurs_du_point_courant,UNDEF));
/* Nombre de diviseurs du numero du point courant. */
DEFV(pointI_2D,point_courant);
/* Point (entier) courant. */
SPIRALE_DEFINITION
/* Donnees de generation d'une spirale de parcours d'une image. */
DEFV(Logical,INIT(le_nombre_premier_precedent_existe,FAUX));
DEFV(Int,INIT(nombre_premier_precedent,UNDEF));
DEFV(pointI_2D,point_precedent);
/* Donnees utiles a la visualisation des nombres premiers jumeaux... */
/*..............................................................................................................................*/
Test(IFGE(NOIR,NIVA(PREMIER_NOMBRE_ENTIER)))
Bblock
PRINT_ATTENTION("on ne pourra faire la difference entre les points marques et les points non marques");
Eblock
ATes
Bblock
Eblock
ETes
Test(IZLE(pas_entre_les_nombres))
Bblock
PRINT_ERREUR("le pas de passage d'un nombre entier au suivant doit etre strictement positif");
Eblock
ATes
Bblock
Eblock
ETes
Test(IFET(EST_IMPAIR(Inombres_premiers_____distance_entre_deux_nombres_premiers_jumeaux)
,IFGT(Inombres_premiers_____distance_entre_deux_nombres_premiers_jumeaux,UN)
)
)
Bblock
PRINT_ATTENTION("une distance entre nombres premiers 'jumeaux' impaire et superieure a 1 n'a pas de sens");
/* Message introduit le 20150331173218... */
/* */
/* En effet, la "distance" entre deux nombres premiers quelconques (et donc pas */
/* necessairement jumeaux) ne peut etre que paire (sauf entre 2 et 3) puisque les */
/* nombres premiers sont impairs (sauf 2...). */
Eblock
ATes
Bblock
Eblock
ETes
SPIRALE_VALIDATION;
/* Validation des pas de parcours (pasX,pasY) des images. */
INITIALISATION_POINT_2D(point_courant,Xcentre,Ycentre);
/* Et on se place au centre de l'image. */
CALS(Inoir(imageR));
/* Au cas ou l'on ne balayerait pas toute l'image... */
DoIn(numero_du_point_courant
,PREMIER_NOMBRE_ENTIER
,TRON(dernier_nombre_a_tester,PREMIER_NOMBRE_ENTIER,MUL2(NOMBRE_DE_NOMBRES_A_TESTER,pas_entre_les_nombres))
,pas_entre_les_nombres
)
Bblock
DEFV(genere_p,INIT(niveau_de_marquage,NIVEAU_UNDEF));
/* Introduit le 20150331095646 afin de permettre de visualiser autre chose que le nombre */
/* de diviseurs... */
CLIR(nombre_de_diviseurs_du_point_courant);
/* Initialisation du nombre de diviseurs du numero du point courant. */
DoIn(diviseur_courant,PREMIER_NOMBRE_ENTIER,numero_du_point_courant,I)
Bblock
Test(IZEQ(REST(numero_du_point_courant,diviseur_courant)))
Bblock
INCR(nombre_de_diviseurs_du_point_courant,I);
/* Et on compte les diviseurs du nombre courant (y compris l'unite et ce */
/* nombre lui-meme...). */
Eblock
ATes
Bblock
Eblock
ETes
Eblock
EDoI
Test(IFGE(NIVA(nombre_de_diviseurs_du_point_courant),BLANC))
Bblock
PRINT_ATTENTION("il y a des points qui ont au moins 'BLANC' diviseurs");
Eblock
ATes
Bblock
Eblock
ETes
Test(IL_FAUT(Inombres_premiers_____visualiser_le_nombre_de_diviseurs_du_point_courant))
/* Test introduit le 20150331100103... */
Bblock
EGAL(niveau_de_marquage,GENP(TRNP(NIVA(nombre_de_diviseurs_du_point_courant))));
/* Afin de visualiser le nombre de diviseurs... */
Eblock
ATes
Bblock
Test(IFEQ(numero_du_point_courant,PREMIER_NOMBRE_ENTIER))
Bblock
EGAL(niveau_de_marquage,Inombres_premiers_____niveau_de_marquage_du_premier_nombre_________________);
/* Cas du premier nombre entier... */
Eblock
ATes
Bblock
Test(IFEQ(nombre_de_diviseurs_du_point_courant,DEUX))
Bblock
EGAL(niveau_de_marquage,Inombres_premiers_____niveau_de_marquage_des_nombres_____premiers__________);
/* Afin de visualiser les nombres premiers a priori... */
Test(EST_VRAI(le_nombre_premier_precedent_existe))
Bblock
Test(IFEQ(SOUS(numero_du_point_courant,nombre_premier_precedent)
,Inombres_premiers_____distance_entre_deux_nombres_premiers_jumeaux
)
)
Bblock
EGAL(niveau_de_marquage
,Inombres_premiers_____niveau_de_marquage_des_nombres_____premiers_jumeaux_1
);
/* Afin de visualiser les nombres premiers jumeaux... */
store_point_valide(niveau_de_marquage
,imageR
,ASD1(point_precedent,x),ASD1(point_precedent,y)
,FVARIABLE
);
/* Et on remarque le point precedent correspondant au couple courant de nombres */
/* premiers jumeaux... */
EGAL(niveau_de_marquage
,Inombres_premiers_____niveau_de_marquage_des_nombres_____premiers_jumeaux_2
);
/* Afin de visualiser les nombres premiers jumeaux... */
Eblock
ATes
Bblock
Eblock
ETes
Eblock
ATes
Bblock
Eblock
ETes
TRANSFERT_POINT_2D(point_precedent,point_courant);
EGAL(nombre_premier_precedent,numero_du_point_courant);
EGAL(le_nombre_premier_precedent_existe,VRAI);
/* Memorisation du nombre premier courant... */
Eblock
ATes
Bblock
EGAL(niveau_de_marquage,Inombres_premiers_____niveau_de_marquage_des_nombres_non_premiers__________);
/* Afin de visualiser les nombres non premiers. */
Eblock
ETes
Eblock
ETes
Eblock
ETes
store_point_valide(niveau_de_marquage
,imageR
,ASD1(point_courant,x),ASD1(point_courant,y)
,FVARIABLE
);
/* Et on marque le point courant avec le nombre de diviseurs de son rang... */
/* */
/* ATTENTION : le point marque est correct, c'est 'point_courant', et non pas {X,Y} ce qui */
/* serait incorrect. On notera que dans le cas d'une image non carree (de type 'Pal', par */
/* exemple), il y aura donc des bandes 'NOIR' dans l'image... */
SPIRALE_INITIALISATION;
/* Initialisation dynamique de 'spirale_nombre_de_points_a_traiter'. */
SPIRALE_DEPLACEMENT(ASD1(point_courant,x),ASD1(point_courant,y));
/* Deplacement du point courant de la spirale... */
/* ATTENTION : on n'utilise pas 'SPIRALE_DEPLACEMENT_ET_PARCOURS(...)' afin de garantir le */
/* traitement de tous les points de l'image... */
SPIRALE_PARCOURS;
/* Parcours de la spirale avec rotation eventuelle de PI/2 du bras courant... */
Eblock
EDoI
RETI(imageR);
Eblock
EFonctionP
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* R E C H E R C H E D E S M U L T I P L E S D ' U N N O M B R E : */
/* */
/*************************************************************************************************************************************/
BFonctionP
DEFV(Common,DEFV(FonctionP,POINTERp(Imultiples_d_un_nombre(imageR
,racine_des_multiples
,niveau_des_multiples
,dernier_nombre_a_tester,pas_entre_les_nombres
)
)
)
)
DEFV(Argument,DEFV(image,imageR));
/* Image Resultat, telle que : imageR[X][Y]=liste des multiples de la "racine", */
/* les nombres entiers etant reperes par le rang du point {X,Y} sur une spirale */
/* carree centree. */
DEFV(Argument,DEFV(Int,racine_des_multiples));
/* Nombre entier dont on cherche les multiples. */
DEFV(Argument,DEFV(genere_p,niveau_des_multiples));
/* Niveau de marquage des multiples du nombre argument ; on notera que l'on */
/* ne marque pas les "non multiples", afin de permettre des "superpositions" */
/* de differents nombres de base. */
DEFV(Argument,DEFV(Positive,dernier_nombre_a_tester));
/* Dernier nombre entier que l'on testera, */
DEFV(Argument,DEFV(Int,pas_entre_les_nombres));
/* Et pas de passage d'un nombre entier au suivant... */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
DEFV(Int,INIT(numero_du_point_courant,UNDEF));
/* Numero du point courant dans [PREMIER_NOMBRE_ENTIER,dernier_nombre_a_tester]. */
DEFV(pointI_2D,point_courant);
/* Point (entier) courant. */
SPIRALE_DEFINITION
/* Donnees de generation d'une spirale de parcours d'une image. */
/*..............................................................................................................................*/
Test(IFGE(NOIR,NIVA(PREMIER_NOMBRE_ENTIER)))
Bblock
PRINT_ATTENTION("on ne pourra faire la difference entre les points marques et les points non marques");
Eblock
ATes
Bblock
Eblock
ETes
Test(IZLE(racine_des_multiples))
Bblock
PRINT_ERREUR("les nombres entiers doivent etre strictement positifs");
Eblock
ATes
Bblock
Eblock
ETes
Test(IZLE(pas_entre_les_nombres))
Bblock
PRINT_ERREUR("le pas de passage d'un nombre entier au suivant doit etre strictement positif");
Eblock
ATes
Bblock
Eblock
ETes
SPIRALE_VALIDATION;
/* Validation des pas de parcours (pasX,pasY) des images. */
INITIALISATION_POINT_2D(point_courant,Xcentre,Ycentre);
/* Et on se place au centre de l'image. */
DoIn(numero_du_point_courant
,PREMIER_NOMBRE_ENTIER
,TRON(dernier_nombre_a_tester,PREMIER_NOMBRE_ENTIER,MUL2(NOMBRE_DE_NOMBRES_A_TESTER,pas_entre_les_nombres))
,pas_entre_les_nombres
)
Bblock
Test(IZEQ(REST(numero_du_point_courant,racine_des_multiples)))
Bblock
store_point_valide(niveau_des_multiples
,imageR
,ASD1(point_courant,x),ASD1(point_courant,y)
,FVARIABLE
);
/* Et on marque le point courant lorsqu'il est divisible par la "racine"... */
Eblock
ATes
Bblock
Eblock
ETes
SPIRALE_INITIALISATION;
/* Initialisation dynamique de 'spirale_nombre_de_points_a_traiter'. */
SPIRALE_DEPLACEMENT(ASD1(point_courant,x),ASD1(point_courant,y));
/* Deplacement du point courant de la spirale... */
/* ATTENTION : on n'utilise pas 'SPIRALE_DEPLACEMENT_ET_PARCOURS(...)' afin de garantir le */
/* traitement de tous les points de l'image... */
SPIRALE_PARCOURS;
/* Parcours de la spirale avec rotation eventuelle de PI/2 du bras courant... */
Eblock
EDoI
RETI(imageR);
Eblock
EFonctionP
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* E T U D E D E L A P E R S I S T A N C E M U L T I P L I C A T I V E */
/* E T A D D I T I V E D E S N O M B R E S : */
/* */
/*************************************************************************************************************************************/
BFonctionP
DEFV(Common,DEFV(Logical,SINT(Ipersistance_multiplicative_des_nombres_entiers_____persistance_additive,FAUX)));
/* Introduit le 20130531105329 pour plus de generalite... */
DEFV(Common,DEFV(Positive,SINT(Ipersistance_multiplicative_des_nombres_entiers_____base_de_numeration,BASE10)));
/* Base de numeration a utiliser, la base decimale etant la base par defaut... */
DEFV(Common,DEFV(Logical,SINT(Ipersistance_multiplicative_des_nombres_entiers_____editer_la_persistance_des_nombres_entiers,FAUX)));
/* Introduit le 20130531094217 a des fins de validation principalement... */
DEFV(Common,DEFV(Logical,SINT(Ipersistance_multiplicative_des_nombres_entiers_____renvoyer_la_Persistance,VRAI)));
DEFV(Common,DEFV(Positive,SINT(Ipersistance_multiplicative_des_nombres_entiers_____maximum_de_la_Persistance,INFINI)));
/* Introduits le 20150113092936 afin de permettre, par exemple, de reperer les nombres qui */
/* initialement contiennent au moins un zero. Il suffit pour ce faire de prendre un maximum */
/* de la 'Persistance' egal a 0 et de ne pas renvoyer la 'Persistance' (et donc renvoyer le */
/* 'CumulMultiplicatif_ou_Additif')... */
DEFV(Common,DEFV(FonctionP,POINTERp(Ipersistance_multiplicative_des_nombres_entiers(imageR
,dernier_nombre_a_tester,pas_entre_les_nombres
)
)
)
)
/* Fonction introduite le 20130531075712... */
DEFV(Argument,DEFV(image,imageR));
/* Image Resultat, telle que : imageR[X][Y]=persistance multiplicative du point {X,Y} */
/* sur une spirale carree centree. */
/* carree centree. */
DEFV(Argument,DEFV(Positive,dernier_nombre_a_tester));
/* Dernier nombre entier que l'on testera, */
DEFV(Argument,DEFV(Int,pas_entre_les_nombres));
/* Et pas de passage d'un nombre entier au suivant... */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
DEFV(Int,INIT(numero_du_point_courant,UNDEF));
/* Numero du point courant dans [PREMIER_NOMBRE_ENTIER,dernier_nombre_a_tester]. */
DEFV(pointI_2D,point_courant);
/* Point (entier) courant. */
SPIRALE_DEFINITION
/* Donnees de generation d'une spirale de parcours d'une image. */
DEFV(Int,INIT(PersistanceMaximale,MOINS_L_INFINI));
/* Calcul de la persistance maximale qui n'a de sens que si l'on edite les persistnces... */
/*..............................................................................................................................*/
Test(IFGE(NOIR,NIVA(PREMIER_NOMBRE_ENTIER)))
Bblock
PRINT_ATTENTION("on ne pourra faire la difference entre les points marques et les points non marques");
Eblock
ATes
Bblock
Eblock
ETes
Test(IZLE(pas_entre_les_nombres))
Bblock
PRINT_ERREUR("le pas de passage d'un nombre entier au suivant doit etre strictement positif");
Eblock
ATes
Bblock
Eblock
ETes
SPIRALE_VALIDATION;
/* Validation des pas de parcours (pasX,pasY) des images. */
INITIALISATION_POINT_2D(point_courant,Xcentre,Ycentre);
/* Et on se place au centre de l'image. */
DoIn(numero_du_point_courant
,PREMIER_NOMBRE_ENTIER
,TRON(dernier_nombre_a_tester,PREMIER_NOMBRE_ENTIER,MUL2(NOMBRE_DE_NOMBRES_A_TESTER,pas_entre_les_nombres))
,pas_entre_les_nombres
)
Bblock
DEFV(Int,INIT(CumulMultiplicatif_ou_Additif
,COND(IL_NE_FAUT_PAS(Ipersistance_multiplicative_des_nombres_entiers_____persistance_additive)
,UN
,ZERO
)
)
);
DEFV(Int,INIT(Reduction,numero_du_point_courant));
DEFV(Int,INIT(Persistance,ZERO));
Test(IL_FAUT(Ipersistance_multiplicative_des_nombres_entiers_____editer_la_persistance_des_nombres_entiers))
Bblock
CAL3(Prme1("%d",Reduction));
Test(IFLT(Reduction,Ipersistance_multiplicative_des_nombres_entiers_____base_de_numeration))
Bblock
CAL3(Prme1(" --> %d",Reduction));
/* Introduit le 20150113104756 car, en effet, cela manquait... */
Eblock
ATes
Bblock
Eblock
ETes
Eblock
ATes
Bblock
Eblock
ETes
Tant(IFET(IFGE(Reduction,Ipersistance_multiplicative_des_nombres_entiers_____base_de_numeration)
,IFLE(Persistance,Ipersistance_multiplicative_des_nombres_entiers_____maximum_de_la_Persistance)
)
)
Bblock
DEFV(Int,INIT(Quotient,Reduction));
DEFV(Int,INIT(Reste,UNDEF));
EGAL(CumulMultiplicatif_ou_Additif
,COND(IL_NE_FAUT_PAS(Ipersistance_multiplicative_des_nombres_entiers_____persistance_additive)
,UN
,ZERO
)
);
/* La reinitialisation de 'CumulMultiplicatif_ou_Additif' doit avoir lieu evidemment a */
/* chaque nouvelle iteration du 'Tant(...)'... */
Tant(IFNE(Quotient,ZERO))
Bblock
EGAL(Reste,REST(Quotient,Ipersistance_multiplicative_des_nombres_entiers_____base_de_numeration));
EGAL(Quotient,DIVI(Quotient,Ipersistance_multiplicative_des_nombres_entiers_____base_de_numeration));
EGAL(CumulMultiplicatif_ou_Additif
,OPC2(IL_NE_FAUT_PAS(Ipersistance_multiplicative_des_nombres_entiers_____persistance_additive)
,MUL2
,ADD2
,CumulMultiplicatif_ou_Additif
,Reste
)
);
Eblock
ETan
EGAL(Reduction,CumulMultiplicatif_ou_Additif);
INCR(Persistance,I);
Test(IL_FAUT(Ipersistance_multiplicative_des_nombres_entiers_____editer_la_persistance_des_nombres_entiers))
Bblock
CAL3(Prme1(" --> %d",Reduction));
Eblock
ATes
Bblock
Eblock
ETes
Eblock
ETan
EGAL(PersistanceMaximale,MAX2(PersistanceMaximale,Persistance));
Test(IL_FAUT(Ipersistance_multiplicative_des_nombres_entiers_____editer_la_persistance_des_nombres_entiers))
Bblock
CAL3(Prme1(" %d\n",Persistance));
Eblock
ATes
Bblock
Eblock
ETes
store_point_valide(COND(IL_FAUT(Ipersistance_multiplicative_des_nombres_entiers_____renvoyer_la_Persistance)
,NIVA(Persistance)
,NIVA(CumulMultiplicatif_ou_Additif)
)
,imageR
,ASD1(point_courant,x),ASD1(point_courant,y)
,FVARIABLE
);
/* Et on marque le point courant a l'aide de sa persistance ou du cumul courant suivant */
/* les cas... */
SPIRALE_INITIALISATION;
/* Initialisation dynamique de 'spirale_nombre_de_points_a_traiter'. */
SPIRALE_DEPLACEMENT(ASD1(point_courant,x),ASD1(point_courant,y));
/* Deplacement du point courant de la spirale... */
/* ATTENTION : on n'utilise pas 'SPIRALE_DEPLACEMENT_ET_PARCOURS(...)' afin de garantir le */
/* traitement de tous les points de l'image... */
SPIRALE_PARCOURS;
/* Parcours de la spirale avec rotation eventuelle de PI/2 du bras courant... */
Eblock
EDoI
Test(IL_FAUT(Ipersistance_multiplicative_des_nombres_entiers_____editer_la_persistance_des_nombres_entiers))
Bblock
CAL3(Prme4("PersistanceMaximale(%d,%d)=%d en base %d\n"
,PINTE(PREMIER_NOMBRE_ENTIER)
,bSOU(numero_du_point_courant,pas_entre_les_nombres)
,PersistanceMaximale
,Ipersistance_multiplicative_des_nombres_entiers_____base_de_numeration
)
);
/* On n'oubliera pas que la definition de 'NOMBRE_DE_NOMBRES_A_TESTER' fait que l'on */
/* etudie un peu plus de nombres que 'dimXY'... */
Eblock
ATes
Bblock
Eblock
ETes
RETI(imageR);
Eblock
EFonctionP
#undef NOMBRE_DE_NOMBRES_A_TESTER
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* C R I B L E D ' E R A T O S T H E N E : */
/* */
/*************************************************************************************************************************************/
BFonctionP
DEFV(Common,DEFV(Logical,SINT(Icrible_d_Eratosthene_____visualiser_la_divisibilite,VRAI)));
/* Choix entre visualiser la divisibilite ou la non divisibilite... */
DEFV(Common,DEFV(Logical,SINT(Icrible_d_Eratosthene_____visualiser_les_nombres_premiers,VRAI)));
/* Afin de pouvoir visualiser les nombres premiers... */
DEFV(Common,DEFV(Int,SINT(Icrible_d_Eratosthene_____premier_diviseur,PREMIER_NOMBRE_ENTIER)));
DEFV(Common,DEFV(Int,SINT(Icrible_d_Eratosthene_____pas_des_diviseurs,UN)));
DEFV(Common,DEFV(Int,SINT(Icrible_d_Eratosthene_____premier_nombre_a_tester,PREMIER_NOMBRE_ENTIER)));
DEFV(Common,DEFV(Int,SINT(Icrible_d_Eratosthene_____pas_des_nombres,UN)));
/* Definition des nombres a tester... */
DEFV(Common,DEFV(genere_p,SINT(Icrible_d_Eratosthene_____niveau_complementaire,GRIS_2)));
DEFV(Common,DEFV(genere_p,SINT(Icrible_d_Eratosthene_____premier_niveau_de_marquage,GRIS_4)));
DEFV(Common,DEFV(Float,SINT(Icrible_d_Eratosthene_____pas_du_niveau_de_marquage,FZERO)));
DEFV(Common,DEFV(genere_p,SINT(Icrible_d_Eratosthene_____niveau_des_nombres_premiers,GRIS_8)));
/* Definition du marquage. On notera le type 'Float' du pas destine a permettre de */
/* progresser "doucement" de facon a ce que les niveaux ne soient pas utilises "modulo"... */
DEFV(Common,DEFV(FonctionP,POINTERp(Icrible_d_Eratosthene(imageR))))
/* Fonction introduite le 20150402092828... */
DEFV(Argument,DEFV(image,imageR));
/* Image Resultat. */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
DEFV(Int,INIT(diviseur_courant,Icrible_d_Eratosthene_____premier_diviseur));
DEFV(Float,INIT(niveau_courant,Icrible_d_Eratosthene_____premier_niveau_de_marquage));
/*..............................................................................................................................*/
begin_colonne
Bblock
DEFV(Int,INIT(nombre_courant,Icrible_d_Eratosthene_____premier_nombre_a_tester));
Test(IFEQ(niveau_courant,NOIR))
Bblock
EGAL(niveau_courant,NOIR_PLANCHER);
Eblock
ATes
Bblock
Eblock
ETes
begin_ligne
Bblock
Test(IFLE(diviseur_courant,nombre_courant))
Bblock
DEFV(Logical,INIT(est_divisible,DIVISIBLE(nombre_courant,diviseur_courant)));
store_point(COND(IFOU(IFET(IL_FAUT(Icrible_d_Eratosthene_____visualiser_la_divisibilite)
,EST_VRAI(est_divisible)
)
,IFET(IL_NE_FAUT_PAS(Icrible_d_Eratosthene_____visualiser_la_divisibilite)
,EST_FAUX(est_divisible)
)
)
,GENP(niveau_courant)
,Icrible_d_Eratosthene_____niveau_complementaire
)
,imageR
,X,Y
,FVARIABLE
);
/* Marquage de la divisibilite ou de la non divisibilite... */
Eblock
ATes
Bblock
Eblock
ETes
Test(IL_FAUT(Icrible_d_Eratosthene_____visualiser_les_nombres_premiers))
Bblock
Test(TOUJOURS_VRAI)
/* Il a eu un temps ici : */
/* */
/* Test(IL_NE_FAUT_PAS(Icrible_d_Eratosthene_____visualiser_la_divisibilite)) */
/* */
Bblock
Test(IFEQ(diviseur_courant,nombre_courant))
Bblock
/* Cas ou on atteint la diagonale principale, on a fini de tester 'nombre_courant'... */
DEFV(Int,INIT(sous_diviseur_courant,UNDEF));
DEFV(Int,INIT(nombre_de_diviseurs,ZERO));
DoIn(sous_diviseur_courant,SUCC(PREMIER_NOMBRE_ENTIER),PRED(nombre_courant),I)
Bblock
INCR(nombre_de_diviseurs,COND(DIVISIBLE(nombre_courant,sous_diviseur_courant),UN,ZERO));
/* Comptage des diviseurs de 'nombre_courant' excepte 1 et lui-meme... */
Eblock
EDoI
Test(IZEQ(nombre_de_diviseurs))
Bblock
/* Cas ou 'nombre_courant' est un nombre premier : */
begin_colonneQ(DoIn
,SUCY(Ymin)
,PREY(SavM_____Y)
,pasY
)
Bblock
store_point(Icrible_d_Eratosthene_____niveau_des_nombres_premiers
,imageR
,X,Y
,FVARIABLE
);
/* Marquage de la colonne du nombre premier 'nombre_courant'... */
Eblock
end_colonneQ(EDoI)
Eblock
ATes
Bblock
Eblock
ETes
Eblock
ATes
Bblock
Eblock
ETes
Eblock
ATes
Bblock
Eblock
ETes
Eblock
ATes
Bblock
Eblock
ETes
INCR(nombre_courant,Icrible_d_Eratosthene_____pas_des_nombres);
Eblock
end_ligne
INCR(niveau_courant,Icrible_d_Eratosthene_____pas_du_niveau_de_marquage);
INCR(diviseur_courant,Icrible_d_Eratosthene_____pas_des_diviseurs);
Eblock
end_colonne
RETI(imageR);
Eblock
EFonctionP
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* S U B D I V I S I O N R E C U R S I V E D ' U N E I M A G E : */
/* */
/*************************************************************************************************************************************/
BFonctionP
#define NOMBRE_DE_NOMBRES_A_TESTER \
ADD2(dimXY,DOUB(ADD2(dimX,dimY))) \
/* Ainsi, on ajoute une "bordure" autour de l'image compensant le fait que si */ \
/* l'on prend juste 'dimXY', etant donne la position de (Xcentre,Ycentre), on */ \
/* risque de laisser deux cotes de l'image incomplets... */
#define AVANT_PREMIER_NIVEAU_DE_RECURSIVITE \
ZERO \
/* "Faux" premier niveau de recursivite ; mais on notera que celui-ci n'est */ \
/* jamais utilise pour le marquage, puisque l'on fait d'abord un 'SUCC'. */
#define PREMIER_NIVEAU_DE_RECURSIVITE \
SUCC(AVANT_PREMIER_NIVEAU_DE_RECURSIVITE) \
/* "Vrai" premier niveau de recursivite. */
#define NOMBRE_DE_NIVEAUX_DE_RECURSIVITE \
TRPU(MAX2(logX,logY)) \
/* Nombre de niveaux de recursivite maximum. */
#define NIVEAU_DE_PREMARQUAGE_DES_COLLISIONS \
NOIR \
/* Niveau indiquant qu'un point n'a pas ete encore atteint. */
#define NOMBRE_DE_SOMMETS_D_UN_CARRE \
INTE(PUI2(NOMBRE_DE_POINTS_DE_vectorI_2D)) \
/* Nombre de sommets d'un carre. */ \
/* */ \
/* Le 20070227143233, 'PUIX(...,BI_DIMENSIONNEL))' fut remplace par 'PUI2(...)'. */
#define DEFINITION_D_UN_CARRE(X_bas_gauche,Y_bas_gauche,X_haut_droite,Y_haut_droite) \
/* */ \
/* Y_haut_droite |---------------| */ \
/* |CHG CHD| */ \
/* | / | */ \
/* | / | */ \
/* | / | */ \
/* | / | */ \
/* | / | */ \
/* |CBG CBD| */ \
/* Y_bas_gauche |---------------| */ \
/* X_bas_gauche X_haut_droite */ \
/* */ \
/* "C" signifie "coin", */ \
/* "B" signifie "bas", "H" signifie "haut", */ \
/* "G" signifie "gauche", "D" signifie "droite". */ \
Bblock \
INITIALISATION_POINT_2D(coin_bas_gauche_reduit,X_bas_gauche,Y_bas_gauche); \
/* Definition du coin bas-gauche du carre courant, */ \
INITIALISATION_POINT_2D(coin_haut_droite_reduit,X_haut_droite,Y_haut_droite); \
/* Definition du coin haut-droite du carre courant, */ \
Eblock
#define DECOUPAGE_RECURSIF_D_UN_CARRE \
Bblock \
CALS(Iquatre_subdivision_recursive(imageR \
,coin_bas_gauche_reduit \
,coin_haut_droite_reduit \
,SUCC(niveau_de_la_recursivite) \
,profondeur_maximale_de_la_recursivite \
,population_courante_des_niveaux \
,population_maximale_inferieure \
,visualiser_le_nombre_de_diviseurs \
) \
); \
Eblock \
/* Appel de la fonction de decoupage recursif d'une image. */
DEFV(Local,DEFV(FonctionP,POINTERp(Iquatre_subdivision_recursive(imageR
,coin_bas_gauche
,coin_haut_droite
,niveau_de_la_recursivite
,profondeur_maximale_de_la_recursivite
,population_courante_des_niveaux
,population_maximale_inferieure
,visualiser_le_nombre_de_diviseurs
)
)
)
)
DEFV(Argument,DEFV(image,imageR));
/* Image Resultat, telle que : imageR[X][Y]=profondeur de la recursion. */
DEFV(Argument,DEFV(pointI_2D,coin_bas_gauche));
/* Coin bas gauche du carre courant (a subdiviser), */
DEFV(Argument,DEFV(pointI_2D,coin_haut_droite));
/* Coin haut droite du carre courant (a subdiviser). */
DEFV(Argument,DEFV(Positive,niveau_de_la_recursivite));
/* Donne le niveau courant de la recursivite de decoupage. *. */
DEFV(Argument,DEFV(Positive,profondeur_maximale_de_la_recursivite));
/* Profondeur d'arret de la recursivite ; avec 'INFINI', on est sur */
/* d'aller jusqu'au bout... */
DEFV(Argument,DEFV(Positive,DTb1(population_courante_des_niveaux,NOMBRE_DE_NIVEAUX_DE_RECURSIVITE)));
/* Pour chaque niveau de recursivite, on trouve dans ce vecteur sa population */
/* courante, c'est-a-dire le nombre de points qui y sont presents. */
DEFV(Argument,DEFV(Positive,DTb1(population_maximale_inferieure,NOMBRE_DE_NIVEAUX_DE_RECURSIVITE)));
/* Pour chaque niveau de recursivite, on trouve dans ce vecteur la population */
/* maximale cumulee des niveaux de recursivite inferieurs. */
DEFV(Argument,DEFV(Logical,visualiser_le_nombre_de_diviseurs));
/* Cet indicateur precise si l'on visualise le niveau de recursivite ('FAUX'), */
/* ou le nombre de diviseurs du numero de chaque point ('VRAI'). */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
DEFV(pointI_2D,coin_bas_gauche_reduit);
/* Coin bas gauche du carre subdivise, */
DEFV(pointI_2D,coin_haut_droite_reduit);
/* Coin haut droite du carre subdivise. */
DEFV(pointI_2D,centre_du_carre);
/* Centre du carre courant. */
DEFV(Int,INIT(numero_du_centre_du_carre,UNDEF));
/* On definit ici un numero du centre du carre courant. Ce numero est */
/* independant du nombre de niveaux de recursivite que l'on va explorer (ce qui */
/* qu'un meme point aura toujours le meme numero, quelle que soit la profondeur */
/* de la recursivite) ; il est egal a la population totale des niveaux de */
/* recursivite inferieurs (que l'on considere alors pleins) plus le numero */
/* de ce centre a ce niveau... */
DEFV(Int,INIT(diviseur_courant,UNDEF));
/* Diviseur courant du numero du point courant dans */
/* [PREMIER_NOMBRE_ENTIER,numero_du_centre_du_carre]. */
DEFV(Int,INIT(nombre_de_diviseurs_du_point_courant,UNDEF));
/* Nombre de diviseurs du numero du point courant. */
/*..............................................................................................................................*/
Test(IFGT(niveau_de_la_recursivite,LSTX(PREMIER_NIVEAU_DE_RECURSIVITE,NOMBRE_DE_NIVEAUX_DE_RECURSIVITE)))
Bblock
PRINT_ERREUR("le niveau de recursivite courant est trop grand");
Eblock
ATes
Bblock
Eblock
ETes
INITIALISATION_POINT_2D(centre_du_carre
,MOYE(ASD1(coin_bas_gauche,x),ASD1(coin_haut_droite,x))
,MOYE(ASD1(coin_bas_gauche,y),ASD1(coin_haut_droite,y))
);
/* Calcul du centre du carre courant. */
INCR(ITb1(population_courante_des_niveaux,INDX(niveau_de_la_recursivite,PREMIER_NIVEAU_DE_RECURSIVITE)),I);
/* Comptage de la population courante du niveau de recursivite courant. */
EGAL(numero_du_centre_du_carre
,ADD2(ITb1(population_maximale_inferieure,INDX(niveau_de_la_recursivite,PREMIER_NIVEAU_DE_RECURSIVITE))
,ITb1(population_courante_des_niveaux,INDX(niveau_de_la_recursivite,PREMIER_NIVEAU_DE_RECURSIVITE))
)
);
/* Ce qui donne le numero du centre du carre courant. Celui-ci est donc */
/* egal a la population totale des niveaux inferieurs (supposes donc */
/* completement remplis), plus le numero de ce point au niveau courant ; */
/* le calcul est fait avant le test suivant afin d'avoir une numerotation */
/* homogene et "isotrope". */
Test(IFEQ(load_point_valide(imageR
,ASD1(centre_du_carre,x),ASD1(centre_du_carre,y)
)
,NIVEAU_DE_PREMARQUAGE_DES_COLLISIONS
)
)
Bblock
Test(IL_FAUT(visualiser_le_nombre_de_diviseurs))
Bblock
CLIR(nombre_de_diviseurs_du_point_courant);
/* Initialisation du nombre de diviseurs du numero du point courant. */
DoIn(diviseur_courant,PREMIER_NOMBRE_ENTIER,numero_du_centre_du_carre,I)
Bblock
Test(IZEQ(REST(numero_du_centre_du_carre,diviseur_courant)))
Bblock
INCR(nombre_de_diviseurs_du_point_courant,I);
/* Et on compte les diviseurs du nombre courant (y compris l'unite et ce */
/* nombre lui-meme...). */
Eblock
ATes
Bblock
Eblock
ETes
Eblock
EDoI
Test(IFGE(NIVA(nombre_de_diviseurs_du_point_courant),BLANC))
Bblock
PRINT_ATTENTION("il y a des points qui ont au moins 'BLANC' diviseurs");
Eblock
ATes
Bblock
Eblock
ETes
Eblock
ATes
Bblock
Eblock
ETes
store_point_valide(COND(IL_FAUT(visualiser_le_nombre_de_diviseurs)
,GENP(TRNP(NIVA(nombre_de_diviseurs_du_point_courant)))
,GENP(NIVA(niveau_de_la_recursivite))
)
,imageR
,ASD1(centre_du_carre,x),ASD1(centre_du_carre,y)
,FVARIABLE
);
/* Et on le marque avec le niveau de recursivite courant */
/* a condition de ne pas ecraser un point anterieur. */
Eblock
ATes
Bblock
Eblock
ETes
Test(IFET(IFLT(niveau_de_la_recursivite,profondeur_maximale_de_la_recursivite)
,IFET(IFGT(SOUA(ASD1(coin_haut_droite,x),ASD1(coin_bas_gauche,x)),pasX)
,IFGT(SOUA(ASD1(coin_haut_droite,y),ASD1(coin_bas_gauche,y)),pasY)
)
)
)
Bblock
/* On ne procede au decoupage recursif que si cela est possible (il ne */
/* se reduit pas a un point) et demande : */
/* */
/* Y_haut_droite |---------------| */
/* | | | */
/* | CHG | CHD | */
/* | | | */
/* |-------|-------| */
/* | | | */
/* | CBG | CBD | */
/* | | | */
/* Y_bas_gauche |---------------| */
/* X_bas_gauche X_haut_droite */
/* */
/* "C" signifie "carre", */
/* "B" signifie "bas", "H" signifie "haut", */
/* "G" signifie "gauche", "D" signifie "droite". */
DEFINITION_D_UN_CARRE(ASD1(centre_du_carre,x),ASD1(centre_du_carre,y),ASD1(coin_haut_droite,x),ASD1(coin_haut_droite,y));
/* Definition du sous-carre haut-droite, */
DECOUPAGE_RECURSIF_D_UN_CARRE;
/* Et decoupage recursif... */
DEFINITION_D_UN_CARRE(ASD1(coin_bas_gauche,x),ASD1(centre_du_carre,y),ASD1(centre_du_carre,x),ASD1(coin_haut_droite,y));
/* Definition du sous-carre haut-gauche, */
DECOUPAGE_RECURSIF_D_UN_CARRE;
/* Et decoupage recursif... */
DEFINITION_D_UN_CARRE(ASD1(coin_bas_gauche,x),ASD1(coin_bas_gauche,y),ASD1(centre_du_carre,x),ASD1(centre_du_carre,y));
/* Definition du sous-carre bas-gauche, */
DECOUPAGE_RECURSIF_D_UN_CARRE;
/* Et decoupage recursif... */
DEFINITION_D_UN_CARRE(ASD1(centre_du_carre,x),ASD1(coin_bas_gauche,y),ASD1(coin_haut_droite,x),ASD1(centre_du_carre,y));
/* Definition du sous-carre haut-droite, */
DECOUPAGE_RECURSIF_D_UN_CARRE;
/* Et decoupage recursif... */
Eblock
ATes
Bblock
Eblock
ETes
RETI(imageR);
Eblock
EFonctionP
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* P A R C O U R S R E C U R S I F P A R S U B D I V I S I O N D ' U N E I M A G E : */
/* */
/*************************************************************************************************************************************/
BFonctionP
DEFV(Common,DEFV(FonctionP,POINTERp(Isubdivision_recursive(imageR
,profondeur_maximale_de_la_recursivite
,visualiser_le_nombre_de_diviseurs
)
)
)
)
DEFV(Argument,DEFV(image,imageR));
/* Image Resultat, telle que : imageR[X][Y]=profondeur de la recursion. */
DEFV(Argument,DEFV(Positive,profondeur_maximale_de_la_recursivite));
/* Profondeur d'arret de la recursivite ; avec 'INFINI', on est sur */
/* d'aller jusqu'au bout... */
DEFV(Argument,DEFV(Logical,visualiser_le_nombre_de_diviseurs));
/* Cet indicateur precise si l'on visualise le niveau de recursivite ('FAUX'), */
/* ou le nombre de diviseurs du numero de chaque point ('VRAI'). */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
DEFV(pointI_2D,coin_bas_gauche_reduit);
/* Coin bas gauche de l'image, */
DEFV(pointI_2D,coin_haut_droite_reduit);
/* Coin haut droite de l'image. */
DEFV(Positive,INIT(niveau_de_la_recursivite,AVANT_PREMIER_NIVEAU_DE_RECURSIVITE));
/* Donne le niveau courant de la recursivite de decoupage. */
DEFV(Positive,DTb1(population_courante_des_niveaux,NOMBRE_DE_NIVEAUX_DE_RECURSIVITE));
/* Pour chaque niveau de recursivite, on trouve dans ce vecteur sa population, */
/* c'est-a-dire le nombre de points qui y sont presents. */
DEFV(Int,INIT(index_de_recursivite,UNDEF));
/* Index d'initialisation du vecteur de population des niveaux... */
DEFV(Positive,DTb1(population_maximale_inferieure,NOMBRE_DE_NIVEAUX_DE_RECURSIVITE));
/* Pour chaque niveau de recursivite, on trouve dans ce vecteur la population */
/* maximale cumulee des niveaux de recursivite inferieurs. */
DEFV(Int,INIT(index_de_cumul,UNDEF));
/* Index d'initialisation du vecteur de population des niveaux inferieurs... */
/*..............................................................................................................................*/
Test(IFET(IL_FAUT(visualiser_le_nombre_de_diviseurs)
,IFGE(NIVEAU_DE_PREMARQUAGE_DES_COLLISIONS,NIVA(PREMIER_NOMBRE_ENTIER))
)
)
Bblock
PRINT_ATTENTION("on ne pourra faire la difference entre les points marques et les points non marques");
Eblock
ATes
Bblock
Eblock
ETes
Test(IFNE(dimX,dimY))
Bblock
PRINT_ATTENTION("les dimensions horizontales et verticales devraient etre egales");
Eblock
ATes
Bblock
Eblock
ETes
Test(IFGE(NIVEAU_DE_PREMARQUAGE_DES_COLLISIONS,NIVA(PREMIER_NIVEAU_DE_RECURSIVITE)))
Bblock
PRINT_ATTENTION("on ne pourra faire la difference entre les points marques et les points non marques");
Eblock
ATes
Bblock
Eblock
ETes
DoIn(index_de_recursivite
,PREMIER_NIVEAU_DE_RECURSIVITE
,LSTX(PREMIER_NIVEAU_DE_RECURSIVITE,NOMBRE_DE_NIVEAUX_DE_RECURSIVITE)
,I
)
Bblock
CLIR(ITb1(population_courante_des_niveaux,INDX(index_de_recursivite,PREMIER_NIVEAU_DE_RECURSIVITE)));
/* Initialisation de la population de chaque niveau de recursivite, */
CLIR(ITb1(population_maximale_inferieure,INDX(index_de_recursivite,PREMIER_NIVEAU_DE_RECURSIVITE)));
/* Et de la population cumulee des niveaux inferieurs... */
Test(IFGT(index_de_recursivite,PREMIER_NIVEAU_DE_RECURSIVITE))
Bblock
DoIn(index_de_cumul
,PREMIER_NIVEAU_DE_RECURSIVITE
,LSTX(PREMIER_NIVEAU_DE_RECURSIVITE,PRED(index_de_recursivite))
,I
)
Bblock
EGAL(ITb1(population_maximale_inferieure
,INDX(index_de_recursivite,PREMIER_NIVEAU_DE_RECURSIVITE)
)
,HORNER_1_01(ITb1(population_maximale_inferieure
,INDX(index_de_recursivite,PREMIER_NIVEAU_DE_RECURSIVITE)
)
,INTE(PUIX(NOMBRE_DE_SOMMETS_D_UN_CARRE,UN))
,INTE(PUIX(NOMBRE_DE_SOMMETS_D_UN_CARRE,ZERO))
)
);
/* Comptage de la population des niveaux pleins inferieurs (d'ou le 'PRED'). */
/* On notera que ce comptage se fait avec la formule de Horner, c'est-a-dire */
/* de la facon suivante ('N' etant le nombre de sommets d'un carre) : */
/* */
/* n n-1 2 1 0 */
/* N + N +...+ N + N + N = N.(N.(...N.(N+1)...)+1)+1, */
/* */
/* avec : */
/* */
/* 1 0 */
/* N = N, et N = 1. */
/* */
Eblock
EDoI
Eblock
ATes
Bblock
Eblock
ETes
Eblock
EDoI
Test(IFNE(ADD2(ITb1(population_maximale_inferieure,INDX(PREMIER_NIVEAU_DE_RECURSIVITE,PREMIER_NIVEAU_DE_RECURSIVITE))
,ADD2(ITb1(population_courante_des_niveaux,INDX(PREMIER_NIVEAU_DE_RECURSIVITE,PREMIER_NIVEAU_DE_RECURSIVITE))
,I
)
)
,PREMIER_NOMBRE_ENTIER
)
)
Bblock
PRINT_ATTENTION("le cardinal du premier niveau de recursivite est mauvais");
Eblock
ATes
Bblock
Eblock
ETes
CALS(Iinitialisation(imageR,NIVEAU_DE_PREMARQUAGE_DES_COLLISIONS));
/* Indiquons qu'aucun point n'a encore ete atteint. */
DEFINITION_D_UN_CARRE(Xmin,Ymin,Xmax,Ymax);
/* Definition du carre correspondant a l'image entiere... */
DECOUPAGE_RECURSIF_D_UN_CARRE;
/* Et decoupage recursif... */
RETI(imageR);
Eblock
EFonctionP
#undef DECOUPAGE_RECURSIF_D_UN_CARRE
#undef DEFINITION_D_UN_CARRE
#undef NOMBRE_DE_SOMMETS_D_UN_CARRE
#undef NIVEAU_DE_PREMARQUAGE_DES_COLLISIONS
#undef NOMBRE_DE_NIVEAUX_DE_RECURSIVITE
#undef PREMIER_NIVEAU_DE_RECURSIVITE
#undef AVANT_PREMIER_NIVEAU_DE_RECURSIVITE
#undef NOMBRE_DE_NOMBRES_A_TESTER
#undef PREMIER_NOMBRE_ENTIER
_______________________________________________________________________________________________________________________________________
_______________________________________________________________________________________________________________________________________
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* S U I T E D E S Y R A C U S E : */
/* */
/*************************************************************************************************************************************/
BFonctionF
DEFV(Common,DEFV(Int,SINT(IFsuite_de_Syracuse_____nombre_maximal_d_iterations,MILLE)));
DEFV(Common,DEFV(Int,SINT(IFsuite_de_Syracuse_____premier_nombre_entier,UN)));
DEFV(Common,DEFV(Int,SINT(IFsuite_de_Syracuse_____valeur_d_arret,UN)));
/* Le 20130124115145 la valeur d'arret est passee de 'QUATRE' a 'UN' plus logique... */
DEFV(Common,DEFV(Int,SINT(IFsuite_de_Syracuse_____rang_initial_d_apparition_de_la_valeur_d_arret,ZERO)));
DEFV(Common,DEFV(Int,SINT(IFsuite_de_Syracuse_____diviseur,DEUX)));
DEFV(Common,DEFV(Int,SINT(IFsuite_de_Syracuse_____alpha___,TROIS)));
DEFV(Common,DEFV(Int,SINT(IFsuite_de_Syracuse_____beta____,UN)));
/* Parametres definissant par defaut la suite de Syracuse... */
DEFV(Common,DEFV(Logical,SINT(IFsuite_de_Syracuse_____editer_les_rangs,FAUX)));
DEFV(Common,DEFV(Int,SINT(IFsuite_de_Syracuse_____premier_rang_d_edition,FLOT__BLANC)));
/* Parametres definissant par defaut l'edition eventuelle des differents rangs (introduit */
/* le 20110306091524). */
#define NOMBRE_DE_NOMBRES_A_TESTER \
QUOE(ADD2(dimXY,DOUB(ADD2(dimX,dimY))),MUL2(pasX,pasY)) \
/* Ainsi, on ajoute une "bordure" autour de l'image compensant le fait que si */ \
/* l'on prend juste 'dimXY', etant donne la position de (Xcentre,Ycentre), on */ \
/* risque de laisser deux cotes de l'image incomplets... */
DEFV(Common,DEFV(FonctionF,POINTERF(IFsuite_de_Syracuse(imageR,dernier_nombre_a_tester,pas_entre_les_nombres))))
/* Fonction introduite le 20110305113822. Le 20110306091524, elle est passee de 'FonctionP' */
/* a 'FonctionF' pour supprimer les problemes de debordement... */
DEFV(Argument,DEFV(imageF,imageR));
/* Image Resultat, telle que : imageR[X][Y]=nombre de diviseurs du nombre valant */
/* le rang du point {X,Y} sur une spirale carree centree. */
DEFV(Argument,DEFV(Positive,dernier_nombre_a_tester));
/* Dernier nombre entier que l'on testera, */
DEFV(Argument,DEFV(Int,pas_entre_les_nombres));
/* Et pas de passage d'un nombre entier au suivant... */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
DEFV(Int,INIT(nombre_entier_courant,UNDEF));
/* Numero du point courant dans [premier_nombre_entier,dernier_nombre_a_tester]. */
DEFV(pointI_2D,point_courant);
/* Point (entier) courant. */
SPIRALE_DEFINITION
/* Donnees de generation d'une spirale de parcours d'une image. */
/*..............................................................................................................................*/
Test(IFGE(FLOT__NOIR,IFsuite_de_Syracuse_____premier_nombre_entier))
Bblock
PRINT_ATTENTION("on ne pourra faire la difference entre les points marques et les points non marques");
Eblock
ATes
Bblock
Eblock
ETes
Test(IZLE(pas_entre_les_nombres))
Bblock
PRINT_ERREUR("le pas de passage d'un nombre entier au suivant doit etre strictement positif");
Eblock
ATes
Bblock
Eblock
ETes
SPIRALE_VALIDATION;
/* Validation des pas de parcours (pasX,pasY) des images. */
INITIALISATION_POINT_2D(point_courant,Xcentre,Ycentre);
/* Et on se place au centre de l'image. */
CALS(IFinitialisation(imageR,FLOT__NOIR));
/* Au cas ou l'on ne balayerait pas toute l'image... */
DoIn(nombre_entier_courant
,IFsuite_de_Syracuse_____premier_nombre_entier
,TRON(dernier_nombre_a_tester
,IFsuite_de_Syracuse_____premier_nombre_entier
,MUL2(NOMBRE_DE_NOMBRES_A_TESTER,pas_entre_les_nombres)
)
,pas_entre_les_nombres
)
Bblock
DEFV(Logical,INIT(iterer,VRAI));
DEFV(Int,INIT(nombre_d_iterations,ZERO));
/* Controle des iterations sachant que l'on s'arrete sur le premier 4 rencontre ou bien si */
/* le nombre d'iterations maximal est atteint... */
DEFV(Float,INIT(U_n,nombre_entier_courant));
/* Definition de U(n) passe de 'Int' a 'Float' le 20110306101744 pour avoir plus de */
/* capacite. Cela s'est vu, par exemple, avec : */
/* */
/* $xci/valeurs_Syra$X un=258207 */
/* */
/* pour lequel apparaissent rapidement des valeurs negatives... */
DEFV(Int,INIT(rang_d_apparition_de_la_valeur_d_arret
,IFsuite_de_Syracuse_____rang_initial_d_apparition_de_la_valeur_d_arret
)
);
DEFV(Logical,INIT(on_a_rencontre_la_valeur_d_arret,FAUX));
/* Afin de savoir a partir de quand apparait {4,2,1} ? */
Tant(IL_FAUT(iterer))
Bblock
Test(EST_FAUX(on_a_rencontre_la_valeur_d_arret))
Bblock
Test(IFEQ(U_n,FLOT(IFsuite_de_Syracuse_____valeur_d_arret)))
Bblock
EGAL(on_a_rencontre_la_valeur_d_arret,VRAI);
EGAL(iterer,FAUX);
/* C'est termine... */
Eblock
ATes
Bblock
INCR(rang_d_apparition_de_la_valeur_d_arret,I);
Eblock
ETes
Eblock
ATes
Bblock
Eblock
ETes
EGAL(U_n
,COND(fEST_PAIR(U_n)
,DIVI(U_n,FLOT(IFsuite_de_Syracuse_____diviseur))
,AXPB(FLOT(IFsuite_de_Syracuse_____alpha___),U_n,FLOT(IFsuite_de_Syracuse_____beta____))
)
);
/* Calcul de la suite de Syracuse "generalisee" : */
/* */
/* U = U / D si U est pair, */
/* n n-1 n-1 */
/* */
/* U = A * U + B si U est impair, */
/* n n-1 n-1 */
/* */
/* avec : */
/* */
/* D = diviseur = 2 */
/* A = alpha = 3 */
/* B = beta = 1 */
/* */
/* et : */
/* */
/* U = 1 */
/* 0 */
/* */
/* par defaut. */
/* */
/* La conjecture enonce que quel que soit 'U(0)' de depart, a un moment apparait de facon */
/* periodique (et alors jusqu'a la fin des temps...) la suite {4,2,1}... */
/* */
/* Le 20110307091820 je note le danger dans l'ecriture : */
/* */
/* EST_PAIR(INTE(U_n)) */
/* */
/* car, en effet, le 'INTE(...)' ne donne pas la partie entiere de 'U_n' dans le cas ou */
/* 'U_n' est trop grand. Mais que faire d'autre ? Le probleme fut resolu le 20110308090607 */
/* par l'introduction de 'fEST_PAIR(...)'. */
INCR(nombre_d_iterations,I);
Test(IFGE(nombre_d_iterations,IFsuite_de_Syracuse_____nombre_maximal_d_iterations))
Bblock
EGAL(iterer,FAUX);
/* On a fait trop d'iterations : on arrete... */
Eblock
ATes
Bblock
Eblock
ETes
Eblock
ETan
Test(EST_FAUX(on_a_rencontre_la_valeur_d_arret))
/* Test essentiel introduit le 20130124080515... */
Bblock
PRINT_ATTENTION("la valeur d'arret n'a pas ete atteinte");
CAL1(Prer2("(U0=%d avec %d iterations au maximum)\n"
,nombre_entier_courant
,IFsuite_de_Syracuse_____nombre_maximal_d_iterations
)
);
Eblock
ATes
Bblock
Eblock
ETes
Test(IL_FAUT(IFsuite_de_Syracuse_____editer_les_rangs))
Bblock
Test(IFGE(rang_d_apparition_de_la_valeur_d_arret,IFsuite_de_Syracuse_____premier_rang_d_edition))
Bblock
CAL3(Prme2("Rang(%d)[/%d]"
,nombre_entier_courant
,IFsuite_de_Syracuse_____rang_initial_d_apparition_de_la_valeur_d_arret
)
);
Test(EST_VRAI(on_a_rencontre_la_valeur_d_arret))
Bblock
CALS(FPrme0("="));
Eblock
ATes
Bblock
CALS(FPrme0(">"));
Eblock
ETes
CAL3(Prme1("%d\n",rang_d_apparition_de_la_valeur_d_arret));
Eblock
ATes
Bblock
Eblock
ETes
Eblock
ATes
Bblock
Eblock
ETes
storeF_point_valide(FLOT(rang_d_apparition_de_la_valeur_d_arret)
,imageR
,ASD1(point_courant,x),ASD1(point_courant,y)
);
/* Et on marque le point courant avec le nombre de diviseurs de son rang... */
/* */
/* ATTENTION : le point marque est correct, c'est 'point_courant', et non pas {X,Y} ce qui */
/* serait incorrect. On notera que dans le cas d'une image non carree (de type 'Pal', par */
/* exemple), il y aura donc des bandes 'NOIR' dans l'image... */
SPIRALE_INITIALISATION;
/* Initialisation dynamique de 'spirale_nombre_de_points_a_traiter'. */
SPIRALE_DEPLACEMENT(ASD1(point_courant,x),ASD1(point_courant,y));
/* Deplacement du point courant de la spirale... */
/* ATTENTION : on n'utilise pas 'SPIRALE_DEPLACEMENT_ET_PARCOURS(...)' afin de garantir le */
/* traitement de tous les points de l'image... */
SPIRALE_PARCOURS;
/* Parcours de la spirale avec rotation eventuelle de PI/2 du bras courant... */
Eblock
EDoI
RETIF(imageR);
Eblock
EFonctionF
#undef NOMBRE_DE_NOMBRES_A_TESTER
_______________________________________________________________________________________________________________________________________
_______________________________________________________________________________________________________________________________________
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* R E C H E R C H E D U " PGCD " D E D E U X N O M B R E S : */
/* */
/*************************************************************************************************************************************/
BFonctionI
DEFV(Common,DEFV(Logical,ZINT(PlusGrandCommunDiviseur_____compatibilite_20250128,FAUX)));
/* Introduit le 20250128083957 afin de permettre de retablir le comportement anterieur... */
DEFV(Common,DEFV(FonctionI,PlusGrandCommunDiviseur(nombre_A,nombre_B)))
/* Fonction introduite le 20081116084109... */
DEFV(Argument,DEFV(Int,nombre_A));
DEFV(Argument,DEFV(Int,nombre_B));
/* Nombres dont on cherche le "PGCD"... */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
DEFV(Logical,INIT(iterer_le_calcul,VRAI));
/* Pour controler le 'Tant(...)' qui va suivre... */
DEFV(Int,INIT(nombre_A_effectif,UNDEF));
DEFV(Int,INIT(nombre_B_effectif,UNDEF));
/* Extrema des deux nombres 'A' et 'B'... */
DEFV(Int,INIT(minimum,UNDEF));
DEFV(Int,INIT(maximum,UNDEF));
/* Extrema des deux nombres 'A' et 'B'... */
DEFV(Int,INIT(PGCD_des_nombres_A_et_B,UNDEF));
/* "PGCD" des deux nombres 'A' et 'B'... */
/*..............................................................................................................................*/
EGAL(nombre_A_effectif,COND(IL_FAUT(PlusGrandCommunDiviseur_____compatibilite_20250128),NEUT(nombre_A),ABSO(nombre_A)));
EGAL(nombre_B_effectif,COND(IL_FAUT(PlusGrandCommunDiviseur_____compatibilite_20250128),NEUT(nombre_B),ABSO(nombre_B)));
/* Reformatage des deux nombres 'A' et 'B'... */
EGAL(minimum,MIN2(nombre_A_effectif,nombre_B_effectif));
EGAL(maximum,MAX2(nombre_A_effectif,nombre_B_effectif));
/* Extrema des deux nombres 'A' et 'B'... */
Test(IZNE(minimum))
Bblock
Tant(IL_FAUT(iterer_le_calcul))
Bblock
DEFV(Int,INIT(reste,REST(maximum,minimum)));
/* Division euclidienne du plus grand nombre par le plus petit... */
Test(IZNE(reste))
Bblock
EGAL(maximum,minimum);
EGAL(minimum,reste);
Eblock
ATes
Bblock
EGAL(PGCD_des_nombres_A_et_B,minimum);
EGAL(iterer_le_calcul,FAUX);
Eblock
ETes
Eblock
ETan
Eblock
ATes
Bblock
EGAL(PGCD_des_nombres_A_et_B,maximum);
Eblock
ETes
RETU(PGCD_des_nombres_A_et_B);
Eblock
EFonctionI
/*===================================================================================================================================*/
/*************************************************************************************************************************************/
/* */
/* R E C H E R C H E D U " PPCM " D E D E U X N O M B R E S : */
/* */
/*************************************************************************************************************************************/
BFonctionI
DEFV(Common,DEFV(FonctionI,PlusPetitCommunMultiple(nombre_A,nombre_B)))
/* Fonction introduite le 20081116084109... */
DEFV(Argument,DEFV(Int,nombre_A));
DEFV(Argument,DEFV(Int,nombre_B));
/* Nombres dont on cherche le "PPCM"... */
/*-----------------------------------------------------------------------------------------------------------------------------------*/
Bblock
DEFV(Float,INIT(produit_des_nombres_A_et_B,MUL2(FLOT(nombre_A),FLOT(nombre_B))));
DEFV(Int,INIT(PGCD_des_nombres_A_et_B,PGCD(nombre_A,nombre_B)));
DEFV(Int,INIT(PPCM_des_nombres_A_et_B,UNDEF));
/* "PGCD" et "PPCM" des deux nombres 'A' et 'B'... */
/* */
/* Le 20081212094335, le 'Int' a ete remplace par un 'Float' en ce qui concerne le produit */
/* des deux nombres A et B afin d'augmenter la capacite de cette fonction... */
/*..............................................................................................................................*/
Test(IZNE(produit_des_nombres_A_et_B))
Bblock
EGAL(PPCM_des_nombres_A_et_B,INTE(DIVI(produit_des_nombres_A_et_B,FLOT(PGCD_des_nombres_A_et_B))));
/* En effet : */
/* */
/* PGCD(A,B)xPPCM(A,B) = AxB */
/* */
Test(IFEQ(MUL2(FLOT(PPCM_des_nombres_A_et_B),FLOT(PGCD_des_nombres_A_et_B))
,produit_des_nombres_A_et_B
)
)
/* Le 20081212094335, le test : */
/* */
/* Test(IZEQ(REST(produit_des_nombres_A_et_B,PGCD_des_nombres_A_et_B))) */
/* */
/* a ete remplace par ce qui precede lors du passage de 'Int' a 'Float' pour le produit */
/* de 'A' et de 'B'... */
Bblock
Eblock
ATes
Bblock
begin_nouveau_block
Bblock
DEFV(CHAR,INIC(POINTERc(format_EGAq____PlusPetitCommunMultiple)
,chain_Aconcaten3("le produit des deux nombres n'est pas divisible par leur 'PGCD'"
," (la capacite des 'Int's ne serait-elle pas insuffisante "
,"?)"
)
)
);
PRINT_ERREUR(format_EGAq____PlusPetitCommunMultiple);
/* Le 'chain_Aconcaten3(...)' est destine uniquement a faire apparaitre correctement */
/* l'espace qui precede le point d'interrogation (" ?")... */
CALZ_FreCC(format_EGAq____PlusPetitCommunMultiple);
Eblock
end_nouveau_block
CAL1(Prer3("(PGCD(%d,%d)=%d)\n",nombre_A,nombre_B,PGCD_des_nombres_A_et_B));
Eblock
ETes
Eblock
ATes
Bblock
EGAL(PPCM_des_nombres_A_et_B,produit_des_nombres_A_et_B);
Eblock
ETes
RETU(PPCM_des_nombres_A_et_B);
Eblock
EFonctionI
_______________________________________________________________________________________________________________________________________
Copyright © Jean-François COLONNA, 2019-2025.
Copyright © CMAP (Centre de Mathématiques APpliquées) UMR CNRS 7641 / École polytechnique, Institut Polytechnique de Paris, 2019-2025.