[Calc] Décomposition en facteurs premiers

Vos meilleures macros et portions de code sont publiées dans cette section.
Aucun support sur une question de programmation ici !

Modérateur : Vilains modOOs

Règles du forum
Aucune question dans cette section !
Celle-ci rassemble les meilleures macros et portions de code. Vous pouvez en revanche commenter ou argumenter le code exposé. Vous pouvez même remercier l'auteur (cela fait toujours plaisir) en indiquant par exemple dans quel cadre ou contexte vous en avez eu l'utilité.
Si vous avez à poster quelque chose, faites-le depuis la section Macros et API et demandez à un modérateur de l'y déplacer.
Avatar de l’utilisateur
poissonbleu
Membre OOrganisé
Membre OOrganisé
Messages : 57
Inscription : 13 nov. 2011 16:46

[Calc] Décomposition en facteurs premiers

Message par poissonbleu »

Bonjour,
Voici un programme qui permet de décomposer un nombre en produit de facteurs premiers et je vous le présente.
J'ai "traduit" pour cela un code qui figurait dans le mode d'emploi d'une calculatrice scientifique, la CASIO fx-8500G, en lui ajoutant quelques perfectionnements:

Code : Tout sélectionner

REM  ***  Ce programme est inspiré sur celui de la calculatrice fx-8500G
Option Explicit
Option Base 1
Dim Entry as Double
Dim Verify as Double
Dim Factor as Long
Dim Result (0) As String
Dim FilterValue As String
Dim AntNumb As String
Dim PosFirstChar as Integer
Dim MsgString As String
Dim EWC As Long
Dim NVFA As Long
Dim CountNumb As Integer
Dim ActStr as String
Dim AllStr As String
Dim ActPos As Integer
Dim DefNbr as Long
Dim DefNbr2 as Long
Dim Pos as Long
Dim AntPos as Long
Const Msg as String = "Analyse de facteurs premiers"
	Sub Start
Defnbr = 1
FilterValue = inputBox ("Veuillez entrer un nombre afin de le décomposer en produit de facteurs premiers (pas de 0 ni de 1, ni de nombres trop grands !)" & _
chr$(13) & "Attention ! Si votre nombre est grand, l'opération peut prendre du temps.", Msg, AntNumb)
Entry = FilterValue
EWC = Entry
If FilterValue = ""then stop
If entry = "1" or entry = "0" then call OnError
'If msgBox ("Les nombres vont être affichés un par un.", 1, Msg) = 2 then Stop
wait 5
call Step2
End Sub
	Sub OnError
If msgBox ("Votre numéro ne doit pas être 0 ou 1. Veuillez en changer.", 48, Msg) = 1 then call Start else stop
end Sub
	Sub Step1
'If msgBox (2, 1, Msg) = 2 then Stop
Incluse (2)
Entry = entry/2
If entry = 1 then call step9
		Call Step2
End Sub
	Sub Step2
If Entry/2 = Fix (Entry/2) then call step1 else Factor = 3
		Call Step3
End Sub
	Sub Step3
Verify = Sqr (entry) + 1
		Call Step4
End Sub
	Sub Step4
If Factor >= Verify then call Step8
If Entry/Factor = Fix (entry/factor) then call step6
		Call Step5
End Sub
	Sub Step5
Factor = factor + 2
		Call step4
End Sub
	Sub Step6
If (Entry/Factor*factor-entry) = 0 then call step7 else call step5
End Sub
	Sub Step7
'If msgBox (factor, 1, Msg) = 2 then Stop
Incluse (factor)
Entry = entry/factor
		Call step3
End Sub
	Sub Step8
'If msgBox (entry, 1, Msg) = 2 then Stop
Incluse (entry)
		Call Step9
End Sub
	Sub Step9
MsgString = "Solution: " & chr$(13) & EWC & " = " & join (Result, " x ") & " " & Chr$(13) & chr$(13) & _
"Désirez-vous recommencer avec un autre nombre ? "
PosFirstChar = inStr (MsgString, " x ")
Mid (MsgString, PosFirstChar, 3, "")
call ExpCh
If result (UBound (result)) = EWC then msgString = "Solution: " & chr$(13) & "Votre nombre était déjà premier." & Chr$(13) & chr$(13) & _
"Désirez-vous recommencer avec un autre nombre ? "
'If msgBox ("L'opération et finie. Voulez-vous recommencer avec un autre nombre ?", 4+32+256, Msg) = 6 then
If msgBox (MsgString, 4+256, msg) = 6 then
ReDim result (0) : AntPos = 0 : Pos = 0 : DefNbr = 0 : DefNbr2 = 0 : msgstring = "" : AntNumb = EWC : EWC = 0 : CountNumb = 0 : ActPos = 0 : ActStr = "" : AllStr = ""
call Start
else
msgBox ("Alors, au revoir !", 0, Msg)
Stop
EndIf
End Sub

Sub Incluse (ActFactor As Long)
NVFA = UBound (result)
ReDim Preserve Result (NVFA)
Result (UBound (Result)) = ActFactor
End Sub

Function ConvertToExposantValue (Number As Long)
AllStr = ""
For CountNumb = 1 to Len (number)
ActPos = Mid (CStr (number), countNumb, 1)
If ActPos = 0 then
ActStr = "⁰"
else
ActStr = choose (actPos, "¹", "²", "³", "⁴", "⁵", "⁶", "⁷", "⁸", "⁹")
endIf
AllStr = AllStr & ActStr
Next
ConvertToExposantValue() = AllStr
End Function

Sub ExpCh()
Do until defNbr = entry + 1
defNbr = defNbr + 1
AntPos = 14 + Len (EWC)
	Do until defNbr2 = EWC - 1
	If InStr (antPos, MsgString, " " & DefNbr & " ") then
		If defNbr2 = 0 then Pos = InStr (antPos, MsgString, DefNbr)
	AntPos = inStr (antPos, msgString, DefNbr) + 1
	DefNbr2 = defNbr2 + 1
	else
	Exit Do
	End If
	Loop
If inStr (msgString, defNbr) and defnbr2 > 1 then
Mid (MsgString, Pos, len (defNbr)*defnbr2 + 3*(defNbr2 - 1), defNbr & convertToExposantValue (defNbr2)) : EndIf
DefNbr2 = 0
Loop
End Sub
J'espère que mon programme servira !
Au revoir !
Le Modérateur a écrit :Toute question à poser dans le fil initial :[Calc] Programme de décomposition en facteurs premiers
Dernière modification par Papayes le 13 nov. 2011 20:42, modifié 4 fois.
Raison : Déplacement en suprême de code du message initial
OpenOffice.org 4.1.1 sous Windows 7 (sans Math ni Base)

attention aux requins
et plouf !
Répondre