test_k_functions_sf.R
In spNetwork: Spatial Analysis on Network

context("testing functions for k and g function analysis")

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#### TEST FOR THE SIMPLE K AND G FUNCTION ####
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

test_that("Testing the simple k function", {

  # defining a simple situation
  wkt_lines <- c(
    "LINESTRING (0 5, 0 0)",
    "LINESTRING (-5 0, 0 0)",
    "LINESTRING (0 -5, 0 0)",
    "LINESTRING (5 0, 0 0)")

  linesdf <- data.frame(wkt = wkt_lines,
                        id = paste("l",1:length(wkt_lines),sep=""))

  all_lines <- st_as_sf(linesdf, wkt = "wkt")

  # definition of three events
  event <- data.frame(x=c(0,3,1,0),
                      y=c(3,0,0,1),
                      id = c(1,2,3,4))
  event <- st_as_sf(event, coords = c("x","y"))

  # calculating the observed values
  observed <- kfunctions(lines = all_lines,
                         points = event,
                         start = 0,
                         end = 6,
                         step = 0.5,
                         width = 2,
                         nsim = 5,
                         conf_int = 0.05,
                         digits = 2,
                         tol = 0.1,
                         resolution = NULL,
                         agg = NULL,
                         verbose = TRUE)

  # after checking on a paper with a pen, the observed k and g values at distance 3 must be :
  expected_vals <- c(0.9, 1.5)
  test <- round(observed$values[7,c("obs_k","obs_g")],1) == expected_vals
  expect_equal(sum(test), 2)

})



#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#### TEST FOR THE cross K AND G FUNCTION ####
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

test_that("Testing the cross k function", {

  # defining a simple situation
  wkt_lines <- c(
    "LINESTRING (0 5, 0 0)",
    "LINESTRING (-5 0, 0 0)",
    "LINESTRING (0 -5, 0 0)",
    "LINESTRING (5 0, 0 0)")

  linesdf <- data.frame(wkt = wkt_lines,
                        id = paste("l",1:length(wkt_lines),sep=""))

  all_lines <- st_as_sf(linesdf, wkt = "wkt")

  # definition of three events
  event <- data.frame(x=c(0,3,1,0),
                      y=c(3,0,0,1),
                      id = c(1,2,3,4))

  event <- st_as_sf(event, coords = c("x","y"))

  As <- event[c(1,2),]
  Bs <- event[c(3,4),]

  # calculating the observed values

  observed <- cross_kfunctions(lines = all_lines,
                               pointsA = As,
                               pointsB = Bs,
                               start = 0,
                               end = 6,
                               step = 0.5,
                               width = 2,
                               nsim = 5,
                               conf_int = 0.05,
                               digits = 2,
                               tol = 0.1,
                               resolution = NULL,
                               agg = NULL,
                               verbose = TRUE)

  # after checking on a paper with a pen, the observed k and g values at distance 3 must be :
  expected_vals <- c(0.2, 0.4)
  diff <- observed$values[7,c("obs_k","obs_g")] - expected_vals
  diff <- round(sum(abs(diff)),10)
  expect_equal(diff, 0)
})


#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#### TEST FOR THE FIRST RANDOMIZATION MATRIX FUNCTION ####
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

test_that("Testing the first randomization function", {

  # defining a simple situation
  wkt_lines <- c(
    "LINESTRING (0 5, 0 0)",
    "LINESTRING (-5 0, 0 0)",
    "LINESTRING (0 -5, 0 0)",
    "LINESTRING (5 0, 0 0)")

  linesdf <- data.frame(wkt = wkt_lines,
                        id = paste("l",1:length(wkt_lines),sep=""))

  all_lines <- st_as_sf(linesdf, wkt = "wkt")

  # definition of three events
  event <- data.frame(x=c(0,3,1,0),
                      y=c(3,0,0,1),
                      id = c(1,2,3,4))
  event <- st_as_sf(event, coords = c("x","y"))

  # creating the graph on wich we will do the randomization
  lines <- all_lines
  points <- event
  agg <- NULL
  digits <- 2
  tol <- 0.1

  ## step0 : clean the points
  n <- nrow(points)
  points$goid <- seq_len(nrow(points))
  points$weight <- rep(1,nrow(points))
  points <- clean_events(points,digits,agg)

  probs <- NULL

  ## step1 : clean the lines
  if(is.null(probs)){
    lines$probs <- 1
  }else{
    lines$probs <- probs
  }

  lines$length <- as.numeric(st_length(lines))
  lines <- subset(lines, lines$length>0)
  lines$oid <- seq_len(nrow(lines))


  ## step2 : adding the points to the lines
  snapped_events <- snapPointsToLines2(points,lines,idField = "oid")
  new_lines <- split_lines_at_vertex(lines, snapped_events,
                                     snapped_events$nearest_line_id, tol)

  ## step3 : splitting the lines
  new_lines$length <- as.numeric(st_length(new_lines))
  new_lines <- subset(new_lines,new_lines$length>0)
  new_lines <- remove_loop_lines(new_lines,digits)
  new_lines$oid <- seq_len(nrow(new_lines))
  new_lines <- new_lines[c("length","oid","probs")]
  Lt <- sum(as.numeric(st_length(new_lines)))

  ## step4 : building the graph for the real case
  graph_result <- build_graph(new_lines,digits = digits,
                              line_weight = "length",
                              attrs = TRUE)
  graph <- graph_result$graph
  nodes <- graph_result$spvertices
  graph_result$spedges$probs <- igraph::get.edge.attribute(graph_result$graph,
                                                           name = "probs")
  snapped_events$vertex_id <- closest_points(snapped_events, nodes)

  ## now time to test !
  set.seed(123)
  observed <- randomize_distmatrix(graph_result$graph,
                                   st_drop_geometry(graph_result$spedges),
                                   n = nrow(event))

  # NOTE : this result is obtained after checking for the function
  # by hand. It is hard to test it other wise because
  # we select the location of the points randomly
  expected <- rbind(
    c(0.0000000, 2.968420, 0.5314272, 1.1556292),
    c(2.9684197, 0.000000, 3.3807815, 4.1240489),
    c(0.5314272, 3.380782, 0.0000000, 0.7432674),
    c(1.1556292, 4.124049, 0.7432674, 0.0000000)
  )

  result <- sum(round(abs(observed-expected),6))
  expect_equal(result,0)

})




#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#### TEST FOR THE SECOND RANDOMIZATION MATRIX FUNCTION ####
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

test_that("Testing the second randomization function", {

  # defining a simple situation
  wkt_lines <- c(
    "LINESTRING (0 5, 0 0)",
    "LINESTRING (-5 0, 0 0)",
    "LINESTRING (0 -5, 0 0)",
    "LINESTRING (5 0, 0 0)")

  linesdf <- data.frame(wkt = wkt_lines,
                        id = paste("l",1:length(wkt_lines),sep=""))

  all_lines <- st_as_sf(linesdf, wkt = "wkt")

  # definition of three events
  event <- data.frame(x=c(0,3,1,0),
                      y=c(3,0,0,1),
                      id = c(1,2,3,4))
  event <- st_as_sf(event, coords = c("x","y"))

  # creating the graph on wich we will do the randomization
  lines <- all_lines
  points <- event
  agg <- NULL
  digits <- 2
  tol <- 0.1

  ## step0 : clean the points
  n <- nrow(points)
  points$goid <- seq_len(nrow(points))
  points$weight <- rep(1,nrow(points))
  points <- clean_events(points,digits,agg)

  probs <- NULL

  ## step1 : clean the lines
  if(is.null(probs)){
    lines$probs <- 1
  }else{
    lines$probs <- probs
  }

  lines$length <- as.numeric(st_length(lines))
  lines <- subset(lines, lines$length>0)
  lines$oid <- seq_len(nrow(lines))


  ## step2 : adding the points to the lines
  snapped_events <- snapPointsToLines2(points,lines,idField = "oid")
  new_lines <- split_lines_at_vertex(lines, snapped_events,
                                     snapped_events$nearest_line_id, tol)

  ## step3 : splitting the lines
  new_lines$length <- as.numeric(st_length(new_lines))
  new_lines <- subset(new_lines,new_lines$length>0)
  new_lines <- remove_loop_lines(new_lines,digits)
  new_lines$oid <- seq_len(nrow(new_lines))
  new_lines <- new_lines[c("length","oid","probs")]
  Lt <- sum( as.numeric(st_length(new_lines)))
  #new_lines$weight <- gLength(new_lines, byid = TRUE)

  ## step4 : building the graph for the real case
  graph_result <- build_graph(new_lines,digits = digits,
                              line_weight = "length",
                              attrs = TRUE)
  graph <- graph_result$graph
  nodes <- graph_result$spvertices
  graph_result$spedges$probs <- igraph::get.edge.attribute(graph_result$graph,
                                                           name = "probs")
  snapped_events$vertex_id <- closest_points(snapped_events, nodes)

  ## now time to test !
  observed <- randomize_distmatrix2(graph_result$graph,
                                   st_drop_geometry(graph_result$spedges),
                                   n = nrow(event),
                                   resolution = 0.5,
                                   nsim = 5)

  ## first of all, the matrix should have only 0s in the diag
  test1 <- sapply(observed, function(mat){
    sum(diag(mat)) == 0
  })

  ## second, all the matrices must be symetric
  test2 <- sapply(observed, function(mat){
    isSymmetric.matrix(mat)
  })

  ## third, the distance between two points must be at max : 10
  test3 <- sapply(observed, function(mat){
    max(mat) <= 10
  })

  total_test <- any(c(!test1,!test2,!test3))

  expect_false(total_test)

})


#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#### TEST FOR THE MULTICORE FUNCTIONS ####
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

test_that("Testing the multicore simple k function", {

  # defining a simple situation
  wkt_lines <- c(
    "LINESTRING (0 5, 0 0)",
    "LINESTRING (-5 0, 0 0)",
    "LINESTRING (0 -5, 0 0)",
    "LINESTRING (5 0, 0 0)")

  linesdf <- data.frame(wkt = wkt_lines,
                        id = paste("l",1:length(wkt_lines),sep=""))

  all_lines <- st_as_sf(linesdf, wkt = "wkt")

  # definition of three events
  event <- data.frame(x=c(0,3,1,0),
                      y=c(3,0,0,1),
                      id = c(1,2,3,4))
  event <- st_as_sf(event, coords = c("x","y"))

  # calculating the observed values
  future::plan(future::multisession(workers=1))
  observed <- kfunctions.mc(all_lines, event, 0, 6, 0.5, 2, 50, conf_int = 0.05, digits = 2, tol = 0.1, resolution = NULL, agg = NULL, verbose = TRUE)

  # after checking on a paper with a pen, the observed k and g values at distance 3 must be :
  expected_vals <- c(0.9, 1.5)
  test <- round(observed$values[7,c("obs_k","obs_g")],1) == expected_vals

  expect_equal(sum(test), 2)

})


test_that("Testing the multicore cross k function", {

  # defining a simple situation
  wkt_lines <- c(
    "LINESTRING (0 5, 0 0)",
    "LINESTRING (-5 0, 0 0)",
    "LINESTRING (0 -5, 0 0)",
    "LINESTRING (5 0, 0 0)")

  linesdf <- data.frame(wkt = wkt_lines,
                        id = paste("l",1:length(wkt_lines),sep=""))

  all_lines <- st_as_sf(linesdf, wkt = "wkt")

  # definition of three events
  event <- data.frame(x=c(0,3,1,0),
                      y=c(3,0,0,1),
                      id = c(1,2,3,4))
  event <- st_as_sf(event, coords = c("x","y"))

  As <- event[c(1,2),]
  Bs <- event[c(3,4),]

  # calculating the observed values
  future::plan(future::multisession(workers=1))
  observed <- cross_kfunctions.mc(all_lines, As, Bs, 0, 6, 0.5, 2, 5, conf_int = 0.05, digits = 2, tol = 0.1, resolution = NULL, agg = NULL, verbose = TRUE)

  # after checking on a paper with a pen, the observed k and g values at distance 3 must be :
  expected_vals <- c(0.2, 0.4)
  diff <- observed$values[7,c("obs_k","obs_g")] - expected_vals
  diff <- round(sum(abs(diff)),10)
  expect_equal(diff, 0)

})


#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#### TEST FOR THE SIMPLE space-time K AND G FUNCTION ####
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

test_that("Testing the simple k function in space-time", {

  # defining a simple situation
  wkt_lines <- c(
    "LINESTRING (0 5, 0 0)",
    "LINESTRING (-5 0, 0 0)",
    "LINESTRING (0 -5, 0 0)",
    "LINESTRING (5 0, 0 0)")

  linesdf <- data.frame(wkt = wkt_lines,
                        id = paste("l",1:length(wkt_lines),sep=""))

  all_lines <- st_as_sf(linesdf, wkt = "wkt")

  # definition of four events
  event <- data.frame(x=c(0,3,1,0),
                      y=c(3,0,0,1),
                      id = c(1,2,3,4),
                      time = c(1,1,3,2))

  event <- st_as_sf(event, coords = c("x","y"))

  # calculating the observed values
  future::plan(future::multisession(workers=1))
  observed <- k_nt_functions.mc(lines = all_lines,
                         points = event,
                         points_time = event$time,
                         start_net = 0,
                         end_net = 6,
                         step_net = 0.5,
                         width_net = 2,
                         start_time = 0,
                         end_time = 6,
                         step_time = 0.5,
                         width_time = 2,
                         nsim = 5,
                         conf_int = 0.05,
                         digits = 2,
                         tol = 0.1,
                         resolution = NULL,
                         agg = NULL,
                         verbose = TRUE)

  # after checking on a paper with a pen, the observed k and g values at  network
  # distance 3 and time distance 1 must be :
  Lt <- sum(st_length(all_lines))
  Tt <- max(event$time) - min(event$time)
  n <- nrow(event)
  t1 <- (n-1)/(Lt * Tt);
  exp_k <- 4 * t1
  exp_g <- 10 * t1
  expected_vals <- c(exp_k, exp_g)

  obtained <- c(observed$obs_k[6,3], observed$obs_g[6,3])

  test <- sum(round(obtained - expected_vals,7)) == 0
  expect_true(test)

})

#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#### TEST FOR THE SIMPLE space-time K AND G FUNCTION (multicore) ####
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

test_that("Testing the simple k function in space-time (multicore)", {

  # defining a simple situation
  wkt_lines <- c(
    "LINESTRING (0 5, 0 0)",
    "LINESTRING (-5 0, 0 0)",
    "LINESTRING (0 -5, 0 0)",
    "LINESTRING (5 0, 0 0)")

  linesdf <- data.frame(wkt = wkt_lines,
                        id = paste("l",1:length(wkt_lines),sep=""))

  all_lines <- st_as_sf(linesdf, wkt = "wkt")

  # definition of four events
  event <- data.frame(x=c(0,3,1,0),
                      y=c(3,0,0,1),
                      id = c(1,2,3,4),
                      time = c(1,1,3,2))

  event <- st_as_sf(event, coords = c("x","y"))

  # calculating the observed values
  observed <- k_nt_functions(lines = all_lines,
                             points = event,
                             points_time = event$time,
                             start_net = 0,
                             end_net = 6,
                             step_net = 0.5,
                             width_net = 2,
                             start_time = 0,
                             end_time = 6,
                             step_time = 0.5,
                             width_time = 2,
                             nsim = 5,
                             conf_int = 0.05,
                             digits = 2,
                             tol = 0.1,
                             resolution = NULL,
                             agg = NULL,
                             verbose = TRUE)

  # after checking on a paper with a pen, the observed k and g values at  network
  # distance 3 and time distance 1 must be :
  Lt <- sum(st_length(all_lines))
  Tt <- max(event$time) - min(event$time)
  n <- nrow(event)
  t1 <- (n-1)/(Lt * Tt);
  exp_k <- 4 * t1
  exp_g <- 10 * t1
  expected_vals <- c(exp_k, exp_g)

  obtained <- c(observed$obs_k[6,3], observed$obs_g[6,3])

  test <- sum(round(obtained - expected_vals,7)) == 0
  expect_true(test)

})