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"))
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()
Cordialement,