lapply

Postez ici vos questions, réponses, commentaires ou suggestions - Les sujets seront ultérieurement répartis dans les archives par les modérateurs

Modérateur : Groupe des modérateurs

Stéphane Pelletier
Messages : 16
Enregistré le : 04 Déc 2017, 06:28

lapply

Messagepar Stéphane Pelletier » 24 Juin 2018, 16:45

Bonjour,

J'ai cette fonction qui me permet de soustraire une valeur donnée au autre valeurs d'un data frame "splitté" :

Code : Tout sélectionner

fonction<-function(x,y,fl){
df <- data.frame(x, fl, y)
sp <- split(df, y)
difference <- lapply(sp, function(x) x$x - x$x[x$fl==2])
a=data.frame(na.omit(df, unlist(difference)))
return(a)
}


Avec cette fonction, je suis obligé de traiter colonne par colonne mon data frame.
J'ai donc essayé de l'adapter pour quelle fonctionne avec plusieurs colonnes différentes :

Code : Tout sélectionner

fonction<-function(x=c(...),y=c(...)){
for (i in y){
vec<-c(apply(expand.grid(x,i), 1, paste, collapse = "_"))
data2=data[colnames(data)%in%vec]
sp <- split(data2, data2[,grep(pattern="chan",colnames(data2))])
print(sp)
vec2<-c(apply(expand.grid("fluo",i), 1, paste, collapse = "_"))
difference <- lapply(sp, function(vec) vec$vec - vec$vec[vec$vec2==2])
print(difference)
}
}


L'ensemble marche sauf la partie avec "lapply". Le résultat renvoyé est "integer(0)" et je ne comprend pas pourquoi. Le data frame est crée et splitté tel que je le souhaite et comme le fait la première fonction.
Si quelqu'un à un solution, d'avance merci.

Stéphane

Mickael Canouil
Messages : 1315
Enregistré le : 04 Avr 2011, 08:53
Contact :

Re: lapply

Messagepar Mickael Canouil » 25 Juin 2018, 08:53

Bonjour,

serait-il possible d'avoir un exemple reproductible ?
Ce sera beaucoup plus simple de proposer une solution à votre problème.

Voir:
Qu'est-ce qu'un code reproductible ?
Comment insérer des données dans un message ?

Cordialement,
Mickaël
mickael.canouil.fr | rlille.fr

Stéphane Pelletier
Messages : 16
Enregistré le : 04 Déc 2017, 06:28

Re: lapply

Messagepar Stéphane Pelletier » 25 Juin 2018, 10:03

Bonjour Mickael,

Merci de la réponse.

Je souhaite utiliser ces fonctions avec des data d'un fichier csv. Mais voici quelque chose de reproductible :

Code : Tout sélectionner

chan_a<-c(2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,4,4,4,4,4,4,4,NA,NA,NA,NA,NA,NA,NA,NA,NA)
test1_a<-c(1686.729,2097.048,1283.899,943.882,1213.855,3225.202,3640.502,1619.531,125.618,1846.551,2691.359,2114.047,1973.151,2405.32,2300.182,125.37,1061.003,1046.895,1348.668,2653.57,2663.689,2513.269,125.859,NA,NA,NA,NA,NA,NA,NA,NA,NA)
test2_a<-c(239.077,225.039,222.987,189.581,216.397,292.713,281.236,215.711,126.336,656.92,668.276,700.468,963.402,770.507,608.539,123.777,225.024,192.198,215.794,289.231,283.172,315.735,123.376,NA,NA,NA,NA,NA,NA,NA,NA,NA)
sous_a<-c(1,1,1,1,1,0,0,0,2,1,1,1,0,0,0,2,1,1,1,0,0,0,2,NA,NA,NA,NA,NA,NA,NA,NA,NA)


chan_b<-c(1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4)
test1_b<-c(1724.1,1618.618,2711.061,2101.482,2700.841,2191.006,1985.074,2389.664,140.601,1818.118,1633.042,1412.723,2037.698,1644.689,117.682,2447.171,3219.997,2937.951,1510.059,2364.83,2286.647,2115.407,2566.157,2589.405,117.59,1614.297,1572.772,1535.659,1773.902,2502.302,1918.392,126.112)
test2_b<-c(262.179,374.372,567.116,548.682,456.197,351.873,346.28,466.298,126.842,805.615,693.568,761.272,777.43,673.069,124.092,745.198,758.18,696.794,495.127,560.076,641.354,476.052,776.308,578.484,123.903,695.857,548.874,642.268,722.153,638.45,901.19,125.827)
sous_b<-c(1,1,1,1,0,0,0,0,2,1,1,0,0,0,2,1,1,1,1,1,0,0,0,0,2,1,1,1,0,0,0,2)

data=data.frame(chan_a,test1_a,test2_a,sous_a,chan_b,test1_b,test2_b,sous_b)

Avec ces data, je souhaite pour chaque valeur dont le nom est "test1" ou "test2" la soustraire par la valeur dont "sous" est égale à 2 et pour chaque "chan" (désolé si c'est un peu "lourd" et pas très claire)

Premiere fonction = traiter chaque donnée independémment :

Code : Tout sélectionner

fonction<-function(x,y,fl){
df <- data.frame(x, fl, y)
sp <- split(df, y)
difference <- lapply(sp, function(x) x$x - x$x[x$fl==2])
print(difference)
}

fonction(x=test1_b,y=chan_b,fl=sous_b)
fonction(x=test2_b,y=chan_b,fl=sous_b)

Ca marche.

Deuxieme fonction : je souhaite tout traiter en même temps :

Code : Tout sélectionner

fonction<-function(x=c(...),y=c(...)){
for (i in y){
vec<-c(apply(expand.grid(x,i), 1, paste, collapse = "_"))
data2=data[colnames(data)%in%vec]
sp <- split(data2, data2[,grep(pattern="chan",colnames(data2))])
print(sp)
vec2<-c(apply(expand.grid("sous",i), 1, paste, collapse = "_"))
difference <- lapply(sp, function(vec) vec$vec - vec$vec[vec$vec2==2])
print(difference)
}
}

fonction(x=c("chan","sous","test1","test2"),y=c("a","b"))

Et là, la fonction marche jusqu'au "split", mais pas pour la différence.

Voila.
Merci de votre aide.

Stéphane

Mickael Canouil
Messages : 1315
Enregistré le : 04 Avr 2011, 08:53
Contact :

Re: lapply

Messagepar Mickael Canouil » 25 Juin 2018, 14:35

Bonjour,

je vais admettre que votre objet usuel est le "data" (renommer en "dta" pour ne pas confondre avec la fonction du même nom).

Code : Tout sélectionner

dta <- structure(list(chan_a = c(2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3,
3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, NA, NA, NA, NA, NA, NA, NA,
NA, NA), test1_a = c(1686.729, 2097.048, 1283.899, 943.882, 1213.855,
3225.202, 3640.502, 1619.531, 125.618, 1846.551, 2691.359, 2114.047,
1973.151, 2405.32, 2300.182, 125.37, 1061.003, 1046.895, 1348.668,
2653.57, 2663.689, 2513.269, 125.859, NA, NA, NA, NA, NA, NA,
NA, NA, NA), test2_a = c(239.077, 225.039, 222.987, 189.581,
216.397, 292.713, 281.236, 215.711, 126.336, 656.92, 668.276,
700.468, 963.402, 770.507, 608.539, 123.777, 225.024, 192.198,
215.794, 289.231, 283.172, 315.735, 123.376, NA, NA, NA, NA,
NA, NA, NA, NA, NA), sous_a = c(1, 1, 1, 1, 1, 0, 0, 0, 2, 1,
1, 1, 0, 0, 0, 2, 1, 1, 1, 0, 0, 0, 2, NA, NA, NA, NA, NA, NA,
NA, NA, NA), chan_b = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2,
2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4), test1_b = c(1724.1,
1618.618, 2711.061, 2101.482, 2700.841, 2191.006, 1985.074, 2389.664,
140.601, 1818.118, 1633.042, 1412.723, 2037.698, 1644.689, 117.682,
2447.171, 3219.997, 2937.951, 1510.059, 2364.83, 2286.647, 2115.407,
2566.157, 2589.405, 117.59, 1614.297, 1572.772, 1535.659, 1773.902,
2502.302, 1918.392, 126.112), test2_b = c(262.179, 374.372, 567.116,
548.682, 456.197, 351.873, 346.28, 466.298, 126.842, 805.615,
693.568, 761.272, 777.43, 673.069, 124.092, 745.198, 758.18,
696.794, 495.127, 560.076, 641.354, 476.052, 776.308, 578.484,
123.903, 695.857, 548.874, 642.268, 722.153, 638.45, 901.19,
125.827), sous_b = c(1, 1, 1, 1, 0, 0, 0, 0, 2, 1, 1, 0, 0, 0,
2, 1, 1, 1, 1, 1, 0, 0, 0, 0, 2, 1, 1, 1, 0, 0, 0, 2)), class = "data.frame", row.names = c(NA,
-32L))


Petite modification de votre fonction initiale pour que cela soit plus propre

Code : Tout sélectionner

fonction0 <- function(x, y, fl, data){
  df <- data[, c(x, fl, y)]
  sp <- split(df, df[, y])
  difference <- lapply(
    X = sp,
    FUN = function(sdf) {
      sdf[, x] - sdf[sdf[, fl]==2, x]
    }
  )
  return(difference)
}


Extension de la fonction (ce n'est qu'une proposition inspiré de votre code):

Code : Tout sélectionner

fonction1 <- function(x = c("test1", "test2"), y = "chan", fl = "sous", suffixes = c("a", "b"), data) {
  out <- lapply(X = suffixes, FUN = function(isuffix) {
    tmp <- lapply(X = x, FUN = function(ix) {
      fonction0(
        x = paste(ix, isuffix, sep = "_"),
        y = paste(y, isuffix, sep = "_"),
        fl = paste(fl, isuffix, sep = "_"),
        data = data
      )
    })
    names(tmp) <- x
  })
  names(out) <- suffixes
  return(out)
}


Pour tester les deux fonctions:

Code : Tout sélectionner

fonction0(x = "test1_b", y = "chan_b", fl = "sous_b", data = dta)
fonction1(x = c("test1", "test2"), y = "chan", fl = "sous", suffixes = c("a", "b"), data = dta)



Maintenant une proposition utilisant le "tidyverse" et permettant d'avoir un tableau en sortie:
La fonction ci-dessous correspond à la fonction "fonction0" ci-dessus.

Code : Tout sélectionner

library(tidyverse)
diff_function <- function(params = c("x", "y", "z"), data) {
  data %>%
    select(params) %>%
    `colnames<-`(c("x", "y", "z")) %>%
    group_by(y) %>%
    transmute(
      difference = x-x[z==2]
    ) %>%
    ungroup() %>%
    `colnames<-`(c(params[2], "difference")) %>%
    return()
}


Ici, il s'agit de formater l'objet "dta" pour qu'il soit dans un format long

Code : Tout sélectionner

dta_long <- dta %>%
  mutate(ID = seq_len(n())) %>%
  gather(key = "Var", value = "Value", -"ID") %>%
  separate(col = "Var", into = c("Variable", "Suffix"), sep = "_") %>%
  spread(key = "Variable", value = "Value") %>%
  gather(key = "keytest", value = "test", -c("ID", "Suffix", "chan", "sous"))

Image
Puis on applique la fonction sur les modalités de vos facteurs "a", "b" et "test1", "test2", tout en renvoyant une table.

Code : Tout sélectionner

dta_long %>%
  group_by(Suffix, keytest) %>%
  nest() %>%
  mutate(
    Difference = map(.x = data, .f = ~diff_function(params = c("test", "chan", "sous"), data = .x))
  ) %>%
  select(-data) %>%
  unnest()

Image

Cordialement,
Mickaël
mickael.canouil.fr | rlille.fr

Stéphane Pelletier
Messages : 16
Enregistré le : 04 Déc 2017, 06:28

Re: lapply

Messagepar Stéphane Pelletier » 25 Juin 2018, 19:33

Merci Mickael pour ton aide.

Concernant la fonction "fonction0", c'est une manière d'écrire dont je n'ai pas l'habitude (j'ai commencé depuis peu à ecrire mes propre fonction pour automatiser certaine tâche), mais je la comprend. De pus elle marche.

Pour la fonction "fonction1", j'ai besoin de plus de temps pour la comprendre completement. Mais par contre chez moi elle ne marche pas.
Voici ce qu'elle renvoie :

Code : Tout sélectionner

$a
[1] "test1" "test2"

$b
[1] "test1" "test2"


Mais puisque tu fais appelle a la fonction "fonction0" dans la fonction "fonction1", a priori elle devrai renvoyé une liste avec les résultats?

Stéphane

Stéphane Pelletier
Messages : 16
Enregistré le : 04 Déc 2017, 06:28

Re: lapply

Messagepar Stéphane Pelletier » 26 Juin 2018, 06:06

Bonjour,

Tout est bon, en fait j'ai compris, et ça marche super bien. Merci beaucoup ;)

Bonne journée.

Stéphane

Bastien Gamboa
Messages : 151
Enregistré le : 13 Jan 2011, 21:31

Re: lapply

Messagepar Bastien Gamboa » 26 Juin 2018, 11:47

Bonjour,

Si j'ai bien compris ce que tu veux faire, je te proposes une approche alternative potentiellement plus simple :

Code : Tout sélectionner

# Mise en forme des données en fonction de _a et _b
truc1 <- data.frame(ID="a", dta[,c("chan_a", "test1_a", "test2_a", "sous_a")])
truc2 <- data.frame(ID="b", dta[,c("chan_b", "test1_b", "test2_b", "sous_b")])
colnames(truc1) <- colnames(truc2) <- c("ID", "chan", "test1", "test2", "sous")
truc <- rbind(truc1, truc2)

# J'isole les valeurs à soustraire
truc3 <- truc[truc$sous==2 & !is.na(truc$sous),c("ID", "chan", "test1", "test2")]
colnames(truc3) <- c("ID", "chan", "soustrait_test1", "soustrait_test2")

# Je rassemble les valeurs à soustraire, aux données
truc4 <- merge(x=truc, y=truc3, all=TRUE)

# Soustraction
truc4$test1_bis <- truc4$test1 - truc4$soustrait_test1
truc4$test2_bis <- truc4$test2 - truc4$soustrait_test2

Il est possible d'automatiser selon le suffixe et/ou la valeur de 'dta$sous' si nécessaire.

HTH,
Bastien

Stéphane Pelletier
Messages : 16
Enregistré le : 04 Déc 2017, 06:28

Re: lapply

Messagepar Stéphane Pelletier » 27 Juin 2018, 14:32

Merci Bastien, ça marche aussi très bien.
Je ferais au plus simple. Il faudra que je mette cette fonction dans une autre. La "soustraction" est la premiere partie de l'analyse de mes data, mais c'était aussi la partie la plus compliqué pour moi.

Merci à tout les 2.

Bonne journée.

Stéphane


Retourner vers « Questions en cours »

Qui est en ligne

Utilisateurs parcourant ce forum : Google [Bot] et 1 invité