library(rhdf5)

############################################################
context("h5write")
############################################################

A <- 1:7
## output file name
h5File <- withr::local_tempfile(pattern = "ex_save", fileext = ".h5")

test_that("Error if file doesn't exist", {
  expect_error(h5write(
    obj = A,
    file = h5File,
    name = "A",
    createnewfile = FALSE
  ))
})

test_that("Writing works", {
  ## writing to a file name
  expect_silent(h5write(obj = A, file = h5File, name = "A"))
  expect_identical(as.integer(h5read(file = h5File, name = "A")), A)

  fid <- H5Fopen(name = h5File)
  ## writing to a group
  gid <- H5Gcreate(h5loc = fid, name = "test_group")
  expect_silent(h5write(matrix(1:20, ncol = 10), file = gid, name = "foo"))
  H5Gclose(gid)

  H5Fclose(fid)
})


test_that("Attributes are written too", {
  B <- runif(n = 10)
  attr(B, "scale") <- "centimeters"
  h5write(obj = B, file = h5File, name = "B", write.attributes = TRUE)
  ## note that attributes aren't retrieved here
  expect_equivalent(as.numeric(h5read(file = h5File, name = "B")), B)
  # expect_equal( h5read(file = h5File, name = "B", read.attributes = TRUE), B )
  expect_true("scale" %in% names(h5readAttributes(file = h5File, name = "B")))
})

test_that("Write by index and hyperslab works.", {
  h5createDataset(file = h5File, dataset = "D", dims = c(10, 9))

  ## Test index works
  h5write(1:4, file = h5File, name = "D", index = list(2:3, c(3, 6)))
  res <- h5read(file = h5File, name = "D", index = list(2:3, c(3, 6)))
  expect_equal(res, matrix(1:4, nrow = 2, ncol = 2))

  ## Test hyperslabs without stride and block arguments work
  h5write(
    matrix(1:12, nrow = 4, ncol = 3),
    file = h5File,
    name = "D",
    start = c(2, 2),
    stride = NULL,
    count = c(4, 3),
    block = NULL
  )
  expect_equal(
    h5read(h5File, "D")[2:5, 2:4],
    matrix(1:12, nrow = 4, ncol = 3)
  )
  res <- h5read(
    file = h5File,
    name = "D",
    start = c(2, 2),
    stride = NULL,
    count = c(4, 3),
    block = NULL
  )
  expect_equal(res, matrix(1:12, nrow = 4, ncol = 3))

  ## Test hyperslabs with all arguments work
  h5write(
    matrix(1:48, nrow = 6, ncol = 8),
    file = h5File,
    name = "D",
    start = c(1, 1),
    stride = c(4, 5),
    count = c(2, 2),
    block = c(3, 4)
  )
  expect_equal(
    h5read(h5File, "D")[c(1:3, 5:7), c(1:4, 6:9)],
    matrix(1:48, nrow = 6, ncol = 8)
  )
  res <- h5read(
    file = h5File,
    name = "D",
    start = c(1, 1),
    stride = c(4, 5),
    count = c(2, 2),
    block = c(3, 4)
  )
  expect_equal(res, matrix(1:48, nrow = 6, ncol = 8))
})

############################################################
context("h5writeDataset")
############################################################

## output file name
h5File <- withr::local_tempfile(pattern = "ex_writeDataset_", fileext = ".h5")

test_that("Writing to file handle", {
  fid <- H5Fcreate(name = h5File)
  expect_silent(h5writeDataset(
    obj = matrix(1:10, ncol = 2),
    h5loc = fid,
    name = "matrix"
  ))
  expect_silent(h5writeDataset(obj = integer(1), h5loc = fid, name = "integer"))
  expect_silent(h5writeDataset(obj = numeric(1), h5loc = fid, name = "numeric"))
  expect_silent(h5writeDataset(obj = "foobaa", h5loc = fid, name = "character"))
  expect_silent(h5writeDataset(obj = logical(1), h5loc = fid, name = "logical"))
  expect_silent(h5writeDataset(
    obj = list(a = 1:4, b = letters[10:15]),
    h5loc = fid,
    name = "list"
  ))
  expect_silent(h5writeDataset(
    obj = data.frame("col_A" = 1:10, "col_B" = letters[1:10]),
    h5loc = fid,
    name = "data.frame"
  ))
  expect_silent(h5writeDataset(
    obj = data.frame("col_A" = 1:10, "col_B" = letters[1:10]),
    h5loc = fid,
    name = "data.frame2",
    DataFrameAsCompound = FALSE
  ))
  expect_silent(h5writeDataset(
    obj = complex(length.out = 10, real = 1:10, imaginary = 10:1),
    h5loc = fid,
    name = "complex"
  ))
  H5Fclose(fid)
})


############################################################
context("h5write with data.frames")
############################################################

h5f1 <- withr::local_tempfile(fileext = ".h5")
h5f2 <- withr::local_tempfile(fileext = ".h5")

h5createFile(h5f1)
h5createFile(h5f2)

## we use file size as a proxy for chunk size
## larger chunks should compress better in this example
test_that("Changing chunk size works", {
  expect_silent(h5write(
    data.frame("A" = rep(1:100), "B" = 201:300),
    h5f1,
    "dset",
    level = 7,
    chunk = 1L
  ))
  expect_silent(h5write(
    data.frame("A" = rep(1:100), "B" = 201:300),
    h5f2,
    "dset",
    level = 7,
    chunk = 100L
  ))
  expect_true(file.size(h5f2) < file.size(h5f1))
})

## only run this test on 64bit OS with space to allocate more than 4GB RAM
test_that("Very large data.frames are limited to chunk size < 4GB", {
  skip_if_not(.Platform$r_arch != "i386")

  counts_1 <- tryCatch(rep(0, 500000000), error = function(e) NULL)
  skip_if(is.null(counts_1), "Not enough memory to run this test")

  d1 <- data.frame(counts_1, counts_1, counts_1, counts_1)

  fid <- H5Fcreate(name = h5File)
  expect_silent(
    did <- .Call(
      "_h5createDataFrame",
      d1,
      fid@ID,
      "test",
      7L,
      nrow(d1),
      PACKAGE = "rhdf5"
    )
  )
  expect_gt(as.numeric(did), 0)
  expect_identical(.Call("_H5Dclose", did, PACKAGE = "rhdf5"), 0L)
  H5Fclose(fid)
})


test_that("We can write a data.frame with multiple factor columns", {
  if (file.exists(h5f1)) {
    file.remove(h5f1)
  }

  Z <- data.frame(
    X = sample(LETTERS, 20000, replace = TRUE),
    Y = sample(LETTERS, 20000, replace = TRUE),
    stringsAsFactors = FALSE
  )

  expect_silent(h5write(
    Z,
    file = h5f1,
    name = "data",
    DataFrameAsCompound = FALSE
  ))
  expect_equivalent(h5read(file = h5f1, name = "data/X"), as.character(Z$X))
  expect_equivalent(h5read(file = h5f1, name = "data/Y"), as.character(Z$Y))
})

test_that("We can write a data.frame with many data types", {
  if (file.exists(h5f1)) {
    file.remove(h5f1)
  }

  Z <- data.frame(
    "col_A" = 1:10,
    "col_B" = letters[1:10],
    "col_C" = as.raw(1:10),
    "col_D" = as.integer(1:10)
  )

  expect_silent(h5write(
    Z,
    file = h5f1,
    name = "data",
    DataFrameAsCompound = TRUE
  ))
  Z2 <- h5read(file = h5f1, name = "data")
  expect_identical(dim(Z), dim(Z2))
  ##  this test is a bit weird, testthat doesn't consider RAW and as.array(RAW) equivalent
  for (i in seq_along(Z)) {
    expect_equivalent(as.array(Z[[i]]), Z2[[i]])
  }
})


############################################################
context("Writing a datset subset")
############################################################

## output file name
h5File <- withr::local_tempfile(pattern = "ex_writeDataset_", fileext = ".h5")

test_that("Overwriting a subset", {
  fid <- H5Fcreate(name = h5File)
  expect_silent(h5writeDataset(
    obj = matrix(1:40, ncol = 4),
    h5loc = fid,
    name = "matrix"
  ))
  expect_silent(h5writeDataset(
    obj = rep(0, 20),
    h5loc = fid,
    name = "matrix",
    index = list(NULL, 2:3)
  ))
  H5Fclose(fid)

  expect_is(mat <- h5read(h5File, name = "matrix"), "matrix")
  expect_true(all(mat[, 2] == 0))
})
