Réduction d'un nombre en un produit d'entier dans un intervalle [Résolu]

Signaler
Messages postés
23
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
1 février 2010
-
Messages postés
14675
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
4 juillet 2020
-
Voilà bonjour à tous,

J'ai essayé de faire un titre pertinent pour ma demande, car je coince un peu là.

Je souhaiterais pouvoir retrouver tous les produits de nombres entiers possibles d'un chiffre dans un intervalle donné.

un exemple est plus parlant qu'autre chose.

-toutes les solutions:
12 1*12 2*6 = 3*4 = 3*2*2 .... plusieurs solutions pour ce cas
-selon un intervalle [3,5] par ex:
12 = 3*4 1seule solution pour ce cas

Bon ici pour l'exemple j'ai pris un chiffre qui est faisable en simple calcul mentale, mais quand on tombe sur 1620 dans l'intervalle [2,20] ca ce complique ...

J'ai bien essayé d'automatiser ca seul mais ca devient trop compliqué selon les intervalles, en me servant de la fonction modulo.

Sub Reduction(ByVal Rapport As Integer)
Dim x As Double
Dim i, r As Integer

i = 0
r = 0

Do Until x < 0
i = i + 1
x = (Rapport / i) - i
If Not x < 0 Then
If Rapport Mod i = 0 Then
ReDim Preserve ResultModulo(r)
ResultModulo(r) = (i & ":" & Rapport / i)
r = r + 1
End If
End If
Loop
End Sub

ceci me renvoie pour le chiffre 30 sans intervalle :

1:30
2:15
3:10
5:6

Donc je réussis bien à décomposer mon chiffre le problème se pose dès que les intervalles interviennent.

Par ex: 30 dans [2;10], il nous resterait:

3:10
5:6

mais il reste aussi le 2:15 à traiter car 15>10 et donc une autre solution serait : 2:3:5

Si mon résultat dépasse 2 entiers ca devient trop compliqué en utilisant cette méthodes ou bien j'ai mal organisé mes calculs.

Pouvez-vous m'aider svp :) ?

merci d'avance.

LC

5 réponses

Messages postés
14675
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
4 juillet 2020
143
Bonsoir,

Je te propose une autre implémentation, un peu plus complexe, mais qui fonctionne (enfin qui semble fonctionner, les tests réalisés étant simples) :

    Sub Main()
        Dim lNum As Integer = 60
        Dim lMin As Integer = 2
        Dim lMax As Integer = 20

        Dim ltSolutions As String() = Decompose(GetPrimary(lNum), lMin, lMax, 1)

        Dim ltShows As New List(Of String)
        For Each lStr As String In ltSolutions
            lStr = lStr.Trim(":"c)
            ReOrder(lStr)
            If Not ltShows.Contains(lStr) Then
                ltShows.Add(lStr)
            End If
        Next

        For Each lStr As String In ltShows
            Console.WriteLine(lStr)
        Next

        Console.ReadKey()
    End Sub

    Private Function GetPrimary(ByVal pNumber As Integer) As Integer()
        Dim ltRes As New List(Of Integer)
        Dim lActDiv As Integer = 2

        Do While (lActDiv * lActDiv) <= pNumber
            If (pNumber Mod lActDiv) = 0 Then
                ltRes.Add(lActDiv)
                pNumber \= lActDiv
            ElseIf lActDiv = 2 Then
                lActDiv = 3
            Else
                lActDiv += 2
            End If
        Loop

        If pNumber > 1 Then
            ltRes.Add(pNumber)
        End If

        Return ltRes.ToArray
    End Function

    Private Function Decompose(ByVal ptValues As Integer(), ByVal pMin As Integer, ByVal pMax As Integer, ByVal pPreviousNumber As Integer) As String()
        Dim ltRes As New List(Of String)

        If ptValues.Length = 1 Then
            'Il ne reste plus qu'un seul élément, on réduit donc les appels

            If pPreviousNumber = 1 Then
                If ptValues(0) <= pMax And ptValues(0) >= pMin Then
                    Return New String() {ptValues(0).ToString}
                Else
                    Return New String() {}
                End If
            Else
                If ptValues(0) * pPreviousNumber <= pMax And ptValues(0) * pPreviousNumber >= pMin Then
                    ltRes.Add((ptValues(0) * pPreviousNumber).ToString)
                End If
                If ptValues(0) <= pMax And ptValues(0) >= pMin Then
                    ltRes.Add(":" + ptValues(0).ToString)
                End If
                Return ltRes.ToArray
            End If
        End If

        Dim ltValues As New List(Of Integer)
        Dim lLastValue As Integer = 0

        'On commence en multipliant, si on n'a pas d'antécédent, on ignore
        If pPreviousNumber > 1 Then
            For Each lInt As Integer In ptValues
                'On ne test pas 2 fois de suite la même valeur 
                If lInt = lLastValue Then Continue For
                lLastValue = lInt

                'Si on ne peut plus multiplier (car dépassement de la borne inférieure), on sort
                If pPreviousNumber * lInt > pMax Then Continue For

                'On initialise le tableau
                ltValues.Clear()
                ltValues.AddRange(ptValues)
                ltValues.Remove(lInt)

                'On calcul et traite le résultat
                For Each lStr As String In Decompose(ltValues.ToArray, pMin, pMax, lInt * pPreviousNumber)
                    If lStr.Substring(0, 1) = ":" Then
                        'Si on n'atteind pas le min, on n'enregistre pas
                        If lInt * pPreviousNumber >= pMin Then
                            ltRes.Add((lInt * pPreviousNumber).ToString + lStr)
                        End If
                    Else
                        ltRes.Add(lStr)
                    End If
                Next



            Next
        End If


        lLastValue = 0
        'Puis sans multiplier
        For Each lInt As Integer In ptValues
            'On ne test pas 2 fois de suite la même valeur 
            If lInt = lLastValue Then Continue For
            lLastValue = lInt

            'On initialise le tableau
            ltValues.Clear()
            ltValues.AddRange(ptValues)
            ltValues.Remove(lInt)

            'On calcul et traite le résultat
            For Each lStr As String In Decompose(ltValues.ToArray, pMin, pMax, lInt)
                If lStr.Substring(0, 1) = ":" Then
                    'Si on n'atteind pas le min, on n'enregistre pas
                    If lInt >= pMin Then
                        ltRes.Add(":" + lInt.ToString + lStr)
                    End If
                Else
                    ltRes.Add(":" + lStr)
                End If
            Next
        Next

        Return ltRes.ToArray
    End Function

    Private Sub ReOrder(ByRef pStr As String)
        Dim ltValues As New SortedDictionary(Of Integer, Integer)

        Dim lInt As Integer

        For Each lStr As String In pStr.Split(":"c)
            lInt = Integer.Parse(lStr)
            If ltValues.ContainsKey(lInt) Then
                ltValues.Item(lInt) += 1
            Else
                ltValues.Add(lInt, 1)
            End If
        Next

        Dim ltStr As New List(Of String)
        For Each lPair As KeyValuePair(Of Integer, Integer) In ltValues
            For i As Integer = 1 To lPair.Value
                ltStr.Add(lPair.Key.ToString)
            Next
        Next

        pStr = String.Join(":", ltStr.ToArray)
    End Sub


A mettre dans une application console.

Ce code s'appuie sur une fonction récursive.

Si tu a des questions, pas de problèmes.

Messages postés
14675
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
4 juillet 2020
143
Bonjour,

En effet, j'ai mis une bonne heure à apporter une solution à ton problème :)

Voilà le code un peu plus commenté
    ''' <summary>
    ''' Fonction principale du programme
    ''' </summary>
    ''' <remarks></remarks>
    Sub Main()
        Dim lNum As Integer = 60 'Nombre à décomposer
        Dim lMin As Integer = 2 'Borne mimimum
        Dim lMax As Integer = 20 'Borne maximum

        'Alors là, on fait plusieurs choses :
        'On décompose en facteurs premiers
        'Et on cherche les différentes solutions
        Dim ltSolutions As String() = Decompose(GetPrimary(lNum), lMin, lMax, 1)

        'Ici on supprime les doublons
        Dim ltShows As New List(Of String)
        For Each lStr As String In ltSolutions
            lStr = lStr.Trim(":"c)
            ReOrder(lStr)
            If Not ltShows.Contains(lStr) Then
                ltShows.Add(lStr)
            End If
        Next

        'puis on affiche
        For Each lStr As String In ltShows
            Console.WriteLine(lStr)
        Next

        'Là on attend pour fermer le programme, car l'utilisateur n'est pas assez rapide pour lire le résultat sinon ;)
        Console.ReadKey()
    End Sub

    ''' <summary>
    ''' Retourne les facteurs premiers d'un nombre
    ''' </summary>
    ''' Nombre à décomposer


    ''' <returns>Retourne un tableau d'entier, contenant les facteurs premiers</returns>
    ''' <remarks></remarks>
    Private Function GetPrimary(ByVal pNumber As Integer) As Integer()
        'Liste des facteurs premiers
        Dim ltRes As New List(Of Integer)
        'Facteur de test actuel
        Dim lActDiv As Integer = 2

        'Tans que le nombre à décomposer est supéreiru ou égale au carré du diviseur actuellement testé
        'Car si x²>Nombre, c'est que Nombre est premier
        Do While (lActDiv * lActDiv) <= pNumber
            ''Est-ce que lActDiv est un diviseur de pNumber
            If (pNumber Mod lActDiv) = 0 Then
                'Oui, donc on l'ajoute et on le retire de pNumbre
                ltRes.Add(lActDiv)
                pNumber \= lActDiv
            ElseIf lActDiv = 2 Then
                'Non, si lActDiv=2, on le passe à 3
                'Car on test les diviseurs par 2, 3, 5, 7, 9, ...
                lActDiv = 3
            Else
                'Non, si lActDiv<>2, on y ajoute 2 (ça permet de sauter les multiples de 2)
                lActDiv += 2
            End If
        Loop

        'Si pNumber <> 1 c'est que c'est aussi un diviseur
        If pNumber > 1 Then
            'Donc on l'ajoute
            ltRes.Add(pNumber)
        End If

        'Et on retourne le résultat.
        Return ltRes.ToArray
    End Function

    ''' <summary>
    ''' Fonction récursive pour la décomposition
    ''' </summary>
    ''' Tableau des valeurs à tester


    ''' Borne minimale de l'interval


    ''' Borne maximale de l'interval


    ''' Valeur au niveau précédent


    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function Decompose(ByVal ptValues As Integer(), ByVal pMin As Integer, ByVal pMax As Integer, ByVal pPreviousNumber As Integer) As String()
        'Liste des résultats
        Dim ltRes As New List(Of String)

        'Si il ne reste plus qu'une seule valeur, c'est que l'on a terminé
        If ptValues.Length = 1 Then
            If pPreviousNumber = 1 Then
                'Là on a un seul niveau
                'si c'est dans les bornes, on prend, sinon, on rejette
                If ptValues(0) <= pMax And ptValues(0) >= pMin Then
                    Return New String() {":" + ptValues(0).ToString}
                Else
                    Return New String() {}
                End If
            Else
                'Oon multiplie la valeur précédente avec la valeur restante et on vérifie si c'est bon
                If ptValues(0) * pPreviousNumber <= pMax And ptValues(0) * pPreviousNumber >= pMin Then
                    ltRes.Add((ptValues(0) * pPreviousNumber).ToString)
                End If
                'Et la valeur seule ?
                If ptValues(0) <= pMax And ptValues(0) >= pMin Then
                    ltRes.Add(":" + ptValues(0).ToString)
                End If
                'On retourne le résultat
                Return ltRes.ToArray
            End If
        End If

        'Ici il reste encore des vlaeurs à tester.

        'Liste temporaire
        Dim ltValues As New List(Of Integer)
        'Dernière valeur testée
        Dim lLastValue As Integer = 0

        'On commence en multipliant, si on n'a pas d'antécédent on ignore
        If pPreviousNumber > 1 Then
            For Each lInt As Integer In ptValues
                'On ne test pas 2 fois de suite la même valeur 
                If lInt = lLastValue Then Continue For
                lLastValue = lInt

                'Si on ne peut plus multiplier (car dépassement de la borne supérieure), on passe au suivant
                If pPreviousNumber * lInt > pMax Then Continue For

                'On initialise le tableau
                ltValues.Clear()
                ltValues.AddRange(ptValues)
                ltValues.Remove(lInt)

                'On calcul et traite le résultat
                For Each lStr As String In Decompose(ltValues.ToArray, pMin, pMax, lInt * pPreviousNumber)
                    If lStr.Substring(0, 1) = ":" Then
                        'Si on n'atteind pas le min, on n'enregistre pas
                        If lInt * pPreviousNumber >= pMin Then
                            ltRes.Add((lInt * pPreviousNumber).ToString + lStr)
                        End If
                    Else
                        ltRes.Add(lStr)
                    End If
                Next
            Next
        End If


        lLastValue = 0
        'Puis sans multiplier
        For Each lInt As Integer In ptValues
            'On ne test pas 2 fois de suite la même valeur 
            If lInt = lLastValue Then Continue For
            lLastValue = lInt

            'On initialise le tableau
            ltValues.Clear()
            ltValues.AddRange(ptValues)
            ltValues.Remove(lInt)

            'On calcul et traite le résultat
            For Each lStr As String In Decompose(ltValues.ToArray, pMin, pMax, lInt)
                If lStr.Substring(0, 1) = ":" Then
                    'Si on n'atteind pas le min, on n'enregistre pas
                    If lInt >= pMin Then
                        ltRes.Add(":" + lInt.ToString + lStr)
                    End If
                Else
                    ltRes.Add(":" + lStr)
                End If
            Next
        Next

        Return ltRes.ToArray
    End Function

    ''' <summary>
    ''' Réorganise la chaine pour mettre les valeurs les plus faibles en premier
    ''' </summary>
    ''' Chaine à réordonnée


    ''' <remarks></remarks>
    Private Sub ReOrder(ByRef pStr As String)
        'Liste des valeurs, Key : valeur, Value : nombre d'occurence
        Dim ltValues As New SortedDictionary(Of Integer, Integer)

        Dim lInt As Integer

        'Listage des valeurs
        For Each lStr As String In pStr.Split(":"c)
            'Parse de la valeur
            lInt = Integer.Parse(lStr)
            'Si valeur connue, on ajoute 1 occurence, sinon on l'ajoute
            If ltValues.ContainsKey(lInt) Then
                ltValues.Item(lInt) += 1
            Else
                ltValues.Add(lInt, 1)
            End If
        Next

        'Reconstruction de la chaine
        Dim ltStr As New List(Of String)
        For Each lPair As KeyValuePair(Of Integer, Integer) In ltValues
            For i As Integer = 1 To lPair.Value
                ltStr.Add(lPair.Key.ToString)
            Next
        Next
        pStr = String.Join(":", ltStr.ToArray)
    End Sub


Sinon pour complément :
Les valeurs retournées sont séparées par des ":".
Dans la recherche récursive, si les ":" sont présents, c'est que la valeur précédente (pPreviousNumber) est ignorée pour cette ligne, donc dans la fonction appelante, on ajoutera cette valeur.
Si les ":" sont absent, c'est que la valeur pPreviousNumber a été utilisée, donc la valeur de la fonction appelante, ne sera pas ajoutée.

En mode pas à pas, ce sera visible facilement.

Messages postés
23
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
1 février 2010

NHenry,

Ce n'est pas la première fois que l'on s'entraide mais là ! je te tire mon chapeau !

Ca marche absolument du tonnerre, mais pour le coup je suis un peu rouillé en prog .net car ca fait quelque mois que je n'ai plus le temps ce qui fait que je suis largué ... ( en plus du fait que tu exploite des fonctions que je ne connaissais pas ... )

Un véritable grand merci à toi, mais bon tout bon programmeur qui se respecte ne se contenterait pas de ca, "hop voilà j'ai mon code je cherche pas à comprendre on oublie ..." non non non j'ai besoin de savoir, de comprendre tous les rouages de ton esprit programme .

Pourrais-tu donc me rajouter des petit commentaires en détaillés sur "chaque" lignes afin de m'aider dans la compréhension de ces routines stp ? Ca serait vraiment sympa

Merci encore

LC

Ah oui encore 1 truc, j'ai besoin de bien tout comprendre car je risque de devoir faire évoluer le code, mais surtout dans un premier temps récupérer certaines valeurs comme le nombre de solution max ...
merci encore
Messages postés
23
Date d'inscription
mardi 13 novembre 2007
Statut
Membre
Dernière intervention
1 février 2010

nhenry,

Merci encore pour tout le travail que tu as fourni (même si je sais que tu y as pris plaisir petit cochon )

Je pense avoir atteins mes limites en termes de programmation avec ce projet car je sais pertinemment après mainte et mainte relecture de ton code que jamais je n'aurais réussi, j'ai même encore du mal à saisir certaine routine ...

J'ai accepté les réponses, choses que j'avais oublié de faire, car bien sur elles sont plus que bonnes !

Merci encore

LC
Messages postés
14675
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
4 juillet 2020
143
Bonjour,

Je comprend facilement ton problème pour comprendre ma logique tordue

J'ai réfléchi plusieurs dizaines de minutes pour trouver une solution, et j'aurais du mal à te l'expliquer

Tu verra dans quelques années, tu sera capable de faire de même si tu continue dans cette voie

Merci pour l'acceptation des réponses