tests/testthat/test_plots.R

In windfarmGA: Genetic Algorithm for Wind Farm Layout Optimization

test_that("Test Plotting Functions", {
  library(terra)
  library(stars)

  skip_on_os("mac", arch = "aarch64")

  ## Function to suppress print/cat outputs
  quiet <- function(x) {
    sink(tempfile())
    on.exit(sink())
    invisible(force(x))
  }

  wind_test <- data.frame(
    x = runif(10, 10, 20),
    y = runif(10, 0, 360)
  )

  ## Windrose Plotting #############
  ## Mock Packages not installed
  with_mocked_bindings(
    is_ggplot2_installed = function() FALSE,
    expect_error(
      plot_windrose(wind_test, plotit = FALSE)
    )
  )
  a0 <- plot_windrose(wind_test, plotit = FALSE)
  expect_true(is.recursive(a0))

  wind_test <- data.frame(
    ws = runif(10, 10, 20),
    wd = runif(10, 0, 360)
  )
  a0 <- plot_windrose(wind_test, plotit = FALSE)
  a0 <- plot_windrose(wind_test, plotit = FALSE)
  a1 <- plot_windrose(wind_test, "ws", "wd", plotit = FALSE)
  a2 <- plot_windrose(wind_test, 1, 2, plotit = FALSE)
  a3 <- plot_windrose(spd = wind_test$ws, dir = wind_test$wd, plotit = FALSE)
  expect_true(all(c(all.equal(a0$data, a1$data), all.equal(a0$data, a2$data))))
  expect_true(all.equal(a0$data, a3$data, check.attributes = FALSE))

  wind_test <- data.frame(
    speed = c(12, 30, 45),
    direction = c(0, 90, 150)
  )
  b0 <- plot_windrose(wind_test, plotit = FALSE)
  b1 <- plot_windrose(wind_test, "speed", dir = "direction", plotit = FALSE)
  b2 <- plot_windrose(wind_test, 1, 2, plotit = FALSE)
  b3 <- plot_windrose(
    spd = wind_test$speed, dir = wind_test$direction,
    plotit = FALSE
  )
  expect_true(all(c(all.equal(b0$data, b1$data), all.equal(b0$data, b2$data))))
  expect_true(all.equal(b0$data, b3$data,
    check.attributes = FALSE
  ))

  wind_test <- data.frame(
    direction = c(0, 90, 150),
    speed = c(12, 30, 45),
    id = 1:3,
    probab = 30:32
  )
  b0 <- plot_windrose(wind_test, plotit = FALSE)
  b1 <- plot_windrose(wind_test, "speed", dir = "direction", plotit = FALSE)
  b2 <- plot_windrose(wind_test, 1, 2,
    spdres = 5, spdseq = seq(1, 40, 5),
    plotit = FALSE
  )
  b3 <- plot_windrose(
    spd = wind_test$speed, dir = wind_test$direction,
    plotit = FALSE
  )
  expect_true(all(c(all.equal(b0$data, b1$data), all.equal(b0$data, b2$data))))
  expect_true(all.equal(b0$data$direction, b3$data$dir,
    check.attributes = FALSE
  ))
  expect_true(all.equal(b0$data$speed, b3$data$spd,
    check.attributes = FALSE
  ))

  wind_test <- data.frame(
    richt = c(0, 90, 150),
    gesch = c(12, 30, 45),
    id = 1:3,
    probab = 30:32
  )
  c0 <- plot_windrose(wind_test, plotit = FALSE)
  c1 <- plot_windrose(wind_test, "gesch", "richt", plotit = FALSE)
  c2 <- plot_windrose(wind_test, 1, 2, plotit = FALSE)
  c3 <- plot_windrose(
    spd = wind_test$gesch, dir = wind_test$richt,
    palette = "Set3", plotit = FALSE
  )
  expect_true(all(c(all.equal(c0$data, c1$data), all.equal(c0$data, c2$data))))
  expect_true(all.equal(c0$data$richt, b3$data$dir, check.attributes = FALSE))
  expect_true(all.equal(c0$data$gesch, b3$data$spd, check.attributes = FALSE))


  wind_test <- data.frame(
    gesch = c(12, 30, 45),
    richt = c(0, 90, 150),
    id = 1:3,
    probab = 30:32
  )
  colnames(wind_test) <- NULL
  c4 <- plot_windrose(wind_test, plotit = FALSE)
  expect_true(identical(c4$data[, "spd"], c0$data[, "gesch"]))

  wind_test <- data.frame(
    blabla = c(12, 30, 45),
    blablaa = c(0, 90, 150),
    id = 1:3,
    somegting = 30:32
  )
  colnames(wind_test) <- NULL
  c5 <- plot_windrose(wind_test, plotit = FALSE)
  expect_true(all.equal(c4$data, c5$data))

  winddat <- data.frame(
    ws = 12,
    wd = 0
  )
  windr_res <- plot_windrose(winddat, "ws", "wd")
  expect_true(class(windr_res)[1] == "gg")


  ## plot_parkfitness ###############
  respf <- plot_parkfitness(resultrect)
  expect_true(is.null(respf))

  ## plot_result ###############
  sp_polygonnp <- sf::st_as_sf(sf::st_sfc(
    sf::st_polygon(list(cbind(
      c(4498482, 4498482, 4499991, 4499991, 4498482),
      c(2668272, 2669343, 2669343, 2668272, 2668272)
    ))),
    crs = 3035
  ))
  plot_res <- quiet(plot_result(resultrect[1:10, ],
    Polygon1 = sp_polygonnp, best = 5000,
    plotEn = 1
  ))
  expect_false(anyNA(plot_res))
  expect_true(all(plot_res$EfficAllDir <= 100))
  plot_res <- quiet(plot_result(resultrect[1:10, ],
    Polygon1 = sp_polygonnp,
    best = 5000, plotEn = 2
  ))
  expect_false(anyNA(plot_res))
  expect_true(all(plot_res$EfficAllDir <= 100))

  polywgs84 <- sp_polygonnp
  polywgs84 <- st_transform(polywgs84, 4326)
  st_crs(polywgs84) <- NA
  plot_res <- quiet(plot_result(resultrect[1:10, ],
    Polygon1 = polywgs84
  ))
  expect_false(anyNA(plot_res))
  expect_true(all(plot_res$EfficAllDir <= 100))

  ## Create a result with 100% Efficiency (to plot all green)
  resultrect100 <- genetic_algorithm(
    Polygon1 = sp_polygon,
    n = 5, iteration = 60,
    vdirspe = winddat,
    Rotor = 30,
    RotorHeight = 100
  )
  plot_res <- quiet(plot_result(resultrect100,
    Polygon1 = sp_polygonnp,
    best = 5000, plotEn = 1
  ))
  expect_false(anyNA(plot_res))
  expect_true(all(plot_res$EfficAllDir <= 100))
  plot_res <- quiet(plot_result(resultrect100,
    Polygon1 = sp_polygonnp,
    best = 5000, plotEn = 2
  ))
  expect_false(anyNA(plot_res))
  expect_true(all(plot_res$EfficAllDir <= 100))

  plot_res <- quiet(plot_result(resultrect,
    Polygon1 = sp_polygon
  ))
  expect_false(anyNA(plot_res))

  plot_res <- quiet(plot_result(resultrect,
    best = 5,
    Polygon1 = sp_polygon
  ))
  expect_false(anyNA(plot_res))

  Grid <- grid_area(st_as_sf(sp_polygon), size = 150)
  plot_res <- quiet(plot_result(resultrect,
    best = 5,
    Polygon1 = sp_polygon,
    Grid = Grid[[2]]
  ))
  expect_false(anyNA(plot_res))

  plot_res <- quiet(plot_result(resultrect,
    Polygon1 = sp_polygon,
    plotEn = 2,
    Grid = Grid[[2]]
  ))
  expect_false(anyNA(plot_res))

  expect_error(quiet(plot_result(resultrect,
    Polygon1 = sp_polygon,
    plotEn = 3
  )))

  ## plot_windfarmGA ###############
  respwf <- plot_windfarmGA(resultrect, sp_polygon,
    whichPl = "all",
    best = 1, plotEn = 1
  )
  expect_true(is.null(respwf))
  respwf <- plot_windfarmGA(resultrect[1:3, ], sp_polygon,
    whichPl = "all",
    best = 1, plotEn = 1
  )
  expect_true(is.null(respwf))
  respwf <- plot_windfarmGA(resultrect[1:3, ], sp_polygon,
    whichPl = "all",
    best = 1, plotEn = 1
  )
  expect_true(is.null(respwf))

  Polygon1 <- sf::st_as_sf(sf::st_sfc(
    sf::st_polygon(list(cbind(
      c(4498482, 4498482, 4499991, 4499991, 4498482),
      c(2668272, 2669343, 2669343, 2668272, 2668272)
    ))),
    crs = 3035
  ))
  respwf <- plot_windfarmGA(resulthex, Polygon1,
    whichPl = "all",
    best = 2, plotEn = 1
  )
  expect_true(is.null(respwf))


  ## plot_cloud ###############
  cloud_res <- plot_cloud(resultrect, pl = FALSE)
  expect_false(anyNA(cloud_res))
  expect_true(ncol(cloud_res) == 15)

  cloud_res <- plot_cloud(resultrect, pl = TRUE)
  expect_false(anyNA(cloud_res))
  expect_true(ncol(cloud_res) == 15)

  ## plot_development ###############
  beor_res <- plot_development(resultrect)
  expect_true(is.null(beor_res))

  ## plot_fitness_evolution ###############
  fitnes_res <- plot_fitness_evolution(resultrect)
  expect_true(is.null(fitnes_res))

  ## plot_evolution ###############
  evo_res <- plot_evolution(resultrect, ask = FALSE)
  expect_true(is.null(evo_res))

  ## plot_leaflet #######################
  skip_if(compareVersion("4.3.0", paste0(R.version$major,".",R.version$minor)) == 1,
          "Skip as the version is <= 4.3.0. Errors in test_plots unresolved (leaflet::addMarkers(...))")
  ## Mock Packages not installed
  with_mocked_bindings(
    is_leaflet_installed = function() FALSE,
    expect_error(
      plot_leaflet(result = resultrect, Polygon1 = sp_polygon, which = 1)
    )
  )

  vdata <- data.frame(ws = 12, wd = 0)
  resultSP <- genetic_algorithm(
    Polygon1 = Polygon1,
    n = 5, iteration = 3,
    vdirspe = vdata, Rotor = 35,
    RotorHeight = 100
  )
  p <- plot_leaflet(resultSP, Polygon1 = Polygon1, which = 1)
  expect_s3_class(p, "leaflet")

  ## Plot the best wind farm on a leaflet map (ordered by energy values)
  p <- plot_leaflet(result = resultrect, Polygon1 = sp_polygon, which = 1)
  expect_s3_class(p, "leaflet")

  ## Plot the best wind farm on a leaflet map (ordered by energy values)
  p <- plot_leaflet(result = resulthex, Polygon1 = sp_polygon, which = 1)
  expect_s3_class(p, "leaflet")

  ## Plot the last wind farm (ordered by chronology).
  p <- plot_leaflet(
    result = resulthex, Polygon1 = sp_polygon, orderitems = FALSE,
    which = 1
  )
  expect_s3_class(p, "leaflet")

  ## Plot the best wind farm on a leaflet map with the rectangular Grid
  Grid <- grid_area(sp_polygon, size = 150, prop = 0.4)
  p <- plot_leaflet(
    result = resultrect, Polygon1 = sp_polygon, which = 1,
    GridPol = Grid[[2]]
  )
  expect_s3_class(p, "leaflet")

  ## Plot the last wind farm with hexagonal Grid
  Grid <- hexa_area(sp_polygon, size = 75)
  p <- plot_leaflet(
    result = resulthex, Polygon1 = sp_polygon, which = 1,
    GridPol = Grid[[2]]
  )
  expect_s3_class(p, "leaflet")

  p <- plot_leaflet(result = resultrect, Polygon1 = sp_polygon, which = 1)
  expect_s3_class(p, "leaflet")

  gr <- grid_area(st_as_sf(sp_polygon), size = 220)
  spnop <- gr[[2]]
  st_crs(spnop) <- NA
  p <- plot_leaflet(result = resultrect, Polygon1 = sp_polygon, GridPol = spnop)
  expect_s3_class(p, "leaflet")

  p <- plot_leaflet(result = resulthex, Polygon1 = sp_polygon, which = 1, orderitems = FALSE)
  expect_s3_class(p, "leaflet")

  p <- plot_leaflet(result = resulthex, Polygon1 = sp_polygon, which = 1000, orderitems = FALSE)
  expect_s3_class(p, "leaflet")


  ## No Projection
  poly_nocrs <- sf::st_as_sf(sf::st_sfc(
    sf::st_polygon(list(cbind(
      c(4498482, 4498482, 4499991, 4499991, 4498482),
      c(2668272, 2669343, 2669343, 2668272, 2668272)
    )))
  ))

  p <- plot_leaflet(result = resultrect, Polygon1 = poly_nocrs)
  expect_s3_class(p, "leaflet")

  expect_error(genetic_algorithm(
    Polygon1 = poly_nocrs,
    n = 12, iteration = 60,
    vdirspe = winddat,
    Rotor = 30,
    RotorHeight = 100
  ))
})