Groupby summarise on multicolumns with subseted rows in R-CodePudding

I am trying to figure out a clean and tidy expression to aggregate statistics on multiple columns using subsetted rows with group_by and summarise. The following is an example solved with a loop.

# example data
dat <- data.frame(
  method = rep(c("A", "B", "baseline"), 2),
  id = rep(1:2, each = 3),
  X = round(rnorm(6, 1, 0.2),3),
  Y = round(runif(6, 1, 2),3)
)
print(dat)
#>     method id     X     Y
#> 1        A  1 0.859 1.003
#> 2        B  1 0.993 1.922
#> 3 baseline  1 1.401 1.959
#> 4        A  2 1.084 1.432
#> 5        B  2 1.083 1.883
#> 6 baseline  2 0.943 1.341

Let's regard A, B, baseline as names of methods, X, Y as evaluation criteria, and id as the ID of repeated experiments. Then, we want to figure out how much improvement in the sense of X and Y has been gained by method A and method B. The improvement is measured as the relative shrinkage of the evaluating criteria over the baseline method.

result <- dat[0,]
for (i in unique(dat$id)) {
  score_A <- dat[dat$id == i & dat$method == "A", c("X", "Y")]
  score_B <- dat[dat$id == i & dat$method == "B", c("X", "Y")]
  score_baseline <- dat[dat$id == i & dat$method == "baseline", c("X", "Y")]
  
  result <- rbind(
    result,
    cbind(
      data.frame(method = c("A", "B")),
      rbind(
        (score_baseline - score_A) / score_baseline,
        (score_baseline - score_B) / score_baseline
      )
    )
  )
}
print(result)
#>    method          X           Y
#> 3       A  0.3868665  0.48800408
#> 31      B  0.2912206  0.01888719
#> 6       A -0.1495228 -0.06785981
#> 61      B -0.1484624 -0.40417599

Now, I would like a more tidy solution for the result above.

CodePudding user response：

Using across you could do:

Note: When using random data you should use set.seed. For this reason my random data differs from the one you provided.

library(dplyr)

dat %>%
  group_by(id) %>%
  mutate(across(c(X, Y), ~ (.x[method == "baseline"] - .x) / .x[method == "baseline"])) %>%
  ungroup() %>%
  filter(!method == "baseline")
#> # A tibble: 4 × 4
#>   method    id     X      Y
#>   <chr>  <int> <dbl>  <dbl>
#> 1 A          1 0.323 -0.521
#> 2 B          1 0.273 -0.426
#> 3 A          2 0.245 -0.823
#> 4 B          2 0.236 -0.196

DATA

set.seed(123)

dat <- data.frame(
  method = rep(c("A", "B", "baseline"), 2),
  id = rep(1:2, each = 3),
  X = round(rnorm(6, 1, 0.2), 3),
  Y = round(runif(6, 1, 2), 3)
)