2017-08-07 6 views
0

Je suis assez nouveau pour R et j'ai suivi quelques tutoriels. Ce que je voudrais faire est de trouver une bonne méthode pour joindre des données sur lui-même en fonction de certaines conditions.Comment puis-je récapituler les données temporelles décalées dans une table de données dans R?

Dans ce cas, ce que je veux faire est de choisir une longueur de retard arbitraire et de créer une fenêtre roulante. Par exemple, si le décalage = 1 et la largeur de la fenêtre = 2, je souhaite cumuler les deux mois précédents 1 mois pour chaque mois, s'ils existent.

Si je commence avec une table de données comme ceci:

mytable = data.table(Month = c(6, 5, 4, 6, 5), Year = c(2016, 2016, 2016, 2016, 2016), Company = c('Kellog', 'Kellog', 'General Mills', 'General Mills', 'General Mills'), ProducedCereals = c(6, 3, 12, 5, 7), CommercialsShown = c(12, 15, 4, 20, 19)) 

Month Year Company ProducedCereals CommercialsShown 
    6 2016 Kellog   6    12 
    5 2016 Kellog   3    15 
    4 2016 Kellog  12    4 
    6 2016 General Mills 5    20 
    5 2016 General Mills 7    19 

La table avec les champs calculés pourrait ressembler à ceci:

Month Year Company ProducedCereals CommercialsShown 
    6 2016 Kellog  15    19 
    5 2016 Kellog  12    4 
    4 2016 Kellog  NA    NA 
    6 2016 General Mills 7    19 
    5 2016 General Mills NA    NA 

J'ai essayé rollapply() avec une largeur de une liste, mais il semble être subordonné à ce que les données soient des séries chronologiques régulières. Cependant, le mien ne l'est pas. Il doit être groupé par Société, et certaines lignes peuvent être manquantes. Il doit en outre prendre les lignes n précédentes en fonction des champs Mois et Année. Je réalise qu'une solution de contournement pourrait être de rendre les données afin que l'opération soit effectuée pour chaque sous-ensemble de la société et injecter des données fictives pour les mois manquant dans le milieu, mais je pensais qu'une meilleure façon existe probablement.

J'ai essayé l'approche suivante, qui applique une fenêtre de décalage et de roulement, mais sans tenir compte du mois, de l'année et de la société.

newthing <- lapply(mytable[,c('ProducedCereals'),with=F], function(x) rollapply(x, width=list(2:3),sum,align='left',fill=NA)) 
+1

Voir https://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example/28481250#28481250 re comment faire un bon exemple reproductible (qui peut être copier-coller dans une nouvelle session R et exécuter). – Frank

+1

Eh bien, j'ai prévu une sortie et ce que je ressens est une explication relativement succincte du problème, alors vous voulez que j'ajoute des données d'entrée dans R? Tu l'as eu. Édité – shiggity

+1

Ok merci. Dunno avec quelle rapidité quelqu'un publiera une réponse, mais en attendant: je suppose qu'une jointure non equi devrait fonctionner https://stackoverflow.com/questions/44406040/sum-over-past-window-size-dates-per-group/ 44407291 # 44407291 en supposant que vous utilisiez une variable yearmon au lieu de deux colonnes séparées. – Frank

Répondre

2

1) En utilisant les données définies dans la note à l'utilisation finale rollapply comme indiqué ci-dessous. nms est le nom des colonnes pour effectuer le calcul de la fenêtre glissante ou il peut être spécifié uniquement comme index de colonne (c'est-à-dire nms <- 4:5). Sum est comme somme, sauf qu'il renverra NA, au lieu de 0, si donné une série qui est entièrement NA et sinon il effectue sum(X, na.rm = TRUE). Notez que les valeurs NA ajoutées au roll sont telles que la série n'est pas plus courte que la largeur de la fenêtre.

library(data.table) 
library(zoo) 

k <- 2 # prior two months 

Sum <- function(x) if (all(is.na(x))) NA else sum(x, na.rm = TRUE) 
roll <- function(x) rollapply(c(x, rep(NA, k)), list(1:k), Sum) 
nms <- names(mytable)[4:5] 

mytable[, (nms) := lapply(.SD, roll), .SDcols = nms, by = "Company"] 

donnant:

> mytable 
    Month Year  Company ProducedCereals CommercialsShown 
1:  6 2016  Kellog    15    19 
2:  5 2016  Kellog    12    4 
3:  4 2016  Kellog    NA    NA 
4:  6 2016 General Mills    7    19 
5:  5 2016 General Mills    NA    NA 

1a) Dans un commentaire, la situation est mentiond où avant la ligne actuelle il y a manque de lignes et que les derniers deux mois civils doivent être utilisés de manière moins de 2 lignes peuvent être utilisées dans n'importe quelle somme.

Dans ce cas, il convient de trier d'abord la trame de données dans l'ordre de Société, puis de la trier par ordre croissant, ce qui implique que nous souhaitons que l'alignement soit aligné sur rollapply.

Nous passons un objet zoo avec l'index yearmon à rollapply afin que nous ayons un index temporel que Sum peut vérifier pour sous-totaliser l'entrée à la fenêtre désirée. Nous utilisons une taille de fenêtre de 3 et ne faisons que sommer les valeurs dans la fenêtre dont les heures se situent dans les limites spécifiées. Nous préciserons coredata = FALSE-rollapply afin que les données et l'index sont transmis à la fonction rollapply et pas seulement les données.

k <- 2 # prior 2 months 

# inputs zoo object x, subsets it to specified window and sums 
Sum2 <- function(x) { 
    w <- window(x, start = end(x) - k/12, end = end(x) - 1/12) 
    if (length(w) == 0 || all(is.na(w))) NA_real_ else sum(w, na.rm = TRUE) 
} 

nms <- names(mytable)[4:5] 

setkey(mytable, Company, Year, Month) # sort 

# create zoo object from arguments and run rollapplyr using Sum2 
roll2 <- function(x, year, month) { 
    z <- zoo(x, as.yearmon(year + (month - 1)/12)) 
    coredata(rollapplyr(z, k+1, Sum2, coredata = FALSE, partial = TRUE)) 
} 

mytable[, (nms) := lapply(.SD, roll2, Year, Month), .SDcols = nms, by = "Company"] 

donnant:

> mytable 
    Month Year  Company ProducedCereals CommercialsShown 
1:  5 2016 General Mills    NA    NA 
2:  6 2016 General Mills    7    19 
3:  4 2016  Kellog    NA    NA 
4:  5 2016  Kellog    12    4 
5:  6 2016  Kellog    15    

1b) Une autre approche pour lignes manquantes est de conver les données à forme longue et à un remplissage de forme rectangulaire dans des cellules manquant de NA. Cela fonctionnera tant que le même mois et l'année ne manquent pas dans chaque entreprise.

k <- 2 # sum over k prior months 
m <- melt(mytable, id = 1:3) 
dd <- as.data.frame.table(tapply(m$value, m[, 1:4, with = FALSE], c), 
    responseName = "value") 
Sum1 <- function(x) { 
    x <- head(x, -1) 
    if (length(x) == 0 || all(is.na(x))) NA_real_ else sum(x, na.rm = TRUE) 
} 
setDT(dd)[, value := rollapplyr(value, k+1, Sum1, partial = TRUE), 
    by = .(Company, variable)] 
dc <- as.data.table(dcast(... ~ variable, data = dd, value = "value")) 
setkey(dc, Company, Year, Month) 
dc 

donne:

Month Year  Company ProducedCereals CommercialsShown 
1:  4 2016 General Mills    NA    NA 
2:  5 2016 General Mills    NA    NA 
3:  6 2016 General Mills    7    19 
4:  4 2016  Kellog    NA    NA 
5:  5 2016  Kellog    12    4 
6:  6 2016  Kellog    15    19 

2) Une autre possibilité est de convertir mytable à l'objet zoo z de division mytable par la Société et ensuite utiliser rollapply à ce sujet. mytable est de nouveau comme indiqué dans la note à la fin. Sum provient de (1).

k <- 2 # prior 2 months 

ym <- function(m, y) as.yearmon(paste(m, y), format = "%m %Y") 
z <- read.zoo(mytable, index = 1:2, split = k+1, FUN = ym) 

Sum <- function(x) if (all(is.na(x))) NA else sum(x, na.rm = TRUE) 
rollapply(z, list(-1:-k), Sum, partial = TRUE, fill = NA) 

donnant:

  ProducedCereals.General Mills CommercialsShown.General Mills 
Apr 2016       NA        NA 
May 2016       NA        NA 
Jun 2016        7        19 
     ProducedCereals.Kellog CommercialsShown.Kellog 
Apr 2016      NA      NA 
May 2016      12      4 
Jun 2016      15      19 

Note: Le code dans la question ne génère pas les données affichées dans la question si nous avons utilisé ce lieu pour le data.table mytable:

library(data.table) 
mytable <- 
structure(list(Month = c(6, 5, 4, 6, 5), Year = c(2016, 2016, 
2016, 2016, 2016), Company = c("Kellog", "Kellog", "Kellog", 
"General Mills", "General Mills"), ProducedCereals = c(6, 3, 
12, 5, 7), CommercialsShown = c(12, 15, 4, 20, 19)), .Names = c("Month", 
"Year", "Company", "ProducedCereals", "CommercialsShown"), row.names = c(NA, 
-5L), class = "data.frame") 
mytable <- as.data.table(mytable) 
+0

Merci, c'est très différent de ce que j'ai trouvé. J'ai remarqué une erreur de coercition lorsque j'ai utilisé différentes valeurs dans la liste() dans la solution n ° 1, par ex. liste (2: 3). Lorsque j'ai remplacé fill = NA par une valeur numérique, comme fill = -1, le problème a été résolu, même si, dans votre exemple, NA est dans la sortie comme prévu. Je ne comprends pas pourquoi ce serait le cas. – shiggity

+0

J'ai également remarqué que la solution # 1 dépend des données étant une série temporelle régulière qui est bonne à noter – shiggity

+0

Eh bien ... J'ai écrit "... donc l'opération est effectuée pour chaque sous-ensemble de la Société et injecter des données fictives pour * * mois manquant au milieu ** "mais je suppose que j'aurais pu l'écrire plus explicitement – shiggity

1

J'ai essayé une jointure non-equi - elle n'aimait pas une jointure avec elle-même, j'ai donc copié la table. Bien que je sois certain que ce n'est pas le meilleur moyen, il gère les mois manquants.

lag = 2 # The lag in number of months 
block = 3 # The number of contiguous months to roll up 

mytable = data.table(Month = c(6, 5, 4, 6, 5), Year = c(2016, 2016, 2016, 2016, 2016), Company = c('Kellog', 'Kellog', 'General Mills', 'General Mills', 'General Mills'), ProducedCereals = c(6, 3, 12, 5, 7), CommercialsShown = c(12, 15, 4, 20, 19)) 

setDT(mytable)[, "MonthsSinceEpoch" := { 
    MonthsSinceEpoch = (Year - 2000) * 12 + Month 
.(MonthsSinceEpoch) 
}] 

mytable2 <- mytable 

setDT(mytable2)[, "EndMonths" := { 
    EndMonths = MonthsSinceEpoch - lag 
    .(EndMonths) 
}] 
setDT(mytable2)[, "StartMonths" := { 
    StartMonths = MonthsSinceEpoch - lag - block + 1 
    .(StartMonths) 
}] 

mytable3 <- mytable[mytable2, on = .(Company, MonthsSinceEpoch >= StartMonths, MonthsSinceEpoch <= EndMonths), 
        .(CommercialsShown = sum(CommercialsShown), ProducedCereals = sum(ProducedCereals)), 
        by=.EACHI] 

mytable3 <- mytable3[order(rank(Company), -MonthsSinceEpoch)] 
mytable3