[Résolu][Calc] Décomposition en facteurs premiers

Discussions et questions sur tout ce qui concerne la programmation tous langages et tous modules confondus.

Modérateur: Vilains modOOs

Règles du forum
:alerte: Balisage obligatoire dans cette section !
Aidez-nous à vous aider au mieux en balisant correctement votre question : reportez-vous sur les règles de cette section avant de poster !

[Résolu][Calc] Décomposition en facteurs premiers

Messagepar poissonbleu » 13 Nov 2011 17:23

:P Bonjour à tous,

(J'aimerais transporter ce programme dans la section "Suprême de code")
J'ai fait un programme génial 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   AgrandirRéduire
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 !
Dernière édition par Bidouille le 14 Nov 2011 15:12, édité 1 fois.
Raison: Balisage ajouté
OpenOffice.org 4.1.1 sous Windows 7 (sans Math ni Base)

attention aux requins
et plouf !
Avatar de l’utilisateur
poissonbleu
Membre OOrganisé
Membre OOrganisé
 
Message(s) : 57
Inscrit le : 13 Nov 2011 16:46

Re: [Basic] Programme de décomposition en facteurs premiers

Messagepar Jean-Louis Cadeillan » 13 Nov 2011 19:56

Bonjour et bienvenue sur le forum,
Merci pour cette contribution :super:
Voir aussi CMathOOoCAS
Cordialement
Jean-Louis
LibreOffice 6.1.5.2 (x64) et Apache OpenOffice 4.1.5, Windows 7 Édition Intégrale 64 SP1, Java (x64) 1.8.0_201 (Domicile)
LibreOffice 5.4.1.2 (x86) sous Linux Karoshi 5.0 (Ubuntu LTS 16.04.1, noyau 4.4.0-93) et Xfce 4.12, Java (x86) 1.8.0_131 (Travail)
Avatar de l’utilisateur
Jean-Louis Cadeillan
ManitOOu
ManitOOu
 
Message(s) : 4257
Inscrit le : 03 Jan 2009 00:56

Re: [Calc]Programme de décomposition en facteurs premiers

Messagepar joel275 » 14 Nov 2011 11:01

Bonjour,

Le programme de décomposition en facteurs premiers ci-dessus pouvant être long voir interminable selon les nombres à décomposer, je l'ai remodelé un peu pour pouvoir y mettre un pare-fou (selon l'excellente expression de Jean-Louis):

Code : Tout sélectionner   AgrandirRéduire
Function FacteursPremiers(Nb as Double)
Dim Decomp as String, Facteur as Long, Expo as Long, Div as Double
   ' 24 secondes avec 909091*909091
   Facteur = 2         
   If nb < 2 Then Exit Function
   Do
      Div = nb/Facteur
      If Div = Fix(Div) Then
         expo = expo + 1
         nb = Div
      Else
         If Expo > 0 Then  Decomp = Decomp & " * " & Facteur & IIf(Expo = 1, "","^" & Expo)
         Facteur = Facteur + 2 + (Facteur = 2)
         If Facteur * Facteur > nb or Facteur > 1000000 Then Exit Do
         Expo = 0
      End If
   Loop
   If Facteur > 1000000 Then MsgBox "Je ne suis pas sûr que " & nb & " soit premier, mais je n'ai pas trouvé de diviseur inférieur à 1 000 000"
   FacteursPremiers = Mid(Decomp & IIf(nb = 1, "","*" & nb), 4)
End Function


 Ajout : Merci Churay: c'est corrigé! 

A plus

Joël
Dernière édition par joel275 le 14 Nov 2011 12:39, édité 1 fois.
OpenOffice 4.1.2 LibreOffice 5-4-6 Windows 8.1
joel275
PassiOOnné
PassiOOnné
 
Message(s) : 716
Inscrit le : 10 Jan 2009 09:05

Re: [Calc]Programme de décomposition en facteurs premiers

Messagepar Churay » 14 Nov 2011 11:35

Bonjour

joel275 a écrit:Le programme de décomposition en facteurs premiers ci-dessus pouvant être long voir interminable selon les nombres à décomposer

Ou très court si le nombre est sérieusement de bonne taille (par exemple : 909091*909091)...
L'imbrication d'appels provoquant chacun un empilement d'adresses de retour dirige droit vers un Stack Overflow...

Cette bécane n'est pas un monstre de puissance, mais la macro de Joel boucle en 12s pour 909091*909091 (LO 3.4.3 ou OOo 3.2.1) si l'on remplace
If nb < 2 Then Exit Sub par If nb < 2 Then Exit Function
cOOordialement
---
AOO 4.0.1 W7-PRO & LO 5.1.6.2 Debian 7.8 & Ubuntu 16.04 LTS
---
F1 : ça aide...
XRay + SDK :super:
---
Quand le NOT CONFIRMED sera corrigé (OOo et LO) , je serai heureux...
Avatar de l’utilisateur
Churay
ManitOOu
ManitOOu
 
Message(s) : 2668
Inscrit le : 30 Avr 2009 05:54
Localisation : CATALUNYA

Re: [Calc]Programme de décomposition en facteurs premiers

Messagepar poissonbleu » 14 Nov 2011 14:06

Merci beaucoup à tous d'avoir pris la peine de me répondre ! Je suis content que mon programme ait servi ! :D

 Ajout : J'oubliais de remercier joel275 car son programme, outre la rapidité, a un autre avantage : il est capable de décomposer des nombres plus grands que dans le mien.
Et merci encore à tous d'avoir passé de temps pour moi ! 


 Ajout : Mais il n'a malheureusement pas l'avantage d'afficher les exposants "en petit" (exemple : 2³). On peut d'ailleurs utiliser ma fonction ConvertToExposantValue afin de convertir les nombres en exposant. 
Dernière édition par poissonbleu le 14 Nov 2011 14:44, édité 2 fois.
OpenOffice.org 4.1.1 sous Windows 7 (sans Math ni Base)

attention aux requins
et plouf !
Avatar de l’utilisateur
poissonbleu
Membre OOrganisé
Membre OOrganisé
 
Message(s) : 57
Inscrit le : 13 Nov 2011 16:46

Re: [Calc]Programme de décomposition en facteurs premiers

Messagepar bm92 » 14 Nov 2011 14:17

Bonjour,
Wikipedia renvoie notamment à cette page web permettant de décomposer un nombre quelconque (programme réalisé en Java).
Bernard

OpenOffice.org 1.1.5 fr / Apache OpenOffice 4.1.1 / LibreOffice 5.0.5.2 (X64)
MS-Windows 7 SP1 64bits Familial
bm92
ManitOOu
ManitOOu
 
Message(s) : 2562
Inscrit le : 26 Nov 2005 14:42

Re: [Résolu][Calc] Décomposition en facteurs premiers

Messagepar joel275 » 14 Nov 2011 17:36

Re,
qu'à cela ne tienne, voilà de quoi afficher le résultat dans les règles de l'art grâce au module Math d'Ooo

Code : Tout sélectionner   AgrandirRéduire
Function FacteursPremiers(Nb as Double)
Dim Decomp as String, Facteur as Long, Expo as Long, Div as Double, nb as Double
Dim  oVCursor as Object, obj as object, oCursor as Object
   Facteur = 2         
   If nb < 2 Then Exit Function
   Do
      Div = nb/Facteur
      If Div = Fix(Div) Then
         expo = expo + 1
         nb = Div
      Else
         If Expo > 0 Then  Decomp = Decomp & " times " & Facteur & jdIIf(Expo = 1, "","^" & Expo)
         Facteur = Facteur + 2 + (Facteur = 2)
         If Facteur * Facteur > nb or Facteur > 1000000 Then Exit Do
         Expo = 0
      End If
   Loop
   If Facteur > 1000000 Then MsgBox "Trop long! Je ne suis pas sûr que " & nb _
   & " soit premier, mais je n'ai pas trouvé de diviseur inférieur à " & Facteur: Exit Function
   Decomp = Mid(Decomp & jdIIf(nb = 1, ""," times " & nb), 8)
   FacteursPremiers = Decomp
' Affiche le résultat dans le document Texte en cours grâce au module Math
   oVCursor = ThisComponent.CurrentController.ViewCursor
   oCursor = oVcursor.Text.createTextCursorByRange(oVCursor)
   obj=ThisComponent.CreateInstance("com.sun.star.text.TextEmbeddedObject")
   With obj   
      .CLSID="078B7ABA-54FC-457F-8551-6147e776a997"
       .AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
        oCursor.Text.InsertTextContent(oCursor, obj, true)
       .EmbeddedObject.Formula = Decomp
        .EmbeddedObject.FontVariablesIsItalic = False
      .EmbeddedObject.SetModified(true)
   End With
   oVCursor.goLeft(1,False)            ' Désélectionne l'objet Math
   oVCursor.goRight(1,False)
End Function


A plus
Joël
OpenOffice 4.1.2 LibreOffice 5-4-6 Windows 8.1
joel275
PassiOOnné
PassiOOnné
 
Message(s) : 716
Inscrit le : 10 Jan 2009 09:05

Re: [Résolu][Calc] Décomposition en facteurs premiers

Messagepar poissonbleu » 14 Nov 2011 19:58

Bonjour Joel, et merci de votre réponse. Au revoir !

 Ajout : Mais pourquoi utilisez-vous une fonction Basic, alors qu'elle ne renvoie pas de valeur ?
(le résultat est affiché dans un document texte) 
OpenOffice.org 4.1.1 sous Windows 7 (sans Math ni Base)

attention aux requins
et plouf !
Avatar de l’utilisateur
poissonbleu
Membre OOrganisé
Membre OOrganisé
 
Message(s) : 57
Inscrit le : 13 Nov 2011 16:46


Retour vers Macros et API

Qui est en ligne ?

Utilisateur(s) parcourant ce forum : Aucun utilisateur inscrit et 7 invité(s)