tests/testthat/test-plot_link.R

In ims-fhs/cld: a DSL to Process Causal Loop Diagrams in R

context("plot_link helper functions")

test_that("offset_coord works.", {
  expect_equal(offset_x(0,0), 0)
  expect_equal(offset_x(1,2), offset_x(2,3))
  expect_true(offset_x(0,2) > offset_x(0,1))
  expect_equal(offset_y(0,0), 0)
  expect_equal(offset_y(1,2), offset_y(2,3))
  expect_true(offset_y(0,2) > offset_y(0,1))
})

# test_that("offset works.", {
#   df <- data.frame(from_x = c(0,100,500,500), to_x = c(100,500,500,100), from_y = c(0,500,100,500), to_y = c(500,100,500,500), curvature = c(-.2,-.5,.1,1))
#   df_off <- offset(df)
#   expect_true(df_off$from_x[1]  df$from_x[1])
#   expect_true(df_off$from_y[1] > df$from_y[1])
#   expect_true(df_off$to_x[1] < df$to_x[1])
#   expect_true(df_off$to_y[1] < df$to_y[1])
#   expect_true(df_off$from_x[2] > df$from_x[2])
#   expect_true(df_off$from_y[2] < df$from_y[2])
#   expect_true(df_off$to_x[2] < df$to_x[2])
#   expect_true(df_off$to_y[2] > df$to_y[2])
#   expect_true(df_off$from_x[3] == df$from_x[3])
#   expect_true(df_off$from_y[3] > df$from_y[3])
#   expect_true(df_off$to_x[3] == df$to_x[3])
#   expect_true(df_off$to_y[3] < df$to_y[3])
#   expect_true(df_off$from_x[4] < df$from_x[4])
#   expect_true(df_off$from_y[4] == df$from_y[4])
#   expect_true(df_off$to_x[4] > df$to_x[4])
#   expect_true(df_off$to_y[4] == df$to_y[4])
#   print(df_off)
# })

test_that("link_coordinates works.", {
  cld <- import("mdl/burnout.mdl")
  cld1 <- link_coordinates(cld)
  expect_equal(nrow(cld1), nrow(cld))
  expect_equal(ncol(cld1), ncol(cld) + 4)
  expect_equal(cld1$from_x[1:6], c(426, 610, 569, 569, 253, 426))
  expect_equal(cld1$from_y[1:2], c(-276, -226))
  expect_equal(cld1$to_x[1:2], c(610, 569))
  expect_equal(cld1$to_y[1:2], c(-226, -364))
})

test_that("curvature works.", {
  cld <- import("mdl/burnout.mdl")
  expect_error(curvature(cld))
  cld <- as.data.frame(cld)
  cld <- link_coordinates(cld)
  print(cld$curvature)
  expect_true(all(curvature(cld)$curvature < 0, na.rm = TRUE))
  cld <- import("mdl/cld-adoption.mdl")
  expect_error(curvature(cld))
  cld <- as.data.frame(cld)
  cld <- link_coordinates(cld)
  print(cld$curvature)
  expect_equal(sign(curvature(cld)$curvature), c(1,1,-1,-1,rep(NA, 3)))
})

test_that("position works", {
  expect_equal(position(0,0,0,0,0,0), 0)
  expect_equal(position(0,0,1,1,1,0), -1)
  expect_equal(position(0,0,1,1,0,1), 1)
  expect_equal(sign(position(0,0,1,1,.5,.4)), -1)
  expect_equal(sign(position(0,0,1,1,.5,.6)), 1)
})