Recherche et décomposition en facteur premier de 1 à 2^64-1

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Répondre
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Recherche et décomposition en facteur premier de 1 à 2^64-1

Message par PAPIPP »

Bonjour à tous

Voici les 2 prg qui explorent la zone de 1 à 2^64-1 en considérant tout nombre comme un nombre entier positif. En effet la Zone de 2^63 à 2^64-1 en PB est signée et les nombres sont vus comme des valeurs négatives.

1) Le premier décompose un nombre en facteur premiers avec de part et d’autre une zone de recherche.
2) Le deuxième recherche les nombres premiers dans une fenêtre.(résultats en printn(...) à la suite

On peut fournir le nombre de base de 3 façons différentes
Respecter les 3 formats possibles "
1) $0FFFFFFFF00000 valeur de $1 à $FFFFFFFFFFFFFFFE
2) 1897654390 valeur de 1 à 2^64-1 donc de 1 à 18446744073709551614
3) 45E10 valeur de 1E0 à 1844.6744073709551614E16

Avant de lancer l’un des 2 prg il faut créer la table des différences dans le même répertoire.
Utilisez si possible la table des différences de p_fact(23) qui donne un meilleur temps de recherche.
Pour vérifier l’amélioration du temps d’exécution créez plusieurs tables différentes.
Celle qui demande le plus de temps à créer est la table de p_fact(23) proche de 3mn
Les autres tables ne demandent que quelques secondes. Par exemple Table p-fact(19)<10 secondes
Ces tables ne sont à créer qu’une seule fois

Placez les 4 prg dans le même répertoire.

Premier prg création des tables des différences

Code : Tout sélectionner

; exemple des p_fact(x)
; p_fact(x)--modulo-----------------Nb_occurrences des différences--------Taux-----------Gain
; 3__________6__________________________2_________________________________0,3333_________66,66%
; 5__________30_________________________8_________________________________0,2666_________73,33%
; 7__________210________________________48________________________________0,2285_________77,14%
; 11_________2310_______________________480_______________________________0,2078_________79,22%
; 13_________30030______________________5760______________________________0,1918_________80,81%
; 17_________510510 ____________________92160_____________________________0,18052________81,94%
; 19_________9699690____________________1658880___________________________0,17102________82,89%
; 23_________223092870__________________36495360__________________________0,16358________83,64%

 Macro _q_t_
 		"
 EndMacro
 Macro _n (__n)
 _q_t_#__n#=_q_t_+Str(__n)+" "
 EndMacro
 Macro _Q (__Q)
 _q_t_#__Q#=_q_t_+Str(__Q)+" "
 EndMacro
EnableExplicit

OpenConsole("Résultats partiel")
Dim T_MODULO.l(12)
Structure colonne
;   nb.q
	prem.a
; 	dif_prec.l
	dif_prec.a

; 	Dif_act.l
EndStructure
Structure DIVIS
  NBPFACT.a
  PREMDIV.l
  NBSEQ.l
  MODULO.q
  ;   Array TDIF.a(40000000)  ;; *** ATTENTION   A utiliser avec DATA.A et read.A  mais très lent avec p_fact(23) P_fact(19) est préférable remplacer 40 par 2
  Array TDIF.a(40000000)  
EndStructure
define SEQD.DIVIS,mess$,nb$,nbs,rest.l,i,modulo,elem,NBprem,Tdep.q,inb,inbp,prem_p,PREM_NB_PREM_AV,NB_PREM,SOM_DIF,vecteur$,NBSEQ,lvecteur,rapportq.d,RAPPORT.D
define ADRDSEQ.q,AdresdebF.q,AdresFinF.q,Adresdeb.q,delta

; **************** Réalisation du vecteur modulo npp à partir d'une table des nombres premiers des 100 premiers nombres *********
;***** Choix du premier Nb premier pour lequel le vecteur modulo sera appliqué.
;***** pour éviter la génération d'un vesteur trop important nous limiterons ce choix aux 23 premiers nombres premiers soit :2 3 5 7 11 13 17 19 23 29 31
;***** Recherche du modulo < 2*3*5*7*11=2310 éléments du vecteur
SAISIE0:
mess$+"Filtre de réduction des diviseurs"
If Len(mess$)>120
	MessageRequester("Erreur","Colonne Div max 2 3 5 7 11 13 17 19 23"+#CR$+"Relancez le prg") ;
	End
EndIf
nb$=InputRequester(mess$,"Colonne Div max 2 3 5 7 11 13 17 19 23","5") ;
If val(nb$)>23
  goto SAISIE0
EndIf
nbs=Val(nb$)
If nbs<1 Or nbs>31
	Goto SAISIE0
EndIf
rest.l=nbs%30
If rest=2 Or rest=3 Or rest=5 Or rest=7 Or rest=11 Or rest=13 Or rest=17 Or rest=19 Or rest=23
Else
  Goto SAISIE0
EndIf 
; NBPFACT=NBS
; FINSAISIE0:
Restore lab_pnbp
i=0
Modulo=1
Repeat
	Read.l ELEM
	If ELEM<>0
		T_modulo(I)=elem
		Modulo*elem
		i+1
	EndIf
Until ELEM=0 Or ELEM=>nbs
redim SEQD\TDIF(Modulo+10)
SEQD\MODULO=MODULO 
SEQD\NBPFACT=nbs
NBprem=i-1
nbs=ELEM
Dim tcol.colonne(SEQD\MODULO+2)
;*** Recherche des colonnes ayant des nb premiers ***
tcol(0)\prem=2
tcol(1)\prem=2
Tdep.q=ElapsedMilliseconds()
For inb=2 To modulo+1
	For inbp=0 To nbprem
		If inb%t_modulo(inbp)=0
			tcol(inb)\prem=2
		EndIf
	Next
Next
prem_p=0
PREM_NB_PREM_AV=0
NB_PREM=0
SOM_DIF=0
vecteur$="DIV_"+Str(nbs)+":"+#CRLF$
;****** Recherche des différence entre NB premiers *****
If CreateFile(0,"DIVA_"+Str(nbs)+".PB")         ; création d'un nouveau fichier texte...
  NBSEQ=0
  For inb=2 To modulo+1
;     tcol(inb)\nb=inb
		If tcol(inb)\prem=0 And inb>nbs
			If prem_p=0
				prem_p=inb
				PREM_NB_PREM_AV=inb
				vecteur$+"DATA.A  "+Str(inb)+","
				SEQD\PREMDIV=inb
				NBSEQ+1
			Else
				NB_PREM+1
				If nb_prem%101=0
				  If nb_prem%201=0
				    PrintN(_n(NB_prem)+_n(prem_p)+_n(tcol(inb)\dif_prec)+_n(som_dif)+_n(ElapsedMilliseconds()-Tdep)+_n(lvecteur))
					EndIf
					If nb_prem%5=0  ; ici tous les =101*x  c'est avec 5 que l'on obtient le meilleur résultat
					  vecteur$+Str(inb-prem_p)+#CRLF$
; 					  SEQD\TDIF(NBSEQ-1)=inb-prem_p
					  SEQD\TDIF(NBSEQ)=inb-prem_p

					  NBSEQ+1
						lvecteur=Len(vecteur$)
						WriteString(0,vecteur$) ;
						vecteur$="Data.A "
					Else
					  vecteur$+Str(inb-prem_p)+#CRLF$+"Data.A "
; 					  SEQD\TDIF(NBSEQ-1)=inb-prem_p
					  SEQD\TDIF(NBSEQ)=inb-prem_p

					  NBSEQ+1
					EndIf
					
					tcol(inb)\dif_prec=inb-prem_p
					SOM_DIF+(inb-prem_p)
; 					tcol(prem_p)\Dif_act=inb-prem_p
					prem_p=inb
				Else
					tcol(inb)\dif_prec=inb-prem_p
					vecteur$+Str(inb-prem_p)+","
; 					SEQD\TDIF(NBSEQ-1)=inb-prem_p
					SEQD\TDIF(NBSEQ)=inb-prem_p
					NBSEQ+1
					SOM_DIF+(inb-prem_p)
; 					tcol(prem_p)\Dif_act=inb-prem_p
					prem_p=inb
				EndIf
			EndIf
		EndIf
	Next
	;  tcol(modulo+2)\dif_prec=nb_prem+modulo-(modulo+1)
	NB_PREM+1
	tcol(modulo+2)\dif_prec=PREM_NB_PREM_AV-1
	SEQD\TDIF(NBSEQ)=PREM_NB_PREM_AV-1
	SEQD\TDIF(0)=PREM_NB_PREM_AV-1
	SEQD\NBSEQ=NBSEQ
	redim SEQD\TDIF(NBSEQ+2)

; 	tcol(1)\Dif_act=PREM_NB_PREM_AV-1
; 	tcol(1)\nb=1
	SOM_DIF+(PREM_NB_PREM_AV-1)
	rapportq.d=100.0*(modulo-Nb_prem)/modulo
	vecteur$+Str(PREM_NB_PREM_AV-1)+",0 ;"+#CRLF$+";; Modulo="+Str(modulo)+" Nb Elements dans vecteur="+Str(NB_prem)+"  NBPFACT="+str(SEQD\NBPFACT)+" Nb sequences="+str(NBSEQ)+"  GAin="+Str(rapportq)+"%"
	
	WriteString(0,vecteur$) ;
	CloseFile(0)            ; ferme le fichier précédemment ouvert et enregistre les données
	PrintN(_n(ElapsedMilliseconds()-Tdep))
	RAPPORT.D=modulo/NB_PREM
	MessageRequester("C'est tout bon","Somme des nb du vecteur="+_n(SOM_DIF)+#CRLF$+_n(modulo)+#CRLF$+"voir le fichier pour le détail du vecteur"+#CRLF$+"Fichier: "+GetCurrentDirectory()+"DIVA_"+Str(nbs)+".PB"+#CRLF$+"Nomnre d'éléments dans le vecteur="+Str(NB_PREM)+" Rapport="+StrD(RAPPORT))
Else
	MessageRequester("Information","Impossible de créer le fichier! DIVA_"+Str(nbs)+".PB")
EndIf
; Adresdeb.l=@SEQD\NBPFACTStructure DIVIS
;   NBPFACT.a
;   PREMDIV.l
;   NBSEQ.l
;   MODULO.q
;   ;   Array TDIF.a(40000000)  ;; *** ATTENTION   A utiliser avec DATA.A et read.A  mais très lent avec p_fact(23) P_fact(19) est préférable remplacer 40 par 2
;   Array TDIF.a(40000000)  
ADRDSEQ.q=@SEQD
AdresdebF.q=@SEQD\NBPFACT
AdresFinF.q=@SEQD\MODULO+sizeof(quad)
Adresdeb.q=@SEQD\TDIF(0)
delta=AdresFinF-AdresdebF
If CreateFile(1, "MEMA_"+Str(nbs)+".bin")
  WriteData(1,ADRDSEQ ,delta )
;   WriteData(1,Adresdebf , 17)
  WriteData(1,Adresdeb , SEQD\NBSEQ+1)
  closefile(1)
Else
  messagerequester("ATTENTION", "Fichier "+ "MEMA_"+Str(nbs)+".bin non créer")
endif

Input()
CloseConsole()

DataSection
	lab_pnbp:
	Data.l 2,3,5,7,11,13,17,19,23,29,31,0
EndDataSection

DataSection
  lab_pnbp2:
  Data.L   2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97
  Data.L  101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199
  Data.L  211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293
  Data.L  307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397
  Data.L  401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499
  Data.L  503,509,521,523,541,547,557,563,569,571,577,587,593,599
  Data.L  601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691
  Data.L  701,709,719,727,733,739,743,751,757,761,769,773,787,797
  Data.L  809,811,821,823,827,829,839,853,857,859,863,877,881,883,887
  Data.L  907,911,919,929,937,941,947,953,967,971,977,983,991,997,0
EndDataSection
; ***************** Ci dessous les Nombres premiers pour les 1000 premiers nombres
; 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97
; 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199
; 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293
; 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397
; 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499
; 503 509 521 523 541 547 557 563 569 571 577 587 593 599
; 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691
; 701 709 719 727 733 739 743 751 757 761 769 773 787 797
; 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887
; 907 911 919 929 937 941 947 953 967 971 977 983 991 997
Deuxième prg Essai_form.pbf

Code : Tout sélectionner

;
; This code is automatically generated by the FormDesigner.
; Manual modification is possible to adjust existing commands, but anything else will be dropped when the code is compiled.
; Event procedures needs to be put in another source file.
;

Global Window_0

Global ListIcon_0, Spin_0, String_0, Button_0, Frame_0, Frame_1, Frame_2, Text_0, Text_1, Text_2, Text_3, Text_4, Frame_3, Option_0, Option_2


Procedure OpenWindow_0(x = 0, y = 0, width = 1080, height = 700)
  Window_0 = OpenWindow(#PB_Any, x, y, width, height, "Decomposition en facteurs premiers", #PB_Window_SystemMenu)
  ListIcon_0 = ListIconGadget(#PB_Any, 20, 90, 1020, 590, "Nombre", 150)
  AddGadgetColumn(ListIcon_0, 1, "Contrôle", 150)
  AddGadgetColumn(ListIcon_0, 2, "Tps en ms", 70)
  AddGadgetColumn(ListIcon_0, 3, "Décomposition  en facteurs premiers", 700)
  Spin_0 = SpinGadget(#PB_Any, 920, 50, 50, 20, 0, 100, #PB_Spin_ReadOnly | #PB_Spin_Numeric)
  String_0 = StringGadget(#PB_Any, 750, 50, 160, 20, "$80123456789ABCDE")
  Button_0 = ButtonGadget(#PB_Any, 980, 50, 70, 20, "OK/FIN")
  Frame_0 = FrameGadget(#PB_Any, 30, 0, 1000, 20, " Donnez un nombre >1 et <$FFFFFFFFFFFFFFFE  en décimal en Hexa ou en format scientifique 2E10 et la zone à explorer + OU - entre 0 et 100")
  Frame_1 = TextGadget(#PB_Any, 45, 50, 275, 25, "Recherche manuelle du vecteur des différences")
  Frame_2 = TextGadget(#PB_Any, 45, 25, 275, 25, "Recherche automatique du vecteur des différences")
  Text_0 = TextGadget(#PB_Any, 340, 30, 110, 25, "")
  Text_1 = TextGadget(#PB_Any, 610, 30, 130, 25, "")
  Text_2 = TextGadget(#PB_Any, 340, 60, 110, 25, "")
  Text_3 = TextGadget(#PB_Any, 610, 60, 130, 25, "")
  Text_4 = TextGadget(#PB_Any, 460, 40, 130, 25, "")
  Frame_3 = TextGadget(#PB_Any, 750, 25, 270, 25, "Nombre à décomposer               Zone à explorer")
  Option_0 = OptionGadget(#PB_Any, 30, 30, 10, 10, "")
  SetGadgetState(Option_0, 1)
  Option_2 = OptionGadget(#PB_Any, 30, 55, 10, 10, "")
EndProcedure
Troisième prg Decomposition d'un nombre et de sa zone en facteurs premiers.

Code : Tout sélectionner

Macro _q_t_
 		"
 EndMacro
 Macro _n (__n)
 _q_t_#__n#=_q_t_+Str(__n)+" "
 EndMacro
 Macro _Q (__Q)
 _q_t_#__Q#=_q_t_+Str(__Q)+" "
 EndMacro
EnableExplicit
Macro _HHQ (_HHQ,_pr="$")
  _PR+RSet(Hex(PeekQ(@_HHQ),#PB_Quad),16,"0")
EndMacro

EnableExplicit
; DisableDebugger
; 2 3 5 7 11 13 17 19 23
GLOBAL DIM TABTERMIN.Q(4)
structure ldec 
  DIFF.l
  IND.l
endstructure
structure synchro 
  structureunion
    SYNCDEC.ldec
    SYNCALP.q
  EndStructureUnion 
  
EndStructure  
Structure DIVIS
  NBPFACT.a
  PREMDIV.l
  NBSEQ.l
  MODULO.q
  Array TDIF.a(37000000)  ;; *** ATTENTION   A utiliser avec DATA.A et read.A  
EndStructure
structure INFOTEMP
  NBASE$
  NBASE.Q
  NBASEHEX$
  NBASEDIFB.q
  NBASEIND.q
  NBASEDIFS.q
  NBASERAC.Q
  NBASEP.Q
  NBASEPHEX$
  NBASEPDIF.Q
  NBASEPIND.q
  NBASEPRAC.q
  
  NPLAGE$
  NPLAGE.Q
  NPLAGEHEX$
  
  NPLAGEMAX$    
  
  NBASEM$
  NBASEM.Q
  NBASEMHEX$
  NBASEMP.Q
  NBASEMPHEX$
  NBASEMIND.q
  NBASEMRAC.Q
  
  ;   FUTBASE$
  ;   FUTBASED.D
  ;   FUTBASE.q
  ;   FUTBASEHEX$
  ;   ;     FUTBASEP.Q
  ;   ;     FUTBASEPHEX$
  ;   FUTBASEIND.q
  ;   FUTBASERAC.Q
  
endstructure 
STRUCTURE INFOCALC
  NBASE$
  NBASE.Q
  NBASEHEX$
  NBASEDIFB.q
  NBASEIND.q
  NBASEDIFS.q
  NBASERAC.Q
  NBASEP.Q
  NBASEPHEX$
  NBASEPDIF.Q
  NBASEPIND.q
  NBASEPRAC.q
endstructure  
global INFOSAISIE.INFOTEMP

Global result$,rest,SEQD.DIVIS,delta_deb.q
; Global nbs.l,NBSEQ.l,SEQD.DIVIS,LIMIT$="7FFFFFFFFFFFFFFF",LIMITQ.Q=$7FFFFFFFFFFFFFFF,RACLIM.d=SQR(LIMITQ)

Define B2DIVIS.q,B2PAS,quotient.q,B1MIN.Q=1E12,pos, logB1MIN, logmax, rmes,B1MIN_DEP.Q,ZONEP.Q,presultat$,resultat$
Define MAX.Q=B1MIN+1E4,nbg$,nbd$,pose.l,t_ind.l,t_col.l,t_ind_dep.l,MAXMAXDIV.q,RAC2.Q,B1MINRAC2.Q,nbseqp,B2IND_MAXDIV,DIF_MAXDIV
Define ind_dep,DIFF,FLAGFIN,IND_NB,CENTM,B2DIVISM,B2INDDD, B2DIVIS$,B2MAXDIV.q,dep_time.q,cent,nbseq_1.q,P_MAXDIV.q,MAXHEX$
Define nb$,nb.q,l2nb.d,nbl2.q,DIVMAX.q,NBREC.q,DIVIS.q,i,ipas,fact_prem$,j,deb1.q,mess$,quotientp.q,iprem,indt,Restd.q,ind.l,pas,idivis,FICHIER$
Global nbs.l,NBSEQ.l,SEQD.DIVIS,LIMIT$="7FFFFFFFFFFFFFFF",LIMITQ.Q=$7FFFFFFFFFFFFFFF,RACLIM.d=SQR(LIMITQ),ecart_MAX.l=10
Dim Tab.q(65) ;;; max = pow(2,64)-1 donc 64 éléments au max
Define *Tab=@Tab(), ADRDSEQ.q,AdresdebF.q,AdresFinF.q,Adresdeb.q,delta,DIVMAXD.d,flag00,NB_DEB.q
; 2 3 5 7 11 13 17 19 23
Dim Nbprem(10)
Nbprem(0)=2:Nbprem(1)=3:Nbprem(2)=5:Nbprem(3)=7:Nbprem(4)=11:Nbprem(5)=13:Nbprem(6)=17:Nbprem(7)=19:Nbprem(8)=23:Nbprem(9)=29
OpenConsole()

procedure CHARGE_SEQD(FICHIER$)
  EnableExplicit
  protected deb00.q , ADRDSEQ.q,AdresdebF.q,AdresFinF.q,Adresdeb.q,delta,DIVMAXD.d
  deb00.q=ElapsedMilliseconds()
  ;************************************************************************************************************************************
  ADRDSEQ=@SEQD
  AdresdebF=@SEQD\NBPFACT
  AdresFinF=@SEQD\MODULO+SizeOf(quad)
  Adresdeb=@SEQD\TDIF(0)
  delta=AdresFinF-AdresdebF
  
  If OpenFile(2,FICHIER$);,#PB_File_SharedRead|#PB_File_NoBuffering)
    ReadData(2,ADRDSEQ ,delta)
    ;     ReDim SEQD\TDIF(SEQD\NBSEQ+1) ;;; cette instruction crée une erreur en cas d'augmentation de la dimension
    ReadData(2, Adresdeb,SEQD\NBSEQ+1)
    CloseFile(2)
  EndIf
  ;   deb0.q=ElapsedMilliseconds()
  delta_deb.q=ElapsedMilliseconds()-deb00
  EnableExplicit
  
EndProcedure
procedure.q SYNCHRO(NBASYNCHRO.Q)
  protected restd.q,t_ind.q,t_col,ind,INFO.SYNCHRO,t_ind_dep,MODULO.Q
  EnableExplicit
  MODULO.q=SEQD\MODULO 
  restd.q=0
  enableasm 
  MOV ecx,dword[p.v_MODULO]  ;;;; la division euclidienne X=kQ+R avec R<Q nous oblige à utiliser une astuce
  XOR EDX,EDX                ;;;; pour éviter avec un diviseur trop petit et un dividente trop grand d'avoir un reste de type qword or EDX est de type dword 
  MOV eax,dword[p.v_NBASYNCHRO+4]
  DIV ecx
  ; 	MOV dword[v_quotientp],eax
  MOV eax,dword[p.v_NBASYNCHRO]
  DIV ecx
  mov dword[p.v_restd],edx
  disableasm 
  ; 
  ; ;   restd=NBASYNCHRO%SEQD\MODULO 
  t_ind=0
  t_col=1
  
  For ind=0 To SEQD\MODULO 
    If restd<=t_col
      t_ind_dep=t_ind
      Break
    Else 
      t_col+seqd\TDIF(t_ind)
      t_ind+1
    EndIf
  Next
  INFO\SYNCDEC\DIFF=t_col-restd
  INFO\SYNCDEC\IND=t_ind_dep
  procedurereturn info\SYNCALP
  DisableExplicit
endprocedure  

Procedure.s HEX2DEC(HEXS.S)
  EnableExplicit
  Static Dim t_rest.a(1000)
  Protected DIVIDENDE$,vald.q,longt,resultat$,DIVIDP$,DIVIDPR$,QUOTP.q,RESTP.q,quotp$,j,ii,DIVIDP.Q,Irest
  DIVIDENDE$=LTrim(UCase(HEXS))
  vald.q=Val("$"+DIVIDENDE$)
  longt=Len(DIVIDENDE$)
  If vald>0 And longt<17
    resultat$=Str(vald)
  Else  
    Irest=0
    DIVIDP$=""
    DIVIDPR$=""
    quotp$=""
    Repeat 
      For ii=1 To longt
        DIVIDP$=DIVIDPR$+Mid(DIVIDENDE$,ii,1)
        DIVIDP.Q=Val("$"+DIVIDP$)
        EnableASM
        MOV ax,word [p.v_DIVIDP]  
        MOV cl,10
        ;   idiv Cl 
        DIV cl  ; utilise moins de cycles machine que idiv
        MOV  [p.v_QUOTP],al
        MOV [p.v_RESTP],AH
        DisableASM
        
        DIVIDPR$=HEX(RESTP)
        quotp$+HEX(QUOTP)
      Next 
      t_rest(Irest)=RESTP
      Irest+1 
      DIVIDENDE$=QUOTP$
      longt=Len(DIVIDENDE$) 
      DIVIDP$=""
      DIVIDPR$=""
      quotp$=""
      
    Until Val("$"+ dividende$)=0
    For j=Irest-1 To 0 Step-1
      resultat$+Str( t_rest(j))
      t_rest(j)=0
    Next
  EndIf
  ProcedureReturn  resultat$
  DisableExplicit
EndProcedure

Procedure.s DEC2HEX(DECI.S)
  EnableExplicit
  Static Dim t_rest.a(1000)
  Protected DIVIDENDE$,vald.q,longt,resultat$,DIVIDP$,DIVIDPR$,QUOTP.q,RESTP.q,quotp$,i,j,ii,DIVIDP.Q,Irest
  DIVIDENDE$=UCase(DECI)
  longt=Len(DIVIDENDE$)
  If Val(DIVIDENDE$)=>0  And longt<20
    vald.q=Val(DIVIDENDE$)
    resultat$=Hex(vald)
  Else  
    irest=0
    DIVIDP$=""
    DIVIDPR$=""
    quotp$=""
    Repeat 
      For ii=1 To longt
        DIVIDP$=DIVIDPR$+Mid(DIVIDENDE$,ii,1)
        DIVIDP.Q=Val(DIVIDP$)
        EnableASM
        MOV ax,word [p.v_DIVIDP]  
        MOV cl,16
        ;   div Cl 
        DIV Cl  ; utilise moins de cycles machine que idiv
        MOV  [p.v_QUOTP],al
        MOV [p.v_RESTP],AH
        DisableASM
        
        DIVIDPR$=Str(RESTP)
        quotp$+Str(QUOTP)
      Next 
      t_rest(Irest)=RESTP
      Irest+1 
      DIVIDENDE$=QUOTP$
      longt=Len(DIVIDENDE$) 
      DIVIDP$=""
      DIVIDPR$=""
      quotp$=""
      
    Until Val(dividende$)=0
    For j=Irest-1 To 0 Step-1
      resultat$+Hex( t_rest(j))
      t_rest(j)=0
    Next
  EndIf
  ProcedureReturn  resultat$
  DisableExplicit
EndProcedure
PROCEDURE CALCUL(_NB.S,*SCALCUL.INFOCALC )
  EnableExplicit
  ; PROCEDURE CALCUL(_NB.S,SCALCUL.INFOCALC )
  static ADR1.q,ADR2.q,ADR3.Q,ADR4.q,FLAG=0 
  PROTECTED POSE,BASEMIN.q,nbasehex$,lnbh,A1.q,A2.q,NBASE.Q,DIFFB.q,difd.d,limitd.d,K.d,RACK.d,DIVMAX.q,NBASEP.q,SYNCDIVIS.SYNCHRO
  PROTECTED MAX_DIV.SYNCHRO,DIVMAXD.d,DIVMAXPD.d,DIVMAXP.q
  if mid(_NB,1,1)="$"
    nbasehex$=right(_NB,len(_NB)-1)
  else
    POSE=FindString(_NB,"E")
    If pose>0
      BASEMIN.q=ValD(_NB)
      nbasehex$=_HHQ(basemin,"")
    Else 
      nbasehex$=dec2hex(_NB)   
    endif 
  EndIf 
  lnbh=len(nbasehex$)
  nbasehex$=right("0000000000000000"+nbasehex$,16)
  
  if lnbh>16 OR nbasehex$>"FFFFFFFFFFFFFFFE" 
    INFOSAISIE\nbase$=""
    INFOSAISIE\NPLAGE$=""
    ProcedureReturn 2 
    Goto FIN
  EndIf
  ;;;;; recherche d'une racine carré de nb à partir de la différence 
  A1.q=val("$"+mid(nbasehex$,9,16))
  A2.q=val("$"+mid(nbasehex$,1,8))
  ;   debug _n(A1)+_n(A2)
  
  NBASE.q=0 
  DIFFB.Q=0
  EnableASM  ;; ici recherche en cours pour évaluer le plus précisément la racine carré des nombres >2^63-1
  mov eax,dword[p.v_A1]
  mov dword[p.v_NBASE],eax 
  mov edx,dword[p.v_A2]
  mov dword [p.v_NBASE+4],edx
  sub eax,dword[v_LIMITQ] 
  sbb edx,dword[v_LIMITQ+4]
  mov dword[p.v_DIFFB],eax 
  mov dword [p.v_DIFFB+4],edx
  if nbasehex$>LIMIT$
    ;;;;; recherche d'une racine carré de nb à partir de la différence 
    difd.d=DIFFB 
    limitd.d=limitq
    K.d=DIFd/LIMITd ;;;; k est défini sur la plage -1 +1 pour une plage div de +$7FFFFFFFFFFFFFFF à -$7FFFFFFFFFFFFFFF
    RACK.D=SQR(1+K) ;;;; plage de 0 sqr(2)
    DIVMAXD.d=RACLIM *RACK
    DIVMAX.q=divmaxd  ;;limite de recherche des facteurs premiers  de la base
  Else 
    DIVMAX=SQR(VAL("$"+nbasehex$))
  endif  
  ;   IF NBASE < SEQD\PREMDIV
  SYNCDIVIS\SYNCALP=SYNCHRO(NBASE)
  *SCALCUL\NBASEP=NBASE+SYNCDIVIS\SYNCDEC\DIFF 
  *SCALCUL\NBASEDIFS=SYNCDIVIS\SYNCDEC\DIFF
  *SCALCUL\NBASEIND=SYNCDIVIS\SYNCDEC\IND
  *SCALCUL\NBASEPHEX$=_HHQ(*SCALCUL\NBASEP,"")
  *SCALCUL\NBASE=NBASE
  *SCALCUL\NBASE$=_NB
  *SCALCUL\NBASEHEX$=nbasehex$
  *SCALCUL\NBASERAC=DIVMAX
  *SCALCUL\NBASEDIFB=DIFFB
  ; *SCALCUL\NBASEIND=INDBASE
  ; *SCALCUL\NBASEP=NBASEP
  IF NBASE>0 AND NBASE<SEQD\PREMDIV
    *SCALCUL\NBASEP=SEQD\PREMDIV
  endif  
  *SCALCUL\NBASEPHEX$=_HHQ(*SCALCUL\NBASEP,"")
  SYNCDIVIS\SYNCALP=SYNCHRO(*SCALCUL\NBASEP)
  *SCALCUL\NBASEPDIF=SYNCDIVIS\SYNCDEC\DIFF 
  *SCALCUL\NBASEPIND=SYNCDIVIS\SYNCDEC\IND
  difd.d=SYNCDIVIS\SYNCDEC\DIFF
  K.d=DIFd/*SCALCUL\NBASEP ;;;; 
  RACK.D=SQR(1+K)          ;;;; plage de 0 sqr(2)
  DIVMAXPD.d=*SCALCUL\NBASERAC *RACK
  DIVMAXP.q=divmaxpd  ;;
  *SCALCUL\NBASEPRAC=DIVMAXP
  FIN:
  DisableExplicit
endprocedure  
PROCEDURE.l EXTRINFO(NBE$)  
  protected pose, basmin.q,nbasehex$,lnbh,A1.q,A2.q,NBASE.Q,DIFFE.Q,difd.d,limitd.d,K.d,RACK.d,DIVMAXD.d,DIVMAX.q,NB$,DIFFB.Q
  ;   static FLAG=0 
  SHARED INF_CAL.INFOCALC, INF_CAL3.INFOCALC
  protected NBl3$,NB_A_TESTER.Q,NB_DE_DIVISEUR_MPAR.Q,NB_DE_DIVISEUR_MAX.d,KEFFICACE.D,NBDIVISIONE.D,LOG2X.d,RET0
  EnableExplicit
  global T1.Q=ElapsedMilliseconds()
  ;   select FLAG 
  ;     case 0
  ;   if INFOSAISIE\nbase$=""
  ret0=calcul (NBE$,INF_CAL)
  CopyMemory(INF_CAL,INFOSAISIE,SIZEOF(INFOCALC))
  ;   endselect
  ;   PRiNTN("X PASSAGE  "+_n(FLAG)+_s(NBE$))
  ;   FLAG+1 
  
  ;   ProcedureReturn 0
  ; FIN:
  ; logB1MIN=Log10(B1MIN)
  ; logmax=Log10(max-B1MIN)
  ; If logB1MIN+logmax>22
  ;   rmes=MessageRequester(" ATTENTION Temps très long","Oui=>continuez Non=>donnez autre zone",#PB_MessageRequester_YesNo)
  ;   If Rmes = 6        ; le bouton Oui a été choisi (Resultat = 6)
  ;   Else               ; le bouton Non a été choisi (Resultat = 7)
  ;     Goto SAISIE2
  ;   EndIf
  ; EndIf
  procedurereturn ret0
  DisableExplicit
endprocedure

Procedure.s choixdiv()
  Protected     COUR_DIR$,Filtre$,fichier$,Tfichier,fichierp$,leftfich$,RIGHTfich$,deb00.q,deb0.q,ADRDSEQ.q,AdresdebF.q,AdresFinF.q,Adresdeb.q,delta
  EnableExplicit
  COUR_DIR$ = GetCurrentDirectory()
  Filtre$ = "MEMA (MEMA_*.BIN)|MEMA_*.BIN;|Tous les fichiers (*.*)|*.*"
  fichier$=OpenFileRequester("Choisissez un fichier MEMA ou annulez", COUR_DIR$+"\MEMA_17.BIN", Filtre$, 0)
  fichierp$=UCase(Trim(GetFilePart(fichier$)))
  Tfichier=FileSize(Fichier$)
  leftfich$=Left(fichierp$,5)
  RIGHTfich$=Right(fichierp$,4)
  If Tfichier<1 Or Left(fichierp$,5)<>"MEMA_" Or Right(fichierp$,4) <>".BIN"
    MessageRequester( "ATTENTION", "fichier vide ou le nom n'est pas conforme "+ _n(Tfichier)+"  "+_s(fichierp$))
    End
  EndIf
  CHARGE_SEQD( FICHIER$)
  EnableExplicit
EndProcedure
procedure RECHERCHE_AUTO()
  EnableExplicit
  protected file$,pose,valfilt,Valfil,filem$,Repertoire$
  Repertoire$=GetCurrentDirectory()
  Valfil=0
  If ExamineDirectory(0, Repertoire$, "mema_*.bin")  
    While NextDirectoryEntry(0)
      If DirectoryEntryType(0) = #PB_DirectoryEntry_File
        file$=DirectoryEntryName(0)
        if UCase(left(file$,5))="MEMA_"
          pose=findstring(file$,".")
          valfilt=val(mid(file$,6,pose-6))
          if valfilt>valfil 
            valfil=valfilt
            filem$=file$
          endif
          ;           debug file$
        endif
      EndIf
    Wend
    FinishDirectory(0)
  EndIf
  if filem$=""
    messagerequester("Pas de fichier MEMA_XX.bin","executer dans le même répertoire de prg de création")
    end
  endif
  CHARGE_SEQD(Repertoire$+FILEM$)
  ;  ProcedureReturn filem$
EndProcedure 
PROCEDURE SAISIEBASE(nb$)
  protected mess$,pos,NBASE$,NPLAGE$,reto.l,NBASE.q,DIFFF.Q,NPLAGEMAX$
  EnableExplicit
  mess$=""
  NBASE$=Trim(nb$)
  reto.l=EXTRINFO(NBASE$)
  if retO>0
    MESS$="Respecter les 3 formats possibles "+#CRLF$+" $FFFFFFFFF00000 de 1 à $FFFFFFFFFFFFFFFE "+#CRLF$+" 1897654390 de 1 à 2^64-1"
    MESS$+#CRLF$+" 45E10 de 1E0 à 1844,6744073709551614E16"
    messagerequester("Attention", MESS$) 
    end
  endif 
  ;;;;;;************* Recherche de la plage max possible à utiliser *****************
  NBASE.q=INFOSAISIE\NBASE
  DIFFF.Q=0
  mov eax,$FFFFFFFE
  mov edx,$FFFFFFFF
  sub eax,dword[p.v_NBASE] 
  sbb edx,dword[p.v_NBASE+4]
  mov dword[p.v_DIFFF],eax 
  mov dword [p.v_DIFFF+4],edx
  NPLAGEMAX$=_HHQ(DIFFF,"" )
  
  INFOSAISIE\NPLAGEMAX$=NPLAGEMAX$
  ;;;*******************************  recherche de la plage à explorer   **************************
  ;   if EXTRINFO(NPLAGE$)
  ;     goto saisie2
  ;   endif 
  ;   INFOSAISIE\NPLAGEMAX$=NPLAGEMAX$
  DisableExplicit
endprocedure

enableExplicit
XIncludeFile "ESSAI_FORM.pbf"
define  wwe,quit,ECART_MAX$,MESSAG$,nbhex$,lnbh,NBo.q,jjj,NBCONT$,A1.q,A2.q,DIFFQQ.Q,difd.d,limitd.d,K.d,RACK.D,Kpj,NBPR$,NBRECH$,NBREC$,flag2

OpenWindow_0()
; while Window_0_Events(WaitWindowEvent() )
; wend 
Repeat
  wwe = WaitWindowEvent()
  Select wwe                       
    Case #PB_Event_CloseWindow     
      quit=1
    Case #PB_Event_Gadget 
      ;       text0$=getgadgettext(TEXT_0)
      if flag00=0
        Select EventGadget()         
          Case   Button_0
            flag00+1
            ;           debug eventGadget()
            if GetGadgetState(Option_0)=1
              recherche_AUTO()
            else 
              CHOIXDIV()
            endif 
            setgadgettext(TEXT_0,"P_Fact="+str(SEQD\NBPFACT))
            setgadgettext(TEXT_1,"Modulo="+str(SEQD\MODULO))
            setgadgettext(TEXT_2,"P_divis="+str(SEQD\PREMDIV))
            setgadgettext(TEXT_3,"Nb_seq="+str(SEQD\NBSEQ))
            setgadgettext(TEXT_4,"Time Prep="+str(delta_deb)+"ms")
            ;           debug _s( GetGadgetText(Spin_0))
            nb$=GetGadgetText(String_0)
            SAISIEBASE(nb$)
            ecart_max=val(GetGadgetText(Spin_0))
            ECART_MAX$=_hhq(ECART_MAX,"")
            ;           printn(_n(ecart_max)+_s(ECART_MAX$)+_s(infosaisie\NPLAGEMAX$))
           ; if ECART_MAX$>infosaisie\NPLAGEMAX$
            ;  MESSAG$="Le nombre à décomposer=$"+infosaisie\NBASEHEX$+chr(10) +"+ la plage de recherche demandée=$"+ECART_MAX$
             ; MESSAG$+CHR(10)+"Dépassent les limites de la machine >$FFFFFFFFFFFFFFFF"+chr(10)+"Plage de recherche diminuée="+infosaisie\NPLAGEMAX$
              ;messagerequester("ATTENTION",MESSAG$)
              ;ECART_MAX=VAL("$"+infosaisie\NPLAGEMAX$)
              ;SetGadgetText(Spin_0,str(ECART_MAX))
              
            ;endif  
;             if infosaisie\NBASE>0 and (infosaisie\NBASE-ECART_MAX)<0  ;;;;
;               MESSAG$="Le nombre à décomposer=$"+infosaisie\NBASEHEX$+chr(10) +"- la plage de recherche demandée=$"+ECART_MAX$
;               MESSAG$+CHR(10)+"Dépassent les limites de la machine <0 "+chr(10)+"Plage de recherche diminuée="+str(infosaisie\NBASE-1)
;               messagerequester("ATTENTION",MESSAG$)
;               ECART_MAX=infosaisie\NBASE-1
;               SetGadgetText(Spin_0,str(ECART_MAX))
;             endif  
            
            ;;;;**************************************************************************************************************************************
            ;           nb$="$"+infosaisie\NBASEHEX$
            nb$=infosaisie\NBASE$
            if findstring(nb$,"E")>0 and mid(nb$,1,1)<>"$"
              nb$=str(infosaisie\NBASE)
            endif  
            if mid(nb$,1,1)="$"
              nbhex$=right(nb$,len(nb$)-1)
            else 
              nbhex$=dec2hex(nb$)   
            endif 
            ;;;;; ******************* mise en forme du nombre à décomposer et recherche d'une racine carrée****************************************
            lnbh=len(nbhex$)
            if lnbh>16 OR nbhex$>"FFFFFFFFFFFFFFFE"
              ;             Goto saisie
            EndIf
            ;;;***********************************************************************************************************************************
            ;;;******************************************************* FIN DE LA SAISIE **********************************************************
            ;;;***********************************************************************************************************************************
            ; 	ecart_max.l=seqd\PREMDIV-1
            ; 	ecart_max=10
            NBo.q=val("$"+nbhex$)
            nbo-ecart_max
            for jjj=-ecart_max to ecart_max	
              nbhex$=_hhq(nbo,"")
              if mid(nb$,1,1)="$"
                nb$=_hhq(nbo)
              else 
                nb$=HEX2DEC(nbhex$)
              endif
              gosub subrout  ;;;  ListView_1 
                             ;             AddGadgetItem( ListView_1, jjj+ecart_max,nb$ +Chr(10)+NBCONT$+Chr(10)+Str(ElapsedMilliseconds()-deb1)+"ms"+chr(10)+fact_prem$)
              AddGadgetItem( ListIcon_0, -1,nb$ +Chr(10)+NBCONT$+Chr(10)+Str(ElapsedMilliseconds()-deb1)+"ms"+chr(10)+fact_prem$)
              SmartWindowRefresh(Window_0, #True ) 
              ;             printn(nb$ +Chr(10)+NBCONT$+Chr(10)+Str(ElapsedMilliseconds()-deb1)+"ms"+chr(10)+fact_prem$)
              
              nbo+1
              nb=nbo
            next
            
          Case ListIcon_0
          Case Spin_0
          case  String_0  
          case Option_0 , Option_2 
            if GetGadgetState(Option_0)=1
              recherche_AUTO()
              setgadgettext(TEXT_0,"P_Fact="+str(SEQD\NBPFACT))
              setgadgettext(TEXT_1,"Modulo="+str(SEQD\MODULO))
              setgadgettext(TEXT_2,"P_divis="+str(SEQD\PREMDIV))
              setgadgettext(TEXT_3,"Nb_seq="+str(SEQD\NBSEQ))
              setgadgettext(TEXT_4,"Time Prep="+str(delta_deb)+"ms")
              
              ;           else 
              ;             CHOIXDIV()
            endif 
            
        EndSelect
      Else 
        delay(10)
        if EventGadget()= Button_0
          quit+1
        endif  
      endif 
  EndSelect
  SmartWindowRefresh(Window_0, #True ) 
  ;   AddGadgetItem( ListIcon_0, -1,nb$ +Chr(10)+NBCONT$+Chr(10)+Str(ElapsedMilliseconds()-deb1)+"ms"+chr(10)+fact_prem$)
  
Until quit > 0
CloseWindow(Window_0)
printn("C'est fini")
Input()
CloseConsole()

End
;;;***********************************************************************************************************************************
;;;******************************************************* Subroutine ****************************************************************
;;;***********************************************************************************************************************************
subrout:
deb1.q=ElapsedMilliseconds()
; nbhex$=ReplaceString(space(16-lnbh)," ","0")+nbhex$
A1.q=val("$"+mid(nbhex$,9,16))
A2.q=val("$"+mid(nbhex$,1,8))
NB.q=0 
DIFFQQ.Q=0
EnableASM  ;; ici recherche en cours pour évaluer le plus précisément la racine carré des nombres >2^63-1
mov eax,dword[v_A1]
mov dword[v_nb],eax 
mov edx,dword[v_A2]
mov dword [v_nb+4],edx
sub eax,dword[v_LIMITQ] 
sbb edx,dword[v_LIMITQ+4]
mov dword[v_DIFFQQ],eax 
mov dword [v_DIFFQQ+4],edx
;;;;; recherche d'une racine carré de nb à partir de la différence 
difd.d=DIFFQQ 
limitd.d=limitq
K.d=DIFd/LIMITd ;;;; k est défini sur la plage -1 +1 pour une plage div de +$7FFFFFFFFFFFFFFF à -$7FFFFFFFFFFFFFFF
RACK.D=SQR(1+K)
DIVMAXD.d=RACLIM *RACK
DIVMAX=divmaxd  ;;limite de recherche des facteurs premiers
 if divmax<4294967296
   divmax+1
 endif 

IF DIVMAX<sqr(SEQD\NBPFACT)
  DIVMAX=SQR(SEQD\NBPFACT)
endif  
;   printn(_n(nb)+_n(DIVMAX)+_hq(DIVMAX)+_n(divmax)+_d(divmaxd))
; printn(_q(DIVMAX))
;*********************************************************************************************************************************************************

NBREC.Q=1
DIVIS=2
i=0
fact_prem$=nb$+"="
; deb1.q=ElapsedMilliseconds()
;************************************** Recherche des diviseurs premiers qui se trouvent dans p_fact(x) ***********************
iprem=0
DIVIS=nbprem(iprem)
indt=0
NB_DEB=NB
if nb<>0 ;  or nb<>1
While DIVIS<=SEQD\NBPFACT And DIVIS<=DIVMAX 
  enableasm
  MOV ecx,dword[v_DIVIS]  ;;;; la division euclidienne X=kQ+R avec R<Q nous oblige à utiliser une astuce
  XOR EDX,EDX             ;;;; pour éviter avec un diviseur trop petit et un dividente trop grand d'avoir un reste de type qword or EDX est de type dword 
  MOV eax,dword[v_nb+4]
  DIV ecx
  MOV dword[v_quotientp],eax
  MOV eax,dword[v_nb]
  DIV ecx
  CMP edx,0
  JNZ @f
  MOV edx,dword[v_quotientp]
  MOV dword[v_nb+4],edx
  MOV dword[v_nb],eax
  ;************************************************ Recherche de la racine carré ***************************************************************
  FILD qword[v_nb]
  FSQRT
  ; !FISTTP dword [v_DIVMAX] ; avec arrondi si vous décommentez cette instruction commentez la précédente
  ;                           et laissez le ! car l'instruction FISTTP n'est pas reconnue par PureBasic avec !FISTTP c'est bon !!!!
  FISTP qword[v_DIVMAX] ; sans arrondi
  tab(indt)=DIVIS
  indt+1
  DIVMAX=Sqr(nb)
  JMP lab0
  !@@:
  iprem+1
  DIVIS=nbprem(iprem)
  !lab0: 
  disableasm 
Wend

;****************  Partie principale pour le reste de la décomposition **************************************
If DIVIS<=seqd\PREMDIV
  DIVIS=SEQD\PREMDIV
EndIf
ipas=0
;************************************************************************************************************************
pas=SEQD\TDIF(1)
idivis=1
NBSEQ=SEQD\NBSEQ
;   ind=indt*8
Repeat
  ;   printn(_n(divis)+_n(pas)+_n(idivis))
  ;     ;Le nom de @@: signifie étiquette anonyme,vous pouvez avoir défini un grand nombre d'entre eux dans la source.
  ;     ;Symbole @b(ou l'équivalent @r)le plus proche des références du label précédent anonyme
  ;     ;,symbole @f références plus proche de l'étiquette suivante anonyme.
  ;     ;Ces symboles spéciaux sont insensibles à la casse.
  ;;*******************************  TESTS EN ASM ********************************************************************
  ;*************************************** Division d'un nombre de 64 bits par un nombre de 32 bits ******************************************
  EnableASM
  MOV ecx,dword[v_DIVIS]  ;;;; la division euclidienne X=kQ+R avec R<Q nous oblige à utiliser une astuce
  XOR EDX,EDX             ;;;; pour éviter avec un diviseur trop petit et un dividente trop grand d'avoir un reste de type qword or EDX est de type dword 
  MOV eax,dword[v_nb+4]
  DIV ecx
  MOV dword[v_quotientp],eax
  MOV eax,dword[v_nb]
  DIV ecx
  CMP edx,0
  JNZ @f
  ;     MOV dword[v_reste],edx
  ; quotientp
  
  MOV edx,dword[v_quotientp]
  MOV dword[v_nb+4],edx
  MOV dword[v_nb],eax
  ;*************************************************************************************************************************************
  ;**** Recherche de la racine carré  pas de pb ici le prg à trouver un diviseur qui n'est pas négatif car (2^64-2)/2 <(2^63-1)*********
  ;*************************************************************************************************************************************
  FILD qword[v_nb]
  FSQRT
  ; !FISTTP dword [v_DIVMAX] ; avec arrondi si vous décommentez cette instruction commentez la précédente
  ;                           et laissez le ! car l'instruction FISTTP n'est pas reconnue par PureBasic avec !FISTTP c'est bon !!!!
  FISTP qword[v_DIVMAX] ; sans arrondi
                        ;                          ;*********************************************** Affectation de la valeur du DIViseur dans la table *******************************************
                        ;     MOV ecx, [v_DIVIS]; à decommenter si ecx est effacée
                        ;     mov ebx, [p_Tab]
                        ;     mov edx, [v_ind]
                        ;     add ebx,edx
                        ;     mov[ebx],ecx
                        ;     add edx,8
                        ;     mov[v_ind],edx
  DisableASM
  tab(indt)=DIVIS   ;;;; Plus rapide que l'option ASM
  indt+1
  If nb<=1:Break:EndIf
  EnableASM
  ;     JMP lab#MacroExpandedCount
  JMP lab
  !@@:
  MOV edx,dword[v_pas]
  ADD dword[v_DIVIS],edx  ; pas de PB l'addition est réalisée en valeur absolue 
  ADC dword[v_DIVIS+4],0  ; pas de PB l'addition est réalisée en valeur absolue 
                          ;     donc $FFFFFFFF =>4294967295 donc pas de risque de dépassement sqr(pow(2,63)-1))=>3037000499,9760496922867524030306 <4294967295
  DisableASM
  ;********************************************************************************************************************************************************
  ;********************************************************************************************************************************************************
  ; ;***********************************  Pour accélerer encore l' algo  *******************************
  idivis+1
  If idivis=NBSEQ+1  ;;; inutil de passer en ASM  voir ci dessous c'est plus long de 5 à 6 secondes  sur la recherche de 9223372036854770999
    idivis=1
  EndIf
  pas=SEQD\TDIF(idivis)
  EnableASM
  ;     mov EAX, dword [v_idivis]
  ;     xor edx,edx
  ;     mov ECX, dword [v_NBSEQ]
  ;     div ECX 
  ;     mov  dword [v_idivis],EDX
  ;     idivis=idivis%NBSEQ
  ;************************************  Pour accélerer encore l' algo vous pouvez décommentez les 7 lignes PB précedentes ******************************
  ;*******************************************************************************************************************************************************
  ;     !lab#MacroExpandedCount:
  !lab:
  ; 		If DIVIS>DIVMAX Or DIVIS<0:Break:EndIf
Until DIVIS>DIVMAX 	
; 	ForEver
;*************************************************Fin macro decompose2****************************************************************************************************
; 	printn(_q(divis)+_q(DIVMAX)+_Q(NB)+_s(nbhex$) +_hhq(NB,"")+"  "+_hhq(DIVMAX))
if nb<>1
  tab(indt)=NB
Else 
  indt-1
endif
Else
;   indt=0
;  tab(indt)=NB_DEB
  tab(indt)=0
endif
if NB_DEB=1
  indt=0
  tab(indt)=1
endif  

;************************************   EDITION ***********************************************
Kpj=0
For j=0 To indt
;   printn(_n(tab(J)))
  if j>0 
    if tab(j-1)=tab(j)
      Kpj+1
    else  
      if Kpj=0
        ;         fact_prem$+str(tab(j))
      else  
        fact_prem$+"^"+str(Kpj+1)
        kpj=0
      endif
      If j<=indt 
        fact_prem$+" * "+str(tab(j))
      EndIf
    endif 
  else 
     if tab(J)>0
		    fact_prem$+str(tab(j))
		  else
		    NBPR$=_hhq(tab(j),"")
		    fact_prem$+HEX2DEC(NBPR$)
		  endif  
;     fact_prem$+str(tab(j))
  endif  
  NBREC *tab(j) ; Vérification de la décomposition
Next

if Kpj>0
  fact_prem$+"^"+str(Kpj+1)
endif  
NBRECH$=HEX(NBREC)
NBREC$=HEX2DEC(NBRECH$)
if mid(nb$,1,1)="$"
  NBCONT$="$"+NBRECH$
else 
  NBCONT$=NBREC$
endif  
;essai pour ces nombres 9223372036854769861, 9223372036854770317, 9223372036854770999, 9223372036854773927 et 9223372036854775309 qui ne sont pas premiers.
if flag2=0
  PrintN("Recherche des diviseurs <=:"+Str(SEQD\NBPFACT)+" + diviseurs =>"+Str(SEQD\NBPFACT))
  PrintN("Nombre d'éléments du vecteur =:"+Str(SEQD\NBSEQ)+"  temps de préparation ="+Str(delta_deb.q))
  ;   MessageRequester("Résultat",fact_prem$+#CR$+NBCONT$+": contrôle"+#CR$+"temps="+Str(ElapsedMilliseconds()-deb1)+"ms"+#CR$+"Recherche des diviseurs <=:"+Str(SEQD\NBPFACT)+" + diviseurs =>"+Str(SEQD\NBPFACT)+#CR$+"Nombre d'éléments du vecteur =:"+Str(SEQD\NBSEQ))
  FLAG2+1
endif
;  AddGadgetItem(ListIcon_0, -1,nb$ +Chr(10)+NBCONT$+Chr(10)+Str(ElapsedMilliseconds()-deb1)+"ms"+chr(10)+fact_prem$)

printn("____________________________________________________________________")
PrintN(fact_prem$)
PrintN(NBCONT$+": contrôle")
PrintN("temps="+Str(ElapsedMilliseconds()-deb1)+"ms")
return 
; ces nombres 9223372036854769861, 9223372036854770317, 9223372036854770999, 9223372036854773927 et 9223372036854775309 qui ne sont pas premiers; 2295911257* 4017303373=9223372036854769861;==> div=-2147483645 divm=2147483647 DIVMAX=3037000500
; ***************** Ci dessous les Nombres premiers pour les 1000 premiers nombres
; 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97
; 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199
; 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293
; 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397
; 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499
; 503 509 521 523 541 547 557 563 569 571 577 587 593 599
; 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691
; 701 709 719 727 733 739 743 751 757 761 769 773 787 797
; 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887
; 907 911 919 929 937 941 947 953 967 971 977 983 991 997

Ps :
Lors de la mise au point des 2 prg, j’ai eu quelques Problèmes à obtenir des résultats satisfaisants dans la zone entre 2^63 et 2^64-1
Comme les pièges dans cette zone sont fréquents et que les tests représentent un nombre extrêmement important il n’est pas impossible que vous trouviez un bug.
Veuillez me le signaler et merci d’avance.
Le 4em programme dans le post suivant.
A+
Dernière modification par PAPIPP le lun. 09/janv./2017 9:56, modifié 1 fois.
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Haut
PAPIPP
Messages : 534
Inscription : sam. 23/févr./2008 17:58

Re: Recherche et décomposition en facteur premier de 1 à 2^6

Message par PAPIPP »

Bonjour à tous (suite premier post)

Voici les 2 prg qui explorent la zone de 1 à 2^64-1 en considérant tout nombre comme un nombre entier positif. En effet la Zone de 2^63 à 2^64-1 en PB est signée et les nombres sont vus comme des valeurs négatives.

1) Le premier décompose un nombre en facteur premiers avec de part et d’autre une zone de recherche
2) Le deuxième recherche les nombres premiers dans une fenêtre.

On peut fournir le nombre de base de 3 façons différentes
Respecter les 3 formats possibles "
1) $0FFFFFFFF00000 valeur de $1 à $FFFFFFFFFFFFFFFE
2) 1897654390 valeur de 1 à 2^64-1 donc de 1 à 18446744073709551614
3) 45E10 valeur de 1E0 à 1844.6744073709551614E16

Avant de lancer l’un des 2 prg il faut créer la table des différences dans le même répertoire.
Utilisez si possible la table des différences de p_fact(23) qui donne un meilleur temps de recherche.
Pour vérifier l’amélioration du temps d’exécution créez plusieurs tables différentes
Celle qui demande le plus de temps à créer est la table de p_fact(23) proche de 3mn
Les autres tables ne demandent que quelques secondes. Par exemple Table p-fact(19)<10 secondes
Ces tables ne sont à créer qu’une seule fois

Placez les 4 prg dans le même répertoire.

Premier prg création des tables des différences

Code : Tout sélectionner

; exemple des p_fact(x)
; p_fact(x)--modulo-----------------Nb_occurrences des différences--------Taux-----------Gain
; 3__________6__________________________2_________________________________0,3333_________66,66%
; 5__________30_________________________8_________________________________0,2666_________73,33%
; 7__________210________________________48________________________________0,2285_________77,14%
; 11_________2310_______________________480_______________________________0,2078_________79,22%
; 13_________30030______________________5760______________________________0,1918_________80,81%
; 17_________510510 ____________________92160_____________________________0,18052________81,94%
; 19_________9699690____________________1658880___________________________0,17102________82,89%
; 23_________223092870__________________36495360__________________________0,16358________83,64%

 Macro _q_t_
 		"
 EndMacro
 Macro _n (__n)
 _q_t_#__n#=_q_t_+Str(__n)+" "
 EndMacro
 Macro _Q (__Q)
 _q_t_#__Q#=_q_t_+Str(__Q)+" "
 EndMacro
EnableExplicit

OpenConsole("Résultats partiel")
Dim T_MODULO.l(12)
Structure colonne
;   nb.q
	prem.a
; 	dif_prec.l
	dif_prec.a

; 	Dif_act.l
EndStructure
Structure DIVIS
  NBPFACT.a
  PREMDIV.l
  NBSEQ.l
  MODULO.q
  ;   Array TDIF.a(40000000)  ;; *** ATTENTION   A utiliser avec DATA.A et read.A  mais très lent avec p_fact(23) P_fact(19) est préférable remplacer 40 par 2
  Array TDIF.a(40000000)  
EndStructure
define SEQD.DIVIS,mess$,nb$,nbs,rest.l,i,modulo,elem,NBprem,Tdep.q,inb,inbp,prem_p,PREM_NB_PREM_AV,NB_PREM,SOM_DIF,vecteur$,NBSEQ,lvecteur,rapportq.d,RAPPORT.D
define ADRDSEQ.q,AdresdebF.q,AdresFinF.q,Adresdeb.q,delta

; **************** Réalisation du vecteur modulo npp à partir d'une table des nombres premiers des 100 premiers nombres *********
;***** Choix du premier Nb premier pour lequel le vecteur modulo sera appliqué.
;***** pour éviter la génération d'un vesteur trop important nous limiterons ce choix aux 23 premiers nombres premiers soit :2 3 5 7 11 13 17 19 23 29 31
;***** Recherche du modulo < 2*3*5*7*11=2310 éléments du vecteur
SAISIE0:
mess$+"Filtre de réduction des diviseurs"
If Len(mess$)>120
	MessageRequester("Erreur","Colonne Div max 2 3 5 7 11 13 17 19 23"+#CR$+"Relancez le prg") ;
	End
EndIf
nb$=InputRequester(mess$,"Colonne Div max 2 3 5 7 11 13 17 19 23","5") ;
If val(nb$)>23
  goto SAISIE0
EndIf
nbs=Val(nb$)
If nbs<1 Or nbs>31
	Goto SAISIE0
EndIf
rest.l=nbs%30
If rest=2 Or rest=3 Or rest=5 Or rest=7 Or rest=11 Or rest=13 Or rest=17 Or rest=19 Or rest=23
Else
  Goto SAISIE0
EndIf 
; NBPFACT=NBS
; FINSAISIE0:
Restore lab_pnbp
i=0
Modulo=1
Repeat
	Read.l ELEM
	If ELEM<>0
		T_modulo(I)=elem
		Modulo*elem
		i+1
	EndIf
Until ELEM=0 Or ELEM=>nbs
redim SEQD\TDIF(Modulo+10)
SEQD\MODULO=MODULO 
SEQD\NBPFACT=nbs
NBprem=i-1
nbs=ELEM
Dim tcol.colonne(SEQD\MODULO+2)
;*** Recherche des colonnes ayant des nb premiers ***
tcol(0)\prem=2
tcol(1)\prem=2
Tdep.q=ElapsedMilliseconds()
For inb=2 To modulo+1
	For inbp=0 To nbprem
		If inb%t_modulo(inbp)=0
			tcol(inb)\prem=2
		EndIf
	Next
Next
prem_p=0
PREM_NB_PREM_AV=0
NB_PREM=0
SOM_DIF=0
vecteur$="DIV_"+Str(nbs)+":"+#CRLF$
;****** Recherche des différence entre NB premiers *****
If CreateFile(0,"DIVA_"+Str(nbs)+".PB")         ; création d'un nouveau fichier texte...
  NBSEQ=0
  For inb=2 To modulo+1
;     tcol(inb)\nb=inb
		If tcol(inb)\prem=0 And inb>nbs
			If prem_p=0
				prem_p=inb
				PREM_NB_PREM_AV=inb
				vecteur$+"DATA.A  "+Str(inb)+","
				SEQD\PREMDIV=inb
				NBSEQ+1
			Else
				NB_PREM+1
				If nb_prem%101=0
				  If nb_prem%201=0
				    PrintN(_n(NB_prem)+_n(prem_p)+_n(tcol(inb)\dif_prec)+_n(som_dif)+_n(ElapsedMilliseconds()-Tdep)+_n(lvecteur))
					EndIf
					If nb_prem%5=0  ; ici tous les =101*x  c'est avec 5 que l'on obtient le meilleur résultat
					  vecteur$+Str(inb-prem_p)+#CRLF$
; 					  SEQD\TDIF(NBSEQ-1)=inb-prem_p
					  SEQD\TDIF(NBSEQ)=inb-prem_p

					  NBSEQ+1
						lvecteur=Len(vecteur$)
						WriteString(0,vecteur$) ;
						vecteur$="Data.A "
					Else
					  vecteur$+Str(inb-prem_p)+#CRLF$+"Data.A "
; 					  SEQD\TDIF(NBSEQ-1)=inb-prem_p
					  SEQD\TDIF(NBSEQ)=inb-prem_p

					  NBSEQ+1
					EndIf
					
					tcol(inb)\dif_prec=inb-prem_p
					SOM_DIF+(inb-prem_p)
; 					tcol(prem_p)\Dif_act=inb-prem_p
					prem_p=inb
				Else
					tcol(inb)\dif_prec=inb-prem_p
					vecteur$+Str(inb-prem_p)+","
; 					SEQD\TDIF(NBSEQ-1)=inb-prem_p
					SEQD\TDIF(NBSEQ)=inb-prem_p
					NBSEQ+1
					SOM_DIF+(inb-prem_p)
; 					tcol(prem_p)\Dif_act=inb-prem_p
					prem_p=inb
				EndIf
			EndIf
		EndIf
	Next
	;  tcol(modulo+2)\dif_prec=nb_prem+modulo-(modulo+1)
	NB_PREM+1
	tcol(modulo+2)\dif_prec=PREM_NB_PREM_AV-1
	SEQD\TDIF(NBSEQ)=PREM_NB_PREM_AV-1
	SEQD\TDIF(0)=PREM_NB_PREM_AV-1
	SEQD\NBSEQ=NBSEQ
	redim SEQD\TDIF(NBSEQ+2)

; 	tcol(1)\Dif_act=PREM_NB_PREM_AV-1
; 	tcol(1)\nb=1
	SOM_DIF+(PREM_NB_PREM_AV-1)
	rapportq.d=100.0*(modulo-Nb_prem)/modulo
	vecteur$+Str(PREM_NB_PREM_AV-1)+",0 ;"+#CRLF$+";; Modulo="+Str(modulo)+" Nb Elements dans vecteur="+Str(NB_prem)+"  NBPFACT="+str(SEQD\NBPFACT)+" Nb sequences="+str(NBSEQ)+"  GAin="+Str(rapportq)+"%"
	
	WriteString(0,vecteur$) ;
	CloseFile(0)            ; ferme le fichier précédemment ouvert et enregistre les données
	PrintN(_n(ElapsedMilliseconds()-Tdep))
	RAPPORT.D=modulo/NB_PREM
	MessageRequester("C'est tout bon","Somme des nb du vecteur="+_n(SOM_DIF)+#CRLF$+_n(modulo)+#CRLF$+"voir le fichier pour le détail du vecteur"+#CRLF$+"Fichier: "+GetCurrentDirectory()+"DIVA_"+Str(nbs)+".PB"+#CRLF$+"Nomnre d'éléments dans le vecteur="+Str(NB_PREM)+" Rapport="+StrD(RAPPORT))
Else
	MessageRequester("Information","Impossible de créer le fichier! DIVA_"+Str(nbs)+".PB")
EndIf
; Adresdeb.l=@SEQD\NBPFACTStructure DIVIS
;   NBPFACT.a
;   PREMDIV.l
;   NBSEQ.l
;   MODULO.q
;   ;   Array TDIF.a(40000000)  ;; *** ATTENTION   A utiliser avec DATA.A et read.A  mais très lent avec p_fact(23) P_fact(19) est préférable remplacer 40 par 2
;   Array TDIF.a(40000000)  
ADRDSEQ.q=@SEQD
AdresdebF.q=@SEQD\NBPFACT
AdresFinF.q=@SEQD\MODULO+sizeof(quad)
Adresdeb.q=@SEQD\TDIF(0)
delta=AdresFinF-AdresdebF
If CreateFile(1, "MEMA_"+Str(nbs)+".bin")
  WriteData(1,ADRDSEQ ,delta )
;   WriteData(1,Adresdebf , 17)
  WriteData(1,Adresdeb , SEQD\NBSEQ+1)
  closefile(1)
Else
  messagerequester("ATTENTION", "Fichier "+ "MEMA_"+Str(nbs)+".bin non créer")
endif

Input()
CloseConsole()

DataSection
	lab_pnbp:
	Data.l 2,3,5,7,11,13,17,19,23,29,31,0
EndDataSection

DataSection
  lab_pnbp2:
  Data.L   2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97
  Data.L  101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199
  Data.L  211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293
  Data.L  307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397
  Data.L  401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499
  Data.L  503,509,521,523,541,547,557,563,569,571,577,587,593,599
  Data.L  601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691
  Data.L  701,709,719,727,733,739,743,751,757,761,769,773,787,797
  Data.L  809,811,821,823,827,829,839,853,857,859,863,877,881,883,887
  Data.L  907,911,919,929,937,941,947,953,967,971,977,983,991,997,0
EndDataSection
; ***************** Ci dessous les Nombres premiers pour les 1000 premiers nombres
; 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97
; 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199
; 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293
; 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397
; 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499
; 503 509 521 523 541 547 557 563 569 571 577 587 593 599
; 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691
; 701 709 719 727 733 739 743 751 757 761 769 773 787 797
; 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887
; 907 911 919 929 937 941 947 953 967 971 977 983 991 997




Voici le 4em prg qui recherche les Nombres Premiers entre 0 et 2^64-1 en utilisant une fenêtre pour limiter l'exploration. Les résultats sont à l’état brut.

Code : Tout sélectionner

; algorithme de recherche des nombres PREMIERS par zones 
; ATTENTION ENTRE 1E2-1E1 =90 entre 1E3-1E2=900 entre 1E4-1E3=9000 entre 1E12-1E11= 900000000000
;; et entre 2^63 et 2^64 différence 2^63 = 9223372036854775808
; Le nombre 1 n'est pas par convention un nombre premier.
; Tous les nombres premiers >5 se terminent par 1 3 7 ou 9 seulement
; exemple des p_fact(x)
; p_fact(x)--modulo-----------------Nb_occurrences des différences--------Taux-----------Gain
; 3__________6__________________________2_________________________________0,3333_________66,66%
; 5__________30_________________________8_________________________________0,2666_________73,33%
; 7__________210________________________48________________________________0,2285_________77,14%
; 11_________2310_______________________480_______________________________0,2078_________79,22%
; 13_________30030______________________5760______________________________0,1918_________80,81%
; 17_________510510 ____________________92160_____________________________0,18052________81,94%
; 19_________9699690____________________1658880___________________________0,17102________82,89%
; 23_________223092870__________________36495360__________________________0,16358________83,64%

Macro _HHQ (_HHQ,_pr="$")
  _PR+RSet(Hex(PeekQ(@_HHQ),#PB_Quad),16,"0")
EndMacro

EnableExplicit
; DisableDebugger
; 2 3 5 7 11 13 17 19 23
Global Dim TABTERMIN.Q(4)
Structure ldec 
  DIFF.l
  IND.l
EndStructure
Structure synchro 
  StructureUnion
    SYNCDEC.ldec
    SYNCALP.q
  EndStructureUnion 
  
EndStructure  
Structure DIVIS
  NBPFACT.a
  PREMDIV.l
  NBSEQ.l
  MODULO.q
  Array TDIF.a(37000000)  ;;
EndStructure
Structure INFOTEMP
  NBASE$
  NBASE.Q
  NBASEHEX$
  NBASEDIFB.q
  NBASEIND.q
  NBASEDIFS.q
  NBASERAC.Q
  NBASEP.Q
  NBASEPHEX$
  NBASEPDIF.Q
  NBASEPIND.q
  NBASEPRAC.q
  
  NPLAGE$
  NPLAGE.Q
  NPLAGEHEX$
  
  NPLAGEMAX$    
  
  NBASEM$
  NBASEM.Q
  NBASEMHEX$
  NBASEMP.Q
  NBASEMPHEX$
  NBASEMIND.q
  NBASEMRAC.Q
  
;   FUTBASE$
;   FUTBASED.D
;   FUTBASE.q
;   FUTBASEHEX$
;   ;     FUTBASEP.Q
;   ;     FUTBASEPHEX$
;   FUTBASEIND.q
;   FUTBASERAC.Q
  
EndStructure 
Structure INFOCALC
  NBASE$
  NBASE.Q
  NBASEHEX$
  NBASEDIFB.q
  NBASEIND.q
  NBASEDIFS.q
  NBASERAC.Q
  NBASEP.Q
  NBASEPHEX$
  NBASEPDIF.Q
  NBASEPIND.q
  NBASEPRAC.q
EndStructure  
Global INFOSAISIE.INFOTEMP

Global result$,rest,SEQD.DIVIS,delta_deb.q,NBDIVISIONE.D
Global nbs.l,NBSEQ.l,SEQD.DIVIS,LIMIT$="7FFFFFFFFFFFFFFF",LIMITQ.Q=$7FFFFFFFFFFFFFFF,RACLIM.d=Sqr(LIMITQ)

Define nb$,nb.q,B2DIVIS.q,B2PAS,mess$,quotient.q,ind.l,B1MIN.Q=1E12,pos,B1MIN_DEP.Q,ZONEP.Q,presultat$,resultat$
Define MAX.Q=B1MIN+1E4,nbg$,nbd$,pose.l,t_ind.l,t_col.l,t_ind_dep.l,MAXMAXDIV.q,RAC2.Q,B1MINRAC2.Q,nbseqp,B2IND_MAXDIV,DIF_MAXDIV
Define ind_dep,DIFF,FLAGFIN,IND_NB,CENTM,B2DIVISM,B2INDDD, B2DIVIS$,B2MAXDIV.q,dep_time.q,cent,nbseq_1.q,P_MAXDIV.q,MAXHEX$
Procedure.Q DIVI64_32Q(DIVIDENTE.Q,DIVISEUR.Q)
    Protected  QUOTIENTS.Q
  global RESTES_.Q  ;; impossible de le placer en shared
  EnableExplicit
  EnableASM 
  MOV ecx,dword[p.v_DIVISEUR]  ;;;; la division euclidienne X=kQ+R avec R<Q nous oblige à utiliser une astuce
  XOR EDX,EDX                  ;;;; pour éviter avec un diviseur trop petit et un dividente trop grand d'avoir un reste de type qword or EDX est de type dword 
  MOV eax,dword[p.v_DIVIDENTE+4]
  DIV ecx
  MOV dword[p.v_QUOTIENTS+4],eax
  MOV eax,dword[p.v_DIVIDENTE]
  DIV ecx
  MOV dword[p.v_QUOTIENTS],eax
  MOV dword[v_RESTES_],edx
  DisableASM 
  ProcedureReturn QUOTIENTs
  DisableExplicit
  EndProcedure  
 Procedure.Q DIVI64_32R(DIVIDENTE.Q,DIVISEUR.Q)
  Shared QUOTIENTS_.Q
  Protected  RESTES_.Q
  EnableASM 
  MOV ecx,dword[p.v_DIVISEUR]  ;;;; la division euclidienne X=kQ+R avec R<Q nous oblige à utiliser une astuce
  XOR EDX,EDX                  ;;;; pour éviter avec un diviseur trop petit et un dividente trop grand d'avoir un reste de type qword or EDX est de type dword 
  MOV eax,dword[p.v_DIVIDENTE+4]
  DIV ecx
  MOV dword[v_QUOTIENTS_+4],eax
  MOV eax,dword[p.v_DIVIDENTE]
  DIV ecx
  MOV dword[v_QUOTIENTS_],eax
  MOV dword[p.v_RESTES_],edx
  DisableASM 
  	ProcedureReturn RESTES_
EndProcedure  
Procedure PREM_1_3_7_9(NBprem.Q);;;; Répartition des Nb premiers par terminaison 1 3 7 9 ********************
 Protected rest10.A
   EnableExplicit
 Rest10.A=DIVI64_32R(NBPREM,10) 
 Select REST10 
    Case 1
      TABTERMIN(1)+1
    Case 3
      TABTERMIN(2)+1
    Case 7
      TABTERMIN(3)+1
    Case 9
       TABTERMIN(4)+1
   Default 
      MessageRequester("Attention " , _HHQ(NBPREM,"")+" n'est pas premier ")
  EndSelect
  DisableExplicit
EndProcedure  

Procedure.s choixdiv()
  Protected     COUR_DIR$,Filtre$,fichier$,Tfichier,fichierp$,leftfich$,RIGHTfich$,deb00.q,deb0.q,ADRDSEQ.q,AdresdebF.q,AdresFinF.q,Adresdeb.q,delta
  EnableExplicit
  COUR_DIR$ = GetCurrentDirectory()
  Filtre$ = "MEMA (MEMA_*.BIN)|MEMA_*.BIN;|Tous les fichiers (*.*)|*.*"
  fichier$=OpenFileRequester("Choisissez un fichier MEMA ou annulez", COUR_DIR$+"\MEMA_17.BIN", Filtre$, 0)
  fichierp$=UCase(Trim(GetFilePart(fichier$)))
  Tfichier=FileSize(Fichier$)
  leftfich$=Left(fichierp$,5)
  RIGHTfich$=Right(fichierp$,4)
  If Tfichier<1 Or Left(fichierp$,5)<>"MEMA_" Or Right(fichierp$,4) <>".BIN"
    MessageRequester( "ATTENTION", "fichier vide ou le nom n'est pas conforme "+ _n(Tfichier)+"  "+_s(fichierp$))
    End
  EndIf
  ;   FICHIER$=choixdiv()
  deb00.q=ElapsedMilliseconds()
  ;************************************************************************************************************************************
  ADRDSEQ=@SEQD
  AdresdebF=@SEQD\NBPFACT
  AdresFinF=@SEQD\MODULO+SizeOf(quad)
  Adresdeb=@SEQD\TDIF(0)
  delta=AdresFinF-AdresdebF
  
  If OpenFile(2,FICHIER$);,#PB_File_SharedRead|#PB_File_NoBuffering)
    ReadData(2,ADRDSEQ ,delta)
    ReDim SEQD\TDIF(SEQD\NBSEQ+1)
    ReadData(2, Adresdeb,SEQD\NBSEQ+1)
    CloseFile(2)
  EndIf
  deb0.q=ElapsedMilliseconds()
  delta_deb.q=deb0-deb00
  EnableExplicit
EndProcedure
Procedure.q SYNCHRO(NBASYNCHRO.Q)
  Protected restd.q,t_ind.q,t_col,ind,INFO.SYNCHRO,t_ind_dep,MODULO.Q
  EnableExplicit
  MODULO.q=SEQD\MODULO 
  restd.q=0
  EnableASM 
  MOV ecx,dword[p.v_MODULO]  ;;;; la division euclidienne X=kQ+R avec R<Q nous oblige à utiliser une astuce
  XOR EDX,EDX                ;;;; pour éviter avec un diviseur trop petit et un dividente trop grand d'avoir un reste de type qword or EDX est de type dword 
  MOV eax,dword[p.v_NBASYNCHRO+4]
  DIV ecx
  ; 	MOV dword[v_quotientp],eax
  MOV eax,dword[p.v_NBASYNCHRO]
  DIV ecx
  MOV dword[p.v_restd],edx
  DisableASM 
  ; 
  ; ;   restd=NBASYNCHRO%SEQD\MODULO 
  t_ind=0
  t_col=1
  
  For ind=0 To SEQD\MODULO 
    If restd<=t_col
      t_ind_dep=t_ind
      Break
    Else 
      t_col+seqd\TDIF(t_ind)
      t_ind+1
    EndIf
  Next
  INFO\SYNCDEC\DIFF=t_col-restd
  INFO\SYNCDEC\IND=t_ind_dep
  ProcedureReturn info\SYNCALP
  DisableExplicit
EndProcedure  

Procedure.s HEX2DEC(HEXS.S)
  EnableExplicit
  Static Dim t_rest.a(1000)
  Protected DIVIDENDE$,vald.q,longt,resultat$,DIVIDP$,DIVIDPR$,QUOTP.q,RESTP.q,quotp$,j,ii,DIVIDP.Q,Irest
  DIVIDENDE$=LTrim(UCase(HEXS))
  vald.q=Val("$"+DIVIDENDE$)
  longt=Len(DIVIDENDE$)
  If vald>0 And longt<17
    resultat$=Str(vald)
  Else  
    Irest=0
    DIVIDP$=""
    DIVIDPR$=""
    quotp$=""
    Repeat 
      For ii=1 To longt
        DIVIDP$=DIVIDPR$+Mid(DIVIDENDE$,ii,1)
        DIVIDP.Q=Val("$"+DIVIDP$)
        ;   QUOTP.q=DIVIDP/10
        ;   RESTP.q=DIVIDP%10
        EnableASM
        MOV ax,word [p.v_DIVIDP]  
        MOV cl,10
        ;   idiv Cl 
        DIV cl  ; utilise moins de cycles machine que idiv
        MOV  [p.v_QUOTP],al
        MOV [p.v_RESTP],AH
        DisableASM
        
        DIVIDPR$=Hex(RESTP)
        quotp$+Hex(QUOTP)
      Next 
      t_rest(Irest)=RESTP
      Irest+1 
      DIVIDENDE$=QUOTP$
      longt=Len(DIVIDENDE$) 
      DIVIDP$=""
      DIVIDPR$=""
      quotp$=""
      
    Until Val("$"+ dividende$)=0
    For j=Irest-1 To 0 Step-1
      resultat$+Str( t_rest(j))
      t_rest(j)=0
    Next
  EndIf
  ProcedureReturn  resultat$
  DisableExplicit
EndProcedure

Procedure.s DEC2HEX(DECI.S)
  EnableExplicit
  Static Dim t_rest.a(1000)
  Protected DIVIDENDE$,vald.q,longt,resultat$,DIVIDP$,DIVIDPR$,QUOTP.q,RESTP.q,quotp$,i,j,ii,DIVIDP.Q,Irest
  DIVIDENDE$=UCase(DECI)
  longt=Len(DIVIDENDE$)
  If Val(DIVIDENDE$)=>0  And longt<20
    vald.q=Val(DIVIDENDE$)
    resultat$=Hex(vald)
  Else  
    irest=0
    DIVIDP$=""
    DIVIDPR$=""
    quotp$=""
    Repeat 
      For ii=1 To longt
        DIVIDP$=DIVIDPR$+Mid(DIVIDENDE$,ii,1)
        DIVIDP.Q=Val(DIVIDP$)
        ;   QUOTP.q=DIVIDP/16
        ;   RESTP.q=DIVIDP%16
        EnableASM
        MOV ax,word [p.v_DIVIDP]  
        MOV cl,16
        ;   div Cl 
        DIV Cl  ; utilise moins de cycles machine que idiv
        MOV  [p.v_QUOTP],al
        MOV [p.v_RESTP],AH
        DisableASM
        
        DIVIDPR$=Str(RESTP)
        quotp$+Str(QUOTP)
      Next 
      t_rest(Irest)=RESTP
      Irest+1 
      DIVIDENDE$=QUOTP$
      longt=Len(DIVIDENDE$) 
      DIVIDP$=""
      DIVIDPR$=""
      quotp$=""
      
    Until Val(dividende$)=0
    For j=Irest-1 To 0 Step-1
      resultat$+Hex( t_rest(j))
      t_rest(j)=0
    Next
  EndIf
  ProcedureReturn  resultat$
  DisableExplicit
EndProcedure
Procedure CALCUL(_NB.S,*SCALCUL.INFOCALC )
  EnableExplicit
  ; PROCEDURE CALCUL(_NB.S,SCALCUL.INFOCALC )
  Static ADR1.q,ADR2.q,ADR3.Q,ADR4.q,FLAG=0 
  Protected POSE,BASEMIN.q,nbasehex$,lnbh,A1.q,A2.q,NBASE.Q,DIFFB.q,difd.d,limitd.d,K.d,RACK.d,DIVMAX.q,NBASEP.q,SYNCDIVIS.SYNCHRO
  Protected MAX_DIV.SYNCHRO,DIVMAXD.d,DIVMAXPD.d,DIVMAXP.q
  If Mid(_NB,1,1)="$"
    nbasehex$=Right(_NB,Len(_NB)-1)
  Else
    POSE=FindString(_NB,"E")
    If pose>0
      BASEMIN.q=ValD(_NB)
      nbasehex$=_HHQ(basemin,"")
    Else 
      nbasehex$=dec2hex(_NB)   
    EndIf 
  EndIf 
  ;   lnbh=len(nbasehex$)
  ;   nbasehex$=ReplaceString(space(16-lnbh)," ","0")+nbasehex$
  nbasehex$=Right("0000000000000000"+nbasehex$,16)
  If lnbh>16 Or nbasehex$>"FFFFFFFFFFFFFFFE" 
    INFOSAISIE\nbase$=""
    INFOSAISIE\NPLAGE$=""
    ProcedureReturn 2 
    Goto FIN
  EndIf
  ;;;;; recherche d'une racine carré de nb à partir de la différence 
  A1.q=Val("$"+Mid(nbasehex$,9,16))
  A2.q=Val("$"+Mid(nbasehex$,1,8))
;   debug _n(A1)+_n(A2)
  
  NBASE.q=0 
  DIFFB.Q=0
  EnableASM  ;; ici recherche en cours pour évaluer le plus précisément la racine carré des nombres >2^63-1
  MOV eax,dword[p.v_A1]
  MOV dword[p.v_NBASE],eax 
  MOV edx,dword[p.v_A2]
  MOV dword [p.v_NBASE+4],edx
  SUB eax,dword[v_LIMITQ] 
  SBB edx,dword[v_LIMITQ+4]
  MOV dword[p.v_DIFFB],eax 
  MOV dword [p.v_DIFFB+4],edx
  If nbasehex$>LIMIT$
    ;;;;; recherche d'une racine carré de nb à partir de la différence 
    difd.d=DIFFB 
    limitd.d=limitq
    K.d=DIFd/LIMITd ;;;; k est défini sur la plage -1 +1 pour une plage div de +$7FFFFFFFFFFFFFFF à -$7FFFFFFFFFFFFFFF
    RACK.D=Sqr(1+K) ;;;; plage de 0 sqr(2)
    DIVMAXD.d=RACLIM *RACK
    DIVMAX.q=divmaxd  ;;limite de recherche des facteurs premiers  de la base
  Else 
    DIVMAX=Sqr(Val("$"+nbasehex$))
  EndIf  
  ;   IF NBASE < SEQD\PREMDIV
  SYNCDIVIS\SYNCALP=SYNCHRO(NBASE)
  *SCALCUL\NBASEP=NBASE+SYNCDIVIS\SYNCDEC\DIFF 
  *SCALCUL\NBASEDIFS=SYNCDIVIS\SYNCDEC\DIFF
  *SCALCUL\NBASEIND=SYNCDIVIS\SYNCDEC\IND
  *SCALCUL\NBASEPHEX$=_HHQ(*SCALCUL\NBASEP,"")
  *SCALCUL\NBASE=NBASE
  *SCALCUL\NBASE$=_NB
  *SCALCUL\NBASEHEX$=nbasehex$
  *SCALCUL\NBASERAC=DIVMAX
  *SCALCUL\NBASEDIFB=DIFFB
  ; *SCALCUL\NBASEIND=INDBASE
  ; *SCALCUL\NBASEP=NBASEP
  If NBASE>0 And NBASE<SEQD\PREMDIV
    *SCALCUL\NBASEP=SEQD\PREMDIV
  EndIf  
  *SCALCUL\NBASEPHEX$=_HHQ(*SCALCUL\NBASEP,"")
  SYNCDIVIS\SYNCALP=SYNCHRO(*SCALCUL\NBASEP)
  *SCALCUL\NBASEPDIF=SYNCDIVIS\SYNCDEC\DIFF 
  *SCALCUL\NBASEPIND=SYNCDIVIS\SYNCDEC\IND
  difd.d=SYNCDIVIS\SYNCDEC\DIFF
  K.d=DIFd/*SCALCUL\NBASEP ;;;; 
  RACK.D=Sqr(1+K)          ;;;; plage de 0 sqr(2)
  DIVMAXPD.d=*SCALCUL\NBASERAC *RACK
  DIVMAXP.q=divmaxpd  ;;
  if divmaxp<4294967296
    divmaxp+1
  endif 
   *SCALCUL\NBASEPRAC=DIVMAXP
  FIN:
  DisableExplicit
EndProcedure  
Procedure EXTRINFO(NBE$)  
  Protected pose, basmin.q,nbasehex$,lnbh,A1.q,A2.q,NBASE.Q,DIFFE.Q,difd.d,limitd.d,K.d,RACK.d,DIVMAXD.d,DIVMAX.q,NB$,DIFFB.Q
  Static FLAG=0 
  Shared INF_CAL.INFOCALC, INF_CAL3.INFOCALC
  Protected NBl3$,NB_A_TESTER.Q,NB_DE_DIVISEUR_MPAR.Q,NB_DE_DIVISEUR_MAX.d,KEFFICACE.D,LOG2X.d
  EnableExplicit
  Global T1.Q=ElapsedMilliseconds()
  Select FLAG 
    Case 0
      ;   if INFOSAISIE\nbase$=""
      calcul (NBE$,INF_CAL)
      CopyMemory(INF_CAL,INFOSAISIE,SizeOf(INFOCALC))
    Case 1 
      ;       PRiNTN("X PASSAGE  "+_n(FLAG)+_s(NBE$))
      calcul (NBE$, INF_CAL3)
      ;   calcul (NB$)
      INFOSAISIE\NPLAGE$=NBe$
      INFOSAISIE\NPLAGE=INF_CAL3\NBASE
      INFOSAISIE\NPLAGEHEX$=INF_CAL3\NBASEHEX$
      If INFOSAISIE\NPLAGEHEX$>INFOSAISIE\NPLAGEMAX$
        ProcedureReturn 3
        ;         goto FIN 
      EndIf  
      ;**********************************  Recherche infos de NBASE MAX  *********************************** 
      INFOSAISIE\NBASEM=INFOSAISIE\NBASE+INFOSAISIE\NPLAGE
      INFOSAISIE\NBASEMHEX$=_HHQ(INFOSAISIE\NBASEM,"")
      NBl3$="$"+INFOSAISIE\NBASEMHEX$
      INFOSAISIE\NBASEM$=NBl3$
      
      If INFOSAISIE\NBASEMHEX$>LIMIT$
        A1.q=Val("$"+Mid(INFOSAISIE\NBASEMHEX$,9,16))
        A2.q=Val("$"+Mid(INFOSAISIE\NBASEMHEX$,1,8))
        NBASE.q=0 
        DIFFB.Q=0
        EnableASM  ;; ici recherche en cours pour évaluer le plus précisément la racine carré des nombres >2^63-1
        MOV eax,dword[p.v_A1]
        MOV dword[p.v_NBASE],eax 
        MOV edx,dword[p.v_A2]
        MOV dword [p.v_NBASE+4],edx
        SUB eax,dword[v_LIMITQ] 
        SBB edx,dword[v_LIMITQ+4]
        MOV dword[p.v_DIFFB],eax 
        MOV dword [p.v_DIFFB+4],edx
        ;;;;; recherche d'une racine carré de nb à partir de la différence 
        difd.d=DIFFB 
        limitd.d=limitq
        K.d=DIFd/LIMITd ;;;; k est défini sur la plage -1 +1 pour une plage div de +$7FFFFFFFFFFFFFFF à -$7FFFFFFFFFFFFFFF
        RACK.D=Sqr(1+K) ;;;; plage de 0 sqr(2)
        DIVMAXD.d=RACLIM *RACK
        DIVMAX.q=divmaxd  ;;limite de recherche des facteurs premiers  de la base
      Else 
        DIVMAX=Sqr(Val("$"+INFOSAISIE\NBASEMHEX$))
      EndIf  
;       INFOSAISIE\NBASEMRAC=DIVMAX+1
      INFOSAISIE\NBASEMRAC=DIVMAX
      
      NB_A_TESTER.Q=INFOSAISIE\NPLAGE
      NB_DE_DIVISEUR_MPAR.Q=INFOSAISIE\NBASEMRAC/2+INFOSAISIE\NBASEPRAC/2
      NB_DE_DIVISEUR_MAX.d=1.00*NB_DE_DIVISEUR_MPAR*NB_A_TESTER
      KEFFICACE.D=SEQD\NBSEQ/SEQD\MODULO
      LOG2X.d=Log(NB_DE_DIVISEUR_MAX)*Log10(#E)/Log10(2)
;       NBDIVISIONE.D=KEFFICACE*NB_DE_DIVISEUR_MAX/LOG10(NB_DE_DIVISEUR_MPAR)
      NBDIVISIONE.D=KEFFICACE*NB_DE_DIVISEUR_MAX
;       LOG2X.d=log(NB_DE_DIVISEUR_MAX)*log10(#e)/log10(2)

;       NBMILIS.D=NBDIVISIONE
;       PRINTN("Nombre de divisions max à effectuer :"+strd(NBDIVISIONE,2));;+" Evaluation du temps en ms : "+strd(NBMILIS))
      PrintN("Nombre de divisions max à effectuer :"+StrD(NBDIVISIONE,2))

      ;;;*********** RECXHERCHE DE LA FUTURE  RACINE  et RACINE*RACINE*************************************
      ;   delta=SEQD\TDIF(INFOSAISIE\NBASEPIND)
      ;   INFOSAISIE\FUTBASERAC=INFOSAISIE\NBASEPRAC+delta
      ;   INFOSAISIE\FUTBASE=INFOSAISIE\FUTBASERAC*INFOSAISIE\FUTBASERAC
    Case 2
;       PRiNTN("X PASSAGE  "+_n(FLAG))
    Case 3 
;       PRiNTN("X PASSAGE  "+_n(FLAG))
    Case 4
;       PRiNTN("X PASSAGE  "+_n(FLAG))
  EndSelect
;   PRiNTN("X PASSAGE  "+_n(FLAG)+_s(NBE$))
  FLAG+1 
  
  ;   ProcedureReturn 0
  ; FIN:
  ; logB1MIN=Log10(B1MIN)
  ; logmax=Log10(max-B1MIN)
  ; If logB1MIN+logmax>22
  ;   rmes=MessageRequester(" ATTENTION Temps très long","Oui=>continuez Non=>donnez autre zone",#PB_MessageRequester_YesNo)
  ;   If Rmes = 6        ; le bouton Oui a été choisi (Resultat = 6)
  ;   Else               ; le bouton Non a été choisi (Resultat = 7)
  ;     Goto SAISIE2
  ;   EndIf
  ; EndIf
  DisableExplicit
EndProcedure

Procedure SAISIEBASEPLAGE()
  Protected mess$,nb$,pos,NBASE$,NPLAGE$,reto.l,NBASE.q,DIFFF.Q,NPLAGEMAX$,logB1MIN.D, logmax.D, rmes,hhqhex$,NBASE2.Q
  EnableExplicit
  mess$=""
  SAISIE2:
  mess$+"Base Zone ex: 98765 1E3, $FF875 1E9 ,1E9 1E4"
  
  If Len(mess$)>120
    MessageRequester("Erreur Relancez le Prg","Base  +Zone à explorer Ex: 98765 +1E3, $FF875 1E9, 1E9 +1E4 "+#CR$+"Relancez le prg") ;
    End
  EndIf ;;;                                                                                         7FFFFFFFFFFFFFFF
  nb$=UCase(LTrim(InputRequester(mess$,"Base Zone Ex:98765 1E3, $FF875 1E9, 1E9 1E4","$7FFFFFFFFFFFFF00 +1E3")));
  pos=FindString(nb$," ")
  NBASE$=Trim(Left(nb$,pos))
  NPLAGE$=Trim(Right(NB$,Len(nb$)-pos))
  
  reto.l=EXTRINFO(NBASE$)
  If retO>0
    Goto saisie2
  EndIf 
  ;;;;;;************* Recherche de la plage max possible à utiliser *****************
  NBASE.q=INFOSAISIE\NBASE
  DIFFF.Q=0
  MOV eax,$FFFFFFFE
  MOV edx,$FFFFFFFF
  SUB eax,dword[p.v_NBASE] 
  SBB edx,dword[p.v_NBASE+4]
  MOV dword[p.v_DIFFF],eax 
  MOV dword [p.v_DIFFF+4],edx
  NPLAGEMAX$=_HHQ(DIFFF,"" )
  
  ;   NPLAGEMAX$=_HHQ(DIFFF,"")
  ;   lnbh=len(NPLAGEMAX$)
  ;   NPLAGEMAX$=ReplaceString(space(16-lnbh)," ","0")+NPLAGEMAX$
  INFOSAISIE\NPLAGEMAX$=NPLAGEMAX$
  ;;;*******************************  recherche de la plage à explorer   **************************
  If EXTRINFO(NPLAGE$)
    Goto saisie2
  EndIf 
  INFOSAISIE\NPLAGEMAX$=NPLAGEMAX$
    ;   ProcedureReturn 0
    ; FIN:
  NBASE2.Q=DIVI64_32Q(NBDIVISIONE,10)
  logB1MIN=log10(NBASE2)+1
  logmax=log10(INFOSAISIE\NPLAGE)
  If logB1MIN+logmax>15
    rmes=MessageRequester(" ATTENTION Temps très long","Oui=>continuez Non=>donnez autre zone",#PB_MessageRequester_YesNo)
    If Rmes = 6        ; le bouton Oui a été choisi (Resultat = 6)
    Else               ; le bouton Non a été choisi (Resultat = 7)
      Goto SAISIE2
    EndIf
  EndIf

  
  DisableExplicit
EndProcedure
EnableExplicit
Define NB_TOT_DIVIS.q,pos1,k,B1MIN$,B1MINPHEX$,B1MINHEX$,MAX_DIV.SYNCHRO,PAS_IND_NB
OpenConsole()
T1.q=ElapsedMilliseconds()
choixdiv()
SAISIEBASEPLAGE()
PrintN("Fin de la mise en place  temps="+Str(ElapsedMilliseconds()-T1))
MAX=INFOSAISIE\NBASEM
MAXHEX$=_HHQ(MAX,"")
B1MIN=INFOSAISIE\NBASEP
B1MIN_DEP=B1MIN
resultat$=""
NB_TOT_DIVIS=0
presultat$="02 03 05 07 11 13 17 19 23 29 31"
If INFOSAISIE\NBASE=>0 And INFOSAISIE\NBASE < SEQD\NBPFACT 
  pos1=FindString(presultat$,right("0"+str(INFOSAISIE\NBASE),2))
;   pos1=FindString(presultat$,Str(INFOSAISIE\NBASE))
  pose=FindString(presultat$,right("0"+Str(SEQD\NBPFACT),2))+2
  resultat$=trim(Mid(presultat$,pos1,POSE-pos1))
  NB_TOT_DIVIS=CountString(resultat$," ")+1
;   CreateRegularExpression(0,"[0-9]+"
  If CreateRegularExpression(0,"[0-9]+")
    Dim TResult$(0)
    Nb = ExtractRegularExpression(0,resultat$, TResult$())
    For k = 0 To Nb-1
      Select Right(Tresult$(k),1)
        Case "1"
          TABTERMIN(1)+1
        Case "2"   
          TABTERMIN(0)+1
        Case "3"   
          TABTERMIN(2)+1
        Case "5"   
          TABTERMIN(0)+1
        Case "7"   
          TABTERMIN(3)+1
        Case "9"
          TABTERMIN(4)+1
      EndSelect
    Next
  Else
    Debug RegularExpressionError()
  EndIf
  
;   NB_TOT_DIVIS=(POSE-POS1)/2
  ;   B1MIN=SEQD\NBPFACT
EndIf   

; ******** sysnchronistion des Nombres à tester avec le vecteur des différences ***********
IND_NB=INFOSAISIE\NBASEPIND
B2DIVIS.q=SEQD\PREMDIV
flagfin=0
; B2MAXDIV.q=Pow(B1MIN,0.5)
B2MAXDIV.q=INFOSAISIE\NBASEPRAC  ;;;;;******************************************************
                                 ; MAXMAXDIV.q=Sqr(MAX)   ;;;;;****************************************************** 
MAXMAXDIV.q=INFOSAISIE\NBASEMRAC ;;;;;****************************************************** 
; if B2MAXDIV>MAXMAXDIV
;   B2MAXDIV=MAXMAXDIV
; endif  
PrintN(_n(MAXMAXDIV) +_n(B2MAXDIV))
PrintN(resultat$)

If B1MIN<0
  centm=B1MIN/-100
Else 
  centm=B1MIN/100
EndIf  
;;;;; ***************************** Gestion des diviseurs max *********************
MAX_DIV\SYNCALP =SYNCHRO(B2MAXDIV)
B2IND_MAXDIV=MAX_DIV\SYNCDEC\IND
DIF_MAXDIV=MAX_DIV\SYNCDEC\DIFF
P_MAXDIV=B2MAXDIV+DIF_MAXDIV
; B2MAXDIV=P_MAXDIV
; if MAXMAXDIV-B2MAXDIV<>0
;   *B2MAXDIV=SYNCHRO(B2MAXDIV)
;   B2IND_MAXDIV=*MAXDIV\IND_SYNCHRO
;   DIF_MAXDIV=*MAXDIV\DIFF_SYNCRO
; B2MAXDIV+DIF_MAXDIV

;******************************************************************************************************************
;;****** le prochain B2MAXDIV (A+dif)^2=A^2+2*dif*A+dif^2=  si A=SQR(X)=RAC donc (RAC^2)=X alors => (RAC+dif)^2= (RAC^2)+dif^2+2*dif*RAC=X+dif+(2*RAC*dif)
;;;********************* X+dif(1+2*RAC)
; RAC2=DIF_MAXDIV *(2*B2MAXDIV+DIF_MAXDIV)
; B1MINRAC2=B1MIN+RAC2





; =Str(B1MIN)+" "
B2DIVISm=0
nbseq_1.q=SEQD\NBSEQ-1
nbseq=SEQD\NBSEQ
nbseqp=nbseq+1
dep_time.q=ElapsedMilliseconds()
; B2PAS=SEQD\TDIF(1)
;;;***************************************************************************************************************************
;;;***************************  Début des 2 boucles pour rechercher  les NB premiers dans une zone MIN MAX   *****************
;;;***************************************************************************************************************************
;;;***************************************************************************************************************************
;;;*****  Début de la première boucle avec incrémentation des Nombrss le la zone donnéepour savoir s'ils sont premiers  *******
;;;***  fin de la boucle jusqu'à Until où l'on teste si le nb après incrémention est toujour dan la zone donnée         *******
;;;***************************************************************************************************************************
Repeat 
  B2INDDD=1
  B2PAS=SEQD\TDIF(B2INDDD)
  ;   PRINTN(_NL+_N(B2DIVIS))
  ;;;***************************************************************************************************************************
  ;;;*****  Début de la deuxième boucle avec incrémentation des diviseurs du premier Nb X au dessus de p_fact(X)         *******
  ;;;***                                  jusqu'à la racine du Nb à tester                                               *******
  ;;;***************************************************************************************************************************
  ;;; Info propre à boucle div=B2
  While B2DIVIS<=B2MAXDIV; or FLAGFIN>0
    
    ;   printn(_n(B2DIVIS)+_n(B2PAS)+_n(idivis))
    ;     ;Le nom de @@: signifie étiquette anonyme,vous pouvez avoir défini un grand nombre d'entre eux dans la source.
    ;     ;Symbole @b(ou l'équivalent @r)le plus proche des références du label précédent anonyme
    ;     ;,symbole @f références plus proche de l'étiquette suivante anonyme.
    ;     ;Ces symboles spéciaux sont insensibles à la casse.
    ;;*******************************  TESTS EN ASM ********************************************************************
    ;*************************************** Division d'un nombre de 64 bits par un nombre de 32 bits ******************************************
    EnableASM
    MOV ecx,dword[v_B2DIVIS]
    XOR EDX,EDX
    MOV eax,dword[v_B1MIN+4]
    DIV ecx
    ;   MOV dword[v_quotientp],eax   ;;;; Le reste de la division nous suffit 
    MOV eax,dword[v_B1MIN]
    DIV ecx
    CMP edx,0
    JNZ @f
    INC dword [v_FLAGFIN] 
    Break
    !@@:
    MOV edx,dword[v_B2PAS]
    ADD dword[v_B2DIVIS],edx  ; pas de PB l'addition est réalisée en valeur absolue 
    ADC dword[v_B2DIVIS+4],0  ; pas de PB l'addition est réalisée en valeur absolue 
                              ;     donc $FFFFFFFF =>4294967295 donc pas de risque de dépassement sqr(pow(2,63)-1))=>3037000499,9760496922867524030306 <4294967295
                              ;********************************************************************************************************************************************************
    
    DisableASM
    ;********************************************************************************************************************************************************
    ;********************************************************************************************************************************************************
    ; ;***********************************  Pour accélerer encore l' algo  *******************************
    B2INDDD+1
    If B2INDDD=nbseqp  ;;; inutil de passer en ASM  voir ci dessus c'est plus long de près du double en temps sur la zone  9223372036854774807 1000
      B2INDDD=1        ;;;;;9223372036854770999
    EndIf
    B2PAS=SEQD\TDIF(B2INDDD)
    EnableASM
    ;************************************  Pour accélerer encore l' algo vous pouvez décommentez les 5 lignes PB précedentes ******************************
  Wend
  ;;;;*******************************************************************************************************************************************************
  ;;;; ***********************************************  FIN DE LA DEUXIEME  BOUCLE DES DIVISEUR *************************************************************
  ;;;; ***********************************************  FIN DE LA DEUXIEME  BOUCLE DES DIVISEUR *************************************************************
  ;;;;*******************************************************************************************************************************************************
  If flagfin=0 and B1MIN<>1
    If B1MIN<0
      cent=B1MIN/-100
    Else 
      cent=B1MIN/100
    EndIf  
    If centm<>cent 
      PrintN(result$)
      centm=cent 
      If B1MIN<0 
        B1MIN$=HEX2DEC(_HHQ(B1MIN,""))
      Else 
        B1MIN$=Str(B1MIN)
      EndIf  
      result$=B1MIN$+" " 
    Else 
      If B1MIN<0 
        B1MIN$=HEX2DEC(_HHQ(B1MIN,""))
      Else 
        B1MIN$=Str(B1MIN)
      EndIf  
      result$+B1MIN$+" " 
    EndIf
    NB_TOT_DIVIS+1
    PREM_1_3_7_9(B1MIN) ;;;; R&partition des Nb premiers par terminaison 1 3 7 9 ******************
  EndIf 
  ;       printn(_NL+_Q(B1MIN)+_s(result$)+_n(FLAGFIN))
  flagfin=0
  B1MINPHEX$=B1MINHEX$
  PAS_IND_NB=seqd\TDIF(ind_nb)
;   B1MIN+ seqd\TDIF(ind_nb) 
  B1MIN+ PAS_IND_NB 
 
  B1MINHEX$=_HHQ(B1MIN,"")

  ;;;*******************************************************************************************************************************************************************
  ;;; On peut anticiper la prochaine racine différente de celle actuelle (A+1)^2 =A^2+1+2A si A=SQR(X)=RAC donc (RAC^2)=X alors => (RAC+1)^2= (RAC^2)+1+2*RAC=X+1+(2*RAC)
  ;;; le mini de diff est 2 donc (A+2)^2 =A^2+4+4A si A=SQR(X)=RAC donc (RAC^2)=X alors => (RAC+2)^2= (RAC^2)+4+4*RAC=X+4+(4*RAC);;;*******************************************************************************************************************************************************************
  ;;; le mini de diff est D donc (A+D)^2 =A^2+D^2+2AD si A=SQR(X)=RAC donc (RAC^2)=X alors => (RAC+D)^2= (RAC^2)+D^2+2D*RAC=X+D^2+(2*D*RAC);;;*******************************************************************************************************************************************************************
  ;;; cette technique pose des pb pour les nombres premiers à trouver < au premier diviseur 
  If B1MIN =>B1MINRAC2 
    if B1MIN > SEQD\PREMDIV ;;;; Valeurs toujours <$7FFFFFFFFFFFFFFF;
  ; Il faudrait prendre le prochain diviseur dans le vecteur des différences avec la gestion de cet indice B2IND_MAXDIV essai en cours 
;     RAC2=DIF_MAXDIV*(2*B2MAXDIV+DIF_MAXDIV)
    RAC2=2*PAS_IND_NB* B2MAXDIV +(PAS_IND_NB*PAS_IND_NB)
    B1MINRAC2=B1MIN+RAC2
    B2MAXDIV.q=Sqr(B1MIN)+PAS_IND_NB+1
    ;     B1MINRAC2.Q=B1MIN+(4*B2MAXDIV)+4
   Else
    RAC2=4* B2MAXDIV +4
    B1MINRAC2=B1MIN+RAC2
    B2MAXDIV.q=Sqr(B1MIN)+2

  EndIf 
  endif
  
;   If B1MIN =>B1MINRAC2  ;;;; Valeurs toujours <$7FFFFFFFFFFFFFFF;;; avec pas mini de 2
;     RAC2=4* B2MAXDIV +4
;     B1MINRAC2=B1MIN+RAC2
;     B2MAXDIV.q=Sqr(B1MIN)+2
; ;     B1MINRAC2.Q=B1MIN+(4*B2MAXDIV)+4
;   EndIf  

  
  ;   IF B1MINRAC2>0
;     printn(_NL+_S(B1MINHEX$)+_s(MAXHEX$)+_n(B2MAXDIV)+_n(B1MINRAC2)+_n(FLAGFIN))
;   endif

  ; 	If B2DIVIS =>B2MAXDIV
  ; 	  
  ;   endif
  B2DIVIS=SEQD\PREMDIV 
  ind_nb+1
  ; 	if ind_nb>SEQD\NBSEQ-1
  If ind_nb>NBSEQ_1
    ind_nb=0  ;;; remise à zéro si le cycle des différences est atteint pour incrémentation des nombres susceptibles d'être premiers
  EndIf  
;       printn(_NL+_S(B1MINHEX$)+_s(MAXHEX$)+_n(B2MAXDIV)+_s(result$)+_n(FLAGFIN)+_n(CENTM)+_n(CENT))
;       PrintN(_NL+_S(B1MINHEX$)+_s(MAXHEX$)+_n(B2MAXDIV)+_n(B1MINRAC2)+_n(B2PAS)+_n(FLAGFIN))
  If B1MINHEX$<B1MINPhex$
;         printn(_NL+_s(B1MINHEX$)+_s(MAXhex$)+_n(B2MAXDIV))
    B1MINHEX$=MAXHEX$
  EndIf
;   paspas=seqd\TDIF(ind_nb)
;     printn(_s(B1MINHEX$)+_s(MAXhex$)+_n(B2MAXDIV)+_n(paspas))
Until B1MINHEX$=>MAXHEX$ ;;; Or B1MIN<0 ;;Si vous n'allez pas aux confins de la machine =$7FFFFFFFFFFFFFFF ;;; = 9223372036854775807 valeur max positive en ..q. 
 ;;                        Vous pouvez retirer (or B1MIN<0) ou dépassement de $7FFFFFFFFFFFFFFF
 ;;;;***********************************************************************************************************************************************************
 ;;;; ***********************************************  FIN DE LA PREMIERE  BOUCLE DES Nb à TESTER **************************************************************
 ;;;; ***********************************************  FIN DE LA DEUXIEME  BOUCLE DES Nb à TESTER  *************************************************************
 ;;;;***********************************************************************************************************************************************************

PrintN(result$)
; PrintN( "Nombre Minimal = "+Str(INFOSAISIE\NBASE)+"  Nombre Maximal = "+Str(MAX))
PrintN( "Nombre Minimal = "+HEX2DEC(_HHQ(INFOSAISIE\NBASE,""))+"  Nombre Maximal = "+HEX2DEC(_HHQ(MAX,"")))
PrintN("Nombre d'éléments du vecteur =:"+Str(SEQD\NBSEQ)+"  temps de préparation ="+Str(delta_deb))

PrintN("Temps millisecondes ="+Str(ElapsedMilliseconds()-dep_time))
PrintN("Nombre de nb premiers ="+Str(NB_TOT_DIVIS)+"  Nb de divisions /miliseconde = "+STRd(NBDIVISIONE/(ElapsedMilliseconds()-dep_time)))
Resultat$=""
For K=1 To 4
  Select K
    Case 1
      resultat$="Termine PAR 1="+Str(TABTERMIN(1))
    Case 2
      resultat$+" PAR 3="+Str(TABTERMIN(2))
    Case 3
     resultat$+" PAR 7="+Str(TABTERMIN(3))
   Case 4
     resultat$+" PAR 9="+Str(TABTERMIN(4))
  EndSelect    
Next 
resultat$+ "  PAR 2 ET 5  ="+Str(TABTERMIN(0))
PrintN(resultat$)
Input() 
CloseConsole()

; ***************** Ci dessous les Nombres premiers pour les 1000 premiers nombres
; 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97
; 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199
; 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293
; 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397
; 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499
; 503 509 521 523 541 547 557 563 569 571 577 587 593 599
; 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691
; 701 709 719 727 733 739 743 751 757 761 769 773 787 797
; 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887
; 907 911 919 929 937 941 947 953 967 971 977 983 991 997
Ps :
Lors de la mise au point des 2 prg, j’ai eu quelques Problèmes à obtenir des résultats satisfaisants dans la zone entre 2^63 et 2^64-1
Comme les pièges dans cette zone sont fréquents et que les tests représentent un nombre extrêmement important il n’est pas impossible que vous trouviez un bug.
Veuillez me le signaler et merci d’avance.

A+
Il est fort peu probable que les mêmes causes ne produisent pas les mêmes effets.(Einstein)
Et en logique positive cela donne.
Il est très fortement probable que les mêmes causes produisent les mêmes effets.
Haut
Répondre

Revenir à « Trucs et astuces »