Bonjour à tous,
voila je cherche désespérément quelqu'un pour m'aider à comprendre un code ( pour précision je ne maitrise pas R), et aussi à l'appliquer sur mes données à moi. Le code je l'ai trouvé après des recherches sur net, je pense que c'est ce qu'il me faut ( pas sûre). le code contient des commentaires, je sais que pour certains c'est suffisant...
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
> SubRegressionBased <- function(y_l, X, n.bc, n.fc, conversion = "sum",
+ method = "chow-lin-maxlog", fr = 4,
+ truncated.rho = 0, 
+ fixed.rho = 0.5, tol = 1e-16, 
+ lower = -0.999, upper = 0.999){
# performs temporal disaggregation for regression based methods 
# Args: 
#   y_l:          vector of the low-frequency left-hand side variable 
#   X:            matrix of high-frequency indicators 
#   conversion:   type of conversion ("sum", "average", "first", "last") 
#   method:       method 
#   fixed.rho:    set a predefined rho 
#   fr:           ratio of high-frequency units per low-frequency unit
#   tol:          desired accuracy, passed on to optim() 
#   lower, upper: scalar indicating the limits of the rho parameter 
# Returns: 
#   A list, containing the output of CalcGLS() and the following elements: 
#     values          vector, interpolated (and extrapolated) high frequency  
#                    series 
#     fitted.values   vector, low-frequency residuals fitted values of the 
#                     regression 
#     p               vector, preliminary high frequency series 
#     residuals       vector, low-frequency residuals 
#     rho             scalar, autoregressive parameter 
#     truncated       logical, whether rho has been truncated to 0 
# dimensions of y_l and X
+ n_l <- length(y_l)
+ n <- dim(X)[1]
+   m <- dim(X)[2]
# conversion matrix expanded with zeros
+ C <- CalcC(n_l, conversion, fr, n.bc = n.bc, n.fc = n.fc)
+ pm <- CalcPowerMatrix(n)
# sanity test
+ stopifnot(identical(dim(C)[2], dim(X)[1]))
# aggregated values
+ X_l <- C %*% X
+  truncated <- FALSE
+ if (method == "chow-lin-maxlog"){
+     Objective <- function(rho){
+       -CalcGLS(y = y_l, X = X_l, vcov = C%*%CalcQ(rho, pm)%*%t(C), 
+                stats = FALSE)$logl
+     }
+   } else if (method == "chow-lin-minrss-ecotrim"){
+     Objective <- function(rho){
+       CalcGLS(y = y_l, X = X_l, vcov = C%*%CalcR(rho, pm)%*%t(C), logl = FALSE, 
+               stats = FALSE)$rss
+     } 
+   } else if  (method == "chow-lin-minrss-quilis"){
+     Objective <- function(rho){
+       CalcGLS(y = y_l, X = X_l, vcov = C%*%CalcQ(rho, pm)%*%t(C), logl = FALSE, 
+               stats = FALSE)$rss
+     }
+   } else if (method == "litterman-maxlog"){
+     Objective <- function(rho){
+       -CalcGLS(y = y_l, X = X_l, vcov = C%*%CalcQ_Lit(X, rho)%*%t(C), 
+                stats = FALSE)$logl
+     }
+   } else if (method == "litterman-minrss"){
+     Objective <- function(rho){
+       CalcGLS(y = y_l, X = X_l, vcov = C%*%CalcQ_Lit(X, rho)%*%t(C), 
+               logl = FALSE, stats = FALSE)$rss
+     }
+   }
+ if (method %in% c("chow-lin-maxlog", "chow-lin-minrss-ecotrim", 
+                     "chow-lin-minrss-quilis", "litterman-maxlog", 
+                     "litterman-minrss")){
+     optimize.results <- optimize(Objective, lower = lower , upper = upper, tol = tol,
+                                  maximum = FALSE)
+     rho <- optimize.results$minimum
+ if (rho < truncated.rho){
+       rho <- truncated.rho
+       truncated <- TRUE
+     } 
+     
+   } else if (method == "fernandez"){
+     rho <- 0
+   } else if (method == "ols"){
+     rho <- 0
+   } else if (method %in% c("chow-lin-fixed", "litterman-fixed")){
+     rho <- fixed.rho
+   }
+ if (method %in% c("fernandez", "litterman-maxlog", "litterman-minrss", 
+                     "litterman-fixed")){
+     Q       <- CalcQ_Lit(X = X, rho = rho)
+   } else if (method %in% c("chow-lin-maxlog", "chow-lin-minrss-ecotrim", 
+                            "chow-lin-minrss-quilis",  "chow-lin-fixed", "ols")){
+     Q       <- CalcQ(rho = rho, pm = pm)
+   }
+ 
+ Q_l <- C %*% Q %*% t(C)
+   
+   # final GLS estimation (aggregated)
+   z <- CalcGLS(y = y_l, X = X_l, vcov = Q_l)
+ 
+   # Check if X is singular
+   if(qr(X)$rank < min(dim(X))) {warning("\nX is singular!\n")}
+ 
+   # preliminary series
+   p   <- as.numeric(X %*% z$coefficients)
+   
+   # distribution matrix
+   D <- Q %*% t(C) %*% z$vcov_inv
+   
+   # low frequency residuals
+   u_l <- as.numeric(y_l - C %*% p)
+   
+   # final series
+   y <- as.numeric(p + D %*% u_l)
+ 
+   # output
+   z$vcov_inv         <- NULL  # no need to keep
+   z$values           <- y
+   z$fitted.values    <- C %*% p
+   z$p                <- p
+   z$residuals        <- u_l
+   z$rho              <- rho
+   z$truncated        <- truncated
+   z
+ }
sachant que mon but et d'appliquer cette methode ( chow-lin) sur mes données trimestrielles pour les avoir en mensuelles via ce code.
voila le lien vers le code: https://github.com/christophsax/temp...ter/R/td.sub.R
voila un extrait de ma table de depart: ( les valeurs sont fictives)
date echeance taux-1ML taux+1M flux -1M flux+1M
Trim1 2006 9 3 9 19
Trim2 2006 8 5 5 11
Trim3 2006 4 4 7 14
Trim4 2006 6 8 6 12

et voila ce que je veux obtenir

date echeance taux_moins1M_snf taux_plus1M_snf flux_moins1meur flux_plus1meur
janv-06 200601 1 3 9 7
FEB06 200602 2 2 6 5
mars-06 200603 3 7 7 7
APR06 200604 4 8 6 4
MAY06 200605 5 1 8 9
juin-06 200606 6 1 8 6
juil-06 200607 1 2 3 4
AUG06 200608 2 3 4 8
sept-06 200609 3 7 8 7
oct-06 200610 4 2 1 9
nov-06 200611 5 6 8 6
DEC06 200612 6 8 1 1
Merci pour l'aide