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 :
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
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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.
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; 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)]