R: Éviter les boucles lors de l'utilisation de plusieurs conditions dépendantes les unes des autres

Question

Je ne suis pas certain que mon titre soit aussi clair que je le souhaite. Ci-dessous un code écrit à l'aide de boucles:

for(i in 1:length(variantTable[,1])){ 
    #N stores counts of numbers of population totals of populations that contain the variant in question 
    N = 0 
    #NF.pop stores frequencies 
    NF.EAS = 0 
    NF.AMR = 0 
    NF.EUR = 0 
    NF.SAS = 0 
    if(variantTable[i,]$EAS_MAF > 0){ 
    NF.EAS = EAScount * variantTable[i,]$EAS_MAF 
    N = N + EAScount 
    } 
    if(variantTable[i,]$AMR_MAF > 0){ 
    NF.AMR = AMRcount * variantTable[i,]$AMR_MAF 
    N = N + AMRcount 
    } 
    if(variantTable[i,]$EUR_MAF > 0){ 
    NF.EUR = EURcount * variantTable[i,]$EUR_MAF 
    N = N + EURcount 
    } 
    if(variantTable[i,]$SAS_MAF > 0){ 
    NF.SAS = SAScount * variantTable[i,]$SAS_MAF 
    N = N + SAScount 
    } 
    variantTable[i,]$nonAFR_N <- N 

    variantTable[i,]$nonAFR_weighted <- (NF.EAS + NF.AMR + NF.EUR + NF.SAS)/N 
} 

Comme vous pouvez le voir variantTable[i,]$nonAFR_weighted est calculée en fonction des conditions sur plusieurs colonnes (EAS_MAF, AMR_MAF, AFR_MAF, EUR_MAF, SAS_MAF). Je suis conscient que les boucles ne sont pas le moyen le plus rapide de faire quelque chose comme ça dans R, d'autant plus que mon jeu de données contient 900000 lignes.

Je viens de commencer à travailler avec ifelse et à appliquer des méthodes, mais je ne sais pas comment les utiliser dans une situation comme celle-ci. J'ai essayé de créer une fonction qui prend simplement une ligne et calcule des valeurs pour cette ligne, puis en utilisant la méthode apply, mais cela n'a pas fonctionné car je ne suis pas sûr de ce que l'entrée devrait être.

Des conseils sur la meilleure façon de procéder à un problème tel que celui-ci?

EDIT: Voici le dput de mes données:

> dput(head(variantTable)) 
structure(list(CHROM = c("1", "1", "1", "1", "1", "1"), POS = c(69224L, 
69428L, 69486L, 69487L, 69496L, 69521L), ID = c("rs568964432", 
"rs140739101", "rs548369610", "rs568226429", "rs150690004", "rs553724620" 
), REF = c("A", "T", "C", "G", "G", "T"), ALT = c("T", "G", "T", 
"A", "A", "A"), AF = c(0.000399361, 0.0189696, 0.000199681, 0.000399361, 
0.000998403, 0.000399361), AC = c(2L, 95L, 1L, 2L, 5L, 2L), AN = c(5008L, 
5008L, 5008L, 5008L, 5008L, 5008L), EAS_AF = c(0, 0.003, 0.001, 
0, 0, 0), AMR_AF = c(0.0029, 0.036, 0, 0, 0.0014, 0.0029), AFR_AF = c(0, 
0.0015, 0, 0.0015, 0.003, 0), EUR_AF = c(0, 0.0497, 0, 0, 0, 
0), SAS_AF = c(0, 0.0153, 0, 0, 0, 0), consequence = c("nonsynonymous SNV", 
"nonsynonymous SNV", "synonymous SNV", "nonsynonymous SNV", "nonsynonymous SNV", 
"nonsynonymous SNV"), gene = c("OR4F5", "OR4F5", "OR4F5", "OR4F5", 
"OR4F5", "OR4F5"), refGene_id = c("NM_001005484", "NM_001005484", 
"NM_001005484", "NM_001005484", "NM_001005484", "NM_001005484" 
), AA_change = c("('D', 'V')", "('F', 'C')", "('N', 'N')", "('A', 'T')", 
"('G', 'S')", "('I', 'N')"), X0.fold_count = c(572L, 572L, 572L, 
572L, 572L, 572L), X4.fold_count = c(141L, 141L, 141L, 141L, 
141L, 141L), EAS_MAF = c(0, 0.003, 0.001, 0, 0, 0), AMR_MAF = c(0.0029, 
0.036, 0, 0, 0.0014, 0.0029), AFR_MAF = c(0, 0.0015, 0, 0.0015, 
0.003, 0), EUR_MAF = c(0, 0.0497, 0, 0, 0, 0), SAS_MAF = c(0, 
0.0153, 0, 0, 0, 0), nonAFR_AF = c(0.0029, 0.104, 0.001, 0, 0.0014, 
0.0029), nonAFR_N = c(309227, 1128036, 262551, 0, 309227, 309227 
), nonAFR_weighted = c(0.0029, 0.0261704282487438, 0.001, NaN, 
0.0014, 0.0029)), .Names = c("CHROM", "POS", "ID", "REF", "ALT", 
"AF", "AC", "AN", "EAS_AF", "AMR_AF", "AFR_AF", "EUR_AF", "SAS_AF", 
"consequence", "gene", "refGene_id", "AA_change", "X0.fold_count", 
"X4.fold_count", "EAS_MAF", "AMR_MAF", "AFR_MAF", "EUR_MAF", 
"SAS_MAF", "nonAFR_AF", "nonAFR_N", "nonAFR_weighted"), row.names = c(NA, 
6L), class = "data.frame") 

les populations compte (EAScount, AMRcount etc.) qui ont été définis comme tels:

EAScount <- length(variantTable$EAS_MAF[variantTable$EAS_MAF>0]) 
AMRcount <- length(variantTable$EAS_MAF[variantTable$AMR_MAF>0]) 
AFRcount <- length(variantTable$EAS_MAF[variantTable$AFR_MAF>0]) 
EURcount <- length(variantTable$EAS_MAF[variantTable$EUR_MAF>0]) 
SAScount <- length(variantTable$EAS_MAF[variantTable$SAS_MAF>0]) 

La sortie Je cherche est le calcul pour variantTable $ nonAFR_n et variantTable $ nonAFR_weighted. Un exemple est ci-dessous avec le calcul correct:

> variantTable[2,] 
    CHROM POS   ID REF ALT  AF AC AN EAS_AF AMR_AF AFR_AF EUR_AF SAS_AF  consequence 
2  1 69428 rs140739101 T G 0.0189696 95 5008 0.003 0.036 0.0015 0.0497 0.0153 nonsynonymous SNV 
    gene refGene_id AA_change X0.fold_count X4.fold_count EAS_MAF AMR_MAF AFR_MAF EUR_MAF SAS_MAF 
2 OR4F5 NM_001005484 ('F', 'C')   572   141 0.003 0.036 0.0015 0.0497 0.0153 
    nonAFR_AF nonAFR_N nonAFR_weighted 
2  0.104 1128036  0.02617043 

Answer 1

cela fonctionnerait-il?

library(dplyr) 
variantTable %>% mutate(
    NF.EAS = EAScount * EAS_MAF, 
    NF.AMR = AMRcount * AMR_MAF, 
    NF.EUR = EURcount * EUR_MAF, 
    NF.SAS = SAScount * SAS_MAF, 
    nonAFR_N = EAScount * (EAS_MAF>0) + AMRcount * (AMR_MAF>0) + EURcount * (EUR_MAF>0) + SAScount * (SAS_MAF>0), 
    nonAFR_weighted = (NF.EAS + NF.AMR + NF.EUR + NF.SAS)/nonAFR_N) %>% 
    select(-c(NF.EAS,NF.AMR,NF.EUR,NF.SAS)) 

muter permet d'ajouter ou modifier des colonnes à la table, il permet l'utilisation des noms de colonne sans la notation $. Votre structure if n'était pas nécessaire car en multipliant par zéro vous obtenez votre valeur zéro par défaut de toute façon, donc la première partie de votre script pourrait être simplifiée.

booléens sont contraints en entiers 0 et 1 lorsqu'il est utilisé avec des opérateurs arithmétiques, donc je n'ai pas besoin de toute la structure if pour calculer N soit.

Et la dernière colonne est assez simple.

Toutes ces opérations ont été vectorisées, ce qui signifie que j'ai ajouté, soustrait, multiplié, divisé des colonnes directement plutôt que des valeurs discrètes, c'est plus rapide pour la machine et plus facile pour les yeux.

En outre, plus efficace et plus facile à lire:

EAScount <- sum(variantTable$EAS_MAF>0) 
AMRcount <- sum(variantTable$AMR_MAF>0) 
AFRcount <- sum(variantTable$AFR_MAF>0) 
EURcount <- sum(variantTable$EUR_MAF>0) 
SAScount <- sum(variantTable$SAS_MAF>0)