Réduction d'un nombre en un produit d'entier dans un intervalleRésolu

Question

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

NHenry · Accepted Answer

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.

whitelegend030 · Answer

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

NHenry · Answer

Bonjour, En effet, j'ai mis une bonne heure à apporter une solution à ton problème :) Voilà le code un peu plus commenté '''

''' Fonction principale du programme '''

''' 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 '''

''' Retourne les facteurs premiers d'un nombre '''

''' Nombre à décomposer ''' Retourne un tableau d'entier, contenant les facteurs premiers ''' 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 '''

''' Fonction récursive pour la décomposition '''

''' Tableau des valeurs à tester ''' Borne minimale de l'interval ''' Borne maximale de l'interval ''' Valeur au niveau précédent ''' ''' 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 '''

''' Réorganise la chaine pour mettre les valeurs les plus faibles en premier '''

''' Chaine à réordonnée ''' 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.

whitelegend030 · Answer

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

NHenry · Answer

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

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

5 réponses

Votre réponse

Discussions similaires