bonjour,
Le document (telechargeable en bas du message) explique comment on peut estimer la valeur qui va suivre dans une série chronologique donnée. Après avoir copié collé le code dans une macro sur excel et rentré une série donnée, la valeur prédite est toujours à 0 quelque soit le nombre de donnée ou le nombre d'équations introduits. Après avoir cherché le problème, tout ce que j'ai trouvé c'est que la matrice XD est toujours nulle, car bien évidemment les valeurs que cette matrice comporte sont inconnues (donc =0 sur excel). Je ne comprends pas trop comment je peux modifier ce code afin qu'il puisse me donner des résultats plus satisfaisants. Merci de m'éclairer là dessus.
Voici le document en question : http://www.sciencedirect.com/science...04276-main.pdf
Voici le code VBA à copier coller si vous voulez l'essayer sur excel :
Code:Sub Deterministic_Regression() Dim i As Long, j As Long, k As Long, h As Long, ll As Long Dim Cont As Double, Cont2 As Double, Cont3 As Double, Cont4 As Double, Cont5 As Double 'r(1) is the number of independent observations in the regression (the base length) 's is the number of simultaneous equations in system (5), Section 2.1 'X = {yi, yi+1, . . . , yi+r-1}, i = j, j + 1, . . . , dim X = r, is the row vector of sliding observations in (2), (3) 'at right, - not the same notation as in (5) 'A is the vector of coefficients ai in the regression (3), (5) Dim r() As Integer: ReDim r(2): Dim s As Integer r(1) = 6 s = 1 Dim X() As Double, A() As Double ReDim X(10000): ReDim A(r(1)) 'Download form Excel X(1), . . . X(r + s), . . . For i = 1 To 10000 X(i) = Cells(9 + i, 2) Next i 'Construct the matrix XU, such that (XU)(A)t = (X(r + 1), . . . X(r + s))t. t = ‘‘transpose’’ Dim XU() As Double: ReDim XU(s, r(1)) For i = 1 To s For j = 1 To r(1) XU(i, j) = X(i + j - 1) Next j Next i ' Construct the matrix XD = (X(r(1) + 1), . . . X(r(1) + s))t, t = ‘‘transpose’’ Dim XD() As Double: ReDim XD(s) For i = 1 To s XD(i) = X(r(1) + i) Next i 'Square (r(1), r(1)) system leading to the orthogonal projection of XD 'Z(A)t = Z(-, 0) is called System_1 and indicates that(XU)(A)t is the orthogonal projection of XD Dim Z() As Double: ReDim Z(r(1), r(1)) For i = 1 To r(1) For j = 1 To s Z(i, 0) = Z(i, 0) + XD(j) * XU(j, i) Next j For j = 1 To r(1) For k = 1 To s Z(i, j) = Z(i, j) + XU(k, i) * XU(k, j) Next k Next j Next i 'System_2 computes the kernel of XU, (XU)(A)t = 0 'Making system_2 diagonal For i = 1 To r(1): XU(0, i) = i: Next i Cont = 0 ll = s If ll > r(1) Then ll = r(1) For i = 1 To ll k = i Do While k <= r(1) And Cont = 0 For j = i To s If XU(j, k) <> 0 Then Cont = Cont + 1 Next j If Cont <> 0 Then For h = 0 To s Cont2 = XU(h, i): XU(h, i) = XU(h, k): XU(h, k) = Cont2 Next h End If k = k + 1 Loop j = i Do While j < s And XU(j, i) = 0 j = j + 1 Loop For k = 1 To r(1) Cont2 = XU(i, k): XU(i, k) = XU(j, k): XU(j, k) = Cont2 Next k Cont3 = XU(i, i) If Cont3 <> 0 Then For k = 1 To r(1) XU(i, k) = XU(i, k) / Cont3 Next k j = i + 1 Do While j <= s Cont2 = XU(j, i) For k = 1 To r(1) XU(j, k) = XU(j, k) - Cont2 * XU(i, k) Next k j = j + 1 Loop End If Cont = 0 Next i 'Dimension of the Kernel. s-ll will denote the required dimension Cont = 0: Cont2 = 0 i = s Do While Cont = 0 And i >= 1 For j = 1 To r(1) If XU(i, j) <> 0 Then Cont = Cont + 1 Next j If Cont = 0 Then Cont2 = Cont2 + 1 i = i - 1 Loop ll = Cont2 'Making the diagonal of the new (XU) equal one For i = 1 To s - ll Cont4 = XU(i, i) For j = 1 To r(1) XU(i, j) = XU(i, j) / Cont4 Next j Next i 'Making terms over the diagonal of the new (XU) vanish For i = s - ll To 1 Step -1 k = i - 1 Do While k > 0 Cont = XU(k, i) For j = 1 To r(1) XU(k, j) = XU(k, j) - XU(i, j) * Cont Next j k = k - 1 Loop Next i 'Basis of the kernel of (XU) Dim Basis_K() As Double: ReDim Basis_K(r(1) - s + ll, r(1)) For j = 1 To r(1) Basis_K(0, j) = XU(0, j) Next j For j = s - ll + 1 To r(1) For i = 1 To r(1) - (s - ll) If i = j - (s - ll) Then Basis_K(i, j) = 1 Next i Next j For i = 1 To r(1) - (s - ll) For j = 1 To s - ll Basis_K(i, j) = -XU(j, s - ll + i) Next j Next i 'Reorganizing Basis_K() so as to have the natural orderA1, . . . , Ar For j = 1 To r(1) i = j Do While Basis_K(0, i) <> j i = i + 1 Loop For k = 0 To r(1) - (s - ll) Cont = Basis_K(k, j): Basis_K(k, j) = Basis_K(k, i): Basis_K(k, i) = Cont Next k Next j 'System_3 is obtained by adjoining system_1 and system involving Basis_K(). System_3 simultaneously imposes (XU)(A)t to 'be the orthogonal projection of (XD) and (A) to be orthogonal to the kernel Dim ZZ() As Double: ReDim ZZ(2 * r(1) - (s - ll), r(1)) For j = 1 To r(1): ZZ(0, j) = j: Next j For i = 1 To r(1) For j = 0 To r(1) ZZ(i, j) = Z(i, j) Next j Next i For i = r(1) + 1 To 2 * r(1) - (s - ll) For j = 1 To r(1) ZZ(i, j) = Basis_K(i - r(1), j) Next j Next i 'Making system_3 diagonal. The system has a unique solution, so not needed rows are deleted For i = 1 To r(1): ZZ(0, i) = i: Next i Cont = 0 i = 1 Do While i <= r(1) k = i Do While k <= r(1) And Cont = 0 For j = i To 2 * r(1) - (s - ll) If ZZ(j, k) <> 0 Then Cont = Cont + 1 Next j If Cont <> 0 Then For h = 0 To 2 * r(1) - (s - ll) Cont2 = ZZ(h, i): ZZ(h, i) = ZZ(h, k): ZZ(h, k) = Cont2 Next h End If k = k + 1 Loop j = i Do While j < 2 * r(1) - (s - ll) And ZZ(j, i) = 0 j = j + 1 Loop For k = 0 To r(1) Cont2 = ZZ(i, k): ZZ(i, k) = ZZ(j, k): ZZ(j, k) = Cont2 Next k Cont2 = ZZ(i, i) For k = 0 To r(1) ZZ(i, k) = ZZ(i, k) / Cont2 Next k j = i + 1 Do While j <= 2 * r(1) - (s - ll) Cont2 = ZZ(j, i) For k = 0 To r(1) ZZ(j, k) = ZZ(j, k) - Cont2 * ZZ(i, k) Next k j = j + 1 Loop Cont = 0 i = i + 1 Loop 'Solving system_3 For i = r(1) To 1 Step -1 A(i) = ZZ(i, 0) j = r(1) Do While j > i A(i) = A(i) - ZZ(i, j) * A(j) j = j - 1 Loop Next i 'Organizing system_3 to retrieve the natural order A(1), A(2), . . .. For j = 1 To r(1) i = j Do While ZZ(0, i) <> j i = i + 1 Loop For k = 0 To r(1) Cont = ZZ(k, j): ZZ(k, j) = ZZ(k, i): ZZ(k, i) = Cont Next k Next j 'Vector A (regression coefficients) For i = 1 To r(1) Cells(10 + i, 5) = A(i) Next i 'Y, state variable estimate, and the deviations X - Y and (X - Y)/X 'Variable rr is the horizon of forecasting Dim Y() As Double: ReDim Y(10000) Dim rr As Long rr = 1 For i = 1 To rr For j = 1 To r(1) Y(r(1) + i) = Y(r(1) + i) + A(j) * X(j + i - 1) Next j Cells(r(1) + i + 10, 8) = Y(r(1) + i) Cells(r(1) + i + 10, 9) = X(r(1) + i) - Y(r(1) + i) If X(r(1) + i) <> 0 Then Cells(r(1) + i + 10, 10) = Abs((Cells(r(1) + i + 9, 2) - Y(r(1) + i))) * 100 / Cells(r(1) + i + 9, 2) Next i End Sub
-----