test_that("distance argument accepted by step_smote()", {
  expect_no_error(
    recipe(class ~ x + y, data = circle_example) |>
      step_smote(class, distance = "euclidean") |>
      prep() |>
      bake(new_data = NULL)
  )
  expect_no_error(
    recipe(class ~ x + y, data = circle_example) |>
      step_smote(class, distance = "cosine") |>
      prep() |>
      bake(new_data = NULL)
  )
  expect_no_error(
    recipe(class ~ x + y, data = circle_example) |>
      step_smote(class, distance = "mahalanobis") |>
      prep() |>
      bake(new_data = NULL)
  )
  expect_no_error(
    recipe(class ~ x + y, data = circle_example) |>
      step_smote(class, distance = "manhattan") |>
      prep() |>
      bake(new_data = NULL)
  )
  expect_no_error(
    recipe(class ~ x + y, data = circle_example) |>
      step_smote(class, distance = "chebyshev") |>
      prep() |>
      bake(new_data = NULL)
  )
})

test_that("sqrt-embedded distance metrics accepted by step_smote()", {
  set.seed(1)
  raw <- matrix(runif(60 * 3), ncol = 3)
  props <- raw / rowSums(raw)
  compositional <- data.frame(
    x = props[, 1],
    y = props[, 2],
    z = props[, 3],
    class = factor(rep(c("a", "b"), times = c(50, 10)))
  )

  bake_with <- function(distance) {
    recipe(class ~ ., data = compositional) |>
      step_smote(class, distance = distance) |>
      prep() |>
      bake(new_data = NULL)
  }

  expect_no_error(bake_with("squared_chord"))
  expect_no_error(bake_with("matusita"))
  expect_no_error(bake_with("hellinger"))
  expect_no_error(bake_with("bhattacharyya"))
})

test_that("philentropy distance metrics accepted by step_smote()", {
  skip_if_not_installed("philentropy")
  set.seed(1)
  raw <- matrix(runif(60 * 3), ncol = 3)
  props <- raw / rowSums(raw)
  compositional <- data.frame(
    x = props[, 1],
    y = props[, 2],
    z = props[, 3],
    class = factor(rep(c("a", "b"), times = c(50, 10)))
  )

  bake_with <- function(distance) {
    recipe(class ~ ., data = compositional) |>
      step_smote(class, distance = distance) |>
      prep() |>
      bake(new_data = NULL)
  }

  expect_no_error(bake_with("canberra"))
  expect_no_error(bake_with("jensen-shannon"))
  expect_no_error(bake_with("kumar-johnson"))
})

test_that("bad distance arg for step_smote()", {
  expect_snapshot(
    error = TRUE,
    recipe(class ~ x + y, data = circle_example) |>
      step_smote(class, distance = "L2") |>
      prep() |>
      bake(new_data = NULL)
  )
})

test_that("errors if there isn't enough data", {
  skip_if_not_installed("modeldata")

  data("credit_data", package = "modeldata")
  credit_data0 <- credit_data

  credit_data0$Status <- as.character(credit_data0$Status)
  credit_data0$Status[1] <- "dummy"
  credit_data0$Status <- as.factor(credit_data0$Status)

  expect_snapshot(
    error = TRUE,
    recipe(Status ~ Age, data = credit_data0) |>
      step_smote(Status) |>
      prep()
  )
})

test_that("basic usage", {
  rec1 <- recipe(class ~ x + y, data = circle_example) |>
    step_smote(class)

  rec1_p <- prep(rec1)

  te_xtab <- table(bake(rec1_p, new_data = circle_example)$class, useNA = "no")
  og_xtab <- table(circle_example$class, useNA = "no")

  expect_equal(sort(te_xtab), sort(og_xtab))

  expect_no_warning(prep(rec1))
})

test_that("works with a single predictor", {
  skip_if_not_installed("modeldata")

  data("hpc_data", package = "modeldata")

  expect_no_error(
    recipe(class ~ compounds, data = hpc_data) |>
      step_smote(all_outcomes()) |>
      prep() |>
      bake(NULL)
  )
})

test_that("bad data", {
  rec <- recipe(~., data = circle_example)
  # numeric check
  expect_snapshot(
    error = TRUE,
    rec |>
      step_smote(x) |>
      prep()
  )
  # Multiple variable check
  expect_snapshot(
    error = TRUE,
    rec |>
      step_smote(class, id) |>
      prep()
  )
})

test_that("errors if character are present", {
  df_char <- data.frame(
    x = factor(1:2),
    y = c("A", "A"),
    stringsAsFactors = FALSE
  )

  expect_snapshot(
    error = TRUE,
    recipe(~., data = df_char) |>
      step_smote(x) |>
      prep()
  )
})

test_that("NA in response", {
  skip_if_not_installed("modeldata")

  data("credit_data", package = "modeldata")

  expect_snapshot(
    error = TRUE,
    recipe(Job ~ Age, data = credit_data) |>
      step_smote(Job) |>
      prep()
  )
})

test_that("`seed` produces identical sampling", {
  step_with_seed <- function(seed = sample.int(10^5, 1)) {
    recipe(class ~ x + y, data = circle_example) |>
      step_smote(class, seed = seed) |>
      prep() |>
      bake(new_data = NULL) |>
      pull(x)
  }

  run_1 <- step_with_seed(seed = 1234)
  run_2 <- step_with_seed(seed = 1234)
  run_3 <- step_with_seed(seed = 12345)

  expect_equal(run_1, run_2)
  expect_false(identical(run_1, run_3))
})

test_that("test tidy()", {
  rec <- recipe(class ~ x + y, data = circle_example) |>
    step_smote(class, id = "")

  rec_p <- prep(rec)

  untrained <- tibble(
    terms = "class",
    id = ""
  )

  trained <- tibble(
    terms = "class",
    id = ""
  )

  expect_equal(untrained, tidy(rec, number = 1))
  expect_equal(trained, tidy(rec_p, number = 1))
})

test_that("ratio value works when oversampling", {
  res1 <- recipe(class ~ x + y, data = circle_example) |>
    step_smote(class) |>
    prep() |>
    bake(new_data = NULL)

  res1.5 <- recipe(class ~ x + y, data = circle_example) |>
    step_smote(class, over_ratio = 0.5) |>
    prep() |>
    bake(new_data = NULL)

  expect_equal(
    as.vector(table(res1$class)),
    rep(max(table(circle_example$class)), length(table(res1$class)))
  )
  expect_equal(
    sort(as.numeric(table(res1.5$class))),
    max(table(circle_example$class)) * c(0.5, 1)
  )
})

test_that("allows multi-class", {
  skip_if_not_installed("modeldata")

  data("credit_data", package = "modeldata")
  expect_no_error(
    recipe(Home ~ Age + Income + Assets, data = credit_data) |>
      step_impute_mean(Income, Assets) |>
      step_smote(Home)
  )
})

test_that("majority classes are ignored if there is more than 1", {
  skip_if_not_installed("modeldata")

  data("penguins", package = "modeldata")
  rec1_p2 <- recipe(
    species ~ bill_length_mm + bill_depth_mm,
    data = penguins[-(1:28), ]
  ) |>
    step_impute_mean(all_predictors()) |>
    step_smote(species) |>
    prep() |>
    bake(new_data = NULL)

  expect_true(all(max(table(rec1_p2$species)) == 124))
})

test_that("factor levels are not affected by alphabet ordering or class sizes", {
  circle_example_alt_levels <- list()
  for (i in 1:4) {
    circle_example_alt_levels[[i]] <- circle_example
  }

  # Checking for forgetting levels by majority/minor switching
  for (i in c(2, 4)) {
    levels(circle_example_alt_levels[[i]]$class) <-
      rev(levels(circle_example_alt_levels[[i]]$class))
  }

  # Checking for forgetting levels by alphabetical switching
  for (i in c(3, 4)) {
    circle_example_alt_levels[[i]]$class <-
      factor(
        x = circle_example_alt_levels[[i]]$class,
        levels = rev(levels(circle_example_alt_levels[[i]]$class))
      )
  }

  for (i in 1:4) {
    rec_p <- recipe(class ~ x + y, data = circle_example_alt_levels[[i]]) |>
      step_smote(class) |>
      prep()

    expect_equal(
      levels(circle_example_alt_levels[[i]]$class), # Original levels
      rec_p$levels$class$values # New levels
    )
    expect_equal(
      levels(circle_example_alt_levels[[i]]$class), # Original levels
      levels(bake(rec_p, new_data = NULL)$class) # New levels
    )
  }
})

test_that("ordering of newly generated points are right", {
  res <- recipe(class ~ x + y, data = circle_example) |>
    step_smote(class) |>
    prep() |>
    bake(new_data = NULL)

  expect_equal(
    res[seq_len(nrow(circle_example)), ],
    as_tibble(circle_example[, c("x", "y", "class")])
  )
})

test_that("non-predictor variables are ignored", {
  res <- recipe(class ~ ., data = circle_example) |>
    update_role(id, new_role = "id") |>
    step_smote(class) |>
    prep() |>
    bake(new_data = NULL)

  expect_equal(
    c(circle_example$id, rep(NA, nrow(res) - nrow(circle_example))),
    as.character(res$id)
  )
})

test_that("id variables don't turn predictors to factors", {
  # https://github.com/tidymodels/themis/issues/56
  rec_id <- recipe(class ~ ., data = circle_example) |>
    update_role(id, new_role = "id") |>
    step_smote(class) |>
    prep() |>
    bake(new_data = NULL)

  expect_equal(is.double(rec_id$x), TRUE)
  expect_equal(is.double(rec_id$y), TRUE)
})

test_that("tunable", {
  rec <- recipe(~., data = mtcars) |>
    step_smote(all_predictors())
  rec_param <- tunable.step_smote(rec$steps[[1]])
  expect_equal(rec_param$name, c("over_ratio", "neighbors"))
  expect_true(all(rec_param$source == "recipe"))
  expect_true(is.list(rec_param$call_info))
  expect_equal(nrow(rec_param), 2)
  expect_equal(
    names(rec_param),
    c("name", "call_info", "source", "component", "component_id")
  )
})

test_that("indicator_column adds logical column marking synthetic rows", {
  rec <- recipe(class ~ x + y, data = circle_example) |>
    step_smote(class, indicator_column = ".new_row") |>
    prep()

  res <- bake(rec, new_data = NULL)

  expect_true(".new_row" %in% names(res))
  expect_type(res$.new_row, "logical")
  expect_equal(sum(!res$.new_row), nrow(circle_example))
  expect_gt(sum(res$.new_row), 0L)
})

test_that("indicator_column bad args", {
  expect_snapshot(
    error = TRUE,
    recipe(class ~ x + y, data = circle_example) |>
      step_smote(class, indicator_column = 1)
  )
  expect_snapshot(
    error = TRUE,
    recipe(class ~ x + y, data = circle_example) |>
      step_smote(class, indicator_column = "") |>
      prep()
  )
  expect_snapshot(
    error = TRUE,
    recipe(class ~ x + y, data = circle_example) |>
      step_smote(class, indicator_column = "x") |>
      prep()
  )
})

test_that("bad args", {
  expect_snapshot(
    error = TRUE,
    recipe(~., data = mtcars) |>
      step_smote(over_ratio = "yes") |>
      prep()
  )
  expect_snapshot(
    error = TRUE,
    recipe(~., data = mtcars) |>
      step_smote(neighbors = TRUE) |>
      prep()
  )
  expect_snapshot(
    error = TRUE,
    recipe(~., data = mtcars) |>
      step_smote(seed = TRUE)
  )
})

test_that("tunable is setup to works with extract_parameter_set_dials", {
  skip_if_not_installed("dials")
  rec <- recipe(~., data = mtcars) |>
    step_smote(
      all_predictors(),
      over_ratio = hardhat::tune(),
      neighbors = hardhat::tune()
    )

  params <- extract_parameter_set_dials(rec)

  expect_s3_class(params, "parameters")
  expect_identical(nrow(params), 2L)
})

test_that("unused outcome levels are skipped with a warning (#238)", {
  circle_example$class <- factor(
    circle_example$class,
    levels = c(levels(circle_example$class), "unused")
  )

  expect_snapshot(
    res <- recipe(class ~ x + y, data = circle_example) |>
      step_smote(class) |>
      prep() |>
      bake(new_data = NULL)
  )

  expect_gt(nrow(res), 0)
})

test_that("smote() works with a character `var` (#261)", {
  df <- circle_example[c("x", "y", "class")]
  df$class <- as.character(df$class)

  res <- smote(df, "class")

  expect_s3_class(res$class, "factor")
  expect_identical(levels(res$class), c("Circle", "Rest"))
  expect_identical(sum(is.na(res$class)), 0L)
})

test_that("step_smote() errors with case weights (#243)", {
  df <- circle_example[c("x", "y", "class")]
  df$wts <- hardhat::frequency_weights(rep(1L, nrow(df)))

  expect_snapshot(
    error = TRUE,
    recipe(class ~ ., data = df) |>
      step_smote(class, skip = FALSE) |>
      prep() |>
      bake(new_data = NULL)
  )
})

test_that("step_smote() accepts a named `over_ratio` vector (#323)", {
  set.seed(1)
  df <- data.frame(
    x = rnorm(70),
    y = rnorm(70),
    class = factor(c(rep("a", 10), rep("b", 20), rep("c", 40)))
  )

  res <- recipe(class ~ x + y, data = df) |>
    step_smote(class, over_ratio = c(a = 1, b = 0.75)) |>
    prep() |>
    bake(new_data = NULL)

  expect_equal(as.numeric(table(res$class)), c(40, 30, 40))
})

test_that("smote() with a constant vector matches the scalar (#323)", {
  set.seed(1)
  df <- data.frame(
    x = rnorm(70),
    y = rnorm(70),
    class = factor(c(rep("a", 10), rep("b", 20), rep("c", 40)))
  )

  set.seed(2)
  res_vec <- smote(df, "class", over_ratio = c(a = 0.5, b = 0.5, c = 0.5))
  set.seed(2)
  res_scalar <- smote(df, "class", over_ratio = 0.5)

  expect_equal(res_vec, res_scalar)
})

test_that("smote() errors on a bad `over_ratio` vector (#323)", {
  set.seed(1)
  df <- data.frame(
    x = rnorm(30),
    y = rnorm(30),
    class = factor(c(rep("a", 10), rep("b", 20)))
  )

  expect_snapshot(error = TRUE, smote(df, "class", over_ratio = c(potato = 1)))
  expect_snapshot(error = TRUE, smote(df, "class", over_ratio = c(a = -1)))
})

test_that("step_smote() checks `over_ratio` names in prep() (#323)", {
  set.seed(1)
  df <- data.frame(
    x = rnorm(30),
    y = rnorm(30),
    class = factor(c(rep("a", 10), rep("b", 20)))
  )

  expect_snapshot(
    error = TRUE,
    recipe(class ~ x + y, data = df) |>
      step_smote(class, over_ratio = c(potato = 1)) |>
      prep()
  )
})

test_that("step_smote() samples each class to its own target (#323)", {
  set.seed(1)
  df <- data.frame(
    x = rnorm(70),
    y = rnorm(70),
    class = factor(c(rep("a", 10), rep("b", 20), rep("c", 40)))
  )

  res <- recipe(class ~ ., data = df) |>
    step_smote(class, over_ratio = c(a = 1, b = 0.75)) |>
    prep() |>
    bake(new_data = NULL)

  expect_equal(as.numeric(table(res$class)), c(40, 30, 40))
})

test_that("step_smote() leaves a class alone when its target is on the wrong side (#323)", {
  set.seed(1)
  df <- data.frame(
    x = rnorm(70),
    y = rnorm(70),
    class = factor(c(rep("a", 10), rep("b", 20), rep("c", 40)))
  )

  res <- recipe(class ~ ., data = df) |>
    step_smote(class, over_ratio = c(c = 0.5)) |>
    prep() |>
    bake(new_data = NULL)

  expect_equal(as.numeric(table(res$class)), c(10, 20, 40))
})

test_that("step_smote() checks `over_ratio` names when prepped (#323)", {
  set.seed(1)
  df <- data.frame(
    x = rnorm(70),
    y = rnorm(70),
    class = factor(c(rep("a", 10), rep("b", 20), rep("c", 40)))
  )

  expect_snapshot(
    error = TRUE,
    recipe(class ~ ., data = df) |>
      step_smote(class, over_ratio = c(a = 1, potato = 1)) |>
      prep()
  )
})


test_that("smote() targets a single class with a named vector (#323)", {
  set.seed(1)
  df <- data.frame(
    x = rnorm(70),
    y = rnorm(70),
    class = factor(c(rep("a", 10), rep("b", 20), rep("c", 40)))
  )

  res <- smote(df, "class", over_ratio = c(a = 1, b = 0.75))

  expect_equal(as.numeric(table(res$class)), c(40, 30, 40))
})

test_that("backwards compatible for arguments added after 1.0.3", {
  rec <- recipe(class ~ x + y, data = circle_example) |>
    step_smote(class)

  exp <- bake(prep(rec), new_data = NULL)

  # simulates a recipe created by an older version of themis
  old <- rec
  old$steps[[1]]$distance <- NULL
  old$steps[[1]]$indicator_column <- NULL

  expect_identical(bake(prep(old), new_data = NULL), exp)

  # simulates a recipe trained by an older version of themis
  old_trained <- prep(rec)
  old_trained$steps[[1]]$distance <- NULL
  old_trained$steps[[1]]$indicator_column <- NULL

  expect_identical(bake(old_trained, new_data = NULL), exp)
})

# Infrastructure ---------------------------------------------------------------

test_that("bake method errors when needed non-standard role columns are missing", {
  rec <- recipe(class ~ x + y, data = circle_example) |>
    step_smote(class, skip = FALSE) |>
    add_role(class, new_role = "potato") |>
    update_role_requirements(role = "potato", bake = FALSE)

  trained <- prep(rec, training = circle_example, verbose = FALSE)

  expect_snapshot(
    error = TRUE,
    bake(trained, new_data = circle_example[, -3])
  )
})

test_that("empty printing", {
  rec <- recipe(mpg ~ ., mtcars)
  rec <- step_smote(rec)

  expect_snapshot(rec)

  rec <- prep(rec, mtcars)

  expect_snapshot(rec)
})

test_that("empty selection prep/bake is a no-op", {
  rec1 <- recipe(mpg ~ ., mtcars)
  rec2 <- step_smote(rec1)

  rec1 <- prep(rec1, mtcars)
  rec2 <- prep(rec2, mtcars)

  baked1 <- bake(rec1, mtcars)
  baked2 <- bake(rec2, mtcars)

  expect_identical(baked1, baked2)
})

test_that("empty selection tidy method works", {
  rec <- recipe(mpg ~ ., mtcars)
  rec <- step_smote(rec)

  expect <- tibble(terms = character(), id = character())

  expect_identical(tidy(rec, number = 1), expect)

  rec <- prep(rec, mtcars)

  expect_identical(tidy(rec, number = 1), expect)
})

test_that("printing", {
  rec <- recipe(class ~ x + y, data = circle_example) |>
    step_smote(class)

  expect_snapshot(print(rec))
  expect_snapshot(prep(rec))
})

test_that("0 and 1 rows data work in bake method", {
  rec <- recipe(class ~ x + y, data = circle_example) |>
    step_smote(class, skip = FALSE) |>
    prep()

  expect_identical(nrow(bake(rec, new_data = slice(circle_example, 0))), 0L)
  expect_identical(nrow(bake(rec, new_data = slice(circle_example, 1))), 1L)
})
