Discussion :

[Durmir]

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

[le_dilem]

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.

[Durmir]

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

[mercatog]

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

[Durmir]

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

[mercatog]

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.

[Durmir]

Je te remercie à nouveau pour ces explications. En entrant l'algo dans le module, ça me donne effectivement un résultat.
D'ailleurs, en voyant les résultats, je me suis aperçu que j'avais fait une erreur dans ma formule puisque je n'obtiens pas tout à fait les résultats attendus. J'ai retrouvé mon erreur, et grâce à ton aide je devrais pouvoir modifier l'algo en fonction. Donc tout baigne

En tout cas encore merci

[mercatog]

je me suis aperçu que j'avais fait une erreur dans ma formule puisque je n'obtiens pas tout à fait les résultats attendus

ça m'étonne, j'ai repris seulement tes explications du problème sans aucune initiative. à toi de tester sur plusieurs cas de figure de n=2 jusqu'à 12 ou 1000, n'importe

[Durmir]

Non mais l'erreur vient de moi, ne t'inquiète pas, j'avais fait une légère erreur en posant mon problème à la base. Mais rien de bien méchant, c'est juste une histoire d'échelle (pour faire simple, disons que j'avais mal normalisé ma formule, la normalisation est un peu trapue, mais bien posée et décomposée j'ai pu l'intégrer dans l'algo). C'est justement parce que ton algorithme est bon que j'ai pu m'en apercevoir
Là je l'ai corrigée, j'ai fait mes calculs, et j'obtiens bien les résultats attendus à présent. Du coup, je vais pouvoir me lancer dans les nouvelles séries de données.
Encore merci

[Durmir]

Je remonte ce sujet, car après un mois d'utilisation de cet algorithme (modifié pour mes besoins), j'ai fini par m'apercevoir qu'il était faux. Je m'en suis aperçu lorsque j'ai modifié l'ordre des lignes où se trouvaient mes données. En effet, la formule étant symétrique, normalement le résultat ne devait pas changer. Et là, si...

Et après avoir réfléchi longuement, j'ai fini par trouver en quoi il était faux. En effet, la solution proposée par Mercatog ne calcule pas tous les termes. Dans le tableau qu'il propose, on voit par exemple pour k = 3 qu'il manque 2 permutations possibles. Ce qui est logique, puisque la combinaison de 2 dans 4 est 6, non 4. Il manque ici les termes où la première et la troisième lignes devraient être en jaune, ainsi que la deuxième et la quatrième.
Et plus Nb augmente, plus il manque de termes.
En effet, le nombre total de termes dans chaque "morceau" de la formule est la combinaison du "numéro du morceau" dans Nb, et non Nb*Nb.

Le souci, c'est que toute l'astuce (et honnêtement il y avait de l'astuce) de l'algorithme de Mercatog était justement d'utiliser un tableau carré. Si le nombre de termes change selon k, alors je n'ai pas l'impression que l'algorithme puisse être adapté. Toute la boucle pour k allant de 2 à Nb (Nb+1 n'est pas nécessaire puisque Mercatog a fait calculer ce cas particulier avant la boucle) devient fausse.
Du moins je n'ai pas réussi malgré de m'être creusé la tête depuis deux jours. En changeant les indices Nb*Nb par Combinaison(Nb, k) (j'ai créé la fonction combinaison pour me simplifier la vie), ou en faisant des boucles imbriquées, au final je n'arrive pas à créer un tableau avec le bon nombre de lignes pour chaque colonne.

Bref, si quelqu'un a une idée, ça me permettra de pouvoir ne pas jeter une partie de mon travail de ce dernier mois à la corbeille...

D'avance merci !

[Durmir]

N'étant pas très doué en informatique, j'ai pris le problème autrement et je l'ai résolu, donc je note ici le résultat si quelqu'un tombe un jour sur le même problème.
En fait, j'ai développé ma formule, à tout hasard, parce qu'il me semblait que certains termes pouvaient se simplifier. Et c'est le cas...
Ma formule est finalement égale à :
S = n + 1 - (somme, i = 1 à n, fi)
Et oui, ça fait mal de se dire qu'un problème en apparence si complexe est en fait si simple... Je vous raconte pas mon dégoût en trouvant cette formule de récurrence, 1 mois de travail en 5 minutes...

Bref, ensuite l'algorithme sous excel est très simple :

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
Public Function PermRes(Rng As Range) As Double
Dim T, S As Double
Dim i As Long, k As Long, Nb As Long
 
If Rng.Columns.Count = 1 And Rng.Count > 1 Then
   Nb = Rng.Rows.Count
   ReDim T(1 To Nb)
   T = Application.Transpose(Rng)
 
   For i = 1 To Nb
       k = IIf(i Mod Nb = 0, Nb, i Mod Nb)
   Next i
 
   S = 0
   For j = 1 To Nb
        S = S - T(j)
   Next j
   S = Nb + 1 + S
End If
 
PermRes = S
 
End Function

Voilà, merci tout de même si certains avaient commencé à chercher...

[mercatog]

J'en suis à la même sensation: la frustration. Certes se lancer à chercher un algorithme complexe avant d'étudier la problématique ça fait perdre... un mois!
désolé pour mon code précédent qu'ayant vérifié pour n=3, je me suis précipité pour une généralisation non réfléchie
Sinon, pour ton dernier code, on peut le faire plus court

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Public Function LaVache(Rng As Range) As Double
If Rng.Columns.Count = 1 And Rng.Count > 1 Then LaVache = Rng.Count + 1 - Application.Sum(Rng)
End Function