Apply function to multiple datasets-CodePudding

*The following function works when the variables (Age, Age2 and Mspline) are in vector format.

Age<-c(2,2.1,2.2,3.4,3.5,4.2,4.7,4.8,5,5.6,NA, 5.9, NA)
Age2<-seq(2,20,0.25)    
Mspline<-rnorm(73)

res <- lapply(1:length(Age), \(x){
  lwr_ind <- max(which(Age2 <= Age[x]))
  upr_ind <- min(which(Age2 >= Age[x]))
  data.frame(Age = Age[x], 
             Mspline = Mspline[lwr_ind]   ((Age[x]-Age2[lwr_ind])/0.25)*(Mspline[lwr_ind] - Mspline[upr_ind]))
})

res <- do.call(rbind, res)

I was wondering how we can modify the function above in order to be used when we have two data sets df1 and df2 and Age, Age2 and Mspline are variables of two data set:*

Age<-c(2,2.1,2.2,3.4,3.5,4.2,4.7,4.8,5,5.6,NA, 5.9, NA)
R<-c(2,2.1,2.2,3.4,3.5,4.2,4.7,4.8,5,5.6,NA, 5.9, NA)
df1<-data.frame(Age,R)
# Second data:
Age2<-seq(2,20,0.25)    
Mspline<-rnorm(73)
df2<-data.frame(Age2, Mspline)

CodePudding user response：

# with vector input data...
set.seed(1234)
Age <- c(2, 2.1, 2.2, 3.4, 3.5, 4.2, 4.7, 4.8, 5, 5.6, NA, 5.9, NA)
Age2 <- seq(2, 20, 0.25)    
Mspline <- rnorm(73)

res <- lapply(1:length(Age), \(x){
  lwr_ind <- max(which(Age2 <= Age[ x ]))
  upr_ind <- min(which(Age2 >= Age[ x ]))
  data.frame(Age = Age[ x ], 
             Mspline = Mspline[ lwr_ind ]   
               ((Age[ x ] - Age2[ lwr_ind ]) / 0.25) * 
               (Mspline[ lwr_ind ] - Mspline[ upr_ind ]))
})
res1 <- do.call(rbind, res)

# with data.frame input data...
Age <- c(2, 2.1, 2.2, 3.4, 3.5, 4.2, 4.7, 4.8, 5, 5.6, NA, 5.9, NA)
R <- rnorm(13)
df1 <- data.frame(Age, R)
Age2 <- seq(2,20,0.25)
df2 <- data.frame(Age2, Mspline)

res2 <- lapply(1:nrow(df1), \(x){
  age <- df1[ x, 'Age' ]
  age2 <- df2[ , 'Age2' ]
  R <- df1[ x, 'R' ]
  lwr_ind <- max(which(age2 <= age))
  upr_ind <- min(which(age2 >= age))
  data.frame(Age = age, 
             Mspline = df2[ lwr_ind, 'Mspline' ]   
               ((age - df2[ lwr_ind, 'Age2' ]) / 0.25) * 
               (df2[ lwr_ind, 'Mspline' ] - df2[ upr_ind, 'Mspline' ]),
             R)
})
res2 <- do.call(rbind, res2)

identical(res1, res2[ , 1:2 ])

[1] TRUE