Discussion :

[nicolas_p356]

Bonjour,
Je souhaite calculer une moyenne mobile sur plusieurs variables en fonction d'une valeur prise par une autre variable. Exemple j'ai deux "groupes" d'observations et deux variables a moyenner.

Code :

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

1
2
3
4
 
 gp <- c(1, 1, 2, 2, 2)
var1 <- c(1, 2, 4, 6, 8)
var2 <- c(1, 2, 4, 6, 8)

je cherche donc a obtenir une table avec les valeurs suivantes

gp v1 v2
1 1.5 1.5
2 5 5
2 7 7

J'arrive a le programmer mais d'une manière pas tres simple avec le code suivant:

Code :

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

1
2
3
4
5
 
	tab  <- zoo(cbind(gp, v1, v2) )
	fdr <- function(tab) rollapply(tab, 2, mean)
	re  <- tapply(tab, tab$gp, fdr) 
	tb  <- do.call(cbind, re)

Le problème c'est qu'a lavant dernière étape il me renvoie une liste. Quand je la transforme une table, j'ai plein de valeurs manquantes. Ce qui devient compliqué pour la suite.


Je vous remercie par avance pour votre aide


nicolas

[pitipoisson]

Bonjour,

Ton exemple ne fonctionne pas chez moi en tout cas.

La solution que je te propose n'est pas non plus simple, mais elle fonctionne :

1. Définition d'une fonction pour le calcul des moyennes mobiles (ça existe peut-être par ailleurs mais c'est toujours bon pour l'exemple) :
   

   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
   mov.average <- function(x, n=2,...)
   {
       ## Purpose: calcul de moyennes mobiles
       ## ----------------------------------------------------------------------
       ## Arguments: x : vecteur (numeric)
       ##            n : nombres de valeurs
       ##            ... : arguments supplémentaires pour la fonction mean.
       ## ----------------------------------------------------------------------
       ## Author: Yves Reecht, Date: 16 févr. 2011, 10:02
       if (n > length(x))
       {
           return(NA)
       }else{
           return(sapply(seq(from=1, to=length(x) - n + 1),
                         function(i)
                     {
                         mean(x[seq(from=i, to=i + n - 1)],...)
                     }))
       }
   }

2. Calcul des moyennes mobiles par variable et par groupe :
   

   Code :

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

   1
   2
   3
   4
   5
   6
   7
   8
   9
   10
   11
   12
   13
   ## Data.frame avec les variables (nécessaire pour sapply) :
   tab <- as.data.frame(cbind(var1, var2))
    
   ## Pas de calcul des moyennes mobiles :
   pas <- 2
    
   ## Calcul des moyennes mobiles :
   re <- as.data.frame(sapply(tab,         # Pour chaque variable.
                              function(x)
                          {
                              ## moyennes mobiles par groupe -> vecteur :
                              unlist(tapply(x, gp, mov.average, n=pas))
                          }))

3. Ajout des groupes à la data.frame :
   

   Code :

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

   1
   2
   3
   4
   5
   6
   7
   8
   9
   10
   11
   ## Ajout des groupes (d'après longueur des groupes et nombre de pas) :
   re$gp <- unlist(tapply(gp, gp,
                          function(x)
                      {
                          if (pas > length(x))
                          {
                              return(x[1])
                          }else{
                              return(x[-(1:(pas - 1))])
                          }
                      }))

   Cette étape est nécessaire pour t'assurer des groupes cohérents qu'ils soient de classe numeric, character, ou autre ; et même si le pas est > au nombre d'élément d'un groupe.
   Toutefois, si tes groupes sont numériques et la moyenne mobile toujours calculable, tu peux les laisser dans tab et passer cette étape (je déconseille quand même).

Ce qui donne (j'ai modifié une valeur dans var2) :

Code :

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

1
2
3
4
5
> re
   var1 var2 gp
1   1.5  1.5  1
21  5.0  5.5  2
22  7.0  7.0  2

ou bien, avec

Code :

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

pas <- 3

Code :

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

1
2
3
4
> re
  var1     var2 gp
1   NA       NA  1
2    6 6.333333  2

[nicolas_p356]

Cher Pitipoisson

Merci pour ton aide, j'ai adopté un mix des deux approches qui doit être moins rigoureux que ta suggestion mais qui a le mérite d'être plus condensé.

voici mon approche finale

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
 
library(zoo)
gp <- c(1, 1, 2, 2, 2)
var1 <- c(1, 2, 4, 6, 8) # j'attends (1, 5, 7)
var2 <- c(1, 2, 4, 6, 8) 
	fct_liss <- function(n) {
		tab <- as.data.frame(cbind(var1, var2) )
		fdr <- function(tab, n) rollapply(tab, n, mean)
		## Calcul des moyennes mobiles :
		re <- as.data.frame(sapply(tab,         # Pour chaque variable.
	                          function(x) unlist(tapply(zoo(x), gp, fdr, n = n) )
	                      ) )
		## Ajout des numero de groupes 
		re$gp <- unlist(tapply(gp, gp,
	                       function(x)
	                   {
	                       if (n > length(x))
	                       {
	                           return(x[1])
	                       }else{
	                           return(x[-(1:(n - 1) ) ] )
	                       }
	                   } ) )
			return(re)
	}
	ss <-	fct_liss(n = 2)

Merci encore

nicolas