R/plots.R

Defines functions plot_random_search dup_coords plot_heatmap plot_fitness_evolution plot_cloud plot_evolution plot_development plot_parkfitness plot_leaflet plot_windfarmGA plot_terrain plot_result plot_windrose

Documented in dup_coords plot_cloud plot_development plot_evolution plot_fitness_evolution plot_heatmap plot_leaflet plot_parkfitness plot_random_search plot_result plot_windfarmGA plot_windrose

#' @title Plot a Windrose
#' @name plot_windrose
#' @description  Plot a wind rose of the wind data frame.
#'
#' @export
#'
#' @param data A data.frame containing the wind information
#' @param spd The column of the wind speeds in "data"
#' @param dir The column of the wind directions in "data"
#' @param spdres The increment of the wind speed legend. Default is 2
#' @param dirres The size of the wind sectors. Default is 10
#' @param spdmin Minimum wind speed. Default is 1
#' @param spdmax Maximal wind speed. Default is 30
#' @param palette A color palette used for drawing the wind rose
#' @param spdseq A wind speed sequence, that is used for plotting
#' @param plotit Should the windrose be plotted? Default is TRUE
#'
#' @family Plotting Functions
#' @return NULL
#'
#' @examples
#' ## Exemplary Input Wind speed and direction data frame
#' # Uniform wind speed and single wind direction
#' data.in <- data.frame(ws = 12, wd = 0)
#' windrosePlot <- plot_windrose(data = data.in, spd = data.in$ws,
#'    dir = data.in$wd)
#'
#' # Random wind speeds and random wind directions
#' data.in <- data.frame(ws = sample(1:25, 10), 
#'                       wd = sample(1:260, 10))
#' windrosePlot <- plot_windrose(data = data.in, spd = data.in$ws,
#'    dir = data.in$wd)
#'
plot_windrose <- function(data, spd, dir, spdres = 2, dirres = 10, spdmin = 1,
                          spdmax = 30, palette = "YlGnBu",
                          spdseq = NULL, plotit = TRUE) {
  if (!requireNamespace("ggplot2", quietly = TRUE)) {
    stop("The package 'ggplot2' is required for this function, but it is not installed.\n",
         "Please install it with `install.packages('ggplot2')`")
  }
  
  if (!missing(data) && exists("data")) {
    # Assume that we've been given a data frame. Lets find the correct columns
    if (length(colnames(data))) {
      accep_speed <- c("SPEED", "GESCH", "V", "WS")
      accep_direc <- c("DIR", "RICHT", "WD")
      sum_col_match <- sum(sapply(c(accep_speed, accep_direc), grepl,
                                  toupper(colnames(data)) ))
      if (sum_col_match >= 2) {
        speed_match <- which(sapply(
          lapply(accep_speed, grepl, toupper(colnames(data))),
          any))
        direc_match <- which(sapply(
          lapply(accep_direc, grepl, toupper(colnames(data))),
          any))
        
        speed_index <- which(grepl(accep_speed[speed_match],
                                   toupper(colnames(data))))
        direc_index <- which(grepl(accep_direc[direc_match],
                                   toupper(colnames(data))))
        data[, c(speed_index[1], direc_index[1])]
        
        spd <- colnames(data)[speed_index]
        dir <- colnames(data)[direc_index]
      } else {
        col_numeric <- which(sapply(data[1, ], is.numeric))
        data <- data[, col_numeric]
        colnames(data) <- c("spd", "dir")
        spd <- "spd"
        dir <- "dir"
      }
    } else {
      col_numeric <- which(sapply(data[1, ], is.numeric))
      data <- data[, col_numeric]
      colnames(data) <- c("spd", "dir")
      spd <- "spd"
      dir <- "dir"
    }
  } 
  else if (!missing(spd) && !missing(dir) && is.numeric(spd) && is.numeric(dir)) {
    # assume that we've been given vectors of the speed and direction vectors
    data <- data.frame(spd = spd, dir = dir)
    spd <- "spd"
    dir <- "dir"
  }
  
  # Tidy up input data #################
  dnu <- (is.na(data[[spd]]) | is.na(data[[dir]]))
  data[[spd]][dnu] <- NA
  data[[dir]][dnu] <- NA
  
  # figure out the wind speed bins #################
  if (missing(spdseq) || is.null(spdseq)) {
    spdseq <- seq(spdmin, spdmax, spdres)
  }
  
  # get some information about the number of bins, etc. #################
  seq_length <- length(spdseq)
  colorpal_n <- seq_length - 1
  
  # create the color map #################
  wind_colorpal <- grDevices::colorRampPalette(RColorBrewer::brewer.pal(
    min(max(3, colorpal_n), min(9, colorpal_n)), palette))(colorpal_n)
  
  if (max(data[[spd]], na.rm = TRUE) > spdmax) {
    speed_brks <- c(spdseq, max(data[[spd]], na.rm = TRUE))
    speed_labls <- c(paste(c(spdseq[1:seq_length - 1]), '-', 
                           c(spdseq[2:seq_length])),
                     paste(spdmax, "-", max(data[[spd]], na.rm = TRUE)))
    wind_colorpal <- c(wind_colorpal, "grey50")
  } else{
    speed_brks <- spdseq
    speed_labls <- paste(c(spdseq[1:seq_length - 1]), '-', 
                         c(spdseq[2:seq_length]))
  }
  speed_bins <- cut(x = data[[spd]], breaks = speed_brks, 
                    labels = speed_labls, ordered_result = TRUE)
  
  # figure out the wind direction bins #################
  dir_brks <- c(-dirres / 2, seq(dirres / 2, 360 - dirres/2, 
                                 by = dirres), 360 + dirres / 2)
  dir_labls <- c(paste(360 - dirres / 2, "-", dirres / 2),
                 paste(seq(dirres / 2, 360 - 3 * dirres / 2, 
                           by = dirres), "-", 
                       seq(3 * dirres/2, 360 - dirres / 2, by = dirres)),
                 paste(360 - dirres / 2, "-", dirres / 2))
  # assign each wind direction to a bin
  dir_bins <- cut(data[[dir]], breaks = dir_brks,
                  ordered_result = TRUE)
  levels(dir_bins) <- dir_labls
  data$dir_bins <- dir_bins
  
  # create the plot #################
  plot_windrose <- ggplot2::ggplot(data = data,
                                   ggplot2::aes(x = dir_bins,
                                                fill = speed_bins)) +
    ggplot2::geom_bar() +
    ggplot2::scale_x_discrete(drop = FALSE, labels = ggplot2::waiver()) +
    ggplot2::coord_polar(start = -((dirres / 2) / 360) * 2 * pi) +
    ggplot2::scale_fill_manual(name = "Wind Speed (m/s)",
                               values = wind_colorpal,
                               drop = FALSE) +
    ggplot2::theme(axis.title.x = ggplot2::element_blank(),
                   axis.title.y = ggplot2::element_blank(),
                   axis.text.y = ggplot2::element_blank(),
                   axis.ticks.y = ggplot2::element_blank(),
                   legend.background = ggplot2::element_rect(fill = "gray96",
                                                             colour = "gray96"),
                   panel.background = ggplot2::element_rect(fill = "gray96",
                                                            colour = "gray96"),
                   panel.grid.minor.y = ggplot2::element_line(size = 2),
                   panel.grid.major = ggplot2::element_line(colour = "gray86"),
                   panel.border = ggplot2::element_blank(),
                   plot.background = ggplot2::element_rect(fill = "gray96",
                                                           colour = "gray96"),
                   strip.background = ggplot2::element_rect(fill = "gray96",
                                                            colour = "gray96"),
                   plot.margin = ggplot2::unit(c(0, 0, 0, 0), "lines"))
  
  
  if (plotit) {
    # print the plot #################
    print(plot_windrose)
  }
  
  # return the handle to the wind rose #################
  invisible(plot_windrose)
}


#' @title Plot the best results
#' @name plot_result
#' @description  Plot the best solutions of the genetic algorithm.
#'   Depending on \code{plotEn}, either the best energy or efficiency solutions
#'   can be plotted. \code{best} indicates the amount of best solutions to plot.
#'
#' @export
#'
#' @inheritParams genetic_algorithm
#' @param result The output of \code{\link{windfarmGA}} or
#'   \code{\link{genetic_algorithm}}
#' @param best A numeric value indicating how many of the best individuals
#'   should be plotted
#' @param plotEn A numeric value that indicates if the best energy or efficiency
#'   output should be plotted. \code{1} plots the best energy solutions
#'   and \code{2} plots the best efficiency solutions
#' @param topographie A logical value, indicating whether terrain effects should
#'   be considered and plotted or not
#' @param Grid If \code{TRUE} (default) the used grid will be added to the plot.
#'   You can also pass another Simple Feature object
#'
#' @family Plotting Functions
#' @return Returns a data.frame of the best (energy/efficiency) individual
#'   during all iterations
#'
#' @examples \donttest{
#' ## Add some data examples from the package
#' library(sf)
#' 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
#' ))
#'
#' ## Plot the results of a hexagonal grid optimization
#' plot_result(resulthex, Polygon1, best = 1, plotEn = 1, topographie = FALSE)
#'
#' ## Plot the results of a rectangular grid optimization
#' plot_result(resultrect, Polygon1, best = 1, plotEn = 1, topographie = FALSE)
#'}
plot_result <- function(result, Polygon1, best = 3, plotEn = 1,
                        topographie = FALSE, Grid = TRUE,
                        sourceCCLRoughness = NULL, sourceCCL = NULL,
                        weibullsrc) {
  ## Check plotEn, set par() and color palette ############## 
  if (!plotEn %in% c(1,2)) {
    stop("plotEn must be either 1 or 2. \n",
         "1 - plots the best energy output. \n",
         "2 - plots the best efficiency output.")
  }
  parpplotRes <- par(no.readonly = TRUE)
  par(mfrow = c(1, 1), mar = c(5, 6, 4, 2) + 0.1, mgp = c(5, 1, 0))
  rbPal1 <- grDevices::colorRampPalette(c('green','red'))
  result_inputs <- result[1,'inputData'][[1]]
  
  ## Check Projections and reference systems ####
  Polygon1 <- isSpatial(Polygon1)
  PROJ6 <- utils::compareVersion(sf::sf_extSoftVersion()[[3]], "6") > 0
  Projection <- result_inputs['Projection',][[1]]
  if (PROJ6) {
    Projection <- tryCatch(as.integer(Projection), 
                           warning = function(e) Projection,
                           error = function(e) Projection)
  }
  if (is.na(st_crs(Polygon1))) {
    message("Polygon is not projected. The spatial reference WGS 84 (EPSG:4326) is assumed.")
    if (PROJ6) {
      st_crs(Polygon1) <- 4326
    } else {
      st_crs(Polygon1) <- "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs "
    }
  }
  Polygon1 <- sf::st_transform(Polygon1, st_crs(Projection))
  
  ## Check Weibull Rasters #########
  if (missing(weibullsrc)) {
    weibullsrc <- NULL
    col2res <- "lightblue"
  }
  else {
    PolyCrop <- sf::st_transform(Polygon1, sf::st_crs(weibullsrc[[1]]))
    if (class(weibullsrc) == "list" & length(weibullsrc) == 2) {
      wblcroped <- lapply(weibullsrc, function(x){
        raster::crop(x, raster::extent(PolyCrop))})
      wblcroped <- lapply(wblcroped, function(x){
        raster::mask(x, PolyCrop)})
      Erwartungswert <- wblcroped[[2]] * (gamma(1 + (1 / wblcroped[[1]])))
    } else if (class(weibullsrc) == "list" & length(weibullsrc) == 1) {
      wblcroped <- raster::crop(weibullsrc[[1]], raster::extent(PolyCrop))
      wblcroped <- raster::mask(weibullsrc[[1]], PolyCrop)
      Erwartungswert <- wblcroped[[1]]
    } else if (class(weibullsrc) == "RasterLayer") {
      wblcroped <- raster::crop(weibullsrc, raster::extent(PolyCrop))
      wblcroped <- raster::mask(weibullsrc, PolyCrop)
      Erwartungswert <- wblcroped
    }
    col2res <- "transparent"
    alpha <- 0.9
    Erwartungswert <- raster::projectRaster(Erwartungswert, 
                                            crs = raster::crs(Polygon1))
  }
  
  ## Check & Make Grid #############
  if (isTRUE(Grid)) {
    cellsize <- as.numeric(result_inputs["Resolution",][[1]])
    if (result_inputs["Grid Method",][[1]] == "Rectangular") {
      Grid <- grid_area(Polygon1, size = cellsize,
                        prop = as.numeric(result_inputs["Percentage of Polygon",][[1]]))[[2]]
    } else {
      Grid <- hexa_area(Polygon1, size = cellsize)[[2]]
    }
  }
  
  
  ## Check Terrain Modell #########
  if (topographie == TRUE) {
    Polygonwgs84 <-  sf::st_transform(Polygon1, 4326)
    srtm <- tryCatch(elevatr::get_elev_raster(locations = as(Polygonwgs84, "Spatial"), z = 11),
                     error = function(e) {
                       stop("\nDownloading Elevation data failed for the given Polygon.\n",
                            e, call. = FALSE)
                     })
    srtm_crop <- raster::crop(srtm, Polygonwgs84)
    srtm_crop <- raster::mask(srtm_crop, Polygonwgs84)
    srtm_crop <- raster::projectRaster(srtm_crop, crs = raster::crs(Polygon1))
    
    # Calculates Wind multiplier. Hills will get higher values, valleys will get lower values.
    orogr1 <- raster::calc(srtm_crop, function(x) {
      x / (raster::cellStats(srtm_crop, mean, na.rm = TRUE))
    })
    
    
    if (is.null(sourceCCL)) {
      if (length(list.files(pattern = "g100_06.tif")) == 0) {
        message("\nNo land cover raster ('sourceCCL') was given. It will be downloaded from ",
                "the EEA-website.")
        ## download an zip CCL-tif
        download.file("http://github.com/YsoSirius/windfarm_data/raw/master/clc.zip", 
                      destfile = "clc.zip", 
                      method = "auto")
        unzip("clc.zip")
        unlink("clc.zip")
        ccl <- raster::raster("g100_06.tif")
      } else {
        sourceCCL <- list.files(pattern = "g100_06.tif", full.names = TRUE)
        ccl <- raster::raster(x = sourceCCL)
      }
    }
    # Include Corine Land Cover Raster to get an estimation of Surface Roughness
    cclPoly <- raster::crop(ccl, Polygon1)
    cclPoly1 <- raster::mask(cclPoly, mask = Polygon1)
    if (is.null(sourceCCLRoughness)) {
      path <- paste0(system.file(package = "windfarmGA"), "/extdata/")
      source_ccl <- paste0(path, "clc_legend.csv")
    } else {
      cat("\nYou are using your own Corine Land Cover legend.")
      # readline(prompt = "\nPress <ENTER> if you want to continue")
      source_ccl <- sourceCCLRoughness
    }
    rauhigkeitz <- utils::read.csv(source_ccl, header = TRUE, sep = ";")
    cclRaster <- raster::reclassify(cclPoly1,
                                    matrix(c(rauhigkeitz[,'GRID_CODE'],
                                             rauhigkeitz[,'Rauhigkeit_z']),
                                           ncol = 2))
  }
  
  
  ## Set Argments for Best Energy/Efficiency Windfarm ##########
  if (plotEn == 1) {
    filter_col <- "EnergyOverall"
    listind <- 2
    title <- "Energy"
  }
  if (plotEn == 2) {
    filter_col <- "EfficAllDir"
    listind <- 3
    title <- "Efficiency"
  }
  
  ## Get Energy/Efficiency Output for every windfarm ###########
  energy_order <- unlist(lapply(result[, listind], function(x) x[, filter_col][[1]]))
  energy_order <- order(energy_order, decreasing = FALSE)
  
  ## Order List by Energy/Efficiency Output #########
  result <- result[, listind][energy_order]
  ledup <- length(result)
  
  ## Check for Duplicates #########
  rectid <- lapply(result, function(x) x[, 'Rect_ID'])
  rectidt <- !duplicated(rectid)
  result <- result[rectidt]
  ndif <- length(result)
  cat(paste("N different optimal configurations:", ndif, "\nAmount duplicates:", 
            (ledup - ndif)))
  
  ## Check for enough results #########
  if (ndif < best) {
    cat(paste("\nNot enough unique Optimas. Show first best Half of different configurations."))
    best <- trunc(ndif / 2)
  }
  if (best == 0) best = 1
  
  ## Pick the `best` results to plot and Loop over #########
  result <- result[(length(result) - best + 1):(length(result))]
  for (i in (1:length(result))) {
    ## Get result ###########
    best_result <- data.frame(result[[i]])
    best_result$EnergyOverall <- round(best_result[, 'EnergyOverall'], 2)
    best_result$EfficAllDir <- round(best_result[, 'EfficAllDir'], 2)
    
    ## Color code locations #########
    br <- length(levels(factor(best_result[, 'AbschGesamt'])))
    if (br > 1) {
      Col <- rbPal1(br)[as.numeric(cut(as.numeric(
        best_result[, 'AbschGesamt']), breaks = br))]
    } else {
      Col <- "green"
    }
    
    ## Plot Best Windfarm  ###########
    cat(paste("\nPlot ", (best + 1) - i, " Best ",title," Solution:\n"))
    par(mfrow = c(1, 1), ask = FALSE)
    plot(st_geometry(Polygon1), col = col2res, 
         main = paste((best + 1) - i, "Best ", title, " Windfarm", 
                      "\nEnergy Output", best_result$EnergyOverall[[1]], "kW",
                      "\nEfficiency:", best_result$EfficAllDir[[1]], "%"),
         cex.main = 0.8)
    if (best > 1) {
      if (i > 1) {
        par(ask = TRUE)
      }
    }
    
    ## Plot Weibull Data ###########      
    if (!is.null(weibullsrc)) {
      raster::plot(Erwartungswert, alpha = alpha, legend = TRUE, axes = FALSE,
                   useRaster = TRUE, add = TRUE,
                   legend.lab = "Mean Wind Speed")
    }
    
    ## Plot Grid  ###########
    if (inherits(Grid, "sf")  || inherits(Grid, "sfc")) {
      plot(Grid, add = TRUE)
    }
    
    ## Plot Turbines and additional Info ###########
    graphics::mtext("Total Wake Effect in %", side = 2, cex = 0.8)
    graphics::points(best_result[, 'X'], best_result[, 'Y'],
                     cex = 2, pch = 20, col = Col)
    graphics::text(best_result[, 'X'], best_result[, 'Y'],
                   round(best_result[, 'AbschGesamt'], 0),
                   cex = 0.8, pos = 1, col = "black")
    
    distpo <- stats::dist(x = cbind(best_result[, 'X'], best_result[, 'Y']),
                          method = "euclidian")
    graphics::mtext(paste("minimal Distance", round(min(distpo), 2)),
                    side = 1, line = 0, cex = 0.8)
    graphics::mtext(paste("mean Distance", round(mean(distpo), 2)),
                    side = 1, line = 1, cex = 0.8)
    
    ## Plot Terrain Model  ###########
    if (topographie == TRUE) {
      par(ask = TRUE)
      sel1 <- best_result[, 1:2]
      plot_terrain(result_inputs, sel1, Polygon1, orogr1, srtm_crop, cclRaster)
    }
  }
  
  ## Reset par() and return best windfarm  ###########
  par(parpplotRes)
  invisible(best_result)
}
plot_terrain <- function(inputs, sel1, polygon1, orogr1, srtm_crop, cclRaster) {
  ## Plot DEM and windspeed multiplier ############
  orogrnum <- raster::extract(x = orogr1, y = as.matrix(sel1),
                              small = TRUE, fun = mean, na.rm = TRUE)
  windpo <- 1 * orogrnum
  ## Get Elevation of Turbine Locations to estimate the air density at the resulting height
  heightWind <- raster::extract(x = srtm_crop, y = as.matrix((sel1)), 
                                small = TRUE, fun = max, na.rm = TRUE)
  par(mfrow = c(1, 2))
  cexa <- 0.9
  raster::plot(srtm_crop, main = "Elevation Data")
  graphics::points(sel1[, 'X'], sel1[, 'Y'], pch = 20)
  calibrate::textxy(sel1[, 'X'], sel1[, 'Y'],
                    labs = round(heightWind, 0), cex = 0.8)
  plot(polygon1, add = TRUE)
  raster::plot(orogr1, main = "Wind Speed Multipliers")
  points(sel1[, 'X'], sel1[, 'Y'], pch = 20)
  calibrate::textxy(sel1[, 'X'], sel1[, 'Y'],
                    labs = round(windpo, 3), cex = 0.8)
  plot(polygon1, add = TRUE)
  
  ## Get Air Density and Pressure from Height Values #########
  HeighttoBaro <- matrix(heightWind); colnames(HeighttoBaro) <- "HeighttoBaro"
  air_dt <- barometric_height(matrix(HeighttoBaro), HeighttoBaro)
  raster::plot(srtm_crop, main = "Normal Air Density",
               col = topo.colors(10))
  points(sel1[, 'X'], sel1[, 'Y'], pch = 20)
  calibrate::textxy(sel1[, 'X'], sel1[, 'Y'],
                    labs = rep(1.225, nrow(sel1)), cex = 0.8)
  plot(polygon1, add = TRUE)
  raster::plot(srtm_crop, main = "Corrected Air Density",
               col = topo.colors(10))
  points(sel1[, 'X'], sel1[, 'Y'], pch = 20)
  calibrate::textxy(sel1[, 'X'], sel1[, 'Y'],
                    labs = round(air_dt[, 'rh'], 2), cex = 0.8)
  plot(polygon1, add = TRUE)
  
  ## CorineLandCover Roughness values ##################
  SurfaceRoughness0 <- raster::extract(x = cclRaster, y = as.matrix((sel1)),
                                       small = TRUE, fun = mean, na.rm = TRUE)
  SurfaceRoughness1 <- raster::extract(x = raster::terrain(srtm_crop, "roughness"),
                                       y = as.matrix((sel1)),
                                       small = TRUE, fun = mean, na.rm = TRUE)
  SurfaceRoughness <- SurfaceRoughness0 * (1 + (SurfaceRoughness1 / max(raster::res(srtm_crop))))
  elrouind <- raster::terrain(srtm_crop, "roughness")
  elrouindn <- raster::resample(elrouind, cclRaster, method = "ngb")
  modSurf <- raster::overlay(x = cclRaster, y = elrouindn,
                             fun = function(x, y) {
                               return(x * (1 + (y / max(raster::res(srtm_crop)))))
                             })
  par(mfrow = c(1, 2))
  raster::plot(cclRaster, main = "Corine Land Cover Roughness")
  points(sel1[, 'X'], sel1[, 'Y'], pch = 20)
  calibrate::textxy(sel1[, 'X'], sel1[, 'Y'],
                    labs = round(SurfaceRoughness0, 2), cex = cexa)
  plot(polygon1, add = TRUE)
  raster::plot(x = raster::terrain(srtm_crop, "roughness", neighbors = 4),
               main = "Elevation Roughness Indicator")
  points(sel1[, 'X'], sel1[, 'Y'], pch = 20)
  calibrate::textxy(sel1[, 'X'], sel1[, 'Y'],
                    labs = round((SurfaceRoughness1), 2), cex = cexa)
  plot(polygon1, add = TRUE)
  raster::plot(modSurf, main = "Modified Surface Roughness")
  points(sel1[, 'X'], sel1[, 'Y'], pch = 20)
  calibrate::textxy(sel1[, 'X'], sel1[, 'Y'],
                    labs = round((SurfaceRoughness), 2), cex = cexa)
  plot(polygon1, add = TRUE)
  
  ## Wake Decay Constant #############
  RotorHeight <- as.integer(inputs['Rotor Height',])
  k_raster <- raster::calc(modSurf, function(x) {x <- 0.5 / (log(RotorHeight / x))})
  # New Wake Decay Constant calculated with new surface roughness values, according to CLC
  k <- 0.5 / (log(RotorHeight / SurfaceRoughness))
  raster::plot(k_raster, main = "Adapted Wake Decay Constant - K")
  points(sel1[, 'X'], sel1[, 'Y'], pch = 20)
  calibrate::textxy(sel1[, 'X'], sel1[, 'Y'], labs = round(k, 3), cex = cexa)
  plot(polygon1, add = TRUE)
}

#' @title Plot the results of an optimization run
#' @name plot_windfarmGA
#' @description  Plot the results of a genetic algorithm run with given inputs.
#'   Several plots try to show all relevant effects and outcomes of the
#'   algorithm. 6 plot methods are available that can be selected individually.
#'
#' @export
#'
#' @inheritParams plot_result
#' @param whichPl Which plots should be shown: 1-6 are possible. The default is
#'   "all" which shows all available plots
#'
#' @family Plotting Functions
#' @return NULL
#' @examples \donttest{
#' library(sf)
#' 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
#' ))
#'
#' ## Plot the results of a hexagonal grid optimization
#' plot_windfarmGA(resulthex, Polygon1, whichPl = "all", best = 1, plotEn = 1)
#'
#' ## Plot the results of a rectangular grid optimization
#' plot_windfarmGA(resultrect, Polygon1, whichPl = "all", best = 1, plotEn = 1)
#' }
plot_windfarmGA <- function(result, Polygon1, whichPl = "all", 
                            best = 1, plotEn = 1,
                            weibullsrc) {
  
  parpplotWindGa <- par(ask = FALSE, no.readonly = TRUE)
  on.exit(par(parpplotWindGa))
  
  ## DATA #################
  if (any(whichPl == "all")) {
    whichPl <- 1:6
  }
  resol <- as.numeric(result[, 'inputData'][[1]][,1]['Resolution'][[1]])
  Polygon1 <- isSpatial(Polygon1)
  if (nrow(result) < 4) {
    if (any(2:5 %in% whichPl)) {
      cat("Cannot plot option 2,3,4,5. \n Only option 1,6 are available.")
      whichPl <- c(1, 6)
    }
  }
  #################
  
  ## PLOTTING OUTPUTS ####################
  if (any(whichPl == 1)) {
    print("plot_result: Plot the 'best' Individuals of the GA:")
    plot_result(result = result, Polygon1 = Polygon1, best = best , plotEn = plotEn,
                topographie = FALSE, Grid = TRUE, weibullsrc = weibullsrc)
    readline(prompt = "Press [enter] to continue")
  }
  if (any(whichPl == 2)) {
    print("plot_evolution: Plot the Evolution of the Efficiency and Energy Values:")
    plot_evolution(result, TRUE, 0.3)
  }
  if (any(whichPl == 3)) {
    print("plot_parkfitness: Plot the Influence of Population Size, Selection, Crossover, Mutation:")
    plot_parkfitness(result, 0.1)
    readline(prompt = "Press [enter] to continue")
  }
  if (any(whichPl == 4)) {
    print("plot_fitness_evolution: Plot the Changes in Fitness Values:")
    plot_fitness_evolution(result)
    readline(prompt = "Press [enter] to continue")
  }
  if (any(whichPl == 5)) {
    print("plot_cloud: Plot all individual Values of the whole Evolution:")
    plot_cloud(result, TRUE)
    readline(prompt = "Press [enter] to continue")
  }
  if (any(whichPl == 6)) {
    print("plot_heatmap: Plot a Heatmap of all Grid Cells:")
    plot_heatmap(result = result, si = 2)
    # readline(prompt = "Press [enter] to continue")
  }
  # if (any(whichPl==7)){
  #   print("GooglePlot: Plot the 'best' Individual with static Google Map:")
  #   GooglePlot(result,Polygon1,best,plotEn,Projection)
  #   readline(prompt="Press [enter] to continue")
  # }
  # if (any(whichPl==8)){
  #   print("GoogleChromePlot: Plot the 'best' Individual with Leaflet with Satelitte Imagery:")
  #   GoogleChromePlot(result,Polygon1,best,plotEn,Projection)
  # }
  return()
}

#' @title Plot a wind warm with leaflet
#' @name plot_leaflet
#' @description  Plot a resulting wind farm on a leaflet map.
#'
#' @export
#'
#' @inheritParams plot_result
#' @param which A numeric value, indicating which individual to plot. The
#'   default is 1. Combined with \code{orderitems = TRUE} this will show the 
#'   best performing wind farm.
#' @param orderitems A logical value indicating whether the results should be
#'   ordered by energy values \code{TRUE} or chronologically \code{FALSE}
#' @param GridPol By default, the grid will be calculated based on the inputs 
#'  of \code{result} and the \code{Polygon1}. But another spatial object or the 
#'  output of the  \code{\link{grid_area}} or \code{\link{hexa_area}} functions 
#'  can also be
#'
#' @return Returns a leaflet map.
#'
#' @examples \donttest{
#' ## Plot the best wind farm on a leaflet map (ordered by energy values)
#' plot_leaflet(result = resulthex, Polygon1 = sp_polygon, which = 1)
#'
#' ## Plot the last wind farm (ordered by chronology).
#' plot_leaflet(result = resulthex, Polygon1 = sp_polygon, orderitems = FALSE,
#'          which = 1)
#'          
#' ## Plot the best wind farm on a leaflet map with the rectangular Grid
#' Grid <- grid_area(sp_polygon, size = 150, prop = 0.4)
#' plot_leaflet(result = resultrect, Polygon1 = sp_polygon, which = 1, 
#'              GridPol = Grid[[2]])
#'
#' ## Plot the last wind farm with hexagonal Grid
#' Grid <- hexa_area(sp_polygon, size = 75)
#' plot_leaflet(result = resulthex, Polygon1 = sp_polygon, which = 1, 
#'              GridPol = Grid[[2]])
#' }
plot_leaflet <- function(result, Polygon1, which = 1, orderitems = TRUE, GridPol) {
  if (!requireNamespace("leaflet", quietly = TRUE)) {
    stop("The package 'leaflet' is required for this function, but it is not installed.\n",
         "Please install it with `install.packages('leaflet')`")
  }
  
  ## Check Polygon and CRS ##############
  poly1 <- isSpatial(shape = Polygon1)
  if (is.na(st_crs(poly1))) {
    projection <- result[, "inputData"][[1]]["Projection", ][[1]]
    projection <- tryCatch(as.numeric(projection),
                           warning = function(e) projection,
                           error = function(e) projection)
    st_crs(poly1) <- st_crs(projection)
  }
  proj_pol <- st_crs(poly1)

  ## Order Items and pick `best` ##############
  if (which > nrow(result)) {
    cat(paste("Maximum possible number for 'which': ", nrow(result)))
    which <- nrow(result)
  }
  
  if (orderitems) {
    a <- sapply(result[, 2], FUN = function(i) {
      subset.matrix(i, subset = c(TRUE, rep(FALSE, nrow(i) - 1)),
                    select = "EnergyOverall")
    })
    b <- data.frame(cbind(a), stringsAsFactors = FALSE)
    order1 <- order(b, decreasing = TRUE)
    result <- result[order1, ]
    beste <- which
  } else {
    beste <- ""
  }
  
  ## WGS84 Projection for old and new GDAL ##############
  PROJ6 <- utils::compareVersion(sf::sf_extSoftVersion()[[3]], "6") > 0
  if (PROJ6) {
    proj_longlat <- 4326
  } else {
    proj_longlat <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
  }
  
  ## Grid-Function ##############
  if (!missing(GridPol)) {
    if (is.na(st_crs(GridPol))) {
      st_crs(GridPol) <- st_crs(proj_pol)
    }
  } else {
    cellsize <- as.numeric(result[, "inputData"][[1]]["Resolution",][[1]])
    if (result[, "inputData"][[1]]["Grid Method",][[1]] != "h") {
      GridPol <- grid_area(poly1, cellsize, 
                           prop = as.numeric(result[, "inputData"][[1]]["Percentage of Polygon",][[1]]),
                           plotGrid = FALSE)[[2]]
    } else {
      GridPol <- hexa_area(poly1, cellsize,  plotGrid = FALSE)[[2]]
    }
  }
  GridPol <- st_transform(GridPol, st_crs(proj_longlat))
  
  ## Pick a Windfarm and Project to WGS84 ##############
  result <- result[, "bestPaEn"][[which]]
  xysp <- st_as_sf(data.frame(result), coords=c("X","Y"))
  st_crs(xysp) <- proj_pol
  resultxy <- st_coordinates(st_transform(xysp, proj_longlat))
  result <- data.frame(result, stringsAsFactors = FALSE)
  result$X <- resultxy[, 1]
  result$Y <- resultxy[, 2]
  result$wake_radius <- round(result$AbschGesamt, 2) / 10
  
  poly1 <- st_transform(poly1, proj_longlat)
  
  ## Get Coordinates for Title ##############
  bbx <- st_bbox(poly1)
  title_locat <- c(mean(bbx[c(1,3)]), max(bbx[c(2,4)]))
  
  ## Color Coding ##############
  col_cir <- grDevices::colorRampPalette(c("green", "yellow",
                                           "red", "darkred"))
  br <- length(levels(factor(result$AbschGesamt)))
  if (br > 1) {
    color_pal <- col_cir(br)
  } else {
    color_pal <- "green"
  }
  pal <- leaflet::colorFactor(color_pal, domain = sort(result$AbschGesamt), 
                              ordered = TRUE,
                              reverse = FALSE)
  result$farbe <- pal(result$AbschGesamt)
  
  
  ## Turbine Icons ###########
  turbine_icon <- leaflet::iconList(
    turbine_icon = leaflet::makeIcon(
      iconUrl = paste0(system.file(package = "windfarmGA"),
                       "/extdata/windturdk.png"),
      iconWidth = 30, iconHeight = 50))
  list_popup <- paste("Total Wake Effect: ", as.character(result$AbschGesamt),
                      "% </dd>")
  
  
  ## Plot a Leaflet Map ###################
  overlay_group <- c("Wake Circles", "Title", "Polygon", "Turbines", "Grid")
  opaycity <- 0.4
  map <- leaflet::leaflet() %>%
    leaflet::addTiles(group = "OSM") %>%
    leaflet::addProviderTiles("Stamen.Terrain", group = "Terrain") %>%
    leaflet::addProviderTiles("Esri.WorldImagery", group = "Satellite") %>%
    leaflet::addProviderTiles("Stamen.Toner", group = "Toner") %>%
    ## Write a Popup with the energy output
    leaflet::addPopups(title_locat[1], (title_locat[2] + 0.0002),
                       group = "Title",
                       popup = paste(beste, "<b>Best Wind Farm with: ",
                                     round(as.numeric(
                                       result[, "EnergyOverall"][[1]]), 2),
                                     "kWh</b>"),
                       options = leaflet::popupOptions(
                         closeButton = TRUE, closeOnClick = FALSE)) %>%
    ## Add the Polygon
    leaflet::addPolygons(data = poly1, group = "Polygon",
                fill = TRUE, fillOpacity = 0.4) %>%
    ## Add the Genetic Algorithm Space
    leaflet::addPolygons(data = GridPol, group = "Grid", weight = 1,
                opacity = opaycity,
                fill = TRUE, fillOpacity = 0) %>%
    ## Create Circles in Map
    leaflet::addCircleMarkers(lng = result$X, lat = result$Y,
                     radius = result$wake_radius,
                     color = result$farbe,
                     stroke = TRUE, fillOpacity = 0.8,
                     group = "Wake Circles") %>%
    ## Add the turbine symbols
    leaflet::addMarkers(lng = result[, 1], lat = result[, 2],
               icon = turbine_icon[1], popup = list_popup,
               group = "Turbines") %>%
    leaflet::addLegend(position = "topleft",
              pal = pal,
              values = result$AbschGesamt,
              labFormat = leaflet::labelFormat(suffix = "%"),
              opacity = 1, title = "Total Wake Effect",
              layerId = "Legend") %>%
    ## Layers control
    leaflet::addLayersControl(baseGroups = c(
      "OSM",
      "Terrain",
      "Satellite",
      "Toner"),
      overlayGroups = overlay_group,
      options = leaflet::layersControlOptions(collapsed = TRUE)
    )
  
  # Plot the map
  map
}

#' @title Plot the genetic algorithm results
#' @name plot_parkfitness
#' @description Plot the evolution of fitness values with the influences of
#'   selection, crossover and mutation.
#' @export
#'
#' @inheritParams plot_result
#' @param spar A numeric value determining how exact a spline should be drawn.
#'   Default is 0.1
#'
#' @family Plotting Functions
#' @return NULL
#' @examples \donttest{
#' ## Plot the results of a hexagonal grid optimization
#' plot_parkfitness(resulthex)
#'}
plot_parkfitness <- function(result, spar = 0.1) {
  ## Data #####################
  rslt <- as.data.frame(do.call("rbind", result[, "allparkcoeff"]))
  mutres <- as.data.frame(do.call("rbind", result[, "mut_rate"]))
  nindiv1 <- as.data.frame(do.call("cbind", result[, "nindiv"]))
  nindiv1 <- nindiv1[-seq(4, length(nindiv1), 4)]
  
  selcross <- unlist(result[, "selcross"])
  selteil <- selcross[seq(2, length(selcross), 2)]
  crossteil <- selcross[seq(1, length(selcross), 2)]
  #######################
  
  ## Set graphics param #####################
  parparfit <- par(ask = FALSE, no.readonly = TRUE)
  on.exit(par(parparfit))
  graphics::layout(matrix(c(1, 1, 1, 1, 2, 3, 4, 5), 2, 4, byrow = TRUE))
  rbPal <- grDevices::colorRampPalette(c("red", "green"))
  Col <- rbPal(4)[as.numeric(cut(as.numeric(rslt$maxparkfitness), breaks = 4))]
  #######################
  
  ## Plot All together (5 Plots) #####################
  plot(rslt$minparkfitness, xaxt = "n", main = "Parkfitness per Generation", pch = 20,
       ylab = "Parkfitness", xlab = "Generation", cex = 1, cex.main = 1, 
       col = "red", ylim = c(min(rslt$minparkfitness), max(rslt$maxparkfitness)))
  graphics::axis(1, at = 1:nrow(rslt), tick = TRUE)
  graphics::points(rslt$meanparkfitness, ylab = "MeanParkF", cex = 1.2, col = "blue", pch = 20)
  graphics::points(rslt$maxparkfitness, ylab = "maxParkF", cex = 1.2, col = "green", pch = 20)
  x <- 1:length(rslt$maxparkfitness)
  
  if (nrow(result) >= 4) {
    lmin <- stats::smooth.spline(x, rslt$minparkfitness, spar = spar)
    graphics::lines(lmin, col = "red", lwd = 1.2)
    lmea <- stats::smooth.spline(x, rslt$meanparkfitness, spar = spar)
    graphics::lines(lmea, col = "blue", lwd = 1.2)
    lmax <- stats::smooth.spline(x, rslt$maxparkfitness, spar = spar)
    graphics::lines(lmax, col = "green", lwd = 1.2)
    graphics::grid(col = "gray")
  }
  
  par(ask = TRUE)
  par(mar = c(5,5,3,2))
  farbe <- rep(seq(1,3,1), length(nindiv1)/3)
  ndindiplot <- as.integer(nindiv1)
  plot(ndindiplot, type = "b", col = farbe, cex = 1.5, cex.main = 1, pch = 20, 
       main = "Population Size", axes = FALSE, xlab = "Generation",
       ylab = "Amount of Individuals", ylim = c(0, max(ndindiplot) + 100))
  axis(side = 2, tick = TRUE) 
  axis(side = 1, tick = TRUE, at = seq(1, length(ndindiplot),3),
       labels = (1:(length(ndindiplot)/3)))
  legend("topleft", title = "Amount of Individuals in: ", lty = c(1,1,1),
         cex = 0.5, inset = c(0.01, 0.01),
         box.lty = 0, box.lwd = 0, c("Fitness","Selection","Crossover"), 
         col = farbe[1:3], xjust = 0)
  
  plot(1*100/selteil, ylim = c(20, 110), type = "b", cex = 2, cex.main = 1,
       col = "green", pch = 20, main = "Selection",
       ylab = "Percentage", xlab = "Generation")
  graphics::grid(col = "gray")
  selrpl <- 1*100/selteil
  timeticksel <- which(selrpl > 75)
  selrplval <- selrpl[selrpl > 75]
  calibrate::textxy(timeticksel, selrplval, labs = timeticksel, cex = 0.7)
  
  
  plot(crossteil, col = crossteil, main = "Crossover",
       xlab = "Generation", ylab = "Crossover Points",
       ylim = c(1, 8), cex = 1, cex.main = 1, pch = 15)
  graphics::grid(col = "gray")
  timetickcro <- which(crossteil > median(crossteil))
  crorplval <- crossteil[crossteil > median(crossteil)]
  calibrate::textxy(timetickcro, crorplval, labs = timetickcro, cex = 0.5)
  
  plot(as.numeric(t(mutres)), type = "b", main = "Mutation", xlab = "Generation",
       ylab = "Mutation Percentage", cex = 1, cex.main = 1, pch = 15)
  mutrpl <- as.numeric(t(mutres))
  timetick <- which(mutrpl > median(mutrpl))
  mutrplval <- mutrpl[mutrpl > median(mutrpl)]
  calibrate::textxy(timetick, mutrplval, labs = timetick, cex = 0.7)
  grid(col = "gray")
  #######################
  
  ## Plot Count Individuals #####################
  par(mfrow = c(1,1))
  plot(ndindiplot, type = "b", col = farbe, cex = 1.5, cex.main = 1, pch = 20, 
       main = "Population Size", axes = FALSE, xlab = "Generation",
       ylab = "Amount of Individuals", ylim = c(0, max(ndindiplot) + 100))
  axis(side = 2, tick = TRUE) 
  axis(side = 1, tick = TRUE, at = seq(1, length(ndindiplot), 3),
       labels = (1:(length(ndindiplot)/3)))
  
  graphics::legend("topleft", title = "Amount of Individuals in: ", pch = c(20,20,20),
                   cex = 1, inset = c(0.01,0.01),
                   box.lty = 0, box.lwd = 0, c("Fitness","Selection","Crossover"),
                   text.col = farbe[1:3], col = farbe[1:3], xjust = 0)
  #######################
  
  ## Plot Selection / Crossover Params #####################
  graphics::par(mfrow = c(2,1))
  plot(1*100/selteil, ylim = c(20,110), type = "b", cex = 2, col = "green",
       pch = 20, main = "Selection",
       ylab = "Percentage", xlab = "Generation")
  graphics::grid(col = "gray")
  selrpl <- 1*100/selteil
  timeticksel <- which(selrpl > 75)
  selrplval <- selrpl[selrpl > 75]
  calibrate::textxy(timeticksel, selrplval, labs = timeticksel, cex = 0.5)
  plot(crossteil, col = crossteil, main = "Crossover", xlab = "Generation",
       ylab = "Crossover Points", ylim = c(1,8), cex = 1, pch = 15)
  grid(col = "gray")
  timetickcro <- which(crossteil > median(crossteil))
  crorplval <- crossteil[crossteil > median(crossteil)]
  calibrate::textxy(timetickcro, crorplval, labs = timetickcro, cex = 0.5)
  #######################
  ## Add Special Events #######################
  if (length(timetick) != 0) {
    graphics::par(mfrow = c(1, 1))
    rbPal <- grDevices::colorRampPalette(c("red","green"))
    Col <- rbPal(4)[as.numeric(cut(as.numeric(rslt$maxparkfitness), breaks = 4))]
    plot(rslt$minParkwirkungsg, xaxt = "n", main = "Mutation Influence", 
         ylab = " in %", cex = 1.2, cex.main = 1, 
         col = "red", pch = 20, xlab = "Generation",
         ylim = c(min(rslt$minParkwirkungsg),max(rslt$maxParkwirkungsg)))
    graphics::axis(1, at = 1:nrow(rslt), tick = TRUE)
    graphics::points(rslt$meanParkwirkungsg, ylab = "MeanParkEff", cex = 1.2, 
                     col = "blue", pch = 20)
    graphics::points(rslt$maxParkwirkungsg, ylab = "maxParkEff", cex = 1.2, 
                     col = "green", pch = 20)
    x <- 1:length(rslt$maxparkfitness)
    if (nrow(result) >= 4) {
      lmin <- stats::smooth.spline(x, rslt$minParkwirkungsg, spar = spar) 
      graphics::lines(lmin, col = "red", lwd = 1.2)
      lmea <- stats::smooth.spline(x, rslt$meanParkwirkungsg, spar = spar) 
      graphics::lines(lmea, col = "blue", lwd = 1.2)
      lmax <- stats::smooth.spline(x, rslt$maxParkwirkungsg, spar = spar) 
      graphics::lines(lmax, col = "green", lwd = 1.2)
      graphics::grid(col = "gray")
    }
    graphics::abline(v = timetick, col = "black")
    graphics::mtext(mutrplval, side = 3, at = timetick, cex = 0.8)
  }
  if (length(timeticksel) != 0) {
    graphics::par(mfrow = c(1,1))
    rbPal <- grDevices::colorRampPalette(c("red","green"))
    Col <- rbPal(4)[as.numeric(cut(as.numeric(rslt$maxparkfitness), breaks = 4))]
    graphics::plot(rslt$minParkwirkungsg, xaxt = "n", 
                   main = "Selection Influence", ylab = " in %", cex = 1, 
                   cex.main = 1, col = "red",xlab = "Generation",
                   pch = 20, ylim = c(min(rslt$minParkwirkungsg),max(rslt$maxParkwirkungsg)))
    graphics::axis(1, at = 1:nrow(rslt), tick = TRUE)
    graphics::points(rslt$meanParkwirkungsg, ylab = "MeanParkEff", 
                     cex = 1.2, col = "blue", pch = 20)
    graphics::points(rslt$maxParkwirkungsg, ylab = "maxParkEff", 
                     cex = 1.2, col = "green", pch = 20)
    x <- 1:length(rslt$maxparkfitness)
    if (nrow(result) >= 4) {
      lmin <- stats::smooth.spline(x, rslt$minParkwirkungsg, spar = spar)
      graphics::lines(lmin, col = "red", lwd = 1.2)
      lmea <- stats::smooth.spline(x, rslt$meanParkwirkungsg, spar = spar)
      graphics::lines(lmea, col = "blue", lwd = 1.2)
      lmax <- stats::smooth.spline(x, rslt$maxParkwirkungsg, spar = spar)
      graphics::lines(lmax, col = "green", lwd = 1.2)
      graphics::grid(col = "gray")
    }
    abline(v = timeticksel,col = "green")
    mtext(selrplval, side = 3,at = timeticksel, col = "green", cex = 0.8)
  }
  if (length(timetickcro) != 0 ) {
    par(mfrow = c(1,1))
    rbPal <- colorRampPalette(c("red","green"))
    Col <- rbPal(4)[as.numeric(cut(as.numeric(rslt$maxparkfitness),
                                   breaks = 4))]
    plot(rslt$minParkwirkungsg, xaxt = "n", main = "Crossover Influence",
         ylab = " in %", cex = 1, cex.main = 1, col = "red", xlab = "Generation",
         pch = 20, ylim = c(min(rslt$minParkwirkungsg),max(rslt$maxParkwirkungsg)))
    axis(1, at = 1:nrow(rslt), tick = TRUE)
    points(rslt$meanParkwirkungsg, ylab = "MeanParkEff", cex = 1.2,
           col = "blue", pch = 20)
    points(rslt$maxParkwirkungsg, ylab = "maxParkEff", cex = 1.2,
           col = "green", pch = 20)
    x <- 1:length(rslt$maxparkfitness)
    if (nrow(result) >= 4) {
      lmin <- stats::smooth.spline(x, rslt$minParkwirkungsg, spar = spar)
      graphics::lines(lmin, col = "red", lwd = 1.2)
      lmea <- stats::smooth.spline(x, rslt$meanParkwirkungsg, spar = spar)
      graphics::lines(lmea, col = "blue", lwd = 1.2)
      lmax <- stats::smooth.spline(x, rslt$maxParkwirkungsg, spar = spar)
      graphics::lines(lmax, col = "green", lwd = 1.2)
      graphics::grid(col = "gray")
    }
    graphics::abline(v = timetickcro, col = "red")
    graphics::mtext(crorplval, side = 3,at = timetickcro, col = "red", cex = 0.8)
  }
  #######################
  
  ## Plot Fitness, Selection, Crossover and Fitness Deviation #####################
  sddata <- plot_cloud(result)
  fitsd <- sddata[, grep(pattern = "Fit", colnames(sddata))]
  effsd <- sddata[, grep(pattern = "Eff", colnames(sddata))]
  enesd <- sddata[, grep(pattern = "Ene", colnames(sddata))]
  graphics::par(mfrow = c(4, 1))
  plot(rslt$minparkfitness, xaxt = "n", main = "Parkfitness per Generation", 
       ylab = "Parkfitness", xlab = "Generation",
       cex = 1, cex.main = 1, col = "red", pch = 20,
       ylim = c(min(rslt$minparkfitness), max(rslt$maxparkfitness)))
  graphics::axis(1, at = 1:nrow(rslt), tick = TRUE)
  graphics::grid(col = "black")
  graphics::points(rslt$meanparkfitness, ylab = "MeanParkF",
                   cex = 1.2, col = "blue", pch = 20)
  graphics::points(rslt$maxparkfitness, ylab = "maxParkF",
                   cex = 1.2, col = "green", pch = 20)
  x <- 1:length(rslt$maxparkfitness)
  if (nrow(result) >= 4) {
    lmin <- smooth.spline(x, rslt$minparkfitness, spar = spar) 
    graphics::lines(lmin, col = "red", lwd = 1.2)
    lmea <- smooth.spline(x, rslt$meanparkfitness, spar = spar)
    graphics::lines(lmea, col = "blue", lwd = 1.2)
    lmax <- smooth.spline(x, rslt$maxparkfitness, spar = spar) 
    graphics::lines(lmax, col = "green", lwd = 1.2)
    graphics::grid(col = "gray")
  }
  
  plot(100 / selteil, ylim = c(20, 110), type = "b", lwd = 2, col = "green",
       pch = 20, main = "Selection",
       ylab = "Percentage", xlab = "Generation", cex.main = 1)
  graphics::grid(lty = 2)
  
  plot(crossteil, col = crossteil, pch = 20, cex.main = 1, cex = 2,
       main = "Crossover", xlab = "Generation", ylab = "Crossover Points",
       ylim = c(1, 6))
  graphics::grid(lty = 2)
  
  plot(enesd[,"EneSD"], type = "b", col = "blue", pch = 20, lwd = 2,
       ylab = "Energy/Efficiency/Fitness Deviation", xlab = "Generation",
       cex.main = 1, main = "Standard Deviation")
  graphics::grid(lty = 2)
  graphics::par(new = TRUE)
  plot(effsd[, "EffSD"], type = "b", col = "orange", lwd = 2, axes = FALSE, 
       bty = "n", xlab = "", ylab = "", pch = 20)
  graphics::par(new = TRUE)
  plot(fitsd[,"FitSD"], type = "b", col = "red", lwd = 2, axes = FALSE, 
       bty = "n", xlab = "", ylab = "",pch = 20)
  
  timeticksd <- which(mutrpl > median(mutrpl))
  sdrplval <- fitsd[,'FitSD'][timeticksd]
  if (length(timeticksd) != 0) {
    calibrate::textxy(timeticksd, sdrplval, labs = timeticksd, cex = 0.5)
    graphics::abline(v = timeticksd)
    graphics::mtext(mutrplval, side = 3, at = timetick, cex = 0.8)
  }
  #######################
  
  ## Plot Mutation influence #####################
  graphics::par(mfrow = c(1, 1))
  plot(fitsd[,'FitSD'], type = "b", col = "red", lwd = 2, cex.main = 1, axes = TRUE,
       bty = "n", xlab = "Generation", ylab = "",
       pch = 20, main = "Mutation influence on Standard Deviation")
  if (length(timeticksd) != 0) {
    calibrate::textxy(timeticksd, sdrplval, labs = timeticksd, cex = 0.7)
    graphics::abline(v = timeticksd)
    graphics::mtext(mutrplval, side = 3,at = timetick,cex = 0.8)
  }
  
  return()
}

#' @title Plot the progress of populations
#' @name plot_development
#' @description Plot the changes in mean and max fitness values to previous
#' generation.
#'
#' @export
#'
#' @inheritParams plot_result
#' 
#' @family Plotting Functions
#' @return NULL
#' @examples \donttest{
#' plot_development(resultrect)
#' }
plot_development <- function(result) {
  parbeorwo <- par(ask = FALSE, no.readonly = TRUE)
  on.exit(par(parbeorwo))
  par(mfrow = c(2, 1))
  
  beorworse <- do.call("rbind", result[, 9])
  maxdif <- data.frame(
    diff = beorworse[, 1],
    farbe = 0)
  
  maxdif$farbe[maxdif$diff < 0]  <- "red"
  maxdif$farbe[maxdif$diff > 0] <- "green"
  maxdif$farbe[maxdif$diff == 0] <- "orange"
  plot(maxdif$diff, type = "b", col = maxdif$farbe, pch = 20, cex = 2)
  abline(0, 0)
  title("Max Difference to previous generation")
  
  
  meandif <- data.frame(
    diff = beorworse[, 2],
    farbe = 0)
  meandif$farbe[meandif$diff < 0]  <- "red"
  meandif$farbe[meandif$diff > 0] <- "green"
  meandif$farbe[meandif$diff == 0] <- "orange"
  plot(meandif$diff, type = "b", col = meandif$farbe, pch = 20, cex = 2)
  abline(0, 0)
  title("Mean Difference to previous generation")
  
  return()
}

#' @title Plot the evolution of fitness values
#' @name plot_evolution
#' @description  Plot the evolution of energy outputs and efficiency rates over
#'   the whole generations. Plots min, mean and max values.
#' @export
#'
#' @inheritParams plot_result
#' @param ask Should R wait for interaction for subsequent plotting. Default is
#'   TRUE
#' @param spar A numeric value determining how exact a spline should be drawn.
#'   Default is 0.1
#'
#' @family Plotting Functions
#' @return NULL
#' @examples \donttest{
#' ## Plot the results of a rectangular grid optimization
#' plot_evolution(resultrect, ask = TRUE, spar = 0.1)
#'}
plot_evolution <- function(result, ask = TRUE, spar = 0.1) {
  ## Set the graphical parameters
  parevol <- par(no.readonly = TRUE)
  on.exit(par(parevol))
  par(mfrow = c(1, 1))
  
  result1 <- as.data.frame(do.call("rbind", result[, 1]))
  
  plot(result1$minParkwirkungsg, xaxt = "n",
       main = "Park Efficiency per Generation",
       xlab = "Generation",
       ylab = "Park Efficiency in %", cex = 0.8, cex.main = 0.8,
       col = "red", pch = 20,
       ylim = c(min(result1$minParkwirkungsg), max(result1$maxParkwirkungsg)))
  axis(1, at = 1:nrow(result1), tick = TRUE)
  grid(col = "black")
  points(result1$meanParkwirkungsg, cex = 1.2, col = "blue", pch = 20)
  points(result1$maxParkwirkungsg, cex = 1.2, col = "green", pch = 20)
  x <- 1:length(result1$MaxEnergyRedu)
  
  if (nrow(result) >= 4) {
    lmin <- smooth.spline(x, result1$minParkwirkungsg, spar = spar)
    lines(lmin, col = "red", lwd = 1.2)
    lmea <- smooth.spline(x, result1$meanParkwirkungsg, spar = spar)
    lines(lmea, col = "blue", lwd = 1.2)
    lmax <- smooth.spline(x, result1$maxParkwirkungsg, spar = spar)
    lines(lmax, col = "green", lwd = 1.2)
  }
  
  par(ask = ask)
  
  plot(result1$MeanEnergyRedu, xaxt = "n",
       main = "Energy Yield per Generation",
       xlab = "Generation",
       ylab = "Energy in kW", cex = 0.8, cex.main = 0.8,
       col = "blue", pch = 20,
       ylim = c(min(result1$MinEnergyRedu), max(result1$MaxEnergyRedu)))
  axis(1, at = 1:nrow(result1), tick = TRUE)
  grid(col = "black")
  points(result1$MaxEnergyRedu, cex = 1.2, col = "green", pch = 20)
  points(result1$MinEnergyRedu, cex = 1.2, col = "red", pch = 20)
  
  if (nrow(result) >= 4) {
    emean <- smooth.spline(x, result1$MeanEnergyRedu, spar = spar)
    lines(emean, col = "blue", lwd = 1.2)
    emax <- smooth.spline(x, result1$MaxEnergyRedu, spar = spar)
    lines(emax, col = "green", lwd = 1.2)
    emin <- smooth.spline(x, result1$MinEnergyRedu, spar = spar)
    lines(emin, col = "red", lwd = 1.2)
  }
  
  return()
}

#' @title Plot outputs of all generations with standard deviations
#' @name plot_cloud
#' @description  Plot the fitness, efficiency and energy outputs of all
#'   generations and the corresponding standard deviations.
#'
#' @export
#'
#' @inheritParams plot_result
#' @param pl Should the results be plotted? Default is FALSE
#'
#' @family Plotting Functions
#' @return Returns a data.frame with the values for fitness, efficiency and
#'   energy for all evaluated individuals
#'
#' @examples \donttest{
#' ## Plot the results of a hexagonal grid optimization
#' plcdf <- plot_cloud(resulthex, TRUE)
#'}
plot_cloud <- function(result, pl = FALSE) {
  parcloud <- par(ask = FALSE, no.readonly = TRUE)
  on.exit(par(parcloud))
  ## Data Aggregation ##########
  clouddata <- result[, 7]
  efficiency_cloud <- lapply(clouddata, function(x) x = x[, 1])
  energy_cloud <- lapply(clouddata, function(x) x = x[, 2])
  fitness_cloud <- lapply(clouddata, function(x) x = x[, 3])

  efficiency_per_gen <- energy_per_gen <- fitness_per_gen <- list()
  for (i in 1:length(clouddata)) {
    l <- length(clouddata[[i]][, "EfficAllDir"])
    efficiency_per_gen[[i]] <- t(as.matrix(rbind(rep(i, l),
                                                 efficiency_cloud[[i]])))
    energy_per_gen[[i]] <- t(as.matrix(rbind(rep(i, l),
                                             energy_cloud[[i]])))
    fitness_per_gen[[i]] <- t(as.matrix(rbind(rep(i, l),
                                              fitness_cloud[[i]])))
  }
  
  
  efficiency_per_gen <- do.call("rbind", efficiency_per_gen)
  efficiency_per_genmax <- data.frame(efficiency_per_gen)
  max_effic_per_gen <- aggregate(efficiency_per_genmax,
                                 list(efficiency_per_genmax$X1), max)
  mean_effic_per_gen <- aggregate(efficiency_per_genmax,
                                  list(efficiency_per_genmax$X1), mean)
  min_effic_per_gen <- aggregate(efficiency_per_genmax,
                                 list(efficiency_per_genmax$X1), min)
  sd_effic_per_gen <- aggregate(efficiency_per_genmax,
                                list(efficiency_per_genmax$X1), sd)
  efficiency_per_genmax <- cbind(
    "X1" = max_effic_per_gen[, 2],
    "max" = max_effic_per_gen[, 3],
    "mean" = mean_effic_per_gen[, 3],
    "min" = min_effic_per_gen[, 3],
    "sd" = sd_effic_per_gen[, 3])

  energy_per_gen <- do.call("rbind", energy_per_gen)
  energy_per_genmax <- data.frame(energy_per_gen)
  max_energy_per_gen <- aggregate(energy_per_genmax,
                                 list(energy_per_genmax$X1), max)
  mean_energy_per_gen <- aggregate(energy_per_genmax,
                                  list(energy_per_genmax$X1), mean)
  min_energy_per_gen <- aggregate(energy_per_genmax,
                                 list(energy_per_genmax$X1), min)
  sd_energy_per_gen <- aggregate(energy_per_genmax,
                                list(energy_per_genmax$X1), sd)
  energy_per_genmax <- cbind(
    "X1" = max_energy_per_gen[, 2],
    "max" = max_energy_per_gen[, 3],
    "mean" = mean_energy_per_gen[, 3],
    "min" = min_energy_per_gen[, 3],
    "sd" = sd_energy_per_gen[, 3])

  fitness_per_gen <- do.call("rbind", fitness_per_gen)
  fitness_per_genmax <- data.frame(fitness_per_gen)
  max_fit_per_gen <- aggregate(fitness_per_genmax,
                              list(fitness_per_genmax$X1), max)
  mean_fit_per_gen <- aggregate(fitness_per_genmax,
                               list(fitness_per_genmax$X1), mean)
  min_fit_per_gen <- aggregate(fitness_per_genmax,
                              list(fitness_per_genmax$X1), min)
  sd_fit_per_gen <- aggregate(fitness_per_genmax,
                             list(fitness_per_genmax$X1), sd)
  fitness_per_genmax <- cbind(
    "X1" = max_fit_per_gen[, 2],
    "max" = max_fit_per_gen[, 3],
    "mean" = mean_fit_per_gen[, 3],
    "min" = min_fit_per_gen[, 3],
    "sd" = sd_fit_per_gen[, 3])

  ## Plots ##########
  if (pl) {
    par(mfrow = c(2, 3))
    ## Fitness #######
    df <- data.frame(fitness_per_gen)
    colnames(df) <- c("generation", "values")
    boxplot(values~generation, data=df, main = "Fitness",
            xlab = "Generation",
            ylab = "Fitnessvalue", 
            pch = 20, col = "red", cex = 1.3)
    
    if (length(clouddata) >= 4) {
      lf <- stats::smooth.spline(x = fitness_per_gen[, 1],
                                 y = fitness_per_gen[, 2],
                                 spar = 0.1)
      graphics::lines(lf, col = "red", lwd = 1.2)
    }
    graphics::points(x = fitness_per_genmax[, "X1"],
                     y = fitness_per_genmax[, "max"],
                     type = "l", col = "red")
    graphics::points(x = fitness_per_genmax[, "X1"],
                     y = fitness_per_genmax[, "min"],
                     type = "l", col = "red")
    
    ## Efficiency #######
    df <- data.frame(efficiency_per_gen)
    colnames(df) <- c("generation", "values")
    boxplot(values~generation, data=df, main = "Efficiency",
            xlab = "Generation",
            ylab = "Efficiency in %",
            pch = 20, col = "orange", cex = 1.3)
    if (length(clouddata) >= 4) {
      le <- stats::smooth.spline(x = efficiency_per_gen[, 1],
                                 y = efficiency_per_gen[, 2],
                                 spar = 0.1)
      graphics::lines(le, col = "orange", lwd = 1.2)
    }
    graphics::points(x = efficiency_per_genmax[, "X1"],
                     y = efficiency_per_genmax[, "max"],
                     type = "l", col = "orange")
    graphics::points(x = efficiency_per_genmax[, "X1"],
                     y = efficiency_per_genmax[, "min"],
                     type = "l", col = "orange")
    
    ## Energy #######
    df <- data.frame(energy_per_gen)
    colnames(df) <- c("generation", "values")
    boxplot(values~generation, data=df, main = "Energy",
            xlab = "Generation",
            ylab = "Energy in kW",
            pch = 20, col = "blue", cex = 1.3)
    if (length(clouddata) >= 4) {
      len <- stats::smooth.spline(x = energy_per_gen[, 1],
                                  y = energy_per_gen[, 2],
                                  spar = 0.1)
      graphics::lines(len, col = "blue", lwd = 1.2)
    }
    graphics::points(x = energy_per_genmax[, "X1"],
                     y = energy_per_genmax[, "max"],
                     type = "l", col = "blue")
    graphics::points(x = energy_per_genmax[, "X1"],
                     y = energy_per_genmax[, "min"],
                     type = "l", col = "blue")

    graphics::plot(x = fitness_per_genmax[, "X1"],
                   y = fitness_per_genmax[, "sd"],
                   main = "Standard Deviation Fitness",
                   xlab = "Generation",
                   ylab = "Standard Deviation of Population", col = "red",
                   type = "b")
    graphics::plot(x = efficiency_per_genmax[, "X1"],
                   y = efficiency_per_genmax[, "sd"],
                   main = "Standard Deviation Efficiency",
                   xlab = "Generation",
                   ylab = "Standard Deviation of Population", col = "orange",
                   type = "b")
    graphics::plot(x = energy_per_genmax[, "X1"],
                   y = energy_per_genmax[, "sd"],
                   main = "Standard Deviation Energy",
                   xlab = "Generation",
                   ylab = "Standard Deviation of Population", col = "blue",
                   type = "b")
  }

  ## Output ##########
  clouddatafull <- cbind(Fitn = fitness_per_genmax,
                         Eff = efficiency_per_genmax,
                         Ene = energy_per_genmax)
  colnames(clouddatafull) <- c("FitX1", "FitMax", "FitMean", "FitMin", "FitSD",
                               "EffX1", "EffMax", "EffMean", "EffMin", "EffSD",
                               "EneX1", "EneMax", "EneMean", "EneMin", "EneSD")
  invisible(clouddatafull)
}

#' @title Plot the changes of min/mean/max fitness values
#' @name plot_fitness_evolution
#' @description  Plot the evolution of fitness values and the change in the min,
#'   mean and max fitness values to the former generations.
#' @export
#'
#' @inheritParams plot_evolution
#'
#' @family Plotting Functions
#' @return NULL
#' @examples \donttest{
#' ## Plot the results of a hexagonal grid optimization
#' plot_fitness_evolution(resulthex, 0.1)
#' }
plot_fitness_evolution <- function(result, spar = 0.1) {
  ## Setting par() and get Result #######
  oparplotfitness <- par(no.readonly = TRUE)
  on.exit(par(oparplotfitness))
  par(mfrow = c(1, 1), ask = FALSE, mar = c(4, 5, 4, 2))
  layout(mat = matrix(c(1, 2, 3, 4, 4, 4), nrow = 2, ncol = 3, byrow = TRUE))
  
  x <- result[, 4]
  x <- x[-c(1)]
  x1 <- do.call("rbind", x)
  result <- as.data.frame(do.call("rbind", result[, 1]))
  
  ## Minimal Fitness #########
  minge <- x1[seq(1, length(x1[,1]), 2), 1]
  minge2 <- x1[seq(2, length(x1[,2]), 2), 1]
  ming3 <- minge - minge2
  ming3 <- c(0, ming3)
  ming3 <- as.data.frame(ming3)
  ming3$farbe <- 0
  ming3$farbe[ming3$ming3 < 0]  <- "red"
  ming3$farbe[ming3$ming3 > 0] <- "green"
  ming3$farbe[ming3$ming3 == 0] <- "orange"
  plot(ming3$ming3, type = "b", col = ming3$farbe, pch = 20, cex = 2,
       xlab = "Generation", ylab = "Change")
  title(main = "Minimal Fitness Values",sub = "compared to previous generation",
        col.main = "red")
  abline(0, 0)
  grid(col = "black")
  
  ## Mean Fitness #########
  meange <- x1[seq(1, length(x1[, 1]), 2), 3]
  meange2 <- x1[seq(2, length(x1[, 2]), 2), 3]
  meag3 <- meange - meange2
  meag3 <- c(0, meag3)
  meag3 <- as.data.frame(meag3)
  meag3$farbe <- 0
  meag3$farbe[meag3$meag3 < 0]  <- "red"
  meag3$farbe[meag3$meag3 > 0] <- "green"
  meag3$farbe[meag3$meag3 == 0] <- "orange"
  plot(meag3$meag3, type = "b", col = meag3$farbe, pch = 20, cex = 2,
       xlab = "Generation", ylab = "Change")
  title(main = "Mean Fitness Values", sub = "compared to previous generation",
        col.main = "orange")
  abline(0, 0)
  grid(col = "black")
  
  ## Maximum Fitness #########
  maxge <- x1[seq(1, length(x1[, 1]), 2), 2]
  maxge2 <- x1[seq(2, length(x1[, 2]), 2), 2]
  mg3 <- maxge - maxge2
  mg3 <- c(0, mg3)
  mg3 <- as.data.frame(mg3)
  mg3$farbe <- 0
  mg3$farbe[mg3$mg3 < 0]  <- "red"
  mg3$farbe[mg3$mg3 > 0] <- "green"
  mg3$farbe[mg3$mg3 == 0] <- "orange"
  plot(mg3$mg3, type = "b", col = mg3$farbe, pch = 20, cex = 2,
       xlab = "Generation", ylab = "Change")
  title(main = "Maximal Fitness Values", sub = "compared to previous generation",
        col.main = "darkgreen")
  abline(0, 0)
  grid(col = "black")
  
  ## Fitness Values per Generation #########
  plot(result$minparkfitness, xaxt = "n", main = "Parkfitness per Generation",
       ylab = "Parkfitness in %", xlab = "Generation", cex = 2, col = "red",
       pch = 20, ylim = c(min(result$minparkfitness), max(result$maxparkfitness)))
  axis(1, at = 1:nrow(result),tick = TRUE)
  grid(col = "black")
  points(result$meanparkfitness, ylab = "MeanParkF", cex = 2, 
         col = "blue", pch = 20)
  points(result$maxparkfitness, ylab = "maxParkF", cex = 2, 
         col = "green", pch = 20)
  x <- 1:length(result$maxparkfitness)
  
  if (nrow(result) >= 4) {
    lmin <- smooth.spline(x,result$minparkfitness, spar = spar)
    lines(lmin, col = "red", lwd = 1.6)
    lmea <- smooth.spline(x,result$meanparkfitness, spar = spar)
    lines(lmea, col = "blue", lwd = 1.6)
    lmax <- smooth.spline(x,result$maxparkfitness, spar = spar)
    lines(lmax, col = "green", lwd = 1.6)
  }
  
  return()
}


#' @title Plot a heatmap of selected grid cells
#' @name plot_heatmap
#' @description  Plot a heatmap of selected grid cells. Green grid cells
#'   have been selected more often than red grid cells.
#'
#' @export
#'
#' @family Plotting Functions
#' @inheritParams plot_result
#' @param si A numeric value that is used for the sizing of the resolution of
#'   the heatmap. Default is 2
#' @param idistw The inverse distance weighting power. Default is the rotor
#'   radius from the 'result' values
#'
#' @return Invisibly returns a list with the result of the inverse distance
#'   weighting and an aggregated dataframe of all grid cells
#' @examples \donttest{
#' ## Plot the results of a hexagonal grid optimization
#' plot_heatmap(resulthex)
#'
#' ## Plot the heatmap with different settings
#' plot_heatmap(resulthex, si = 4, idistw = 2)
#' }
plot_heatmap <- function(result, si = 2, idistw) {
  if (!requireNamespace("gstat", quietly = TRUE)) {
    stop("The package 'gstat' is required for this function, but it is not installed.\n",
         "Please install it with `install.packages('gstat')`")
  }  
  parheat <- par(ask = FALSE, no.readonly = TRUE)
  on.exit(par(parheat))
  par(mfrow = c(1, 1))
  
  bpe <- do.call("rbind", result[, "allCoords"])
  bpe <- data.frame(bpe[, 1:2])
  row.names(bpe) <- NULL
  
  sizingidw <- as.integer(result[, "inputData"][[1]][, 1]["Rotorradius"])
  sizing <- as.integer(result[, "inputData"][[1]][, 1]["Resolution"]) / si
  
  # dupco <- geoR::dup.coords(bpe, simplify = TRUE)
  dupco <- dup_coords(bpe, simplify = TRUE)
    
  bpe$Ids <- seq.int(nrow(bpe))
  dupco <- lapply(dupco, function(x) as.integer(x))
  dupcosum <- lapply(dupco, function(x) length(x))
  bpenew <- vector("list", length(dupco))
  for (i in 1:length(dupco)) {
    bpenew[[i]] <- bpe[bpe$Ids == dupco[[i]][1], ]
    bpenew[[i]]$Sum <- dupcosum[[i]][1]
  }
  bpenew <- do.call("rbind", bpenew)
  bpenew <- bpenew[-3]
  
  polo <- st_as_sf(bpenew, coords=c("X","Y"))
  
  extra_margin <- 50
  x_range <-   range(bpenew$X)
  y_range <-   range(bpenew$Y)
  grd <- expand.grid(X = seq(from = x_range[1] - extra_margin,
                             to = x_range[2] + extra_margin, by = sizing),
                     Y = seq(from = y_range[1] - extra_margin,
                             to = y_range[2] + extra_margin, by = sizing))
  
  ## convert grid to SpatialPixel class
  grd <- st_as_sf(grd, coords=c("X","Y"))
  grd <- st_make_grid(grd, offset = st_bbox(grd)[c("xmin", "ymin")],
                      cellsize = st_distance(grd[1,], grd[2,])[[1]]) 
  
  if (missing(idistw)) {
    idistw <- sizingidw
  } else {
    idistw <- idistw
  }
  
  ## Calculate IDW
  idwout <- data.frame(gstat::idw(formula = bpenew$Sum ~ 1,
                                  locations = polo, newdata = grd,
                                  idp = idistw))
  
  ## Plot heatmap
  if (!requireNamespace("ggplot2", quietly = TRUE)) {
    warning("The package 'ggplot2' is required to plot the result, but it is not installed.\n",
            "Please install it with `install.packages('ggplot2')`")
  } else {
    var1.pred=X=Y=x=y=NULL
    
    plot1 <- ggplot2::ggplot(data = idwout,
                             mapping = ggplot2::aes(x = x, y = y)) +
      ggplot2::geom_tile(data = idwout, ggplot2::aes(fill = var1.pred),
                         show.legend = TRUE) +
      ggplot2::labs(
        title = "Inverse Distance Weighting for Grid Cell Selection") +
      ggplot2::geom_point(data = bpenew, mapping = ggplot2::aes(x = X, y = Y),
                          show.legend = TRUE, size = 5*bpenew$Sum/max(bpenew$Sum),
                          alpha = 0.6) +
      ggplot2::scale_fill_gradient(low = "red", high = "green") +
      ggplot2::coord_equal()
    
    print(plot1)
  }
  
  invisible(list("idw" = idwout,
                 "GA_grids" = bpenew))
}


#' @title Splits duplicated coords (copy of geoR::dup.coords)
#' @name dup_coords
#' @description This function takes an object with 2-D coordinates and returns
#' the positions of the duplicated coordinates. Also sets a method for
#' duplicated. Helper function for \code{\link{plot_heatmap}}
#'
#' @export
#'
#' @param x Two column numeric matrix or data frame
#' @param ... passed to sapply. If simplify = TRUE (default) results are
#' returned as an array if possible (when the number of replicates are the
#' same at each replicated location)
#' 
#' @family Helper Functions
#' @return Function and methods returns NULL if there are no duplicates 
#' locations. Otherwise, the default method returns a list where each component
#' is a vector with the positions or the rownames, if available, of the
#' duplicates coordinates. The method for geodata returns a data-frame with
#' rownames equals to the positions of the duplicated coordinates, the first
#' column is a factor indicating duplicates and the remaining are output of
#' as.data.frame.geodata.
#' 
#' @author Paulo Justiniano Ribeiro Jr. \email{paulojus@@leg.ufpr.br}
#' Peter J. Diggle \email{p.diggle@@lancaster.ac.uk}
dup_coords <- function(x, ...) {
  ap1 <- unclass(factor(paste("x", x[, 1], "y", x[, 2], sep = "")))
  ap2 <- table(ap1)
  ap2 <- ap2[ap2 > 1]
  takecoords <- function(n){
    if (!is.null(rownames(x))) rownames(x[ap1 == n, ])
  }
  res <- sapply(as.numeric(names(ap2)), takecoords, ...)
  if (!is.null(res)) class(res) <- "duplicated.coords"
  return(res)
}



#' @title Plot the result of a randomized output.
#' @name plot_random_search
#' @description Plotting method for the results of
#'   \code{\link{random_search_single}} and \code{\link{random_search}}.
#'
#' @export
#'
#' @inheritParams plot_result
#' @param resultRS The result of the random functions
#'   \code{\link{random_search_single}} and \code{\link{random_search}}.
#' @param best How many best candidates to plot. Default is 1.
#'
#' @family Randomization
#' @return NULL
#' 
#' @examples \donttest{
#' library(sf)
#' 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
#' ))
#'
#' Res = random_search(result = resultrect, Polygon1 = Polygon1)
#' plot_random_search(resultRS = Res, result = resultrect, Polygon1 = Polygon1, best=2)
#' }
plot_random_search <- function(resultRS, result, Polygon1, best) {
  
  op <- par(no.readonly = TRUE) 
  par(mfrow = c(1, 2))
  
  result_inputs <- result[1,'inputData'][[1]]
  resultRS1 <- do.call("rbind", cbind(resultRS))
  a <- resultRS1[,"EnergyOverall"]
  order1 <- order(a, decreasing = TRUE)
  resultRS1 <- resultRS1[order1, ]
  
  if (missing(best)) best <- 1
  
  # resBest <- resultRS1[!duplicated(resultRS1$Run) & !duplicated(resultRS1$bestGARun),]
  resBest <- resultRS1[!duplicated(resultRS1[, "Run"]),,drop = FALSE]
  if (nrow(resBest) < best) {best <- nrow(resBest)}
  
  resBest <- resBest[1:best,,drop = FALSE]
  # resBest <- resBest[nrow(resBest):(nrow(resBest)-best),]
  
  resultRS2 <- list()
  for (nr in 1:nrow(resBest)) {
    resultRS2[[nr]] <- resultRS1[resultRS1[, "Run"] == resBest[, "Run"][nr] & 
                                   resultRS1[, "bestGARun"] == resBest[, "bestGARun"][nr],]
  }
  resultRS1 <- resultRS2
  
  resultRS1 <- rev(resultRS1)
  resBest <- resBest[order(resBest[,"EnergyOverall"]),,drop=FALSE]
  
  Polygon1 <- isSpatial(Polygon1)
  cellsize <- as.numeric(result_inputs["Resolution",][[1]])
  if (result_inputs["Grid Method",][[1]] == "Rectangular") {
    Grid <- grid_area(Polygon1, size = cellsize,
                      prop = as.numeric(result_inputs["Percentage of Polygon",][[1]]))[[2]]
  } else {
    Grid <- hexa_area(Polygon1, size = cellsize)[[2]]
  }
  rbPal1 <- grDevices::colorRampPalette(c("green","red"))
  col2res <- "lightblue"
  
  for (i in 1:length(resultRS1) ) {
    ## Original GA-result ################
    bestGAR <- resBest[,"bestGARun",drop=F][i]
    bestrestGA <- result[bestGAR,]$bestPaEn
    brOrig <- length(levels(factor(bestrestGA[,"AbschGesamt",drop=F])))
    if (brOrig > 1) {
      ColOri <- rbPal1(brOrig)[as.numeric(cut(as.numeric(bestrestGA[,"AbschGesamt",drop=F]),
                                              breaks = brOrig))]
    } else {
      ColOri <- "green"
    }
    
    bestrestGA[,"EnergyOverall"] <- round(bestrestGA[,"EnergyOverall"], 2)
    bestrestGA[,"EfficAllDir"] <- round(bestrestGA[,"EfficAllDir"], 2)
    raster::plot(Polygon1, col = col2res, 
                 main = paste("Original - Best Energy:", (best + 1) - i, "\n","Energy Output",
                              bestrestGA[,"EnergyOverall"][[1]],"kW", "\n", "Efficiency:",
                              bestrestGA[,"EfficAllDir"][[1]]))
    raster::plot(Grid, add = TRUE)
    graphics::mtext("Total Wake Effect in %", side = 2)
    graphics::points(bestrestGA[,"X"],bestrestGA[,"Y"],
                     cex = 2, pch = 20, col = ColOri)
    graphics::text(bestrestGA[,"X"], bestrestGA[,"Y"],
                   round(bestrestGA[,"AbschGesamt"],0),
                   cex = 0.8, pos = 1, col = "black")
    distpo <- stats::dist(x = cbind(bestrestGA[,"X"], bestrestGA[,"Y"]),
                          method = "euclidian")
    graphics::mtext(paste("minimal Distance", round(min(distpo), 2)),
                    side = 1, line = 0)
    graphics::mtext(paste("mean Distance", round(mean(distpo), 2)),
                    side = 1, line = 1)
    ################
    
    ## Random Search Output  ################
    EnergyBest <- data.frame(resultRS1[[i]])
    ## Assign the colour depending on the individual wind speed 
    br <- length(levels(factor(EnergyBest[,'AbschGesamt'])))
    if (br > 1) {
      Col <- rbPal1(br)[as.numeric(cut(as.numeric(
        EnergyBest[, 'AbschGesamt']), breaks = br))]
    } else {
      Col <- "green"
    }
    
    EnergyBest[,'EnergyOverall'] <- round(EnergyBest[,'EnergyOverall'], 2)
    EnergyBest[,'EfficAllDir'] <- round(EnergyBest[,'EfficAllDir'], 2)
    raster::plot(Polygon1, col = col2res,
                 main = paste("Random Search - Best Energy:", (best + 1) - i, 
                              "\n","Energy Output",
                              EnergyBest[,'EnergyOverall'][[1]],"kW", "\n", "Efficiency:",
                              EnergyBest[,'EfficAllDir'][[1]]))
    
    raster::plot(Grid, add = TRUE)
    graphics::mtext("Total Wake Effect in %", side = 2)
    graphics::points(EnergyBest[,'X'],EnergyBest[,'Y'],
                     cex = 2, pch = 20, col = Col)
    graphics::text(EnergyBest[,'X'], EnergyBest[,'Y'],
                   round(EnergyBest[,'AbschGesamt'], 0),
                   cex = 0.8, pos = 1, col = "black")
    distpo <- stats::dist(x = cbind(EnergyBest[,'X'],EnergyBest[,'Y']),
                          method = "euclidian")
    graphics::mtext(paste("minimal Distance", round(min(distpo), 2)),
                    side = 1, line = 0)
    graphics::mtext(paste("mean Distance", round(mean(distpo), 2)),
                    side = 1, line = 1)
    ################
  }
  
  par(op)
  invisible(NULL)
}

Try the windfarmGA package in your browser

Any scripts or data that you put into this service are public.

windfarmGA documentation built on May 5, 2021, 5:08 p.m.