Calculer une moyenne mobile en fonction d'une autre variable

Version imprimable

15/02/2011, 20h14
nicolas_p356

Calculer une moyenne mobile en fonction d'une autre variable
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:

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:

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

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 :

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:

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)],...)
                  }))
    }
}

Calcul des moyennes mobiles par variable et par groupe :

Code:

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))
                       }))

Ajout des groupes à la data.frame :

Code:

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:

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:

pas <- 3

Code:

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

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:

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