Math : Ecrire un nombre à virgule sous forme de fraction

Partagez votre expérience de PureBasic avec les autres utilisateurs.
G-Rom
Messages : 3641
Inscription : dim. 10/janv./2010 5:29

Re: Math : Ecrire un nombre à virgule sous forme de fraction

Message par G-Rom »

0.034ms Ici 8O
par contre le code (1° du post) du haut me renvois rien :/
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Re: Math : Ecrire un nombre à virgule sous forme de fraction

Message par Le Soldat Inconnu »

j'ai du mettre un nombre à virgule trop petit dans le calcul de Fraction() :mrgreen: j'ai changé
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)]
lepiaf31
Messages : 510
Inscription : dim. 25/mars/2007 13:44
Localisation : Toulouse, France
Contact :

Re: Math : Ecrire un nombre à virgule sous forme de fraction

Message par lepiaf31 »

Chez moi je trouve 0.19 ms. (Processeur Intel SU7300 et Windows 7).
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Re: Math : Ecrire un nombre à virgule sous forme de fraction

Message par Le Soldat Inconnu »

je suis descendu à 0.050ms pour trouver une fraction d'un chiffre limiter à un numérateur et dénominateur compris entre 1 et 10000, ce qui est largement suffisant (après, la mise sous fraction ne veut pas dire grand chose, mais j'arrive à monter à une précision entre 1 et 100000)

Code : Tout sélectionner

Procedure.s Fraction(Valeur.d)
	Protected NewList Reste.q()
	Protected Entier.q, Numerateur.q, Denominateur.q, Reel.d, Signe.q
	
	Reel.d = Abs(Valeur)
	If Reel <> Valeur
		Signe = -1
	Else
		Signe = 1
	EndIf
	Entier = IntQ(ValD(StrD(Reel, 4)))
	; Debug Reel
	; Debug Entier
	While ValD(StrD(Reel, 4)) <> Entier 
		AddElement(Reste())
		Reste() = Entier
		Reel = 1 / (Reel - Entier)
		Entier = IntQ(ValD(StrD(Reel, 4)))
		; Debug Reel
		; Debug Entier
		If ListSize(Reste()) > 32 Or Entier > 10000
			ProcedureReturn ""
		EndIf
	Wend
	
	If ListSize(Reste()) = 0
		ProcedureReturn ""
	EndIf
	
	; Debug ""
	
	Numerateur = Entier
	Denominateur = 1
	; Debug Str(Numerateur) + "/" + Str(Denominateur)
	
	Repeat 
		Swap Numerateur, Denominateur
		Numerateur = Reste() * Denominateur + Numerateur
		; Debug Str(Numerateur) + "/" + Str(Denominateur)
	Until PreviousElement(Reste()) = 0
	
	; Debug ""
	
	If ValD(StrD(Valeur - Signe * Numerateur / Denominateur, 12)) = 0 And Numerateur <= 10000 And Denominateur <= 10000 ; And Str(Denominateur) <> LSet("1", Len(Str(Denominateur)), "0")
		Debug Str(Signe * Numerateur) + "/" + Str(Denominateur)
		ProcedureReturn Str(Signe * Numerateur) + "/" + Str(Denominateur)
	Else
		ProcedureReturn ""
	EndIf
	
EndProcedure

Ok = 0
Max = 10000
Temps1 = ElapsedMilliseconds()
For n = 1 To Max
	Repeat
		Numerateur = Random(9999) + 1
		Denominateur = Random(9999) + 1
	Until Numerateur % Denominateur <> 0 ; Si la division n'est pas entiere
	Debug ""
	Debug Str(Numerateur) + "/" + Str(Denominateur)
	Reel.d = Numerateur / Denominateur
	Texte.s = Fraction(Reel)
	If Texte <> ""
		Ok + 1
	EndIf
Next
Temps2 = ElapsedMilliseconds()

MessageRequester("Fraction", "Détermination bonne : " + Str(Ok) + "/" + Str(Max) + Chr(10) + "Temps d'analyse de " + Str(Max) + " valeurs = " + Str(Temps2 - Temps1) + "ms" + Chr(10) + "Temps d'analyse moyen = " + StrD((Temps2 - Temps1)/Max, 3) + "ms")
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)]
lepiaf31
Messages : 510
Inscription : dim. 25/mars/2007 13:44
Localisation : Toulouse, France
Contact :

Re: Math : Ecrire un nombre à virgule sous forme de fraction

Message par lepiaf31 »

Sinon il y a une méthode plus rapide pour les nombres réels avec un motif qui se répète.
Je prends un exemple c'est plus simple pour expliquer:

13/9 = 1,4444444...
on voit que le motif qui se répète c'est un 4.
donc on pose F notre fraction:
F = 1.4444
10*F = 14.444 (on multiplie par 10^(nombre de chiffres du motif, ici il y en a un: 4))
on soustrait: 10*F - F = 9*F = 14.444 - 1.4444 = 13
donc F = 13 / 9

pour 3.143143, on a:
F = 3.143143
1000F = 3143.143
1000F - F = 999F = 3143.143 - 3.143143 = 3140
F = 3140 / 999

Cette méthode ne marche donc que si il y a un motif qui se répète.

voilà un code:

Code : Tout sélectionner

Structure Fraction
  numerator.i
  denominator.i
EndStructure

Procedure trouverFraction(valeur.d, nbMotif.l, *fraction.Fraction)
  numerator = Pow(10, nbMotif)*valeur - valeur
  denominator = Pow(10, nbMotif)-1
  *fraction\numerator = numerator
  *fraction\denominator = denominator
EndProcedure

frac.Fraction
trouverFraction(1.444, 1, @frac)
Debug Str(frac\numerator) + "/" + Str(frac\denominator)
trouverFraction(3.143143, 3, @frac)
Debug Str(frac\numerator) + "/" + Str(frac\denominator)
lepiaf31
Messages : 510
Inscription : dim. 25/mars/2007 13:44
Localisation : Toulouse, France
Contact :

Re: Math : Ecrire un nombre à virgule sous forme de fraction

Message par lepiaf31 »

Bon voilà une petite fonction qui illustre ce que j'ai dit dans le post précédent (Attention, elle ne marche correctement que si elle trouve un motif qui se répète dans la partie décimale):

Code : Tout sélectionner

Structure Fraction
  numerator.i
  denominator.i
EndStructure

Procedure PGCD(Value1, Value2)
  pgdc = 0
  
  If Value1 = 0 Or Value2 = 0
    ProcedureReturn 1
  EndIf
  
  If Value1 < Value2
    Val = Value1
    Value1 = Value2
    Value2 = Val
  EndIf
  
  If Value1%Value2 = 0
    pgcd = Value1/Value2
  Else
    Dividende = Value1
    Diviseur = Value2
    Reste = 0
    Reste1 = 0
    Repeat
      Reste1 = Dividende%Diviseur
      If Reste1 = 0
        pgcd = Reste
      Else
        Reste = Reste1
      EndIf
      
      Dividende = Diviseur
      Diviseur = Reste
      
    Until Reste1 = 0
  EndIf
  
  ProcedureReturn pgcd
EndProcedure

Procedure findFraction(value.d, *fraction.Fraction)
  str.s = StrD(value, 14)
  
  ;suppression des zeros 
  While Right(str, 1) = "0"
    str = Left(str, Len(str)-1)
  Wend
  nbDec = Len(str)-FindString(str, ".", 1)
  
  ;repérage d'un motif répétitif
  For motifSize=1 To nbDec
    motif.s = Right(str, motifSize)
    nbMotif = 0
    i = Len(str) - motifSize + 1
    While Mid(str, i, motifSize) = motif And i>0
      i - motifSize
      nbMotif + 1
    Wend
    
    If nbMotif >= 2
      Break
    EndIf
  Next
  
  If motifSize > nbDec
    motifSize = nbDec
  EndIf
  
  ;coeff sert à mettre à la partie entière tout ce qui n'est pas identique au motif
  ;par exemple: 8.62121 deviendra 86.2121 (le motif est 21)
  coeff = Pow(10, nbDec - nbMotif*motifSize)
  coeff2 = Pow(10, nbMotif)
  numerator = Int(value * coeff * coeff2) - Int(value*coeff)
  denominator = (coeff2 - 1) * coeff
  
  ;simplification de la fraction
  pgcd = PGCD(numerator, denominator)
  numerator = numerator / pgcd
  denominator = denominator / pgcd
  
  *fraction\numerator = numerator
  *fraction\denominator = denominator
  
EndProcedure

frac.Fraction
findFraction(1.333, @frac)
Debug Str(frac\numerator) + "/" + Str(frac\denominator)
Répondre