Applying conditions to 2 dataframes to perform calculation and store result

I have two dataframes; a simplified version looks something like the following:

df1 <- data.frame(x = c(rep(c(1:10)), rep(c(9:1))),
                  y = c(200, 183, 166, 144, 117, 80, 65, 33, 14, 0, 6, 15, 37, 65, 92, 123, 156, 182, 200))

df2 <- data.frame(WL = sample(x = 0:200, size = 19, replace = F))

For context, df1 actually represents a river cross-section (x & y) and df2 represents hourly water level measurements (WL).

I would like to create an automated way to calculate the cross-sectional area of the river channel that is filled with water for each water level in df2, and store that area in a new column called area in df2.

The following code shows what I would like to achieve, but as you can see it can get very tedious as my actual water level dataset is huge (hundreds of rows). I would appreciate any help to automate this process:

# package required for calculating area of polygon
library(pracma)

# for the first observation/row in df2:
a <- ifelse(df1$y <= df2$WL[1], df1$y, 0) 
df2$area[1] <- abs(polyarea(df1$x, a)) 

# for the second observation/row in df2:
a <- ifelse(df1$y <= df2$WL[2], df1$y, 0) 
df2$area[2] <- abs(polyarea(df1$x, a))

CodePudding user response：

library(tidyverse)
library(pracma)
#> 
#> Attaching package: 'pracma'
#> The following object is masked from 'package:purrr':
#> 
#>     cross

df1 <- data.frame(
  x = c(rep(c(1:10)), rep(c(9:1))),
  y = c(200, 183, 166, 144, 117, 80, 65, 33, 14, 0, 6, 15, 37, 65, 92, 123, 156, 182, 200)
)
df2 <- data.frame(WL = sample(x = 0:200, size = 19, replace = F))

df2 %>%
  as_tibble() %>%
  mutate(
    area = WL %>% map_dbl(~ {
      a <- ifelse(df1$y <= .x, df1$y, 0)
      abs(polyarea(df1$x, a))
    })
  )
#> # A tibble: 19 × 2
#>       WL  area
#>    <int> <dbl>
#>  1   128    29
#>  2   193   126
#>  3    33    26
#>  4    96    23
#>  5    26     7
#>  6    13     6
#>  7    10     6
#>  8    68    11
#>  9    93    23
#> 10   125    29
#> 11   106    23
#> 12    49    11
#> 13    12     6
#> 14   100    23
#> 15    76    11
#> 16   118    94
#> 17    20     7
#> 18    67    11
#> 19   164    41

^{Created on 2022-03-02 by the reprex package (v2.0.0)}