R - maximiser l'aire sous la courbe pour plusieurs scénarios

Question

Pour illustrer, les deux vecteurs ont été obtenus comme indiqué ci-dessous:

residues <- 1:31 
scores <- runif(n = 31, min = 0.35, max = 3.54) 

Je considère une séquence aléatoire juste pour illustrer. Si je indiquerez les residues x le scores j'ai le graphique suivant:

Ce que je veux faire est la suivante: je considérerai des combinaisons spécifiques de 15 résidus (désormais visés comme 15mère), sauter un résidu (ie 1:15, 2:16, 3:17 jusqu'à 17:31) et je veux calculer l'aire sous la courbe (AUC) pour toutes ces 17 combinaisons. Mon objectif final est de sélectionner le 15mer qui a l'AUC la plus élevée.

L'AUC peut être calculée à l'aide de la fonction rollmean du package zoo, comme indiqué dans this question. Cependant, comme j'ai, dans cet exemple, 17 combinaisons possibles, j'essaie de trouver un script pour automatiser le processus. Merci d'avance.

Answer 1

library(zoo) 

set.seed(555) 
residues <- 1:31 
scores <- runif(n = 31, min = 0.35, max = 3.54) 


which.max(sapply(1:17, function(x){sum(diff(residues[x:(x+14)])*rollmean(scores[x:(x+14)],2))})) 
# result 7 i.e. 7:21 

ou

sapply(1:17, function(x){sum(diff(residues[x:(x+14)])*rollmean(scores[x:(x+14)],2))}) # gives you the AUCs 
# result [1] 28.52530 29.10203 28.52847 27.65325 27.19925 28.77782 29.29373 28.13133 28.23705 27.68724 25.75294 25.27226 25.44963 25.81201 25.49907 23.48632 
     #[17] 22.45763 

ou avec une fonction personnalisée

f_AUC <- function(x, y, lngth){ 
    sapply(1:(length(x)-lngth+1), function(z) sum(diff(x[z:(z+lngth-1)])*rollmean(y[z:(z+lngth-1)],2))) 
} 

f_AUC(x=residues, y=scores, lngth=15) 

Answer 2

Voici la fonction suivante j'ai utilisé

scores <- runif(n = 31, min = 0.35, max = 3.54) 

fun <- function(dat, n) { 
    require(zoo) 
    N <- which(max(rollmean(dat, n)) == rollmean(dat, n)) 
    output <- matrix(0, length(N), n) 
    for (i in 1:length(N)) { 
    output[i, ] <- dat[N[i]:(N[i] + n - 1)] 
    } 
    output 
} 

fun(scores, 15) 

permet d'exécuter bien à l'intérieur des

rollmean(dat, n) 

du paquet zoo comme vous l'avez mentionné nous donne le roulement moyen dont nous

max(rollmean(dat, n)) 

trouve le maximum de la moyenne de laminage

max(rollmean(dat, n)) == rollmean(dat, n) 

renvoie un vecteur VRAI/FAUX de laquelle des moyens de roulement sont égaux au maximum

N <- which(max(rollmean(dat, n)) == rollmean(dat, n)) 

renvoie les indices des maximums. En fonction de vos données, vous pourriez avoir plusieurs séquences qui obtiennent le maximum que nous décidons de retourner tous avec la boucle suivante

for (i in 1:length(N)) { 
    output[i, ] <- dat[N[i]:(N[i] + n -1)] 
} 

au résultat:

set.seed(12345) 
scores <- runif(n = 31, min = 0.35, max = 3.54) 

fun(scores, 15) 
     [,1]  [,2]  [,3]  [,4]  [,5] [,6] 
[1,] 1.588179 1.633928 0.9208938 3.385791 1.797393 1.39234 
     [,7]  [,8]  [,9] [,10] [,11] [,12] 
[1,] 3.429675 2.606867 2.406091 1.593553 2.578354 2.085545 
     [,13] [,14] [,15] 
[1,] 1.07243 1.895739 2.879693 

fun(rpois(1000, 1), 10) 
    [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
[1,] 1 1 4 2 1 1 3 3 2  2 
[2,] 1 4 2 1 1 3 3 2 2  1 
[3,] 4 2 1 1 3 3 2 2 1  1