tests/testthat/test-discretize_depth.R

In valentingar/ConFluxPro: A toolkit for soil gas analysis

test_that("correct interpolation",{
  df1 <- data.frame(depth = c(10,0,-50),
                    value1 = c(1,5,30),
                    site = "A")

  df2 <- data.frame(upper = c(9,0,-10),
                    lower = c(0,-10,-30),
                    value2 = c(0.9,0.7,0.5),
                    site = "A")

  lmap <- data.frame(depth = c(5,0,-5,-10,-20,-30),
                     site = "A")

  df_res <-data.frame(site = "A",
                      upper = c(5,0,-5,-10,-20),
                      lower = c(0,-5,-10,-20,-30),
                      depth = c(2.5,-2.5,-7.5,-15,-25),
                      value2 = c(0.9,0.7,0.7,0.5,0.5),
                      value1 = c(4,6.25,8.75,12.5,17.5))
  df_res <-df_res[order(df_res$upper),]
  row.names(df_res) <- (1:5)
  df_res1 <- df_res[,c(1,6,4,2,3)] |> cfp_layered_profile(id_cols = "site")
  df_res2 <- df_res[,c(1,5,4,2,3)]|> cfp_layered_profile(id_cols = "site")



  expect_equal(
  discretize_depth(df1,
                   param = "value1",
                   depth_target = lmap,
                   method = "linear",
                   id_cols = "site"),
  df_res1

  )
  expect_equal(
    discretize_depth(df2,
                     param = "value2",
                     depth_target = lmap,
                     method = "boundary",
                     id_cols = "site"),
    df_res2


  )
})

test_that("can interpolate multiple profiles",{
  df1 <- data.frame(depth = c(10,0,-50,
                              10,0,-30),
                    value1 = c(1,5,30,
                               1,60,120),
                    site = c("A","A","A",
                             "B","B","B")
  )

  df2 <- data.frame(upper = c(9,0,-10,
                              5,0,-20),
                    lower = c(0,-10,-30,
                              0,-20,-50),
                    value2 = c(0.9,0.7,0.5,
                               10,12,11),
                    site = c("A","A","A",
                             "B","B","B")
  )

  lmap <- data.frame(depth = c(5,0,-5,-10,-20,-30,
                               2,0,-6,-8,-20,-24),
                     site = c("A","A","A","A","A","A",
                              "B","B","B","B","B","B"))

  df_res <-data.frame(site = c("A","A","A","A","A",
                               "B","B","B","B","B"),
                      upper = c(5,0,-5,-10,-20,
                                2,0,-6,-8,-20),
                      lower = c(0,-5,-10,-20,-30,
                                0,-6,-8,-20,-24),
                      depth = c(2.5,-2.5,-7.5,-15,-25,
                                1,-3,-7,-14,-22),
                      value2 = c(0.9,0.7,0.7,0.5,0.5,
                                 10,12,12,12,11),
                      value1 = c(4,6.25,8.75,12.5,17.5,
                                 54.1,66,74,88,104)
                      )

  df_res <-df_res[order(df_res$site,df_res$upper),]
  row.names(df_res) <- (1:10)

  df_res <- df_res |> cfp_layered_profile(id_cols = "site")

  expect_equal(
    discretize_depth(df1,
                     param = "value1",
                     depth_target = lmap,
                     method = "linear",
                     id_cols = "site"),
    df_res[,c(1,6,4,2,3)]

  )
  expect_equal(
    discretize_depth(df2,
                     param = "value2",
                     depth_target = lmap,
                     method = "boundary",
                     id_cols = "site"),
    df_res[,c(1,5,4,2,3)]
  )

})

test_that("boundary creates correct NAs",{
          df <- data.frame(upper = c(9,0,-10),
                           lower = c(0,-10,-30),
                           value2 = c(0.9,0.7,0.5),
                           site = "A")

          lmap <- data.frame(depth = c(12,10,0,-5,-8,-20,-30,-100),
                             site = "A")

          expect_equal(discretize_depth(df,
                                        param = "value2",
                                        depth_target = lmap,
                                        method = "boundary",
                                        id_cols = "site")$value2,
                       c(NA,0.5,NA,0.7,0.7,NA,NA)
                       )


          })


test_that("depth_target can be a vector",{
  df <- discretize_depth(
    data.frame(upper = c(10,0),
               lower = c(0,-100),
               value = c("A","B"),
               site = "A") ,
    depth_target = c(10,0,-10,-50),
    method = "boundary",
    param = "value",
    id_cols = "site")

  expect_equal(nrow(df),3)
})


test_that("id_cols can be left blank",{
  df <- discretize_depth(
    data.frame(upper = c(10,0),
               lower = c(0,-100),
               value = c("A","B")) ,
    depth_target = c(10,0,-10,-50),
    method = "boundary",
    param = "value")

  expect_equal(nrow(df),3)
})


test_that("method boundary_average",{
  df <- data.frame(upper = c(10,0),
                   lower = c(0,-10),
                   value = c(1,2))
  dt <- c(10,5,-5,-10)

  df_test <-
  discretize_depth(df,
                   "value",
                   "boundary",
                   dt,
                   boundary_nearest = T,
                   boundary_average = "arith")

  df_res <-
    data.frame(value = c(2,1.5,1),
               depth = c(-7.5,0,7.5),
               upper = c(-5,5,10),
               lower = c(-10,-5,5)
    )|> cfp_layered_profile(id_cols = NULL)
  expect_equal(df_test,df_res)
})


test_that("method nearest",{
  df <- data.frame(depth = c(-10,-8,0,10),
                   value = c(1,4,1,2))
  dt <- c(10,7,-5,-10)

  df_test <-
    discretize_depth(df,
                     "value",
                     "nearest",
                     dt,
                     int_depth = 0.5)

  df_test2 <-
    discretize_depth(df,
                     "value",
                     "nearest",
                     dt,
                     int_depth = 0)

  df_test3 <-
    discretize_depth(df,
                     "value",
                     "nearest",
                     dt,
                     int_depth = 1)

  df_res <-
    data.frame(value = c(4,1,2),
               depth = c(-7.5,1,8.5),
               upper = c(-5,7,10),
               lower = c(-10,-5,7)
    )|> cfp_layered_profile(id_cols = NULL)
  expect_equal(df_test,df_res)
  expect_equal(df_test2$value,c(1,4,2))
  expect_equal(df_test3$value,c(4,2,2))
})

test_that("method harmonic",{
  df <- data.frame(depth = c(-10,0,10),
                   value = c(1,1,2))
  dt <- c(10,5,-5,-10)

  df_test <-
    discretize_depth(df,
                     "value",
                     "harmonic",
                     dt,
                     int_depth = 0.5)

  df_res <-
    data.frame(value = c(1,1,1.6),
               depth = c(-7.5,0,7.5),
               upper = c(-5,5,10),
               lower = c(-10,-5,5)
    )|> cfp_layered_profile(id_cols = NULL)
  expect_equal(df_test,df_res)
})


test_that("method linear spline",{
  df <- data.frame(depth = c(-10,0,10),
                   value = c(1,1,2))
  dt <- c(10,5,-5,-10)

  df_test <-
    discretize_depth(df,
                     "value",
                     "linspline",
                     dt)

  df_res <-
    data.frame(value = c(0.958,1.333,1.708),
               depth = c(-7.5,0,7.5),
               upper = c(-5,5,10),
               lower = c(-10,-5,5)
    ) |> cfp_layered_profile(id_cols = NULL)

  expect_equal(round(df_test,3),df_res)
})