Integer Square/Cubic Root finder

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Guimauve
Messages : 1015
Inscription : mer. 11/févr./2004 0:32
Localisation : Québec, Canada

Integer Square/Cubic Root finder

Message par Guimauve »

Bonjour à tous,

J'ai eu besoin d'une fonction pour trouver la racine carré entière d'un entier et en faisant une recherche, je suis tombé sur un pseudo code qui ne fonctionnait pas mais l'idée de son fonctionnement était très intéressante. Il est certain que j'aurais pu faire un truc du genre :

Code : Tout sélectionner

Int(Sqr(Mon_entier))
mais je voulais une solution fonctionnant uniquement avec des entiers. La recherche de la racine s'effectue de façon dichotomique et c'est relativement rapide pour trouver la réponse. La fonction retourne -1 si l'entier n'a pas de racine carré entière.

P.S. J'ai ajouté la racine cubique par la suite juste pour m'amuser un peu. Le fonctionnement est le même

Code : Tout sélectionner

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Nom du projet : Integer Square/Cubic Root
; Nom du fichier : IntegerSquareCubicRoot.pb
; Version du fichier : 1.0.0
; Programmation : OK
; Programmé par : : Guimauve
; Date : 14-06-2010
; Mise à jour : 14-06-2010
; Code PureBasic : 4.50
; Plateforme : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  
Procedure.q IntegerSquareRoot(Value.q)
  
  A.q = 0
  B.q = 6074000999
  Root.q = -1
  
  While A <= B
    
    D.q = (A + B) >> 1
    D1.q = D * D
    
    If Value > D1
      A = D + 1
    ElseIf Value < D1
      B = D - 1
    Else
      Root = D
      A = B + 1
    EndIf 
    
  Wend
  
  ProcedureReturn Root
EndProcedure 
  
Procedure.q IntegerCubicRoot(Value.q)
  
  A.q = 0
  B.q = 4194303
  Root.q = -1
  
  While A <= B
    
    D.q = (A + B) >> 1
    D1.q = D * D * D
    
    If Value > D1
      A = D + 1
    ElseIf Value < D1
      B = D - 1
    Else
      Root = D
      A = B + 1
    EndIf 
    
  Wend
  
  ProcedureReturn Root
EndProcedure 
  
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< !!! ATTENTION - CODE D'ESSAI !!! <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  
For Index = 0 To 1500
  
  Result01.l = IntegerSquareRoot(Index)
  
  If Result01 = -1
    ;Debug Str(Index) + " n'a pas de racine carrée entière."
  Else
    Debug Str(Index) + " a une de racine carrée entière. --> " + Str(Result01) + "X" + Str(Result01) + " = " + Str(Index)
  EndIf 
  
  Result02.l = IntegerCubicRoot(Index)
  
  If Result02 = -1
   ; Debug Str(Index) + " n'a pas de racine cubique entière."
  Else
    Debug Str(Index) + " a une de racine cubique entière. --> " + Str(Result02) + "X" + Str(Result02) + "X" +  Str(Result02) + " = " + Str(Index)
  EndIf 
  
  ; Debug ""
  
Next 
  
; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< FIN DU FICHIER <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<
A+
Guimauve
Dernière modification par Guimauve le sam. 19/juin/2010 3:54, modifié 1 fois.
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Re: Integer Square/Cubic Root finder

Message par Le Soldat Inconnu »

il y a plus simple, regarde :) et plus rapide aussi

Code : Tout sélectionner

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Nom du projet : IntegerSquareRoot
; Nom du fichier : IntegerSquareRoot.pb
; Version du fichier : 1.0.0
; Programmation : OK
; Programmé par : : Guimauve
; Date : 14-06-2010
; Mise à jour : 14-06-2010
; Code PureBasic : 4.50
; Plateforme : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure.q IntegerSquareRoot(Value.q)
	
	A.q = 0
	B.q = 9223372036
	
	Root.q = -1
	
	While A <= B
		
		D.q = (A + B) >> 1
		D1.q = D * D
		
		If Value > D1
			A = D + 1
		ElseIf Value < D1
			B = D - 1
		Else
			Root.q = D
			A = B + 1
		EndIf
		
	Wend
	
	ProcedureReturn Root
EndProcedure

Procedure.q SquareRoot(Value.q)
	Protected SqrReturn.d
	SqrReturn = Sqr(Value)
	If SqrReturn = Int(SqrReturn)
		ProcedureReturn SqrReturn
	Else
		ProcedureReturn -1
	EndIf
	
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< !!! ATTENTION - CODE D'ESSAI !!! <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Temps1 = ElapsedMilliseconds()
For Index = 0 To 100000
	
	Result01.l = IntegerSquareRoot(Index)
	
	If Result01 = -1
		;Debug Str(Index) + " n'a pas de racine carrée entière."
	Else
		Debug Str(Index) + " a une de racine carrée entière. --> " + Str(Result01) + "X" + Str(Result01) + " = " + Str(Index)
	EndIf
	
Next
Temps2 = ElapsedMilliseconds()
For Index = 0 To 100000
	
	Result03.l = SquareRoot(Index)
	
	If Result03 = -1
		;Debug Str(Index) + " n'a pas de racine carrée entière."
	Else
		Debug Str(Index) + " a une de racine carrée entière. --> " + Str(Result03) + "X" + Str(Result03) + " = " + Str(Index)
	EndIf
	
	; Debug ""
	
Next
Temps3 = ElapsedMilliseconds()
MessageRequester("Speed test", "Guimauve : " + Str(Temps2 - Temps1) + Chr(10) + "LSI : " + Str(Temps3 - Temps2))

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< FIN DU FICHIER <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Guimauve
Messages : 1015
Inscription : mer. 11/févr./2004 0:32
Localisation : Québec, Canada

Re: Integer Square/Cubic Root finder

Message par Guimauve »

Le Soldat Inconnu a écrit :il y a plus simple, regarde :) et plus rapide aussi
Je le sais très bien sauf que ton astuce utilise un calcul avec des nombres réels (Float) ce que je voulais éviter à n'importe quel prix.

Voilà

A+
Guimauve
Répondre