IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

petit problème de permutations


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Nouveau membre du Club
    Inscrit en
    Juillet 2010
    Messages
    7
    Détails du profil
    Informations forums :
    Inscription : Juillet 2010
    Messages : 7
    Par défaut petit problème de permutations
    Bonjour à vous,
    N'ayant jamais reçu de formation en programmation et devant actuellement faire un petit algo en VBA, je suis confronté à un souci. Je suis tombé sur cet excellent site, et j'aurais souhaité profiter de vos lumières

    Voilà mon problème :
    J'aimerais créer un algorithme pour calculer la formule suivante (écrite avec les connaissances que j'ai en info, c'est-à-dire nulles, donc désolé à l'avance si la formulation est mauvaise) :
    R = somme(i=1 à n+1, i * ((i-1) sommes(j=1 à n, produit(h prenant comme valeurs l'ensemble des indices de mes i-1 sommes, (1-fh)) * produit(k=1 à n avec k différent de l'ensemble des indices de mes i-1 sommes, fk)))

    Je me rends compte que c'est pas très clair, donc je donne comme exemple, pour i=1 :
    on a : 1 * (pas de somme puisque i-1 = 0)(pas de premier produit, puisqu'il n'y a pas de somme donc pas d'indice) produit(k=1 à n, fk) = f1*f2*...*fn
    pour i=2 :
    on a : 2 * somme(j=1 à n, produit(h=j, (1-fh)) * produit(k=1 à n et k <> j, fk)) = 2*(1-f1)*f2*f3*...*fn + 2*(1-f2)*f1*f3*f4*...*fn + ... + 2*(1-fn)*f1*f2*...*f(n-1)
    i = 3, on aura de même : 3*(1-f1)*(1-f2)*f3*f4*...*fn + 3*(1-f1)*(1-f3)*f2*f4*...*fn + ... + 3*(1-f(n-1))*(1-fn)*f1*f2*...*fn
    ...
    i = n+1 : (n+1)*(1-f1)*(1-f2)*...*(1-fn)

    Et R est donc la somme de tous ces termes. Pour chaque i, tous les fi apparaissent, mais une fois chacun, et ceux qui ne sont pas dans le premier produit sont dans le deuxième.

    J'espère que ça aide un peu à comprendre...

    J'ai réfléchi à plusieurs solutions possibles. N'étant pas un informaticien, je me suis lancé d'abord dans un algo pour traduire mathématiquement la formule, évidemment je n'y suis pas arrivé. Voilà les deux solutions que j'ai essayées pour l'instant (les cellules que je prends dans excel sont mes fi, placés dans la deuxième colonne à partir de la ligne 199 jusqu'à la ligne 210):


    Sol1 :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    Sub Calcul_indice()
    Sheets("distances").Select
    n = 12
    o = 198
    Range("J229").Select
     
    ThisWorkbook.Worksheets("distances").Cells(500, 2) = ""
    ThisWorkbook.Worksheets("distances").Cells(501, 2) = 1
    R = (1 - ThisWorkbook.Worksheets("distances").Cells(500, 2))
    P = ThisWorkbook.Worksheets("distances").Cells(501, 2)
    S = 0
    Q = 1
    X = 1
    aux = 1
    pipo = 1
    pipette = 1
     
    For i = 1 To n + 1
        If i = 1 Then
            For k = 1 To n
                X = X * ThisWorkbook.Worksheets("distances").Cells((o + k), 2)
            Next k
        Else
            For j = 1 To n
                For t = 1 To i - 1
                    R = R * (1 - ThisWorkbook.Worksheets("distances").Cells((o + j), 2))
                Next t
     
                For u = i To n
                    If j = n Then
                        P = 1
                    Else
                        For m = 1 To n And m <> j
                            P = P * ThisWorkbook.Worksheets("distances").Cells((o + m), 2)
                        Next m
                    End If
                Next u
            Next j
        S = S + i * P * R
        End If
     
     
    Next i
    S = S + X
     
    ThisWorkbook.Worksheets("distances").Cells(229, 10) = S
     
    End Sub
    Cette solution marche pour i=1 (normal puisque j'en ai fait un cas à part) et i=2. Malheureusement elle ne laisse pas apparaître la variation de termes dans mes produits.
    Sinon au début j'avais fait :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    Sub Calcul_indice()
    Sheets("distances").Select
    n = 12
    o = 198
    Range("J229").Select
     
    ThisWorkbook.Worksheets("distances").Cells(500, 2) = ""
    ThisWorkbook.Worksheets("distances").Cells(501, 2) = 1
    R = (1 - ThisWorkbook.Worksheets("distances").Cells(500, 2))
    P = ThisWorkbook.Worksheets("distances").Cells(501, 2)
    S = 0
    Q = 0
    X = 0
    aux = 0
    pipo = 1
    pipette = 1
     
    For j = 1 To (n + 1)
        If j <> 1 Then
            For k = (o + 1) To (o + j - 1)
                pipo = 1 - ThisWorkbook.Worksheets("distances").Cells(k, 2)
                pipette = pipette * pipo
            Next k
        Else: pipette = 1
        End If
        R = pipette
        pipette = 1
     
        If j <> (n + 1) Then
            For h = (o + j) To (o + n)
                pipo = ThisWorkbook.Worksheets("distances").Cells(h, 2)
                pipette = pipette * pipo
            Next h
        Else: pipette = 1
        End If
        P = pipette
        pipette = 1
     
        If (P * R) = 1 Then
                aux = 0
        Else: aux = j * P * R
        End If
        S = S + aux
        P = 1
        R = 1
        aux = 0
    Next j
     
    X = S
    P = 1
    R = 1
     
    For i = 2 To n
     
        For j = 1 To n
            For k = (o + 1) To (o + j)
                If (o + i) <> k Then
                    pipo = 1 - ThisWorkbook.Worksheets("distances").Cells(k, 2)
                Else: pipo = 1
                End If
                pipette = pipette * pipo
            Next k
        R = pipette
        pipette = 1
     
            For h = (o + j) To (o + n)
                If (o + j - 1 + i) <> h Then
                    pipo = ThisWorkbook.Worksheets("distances").Cells(h, 2)
                Else: pipo = 1
                End If
                pipette = pipette * pipo
            Next h
        P = pipette
        pipette = 1
     
            If (P * R) = 1 Then
                aux = 0
            Else: aux = j * P * R
            End If
            Q = Q + aux
        Next j
     
    Next i
    X = X + Q
    ThisWorkbook.Worksheets("distances").Cells(229, 10) = X
     
     
    End Sub
    Mais j'avais redondance de termes, et malgré plusieurs tentatives de bidouillage, je n'ai pas trouvé le moyen de m'en affranchir autrement qu'en faisant n cas particuliers (ce qui n'est pas vraiment le but...).

    Pour info, à l'avenir, je serai amené à travailler sur des fi avec n différent de 12. Voilà pourquoi j'introduis n et non 12.

    Ensuite, j'ai réfléchi à faire un tableau à une ligne et n colonne, rempli de tous les arrangements possibles de 1 et de 0 (soit 16 possibilités pour n = 4 par exemple), puis d'aller chercher mes 0 et mes 1 dans le tableau et essayer de les remplacer respectivement par mes termes du premier et du second produit.
    Malheureusement, je suis incapable de formaliser ça. Je découvre tout juste la programmation et les algorithmes, et j'ai encore beaucoup de mal à formaliser mes idées.

    Voilà, si quelqu'un a ne serait-ce qu'une piste, ce serait vraiment sympa
    D'avance merci

  2. #2
    Membre éclairé Avatar de le_dilem
    Homme Profil pro
    Consultant ERP
    Inscrit en
    Avril 2005
    Messages
    313
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Algérie

    Informations professionnelles :
    Activité : Consultant ERP

    Informations forums :
    Inscription : Avril 2005
    Messages : 313
    Par défaut
    Salut

    peux tu stp nous donner une exemple est le résultat que tu veux avoir.

    car je ne comprends comment tes données son organsinées.

  3. #3
    Nouveau membre du Club
    Inscrit en
    Juillet 2010
    Messages
    7
    Détails du profil
    Informations forums :
    Inscription : Juillet 2010
    Messages : 7
    Par défaut
    Dans mon problème, mes fi ont des valeurs comprises entre 0 et 1.
    Un calcul donne un résultat compris entre 1 et 5.5 environ (j'ai plusieurs séries de données) . Voilà pour l'échelle. Le résultat ne peut pas être plus petit que 1 de toute façon, ni plus grand que 5.5.

    Pour faire très simple, si on a n=3, alors la formule va revenir à :

    R = 1*f1*f2*f3
    ____+ 2*((1-f1)*f2*f3 + f1*(1-f2)*f3 + f1*f2*(1-f3))
    ____+ 3*((1-f1)*(1-f2)*f3 + (1-f1)*f2*(1-f3) + f1*(1-f2)*(1-f3))
    ____+ 4*(1-f1)*(1-f2)*(1-f3)

    A l'avenir, je vais être amené à travailler sur des séries de données avec n>10, d'où l'intérêt de l'algorithme, parce que vu le nombre de termes sinon...

    Mes séries de données sont consignées sous excel. La première série de données que j'utilise est composée de n termes donc, avec n=12, qui sont dans les cellules B199 à B210 (d'où o=198 l'indice de ligne dans mes tentatives ratées d'algo).

    D'avance merci

  4. #4
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Une fonction à tester, non commentée
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    Public Function SpecSomProd(Rng As Range) As Double
    Dim T, Temp() As Double, Prod() As Double
    Dim i As Long, k As Long, Nb As Long, Deb As Long
    Dim m As Byte, n As Byte
    Dim P As Double, F As Double, S As Double
     
    If Rng.Columns.Count = 1 And Rng.Count > 1 Then
       Nb = Rng.Rows.Count
       ReDim T(1 To Nb): ReDim Temp(1 To Nb * Nb): ReDim Prod(1 To Nb + 1)
       T = Application.Transpose(Rng)
     
       For i = 1 To Nb * Nb
           k = IIf(i Mod Nb = 0, Nb, i Mod Nb)
           Temp(i) = T(k)
       Next i
     
       P = 1: F = 1
       For i = 1 To Nb
           P = P * T(i)
           F = F * (1 - T(i))
       Next i
       Prod(1) = P: Prod(Nb + 1) = (Nb + 1) * F
     
       For k = 2 To Nb + 1
           For i = 1 To Nb * Nb
                Deb = 1 + ((i - 0.99) \ Nb)
                m = IIf(i Mod Nb = 0, Nb, i Mod Nb)
                n = Deb + k - 2
                n = IIf(n Mod Nb = 0, Nb, n Mod Nb)
                Temp(i) = IIf(m = n, 1 - Temp(i), Temp(i))
           Next i
     
           If k <= Nb Then
              S = 0
              For m = 1 To Nb
                P = 1
                For i = Nb * (m - 1) + 1 To m * Nb
                  P = P * Temp(i)
                Next i
                   S = S + P
             Next m
             Prod(k) = k * S
          End If
       Next k
     
       S = 0
       For i = 1 To Nb + 1
           S = S + Prod(i)
       Next i
    End If
    SpecSomProd = S
    End Function
    à appeler directement dans une cellule de ta feuille par =SpecSomProd(B199:B210) ou à l'intérieur d'une autre fonction ou sub

  5. #5
    Nouveau membre du Club
    Inscrit en
    Juillet 2010
    Messages
    7
    Détails du profil
    Informations forums :
    Inscription : Juillet 2010
    Messages : 7
    Par défaut
    Salut mercatog et un grand merci à toi !
    Je vais sans doute être amené par la suite à bidouiller le même genre d'algo, donc j'aimerais tout comprendre pour être capable de le refaire. J'ai bien saisi toute la deuxième partie de ton code, mais je bute un peu sur
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    Nb = Rng.Rows.Count
    ReDim T(1 To Nb): ReDim Temp(1 To Nb * Nb): ReDim Prod(1 To Nb + 1)
    T = Application.Transpose(Rng)
     
    For i = 1 To Nb * Nb
        k = IIf(i Mod Nb = 0, Nb, i Mod Nb)
        Temp(i) = T(k)
    Next i
    J'avoue que ça me laisse un peu pantois
    En tout cas un grand merci. J'ai toujours un petit souci par contre. Quand je rentre, dans la cellule que je veux, l'appel, il me sort "#NOM?". J'ai sans doute dû faire un truc mal... Désolé si la question est stupide, je nage encore un peu dans tout ça . D'avance merci ou remerci à la bonne âme qui me répondra

  6. #6
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Le Tableau (Vecteur) T reprend les données input Rng
    le tableau Temp est un tableau constitué de Nb fois le tableau T. Nb étant le nombre de données
    (on pourrait penser créer le tableau Temp à deux dimensions)
    Une illustration mieux, le tableau Temp est modifié à chaque étape pour récupérer en fin de compte toutes les permutation et de calculer les résultats intermédiaires dans le Tableau Prod.
    la fonction est à mettre dans un module général.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Petit problème de décimales !
    Par ridan dans le forum Langage SQL
    Réponses: 5
    Dernier message: 11/09/2004, 21h24
  2. Réponses: 17
    Dernier message: 13/07/2004, 20h37
  3. petit problème premier plan, arrière plan
    Par gros bob dans le forum OpenGL
    Réponses: 4
    Dernier message: 19/04/2004, 12h00
  4. [jointure] Petit problème sur le type de jointure...
    Par SteelBox dans le forum Langage SQL
    Réponses: 13
    Dernier message: 13/02/2004, 18h55

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo