Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Cliquez ici pour mettre ce site au démarrage de votre navigateur

AccueilCodesTutorielsForumsEmploiLivresConnexion

begin process at 2009 01 08 06:19:37

3 ARTICLES SUR SQL SERVER (DATA STRUCTURES, SCANS AND SEEKS, DATA ACCESS STRATEGIES) par RaptorXP

MAIS QUE PEUT BIEN FAIRE UN MVP QUAND IL NE CODE PAS ??? par sebmafate

POWERSHELL : COMMENT EXéCUTER UN SCRIPT PS DEPUIS UNE FENêTRE MS DOS OU SCHEDULED TASK par ROMELARD Fabrice

EDM DESIGNER par Matthieu MEZIL

SMALL BASIC - UN PROJET INTéRESSANT par pierrick

RE : COLLECTION par Orohena

REMPLIR DATAGRID EN 2 TABLE VB.NET par tdi2a

RE : COLLECTION par skyla

RE : POURQUOI ISEMPTY(VBEMPTY) RENVOI FALSE ??? par PCPT

+ de logiciels à télécharger

1 329 728 membres
74 nouveaux aujourd'hui
14 640 membres club

Trouver une ressource

Trouvez une ressource parmi 39 269 codes, 1 222 800 messages d'aide etc...

Recherche: dans [ Dernières recherches ]

Filtre:Tous les codes.NET uniquementExclure .NET

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

RACINE CARRÉE (AJOUT AUX FONCTIONS PRÉCÉDENTES)

Information sur la source

Catégorie :Maths Niveau : Débutant Date de création : 17/08/2003 Date de mise à jour : 17/08/2003 21:52:09 Vu : 2 791

Auteur : DHKold

Site perso

Ecrire un message privé

Note :

10,00 / 10

Commentaire sur cette source (9)

Ajouter un commentaire et/ou une note

Description

Voilà, il y a quelques temps, j'avais posté une source avec un ensemble de fonctions mathématiques pour les calculs sur de très grands nombre:
http://www.vbfrance.com/article.aspx?ID=9115
J'avais dit que j'ajouterais des fonctions, c'est chose faite avec celles-ci.

POUR FONCTIONNER, ELLES NECESSITES LES AUTRES FONCTIONS (voir l'autre source).

Source

Public Function racine(nombre As String, reste As Boolean)
If Len(nombre) Mod 2 = 1 Then nombre = "0" & nombre
tmp3 = "0"
For i = 1 To Len(nombre) Step 2
tmp1 = tmp3 & Mid$(nombre, i, 2)
tmp2 = "0"
tmp5 = multi(Mid$(racine, 1), "2")
If i = 1 Then tmp4 = 0: tmp2 = Int(Sqr(tmp1)) ^ 2: a = Int(Sqr(tmp1)): tmp0 = tmp2: GoTo nott
For a = 0 To 10
tmp0 = tmp2
If a < 10 Then tmp2 = multi(tmp5 & Mid$(a, 1), Mid$(a, 1))
If a = 10 Then tmp2 = multi(addition(multi(Mid$(tmp5, 1), "10"), Mid$(a, 1)), Mid$(a, 1))
tmp4 = pgdd(Mid$(tmp2, 1), Mid$(tmp1, 1))
If tmp4 = 0 Then Exit For
If tmp4 = 1 Then Exit For
Next a
nott:
tmp3 = soustraction(Mid$(tmp1, 1), Mid$(tmp0, 1))
racine = racine & Mid(a - tmp4, 1)
Next i
If reste = True Then racine = racine & "r" & tmp3
End Function
Function addit(nombre As String)
For i = 1 To Len(nombre)
addit = addition(Mid$(addit, 1), Mid$(nombre, i, 1))
Next i
End Function
Public Function DecToBin(nombre As String)
Do While nombre <> "0"
bini = Val(Right(nombre, 1)) Mod 2
biny = bini & biny
nombre = divis2(nombre)
Loop
DecToBin = biny
End Function
Public Function divis2(ByVal nombre As String)
suiv = 0: div2 = ""
For i = 1 To Len(nombre)
div2 = div2 & Val(Mid(nombre, i, 1)) \ 2 + suiv
suiv = (Val(Mid(nombre, i, 1)) Mod 2) * 5
Next i
divis2 = zero(Mid$(div2, 1))
End Function

Public Function racine(nombre As String, reste As Boolean)
If Len(nombre) Mod 2 = 1 Then nombre = "0" & nombre
tmp3 = "0"
For i = 1 To Len(nombre) Step 2
    tmp1 = tmp3 & Mid$(nombre, i, 2)
    tmp2 = "0"
    tmp5 = multi(Mid$(racine, 1), "2")
    If i = 1 Then tmp4 = 0: tmp2 = Int(Sqr(tmp1)) ^ 2: a = Int(Sqr(tmp1)): tmp0 = tmp2: GoTo nott
    For a = 0 To 10
        tmp0 = tmp2
        If a < 10 Then tmp2 = multi(tmp5 & Mid$(a, 1), Mid$(a, 1))
        If a = 10 Then tmp2 = multi(addition(multi(Mid$(tmp5, 1), "10"), Mid$(a, 1)), Mid$(a, 1))
        tmp4 = pgdd(Mid$(tmp2, 1), Mid$(tmp1, 1))
        If tmp4 = 0 Then Exit For
        If tmp4 = 1 Then Exit For
    Next a
nott:
    tmp3 = soustraction(Mid$(tmp1, 1), Mid$(tmp0, 1))
    racine = racine & Mid(a - tmp4, 1)
Next i
If reste = True Then racine = racine & "r" & tmp3
End Function

Function addit(nombre As String)
For i = 1 To Len(nombre)
addit = addition(Mid$(addit, 1), Mid$(nombre, i, 1))
Next i
End Function

Public Function DecToBin(nombre As String)
Do While nombre <> "0"
bini = Val(Right(nombre, 1)) Mod 2
biny = bini & biny
nombre = divis2(nombre)
Loop
DecToBin = biny
End Function

Public Function divis2(ByVal nombre As String)
suiv = 0: div2 = ""
For i = 1 To Len(nombre)
div2 = div2 & Val(Mid(nombre, i, 1)) \ 2 + suiv
suiv = (Val(Mid(nombre, i, 1)) Mod 2) * 5
Next i
divis2 = zero(Mid$(div2, 1))
End Function

Conclusion

::RACINE CARREE::
----------------------

racine(nombre, reste)

renvoie la racine entière de nombre, si reste vaut TRUE, renvoie la racine de nombre entière suivit de 'r' et du reste.

:: Decimal en Binaire :: || MàJ ||
--------------------------

DecToBin(nombre)

renvoie la valeur binaire (1 et 0) de nombre, je l'ai améliorée de facon à la rendre plus rapide (beaucoup plus rapide).

:: Division par 2 ::
---------------------

C'est grace à cette fonction que DecToBin est plus rapide, elle peut être utilisée de préférence à la fonction Division, mais n'a été créer que pour la fonction DecToBin

:: Addition des chiffres du nombre ::
-----------------------------------------

Addit(nombre)

Renvoie la somme des chiffres composants le nombre.
EXEMPLE: addit ("223") renvoie 2+2+3, soit 7.

RAPPEL: NECESSITE LES AUTRES FONCTIONS:
http://www.vbfrance.com/article.aspx?ID=9115

Sources du même auteur

ENSEMBLE DE FONCTION MATHÉMATIQUE (POUR TRES GRAND NOMBRES)

DHCUT - SPLITEUR, RÉ-ASSEMBLEUR (COUPER ET RECONSTRUIRE UN F...

EXTRAIRE LE NOM DU FICHIER D'UN CHEMIN

GÉNÉRATEUR DE TEXTE DYNAMIQUE

CONVERTISSEUR PRO BETA 1.0

Toutes les sources de DHKold

Sources de la même categorie

ANALYSE SPECTRALE SOUS EXCEL (TFR OU FFT) par Patrice99

RÉSOLUTION DE L'ÉQUATION DE LA CHALEUR par Arnal88

CALCULETTE POUR PROGRAMMEUR par Galactus13

OPERATIONS MATRICIELLES par yass21

CONVERTIR DÉC-BIN-OCT-HEX par titpeanut

Toutes les sources de la catégorie Maths

Commentaires et avis

Commentaire de Kaizen le 27/07/2004 16:25:40

Bravo pour l'esprit de partage d'une telle qualité de travail...
Hormis le typage, ce code fonctionne aussi sur OpenOffice.Org
La division est cependant très lente.
Un petit rajout de la fonction Puiss(x,y) serait sympa
et un Carre(x) = Multi(x,x)

Commentaire de Kaizen le 05/08/2004 10:07:03

La racine ne fonctionne pas toujours...

Pour Puiss(x,y) j'ai fait ça :

Private Function puiss(x As String, expo)
Dim p As String
Dim i As Integer
p = "1"
i = 1
   Do While i <= expo
     p = multi(p, x)
     i = i + 1
   Loop
puiss = p
End Function

Commentaire de Renfield le 05/08/2004 11:15:47 administrateur CS

Pourquoi utiliser des String ?

Commentaire de Kaizen le 05/08/2004 17:52:29

Je crois que c'est pour éviter une notation scientifique et outrepasser la limite des type de donnée lors de calcul sur des nombres astronomiques.

Commentaire de Renfield le 06/08/2004 23:32:46 administrateur CS

J'avais posté sur l'autre source une version améliorée du code...... si ca en interesse quelques uns, j'aimerai bien vos avis...... surtout toi, DHKold

Commentaire de Kaizen le 09/08/2004 09:47:55

Pour ma part, c'est justement ta version que j'utilise.
L'amélioration porte sur le typage, la lisibilité du code, les calculs préalables hors boucle.
L'intérêt du code étant de travailler sur des grands nombres et de l'utiliser à travers excel, une compilation sous C++ n'apporterait pas grand chose, si ce n'est de se traîner avec une DLL de plus.
Ce qui reste à creuser, c'est l'algorithme. Preuve en est sur Divis2(x) par rapport à Divis(x,2,faux)
Pour Racine(x) qui ne fonctionne pas, il faudrait réussir :
Puiss(x;0,5)
Mais ce code ne travaille pas avec les nombres à virgule.

Voire au delà de l'algorithme, ce qui reste à creuser c'est la connaissance des facteurs premiers de grands nombres, surtout quand il n'y en a que deux...

Commentaire de DHKold le 19/09/2004 18:38:16

Désolé, j'étais absent ces derniers mois. Dès que j'ai le temps (rarement), je corrige les erreurs. Mais je ne ferai sans doute pas de gros ajouts, étant donné que je pense lacher en grande partie VB, pour travailler sur un language de bas-niveau comme l'assembleur, en parrallèle avec du C#/C++

Commentaire de OBI76 le 15/01/2005 22:46:45

c pas du tout comme ça que ca fonctionne dans la réalité, ils ne font que des développements limités... tu peux faire toutes les fonctions comme ça (a^b = e^b*ln(a)) c récurent et atteint une certaine précision au bout d'un certain nombre d'itération, maintenant ce qu'il faudrai voir c combien.....)

Commentaire de Kaizen le 17/01/2005 08:17:35

Salut Cédric,

  La racine n'ayant pas été corrigée, je te propose une racine entière qui fonctionne sous VBA...

Private Function Racin(nombre As String)
Dim NbImp As String
Dim LeReste As String
Dim Sous As String
If Len(nombre) Mod 2 = 1 Then nombre = "0" & nombre
NbImp = 1
LeReste = ""
For I = 1 To Len(nombre) Step 2
  Tranche = Mid$(nombre, I, 2)
  LeReste = LeReste & Tranche
  Sous = "1"
  Do
    If Mid$(LeReste, 1, 1) <> "-" Then
      LeReste = soustraction(Mid$(LeReste, 1), Mid$(NbImp, 1))
    Else
      LeReste = addition(Mid$(LeReste, 2), Mid$(NbImp, 1))
      LeReste = "-" & LeReste
    End If
    NbImp = addition(Mid$(NbImp, 1), "2")
    Sous = addition(Mid$(Sous, 1), "1")
    cond = Mid$(LeReste, 1, 1)
  Loop While cond <> "-" Or cond = "0"
  Sous = soustraction(Sous, 2)
  NbImp = soustraction(Mid$(NbImp, 1), "2")
  If Left$(LeReste, 1) = "-" Then
    LeReste = soustraction(Mid$(LeReste, 2), Mid$(NbImp, 1))
    LeReste = Mid$(LeReste, 2)
  Else
    LeReste = addition(Mid$(LeReste, 1), Mid$(NbImp, 1))
  End If
  NbImp = soustraction(Mid$(NbImp, 1), "2")
  NbImp = addition(multi(addition(Mid$(NbImp, 1), 1), 10), 1)
  res = res & Sous
Next
Racin = zero(Mid$(res, 1))
End Function