tidyverse方法看起来可能是这样的。通过整形为long，我们可以很容易地使用left_join根据孩子的年龄合并L列。

library(tidyverse)

sample |>
  pivot_longer(starts_with("asfr")) |>
  mutate(age_child = age - readr::parse_number(name)) |>
  left_join(sample1, by = c("age_child" = "age")) |>
  mutate(value = value * (1 - L)) |>
  select(-age_child, -L) |>
  pivot_wider(
    names_from = name,
    values_from = value
  )
#> # A tibble: 2 × 41
#>      iD   age born_1 born_2 born_3 born_4 asfr15 asfr16 asfr17 asfr18 asfr19
#>   <dbl> <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
#> 1     1    68     14      9      4      0      0  0.555  3.06   4.98   6.41 
#> 2     2    40      1     NA     NA     NA      0  0.206  0.199  0.192  0.184
#> # ℹ 30 more variables: asfr20 <dbl>, asfr21 <dbl>, asfr22 <dbl>, asfr23 <dbl>,
#> #   asfr24 <dbl>, asfr25 <dbl>, asfr26 <dbl>, asfr27 <dbl>, asfr28 <dbl>,
#> #   asfr29 <dbl>, asfr30 <dbl>, asfr31 <dbl>, asfr32 <dbl>, asfr33 <dbl>,
#> #   asfr34 <dbl>, asfr35 <dbl>, asfr36 <dbl>, asfr37 <dbl>, asfr38 <dbl>,
#> #   asfr39 <dbl>, asfr40 <dbl>, asfr41 <dbl>, asfr42 <dbl>, asfr43 <dbl>,
#> #   asfr44 <dbl>, asfr45 <dbl>, asfr46 <dbl>, asfr47 <dbl>, asfr48 <dbl>,
#> #   asfr49 <dbl>

字符串
然而，虽然这适用于您的示例数据，但恐怕对于您的庞大数据集来说效率不高。因此，这里是一个基于矩阵的方法。基本上，我首先创建一个L值的矩阵，其中每行反映了基于母亲年龄的相应值，并且名称对应于asfr列。然后，我们可以将asfr列乘以这个矩阵。

L_mat <- sapply(sample$age, \(age) {
  L <- c(rep(NA, 35), sample1$L) # 35 = 49 - 15 + 1
  names(L) <- c(-rev(seq_len(35)), sample1$age)
  L[as.character(age - 15:49)]
}) |>
  t()
colnames(L_mat) <- paste0("L", 15:49)

sample[paste0("asfr", 15:49)] <-
  sample[paste0("asfr", 15:49)] * (1 - L_mat)
sample
#> # A tibble: 2 × 41
#>      iD   age born_1 born_2 born_3 born_4 asfr15 asfr16 asfr17 asfr18 asfr19
#>   <dbl> <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
#> 1     1    68     14      9      4      0      0  0.555  3.06   4.98   6.41 
#> 2     2    40      1     NA     NA     NA      0  0.206  0.199  0.192  0.184
#> # ℹ 30 more variables: asfr20 <dbl>, asfr21 <dbl>, asfr22 <dbl>, asfr23 <dbl>,
#> #   asfr24 <dbl>, asfr25 <dbl>, asfr26 <dbl>, asfr27 <dbl>, asfr28 <dbl>,
#> #   asfr29 <dbl>, asfr30 <dbl>, asfr31 <dbl>, asfr32 <dbl>, asfr33 <dbl>,
#> #   asfr34 <dbl>, asfr35 <dbl>, asfr36 <dbl>, asfr37 <dbl>, asfr38 <dbl>,
#> #   asfr39 <dbl>, asfr40 <dbl>, asfr41 <dbl>, asfr42 <dbl>, asfr43 <dbl>,
#> #   asfr44 <dbl>, asfr45 <dbl>, asfr46 <dbl>, asfr47 <dbl>, asfr48 <dbl>,
#> #   asfr49 <dbl>

型

我相信这是可行的，尽管我 * 肯定 * 有更优雅的解决方案-首先创建一个“helper”函数，它将根据年龄识别需要修改的列，并根据您的描述修改它们（asfrN * (1-L[age])）。然后我根据ID将split转换为列表，并在整个列表中应用该函数，将其与do.call重新组合在一起

helperFun <- function(x){
  asfr <- paste0("asfr", 15:min((x$age - 15), 49))
  x[asfr] <- lapply(x[asfr], \(y) 
                    y * (1-(sample1[sample1$age == (x$age - 15),"L"])))
  x
}

do.call(rbind, lapply(split(sample, sample$iD), helperFun))

字符串
尽管由于样本数据的宽度而难以在此演示，但在序数sample数据中仅修改了与年龄相适应的列。
下面我输出列asfr 15 -18和22-28，以显示转换在ID #2的正确列处停止：

# A tibble: 2 × 13
#      iD   age asfr15$L asfr16$L asfr17$L asfr18$L asfr22$L asfr23$L asfr24$L asfr25$L asfr26$L asfr27$L asfr28$L
#   <dbl> <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
# 1     1    68        0    0.584    3.38     5.76     14.2     15.1     15.8     15.8      15.8     15.8     15.6
# 2     2    40        0    0.214    0.214    0.214     5.20     5.20     5.20     5.20    180.     180.     180.

型