lolplyr: Adapting dplyr for lists-of-lists

mtc <- as_lol(mtcars)


test_that("lol can be back-transformed to tibble", {

  # not identical since inconsistency in dplyr bind_rows vs tibble
  # one of the objects has rownames (see compare::compare output)
  expect_equal(
    mtcars %>% as_lol() %>% bind_rows(),
    mtcars %>% dplyr::as_tibble()
  )

})

# test_that("lov can be back-transformed to tibble", {
#
#   # not identical since inconsistency in dplyr bind_rows vs tibble
#   # one of the objects has rownames (see compare::compare output)
#   expect_equal(
#     mtcars %>% as_lov() %>% bind_rows(),
#     mtcars %>% dplyr::as_tibble()
#   )
#
# })


test_that("filter works as in dplyr", {

  expect_identical(
    mtc %>% filter(cyl == 4, mpg > 30) %>% bind_rows(),
    mtcars %>% filter(cyl == 4, mpg > 30) %>% as_tibble()
  )

  expect_identical(
    mtc %>% filter_or(cyl == 4, mpg > 30) %>% bind_rows(),
    mtcars %>% filter(cyl == 4 | mpg > 30) %>% as_tibble()
  )

})


test_that("output of summarise makes sense", {

  expect_equal(
    mtc %>% summarise(avg_mpg = mean(mpg)) %>% .$avg_mpg,
    mean(mtcars$mpg)
  )

})


test_that("output of mutate_elem and transmute_elem makes sense", {

  expect_true(
    mtc %>%
      mutate_elem(cyl = as.character(cyl)) %>%
      purrr::transpose() %>%
      .$cyl %>%
      lapply(class) %>%
      `==`("character") %>%
      all()
  )

})


test_that("mutate and transmute work as in dplyr", {

  expect_equal(
    as_lol(mtcars) %>%
      mutate(
        avg_mpg = rep_list(mean(mpg), length(mpg)),
        cyl = cyl + 1000
      ) %>%
      bind_rows(),

    mtcars %>%
      mutate(
        avg_mpg = mean(mpg),
        cyl = cyl + 1000
      ) %>%
      as_tibble()
  )


  expect_equal(
    as_lol(mtcars) %>%
      transmute(
        avg_mpg = rep_list(mean(mpg), length(mpg)),
        cyl = cyl + 1000
      ) %>%
      bind_rows(),

    mtcars %>%
      transmute(
        avg_mpg = mean(mpg),
        cyl = cyl + 1000
      ) %>%
      as_tibble()
  )

})


test_that("chained evaluation of expressions works", {

  # chained evaluation works
  expect_silent(
    mtc %>%
      mutate(
        mpg2 = mpg + 100,
        mpg3 = mpg2 * 100
      )
  )

  expect_identical(
    mtc %>%
      transmute(
        mpg2 = mpg + 100,
        mpg3 = mpg2 * 100
      ) %>%
      purrr::transpose() %>%
      names(),

    c("mpg2", "mpg3")
  )

})


test_that("it is possible to transform lol -> lov and lov -> lol", {

  expect_identical(
    as_lol(as_lov(mtcars)),
    as_lol(mtcars)
  )

  expect_identical(
    as_lov(as_lol(mtcars)),
    as_lov(mtcars)
  )

})


test_that("hash_by works correctly", {

  expect_identical(hash_by(mtc), hash_by(mtc, colnames(mtcars)))

})


test_that("everything works with messy data", {

  messy_data <- list(
    list(V1 = 1,   V2 = 1:2,       V3 = "a"),
    list(V1 = 1,   V2 = 1,         V3 = 2,    V4 = 2),
    list(V1 = 1,   V2 = list(1:5), V3 = NA),
    list(V1 = 2,   V2 = NA,        V3 = 4),
    list(V1 = "e", V2 = 666,       V3 = NULL),
    list(V1 = 2,   V2 = 1,         V3 = 6)
  )

  expect_silent(messy_data %>% select(V2))

  expect_silent(messy_data %>% select(V3))

  # return empty rows for selecting nonexistent columns
  expect_warning(messy_data %>% select(V4))

  expect_warning(messy_data %>% select(V4, V2))

  expect_silent(messy_data %>% rename(X = V4))

  expect_warning(messy_data %>% group_by(V4))

  expect_silent(messy_data %>% filter(is_there(V4)))

  expect_warning(messy_data %>% mutate_elem(V2_new = V2 + 100))

  expect_warning(messy_data %>% mutate_elem(V3_new = V3 + 100))

  expect_warning(messy_data %>% transmute_elem(V3_new = V3 + 100))

  expect_warning(messy_data %>% transmute_elem(V4_new = V4 + 100))

  expect_warning(messy_data %>% hash_by(V4))

  expect_warning(messy_data %>% hash_by(V4, V2))

  # expect_warning(messy_data %>% transmute(V4_new = V4 + 100))
  #
  # expect_warning(messy_data %>% mutate(V4_new = V4 + 100))

  expect_warning(expect_identical(
    messy_data %>%
      group_by(V4) %>%
      ungroup(),
    messy_data
  ))

  expect_warning(expect_identical(
    messy_data %>%
      group_by(V4, V1) %>%
      ungroup(),
    messy_data
  ))

})


test_that("misc tests", {

  expect_true(all(unlist(lapply(mtc %>% select(mpg, cyl), length)) == 2L))

  expect_true(length(hash_by(mtc, mpg, cyl)) == nrow(mtcars))

  expect_true(is_grouped_list(group_by(mtc, mpg, gear)))

  expect_true((drop_nulls(list(a = 1, b = NULL, c = 3)) %>% length()) == 2L)

  expect_true(length(anti_join(mtc, mtc, "disp")) == 0L)

  # naming unnamed output
  expect_identical(
    mtc %>%
      transmute_elem(
        mean(mpg),
        sum(cyl)
      ) %>%
      purrr::transpose() %>%
      names(),

    c("mean(mpg)", "sum(cyl)")
  )

})


test_that("backend works properly", {

  x <- 8

  my_mutate <- function(.data, ...) {
    dots <- quos(...)
    lolplyr:::try_eval(dots, data = .data)
  }

  expect_silent(expect_identical(
    list(a = 1) %>%
      my_mutate(b = a + 1, c = b * 2, d = c + x, e = 2.7182) %>%
      names(),
    letters[2:5]
  ))

})


test_that("handling data.frames is implemented", {

  # using dplyr
  expect_silent(
    mtcars %>% lolplyr:::select(mpg, cyl)
  )

  # mtcars %>%
  #   lolplyr:::rename.list(mpg2 = mpg)
  #
  # mtcars %>%
  #   lolplyr:::group_by.list(gear, cyl)
  #
  # mtcars %>%
  #   lolplyr:::filter.list(mpg + 2)
  #
  # mtcars %>%
  #   lolplyr:::mutate.list(mpg + 2)
  #
  # mtcars %>%
  #   lolplyr:::summarise.list(mean(mpg))

})


test_that("is_lol and is_lov work correctly", {

  expect_true(is_lol(as_lol(mtcars)))

  expect_true(is_lov(as_lov(mtcars)))

  expect_false(is_lov(as_lol(mtcars)))

  expect_false(is_lol(as_lov(mtcars)))

  expect_true(is_lov(as.list(1:10)))

  expect_false(is_lol(1:10))

  expect_false(is_lov(1:10))

  expect_false(is_lol(mtcars))

  expect_false(is_lov(mtcars))

  expect_false(is_lol(NULL))

  expect_false(is_lov(NULL))

  expect_false(is_lol(NA))

  expect_false(is_lov(NA))

})


test_that("the is_ functions worrk correctly", {

  expect_silent(expect_false(is_there(aaa)))

  bbb <- 42

  expect_silent(expect_true(is_there(bbb)))


  expect_true(is_simple_vector(c()))

  expect_true(is_simple_vector(NA))

  expect_true(is_simple_vector(NULL))

  expect_true(is_simple_vector(vector()))

  expect_false(is_simple_vector(list()))

  expect_true(is_simple_vector(letters[1:10]))

  expect_true(is_simple_vector(factor(letters[1:10])))

  expect_true(is_simple_vector(as.ts(1:10)))

  expect_false(is_simple_vector(list(1:10)))

  expect_false(is_simple_vector(as.list(1:10)))

  expect_false(is_simple_vector(matrix(1:10, 2, 5)))

  expect_false(is_simple_vector(array(1:10, list(2, 5))))

  expect_false(is_simple_vector(data.frame(x = 1:10)))



  expect_false(is_simple_list(c()))

  expect_false(is_simple_list(NA))

  expect_false(is_simple_list(NULL))

  expect_false(is_simple_list(vector()))

  expect_true(is_simple_list(list()))

  expect_false(is_simple_list(1:10))

  expect_false(is_simple_list(letters[1:10]))

  expect_false(is_simple_list(factor(letters[1:10])))

  expect_false(is_simple_list(as.ts(1:10)))

  expect_true(is_simple_list(list(1:10)))

  expect_true(is_simple_list(as.list(1:10)))

  expect_false(is_simple_list(matrix(1:10, 2, 5)))

  expect_false(is_simple_list(array(1:10, list(2, 5))))

  expect_false(is_simple_list(data.frame(x = 1:10)))


})


test_that("group_by and ungroup do not change the data", {

  # mtc_grp <- mtc %>%
  #   group_by(cyl, mpg, gear) %>%
  #   ungroup()
  #
  # # unfortunatelly, it drops the names and changes order
  # expect_identical(
  #   mtc_grp[order(hash_by_(mtc_grp, colnames(mtcars)))],
  #   mtc[order(hash_by_(mtc, colnames(mtcars)))]
  # )

  expect_identical(
    mtc %>%
      group_by(cyl, mpg, gear) %>%
      ungroup(),
    mtc
  )

})


test_that("joins work as expected", {

  band_members <- dplyr::band_members
  band_instruments <- dplyr::band_instruments

  expect_identical(
    band_members %>%
      inner_join(band_instruments) %>%
      nrow(),

    as_lol(band_members) %>%
      inner_join(as_lol(band_instruments), by = "name") %>%
      length()
  )

  expect_identical(
    band_members %>%
      left_join(band_instruments) %>%
      nrow(),

    as_lol(band_members) %>%
      left_join(as_lol(band_instruments), by = "name") %>%
      length()
  )

  expect_identical(
    band_members %>%
      right_join(band_instruments) %>%
      nrow(),

    as_lol(band_members) %>%
      right_join(as_lol(band_instruments), by = "name") %>%
      length()
  )

  expect_identical(
    band_members %>%
      full_join(band_instruments) %>%
      nrow(),

    as_lol(band_members) %>%
      full_join(as_lol(band_instruments), by = "name") %>%
      length()
  )

  expect_identical(
    band_members %>%
      semi_join(band_instruments) %>%
      nrow(),

    as_lol(band_members) %>%
      semi_join(as_lol(band_instruments), by = "name") %>%
      length()
  )

  expect_identical(
    band_members %>%
      anti_join(band_instruments) %>%
      nrow(),

    as_lol(band_members) %>%
      anti_join(as_lol(band_instruments), by = "name") %>%
      length()
  )

})