#' @title Metric graph
#' @description Class representing a general metric graph.
#' @details A graph object created from vertex and edge matrices, or from an
#' `sp::SpatialLines` object where each line is representing and edge. For more
#' details, see the vignette:
#' \code{vignette("metric_graph", package = "MetricGraph")}
#' @return Object of \code{\link[R6]{R6Class}} for creating metric graphs.
#' @examples
#' edge1 <- rbind(c(0, 0), c(2, 0))
#' edge2 <- rbind(c(2, 0), c(1, 1))
#' edge3 <- rbind(c(1, 1), c(0, 0))
#' edges <- list(edge1, edge2, edge3)
#' graph <- metric_graph$new(edges)
#' graph$plot()
#'
#' @export
metric_graph <-  R6Class("metric_graph",
   public = list(
     #' @field V Matrix with positions in Euclidean space of the vertices of the
     #' graph.
     V = NULL,

     #' @field nV The number of vertices.
     nV = 0,

     #' @field E Matrix with the edges of the graph, where each row represents an
     #' edge, `E[i,1]` is the vertex at the start of the ith edge and `E[i,2]` is
     #' the vertex at the end of the edge.
     E = NULL,

     #' @field nE The number of edges.
     nE= 0,

     #' @field edge_lengths Vector with the lengths of the edges in the graph.
     edge_lengths = NULL,

     #' @field C Constraint matrix used to set Kirchhoff constraints.
     C = NULL,

     #' @field CoB Change-of-basis object used for Kirchhoff constraints.
     CoB = NULL,

     #' @field PtV Vector with the indices of the vertices which are observation
     #' locations.
     PtV  = NULL,

     #' @field mesh Mesh object used for plotting.
     mesh = NULL,

     #' @field edges The coordinates of the edges in the graph.
     edges = NULL,

     #' @field DirectionalWeightFunction_in Function for inwards weights in
     #' directional models
     DirectionalWeightFunction_in  =NULL,
     #' @field DirectionalWeightFunction_out Function for outwards weights in
     #' directional models
     DirectionalWeightFunction_out  = NULL,

     #' @field vertices The coordinates of the vertices in the graph, along with
     #' several attributes.
     vertices = NULL,


     #' @field geo_dist Geodesic distances between the vertices in the graph.
     geo_dist = NULL,

     #' @field res_dist Resistance distances between the observation locations.
     res_dist = NULL,

     #' @field Laplacian The weighted graph Laplacian of the vertices in the
     #' graph. The weights are given by the edge lengths.
     Laplacian = NULL,

     #' @field characteristics List with various characteristics of the graph.
     characteristics = NULL,

     #' @description Create a new `metric_graph` object.
     #' @param edges A list containing coordinates as `m x 2` matrices (that is,
     #' of `matrix` type) or m x 2 data frames (`data.frame` type) of sequence of
     #' points connected by straightlines. Alternatively, you can also prove an
     #' object of type `SSN`, `osmdata_sp`, `osmdata_sf`, `SpatialLinesDataFrame`
     #' or `SpatialLines` (from `sp` package) or `MULTILINESTRING` (from `sf` package).
     #' @param V n x 2 matrix with Euclidean coordinates of the n vertices.
     #' If non-NULL, no merges will be performed.
     #' @param E m x 2 matrix where each row represents one of the m edges.
     #' If non-NULL, no merges will be performed.
     #' @param vertex_unit The unit in which the vertices are specified.
     #' The options are 'degree' (the great circle distance in km), 'km', 'm'
     #' and 'miles'. The default is `NULL`, which means no unit. However, if you
     #' set `length_unit`, you need to set `vertex_unit`.
     #' @param length_unit The unit in which the lengths will be computed.
     #' The options are 'km', 'm' and 'miles'. The default, when longlat is `TRUE`,
     #' or an `sf` or `sp` objects are provided, is 'km'.
     #' @param edge_weights Either a number, a numerical vector with length given by
     #' the number of edges, providing the edge weights, or a `data.frame` with the
     #' number of rows being equal to the number of edges, where
     #' each row gives a vector of weights to its corresponding edge. Can be changed
     #' by using the `set_edge_weights()` method.
     #' @param kirchhoff_weights If non-null, the name (or number) of the column of
     #' `edge_weights` that contain the Kirchhoff weights. Must be equal to 1 (or `TRUE`)
     #' in case `edge_weights` is a single number and those are the Kirchhoff weights.
     #' @param directional_weights If non-null, the name (or number) of the column of
     #' `edge_weights` that contain the directional weights. The default is the
     #' first column of the edge weights.
     #' @param longlat There are three options: `NULL`, `TRUE` or `FALSE`. If `NULL`
     #' (the default option), the `edges` argument will be checked to see if there
     #' is a CRS or proj4string available, if so, `longlat` will be set to `TRUE`,
     #' otherwise, it will be set to `FALSE`. If `TRUE`, then it is assumed that the
     #' coordinates are given.
     #' in Longitude/Latitude and that distances should be computed in meters. If `TRUE`
     #' it takes precedence over
     #' `vertex_unit` and `length_unit`, and is equivalent to `vertex_unit = 'degree'`
     #' and `length_unit = 'm'`.
     #' @param include_obs If the object is of class `SSN`, should the observations
     #' be added? If `NULL` and the edges are of class `SSN`, the data will be
     #' automatically added. If `FALSE`, the data will not be added. Alternatively,
     #' one can set this argument to the numbers or names of the columns of the
     #' observations to be added as observations.
     #' @param add_obs_options List containing additional options to be passed to
     #' the `add_observations()` method when adding observations from `SSN` data?
     #' @param include_edge_weights If the object is of class `SSN`, `osmdata_sp`,
     #' `osmdata_sf`, `SpatialLinesDataFrame`, `MULTILINESTRING`, `LINESTRING`,
     #' `sfc_LINESTRING`, `sfc_MULTILINESTRING`, should the edge data (if any) be
     #' added as edge weights? If `NULL`, the edge data will be added as edge weights,
     #' if `FALSE` they will not be added. Alternatively, one can set this argument
     #' to the numbers or names of the columns of the edge data to be added as edge
     #' weights.
     #' @param crs Coordinate reference system to be used in case `longlat` is set
     #' to `TRUE` and `which_longlat` is `sf`. Object of class crs. The default
     #' choice, if the `edges` object does not have CRS nor proj4string, is `sf::st_crs(4326)`.
     #' @param proj4string Projection string of class CRS-class to be used in
     #' case `longlat` is set to `TRUE` and `which_longlat` is `sp`. The default
     #' choice, if the `edges` object does not have CRS nor proj4string, is
     #' `sp::CRS("+proj=longlat +datum=WGS84")`.
     #' @param which_longlat Compute the distance using which package? The options
     #' are `sp` and `sf`. The default is `sp`.
     #' @param project If `longlat` is `TRUE` should a projection be used to
     #' compute the distances to be used for the tolerances (see `tolerance` below)?
     #' The default is `FALSE`. When `TRUE`, the construction of the graph is faster.
     #' @param project_data If `longlat` is `TRUE` should the vertices be project
     #' to planar coordinates? The default is `FALSE`. When `TRUE`, the construction
     #' of the graph is faster.
     #' @param which_projection Which projection should be used in case `project`
     #' is `TRUE`? The options are `Robinson`, `Winkel tripel` or a proj4string.
     #' The default is `Winkel tripel`.
     #' @param manual_edge_lengths If non-NULL, a vector containing the edges
     #' lengths, and all the quantities related to edge lengths will be computed
     #' in terms of these. If merges are performed, it is likely that the merges
     #' will override the manual edge lengths. In such a case, to provide manual
     #' edge lengths, one should either set the `perform_merges` argument to `FALSE`
     #' or use the `set_manual_edge_lengths()` method.
     #' @param perform_merges There are three options, `NULL`, `TRUE` or `FALSE`.
     #' The default option is `NULL`. If `NULL`, it will be set to `FALSE` unless
     #' 'edges', 'V' and 'E' are `NULL`, in which case it will be set to `TRUE`.
     #' If FALSE, this will take priority over the other arguments, and no merges
     #' (except the optional `merge_close_vertices` below) will be performed.
     #' Note that the merge on the additional `merge_close_vertices` might still
     #' be performed, if it is set to `TRUE`.
     #' @param approx_edge_PtE Should the relative positions on the edges be
     #' approximated? The default is `TRUE`. If `FALSE`, the speed can be considerably
     #' slower, especially for large metric graphs.
     #' @param tolerance List that provides tolerances during the construction
     #' of the graph:
     #' - `vertex_vertex` Vertices that are closer than this number are merged (default = 1e-7).
     #' - `vertex_edge` If a vertex at the end of one edge is closer than this
     #' number to another edge, this vertex is connected to that edge
     #' (default = 1e-7). Previously `vertex_line`, which is now deprecated.
     #' - `edge_edge` If two edges at some point are closer than this number, a new
     #' vertex is added at that point and the two edges are connected (default = 0).
     #' - `vertex_line`, Deprecated. Use `vertex_edge` instead.
     #' - `line_line`, Deprecated. Use `edge_edge` instead.
     #'
     #' In case `longlat = TRUE`, the tolerances are given in `length_unit`.
     #' @param check_connected If `TRUE`, it is checked whether the graph is
     #' connected and a warning is given if this is not the case.
     #' @param remove_deg2 Set to `TRUE` to remove all vertices of degree 2 in the
     #' initialization. Default is `FALSE`.
     #' @param merge_close_vertices Should an additional step to merge close vertices
     #' be done? The options are `NULL` (the default), `TRUE` or `FALSE`. If `NULL`,
     #' it will be determined automatically. If `TRUE` this step will be performed
     #' even if `perfom_merges` is set to `FALSE`.
     #' @param factor_merge_close_vertices Which factor to be multiplied by tolerance
     #' `vertex_vertex` when merging close vertices at the additional step?
     #' @param remove_circles All circlular edges with a length smaller than this
     #' number are removed. If `TRUE`, the `vertex_vertex` tolerance will be used.
     #' If `FALSE`, no circles will be removed.
     #' @param auto_remove_point_edges Should edges of length zero, that is, edges
     #' that are actually points, be automatically removed?
     #' @param verbose Print progress of graph creation. There are 3 levels of
     #' verbose, level 0, 1 and 2. In level 0, no messages are printed. In level 1,
     #' only messages regarding important steps are printed. Finally, in level 2,
     #' messages detailing all the steps are printed. The default is 1.
     #' @param lines `r lifecycle::badge("deprecated")` Use `edges` instead.
     #' @param .assemble Expert option for assembling the graph by skipping the
     #' entire constructor pipeline and instead populate the R6 object directly
     #' from a pre-computed list. Intended for internal use.
     #' @details A graph object can be initialized in two ways. The first method
     #' is to specify V and E. In this case, all edges are assumed to be straight
     #' lines. The second option is to specify the graph via the `lines` input.
     #' In this case, the vertices are set by the end points of the lines.
     #' Thus, if two lines are intersecting somewhere else, this will not be
     #' viewed as a vertex.
     #' @return A `metric_graph` object.
     initialize = function(edges = NULL,
                           V = NULL,
                           E = NULL,
                           vertex_unit = NULL,
                           length_unit = NULL,
                           edge_weights = NULL,
                           kirchhoff_weights = NULL,
                           directional_weights = NULL,
                           longlat = NULL,
                           crs = NULL,
                           proj4string = NULL,
                           which_longlat = "sp",
                           include_obs = NULL,
                           include_edge_weights = NULL,
                           project = FALSE,
                           project_data = FALSE,
                           which_projection = "Winkel tripel",
                           manual_edge_lengths = NULL,
                           perform_merges = NULL,
                           approx_edge_PtE = TRUE,
                           tolerance = list(vertex_vertex = 1e-3,
                                            vertex_edge = 1e-3,
                                            edge_edge = 0),
                           check_connected = TRUE,
                           remove_deg2 = FALSE,
                           merge_close_vertices = NULL,
                           factor_merge_close_vertices = 1,
                           remove_circles = FALSE,
                           auto_remove_point_edges = TRUE,
                           verbose = 1,
                           add_obs_options = list(return_removed = FALSE,
                                                  verbose = verbose),
                           lines = deprecated(),
                           .assemble = NULL) {

       if (!is.null(.assemble)) {
         pub  <- .assemble$public
         priv <- .assemble$private
         if (!is.null(pub)) {
           for (nm in names(pub)) {
             assign(nm, pub[[nm]], envir = self)
           }
         }
         if (!is.null(priv)) {
           for (nm in names(priv)) {
             assign(nm, priv[[nm]], envir = private)
           }
         }
         private$compute_component_membership()
         return(invisible(self))
       }

       start_construction_time <- Sys.time()

       add_data_tmp <- FALSE

       private$project_data <- project_data

       if(is.null(merge_close_vertices)){
         merge_close_vertices <- TRUE
       }

       if(inherits(edges, "SSN")){
         if(is.null(include_obs) || include_obs[[1]] == TRUE){
           dataset_tmp <- edges$obs
           add_data_tmp <- TRUE
         } else if(is.numeric(include_obs) || is.character(include_obs)){
           dataset_tmp <- edges$obs[,include_obs]
           add_data_tmp <- TRUE
         } else if(!is.logical(include_obs[[1]])){
           stop("invalid option passed to include_obs.")
         }
         edges <- edges$edges
         if(is.null(include_edge_weights) || include_edge_weights[[1]] == TRUE){
           edge_weights <- sf::st_drop_geometry(edges)
         } else if(is.numeric(include_edge_weights) || is.character(include_edge_weights)){
           edge_weights <- sf::st_drop_geometry(edges)
           edge_weights <- edge_weights[,include_edge_weights]
         } else if(!is.logical(include_edge_weights[[1]])){
           stop("invalid option passed to include_edge_weights.")
         }
       }

       if(inherits(edges, c("osmdata_sp", "osmdata_sf"))){
         edges <- edges$osm_lines
         if(is.null(include_edge_weights) || include_edge_weights[[1]] == TRUE){
           if(inherits(edges, "osmdata_sp")){
             edge_weights <- edges@data
           } else{
             edge_weights <- sf::st_drop_geometry(edges)
           }
         } else if(is.numeric(include_edge_weights) || is.character(include_edge_weights)){
           if(inherits(edges, "osmdata_sp")){
             edge_weights <- edges@data
           } else{
             edge_weights <- sf::st_drop_geometry(edges)
           }
           edge_weights <- edge_weights[,include_edge_weights]
         } else if(!is.logical(include_edge_weights[[1]])){
           stop("invalid option passed to include_edge_weights.")
         }
       }

       if (inherits(edges,"SpatialLines") || inherits(edges,"SpatialLinesDataFrame")) {
         if(is.null(longlat) || longlat){
           if(!is.na(sp::proj4string(edges))){
             longlat <- TRUE
             if(is.null(proj4string) && is.null(crs)){
               proj4string <- sp::proj4string(edges)
               crs_tmp <- sf::st_crs(proj4string, parameters = TRUE)
               if(is.null(vertex_unit)){
                 vertex_unit <- crs_tmp$units_gdal
                 if(vertex_unit == "metre"){
                   vertex_unit <- "m"
                 } else if(vertex_unit == "kilometre"){
                   vertex_unit <- "km"
                 }
               }
             }
             if(is.null(length_unit)){
               length_unit <- "km"
             }
           } else{
             longlat <- FALSE
           }
         }
         if(inherits(edges,"SpatialLinesDataFrame")){
           if(is.null(include_edge_weights) || include_edge_weights[[1]] == TRUE){
             edge_weights <- edges@data
           } else if(is.numeric(include_edge_weights) || is.character(include_edge_weights)){
             edge_weights <- edges@data
             edge_weights <- edge_weights[,include_edge_weights]
           } else if(!is.logical(include_edge_weights[[1]])){
             stop("invalid option passed to include_edge_weights.")
           }
         }
       } else if(inherits(edges, c("MULTILINESTRING", "LINESTRING", "sfc_LINESTRING",
                                   "sfc_MULTILINESTRING", "sf"))){
         if(is.null(longlat) || longlat){
           if(!is.na(sf::st_crs(edges))){
             longlat <- TRUE
             if(is.null(proj4string) && is.null(crs)){
               crs <- sf::st_crs(edges)
               crs_tmp <- sf::st_crs(edges, parameters = TRUE)
               if(is.null(vertex_unit)){
                 vertex_unit <- crs_tmp$units_gdal
                 if(vertex_unit == "metre"){
                   vertex_unit <- "m"
                 } else if(vertex_unit == "kilometre"){
                   vertex_unit <- "km"
                 }
               }
             }
             if(is.null(length_unit)){
               length_unit <- "km"
             }
           } else{
             longlat <- FALSE
           }
         }

         if(inherits(edges, "data.frame")){
           if(is.null(include_edge_weights) || include_edge_weights[[1]] == TRUE){
             edge_weights <- sf::st_drop_geometry(edges)
           } else if(is.numeric(include_edge_weights) || is.character(include_edge_weights)){
             edge_weights <- sf::st_drop_geometry(edges)
             edge_weights <- edge_weights[,include_edge_weights]
           } else if(!is.logical(include_edge_weights[[1]])){
             stop("invalid option passed to include_edge_weights.")
           }

         }


       } else{
         if(is.null(longlat)){
           longlat <- FALSE
         }
       }

       if (lifecycle::is_present(lines)) {
         if (is.null(edges)) {
           lifecycle::deprecate_warn("1.2.0", "metric_graph$new(lines)",
                                     "metric_graph$new(edges)",
                                     details = c("`lines` was provided but not `edges`. Setting `edges <- lines`.")
           )
           edges <- lines
         } else {
           lifecycle::deprecate_warn("1.2.0", "metric_graph$new(lines)",
                                     "metric_graph$new(edges)",
                                     details = c("Both `edges` and `lines` were provided. Only `edges` will be considered.")
           )
         }
         lines <- NULL
       }

       if(is.null(edge_weights)){
         edge_weights <- 1
       }

       if(!is.null(kirchhoff_weights)){
         if(length(kirchhoff_weights)>1){
           warning("Only the first entry of 'kirchhoff_weights' was used.")
           kirchhoff_weights <- kirchhoff_weights[[1]]
         }
         if(!is.numeric(kirchhoff_weights)){
           if(!is.character(kirchhoff_weights)){
             stop("'kirchhoff_weights' must be either a number of a string.")
           }
           if(!(kirchhoff_weights%in%colnames(edge_weights))){
             stop(paste(kirchhoff_weights, "is not a column of 'edge_weights'!"))
           }
         } else{
           if(!is.data.frame(edge_weights)){
             if(kirchhoff_weights != 1){
               stop("Since 'edge_weights' is not a data.frame, 'kirchhoff_weights' must be either NULL or 1.")
             }
           } else{
             if(kirchhoff_weights %%1 != 0){
               stop("'kirchhoff_weights' must be an integer.")
             }
             if((kirchhoff_weights < 1) || (kirchhoff_weights > ncol(edge_weights))){
               stop("'kirchhoff_weights' must be a positive integer number smaller or equal to the number of columns of 'edge_weights'.")
             }
           }
         }
         private$kirchhoff_weights <- kirchhoff_weights
       } else{
         if(is.vector(edge_weights)){
           private$kirchhoff_weights <- 1
         } else{
           if(".weights" %in% colnames(edge_weights)){
             private$kirchhoff_weights <- ".weights"
           } else{
             edge_weights[, ".weights"] <- 1
             private$kirchhoff_weights <- ".weights"
           }
         }
       }



       if(!is.null(directional_weights)){
         if(!is.numeric(directional_weights)){
           if(!is.character(directional_weights)){
             stop("'directional_weights' must be either a numerical vector of a string vector.")
           }
           if(!(directional_weights%in%colnames(edge_weights))){
             stop(paste(directional_weights, "is not a column of 'weights'!"))
           }
         } else{
           if(!is.data.frame(edge_weights)){
             if(directional_weights != 1){
               stop("Since 'weights' is not a data.frame, 'directional_weights' must be either NULL or 1.")
             }
           } else{
             if(directional_weights %%1 != 0){
               stop("'directional_weights' must be an integer.")
             }
             if((directional_weights < 1) || (directional_weights > ncol(edge_weights))){
               stop("'directional_weights' must be a positive integer number smaller or equal to the number of columns of 'weights'.")
             }
           }
         }
         private$directional_weights <- directional_weights
       } else{
         if(is.vector(edge_weights)){
           private$directional_weights <- 1
         } else{
           if(".weights" %in% colnames(edge_weights)){
             private$directional_weights <- ".weights"
           } else{
             edge_weights[, ".weights"] <- 1
             private$directional_weights <- ".weights"
           }
         }
       }


       if (is.null(tolerance$vertex_edge) && !is.null(tolerance$vertex_line)) {
         lifecycle::deprecate_warn("1.2.0", "metric_graph$new(tolerance = 'must contain either vertex_vertex, vertex_edge or edge_edge')",
                                   details = c("`tolerance$vertex_line` was provided but not `tolerance$vertex_edge`. Setting `tolerance$vertex_edge <- tolerance$vertex_line`.")
         )
         tolerance$vertex_edge <- tolerance$vertex_line
         tolerance$vertex_line <- NULL
       } else if(!is.null(tolerance$vertex_edge) && !is.null(tolerance$vertex_line)) {
         lifecycle::deprecate_warn("1.2.0","metric_graph$new(tolerance = 'must contain either vertex_vertex, vertex_edge or edge_edge')",
                                   details = c("Both `tolerance$vertex_edge` and `tolerance$vertex_line` were provided. Only `tolerance$vertex_edge` will be considered.")
         )
         tolerance$vertex_line <- NULL
       }

       if (is.null(tolerance$edge_edge) && !is.null(tolerance$line_line)) {
         lifecycle::deprecate_warn("1.2.0", "metric_graph$new(tolerance = 'must contain either vertex_vertex, vertex_edge or edge_edge')",
                                   details = c("`tolerance$line_line` was provided but not `tolerance$edge_edge`. Setting `tolerance$edge_edge <- tolerance$line_line`.")
         )
         tolerance$edge_edge <- tolerance$line_line
         tolerance$line_line <- NULL
       } else if(!is.null(tolerance$edge_edge) && !is.null(tolerance$line_line)) {
         lifecycle::deprecate_warn("1.2.0","metric_graph$new(tolerance = 'must contain either vertex_vertex, vertex_edge or edge_edge')",
                                   details = c("Both `tolerance$edge_edge` and `tolerance$line_line` were provided. Only `tolerance$edge_edge` will be considered.")
         )
         tolerance$line_line <- NULL
       }

       valid_units_vertex <- c("m", "km", "miles", "degree")
       valid_units_length <- c("m", "km", "miles")

       if(!(which_longlat %in% c("sp", "sf"))){
         stop("The options for 'which_longlat' are 'sp' and 'sf'!")
       }

       if(longlat){
         private$longlat <- TRUE
         private$which_longlat <- which_longlat
       }

       if(!is.null(proj4string)){
         if(!longlat){
           warning("proj4string was passed, so setting longlat to TRUE")
           longlat <- TRUE
           private$longlat <- TRUE
           private$which_longlat <- which_longlat
         }
         private$crs <- sf::st_crs(proj4string)
         private$proj4string <- proj4string
         crs <- private$crs
         private$transform <- !(sf::st_is_longlat(private$crs))
       }

       if(!is.null(crs)){
         if(!longlat){
           warning("crs was passed, so setting longlat to TRUE")
           longlat <- TRUE
           private$longlat <- TRUE
           private$which_longlat <- which_longlat
         }
         private$crs <- sf::st_crs(crs)
         private$proj4string <- sp::CRS(private$crs$proj4string)
         proj4string <- private$proj4string
         private$transform <- !(sf::st_is_longlat(private$crs))
       }

       if(longlat && (which_longlat == "sp") && is.null(proj4string)){
         proj4string <- sp::CRS("+proj=longlat +datum=WGS84")
         private$crs <- sf::st_crs(proj4string)
         private$proj4string <- proj4string
         private$transform <- !(sf::st_is_longlat(private$crs))
       }

       if(longlat && (which_longlat == "sf") && is.null(crs)){
         crs <- sf::st_crs(4326)
         private$crs <- crs
         private$transform <- !(sf::st_is_longlat(private$crs))
       }

       # private$longlat <- longlat

       if((is.null(vertex_unit) && !is.null(length_unit)) || (is.null(length_unit) && !is.null(vertex_unit))){
         stop("If one of 'vertex_unit' or 'length_unit' is NULL, and the edges are not sf nor sp objects, then the other must also be NULL.")
       }

       if(!is.null(vertex_unit)){
         vertex_unit <- vertex_unit[[1]]
         if(!is.character(vertex_unit)){
           stop("'vertex_unit' must be a string!")
         }
         if(!(vertex_unit %in% valid_units_vertex)){
           stop(paste("The possible options for 'vertex_unit' are ",
                      toString(valid_units_vertex)))
         }
         private$vertex_unit <- vertex_unit
       }

       if(!is.null(length_unit)){
         length_unit <- length_unit[[1]]
         if(!is.character(length_unit)){
           stop("'length_unit' must be a string!")
         }
         if(length_unit == "degree"){
           length_unit <- "km"
         }
         if(!(length_unit %in% valid_units_length)){
           stop(paste("The possible options for 'length_unit' are ",
                      toString(valid_units_length)))
         }
         private$length_unit <- length_unit
       }

       if(longlat){
         private$vertex_unit <- vertex_unit
         if(is.null(vertex_unit)){
           private$vertex_unit <- "degree"
         }
         if(!is.null(length_unit)){
           private$length_unit <- length_unit
         } else{
           private$length_unit <- "km"
         }
       } else if(!is.null(vertex_unit)){
         if(private$vertex_unit == "degree"){
           longlat <- TRUE
           private$longlat <- TRUE
         }
       }

       if(is.null(edges) && is.null(V) && is.null(E)) {
         edges <- logo_lines()
         if(is.null(perform_merges)){
           perform_merges <- TRUE
           remove_circles <- TRUE
         }
       }

       if(!is.null(manual_edge_lengths)){
         if(is.null(perform_merges)){
           perform_merges <- FALSE
         }
       } else{
         if(is.null(perform_merges)){
           perform_merges <- FALSE
         }
       }

       factor_unit <- process_factor_unit(private$vertex_unit, private$length_unit)

       tolerance_default = list(vertex_vertex = 1e-7,
                                vertex_edge = 1e-7,
                                edge_edge = 0)



       for(i in 1:length(tolerance_default)){
         if(!(names(tolerance_default)[i] %in% names(tolerance))){
           tolerance[names(tolerance_default)[i]] <- tolerance_default[i]
         }
       }

       if(verbose > 0){
         message("Starting graph creation...")
         message(paste("LongLat is set to",longlat))
         if(longlat){
           message(paste("The unit for edge lengths is", private$length_unit))
           if(perform_merges){
             message(paste0("The current tolerances (in ",private$length_unit,") are:"))
             message(paste("\t Vertex-Vertex", tolerance$vertex_vertex))
             message(paste("\t Vertex-Edge", tolerance$vertex_edge))
             message(paste("\t Edge-Edge", tolerance$edge_edge))
           }
         } else if (perform_merges){
           message("The current tolerances are:")
           message(paste("\t Vertex-Vertex", tolerance$vertex_vertex))
           message(paste("\t Vertex-Edge", tolerance$vertex_edge))
           message(paste("\t Edge-Edge", tolerance$edge_edge))
         }
       }

       if(is.null(tolerance$buffer_edge_edge)){
         tolerance$buffer_edge_edge <- max(tolerance$edge_edge/2 - 1e-10,0)
       }
       max_tol <- max(c(tolerance$vertex_vertex,
                        tolerance$vertex_edge,
                        tolerance$edge_edge))

       private$tolerance <- tolerance

       PtE_tmp_edge_edge <- NULL
       PtE_tmp_edge_vertex <- NULL


       if(!(perform_merges %in% c(TRUE,FALSE))){
         stop("perform_merges should be either TRUE or FALSE.")
       }

       private$perform_merges <- perform_merges

       if(verbose > 0){
         message("Creating edges...")
       }

       if(!is.null(edges)){
         if(!is.null(V) || !is.null(E)){
           warning("object initialized from edges, then E and V are ignored")
         }
         if (inherits(edges,"SpatialLinesDataFrame")) {
           tmp_lines = sp::SpatialLines(edges@lines)
           self$edges <- lapply(1:length(tmp_lines), function(i){tmp_lines@lines[[i]]@Lines[[1]]@coords})
         } else if (inherits(edges,"SpatialLines")) {
           self$edges = lapply(1:length(edges), function(i){edges@lines[[i]]@Lines[[1]]@coords})
         } else if (inherits(edges, c("MULTILINESTRING", "LINESTRING",
                                      "sfc_LINESTRING", "sfc_MULTILINESTRING", "sf"))) {
           # Ensure 'edges' is an 'sf' object if it is not already
           if (!inherits(edges, "sf")) {
             # Convert to 'sfc' (simple feature geometry list column)
             edges <- sf::st_sfc(edges)
             edges <- sf::st_sf(geometry = edges)  # Wrap in an 'sf' data frame
           }

           # Define valid geometry types for filtering
           valid_types <- c("LINESTRING", "MULTILINESTRING")

           # Filter for valid geometry types in 'edges'
           valid_indices <- sf::st_geometry_type(edges) %in% valid_types
           valid_edges <- edges[valid_indices, , drop = FALSE]  # Filter only valid geometries

           # Extract coordinates for the valid edges
           coords_multilinestring <- sf::st_coordinates(sf::st_geometry(valid_edges))

           split_coords <- split(coords_multilinestring[, 1:2, drop = FALSE],
                                 coords_multilinestring[, "L1"])
           self$edges <- lapply(split_coords, function(coords) matrix(coords,
                                                                      ncol=2,
                                                                      byrow=FALSE))
         } else if(is.list(edges)){
           self$edges <- check_lines_input(edges)
         } else {
           stop("edges should either be a list, or of class MULTILINESTRING, SpatialLines or SpatialLinesDataFrame")
         }

       } else {
         if(is.null(V) || is.null(E)){
           stop("You must supply edges or V and E")
         }
         if(ncol(V)!=2 || ncol(E)!=2){
           stop("V and E must have two columns!")
         }
         edges <- list()
         for(i in 1:dim(E)[1]) {
           edges[[i]] <- rbind(V[E[i,1], ], V[E[i,2], ])
         }
         self$edges <- edges
         self$E <- E
         self$V <- V
         private$perform_merges <- FALSE
       }

       self$edges <- lapply(self$edges, function(x) if(nrow(x) < 2) NULL else x)

       self$nE <- length(self$edges)

       if(verbose > 0){
         message("Setting edge weights...")
       }

       private$set_first_weights(weights = edge_weights)


       if(verbose > 0){
         message("Computing bounding box...")
       }
       private$compute_bounding_box()

       if(!is.null(manual_edge_lengths)){
         self$set_manual_edge_lengths(edge_lengths = manual_edge_lengths,
                                      unit = length_unit)
       }

       if(private$perform_merges){

         if(verbose > 0){
           message("Setup edges and merge close vertices")
         }

         if(!is.null(manual_edge_lengths)){
           warning("Since 'perform_merges' is TRUE, the manual edge lengths will not be used. Either set 'perform_merges' to FALSE or use the 'set_manual_edge_lengths()' method on the graph after the graph construction.")
         }

         t <- system.time(
           private$line_to_vertex(tolerance = tolerance$vertex_vertex,
                                  longlat = private$longlat,
                                  factor_unit, verbose=verbose,
                                  private$crs,
                                  private$proj4string,
                                  which_longlat,
                                  private$length_unit,
                                  private$vertex_unit,
                                  project,
                                  which_projection,
                                  project_data)
         )

         if(verbose == 2){
           message(sprintf("time: %.3f s", t[["elapsed"]]))
         }

         # The first compute_PtE_edges call is only needed if split_edge will
         # be invoked between here and the unconditional second call ~270 lines
         # below. split_edge reads attr(edge, "PtE"), and is only triggered
         # from private$add_vertices, which is only called from the
         # tolerance$edge_edge > 0 or tolerance$vertex_edge > 0 branches.
         # Skipping it when neither applies saves a full edge sweep on the
         # large-graph hot path.
         if (tolerance$edge_edge > 0 || tolerance$vertex_edge > 0) {
           self$compute_PtE_edges(approx = approx_edge_PtE, verbose=verbose)
         }

         if(length(self$edges) > 1){

           if (tolerance$edge_edge > 0) {
             private$addinfo <- TRUE

             if(verbose > 0){
               message("Find edge-edge intersections")
             }

             t <- system.time(
               points_add <- private$find_edge_edge_points(tol = tolerance$edge_edge,
                                                           verbose=verbose,
                                                           crs=private$crs,
                                                           proj4string = private$proj4string,
                                                           longlat=private$longlat,
                                                           fact = factor_unit,
                                                           which_longlat = which_longlat)
             )

             if(verbose == 2){
               message(sprintf("time: %.3f s", t[["elapsed"]]))
             }

             PtE <- points_add$PtE

             PtE[,2] <- PtE[,2]/self$edge_lengths[PtE[,1]]

             filter_tol <- ((PtE[,2] > max_tol/self$edge_lengths[PtE[,1]]) &
                              (PtE[,2] < 1- max_tol/self$edge_lengths[PtE[,1]]))

             PtE <- PtE[filter_tol,]

             if(!is.null(PtE)){
               if(nrow(PtE) == 0){
                 PtE <- NULL
               }
             }

             if(!is.null(PtE)){
               if(verbose == 2){
                 message(sprintf("Add %d new vertices", nrow(PtE)))
               }

               PtE <- na.omit(PtE)

               t <- system.time(
                 private$add_vertices(PtE, tolerance = tolerance$edge_edge,
                                      verbose = verbose)
               )

               if(verbose == 2){
                 message(sprintf("time: %.3f s", t[["elapsed"]]))
               }
             }

             private$clear_initial_info()
           }

           if(tolerance$vertex_edge > 0){
             private$addinfo <- TRUE
             if(verbose > 0){
               message("Snap vertices to close edges")
             }

             t <- system.time(
               PtE_tmp <- private$coordinates_multiple_snaps(XY = self$V,
                                                             tolerance = tolerance$vertex_edge,
                                                             verbose = verbose,
                                                             crs=private$crs,
                                                             proj4string = private$proj4string,
                                                             longlat=private$longlat,
                                                             fact = factor_unit,
                                                             which_longlat = which_longlat)
             )

             if(verbose == 2){
               message(sprintf("time: %.3f s", t[["elapsed"]]))
             }
             edge_length_filter <- self$edge_lengths[PtE_tmp[,1]]

             filter_tol <- ((PtE_tmp[,2] > max_tol/edge_length_filter) &
                              (PtE_tmp[,2] < 1- max_tol/edge_length_filter))

             PtE_tmp <- PtE_tmp[filter_tol,,drop = FALSE]
             PtE_tmp <- unique(PtE_tmp)
             PtE_tmp <- PtE_tmp[order(PtE_tmp[,1], PtE_tmp[,2]),,drop = FALSE]

             if(!is.null(PtE_tmp)){
               if(nrow(PtE_tmp) == 0){
                 PtE_tmp <- NULL
               }
             }

             if(!is.null(PtE_tmp)){
               if(verbose == 2){
                 message(sprintf("Add %d new vertices", nrow(PtE_tmp)))
               }

               PtE_tmp <- na.omit(PtE_tmp)

               t <- system.time(
                 private$add_vertices(PtE_tmp, tolerance = tolerance$vertex_edge,
                                      verbose=verbose)
               )

               if(verbose == 2){
                 message(sprintf("time: %.3f s", t[["elapsed"]]))
               }
             }
             private$clear_initial_info()
           }

           if(merge_close_vertices){
             private$merge_close_vertices(factor_merge_close_vertices * tolerance$vertex_vertex,
                                          factor_unit)
           }

           if(auto_remove_point_edges){
             private$remove_circles(1e-15, verbose=verbose,longlat = private$longlat,
                                    unit=length_unit, crs=private$crs,
                                    proj4string=private$proj4string,
                                    which_longlat=which_longlat,
                                    vertex_unit=vertex_unit, project_data)
           }

           if(is.logical(remove_circles)){
             if(remove_circles){
               private$remove_circles(tolerance$vertex_vertex, verbose=verbose,
                                      longlat = private$longlat, unit=length_unit,
                                      crs=private$crs, proj4string=private$proj4string,
                                      which_longlat=which_longlat,
                                      vertex_unit=vertex_unit, project_data)
             }
           } else {
             private$remove_circles(remove_circles, verbose = verbose,
                                    longlat = private$longlat, unit = length_unit,
                                    crs=private$crs, proj4string = private$proj4string,
                                    which_longlat=which_longlat,
                                    vertex_unit=vertex_unit, project_data)
             remove_circles <- TRUE
           }


           if(merge_close_vertices || remove_circles){
             if(verbose == 2){
               message("Recomputing edge lengths")
             }
             t <- system.time({
               self$edge_lengths <- private$compute_lengths(private$longlat,
                                                            private$length_unit,
                                                            private$crs,
                                                            private$proj4string,
                                                            private$which_longlat,
                                                            private$vertex_unit,
                                                            project_data,private$transform)
             })
             if(verbose == 2){
               message(sprintf("time: %.3f s", t[["elapsed"]]))
             }
           }
           # End of cond of having more than 1 edge
         }

         # Cleaning the edges

         if(verbose == 2){
           message("Post-processing the edges")
         }

         t <- system.time({
           self$edges <- postprocess_edges_cpp(self$edges)
         })

         if(verbose == 2){
           message(sprintf("time: %.3f s", t[["elapsed"]]))
         }

         # Checking if there is some edge with infinite length
         if(any(!is.finite(self$edge_lengths))){
           warning("There is at least one edge of infinite length. Please, consider redefining the graph.")
         }

         # end of if do merges
       } else{

         if (verbose > 0) {
           message("Setting up edges")
         }

         # Extract the start and end vertices of all edges at once
         edges_vertices <- do.call(rbind, lapply(self$edges, function(edge) {
           edge[c(1, nrow(edge)), ]
         }))

         # Round the vertex coordinates and ensure uniqueness
         self$V <- unique(round(edges_vertices * 10^15) / 10^15)
         self$nV <- nrow(self$V)

         lvl <- matrix(0, nrow = length(self$edges), ncol = 2)

         # Collect all points and split them into start and end points
         all_points <- do.call(rbind, self$edges)
         n_points <- sapply(self$edges, nrow)

         # Split all points into start and end points
         start_indices <- cumsum(c(1, n_points[-length(n_points)]))
         end_indices <- cumsum(n_points)
         start_points <- all_points[start_indices, , drop = FALSE]
         end_points <- all_points[end_indices, , drop = FALSE]

         # Use RANN for efficient nearest-neighbor search
         nn_start <- nn2(self$V, start_points, k = 1)
         nn_end <- nn2(self$V, end_points, k = 1)

         # Extract the indices of the closest vertices
         lvl[, 1] <- nn_start$nn.idx
         lvl[, 2] <- nn_end$nn.idx

         self$E <- lvl

         if (merge_close_vertices) {
           if (verbose > 0) {
             message("Merging close vertices")
           }
           private$merge_close_vertices(factor_merge_close_vertices * tolerance$vertex_vertex,
                                        factor_unit)
         }
       }

       if(!private$perform_merges && is.null(manual_edge_lengths)){
         if(verbose == 2){
           message("Computing edge lengths")
         }
         t <- system.time({
           self$edge_lengths <- private$compute_lengths(private$longlat,
                                                        private$length_unit,
                                                        private$crs,
                                                        private$proj4string,
                                                        private$which_longlat,
                                                        private$vertex_unit,
                                                        project_data,private$transform)
         })
         if(verbose == 2){
           message(sprintf("time: %.3f s", t[["elapsed"]]))
         }
       }


       if(auto_remove_point_edges){
         private$remove_circles(1e-15, verbose = verbose,
                                longlat = private$longlat,
                                unit = length_unit, crs=private$crs,
                                proj4string = private$proj4string,
                                which_longlat = which_longlat,
                                vertex_unit = vertex_unit, project_data)
       }

       if(!private$perform_merges){
         if(is.logical(remove_circles)){
           if(remove_circles){
             private$remove_circles(tolerance$vertex_vertex, verbose = verbose,
                                    longlat = private$longlat, unit = length_unit,
                                    crs=private$crs, proj4string = private$proj4string,
                                    which_longlat = which_longlat,
                                    vertex_unit = vertex_unit, project_data)
           }
         } else {
           private$remove_circles(remove_circles, verbose = verbose,
                                  longlat = private$longlat, unit = length_unit,
                                  crs = private$crs, proj4string = private$proj4string,
                                  which_longlat = which_longlat,
                                  vertex_unit = vertex_unit, project_data)
           remove_circles <- TRUE
         }
       }

       end_construction_time <- Sys.time()
       construction_time <- end_construction_time - start_construction_time

       if(verbose > 0){
         message(sprintf('Total construction time: %.2f %s', construction_time,
                         units(construction_time)))
       }

       # Compute the connected-component decomposition once and cache it.
       # `is_disconnected()`, `get_components()`, `which_component()`, and
       # `plot(components = ...)` all read from this cache.
       private$compute_component_membership()
       private$connected <- (private$nC <= 1L)
       if (check_connected && private$nC > 1L) {
         message("The graph is disconnected. You can either use 'mg$get_components()' to obtain the connected components, or set 'perform_merges = TRUE' (and adjust the 'tolerances') to merge them into a single connected graph. To suppress this message, pass 'check_connected = FALSE'.")
       }
       # creating/updating reference edges
       private$ref_edges <- map_into_reference_edge(self, verbose=verbose)

       # Cloning the initial graph

       if(verbose > 0){
         message("Creating and updating vertices...")
       }

       private$create_update_vertices(verbose=verbose)

       if(verbose > 0){
         message("Storing the initial graph...")
       }

       self$compute_PtE_edges(approx = approx_edge_PtE, verbose=verbose)

       private$initial_graph <- self$clone()

       # Cloning again to add the initial graph to the initial graph
       private$initial_graph <- self$clone()

       self$set_edge_weights(weights = private$edge_weights,
                             kirchhoff_weights = private$kirchhoff_weights,
                             directional_weights = private$directional_weights,
                             verbose=verbose)

       self$setDirectionalWeightFunction()

       if (remove_deg2) {
         if (verbose > 0) {
           message("Remove degree 2 vertices")
         }
         t <- system.time(
           self$prune_vertices(verbose = verbose)
         )
         if(verbose == 2){
           message(sprintf("time: %.3f s", t[["elapsed"]]))
         }
       }
       # Adding IDs to edges and setting up their class

       # for(i in 1:length(self$edges)){
       #   attr(self$edges[[i]], "id") <- i
       #   class(self$edges[[i]]) <- "metric_graph_edge"
       # }

       if(add_data_tmp){
         if(verbose > 0){
           message("Adding observations...")
         }
         add_obs_options[["data"]] <- dataset_tmp
         do.call(self$add_observations, add_obs_options)
       }

       # Checking if there is some edge with zero length
       if(any(self$edge_lengths == 0)){
         warning("There is at least one edge of length zero. Please, consider redefining the graph.")
       }

     },

     #' @description Sets the edge weights
     #' @param tolerance Tolerance at which circles with length less than this
     #' will be removed.
     #' @param verbose Print progress of graph creation. There are 3 levels of
     #' verbose, level 0, 1 and 2. In level 0, no messages are printed.
     #' In level 1, only messages regarding important steps are printed.
     #' Finally, in level 2, messages detailing all the steps are printed.
     #' The default is 1.
     #' @return No return value. Called for its side effects.
     remove_small_circles = function(tolerance, verbose = 1){
       private$remove_circles(tolerance, verbose = verbose,
                              longlat = private$longlat,
                              unit=private$length_unit,
                              crs=private$crs,
                              proj4string = private$proj4string,
                              which_longlat = private$which_longlat,
                              vertex_unit = private$vertex_unit,
                              project_data = private$project_data)
       private$create_update_vertices(verbose=verbose)
       # Removing edges can change the component decomposition; refresh
       # the cache.
       private$compute_component_membership()
       private$components_cache <- NULL
     },
     #' @description Exports the edges of the MetricGraph object as an `sf` or `sp`.
     #' @param format The format for the exported object. The options are `sf` (default), `sp` and `list`.
     #' @return
     #' For `format == "sf"`, the function returns an `sf` object of `LINESTRING`
     #' geometries, where the associated data frame includes edge weights.
     #'
     #' For `format == "sp"`, the function returns a `SpatialLinesDataFrame` where
     #' the data frame includes edge weights.
     get_edges = function(format = c("sf", "sp", "list")){
       format <- format[[1]]
       if(!(format%in%c("sf", "sp", "list"))){
         stop("'format' must be one of the following: 'sf', 'sp' or 'list'.")
       }
       if(format == "sf"){
         edges_geometries <- lapply(self$edges, sf::st_linestring)

         if(is.vector(private$edge_weights)){
           ew_tmp <- data.frame(.weights = private$edge_weights)
         } else{
           ew_tmp <- as.data.frame(private$edge_weights)
         }

         ew_tmp[[".edge_lengths"]] <- self$edge_lengths

         edges_sf <- sf::st_sf(ew_tmp, geometry = sf::st_sfc(edges_geometries),
                               crs = if(!is.null(private$crs)) private$crs else sf::NA_crs_)
         return(edges_sf)
       } else if(format == "sp"){
         edges_list <- lapply(1:length(self$edges), function(i) {
           sp::Line(coords = matrix(self$edges[[i]], nrow = dim(self$edges[[i]])[1],
                                    ncol = dim(self$edges[[i]])[2]))
         })
         sp_edges <- sp::SpatialLines(
           lapply(1:length(edges_list), function(i) sp::Lines(list(edges_list[[i]]),
                                                              ID = as.character(i))),
           proj4string = if (!is.null(private$crs)) private$proj4string else sp::CRS(NA_character_)
         )
         if(is.vector(private$edge_weights)){
           ew_tmp <- data.frame(.weights = private$edge_weights)
         } else{
           ew_tmp <- as.data.frame(private$edge_weights)
         }
         ew_tmp[[".ID"]] <- as.character(1:length(sp_edges))
         ew_tmp[[".edge_lengths"]] <- self$edge_lengths
         edges_sldf <- sp::SpatialLinesDataFrame(sp_edges, data = ew_tmp,
                                                 match.ID = ".ID")
         return(edges_sldf)
       } else{
         return(self$edges)
       }
     },
     #' @description Bounding box of the metric graph
     #' @param format If the metric graph has a coordinate reference system, the
     #' format for the exported object. The options are `sf` (default), `sp`
     #' and `matrix`.
     #' @return A bounding box of the metric graph
     get_bounding_box = function(format = "sf"){
       bounding_box <- private$bounding_box
       if (private$longlat) {
         if (format == "sf") {
           bounding_box <- sf::st_bbox(
             c(xmin = bounding_box$min_x,
               ymin = bounding_box$min_y,
               xmax = bounding_box$max_x,
               ymax = bounding_box$max_y),
             crs = private$crs
           )
         } else {
           sp_bbox_matrix <- matrix(
             c(bounding_box$min_x, bounding_box$max_x,
               bounding_box$min_y, bounding_box$max_y),
             ncol = 2,
             dimnames = list(c("x", "y"), c("min", "max"))
           )

           bounding_box <- sp::SpatialPolygons(
             list(sp::Polygons(list(sp::Polygon(cbind(
               c(sp_bbox_matrix[1, "min"], sp_bbox_matrix[1, "max"],
                 sp_bbox_matrix[1, "max"], sp_bbox_matrix[1, "min"],
                 sp_bbox_matrix[1, "min"]),
               c(sp_bbox_matrix[2, "min"], sp_bbox_matrix[2, "min"],
                 sp_bbox_matrix[2, "max"], sp_bbox_matrix[2, "max"],
                 sp_bbox_matrix[2, "min"])
             ))), ID = "1")),
             proj4string = private$proj4string
           )
         }
       }
       return(bounding_box)
     },

     #' @description Exports the vertices of the MetricGraph object as an `sf`,
     #' `sp` or as a matrix.
     #' @param format The format for the exported object. The options are `sf`
     #' (default), `sp` and `matrix`.
     #' @return
     #' For `which_format == "sf"`, the function returns an `sf` object of `POINT`
     #' geometries.
     #'
     #' For `which_format == "sp"`, the function returns a `SpatialPointsDataFrame`
     #' object.

     get_vertices = function(format = c("sf", "sp", "list")){
       format <- format[[1]]
       if(!(format%in%c("sf", "sp", "list"))){
         stop("'format' must be one of the following: 'sf', 'sp' or 'list'.")
       }
       vertices_df <- do.call(rbind, lapply(self$vertices, function(v) {
         data.frame(
           X = v[1],
           Y = v[2],
           degree = attr(v, "degree"),
           indegree = attr(v, "indegree"),
           outdegree = attr(v, "outdegree"),
           problematic = attr(v, "problematic"),
           id = attr(v, "id"),
           longlat = attr(v, "longlat"),
           stringsAsFactors = FALSE
         )}))
       if(format == "sf"){
         vertices_df <- sf::st_as_sf(vertices_df, coords = c("X", "Y"))
         if(!is.null(private$crs)){
           sf::st_crs(vertices_df) <- private$crs
         } else{
           sf::st_crs(vertices_df) <- sf::NA_crs_
         }
       } else if(format == "sp"){
         sp::coordinates(vertices_df) <- ~ X + Y
         if(!is.null(private$proj4string)){
           sp::proj4string(vertices_df) <- private$proj4string
         }
       }
       return(vertices_df)
     },
     #' @description Exports the MetricGraph object as an `sf` or `sp` object.
     #' @param format The format for the exported object. The options are `sf`
     #' (default) and `sp`.
     #' @return Returns a list with three elements: `edges`, `vertices`, and `data`.
     #'
     #' For `format == "sf"`, `edges` is an `sf` object of `LINESTRING` geometries
     #' with edge weights, and `vertices` and `data` are `sf` objects with
     #' `POINT` geometries.
     #'
     #' For `format == "sp"`, `edges` is a `SpatialLinesDataFrame` with edge weights,
     #' and `vertices` and `data` are `SpatialPointsDataFrame`.
     export = function(format = "sf"){
       edges <- self$get_edges(format = format)
       vertices <- self$get_vertices(format = format)
       if(!is.null(private$data)){
         data = self$get_data(format = format, drop_all_na=FALSE, drop_na = FALSE, group = NULL)
       } else{
         data = NULL
       }
       exported_metric_graph = list(edges = edges, vertices = vertices, data = data)
       return(exported_metric_graph)
     },

     #' @description Return the metric graph as a `leaflet::leaflet()` object to
     #' be built upon.
     #' @param width	the width of the map
     #' @param height the height of the map
     #' @param padding	the padding of the map
     #' @param options	the map options
     #' @param elementId	Use an explicit element ID for the widget (rather than
     #' an automatically generated one).
     #' @param sizingPolicy	htmlwidgets sizing policy object. Defaults to
     #' `leafletSizingPolicy()`.

     leaflet = function(width = NULL, height = NULL, padding = 0,
                        options = leafletOptions(), elementId = NULL,
                        sizingPolicy = leafletSizingPolicy(padding = padding)){
       edges_sf <- self$get_edges(format = "sf")
       return(leaflet::leaflet(data = edges_sf, width = width, height = height,
                               padding = padding, options = options,
                               elementId = elementId, sizingPolicy = sizingPolicy))
     },

     #' @description Returns a `mapview::mapview()` object of the metric graph
     #' @param ... Additional arguments to be passed to `mapview::mapview()`.
     #' The `x` argument of mapview, containing the metric graph is already
     #' passed internally.
     mapview = function(...){
       edges_sf <- self$get_edges(format = "sf")
       return(mapview::mapview(x = edges_sf, ...))
     },

     #' @description Sets the edge weights
     #' @param weights Either a number, a numerical vector with length given by
     #' the number of edges, providing the edge weights, or a `data.frame` with
     #' the number of rows being equal to the number of edges, where
     #' each row gives a vector of weights to its corresponding edge.
     #' @param kirchhoff_weights If non-null, the name (or number) of the column
     #' of `weights` that contain the Kirchhoff weights. Must be equal to 1
     #' (or `TRUE`) in case `weights` is a single number and those are the
     #' Kirchhoff weights.
     #' @param directional_weights If non-null, the name (or number) of the column
     #' of `weights` that contain the directional weights.
     #' @param verbose There are 3 levels of verbose, level 0, 1 and 2. In level
     #' 0, no messages are printed. In level 1, only messages regarding important
     #' steps are printed. Finally, in level 2, messages detailing all the steps
     #' are printed. The default is 1.
     #' @return No return value. Called for its side effects.

     set_edge_weights = function(weights = NULL, kirchhoff_weights = NULL,
                                 directional_weights = NULL, verbose = 0) {

       # Validate input types early
       if(!is.vector(weights) && !is.data.frame(weights) && !is.null(weights)){
         stop("'weights' must be either a vector or a data.frame!")
       }

       if(verbose == 2){
         message("Setting edge weights...")
       }

       if(!is.null(weights)){
         if(is.vector(weights)){
           if ( (length(weights) != 1) && (length(weights) != self$nE)){
             stop(paste0("The length of 'weights' must be either 1 or ",
                         self$nE))
           }
           if(length(weights)==1){
             private$edge_weights <- rep(weights, self$nE)
           } else{
             private$edge_weights <- weights
           }
           # Strip units from vector weights
           private$edge_weights <- sapply(private$edge_weights,
                                          strip_units_if_present)
         } else{
           if(nrow(weights) != self$nE){
             stop("The number of rows of weights must be equal to the number of edges!")
           }
           private$edge_weights <- weights
           if(!(".weights" %in% colnames(private$edge_weights))){
             private$edge_weights[, ".weights"] <- 1
           }
           # Strip units from data.frame weights
           private$edge_weights[] <- lapply(private$edge_weights,
                                            strip_units_if_present)
         }
       } else{
         weights <- private$edge_weights
       }

       if(!is.null(kirchhoff_weights)){
         if(length(kirchhoff_weights)>1){
           warning("Only the first entry of 'kirchhoff_weights' was used.")
           kirchhoff_weights <- kirchhoff_weights[[1]]
         }
         if(!is.numeric(kirchhoff_weights)){
           if(!is.character(kirchhoff_weights)){
             stop("'kirchhoff_weights' must be either a number of a string.")
           }
           if(!(kirchhoff_weights%in%colnames(weights))){
             stop(paste(kirchhoff_weights, "is not a column of 'weights'!"))
           }
         } else{
           if(!is.data.frame(weights)){
             if(kirchhoff_weights != 1){
               stop("Since 'weights' is not a data.frame, 'kirchhoff_weights' must be either NULL or 1.")
             }
           } else{
             if(kirchhoff_weights %%1 != 0){
               stop("'kirchhoff_weights' must be an integer.")
             }
             if((kirchhoff_weights < 1) || (kirchhoff_weights > ncol(weights))){
               stop("'kirchhoff_weights' must be a positive integer number smaller or equal to the number of columns of 'weights'.")
             }
           }
         }
         private$kirchhoff_weights <- kirchhoff_weights
       } else{
         if(is.vector(weights)){
           private$kirchhoff_weights <- 1
         } else{
           private$kirchhoff_weights <- ".weights"
         }
       }

       if(!is.null(directional_weights)){
         if(!is.numeric(directional_weights)){
           if(!is.character(directional_weights)){
             stop("'directional_weights' must be either a numerical vector of a string vector.")
           }
           if(!(directional_weights%in%colnames(weights))){
             stop(paste(directional_weights, "is not a column of 'weights'!"))
           }
         } else{
           if(!is.data.frame(weights)){
             if(directional_weights != 1){
               stop("Since 'weights' is not a data.frame, 'directional_weights' must be either NULL or 1.")
             }
           } else{
             if(directional_weights %%1 != 0){
               stop("'directional_weights' must be an integer.")
             }
             if((directional_weights < 1) || (directional_weights > ncol(weights))){
               stop("'directional_weights' must be a positive integer number smaller or equal to the number of columns of 'weights'.")
             }
           }
         }
         private$directional_weights <- directional_weights
       } else{
         if(is.vector(weights)){
           private$directional_weights <- 1
         } else{
           private$directional_weights <- ".weights"
         }
       }

       # Get edge lengths and preallocate attributes
       edge_lengths <- self$get_edge_lengths()
       edges_PtE <- lapply(self$edges, function(edge) attr(edge, "PtE"))
       nE <- self$nE

       edges_local <- self$edges
       ew_local    <- private$edge_weights
       ew_is_df    <- is.data.frame(ew_local)
       longlat_val <- private$longlat
       crs_val     <- private$crs$input
       kw_val      <- private$kirchhoff_weights
       dw_val      <- private$directional_weights

       edges_local <- lapply(seq_along(edges_local), function(i) {
         edge <- edges_local[[i]]
         if (ew_is_df) {
           attr(edge, "weight") <- ew_local[i, , drop = FALSE]
         } else {
           attr(edge, "weight") <- ew_local[i]
         }
         attr(edge, "length") <- edge_lengths[i]
         attr(edge, "id") <- i
         attr(edge, "PtE") <- edges_PtE[[i]]
         attr(edge, "longlat") <- longlat_val
         attr(edge, "crs") <- crs_val
         attr(edge, "kirchhoff_weight") <- kw_val
         attr(edge, "directional_weights") <- dw_val
         class(edge) <- "metric_graph_edge"
         edge
       })

       class(edges_local) <- "metric_graph_edges"
       self$edges <- edges_local
     },


     #' @description Gets the edge weights
     #' @param data.frame If the edge weights are given as vectors, should the
     #' result be returned as a data.frame?
     #' @param format Which format should the data be returned? The options are
     #' `tibble` for `tidyr::tibble`, `sf` for `POINT`, `sp` for
     #' `SpatialPointsDataFrame` and `list` for the internal list format.
     #' @param tibble `r lifecycle::badge("deprecated")` Use `format` instead.
     #' @return A vector or `data.frame` containing the edge weights.

     get_edge_weights = function(data.frame = FALSE, format = c("tibble", "sf", "sp", "list"),
                                 tibble = deprecated()){

       if (lifecycle::is_present(tibble)) {
         lifecycle::deprecate_warn("1.3.0.9000", "get_edge_weights(tibble)",
                                   "get_edge_weights(format)",
                                   details = c("The argument `tibble` was deprecated in favor of the argument `format`.")
         )
         if(tibble){
           format <- "tibble"
         }
       }

       format <- format[[1]]

       format <- tolower(format)

       if(!(format %in% c("tibble", "sf", "sp", "list"))){
         stop("The possible formats are 'tibble', 'sf', 'sp' and 'list'.")
       }

       tmp <- private$edge_weights
       row.names(tmp) <- NULL
       if(!is.data.frame(tmp) && data.frame){
         tmp <- data.frame(.weights = tmp)
       }
       if(format == "tibble"){
         if(!is.data.frame(tmp)){
           tmp <- data.frame(.weights = tmp)
         }
         tmp <- dplyr::as_tibble(tmp)
       } else{
         return(self$get_edges(format = format))
       }
       class(tmp) <- c("metric_graph_weights", class(tmp))
       return(tmp)
     },

     #' @description Gets vertices with incompatible directions
     #' @return A vector containing the vertices with incompatible directions.

     get_vertices_incomp_dir = function(){
       if(is.null(self$vertices)){
         start.deg <- end.deg <- rep(0,self$nV)
         for(i in 1:self$nV) {
           start.deg[i] <- sum(self$E[,1]==i)
           end.deg[i] <- sum(self$E[,2]==i)
         }

         degrees <- self$get_degrees()

         # Finding problematic vertices, that is, vertices with incompatible directions
         # They will not be pruned.
         problematic <- (degrees > 1) & (start.deg == 0 | end.deg == 0)
         return(which(problematic))
       } else{
         problematic <- sapply(self$vertices, function(vert){attr(vert, "problematic")})
         return(which(problematic))
       }

     },

     #' @description Prints a summary of various informations of the graph
     #' @param messages Should message explaining how to build the results be
     #' given for missing quantities?
     #' @param compute_characteristics Should the characteristics of the graph
     #' be computed? If `NULL` it will be determined based on the size of the graph.
     #' @param check_euclidean Check if the graph has Euclidean edges? If `NULL`
     #' it will be determined based on the size of the graph.
     #' @param check_distance_consistency Check the distance consistency assumption?
     #' If `NULL` it will be determined based on the size of the graph.
     #' @return No return value. Called for its side effects.
     summary = function(messages = FALSE,
                        compute_characteristics = NULL,
                        check_euclidean = NULL,
                        check_distance_consistency = NULL){

       if(self$nV > 10000){
         if(is.null(compute_characteristics)){
           compute_characteristics <- FALSE
         }
         if(is.null(check_euclidean)){
           check_euclidean <- FALSE
         }
         if(is.null(check_distance_consistency)){
           check_distance_consistency <- FALSE
         }
       } else{
         if(is.null(compute_characteristics)){
           compute_characteristics <- TRUE
         }
         if(is.null(check_euclidean)){
           check_euclidean <- TRUE
         }
         if(is.null(check_distance_consistency)){
           check_distance_consistency <- TRUE
         }
       }

       if(compute_characteristics){
         self$compute_characteristics()
       }
       if(check_distance_consistency){
         self$check_distance_consistency()
       }
       if(check_euclidean){
         self$check_euclidean()
       }
       cat("A metric graph object with:\n\n")
       cat("Vertices:\n")
       cat("\t Total:", self$nV,"\n")
       degrees <- self$get_degrees()
       cat("\t")
       degrees_u <- sort(unique(degrees))
       for(i in 1:length(degrees_u)){
         if((i>1) && (i%%5 == 1)){
           cat("\n\t")
         }
         cat(paste0(" Degree ", degrees_u[i],": ",
                    sum(degrees == degrees_u[i]), "; "))
       }
       cat("\n")

       cat("\t With incompatible directions: ",
           length(self$get_vertices_incomp_dir()), "\n\n")
       cat("Edges: \n")
       cat("\t Total:", self$nE,"\n")
       cat("\t Lengths: \n")
       cat("\t\t Min:", min(self$get_edge_lengths()), " ; Max:",
           max(self$get_edge_lengths()), " ; Total:",
           sum(self$get_edge_lengths()), "\n")
       cat("\t Weights: \n")
       if(is.vector(private$edge_weights)){
         cat("\t\t Min:", min(private$edge_weights), " ; Max:",
             max(private$edge_weights), "\n")
       } else{
         if(!is.null(colnames(private$edge_weights))){
           cat("\t\t Columns:", colnames(private$edge_weights),"\n")
         } else{
           cat("\t\t Number of columns:", ncol(private$edge_weights), "\n")
         }
       }
       cat("\t That are circles: ", sum(self$E[,1] == self$E[,2]), "\n\n")
       cat("Graph units: \n")
       cat("\t Vertices unit: ", ifelse(is.null(private$vertex_unit), "None",
                                        private$vertex_unit), " ; Lengths unit: ",
           ifelse(is.null(private$length_unit), "None", private$length_unit),
           "\n\n")
       cat("Longitude and Latitude coordinates: ", private$longlat)
       if(private$longlat){
         cat("\n\t Which spatial package: ", private$which_longlat, "\n")
         cat("\t CRS: ", private$crs$input)
       }
       cat("\n\n")
       if(!is.null(self$characteristics)) {
         cat("Some characteristics of the graph:\n")
         if(self$characteristics$connected){
           cat("\t Connected: TRUE\n")
         } else {
           cat("\t Connected: FALSE\n")
         }
         if(self$characteristics$has_loops){
           cat("\t Has loops: TRUE\n")
         } else {
           cat("\t Has loops: FALSE\n")
         }
         if(self$characteristics$has_multiple_edges){
           cat("\t Has multiple edges: TRUE\n")
         } else {
           cat("\t Has multiple edges: FALSE\n")
         }
         if(self$characteristics$is_tree){
           cat("\t Is a tree: TRUE\n")
         } else {
           cat("\t Is a tree: FALSE\n")
         }
         if(!is.null(self$characteristics$distance_consistency)){
           if(self$characteristics$distance_consistency){
             cat("\t Distance consistent: TRUE\n")
           } else {
             cat("\t Distance consistent: FALSE\n")
           }
         } else{
           cat("\t Distance consistent: unknown\n")
           if(messages){
             message("To check if the graph satisfies the distance consistency, run the `check_distance_consistency()` method.")
           }
         }
         if(!is.null(self$characteristics$euclidean)){
           if(self$characteristics$euclidean){
             cat("\t Has Euclidean edges: TRUE\n")
           } else {
             cat("\t Has Euclidean edges: FALSE\n")
           }
         } else{
           cat("\t Has Euclidean edges: unknown\n")
           if(messages){
             message("To check if the graph has Euclidean edges, run the `check_euclidean()` method.")
           }
         }
       } else{
         cat("Some characteristics of the graph: Not computed.\n")
         if(messages){
           message("To compute the characteristics, run the `compute_characteristics()` method.")
         }
       }
       cat("\n")
       cat("Computed quantities inside the graph: \n")
       cat("\t Laplacian: ", !is.null(self$Laplacian), " ; Geodesic distances: ",
           !is.null(self$geo_dist), "\n")
       if(is.null(self$Laplacian)){
         if(messages){
           message("To compute the Laplacian, run the 'compute_laplacian()' method.")
         }
       }
       if(is.null(self$geo_dist)){
         if(messages){
           message("To compute the geodesic distances, run the 'compute_geodist()' method.")
         }
       }
       cat("\t Resistance distances: ", !is.null(self$res_dist),
           " ; Finite element matrices: ", !is.null(self$mesh$C), "\n")
       if(is.null(self$res_dist)){
         if(messages){
           message("To compute the resistance distances, run the 'compute_resdist()' method.")
         }
       }
       if(is.null(self$mesh$C)){
         if(messages){
           message("To compute the finite element matrices, run the 'compute_fem()' method.")
         }
       }
       cat("\n")
       if(is.null(self$mesh)){
         cat("Mesh: The graph has no mesh! \n")
         if(messages){
           message("To build the mesh, run the 'build_mesh()' method.")
         }
       } else{
         cat("Mesh: \n")
         cat("\t Max h_e: ", max(self$mesh$h_e), " ; Min n_e: ",
             min(self$mesh$n_e), "\n")
       }
       cat("\n")
       if(is.null(private$data)){
         cat("Data: The graph has no data!\n")
         if(messages){
           message("To add observations, use the 'add_observations()' method.")
         }
       } else{
         cat("Data: \n")
         col_names_valid <- grepl("^[^.]+$", names(private$data))
         cat("\t Columns: ", names(private$data)[col_names_valid], "\n")
         cat("\t Groups: ", ifelse(is.null(private$group_col), "None",
                                   private$group_col), "\n")
       }
       cat("\n")
       cat("Tolerances: \n")
       cat("\t vertex-vertex: ", private$tolerance$vertex_vertex, "\n")
       cat("\t vertex-edge: ", private$tolerance$vertex_edge, "\n")
       cat("\t edge-edge: ", private$tolerance$edge_edge, "\n")
     },


     #' @description Prints various characteristics of the graph
     #' @return No return value. Called for its side effects.

     print = function() {
       cat("A metric graph with ", self$nV, " vertices and ",
           self$nE, " edges.\n\n")
       cat("Vertices:\n")
       degrees <- self$get_degrees()
       cat("\t")
       degrees_u <- sort(unique(degrees))
       for(i in 1:length(degrees_u)){
         if((i>1) && (i%%5 == 1)){
           cat("\n\t")
         }
         cat(paste0(" Degree ", degrees_u[i],": ",
                    sum(degrees == degrees_u[i]), "; "))
       }
       cat("\n")
       cat("\t With incompatible directions: ",
           length(self$get_vertices_incomp_dir()), "\n\n")
       cat("Edges: \n")
       cat("\t Lengths: \n")
       cat("\t\t Min:", min(self$get_edge_lengths()), " ; Max:",
           max(self$get_edge_lengths()), " ; Total:",
           sum(self$get_edge_lengths()), "\n")
       cat("\t Weights: \n")
       if(is.vector(private$edge_weights)){
         cat("\t\t Min:", min(private$edge_weights), " ; Max:",
             max(private$edge_weights), "\n")
       } else{
         if(!is.null(colnames(private$edge_weights))){
           cat("\t\t Columns:", colnames(private$edge_weights),"\n")
         } else{
           cat("\t\t Number of columns:", ncol(private$edge_weights), "\n")
         }
       }
       cat("\t That are circles: ", sum(self$E[,1] == self$E[,2]), "\n\n")
       cat("Graph units: \n")
       cat("\t Vertices unit: ", ifelse(is.null(private$vertex_unit), "None",
                                        private$vertex_unit),
           " ; Lengths unit: ", ifelse(is.null(private$length_unit),
                                       "None", private$length_unit), "\n\n")
       cat("Longitude and Latitude coordinates: ", private$longlat)
       if(private$longlat){
         cat("\n\t Which spatial package: ", private$which_longlat, "\n")
         cat("\t CRS: ", private$crs$input)
       }
       cat("\n\n")

       if(!is.null(self$characteristics)) {
         cat("Some characteristics of the graph:\n")
         if(self$characteristics$connected){
           cat("  Connected: TRUE\n")
         } else {
           cat("  Connected: FALSE\n")
         }
         if(self$characteristics$has_loops){
           cat("  Has loops: TRUE\n")
         } else {
           cat("  Has loops: FALSE\n")
         }
         if(self$characteristics$has_multiple_edges){
           cat("  Has multiple edges: TRUE\n")
         } else {
           cat("  Has multiple edges: FALSE\n")
         }
         if(self$characteristics$is_tree){
           cat("  Is a tree: TRUE\n")
         } else {
           cat("  Is a tree: FALSE\n")
         }
         if(!is.null(self$characteristics$distance_consistency)){
           if(self$characteristics$distance_consistency){
             cat("  Distance consistent: TRUE\n")
           } else {
             cat("  Distance consistent: FALSE\n")
           }
         } else{
           cat("  Distance consistent: unknown\n")
           message("To check if the graph satisfies the distance consistency, run the `check_distance_consistency()` method.")
         }
         if(!is.null(self$characteristics$euclidean)){
           if(self$characteristics$euclidean){
             cat("  Has Euclidean edges: TRUE\n")
           } else {
             cat("  Has Euclidean edges: FALSE\n")
           }
         } else{
           cat("  Has Euclidean edges: unknown\n")
           message("To check if the graph has Euclidean edges, run the `check_euclidean()` method.")
         }
       }
       invisible(self)
     },
     #' @description Computes various characteristics of the graph
     #' @param check_euclidean Also check if the graph has Euclidean edges?
     #' This essentially means that the distance consistency check will also be
     #' perfomed. If the graph does not have Euclidean edges due to another reason
     #' rather than the distance consistency, then it will already be indicated that
     #' the graph does not have Euclidean edges.
     #' @return No return value. Called for its side effects. The computed
     #' characteristics are stored in the `characteristics` element of the
     #' `metric_graph` object.
     compute_characteristics = function(check_euclidean = FALSE) {
       if(is.null(self$characteristics)){
         self$characteristics <- list()
       }

       #check for loops
       if(is.null(self$characteristics$has_loops)){
         if(sum(self$E[,1]==self$E[,2])>0) {
           self$characteristics$has_loops <- TRUE
         } else {
           self$characteristics$has_loops <- FALSE
         }
       }

       # Read connectivity from the cached component decomposition computed
       # in `initialize()`. Recompute defensively if the cache hasn't been
       # populated yet (e.g. partially-initialised legacy objects).
       if (is.null(private$component_membership)) {
         private$compute_component_membership()
       }
       private$connected <- (private$nC <= 1L)
       self$characteristics$connected <- private$connected

       #check for multiple edges
       if(is.null(self$characteristics$has_multiple_edges)){
         self$characteristics$has_multiple_edges <- FALSE
         k <- 1
         while(k < self$nV && self$characteristics$has_multiple_edges == FALSE) {
           ind <- which(self$E[,1]==k | self$E[,2]==k) #edges starting or ending in k
           if(length(ind) > length(unique(rowSums(self$E[ind,,drop=FALSE])))) {
             self$characteristics$has_multiple_edges <- TRUE
           } else {
             k <- k + 1
           }
         }
       }


       #check for tree structure
       if(!self$characteristics$has_loops && !self$characteristics$has_multiple_edges){
         self$characteristics$is_tree <- self$is_tree()
       } else {
         self$characteristics$is_tree <- FALSE
       }

       if(!self$characteristics$connected || self$characteristics$has_loops ||
          self$characteristics$has_multiple_edges){
         self$characteristics$euclidean <- FALSE
       } else if(self$characteristics$is_tree){
         self$characteristics$euclidean <- TRUE
       }

     },

     #' @description Check if the graph has Euclidean edges.
     #' @return Returns `TRUE` if the graph has Euclidean edges, or `FALSE` otherwise.
     #' The result is stored in the `characteristics` element of the `metric_graph` object.
     #' The result is displayed when the graph is printed.
     check_euclidean = function(){
       self$compute_characteristics()
       if(!is.null(self$characteristics$euclidean)){
         return(invisible(NULL))
       }

       if(is.null(self$characteristics$distance_consistency)){
         self$check_distance_consistency()
         if(self$characteristics$distance_consistency){
           self$characteristics$euclidean <- TRUE
         } else{
           self$characteristics$euclidean <- FALSE
         }
       } else{
         if(self$characteristics$distance_consistency){
           self$characteristics$euclidean <- TRUE
         } else{
           self$characteristics$euclidean <- FALSE
         }
       }
     },

     #' @description Checks distance consistency of the graph.
     #' @return No return value.
     #' The result is stored in the `characteristics` element of the `metric_graph` object.
     #' The result is displayed when the graph is printed.
     check_distance_consistency = function(){
       self$compute_characteristics()
       if(is.null(self$geo_dist)){
         self$geo_dist <- list()
       }

       if(is.null(self$geo_dist[[".vertices"]])){
         g <- make_graph(edges = c(t(self$E)), directed = FALSE)
         E(g)$weight <- self$edge_lengths
         self$geo_dist[[".vertices"]] <- distances(g)
       }

       geo_dist_edges <- self$geo_dist[[".vertices"]][self$E]
       if(any(abs(geo_dist_edges - self$edge_lengths) > 1e-8)){
         self$characteristics$distance_consistency <- FALSE
       } else{
         self$characteristics$distance_consistency <- TRUE
       }
     },

     #' @description Computes shortest path distances between the vertices in the
     #' graph
     #' @param obs Should the geodesic distances be computed at the observation
     #' locations or only at vertices?
     #' @param include_vertices If `obs` is `TRUE`, should the vertex locations be
     #' included in the resulting distance matrix?
     #' @param all_groups Should the geodesic distances be computed for all
     #' the available locations accross all groups? If `FALSE`, it will be computed
     #' separately for the locations of each group.
     #' @param group Vector or list containing which groups to compute the distance
     #' for. If `NULL`, it will be computed for all groups.
     #' @param verbose Print progress of the computation of the geodesic distances.
     #' There are 3 levels of verbose, level 0, 1 and 2. In level 0, no messages
     #' are printed. In level 1, only messages regarding important steps are printed.
     #' Finally, in level 2, messages detailing all the steps are printed. The default is 1.
     #' @param full `r lifecycle::badge("deprecated")` Use `all_groups` instead.
     #' @return No return value. Called for its side effects. The computed geodesic
     #' distances are stored in the `geo_dist` element of the `metric_graph` object.
     compute_geodist = function(obs = TRUE,
                                include_vertices = FALSE,
                                all_groups = FALSE,
                                group = NULL,
                                verbose = 0,
                                full = lifecycle::deprecated()) {
       if(lifecycle::is_present(full)){
         lifecycle::deprecate_warn("1.5.0.9000", "compute_geodist(full)",
                                   "compute_geodist(all_groups)")
         all_groups <- full
       }
       if(is.null(self$geo_dist)){
         self$geo_dist <- list()
       }

       if(is.null(private$data)){
         obs <- FALSE
       }
       if(!obs){
         if(verbose == 2){
           message("Creating auxiliary graph...")
         }
         t <- system.time({
           g <- make_graph(edges = c(t(self$E)), directed = FALSE)
           E(g)$weight <- self$edge_lengths
         })
         if(verbose == 2){
           message(sprintf("time: %.3f s", t[["elapsed"]]))
         }
         if(verbose > 0){
           message("Computing geodesic distances...")
         }
         t <- system.time(
           self$geo_dist[[".vertices"]] <- distances(g)
         )
         if(verbose == 2){
           message(sprintf("time: %.3f s", t[["elapsed"]]))
         }
       } else if(all_groups){
         PtE_full <- self$get_PtE()
         self$geo_dist[[".complete"]] <- self$compute_geodist_PtE(PtE = PtE_full,
                                                                  normalized = TRUE,
                                                                  verbose = verbose,
                                                                  include_vertices = include_vertices)
       } else{
         if(is.null(group)){
           group <- unique(private$data[[".group"]])
         }
         for(grp in group){
           data_grp <- select_group(private$data, grp)
           idx_notna <- idx_not_all_NA(data_grp)
           PtE_group <- cbind(data_grp[[".edge_number"]][idx_notna],
                              data_grp[[".distance_on_edge"]][idx_notna])
           self$geo_dist[[grp]] <- self$compute_geodist_PtE(PtE = PtE_group,
                                                            normalized = TRUE,
                                                            verbose = verbose,
                                                            include_vertices = include_vertices)
         }
       }
     },
     #' @description Computes shortest path distances between the vertices in the
     #' graph.
     #' @param PtE Points to compute the metric for.
     #' @param normalized are the locations in PtE in normalized distance?
     #' @param include_vertices Should the original vertices be included in the
     #' distance matrix?
     #' @param verbose Print progress of the computation of the geodesic distances.
     #' There are 3 levels of verbose, level 0, 1 and 2. In level 0, no messages
     #' are printed. In level 1, only messages regarding important steps are printed.
     #' Finally, in level 2, messages detailing all the steps are printed.
     #' The default is 1.
     #' @return A matrix containing the geodesic distances.
     compute_geodist_PtE = function(PtE,
                                    normalized = TRUE,
                                    include_vertices = TRUE, verbose = 0){
       if(verbose == 2){
         message("Processing the graph locations...")
       }
       t <- system.time({
         graph.temp <- self$clone()
         graph.temp$clear_observations()
         df_temp <- data.frame(y = rep(0, dim(PtE)[1]),
                               edge_number = PtE[,1],
                               distance_on_edge = PtE[,2])

         df_temp <- standardize_df_positions(df_temp, self)

         if(sum(duplicated(df_temp))>0){
           warning("Duplicated locations were found when computing geodist. The returned values are given for unique locations.")
           df_temp <- unique(df_temp)
         }

         graph.temp$build_mesh(h = 10000)

         df_temp2 <- data.frame(y = 0,
                                edge_number = graph.temp$mesh$VtE[1:nrow(self$V),1],
                                distance_on_edge = graph.temp$mesh$VtE[1:nrow(self$V),2])

         df_temp2 <- standardize_df_positions(df_temp2, self)

         df_temp$included <- TRUE
         temp_merge <- merge(df_temp, df_temp2, all = TRUE)

         df_temp$included <- NULL

         df_temp2 <- temp_merge[is.na(temp_merge["included"]),]

         nV_new <- sum(is.na(temp_merge["included"]))

         df_temp2$included <- NULL

         df_temp <- rbind(df_temp2, df_temp)

         df_temp[["__dummy"]] <- 1:nrow(df_temp)

         graph.temp$add_observations(data = df_temp,
                                     normalized = normalized,
                                     verbose=0,
                                     suppress_warnings = TRUE)

       })

       if(verbose == 2){
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }

       if(verbose == 2){
         message("Turning observations of the auxiliary graph to vertices...")
       }
       t <- system.time(
         graph.temp$observation_to_vertex(mesh_warning = FALSE)
       )
       if(verbose == 2){
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }
       if(verbose == 2){
         message("Creating auxiliary graph...")
       }
       t <- system.time({
         g <- make_graph(edges = c(t(graph.temp$E)), directed = FALSE)
         E(g)$weight <- graph.temp$edge_lengths
       })
       if(verbose == 2){
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }
       if(verbose>0){
         message("Computing geodesic distances...")
       }
       t <- system.time(
         geodist_temp <- distances(g)
       )
       if(verbose == 2){
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }

       if(length(graph.temp$PtV)[1]!=nrow(geodist_temp)){
         un_PtV <- unique(graph.temp$PtV)
         un_coords <- !duplicated(graph.temp$PtV)

         geodist_temp <- geodist_temp[un_PtV, un_PtV]

         tmp_vec <- graph.temp$.__enclos_env__$private$data[["__dummy"]][un_coords]

         un_ord <- order(tmp_vec)

         tmp_vec[un_ord] <- 1:length(tmp_vec)
         #Ordering back in the input order
         geodist_temp[tmp_vec,tmp_vec] <- geodist_temp
       } else{
         geodist_temp <- geodist_temp[graph.temp$PtV, graph.temp$PtV]
         #Ordering back in the input order
         geodist_temp[graph.temp$.__enclos_env__$private$data[["__dummy"]],
                      graph.temp$.__enclos_env__$private$data[["__dummy"]]] <- geodist_temp
       }

       if(!include_vertices){
         geodist_temp <- geodist_temp[(nV_new+1):nrow(geodist_temp),
                                      (nV_new+1):nrow(geodist_temp)]
       }

       attr(geodist_temp, "unit") <- private$length_unit

       return(geodist_temp)
     },

     #' @description Computes shortest path distances between the vertices in the
     #' mesh.
     #' @return No return value. Called for its side effects. The geodesic distances
     #' on the mesh are stored in `mesh$geo_dist` in the `metric_graph` object.
     compute_geodist_mesh = function() {
       g <- make_graph(edges = c(t(self$mesh$E)), directed = FALSE)
       E(g)$weight <- self$mesh$h_e
       self$mesh$geo_dist <- distances(g)
     },

     #' @description Computes the resistance distance between the observation
     #' locations.
     #' @param full Should the resistance distances be computed for all
     #' the available locations. If `FALSE`, it will be computed
     #' separately for the locations of each group.
     #' @param obs Should the resistance distances be computed at the observation
     #' locations?
     #' @param group Vector or list containing which groups to compute the distance
     #' for. If `NULL`, it will be computed for all groups.
     #' @param check_euclidean Check if the graph used to compute the resistance
     #' distance has Euclidean edges? The graph used to compute the resistance
     #' distance has the observation locations as vertices.
     #' @param include_vertices Should the vertices of the graph be also included
     #' in the resulting matrix when using `FULL=TRUE`?
     #' @param verbose Print progress of the computation of the resistance
     #' distances. There are 3 levels of verbose, level 0, 1 and 2. In level 0,
     #' no messages are printed. In level 1, only messages regarding important
     #' steps are printed. Finally, in level 2, messages detailing all the steps
     #' are printed. The default is 1.
     #' @return No return value. Called for its side effects. The geodesic distances
     #' are stored in the `res_dist` element of the `metric_graph` object.
     compute_resdist = function(full = FALSE,
                                obs = TRUE,
                                group = NULL,
                                check_euclidean = FALSE,
                                include_vertices = FALSE,
                                verbose = 0) {
       self$res_dist <- list()
       if(is.null(private$data)){
         obs <- FALSE
       }
       if(!obs){
         graph.temp <- self$clone()
         graph.temp$build_mesh(h=1000)

         PtE <- graph.temp$mesh$VtE[1:nrow(self$V),]
         rm(graph.temp)
         self$res_dist[[".vertices"]] <- self$compute_resdist_PtE(PtE,
                                                                  normalized=TRUE,
                                                                  check_euclidean = check_euclidean,
                                                                  verbose = verbose)
       } else if(full){
         PtE <- self$get_PtE()
         if(!include_vertices){
           self$res_dist[[".complete"]] <- self$compute_resdist_PtE(PtE,
                                                                    normalized=TRUE,
                                                                    include_vertices = FALSE,
                                                                    check_euclidean = check_euclidean,
                                                                    verbose = verbose)
         } else{
           self$res_dist[[".complete"]] <- self$compute_resdist_PtE(PtE,
                                                                    normalized=TRUE,
                                                                    include_vertices = TRUE,
                                                                    check_euclidean = check_euclidean,
                                                                    verbose = verbose)
         }

       } else{
         if(is.null(group)){
           group <- unique(private$data[[".group"]])
         }
         for(grp in group){
           data_grp <- select_group(private$data, grp)
           idx_notna <- idx_not_all_NA(data_grp)
           if(sum(idx_notna) == 0){
             stop("There are no non-NA observations.")
           }
           PtE <- cbind(data_grp[[".edge_number"]][idx_notna],
                        data_grp[[".distance_on_edge"]][idx_notna])
           self$res_dist[[as.character(grp)]] <- self$compute_resdist_PtE(PtE,
                                                                          normalized=TRUE,
                                                                          check_euclidean = check_euclidean,
                                                                          verbose = verbose)
         }
       }
     },

     #' @description Computes the resistance distance between the observation
     #' locations.
     #' @param PtE Points to compute the metric for.
     #' @param normalized Are the locations in PtE in normalized distance?
     #' @param include_vertices Should the original vertices be included in the
     #' Laplacian matrix?
     #' @param check_euclidean Check if the graph used to compute the resistance
     #' distance has Euclidean edges? The graph used to compute the resistance
     #' distance has the observation locations as vertices.
     #' @param verbose Print progress of the computation of the resistance distances.
     #' There are 3 levels of verbose, level 0, 1 and 2. In level 0, no messages
     #' are printed. In level 1, only messages regarding important steps are printed.
     #' Finally, in level 2, messages detailing all the steps are printed. The default is 1.
     #' @return A matrix containing the resistance distances.
     compute_resdist_PtE = function(PtE,
                                    normalized = TRUE,
                                    include_vertices = FALSE,
                                    check_euclidean = FALSE, verbose = 0) {
       # On disconnected graphs the Laplacian has more than one zero
       # eigenvalue, so the standard regularization `L[1, 1] <- L[1, 1] + 1`
       # leaves the matrix singular and `solve(L)` fails. Handle this by
       # adding the regularization on one vertex per connected component,
       # and explicitly setting the resistance distance to `Inf` between
       # vertices in different components (the mathematically correct value).
       if(verbose == 2){
         message("Processing the graph locations...")
       }
       t <- system.time({
         graph.temp <- self$clone()
         graph.temp$clear_observations()
         df_temp <- data.frame(y = rep(0, dim(PtE)[1]),
                               edge_number = PtE[,1],
                               distance_on_edge = PtE[,2])

         df_temp <- standardize_df_positions(df_temp, self)

         if(sum(duplicated(df_temp))>0){
           warning("Duplicated locations were found when computing resdist. The returned values are given for unique locations.")
           df_temp <- unique(df_temp)
         }

         graph.temp$build_mesh(h = 1000)

         df_temp2 <- data.frame(y = 0,
                                edge_number = graph.temp$mesh$VtE[1:nrow(self$V), 1],
                                distance_on_edge = graph.temp$mesh$VtE[1:nrow(self$V), 2])

         df_temp2 <- standardize_df_positions(df_temp2, self)

         df_temp$included <- TRUE
         temp_merge <- merge(df_temp, df_temp2, all = TRUE)

         df_temp$included <- NULL

         df_temp2 <- temp_merge[is.na(temp_merge["included"]),]

         nV_new <- sum(is.na(temp_merge["included"]))

         df_temp2$included <- NULL

         df_temp <- rbind(df_temp2, df_temp)

         df_temp[["__dummy"]] <- 1:nrow(df_temp)

         graph.temp$add_observations(data = df_temp,
                                     normalized = normalized, verbose = 0,
                                     suppress_warnings = TRUE)
       })
       if(verbose == 2){
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }
       if(verbose == 2){
         message("Turning observations of the auxiliary graph to vertices...")
       }
       t <- system.time(
         graph.temp$observation_to_vertex(mesh_warning=FALSE)
       )
       if(verbose == 2){
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }
       if(verbose > 0){
         message("Computing auxiliary geodesic distances...")
       }
       t <- system.time(
         graph.temp$compute_geodist(all_groups=TRUE,verbose = verbose)
       )
       if(verbose == 2){
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }

       if(check_euclidean){
         graph.temp$check_euclidean()
         is_euclidean <- graph.temp$characteristics$euclidean
       }

       if(verbose > 0){
         message("Computing the resistance distances...")
       }
       t <- system.time({
         geodist_temp <- graph.temp$geo_dist[[".complete"]]
         geodist_temp[graph.temp$PtV, graph.temp$PtV] <- geodist_temp

         L <- Matrix(0, graph.temp$nV, graph.temp$nV)

         for (i in 1:graph.temp$nE) {
           tmp <- -1 / geodist_temp[graph.temp$E[i, 1],
                                    graph.temp$E[i, 2]]
           L[graph.temp$E[i, 2], graph.temp$E[i, 1]] <- tmp
           L[graph.temp$E[i, 1], graph.temp$E[i, 2]] <- tmp
         }
         for(i in 1:graph.temp$nV){
           L[i, i] <- -sum(L[i, -i])
         }
         # Regularize one vertex per connected component to make L invertible
         # (each component contributes one zero eigenvalue to L).
         g_ig_temp <- igraph::make_graph(
           edges = c(t(graph.temp$E)), directed = FALSE)
         comp_membership <- igraph::components(
           g_ig_temp, mode = "weak")$membership
         for (cid in unique(comp_membership)) {
           v_anchor <- which(comp_membership == cid)[1]
           L[v_anchor, v_anchor] <- L[v_anchor, v_anchor] + 1
         }

         Li <- solve(L)
         R <- -2*Li + t(diag(Li)) %x% rep(1, graph.temp$nV) +
           t(rep(1, graph.temp$nV)) %x% diag(Li)

         # Resistance distance between vertices in different components is
         # mathematically infinite. The Klein-Randic formula above gives a
         # finite (incorrect) value for cross-component pairs; overwrite
         # those entries explicitly.
         if (length(unique(comp_membership)) > 1L) {
           R <- as.matrix(R)
           cross_mask <- outer(comp_membership, comp_membership,
                               function(a, b) a != b)
           R[cross_mask] <- Inf
         }

         R <- R[graph.temp$PtV, graph.temp$PtV]
         R[graph.temp$.__enclos_env__$private$data[["__dummy"]],
           graph.temp$.__enclos_env__$private$data[["__dummy"]]] <- R

         if(!include_vertices){
           R <- R[(nV_new+1):nrow(R), (nV_new+1):nrow(R)]
         }
       })

       if(verbose == 2){
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }

       if(check_euclidean){
         attr(R, "euclidean") <- is_euclidean
       }

       return(R)
     },

     #' @description Returns the degrees of the vertices in the metric graph.
     #' @param which If "degree", returns the degree of the vertex. If "indegree",
     #' returns the indegree, and if "outdegree", it returns the outdegree.
     #' @return A vector containing the degrees of the vertices.
     get_degrees = function(which = "degree"){
       which <- which[[1]]
       if(!(which %in% c("degree", "indegree", "outdegree"))){
         stop("'which' must be either 'degree', 'indegree' or 'outdegree'!")
       }
       if(which == "degree"){
         degrees <- sapply(self$vertices, function(vert){attr(vert, "degree")})
       } else if(which == "indegree"){
         degrees <- sapply(self$vertices, function(vert){attr(vert, "indegree")})
       } else{
         degrees <- sapply(self$vertices, function(vert){attr(vert, "outdegree")})
       }
       return(degrees)
     },

     #' @description Computes the relative positions of the coordinates of the
     #' edges and save it as an attribute to each edge. This improves the quality
     #' of plots obtained by the `plot_function()` method, however it might
     #' be costly to compute.
     #' @param approx Should the computation of the relative positions be
     #' approximate? Default is `TRUE`. If `FALSE`, the speed can be considerably
     #' slower, especially for large metric graphs.
     #' @param verbose Level of verbosity, 0, 1 or 2. The default is 0.
     #' @return No return value, called for its side effects.
     compute_PtE_edges = function(approx = TRUE, verbose = 0){

       if(verbose > 0){
         message("Computing the relative positions of the edges...")
       }

       nE <- length(self$edges)
       if (nE == 0L) {
         class(self$edges) <- "metric_graph_edges"
         return(invisible(NULL))
       }

       edges_local <- self$edges

       if (approx) {
         use_longlat <- isTRUE(private$longlat)
         ptes <- compute_PtE_edges_cpp(edges_local, use_longlat)
         for (j in seq_len(nE)) {
           attr(edges_local[[j]], "PtE") <- ptes[[j]]
         }
       } else {
         # exact path: per-edge geodesic distances; no batched form yet
         for (j in seq_len(nE)) {
           attr(edges_local[[j]], "PtE") <- private$exact_PtE_coordinates(edge = edges_local[[j]])
         }
       }

       class(edges_local) <- "metric_graph_edges"
       self$edges <- edges_local
       return(invisible(NULL))
     },

     #' @description Computes the resistance metric between the vertices in the
     #' mesh.
     #' @return No return value. Called for its side effects. The geodesic distances
     #' on the mesh are stored in the `mesh$res_dist` element in the `metric_graph`
     #' object.
     compute_resdist_mesh = function() {
       if (is.null(self$mesh)) {
         stop("no mesh provided")
       }
       if(is.null(self$mesh$geo_dist)){
         self$compute_geodist_mesh()
       }
       L <- Matrix(0, dim(self$mesh$V)[1], dim(self$mesh$V)[1])
       for (i in 1:dim(self$mesh$E)[1]) {
         tmp <- -1 / self$mesh$geo_dist[self$mesh$E[i, 1], self$mesh$E[i, 2]]
         L[self$mesh$E[i, 2], self$mesh$E[i, 1]] <- tmp
         L[self$mesh$E[i, 1], self$mesh$E[i, 2]] <- tmp
       }
       for (i in 1:dim(self$mesh$V)[1]) {
         L[i, i] <- -sum(L[i, -i])
       }
       L[1, 1] <- L[1, 1] + 1

       Li <- solve(L)
       self$mesh$res_dist <- -2*Li + t(diag(Li)) %x% rep(1,dim(self$mesh$V)[1]) +
         t(rep(1,dim(self$mesh$V)[1])) %x% diag(Li)
     },


     #' @description Computes the weigthed graph Laplacian for the graph.
     #' @param full Should the resistance distances be computed for all
     #' the available locations. If `FALSE`, it will be computed
     #' separately for the locations of each group.
     #' @param obs Should the resistance distances be computed at the observation
     #' locations? It will only compute for locations in which there is at least
     #' one observations that is not NA.
     #' @param group Vector or list containing which groups to compute the
     #' Laplacian for. If `NULL`, it will be computed for all groups.
     #' @param verbose Print progress of the computation of the Laplacian.
     #' There are 3 levels of verbose, level 0, 1 and 2. In level 0, no messages
     #' are printed. In level 1, only messages regarding important steps are printed.
     #' Finally, in level 2, messages detailing all the steps are printed.
     #' The default is 1.
     #' @return No reutrn value. Called for its side effects. The Laplacian is stored
     #' in the `Laplacian` element in the `metric_graph` object.
     compute_laplacian = function(full = FALSE, obs = TRUE, group = NULL, verbose = 0) {
       self$Laplacian <- list()
       if(is.null(private$data)){
         obs <- FALSE
       }
       if(!obs){
         graph.temp <- self$clone()
         graph.temp$build_mesh(h=1000)

         PtE <- graph.temp$mesh$VtE[1:nrow(self$V),]
         rm(graph.temp)
         self$Laplacian[[".vertices"]] <- private$compute_laplacian_PtE(PtE,
                                                                        normalized = TRUE,
                                                                        verbose = verbose)
       } else if(full){
         PtE <- self$get_PtE()
         self$Laplacian[[".complete"]] <- private$compute_laplacian_PtE(PtE,
                                                                        normalized = TRUE,
                                                                        verbose = verbose)
       } else{
         if(is.null(group)){
           group <- unique(private$data[[".group"]])
         }
         for(grp in group){
           data_grp <- select_group(private$data, grp)
           idx_notna <- idx_not_all_NA(data_grp)
           PtE <- cbind(data_grp[[".edge_number"]][idx_notna],
                        data_grp[[".distance_on_edge"]][idx_notna])
           if(nrow(PtE) == 0){
             stop("All the observations are NA.")
           }
           self$Laplacian[[grp]] <- private$compute_laplacian_PtE(PtE,
                                                                  normalized = TRUE,
                                                                  verbose = verbose)
         }
       }
     },

     #' @description Removes vertices of degree 2 from the metric graph.
     #' @return No return value. Called for its side effects.
     #' @param check_weights If `TRUE` will only prune edges with different weights.
     #' @param check_circles If `TRUE` will not prune a vertex such that the
     #' resulting edge is a circle.
     #' @param verbose Print progress of pruning. There are 3 levels of verbose,
     #' level 0, 1 and 2. In level 0, no messages are printed. In level 1, only
     #' messages regarding important steps are printed. Finally, in level 2,
     #' messages detailing all the steps are printed. The default is 1.
     #' @details
     #' Vertices of degree 2 are removed as long as the corresponding edges that
     #' would be merged are compatible in terms of direction.
     #'
     prune_vertices = function(check_weights = TRUE,
                               check_circles = TRUE,
                               verbose = FALSE){

       t <- system.time({
         degrees <- private$degrees$degrees

         problematic <- vapply(self$vertices,
                               function(vert) isTRUE(attr(vert, "problematic")),
                               logical(1))

         if((verbose > 0) && (sum(problematic) > 0)){
           message(paste(sum(problematic), "vertices were not pruned due to incompatible directions."))
         }

         # Weight pre-check (verbatim from the original): mark deg-2 vertices
         # whose two adjacent edges have different weights as problematic so the
         # chain walks below stop at weight boundaries.
         if (check_weights) {
           idx_tmp <- which(degrees == 2 & !problematic)
           problematic_weights <- rep(FALSE, self$nV)

           if (verbose == 2) {
             message("Checking weight compatibility")
           }

           start_deg <- match(idx_tmp, self$E[, 1], nomatch = 0)
           end_deg   <- match(idx_tmp, self$E[, 2], nomatch = 0)
           edges_tmp <- cbind(start_deg, end_deg)
           valid_edges <- rowSums(edges_tmp == 0) == 0

           if (any(valid_edges)) {
             edges_tmp <- edges_tmp[valid_edges, , drop = FALSE]
             idx_tmp <- idx_tmp[valid_edges]

             if (is.vector(private$edge_weights)) {
               cnd_tmp <- compare_with_na(
                 private$edge_weights[edges_tmp[, 1]],
                 private$edge_weights[edges_tmp[, 2]]
               )
             } else {
               cnd_tmp <- compare_with_na(
                 private$edge_weights[edges_tmp[, 1], , drop = FALSE],
                 private$edge_weights[edges_tmp[, 2], , drop = FALSE],
                 is_matrix = TRUE
               )
             }

             problematic_weights[idx_tmp] <- cnd_tmp
           }

           problematic <- (problematic | problematic_weights)

           if ((verbose > 0) && (sum(problematic_weights) > 0)) {
             message(paste(sum(problematic_weights), "vertices were not pruned due to incompatible weights. Turn 'check_weights' to FALSE to prune these vertices."))
           }
         }

         if (verbose > 0) {
           to.prune <- sum(degrees == 2 & !problematic)
           message(sprintf("removing %d vertices", to.prune))
         }

         # Pull state into locals (R6 active bindings are slow in tight loops)
         V          <- self$V
         E          <- self$E
         edges_loc  <- self$edges
         edge_len   <- self$edge_lengths
         edge_w     <- private$edge_weights
         ew_is_df   <- is.data.frame(edge_w)
         nV_loc     <- nrow(V)
         nE_loc     <- nrow(E)

         is_chain_v <- (degrees == 2L) & !problematic

         if (any(is_chain_v)) {

           # Vectorized adjacency build for chain vertices
           ea <- E[, 1L]; eb <- E[, 2L]
           mask_a <- is_chain_v[ea]
           mask_b <- is_chain_v[eb] & (ea != eb)

           v_list <- c(ea[mask_a],    eb[mask_b])
           e_list <- c(which(mask_a), which(mask_b))

           ord      <- order(v_list)
           v_sorted <- v_list[ord]
           e_sorted <- e_list[ord]

           chain_e1 <- integer(nV_loc)
           chain_e2 <- integer(nV_loc)
           dup      <- duplicated(v_sorted)
           first    <- !dup
           chain_e1[v_sorted[first]] <- e_sorted[first]
           chain_e2[v_sorted[dup]]   <- e_sorted[dup]

           # Walk chains
           edge_consumed  <- logical(nE_loc)
           vertex_visited <- logical(nV_loc)
           chains <- vector("list", 64L)
           chains_n <- 0L

           # Upper bound on any chain length: number of chain vertices + 1
           max_chain_len <- sum(is_chain_v) + 1L

           walk_chain <- function(start_v, start_e) {
             e_seq  <- integer(max_chain_len)
             o_seq  <- logical(max_chain_len)
             iv_seq <- integer(max_chain_len)
             n <- 0L; cur_v <- start_v; cur_e <- start_e
             repeat {
               n <- n + 1L
               a <- E[cur_e, 1L]; b <- E[cur_e, 2L]
               next_v <- if (a == cur_v) b else a
               e_seq[n] <- cur_e
               o_seq[n] <- (a == cur_v)
               edge_consumed[cur_e] <<- TRUE
               if (!is_chain_v[next_v]) {
                 return(list(e = e_seq[seq_len(n)], o = o_seq[seq_len(n)],
                             iv = iv_seq[seq_len(n - 1L)], anchor_b = next_v))
               }
               iv_seq[n] <- next_v
               vertex_visited[next_v] <<- TRUE
               e_other <- if (chain_e1[next_v] == cur_e) chain_e2[next_v] else chain_e1[next_v]
               if (e_other == 0L || edge_consumed[e_other]) {
                 return(list(e = e_seq[seq_len(n)], o = o_seq[seq_len(n)],
                             iv = iv_seq[seq_len(n - 1L)], anchor_b = next_v))
               }
               cur_v <- next_v; cur_e <- e_other
             }
           }

           # 1) open chains
           for (k in seq_len(nE_loc)) {
             if (edge_consumed[k]) next
             a <- E[k, 1L]; b <- E[k, 2L]
             if (a == b) { edge_consumed[k] <- TRUE; next }
             a_chain <- is_chain_v[a]; b_chain <- is_chain_v[b]
             if (a_chain && b_chain) next
             if (!a_chain) { start_v <- a; other <- b } else { start_v <- b; other <- a }
             if (!is_chain_v[other]) { edge_consumed[k] <- TRUE; next }
             walk <- walk_chain(start_v, k)
             chains_n <- chains_n + 1L
             if (chains_n > length(chains)) length(chains) <- 2L * length(chains)
             chains[[chains_n]] <- list(
               anchor_a = start_v, anchor_b = walk$anchor_b,
               e = walk$e, o = walk$o, iv = walk$iv,
               is_cycle = (start_v == walk$anchor_b)
             )
           }

           # 2) closed cycle chains (handled by serial fallback below; we just
           #    need to NOT touch their edges/vertices in the batch step)

           # Apply per-chain merges
           edge_drop <- logical(nE_loc)
           vert_drop <- logical(nV_loc)
           prune_warning_local <- FALSE

           if (chains_n > 0L) {
             for (ci in seq_len(chains_n)) {
               ch <- chains[[ci]]
               if (ch$is_cycle) next   # leave for serial fallback

               e_ids  <- ch$e
               orient <- ch$o
               n_seg  <- length(e_ids)

               # Pre-compute total row count for the merged edge
               lens <- numeric(n_seg)
               nrows_seg <- integer(n_seg)
               for (s in seq_len(n_seg)) {
                 ed_k <- e_ids[s]
                 nr <- nrow(edges_loc[[ed_k]])
                 lens[s] <- edge_len[ed_k]
                 nrows_seg[s] <- if (s == 1L) nr else nr - 1L
               }
               total_rows <- sum(nrows_seg)
               merged_len <- sum(lens)

               # Pre-allocate merged coordinate matrix and PtE vector
               merged_coords <- matrix(NA_real_, nrow = total_rows, ncol = 2L)
               merged_pte    <- numeric(total_rows)
               seg_starts    <- c(0, cumsum(lens)[-n_seg])

               row_cursor <- 0L
               for (s in seq_len(n_seg)) {
                 ed_k <- e_ids[s]
                 ec   <- unclass(edges_loc[[ed_k]])
                 pte  <- attr(edges_loc[[ed_k]], "PtE")
                 if (!orient[s]) {
                   ec  <- ec[nrow(ec):1L, , drop = FALSE]
                   pte <- 1 - rev(pte)
                 }
                 if (s > 1L) {
                   ec  <- ec[-1L, , drop = FALSE]
                   pte <- pte[-1L]
                 }
                 nr <- nrows_seg[s]
                 idx <- row_cursor + seq_len(nr)
                 merged_coords[idx, ] <- ec
                 merged_pte[idx] <- (seg_starts[s] + pte * lens[s]) / merged_len
                 row_cursor <- row_cursor + nr
               }
               attr(merged_coords, "PtE") <- merged_pte

               slot <- min(e_ids)
               edges_loc[[slot]] <- merged_coords
               edge_len[slot]    <- merged_len
               E[slot, ]         <- c(ch$anchor_a, ch$anchor_b)

               dropped <- e_ids[e_ids != slot]
               edge_drop[dropped] <- TRUE
               vert_drop[ch$iv] <- TRUE

               # If check_weights is FALSE, the chain may span weight boundaries;
               # warn if any edge in the chain has a weight different from slot.
               if (!check_weights && length(dropped) > 0L) {
                 if (!ew_is_df) {
                   # Vectorized comparison for scalar weights
                   if (any(compare_with_na(edge_w[dropped], edge_w[slot]))) {
                     prune_warning_local <- TRUE
                   }
                 } else {
                   w_slot <- edge_w[slot, , drop = FALSE]
                   for (ed_k in dropped) {
                     wk <- edge_w[ed_k, , drop = FALSE]
                     if (isTRUE(compare_with_na(wk, w_slot, is_matrix = TRUE))) {
                       prune_warning_local <- TRUE; break
                     }
                   }
                 }
               }
             }

             # Build edge remap for fast data location update:
             # For each old edge, record (slot_edge, offset, flipped, merged_length)
             # so observation PtE can be recomputed analytically in O(N).
             edge_remap_slot   <- seq_len(nE_loc)  # default: maps to itself
             edge_remap_offset <- numeric(nE_loc)   # cumulative offset in merged edge
             edge_remap_mlen   <- edge_len          # merged edge total length
             edge_remap_flip   <- logical(nE_loc)   # whether this segment was flipped
             edge_len_orig     <- self$edge_lengths  # snapshot before merge modifies edge_len

             for (ci in seq_len(chains_n)) {
               ch <- chains[[ci]]
               if (ch$is_cycle) next
               e_ids  <- ch$e
               orient <- ch$o
               slot   <- min(e_ids)
               cum_off <- 0
               for (s in seq_along(e_ids)) {
                 eid <- e_ids[s]
                 edge_remap_slot[eid]   <- slot
                 edge_remap_offset[eid] <- cum_off
                 edge_remap_flip[eid]   <- !orient[s]
                 edge_remap_mlen[eid]   <- edge_len[slot]
                 cum_off <- cum_off + edge_len_orig[eid]
               }
             }

             # Compact: keep surviving rows/elements only, relabel E
             keep_e <- !edge_drop
             # Build old-to-new edge index mapping
             old_to_new_e <- integer(nE_loc)
             old_to_new_e[keep_e] <- seq_len(sum(keep_e))
             edge_remap_new_idx <- old_to_new_e[edge_remap_slot]

             edges_loc <- edges_loc[keep_e]
             edge_len  <- edge_len[keep_e]
             E         <- E[keep_e, , drop = FALSE]
             edge_w    <- if (ew_is_df) edge_w[keep_e, , drop = FALSE] else edge_w[keep_e]

             keep_v <- !vert_drop
             V <- V[keep_v, , drop = FALSE]
             remap <- integer(nV_loc)
             remap[keep_v] <- seq_len(sum(keep_v))
             E[, 1L] <- remap[E[, 1L]]
             E[, 2L] <- remap[E[, 2L]]

             # Write back to self in one shot
             self$V <- V
             self$E <- E
             self$edges <- edges_loc
             self$edge_lengths <- edge_len
             self$nV <- nrow(V)
             self$nE <- nrow(E)
             private$edge_weights <- edge_w
             if (prune_warning_local) private$prune_warning <- TRUE
           }
         }

         # Serial fallback for any residual loop chains
         # After the batch step, the only remaining deg-2 non-problematic vertices
         # are those on closed loops (chains whose anchors are the same vertex).
         #
         # We check cheaply via tabulate(E) on the new E and the "old" problematic
         # flags carried through the keep_v subset, avoiding any R6 active-binding
         # roundtrip.
         needs_fallback <- FALSE
         if (any(is_chain_v)) {
           new_deg <- tabulate(self$E[, 1], nbins = self$nV) +
             tabulate(self$E[, 2], nbins = self$nV)
           # `problematic` indexed at OLD vertex ids -> map through keep_v survivors
           if (exists("keep_v", inherits = FALSE)) {
             new_prob <- problematic[keep_v]
           } else {
             new_prob <- problematic
           }
           needs_fallback <- any(new_deg == 2L & !new_prob)
         }
         if (needs_fallback) {
           # Refresh self$vertices and degrees so the serial helper sees consistent
           # state.
           private$compute_degrees(add = TRUE)
           private$create_update_vertices(verbose = 0)
           deg_now <- private$degrees$degrees
           prob_now <- vapply(self$vertices,
                             function(vert) isTRUE(attr(vert, "problematic")),
                             logical(1))
           res <- list(
             degrees = deg_now,
             problematic = prob_now,
             problematic_circles = rep(FALSE, length(deg_now))
           )
           while (sum(res$degrees == 2 & !res$problematic & !res$problematic_circles) > 0) {
             res <- private$remove.first.deg2(res, check_circles = check_circles)
           }
           if (verbose == 2 && !is.null(res$circles_avoided)) {
             message(paste(sum(res$problematic_circles),
                           "vertices were not pruned in order to avoid creating circles. Turn 'check_circles' to FALSE to prune these vertices."))
           }
         }
       })
       if(verbose  == 2){
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }
       # if(verbose && to.prune > 0){
       #   close(pb)
       # }

       t <- system.time({
         private$create_update_vertices(verbose=verbose)
         # creating/updating reference edges
         private$ref_edges <- map_into_reference_edge(self, verbose=verbose)
         if(verbose==2){
           message("Updating attributes of the edges")
           bar_update_attr_edges <- msg_progress_bar(length(self$edges))
         }

         edge_lengths_ <- self$get_edge_lengths()

         # Hoist R6 active bindings out of the per-edge closure
         ew_local        <- private$edge_weights
         ew_is_vec       <- is.vector(ew_local)
         longlat_local   <- private$longlat
         crs_local       <- private$crs$input
         kw_local        <- private$kirchhoff_weights
         dw_local        <- private$directional_weights
         edges_local     <- self$edges
         nE_now          <- self$nE

         if (verbose == 2) {
           for (i in seq_len(nE_now)) {
             edge <- edges_local[[i]]
             if (ew_is_vec) {
               attr(edge, "weight") <- ew_local[i]
             } else {
               attr(edge, "weight") <- ew_local[i, , drop = FALSE]
             }
             attr(edge, "longlat")             <- longlat_local
             attr(edge, "crs")                 <- crs_local
             attr(edge, "length")              <- edge_lengths_[i]
             attr(edge, "id")                  <- i
             attr(edge, "kirchhoff_weight")    <- kw_local
             attr(edge, "directional_weights") <- dw_local
             class(edge) <- "metric_graph_edge"
             edges_local[[i]] <- edge
             bar_update_attr_edges$increment()
           }
         } else {
           # Fast path: lapply avoids repeated copy-on-modify of the list spine
           edges_local <- lapply(seq_len(nE_now), function(i) {
             edge <- edges_local[[i]]
             if (ew_is_vec) {
               attr(edge, "weight") <- ew_local[i]
             } else {
               attr(edge, "weight") <- ew_local[i, , drop = FALSE]
             }
             attr(edge, "longlat")             <- longlat_local
             attr(edge, "crs")                 <- crs_local
             attr(edge, "length")              <- edge_lengths_[i]
             attr(edge, "id")                  <- i
             attr(edge, "kirchhoff_weight")    <- kw_local
             attr(edge, "directional_weights") <- dw_local
             class(edge) <- "metric_graph_edge"
             edge
           })
         }
         class(edges_local) <- "metric_graph_edges"
         self$edges <- edges_local

       })
       if(verbose == 2){
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }


      if (!is.null(private$data)) {
        if (verbose > 0) {
          message("Updating data locations.")
        }

        t <- system.time({
          has_remap <- exists("edge_remap_new_idx", inherits = FALSE) &&
            exists("needs_fallback", inherits = FALSE) &&
            !needs_fallback

          if (has_remap) {
            # Fast analytical remap: update old (edge, distance) to new
            # (edge, distance) after batch pruning.
            old_en  <- private$data[[".edge_number"]]
            old_doe <- private$data[[".distance_on_edge"]]

            old_len <- edge_len_orig[old_en]

            new_en <- as.numeric(edge_remap_new_idx[old_en])

            new_doe <- (
              edge_remap_offset[old_en] +
                ifelse(
                  edge_remap_flip[old_en],
                  (1 - old_doe) * old_len,
                  old_doe * old_len
                )
            ) / edge_remap_mlen[old_en]

            private$data[[".edge_number"]] <- new_en
            private$data[[".distance_on_edge"]] <- new_doe

          } else {
            # Safe fallback: recompute graph locations from stored spatial coords.
            x_coord <- private$data[[".coord_x"]]
            y_coord <- private$data[[".coord_y"]]

            new_PtE <- self$coordinates(XY = cbind(x_coord, y_coord))

            private$data[[".edge_number"]] <- new_PtE[, 1]
            private$data[[".distance_on_edge"]] <- new_PtE[, 2]
          }

          # Re-standardize positions after pruning.
          # This handles boundary cases such as distance_on_edge == 1 being moved
          # to the reference edge with distance_on_edge == 0.
          private$data <- standardize_df_positions(
            private$data,
            self,
            edge_number = ".edge_number",
            distance_on_edge = ".distance_on_edge"
          )

          # Sort rows in the canonical internal order.
          group_vec <- private$data[[".group"]]
          if (is.null(group_vec)) {
            group_vec <- rep(1L, length(private$data[[".edge_number"]]))
          }

          order_idx <- order(
            group_vec,
            private$data[[".edge_number"]],
            private$data[[".distance_on_edge"]]
          )

          old_group_variables <- attr(private$data, "group_variables")

          private$data <- lapply(private$data, function(dat) {
            dat[order_idx]
          })

          attr(private$data, "group_variables") <- old_group_variables
          class(private$data) <- unique(c("metric_graph_data", class(private$data)))

          # Rebuild .loc_idx from the NEW canonical locations.
          #
          # This is the important missing part. The old .loc_idx refers to unique
          # locations before pruning, so it may no longer match the new
          # (.edge_number, .distance_on_edge) pairs.
          e <- private$data[[".edge_number"]]
          d <- private$data[[".distance_on_edge"]]

          uloc <- unique(data.frame(
            e = e,
            d = d
          ))

          uloc <- uloc[order(uloc$e, uloc$d), , drop = FALSE]

          row_key <- paste(e, d, sep = "|")
          loc_key <- paste(uloc$e, uloc$d, sep = "|")

          private$data[[".loc_idx"]] <- match(row_key, loc_key)

          # Refresh stored spatial coordinates from the new graph representation.
          #
          # This should usually reproduce the same coordinates, but it keeps the
          # internal representation fully consistent after pruning and after
          # standardize_df_positions().
          xy <- self$coordinates(
            PtE = cbind(
              private$data[[".edge_number"]],
              private$data[[".distance_on_edge"]]
            ),
            normalized = TRUE
          )

          private$data[[".coord_x"]] <- xy[, 1]
          private$data[[".coord_y"]] <- xy[, 2]
        })

        if (verbose == 2) {
          message(sprintf("time: %.3f s", t[["elapsed"]]))
        }
      }

      if (!is.null(self$mesh)) {
        max_h <- max(self$mesh$h_e)
      
        old_continuous <- attr(self$mesh, "continuous")
        old_continuous_outs <- attr(self$mesh, "continuous.outs")
        old_continuous_deg2 <- attr(self$mesh, "continuous.deg2")
      
        if (is.null(old_continuous)) old_continuous <- TRUE
        if (is.null(old_continuous_outs)) old_continuous_outs <- FALSE
        if (is.null(old_continuous_deg2)) old_continuous_deg2 <- FALSE
      
        self$mesh <- NULL
        self$build_mesh(
          h = max_h,
          continuous = old_continuous,
          continuous.outs = old_continuous_outs,
          continuous.deg2 = old_continuous_deg2
        )
      }

       self$C <- NULL
       self$CoB <- NULL

       private$pruned <- TRUE
       private$degrees <- NULL
       # Pruning rewrites E / V / nE / nV, so the cached component
       # decomposition is now stale. Recompute the membership vector and
       # invalidate the lazy per-component metric_graph snapshot so that
       # `is_disconnected()`, `which_component()`, and `get_components()`
       # see the post-prune topology.
       private$compute_component_membership()
       private$components_cache <- NULL
       if(private$prune_warning){
         warning("At least two edges with different weights were merged due to pruning. Only one of the weights has been assigned to the merged edge. Please, review carefully.")
         private$prune_warning <- FALSE
       }
     },

     #' @description Gets the groups from the data.
     #' @param edge_lengths edge lengths to be set to the metric graph edges.
     #' @param unit set or override the edge lengths unit.
     #' @return does not return anything. Called for its side effects.
     set_manual_edge_lengths = function(edge_lengths, unit = NULL){
       if(is.null(edge_lengths)){
         warning("edge_lengths is NULL, edge lengths were not set.")
         return(invisible(NULL))
       }
       if(length(edge_lengths)!=length(self$edges)){
         stop("edge_lengths must have length equal to the number of edges.")
       }
       private$manual_edge_lengths <- TRUE
       self$edge_lengths <- edge_lengths
       private$length_unit <- unit
       # Components are sorted by total edge length; updating the lengths
       # may permute the component ordering. Recompute the membership and
       # invalidate the per-component snapshot.
       private$compute_component_membership()
       private$components_cache <- NULL
       return(invisible(NULL))
     },

     #' @description Gets the groups from the data.
     #' @param get_cols Should the names of the columns that created the group
     #' variable be returned?
     #' @return A vector containing the available groups in the internal data.

     get_groups = function(get_cols = FALSE){
       if(is.null(private$data)){
         warning("There is no data!")
         return(invisible(NULL))
       }
       if(get_cols){
         return(private$group_col)
       }
       return(unique(private$data[[".group"]]))
     },

     #' @description Gets PtE from the data.
     #' @param group For which group, should the PtE be returned? `NULL` means
     #' that all PtEs available will be returned.
     #' @param include_group Should the group be included as a column? If `TRUE`,
     #' the PtEs for each group will be concatenated, otherwise a single matrix
     #' containing the unique PtEs will be returned.
     #' @return A matrix with two columns, where the first column contains the edge
     #' number and the second column contains the distance on edge of the
     #' observation locations.
     get_PtE = function() {
       if(is.null(private$data)){
         warning("There is no data!")
         return(invisible(NULL))
       }
       # Return all unique (edge, dist) pairs across all groups, sorted numerically.
       # In the common case (same locations for all groups) this equals the
       # first-group locations; for LGCP-style replicates with different events
       # per replicate this returns the full union.
       if (!is.null(private$data[[".loc_idx"]])) {
         # Sparse format: reconstruct unique locs from .loc_idx ordering
         e <- private$data[[".edge_number"]]
         d <- private$data[[".distance_on_edge"]]
         idx <- private$data[[".loc_idx"]]
         # Re-order by .loc_idx to get unique locations in canonical order
         ord_uniq <- order(idx, e, d)
         keep <- !duplicated(idx[ord_uniq])
         e_u <- e[ord_uniq][keep]
         d_u <- d[ord_uniq][keep]
         return(cbind(e_u, d_u))
       }
       # Legacy full-grid format: first group's locations (same for all groups)
       group <- private$data[[".group"]]
       group <- which(group == group[1])
       PtE <- cbind(private$data[[".edge_number"]][group],
                    private$data[[".distance_on_edge"]][group])
       return(PtE)
     },

     #' @description Gets the edge lengths with the corresponding unit.
     #' @param unit If non-NULL, changes from `length_unit` from the graph
     #' construction to `unit`.
     #' @return a vector with the length unit (if the graph was constructed with
     #' a length unit).

     get_edge_lengths = function(unit = NULL){
       el <- self$edge_lengths
       units(el) <- private$length_unit
       if(!is.null(unit)){
         units(el) <- unit
       }
       names(el) <- NULL
       return(el)
     },

     #' @description Gets the spatial locations from the data.
     #' @return A `data.frame` object with observation locations. If `longlat = TRUE`,
     #' the column names are lon and lat, otherwise the column names are x and y.
     get_locations = function(){
       if(is.null(private$data)){
         warning("There is no data!")
         return(invisible(NULL))
       }
       group <- private$data[[".group"]]
       group <- which(group == group[1])
       Spoints <- data.frame(x = private$data[[".coord_x"]][group],
                             y = private$data[[".coord_y"]][group])
       if(private$longlat){
         colnames(Spoints) <- c("lon", "lat")
       }
       return(Spoints)
     },

     #' @description Adds observation locations as vertices in the graph.
     #' @param share_weights Should the same weight be shared among the split
     #' edges? If `FALSE`, the weights will be removed, and a common weight given
     #' by 1 will be given.
     #' @param mesh_warning Display a warning if the graph structure change and
     #' the metric graph has a mesh object.
     #' @param verbose Print progress of the steps when adding observations.
     #' There are 3 levels of verbose, level 0, 1 and 2. In level 0, no messages
     #' are printed. In level 1, only messages regarding important steps are
     #' printed. Finally, in level 2, messages detailing all the steps are printed.
     #' The default is 1.
     #' @param tolerance `r lifecycle::badge("deprecated")`. Not used anymore
     #' @return No return value. Called for its side effects.
     observation_to_vertex = function(mesh_warning = TRUE,
                                      verbose = 0,
                                      tolerance = deprecated()) {
       if (lifecycle::is_present(tolerance)) {
         lifecycle::deprecate_warn("1.3.0.9000", "observation_to_vertex(tolerance)")
       }

       if (is.null(private$data)) {
         stop("There is no data!")
       }

       if (verbose > 1) message("Extracting observation locations...")

       edge_numbers <- private$data[[".edge_number"]]
       distances    <- private$data[[".distance_on_edge"]]
       loc_idx_orig <- private$data[[".loc_idx"]]

       # Build unique-location table
       # Sparse format: .loc_idx maps each row to its unique (edge, dist).
       # Fall back to first-group approach when .loc_idx is absent (legacy).
       if (!is.null(loc_idx_orig)) {
         n_unique <- max(loc_idx_orig)
         ord_by_idx <- order(loc_idx_orig)
         keep_first <- !duplicated(loc_idx_orig[ord_by_idx])
         unique_e <- edge_numbers[ord_by_idx][keep_first]
         unique_d <- distances[ord_by_idx][keep_first]
       } else {
         # Legacy full-grid: all groups share the same first-group locations
         grp      <- private$data[[".group"]]
         fg_mask  <- grp == grp[1]
         unique_e <- edge_numbers[fg_mask]
         unique_d <- distances[fg_mask]
         n_unique <- sum(fg_mask)
         loc_idx_orig <- rep(seq_len(n_unique), length(unique(grp)))
       }

       # temp_PtE columns: [edge, dist, unique_loc_idx]
       private$temp_PtE <- cbind(unique_e, unique_d, seq_len(n_unique))
       ptv_local <- rep(NA_integer_, n_unique)

       # Classify unique locations
       is_start_vertex <- unique_d < 1e-15
       is_end_vertex   <- unique_d > 0.999999999999999

       E_local <- self$E
       if (any(is_start_vertex)) {
         idx <- which(is_start_vertex)
         ptv_local[idx] <- E_local[unique_e[idx], 1]
       }
       if (any(is_end_vertex)) {
         idx <- which(is_end_vertex)
         ptv_local[idx] <- E_local[unique_e[idx], 2]
       }

       # plit interior locations
       remaining_mask  <- !(is_start_vertex | is_end_vertex)
       remaining_count <- sum(remaining_mask)

       if (remaining_count > 0) {
         if (verbose > 1) message("Grouping observations by edges...")
         remaining_data <- private$temp_PtE[remaining_mask, , drop = FALSE]
         edge_ids       <- remaining_data[, 1]
         edge_groups    <- split.data.frame(remaining_data[, c(2, 3),
                                                           drop = FALSE],
                                            edge_ids)

         # split_edges_batch_cpp computes segment_lengths as the successive
         # differences (t[j] - t[j-1]) * edge_len and assumes monotone-
         # increasing t-values within each edge group. Group input order is
         # determined by the upstream sort (loc_idx), which after
         # prune_vertices' chain merges is no longer monotone in t per edge.
         # Sort each group's t-values ascending here to keep that invariant
         # and avoid negative segment lengths.
         edge_groups <- lapply(edge_groups, function(g) {
           if (is.matrix(g)) {
             if (nrow(g) > 1L) g[order(g[, 1]), , drop = FALSE] else g
           } else if (is.data.frame(g)) {
             if (nrow(g) > 1L) g[order(g[[1]]), , drop = FALSE] else g
           } else g
         })

         if (verbose == 2) {
           bar_otv <- msg_progress_bar(length(edge_groups))
           message("Processing edge splits in batches...")
         }

         new_vertices_list <- private$split_edge_batch(edge_groups,
                                                       verbose = verbose)

         for (i in seq_along(edge_groups)) {
           gdi     <- edge_groups[[i]]
           indices <- if (is.matrix(gdi)) gdi[, 2] else gdi[2]
           nvi     <- new_vertices_list[[i]]
           if (length(nvi) > 0) ptv_local[indices] <- nvi
           if (verbose == 2) bar_otv$increment()
         }
       }

       # Update temp_PtE edge numbers after graph changes
       # Edge numbering may shift after splits; remap boundary observations.
       # split_edge_batch may have mutated self$E, so re-fetch.
       E_local <- self$E
       valid_ptv <- !is.na(ptv_local)
       if (any(is_start_vertex & valid_ptv)) {
         idx <- which(is_start_vertex & valid_ptv)
         private$temp_PtE[idx, 1] <- match(ptv_local[idx], E_local[, 1])
         private$temp_PtE[idx, 2] <- 0
       }
       if (any(is_end_vertex & valid_ptv)) {
         idx <- which(is_end_vertex & valid_ptv)
         private$temp_PtE[idx, 1] <- match(ptv_local[idx], E_local[, 2])
         private$temp_PtE[idx, 2] <- 1
       }
       self$PtV <- ptv_local[!is.na(ptv_local)]  # compact (defensive), single flush

       # Propagate updated (edge, dist) to every data row via loc_idx
       if (verbose > 1) message("Updating data structures...")

       private$data[[".edge_number"]]      <- private$temp_PtE[loc_idx_orig, 1]
       private$data[[".distance_on_edge"]] <- private$temp_PtE[loc_idx_orig, 2]

       # Re-sort all rows and rebuild .loc_idx
       index_order <- order(private$data[[".group"]],
                            private$data[[".edge_number"]],
                            private$data[[".distance_on_edge"]])

       old_group_variables <- attr(private$data, "group_variables")
       private$data       <- lapply(private$data, `[`, index_order)
       attr(private$data, "group_variables") <- old_group_variables

       private$temp_PtE <- NULL

       self$geo_dist <- NULL
       self$res_dist <- NULL
       if (!is.null(self$CoB)) self$buildC(2)

       if (!is.null(self$mesh)) {
         self$mesh <- NULL
         if (mesh_warning) {
           warning("Removing the existing mesh due to the change in the graph structure, please create a new mesh if needed.")
         }
       }

       private$ref_edges <- map_into_reference_edge(self, verbose = verbose)
       private$data <- standardize_df_positions(private$data, self,
                                                edge_number = ".edge_number",
                                                distance_on_edge = ".distance_on_edge")
       private$create_update_vertices(verbose = verbose)

       # Rebuild .loc_idx and PtV from canonical post-standardize positions.
       # standardize_df_positions may remap dist=1 obs to (ref_edge, 0), which
       # can change sort order. Re-sort data and rebuild .loc_idx from scratch.
       # PtV is rebuilt via ref_edges reverse-lookup (canonical vertex positions).
       new_e_fin <- private$data[[".edge_number"]]
       new_d_fin <- private$data[[".distance_on_edge"]]
       idx_sort  <- order(private$data[[".group"]], new_e_fin, new_d_fin)
       if (!identical(idx_sort, seq_along(idx_sort))) {
         old_gv_fin <- attr(private$data, "group_variable")
         private$data <- lapply(private$data, `[`, idx_sort)
         attr(private$data, "group_variable") <- old_gv_fin
         new_e_fin <- private$data[[".edge_number"]]
         new_d_fin <- private$data[[".distance_on_edge"]]
       }
       sep_fin    <- "|"
       uloc_fin   <- unique(data.frame(e = new_e_fin, d = new_d_fin))
       uloc_fin   <- uloc_fin[order(uloc_fin$e, uloc_fin$d), , drop = FALSE]
       ukey_fin   <- paste(uloc_fin$e, uloc_fin$d, sep = sep_fin)
       rkey_fin   <- paste(new_e_fin, new_d_fin, sep = sep_fin)
       private$data[[".loc_idx"]] <- match(rkey_fin, ukey_fin)
       # Each canonical (edge, dist) maps to exactly one vertex via ref_edges
       ref_key_fin <- paste(private$ref_edges[, 1], private$ref_edges[, 2],
                            sep = sep_fin)
       self$PtV    <- match(ukey_fin, ref_key_fin)

       self$set_edge_weights(
         weights              = private$edge_weights,
         kirchhoff_weights    = private$kirchhoff_weights,
         directional_weights  = private$directional_weights,
         verbose              = verbose
       )
     },


     #' @description Turns edge weights into data on the metric graph
     #' @param loc A `matrix` or `data.frame` with two columns containing the
     #' locations to generate the data from the edge weights. If `data_coords`
     #' is 'spatial', the first column must be the x-coordinate of the data, and
     #' the second column must be the y-coordinate. If `data_coords` is 'PtE', the
     #' first column must be the edge number and the second column must be the
     #' distance on edge.
     #' @param data_loc Should the data be generated to the data locations? In
     #' this case, the `loc` argument will be ignored. Observe that the metric
     #' graph must have data for one to use this option. CAUTION: To add edgeweight
     #' to data to both the data locations and mesh locations, please, add at the
     #' data locations first, then to mesh locations.
     #' @param mesh Should the data be generated to the mesh locations? In this
     #' case, the `loc` argument will be ignored. Observe that the metric graph
     #' must have a mesh built for one to use this option. CAUTION: To add
     #' edgeweight to data to both the data locations and mesh locations, please,
     #' add at the data locations first, then to mesh locations.
     #' @param weight_col Which columns of the edge weights should be turned into
     #' data? If `NULL`, all columns will be turned into data.
     #' @param add Should the data generated be added to the metric graph
     #' internal data?
     #' @param data_coords To be used only if `mesh` is `FALSE`. It decides which
     #' coordinate system to use. If `PtE`, the user must provide `edge_number` and
     #' `distance_on_edge`, otherwise if `spatial`, the user must provide
     #' `coord_x` and `coord_y`.
     #' @param normalized if TRUE, then the distances in `distance_on_edge` are
     #' assumed to be normalized to (0,1). Default FALSE.
     #' @param tibble Should the data be returned in a `tibble` format?
     #' @param format If `return` is `TRUE`, the format of the output: "tibble",
     #' "sf", or "sp". Default is "tibble".
     #' @param verbose Print progress of the steps when adding observations.
     #' There are 3 levels of verbose, level 0, 1 and 2. In level 0, no messages
     #' are printed. In level 1, only messages regarding important steps are printed.
     #' Finally, in level 2, messages detailing all the steps are printed.
     #' The default is 1.
     #' @param suppress_warnings Suppress warnings related to duplicated observations?
     #' @param return Should the data be returned? If `return_removed` is `TRUE`,
     #' only the removed locations will be return (if there is any).
     edgeweight_to_data = function(loc = NULL, mesh = FALSE,
                                   data_loc = FALSE,
                                   weight_col = NULL, add = TRUE,
                                   data_coords = c("PtE", "spatial"),
                                   normalized = FALSE,
                                   tibble = FALSE,
                                   format = c("tibble", "sf", "sp", "list"),
                                   verbose = 1,
                                   suppress_warnings = FALSE,
                                   return = FALSE){

       if(is.null(loc) && !mesh && !data_loc){
         stop("Either 'loc' must be provided, 'mesh' must be TRUE or 'data_loc' must be TRUE.")
       }
       if(mesh){
         if(is.null(self$mesh)){
           stop("There is no mesh! Build a mesh using the build_mesh() method.")
         }
         loc <- self$mesh$VtE
         normalized <- TRUE
         data_coords <- "PtE"
       }

       if(data_loc){
         if(is.null(private$data)){
           stop("The graph has no data!")
         }
         loc <- self$get_PtE()
         normalized <- TRUE
         data_coords <- "PtE"
       }

       data_coords <- data_coords[[1]]

       if(tolower(data_coords) == "pte"){
         df_ew <- data.frame(.edge_number = loc[,1],
                             .distance_on_edge = loc[,2])
         if(normalized){
           if(max(loc[,2])>1){
             stop("distance_on_edge of normalized locations cannot be greater than 1!")
           }
         }
       } else if(tolower(data_coords) == "spatial"){
         loc_tmp <- self$coordinates(XY = loc)
         nr_tmp <- nrow(loc_tmp)
         loc_tmp <- unique(loc_tmp)
         if(nr_tmp != nrow(loc_tmp)){
           if(!suppress_warnings){
             warning("Some locations were projected to the same point of the metric graph and were not considered.")
           }
         }
         df_ew <- data.frame(.edge_number = loc_tmp[,1],
                             .distance_on_edge = loc_tmp[,2])
         normalized <- TRUE
       } else{
         stop("'data_coords' must be either 'PtE' or 'spatial'!")
       }

       if(!is.null(private$data[[".group"]])){
         df_ew <- cbind(df_ew, .group = rep(unique(private$data[[".group"]]),
                                            each = nrow(df_ew)))
       }

       ew <- private$get_edge_weights_internal()

       if(is.vector(ew)){
         ew <- data.frame(.weight = ew)
       }

       if(!is.null(weight_col)){
         ew <- ew[, weight_col, drop=FALSE]
       }

       ew[[".edge_number"]] <- 1:nrow(ew)

       ew[[".edge_lengths"]] <- self$edge_lengths

       df_ew <- merge(df_ew, ew, by = ".edge_number")

       if(!normalized){
         if(max(df_ew[[".distance_on_edge"]]/df_ew[[".edge_lengths"]]) > 1){
           stop("There is at least one distance on edge that is greater than the corresponding edge length!")
         }
       }

       df_ew[[".edge_lengths"]] <- NULL

       if(add){
         self$add_observations(data = df_ew,
                               edge_number = ".edge_number",
                               distance_on_edge = ".distance_on_edge",
                               data_coords = "PtE",
                               group = ".group",
                               tibble = tibble,
                               normalized = normalized,
                               verbose = verbose)
       }

       if(return){
         return(self$process_data(data = df_ew,
                                  edge_number = ".edge_number",
                                  distance_on_edge = ".distance_on_edge",
                                  data_coords = "PtE",
                                  group = ".group",
                                  normalized = normalized,
                                  format = format,
                                  verbose = verbose))
       } else{
         return(invisible(NULL))
       }
     },

     #' @description Returns a list or a matrix with the mesh locations.
     #' @param bru Should an 'inlabru'-friendly list be returned?
     #' @param loc If `bru` is set to `TRUE`, the column names of the location
     #' variables.
     #' The default name is `c('.edge_number', '.distance_on_edge')`.
     #' @param normalized If TRUE, then the distances in `distance_on_edge` are
     #' assumed to be normalized to (0,1). Default TRUE.
     #' @param loc_name The name of the location variables. Not needed for
     #' `rSPDE` models.
     #'
     #' @return A list or a matrix containing the mesh locations.
     get_mesh_locations = function(bru = FALSE,
                                   loc = c(".edge_number", ".distance_on_edge"),
                                   loc_name = NULL,
                                   normalized = TRUE) {
       if(is.null(self$mesh)){
         warning("There is no mesh!")
         return(invisible(NULL))
       }

       if(!bru){
         return(self$mesh$VtE)
       } else{
         if(is.null(loc)){
           stop("If bru is TRUE, then the loc argument must be provided!")
         }
         tmp_VtE <- self$mesh$VtE
         if(!normalized){
           tmp_VtE[,2] <- tmp_VtE[,2] * self$edge_lengths[tmp_VtE[, 1]]
         }
         data_list <- list()
         data_list[[loc[1]]] <- tmp_VtE[,1]
         data_list[[loc[2]]] <- tmp_VtE[,2]
         data_list <- as.data.frame(data_list)
         if(!is.null(loc_name)){
           ret_list <- list()
           ret_list[[loc_name]] <- data_list
           return(ret_list)
         }
         return(data_list)
       }
     },

     #' @description Clear all observations from the `metric_graph` object.
     #' @return No return value. Called for its side effects.
     clear_observations = function() {
       private$data <- NULL
       self$geo_dist <- NULL
       self$res_dist <- NULL
       self$PtV <- NULL
       private$components_cache <- NULL  # invalidate per-component snapshot
     },


     #' @description Process data to the metric graph data format.
     #' @param data A `data.frame` or named list containing the observations. In
     #' case of groups, the data.frames for the groups should be stacked vertically,
     #' with a column indicating the index of the group. If `data` is not `NULL`,
     #' it takes priority over any eventual data in `Spoints`.
     #' @param edge_number Column (or entry on the list) of the `data` that
     #' contains the edge numbers. If not supplied, the column with name
     #' "edge_number" will be chosen. Will not be used if `Spoints` is not `NULL`.
     #' @param distance_on_edge Column (or entry on the list) of the `data` that
     #' contains the edge numbers. If not supplied, the column with name
     #' "distance_on_edge" will be chosen.  Will not be used if `Spoints` is not
     #' `NULL`.
     #' @param coord_x Column (or entry on the list) of the `data` that contains
     #' the x coordinate. If not supplied, the column with name "coord_x" will be
     #' chosen. Will not be used if `Spoints` is not `NULL` or if `data_coords` is
     #' `PtE`.
     #' @param coord_y Column (or entry on the list) of the `data` that contains
     #' the y coordinate. If not supplied, the column with name "coord_x" will be
     #' chosen. Will not be used if `Spoints` is not `NULL` or if `data_coords` is
     #' `PtE`.
     #' @param data_coords It decides which
     #' coordinate system to use. If `PtE`, the user must provide `edge_number` and
     #' `distance_on_edge`, otherwise if `spatial`, the user must provide
     #' `coord_x` and `coord_y`. The option `euclidean` is `r lifecycle::badge("deprecated")`.
     #' Use `spatial` instead.
     #' @param group Vector. If the data is grouped (for example measured at
     #' different time points), this argument specifies the columns (or entries
     #' on the list) in which the group variables are stored. It will be stored
     #' as a single column `.group` with the combined entries.
     #' @param group_sep separator character for creating the new group variable
     #' when grouping two or more variables.
     #' @param normalized if TRUE, then the distances in `distance_on_edge` are
     #' assumed to be normalized to (0,1). Default FALSE.
     #' @param format Which format should the data be returned? The options are
     #' `tibble` for `tidyr::tibble`, `sf` for `POINT`, `sp` for `SpatialPointsDataFrame`
     #' and `list` for the internal list format.
     #' @param duplicated_strategy Which strategy to handle observations on the
     #' same location on the metric graph (that is, if there are two or more
     #' observations projected at the same location).
     #' The options are 'closest' and 'jitter'. If 'closest', only the closest
     #' observation will be used. If 'jitter', a small perturbation will be
     #' performed on the projected observation location. The default is 'closest'.
     #' @param include_distance_to_graph When `data_coord` is 'spatial', should
     #' the distance of the observations to the graph be included as a column?
     #' @param only_return_removed Should the removed data (if it exists) when
     #' using 'closest' `duplicated_strategy` be returned instead of the processed
     #' data?
     #' @param tolerance Parameter to control a warning when adding observations.
     #' If the distance of some location and the closest point on the graph is
     #' greater than the tolerance, the function will display a warning.
     #' This helps detecting mistakes on the input locations when adding new data.
     #' @param verbose If `TRUE`, report steps and times.
     #' @param suppress_warnings Suppress warnings related to duplicated observations?
     #' @param Spoints `r lifecycle::badge("deprecated")` Use `data` instead.
     #' @param tibble  `r lifecycle::badge("deprecated")` Use `format` instead.
     #' @return No return value. Called for its side effects. The observations are
     #' stored in the `data` element of the `metric_graph` object.

     process_data = function(    data = NULL,
                                 edge_number = "edge_number",
                                 distance_on_edge = "distance_on_edge",
                                 coord_x = "coord_x",
                                 coord_y = "coord_y",
                                 data_coords = c("PtE", "spatial"),
                                 group = NULL,
                                 group_sep = ".",
                                 normalized = FALSE,
                                 format = c("tibble", "sf", "sp", "list"),
                                 duplicated_strategy = "closest",
                                 include_distance_to_graph = TRUE,
                                 only_return_removed = FALSE,
                                 tolerance = max(self$edge_lengths)/2,
                                 verbose = FALSE,
                                 suppress_warnings = FALSE,
                                 Spoints = lifecycle::deprecated(),
                                 tibble = lifecycle::deprecated()) {

       if (lifecycle::is_present(tibble)) {
         lifecycle::deprecate_warn("1.3.0.9000", "get_edge_weights(tibble)",
                                   "get_edge_weights(format)",
                                   details = c("The argument `tibble` was deprecated in favor of the argument `format`.")
         )
         if(tibble){
           format <- "tibble"
         }
       }

       format <- format[[1]]

       format <- tolower(format)

       if(!(format %in% c("tibble", "sf", "sp", "list"))){
         stop("The possible formats are 'tibble', 'sf', 'sp' and 'list'.")
       }

       data_coords <- data_coords[[1]]
       if(!is.null(group)){
         group <- unique(group)
       }

       if(length(tolerance)>1){
         tolerance <- tolerance[[1]]
         warning("'tolerance' had more than one element, only the first one will be used.")
       }

       if(lifecycle::is_present(Spoints)){
         lifecycle::deprecate_warn("1.2.9000", "add_observations(Spoints)", "add_observations(data)",
                                   details = c("`Spoints` is deprecated, use `data` instead.")
         )
         data <- Spoints
       }

       removed_data <- NULL
       strc_data <- FALSE

       if(data_coords == "spatial" &&
          !inherits(data, "sf") &&
          !inherits(data, "metric_graph_data") &&
          !"SpatialPointsDataFrame" %in% is(data) &&
          !is.null(private$crs)) {

         if(!is.null(data[[coord_x]]) && !is.null(data[[coord_y]])) {
           warning("The crs of the data is not set, the data will be assumed to be in the same crs as the graph.")

           # Create sf object from the data
           data_df <- as.data.frame(data)
           data <- sf::st_as_sf(data_df,
                                coords = c(coord_x, coord_y),
                                crs = private$crs)

         } else{
           stop("`coord_x` and `coord_y` must be columns of the data when `data_coords` is 'spatial'.")
         }
       }

       if(inherits(data, "sf")){
         if(!inherits(data, "data.frame")){
           stop("No data was found in 'data'")
         }
         data_coords <- "spatial"
         coord_x = ".coord_x"
         coord_y = ".coord_y"

         if(!is.null(private$crs)){
           if(!is.na((sf::st_crs(data)))){
             data <- sf::st_transform(data, crs = private$crs)
           } else{
             warning("The crs of the data is not set, the data will be assumed to be in the same crs as the graph.")
             data <- sf::st_set_crs(data, private$crs)
           }
         }
         coord_tmp <- sf::st_coordinates(data,geometry)
         data <- sf::st_drop_geometry(data)
         data[[".coord_x"]] <- coord_tmp[,1]
         data[[".coord_y"]] <- coord_tmp[,2]
         strc_data <- TRUE
       }

       if("SpatialPointsDataFrame"%in%is(data)){
         data_coords <- "spatial"
         coord_x = ".coord_x"
         coord_y = ".coord_y"
         if(!is.null(private$proj4string)){
           if(!is.na(sp::proj4string(data))){
             data <- sp::spTransform(data,sp::CRS(private$proj4string))
           } else {
             warning("The crs of the data is not set, the data will be assumed to be in the same crs as the graph.")
             sp::proj4string(data) <- private$proj4string
           }
         }
         coord_tmp <- data@coords
         data <- data@data
         data[[".coord_x"]] <- coord_tmp[,1]
         data[[".coord_y"]] <- coord_tmp[,2]
         strc_data <- TRUE
       }

       if(inherits(data, "metric_graph_data")){
         if(!any(c(".edge_number", ".distance_on_edge", ".group",
                   ".coord_x", ".coord_y") %in% names(data))){
           warning("The data is of class 'metric_graph_data', but it is not a proper 'metric_graph_data' object. The data will be added as a regular data.")
           class(data) <- setdiff(class(data), "metric_graph_data")
         } else{
           data_coords <- "PtE"
           edge_number <- ".edge_number"
           distance_on_edge <- ".distance_on_edge"
           group <- ".group"
           normalized <- TRUE
         }
       }

       if(is.null(data)){
         stop("No data provided!")
       }

       if(!is.null(data)){
         if(!is.list(data) && !is.data.frame(data)){
           stop("'data' must be either a list or a data.frame!")
         }
       }

       data <- as.list(data)


       if(!strc_data){
         if(data_coords == "PtE"){
           if(any( !(c(edge_number, distance_on_edge) %in% names(data)))){
             stop(paste("The data does not contain either the column",
                        edge_number, "or the column", distance_on_edge))
           }
         } else{
           if(any( !(c(coord_x, coord_y) %in% names(data)))){
             stop(paste("The data does not contain either the column",
                        coord_x,"or the column", coord_y))
           }
         }
       }

       if(!is.null(group)){
         if(!all(group%in%names(data))){
           stop("There were group variables that are not columns of 'data'!")
         }
         data_group_tmp <- lapply(group, function(lab){data[[lab]]})
         ord_tmp <- do.call(order, data_group_tmp)
         rm(data_group_tmp)
         data <- lapply(data, function(dat){dat[ord_tmp]})
         rm(ord_tmp)
         # Vectorized group-key construction (replaces per-element sapply loop)
         data[[".group"]] <- Reduce(
           function(a, b) paste(a, b, sep = group_sep),
           lapply(group, function(g) as.character(data[[g]]))
         )
       }

       ## convert everything to PtE
       if(verbose > 0){
         if(data_coords == "spatial"){
           message("Converting data to PtE")
           if(private$longlat){
             message("This step may take long. If this step is taking too long consider pruning the vertices to possibly obtain some speed up.")
           }
         }
       }

       ## Check data for repeated observations
       if(data_coords == "spatial"){
         if(is.null(group)){
           data_tmp <- cbind(data[[coord_x]], data[[coord_y]])
         } else{
           data_tmp <- cbind(data[[coord_x]], data[[coord_y]], data[[".group"]])
         }
       } else{
         if(is.null(group)){
           data_tmp <- cbind(data[[edge_number]], data[[distance_on_edge]])
         } else{
           data_tmp <- cbind(data[[edge_number]], data[[distance_on_edge]],
                             data[[".group"]])
         }
       }

       if(nrow(unique(data_tmp)) != nrow(data_tmp)){
         if(!suppress_warnings){
           warning("There is at least one 'column' of the data with repeated (possibly different) values at the same location for the same group variable. Only one of these values will be used. Consider using the group variable to differentiate between these values or provide different names for such variables.")
         }
       }


       t <- system.time({
         if(data_coords == "PtE"){
           PtE <- cbind(data[[edge_number]], data[[distance_on_edge]])
           if(!normalized){
             PtE[, 2] <- PtE[,2] / self$edge_lengths[PtE[, 1]]
           }
         } else if(data_coords == "spatial"){
           point_coords <- cbind(data[[coord_x]], data[[coord_y]])
           PtE <- self$coordinates(XY = point_coords)

           fact    <- process_factor_unit(private$vertex_unit, private$length_unit)
           grp_dat <- data[[".group"]]
           if(length(grp_dat) == 0) grp_dat <- rep(1L, nrow(PtE))

           flt <- filter_spatial_obs_groups(
             graph = self, PtE = PtE, point_coords = point_coords,
             grp_dat = grp_dat, tolerance = tolerance,
             duplicated_strategy = duplicated_strategy,
             fact = fact, crs = private$crs, longlat = private$longlat,
             proj4string = private$proj4string,
             which_longlat = private$which_longlat,
             length_unit = private$length_unit,
             transform = private$transform,
             suppress_warnings = suppress_warnings
           )

           PtE          <- flt$PtE
           far_points   <- flt$far_mask
           norm_XY      <- flt$norm_XY
           closest_mask <- flt$closest_mask

           if(flt$has_dup && !suppress_warnings){
             warning("There were points projected at the same location. Only the closest point was kept. To keep all the observations change 'duplicated_strategy' to 'jitter'.")
           }
           if(any(far_points) && !suppress_warnings){
             warning(paste("There were points that were farther than the tolerance. These points were removed. If you want them projected into the graph, please increase the tolerance. The total number of points removed due do being far is", sum(far_points)))
           }

           data <- lapply(data, function(dat) dat[!far_points])
           if(any(closest_mask)){
             removed_data <- lapply(data, function(dat) dat[closest_mask])
             data <- lapply(data, function(dat) dat[!closest_mask])
           }
           if(include_distance_to_graph){
             data[[".distance_to_graph"]] <- norm_XY
           }

         } else{
           stop("The options for 'data_coords' are 'PtE' and 'spatial'.")
         }
       })

       if(only_return_removed){
         if(!is.null(removed_data)){
           return(as.data.frame(removed_data))
         }
       }

       if(verbose == 2) {
         message(sprintf("time: %.3f s", t[["elapsed"]]))

         message("Processing data")
       }

       t <- system.time({
         if(!is.null(group)){
           group_vector <- data[[".group"]]
         } else{
           group <- ".group"
           group_vector <- NULL
         }

         lapply(data, function(dat){if(nrow(matrix(PtE, ncol=2)) != length(dat)){
           stop(paste(dat,"has a different number of elements than the number of
coordinates!"))
         }})


         group_vals <- unique(group_vector)


         # n_group <- length(unique(group_vector))
         n_group <- length(group_vals)
         n_group <- ifelse(n_group == 0, 1, n_group)

         data[[edge_number]] <- NULL
         data[[distance_on_edge]] <- NULL
         data[[coord_x]] <- NULL
         data[[coord_y]] <- NULL
         data[[".group"]] <- NULL
         data[[".coord_x"]] <- NULL
         data[[".coord_y"]] <- NULL


         length_data <- unique(unlist(lapply(data, length)))

         if(length(length_data)>1){
           stop("There was a problem when processing the data. The number of observations and observation locations (after projecting on the metric graph) are not matching.")
         }

         # Process the data (find all the different coordinates
         # across the different replicates, and also merge the new data to the old data)
         data <- process_data_add_obs(PtE, new_data = data,
                                      old_data = NULL,
                                      group_vector,
                                      suppress_warnings = suppress_warnings)

         data <- standardize_df_positions(data, self, edge_number = ".edge_number",
                                          distance_on_edge = ".distance_on_edge")
         ## convert to Spoints and add
         loc_idx_stored <- data[[".loc_idx"]]
         if (!is.null(loc_idx_stored)) {
           # Sparse mode: extract unique locs in sorted order (by loc_idx)
           ord_u <- order(loc_idx_stored)
           first_occ <- ord_u[!duplicated(loc_idx_stored[ord_u])]
           PtE_uniq <- cbind(data[[".edge_number"]][first_occ],
                             data[[".distance_on_edge"]][first_occ])
           spatial_points_uniq <- self$coordinates(PtE = PtE_uniq,
                                                   normalized = TRUE)
           data[[".coord_x"]] <- spatial_points_uniq[loc_idx_stored, 1]
           data[[".coord_y"]] <- spatial_points_uniq[loc_idx_stored, 2]
         } else {
           group_1 <- data[[".group"]]
           group_1 <- which(group_1 == group_1[1])
           PtE <- cbind(data[[".edge_number"]][group_1],
                        data[[".distance_on_edge"]][group_1])
           spatial_points <- self$coordinates(PtE = PtE, normalized = TRUE)
           data[[".coord_x"]] <- rep(spatial_points[,1], times = n_group)
           data[[".coord_y"]] <- rep(spatial_points[,2], times = n_group)
         }

         if(format == "tibble"){
           data <- tidyr::as_tibble(data)
         }

         if(format == "sf"){
           data <- as.data.frame(data)
           data_geometries <- lapply(1:nrow(data),
                                     function(i) sf::st_point(as.numeric(data[i, c('.coord_x', '.coord_y')])))
           data <- sf::st_sf(data, geometry = sf::st_sfc(data_geometries),
                             crs = if(!is.null(private$crs)) private$crs else NULL)
         }

         class(data) <- c("metric_graph_data", class(data))
         if(!is.null(group)){
           attr(data, "group_variables") <- group
         } else{
           attr(data, "group_variables") <- ".none"
         }
       })

       if(format == "sp"){
         data <- as.data.frame(data)
         sp::coordinates(data) <- ~ .coord_x + .coord_y
       }

       if(verbose == 2) {
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }
       return(data)

     },

     #' @description Add observations to the metric graph.
     #' @param data A `data.frame` or named list containing the observations. In
     #' case of groups, the data.frames for the groups should be stacked vertically,
     #' with a column indicating the index of the group. `data` can also be an
     #' `sf` object, a `SpatialPointsDataFrame` object or an `SSN` object.
     #' in which case `data_coords` will automatically be spatial, and there is
     #' no need to specify the `coord_x` or `coord_y` arguments.
     #' @param edge_number Column (or entry on the list) of the `data` that
     #' contains the edge numbers. If not supplied, the column with name
     #' "edge_number" will be chosen. Will not be used if `Spoints` is not `NULL`.
     #' @param distance_on_edge Column (or entry on the list) of the `data` that
     #' contains the edge numbers. If not supplied, the column with name
     #' "distance_on_edge" will be chosen.  Will not be used if `Spoints` is not
     #' `NULL`.
     #' @param coord_x Column (or entry on the list) of the `data` that contains
     #' the x coordinate. If not supplied, the column with name "coord_x" will be
     #' chosen. Will not be used if `Spoints` is not `NULL` or if `data_coords` is
     #' `PtE`.
     #' @param coord_y Column (or entry on the list) of the `data` that contains
     #' the y coordinate. If not supplied, the column with name "coord_x" will be
     #' chosen. Will not be used if `Spoints` is not `NULL` or if `data_coords`
     #' is `PtE`.
     #' @param data_coords It decides which
     #' coordinate system to use. If `PtE`, the user must provide `edge_number`
     #' and `distance_on_edge`, otherwise if `spatial`, the user must provide
     #' `coord_x` and `coord_y`. The option `euclidean` is
     #' `r lifecycle::badge("deprecated")`. Use `spatial` instead.
     #' @param group Vector. If the data is grouped (for example measured at
     #' different time points), this argument specifies the columns (or entries
     #' on the list) in which the group variables are stored. It will be stored
     #' as a single column `.group` with the combined entries.
     #' @param group_sep separator character for creating the new group variable
     #' when grouping two or more variables.
     #' @param normalized if TRUE, then the distances in `distance_on_edge` are
     #' assumed to be normalized to (0,1). Default FALSE.
     #' @param clear_obs Should the existing observations be removed before adding
     #' the data?
     #' @param tibble Should the data be returned as a `tidyr::tibble`?
     #' @param duplicated_strategy Which strategy to handle observations on the
     #' same location on the metric graph (that is, if there are two or more
     #' observations projected at the same location).
     #' The options are 'closest' and 'jitter'. If 'closest', only the closest
     #' observation will be used. If 'jitter', a small perturbation will be
     #' performed on the projected observation location. The default is 'closest'.
     #' @param include_distance_to_graph When `data_coord` is 'spatial', should
     #' the distance of the observations to the graph be included as a column?
     #' @param tolerance Parameter to control a warning when adding observations.
     #' If the distance of some location and the closest point on the graph is
     #' greater than the tolerance, the function will display a warning.
     #' This helps detecting mistakes on the input locations when adding new data.
     #' @param tolerance_merge tolerance (in edge_length units) for merging points
     #' that are very close and are on a common edge. By default, this tolerance
     #' is zero, meaning no merges will be performed.
     #' @param merge_strategy The strategies to handle observations that are
     #' within the tolerance. The options are `remove`, `merge`, `average`.
     #' The default is `merge`, in which one of the observations will be chosen,
     #' and the remaining will be used to try to fill all columns with non-NA values.
     #' The second strategy is `remove`, meaning that if two observations are within
     #' the tolerance one of them will be removed. Finally, `average` will take
     #' the average over the close observations for numerical variables, and will
     #' choose one non-NA for non-numerical variables.
     #' @param return_removed Should the removed data (if it exists) due to being
     #' projected to the same place when using 'closest' `duplicated_strategy`,
     #' or due to some merge strategy, be returned?
     #' @param verbose Print progress of the steps when adding observations.
     #' There are 3 levels of verbose, level 0, 1 and 2. In level 0, no messages
     #' are printed. In level 1, only messages regarding important steps are printed.
     #' Finally, in level 2, messages detailing all the steps are printed.
     #' The default is 1.
     #' @param suppress_warnings Suppress warnings related to duplicated observations?
     #' @param Spoints `r lifecycle::badge("deprecated")` Use `data` instead.
     #' @return No return value. Called for its side effects. The observations are
     #' stored in the `data` element of the `metric_graph` object.
     add_observations = function(data = NULL,
                                 edge_number = "edge_number",
                                 distance_on_edge = "distance_on_edge",
                                 coord_x = "coord_x",
                                 coord_y = "coord_y",
                                 data_coords = c("PtE", "spatial"),
                                 group = NULL,
                                 group_sep = ".",
                                 normalized = FALSE,
                                 clear_obs = FALSE,
                                 tibble = FALSE,
                                 tolerance = max(self$edge_lengths)/2,
                                 duplicated_strategy = "closest",
                                 include_distance_to_graph = TRUE,
                                 return_removed = TRUE,
                                 tolerance_merge = 0,
                                 merge_strategy = "merge",
                                 verbose = 1,
                                 suppress_warnings = FALSE,
                                 Spoints = lifecycle::deprecated()) {

       private$components_cache <- NULL  # invalidate per-component snapshot

       merge_strategy <- match.arg(merge_strategy, c("remove", "merge", "average"))
       duplicated_strategy <- match.arg(duplicated_strategy, c("closest", "jitter"))
       data_coords <- match.arg(data_coords, c("PtE", "spatial"))

       if(clear_obs){
         df_temp <- data
         self$clear_observations()
         data <- df_temp
       }

       if(inherits(data, "SSN")){
         data <- data$obs
       }

       if(lifecycle::is_present(Spoints)){
         lifecycle::deprecate_warn("1.2.9000", "add_observations(Spoints)",
                                   "add_observations(data)",
                                   details = c("`Spoints` is deprecated, use `data` instead.")
         )
         data <- Spoints
       }

       removed_data <- NULL
       far_data <- NULL
       strc_data <- FALSE

       if(data_coords == "spatial" &&
          !inherits(data, "sf") &&
          !inherits(data, "metric_graph_data") &&
          !"SpatialPointsDataFrame" %in% is(data) &&
          !is.null(private$crs)) {

         if(!is.null(data[[coord_x]]) && !is.null(data[[coord_y]])) {
           warning("The crs of the data is not set, the data will be assumed to be in the same crs as the graph.")

           # Create sf object from the data
           data_df <- as.data.frame(data)
           data <- sf::st_as_sf(data_df,
                                coords = c(coord_x, coord_y),
                                crs = private$crs)

         } else{
           stop("`coord_x` and `coord_y` must be columns of the data when `data_coords` is 'spatial'.")
         }
       }

       if(inherits(data, "sf")){
         if(!inherits(data, "data.frame")){
           stop("No data was found in 'data'")
         }
         data_coords <- "spatial"
         coord_x = ".coord_x"
         coord_y = ".coord_y"

         if(!is.null(private$crs)){
           if(!is.na((sf::st_crs(data)))){
             data <- sf::st_transform(data, crs = private$crs)
           } else{
             warning("The crs of the data is not set, the data will be assumed to be in the same crs as the graph.")
             data <- sf::st_set_crs(data, private$crs)
           }
         }
         coord_tmp <- sf::st_coordinates(data,geometry)
         data <- sf::st_drop_geometry(data)
         data[[".coord_x"]] <- coord_tmp[,1]
         data[[".coord_y"]] <- coord_tmp[,2]
         strc_data <- TRUE
       }

       if("SpatialPointsDataFrame"%in%is(data)){
         data_coords <- "spatial"
         coord_x = ".coord_x"
         coord_y = ".coord_y"
         if(!is.null(private$proj4string)){
           if(!is.na(sp::proj4string(data))){
             data <- sp::spTransform(data,sp::CRS(private$proj4string))
           } else {
             warning("The crs of the data is not set, the data will be assumed to be in the same crs as the graph.")
             sp::proj4string(data) <- private$proj4string
           }
         }
         coord_tmp <- data@coords
         data <- data@data
         data[[".coord_x"]] <- coord_tmp[,1]
         data[[".coord_y"]] <- coord_tmp[,2]
         strc_data <- TRUE
       }

       if(length(tolerance)>1){
         tolerance <- tolerance[[1]]
         warning("'tolerance' had more than one element, only the first one will be used.")
       }

       if(verbose>0){
         message("Adding observations...")
         if(data_coords == "PtE"){
           if(normalized){
             message("Assuming the observations are normalized by the length of the edge.")
           } else{
             message("Assuming the observations are NOT normalized by the length of the edge.")
           }
         }
         if(private$longlat){
           message(paste("The unit for edge lengths is", private$length_unit))
           message(paste0("The current tolerance for removing distant observations is (in ",
                          private$length_unit,"): ", tolerance))
         }
       }

       if(!is.null(group)){
         group <- unique(group)
       }

       if(inherits(data, "metric_graph_data")){
         if(!any(c(".edge_number", ".distance_on_edge",
                   ".group", ".coord_x", ".coord_y") %in% names(data))){
           warning("The data is of class 'metric_graph_data', but it is not a proper 'metric_graph_data' object. The data will be added as a regular data.")
           class(data) <- setdiff(class(data), "metric_graph_data")
         } else{
           data_coords <- "PtE"
           edge_number <- ".edge_number"
           distance_on_edge <- ".distance_on_edge"
           group <- ".group"
           normalized <- TRUE
         }
       }

       data_coords <- data_coords[[1]]
       if(data_coords == "euclidean"){
         lifecycle::deprecate_warn("1.2.0",
                                   "add_observations(data_coords = 'must be either PtE or spatial')")
         data_coords <- "spatial"
       }
       if(is.null(data)){
         stop("No data provided!")
       }

       if(!is.null(data)){
         if(!is.list(data) && !is.data.frame(data)){
           stop("'data' must be either a list or a data.frame!")
         }
       }


       data <- as.list(data)

       if(!strc_data){
         if(data_coords == "PtE"){
           if(any( !(c(edge_number, distance_on_edge) %in% names(data)))){
             stop(paste("The data does not contain either the column",
                        edge_number, "or the column", distance_on_edge))
           }
         } else{
           if(any( !(c(coord_x, coord_y) %in% names(data)))){
             stop(paste("The data does not contain either the column",
                        coord_x, "or the column", coord_y))
           }
         }
       }

       if(!is.null(group)){
         if(!all(group%in%names(data))){
           stop("There were group variables that are not columns of 'data'!")
         }
         data_group_tmp <- lapply(group, function(lab){data[[lab]]})
         ord_tmp <- do.call(order, data_group_tmp)
         rm(data_group_tmp)
         data <- lapply(data, function(dat){dat[ord_tmp]})
         rm(ord_tmp)
         # Vectorized group-key construction (replaces per-element sapply loop)
         data[[".group"]] <- Reduce(
           function(a, b) paste(a, b, sep = group_sep),
           lapply(group, function(g) as.character(data[[g]]))
         )
       }


       ## convert everything to PtE
       if(verbose > 0){
         if(data_coords == "spatial"){
           message("Converting data to PtE")
           if(private$longlat){
             message("This step may take long. If this step is taking too long consider pruning the vertices to possibly obtain some speed up.")
           }
         }
       }



       ## Check data for repeated observations
       if(data_coords == "spatial"){
         if(is.null(group)){
           data_tmp <- cbind(data[[coord_x]], data[[coord_y]])
         } else{
           data_tmp <- cbind(data[[coord_x]], data[[coord_y]], data[[".group"]])
         }
       } else{
         if(is.null(group)){
           data_tmp <- cbind(data[[edge_number]], data[[distance_on_edge]])
         } else{
           data_tmp <- cbind(data[[edge_number]], data[[distance_on_edge]],
                             data[[".group"]])
         }
       }

       if(nrow(unique(data_tmp)) != nrow(data_tmp)){
         if(!suppress_warnings){
           warning("There is at least one 'column' of the data with repeated (possibly different) values at the same location for the same group variable. Only one of these values will be used. Consider using the group variable to differentiate between these values or provide different names for such variables.")
         }
       }

       t <- system.time({
         if(data_coords == "PtE"){
           PtE <- cbind(data[[edge_number]], data[[distance_on_edge]])
           if(!normalized){
             PtE[, 2] <- PtE[,2] / self$edge_lengths[PtE[, 1]]
             if(any(PtE[,2] > 1)){
               stop("There were invalid distances on edges. If your data is normalized, please set the 'normalized' argument to TRUE.")
             }
           }
         } else if(data_coords == "spatial"){
           point_coords <- cbind(data[[coord_x]], data[[coord_y]])
           PtE <- self$coordinates(XY = point_coords)

           fact    <- process_factor_unit(private$vertex_unit,
                                          private$length_unit)
           grp_dat <- data[[".group"]]
           if(length(grp_dat) == 0) grp_dat <- rep(1L, nrow(PtE))

           flt <- filter_spatial_obs_groups(
             graph = self, PtE = PtE, point_coords = point_coords,
             grp_dat = grp_dat, tolerance = tolerance,
             duplicated_strategy = duplicated_strategy,
             fact = fact, crs = private$crs, longlat = private$longlat,
             proj4string = private$proj4string,
             which_longlat = private$which_longlat,
             length_unit = private$length_unit,
             transform = private$transform,
             suppress_warnings = suppress_warnings
           )

           PtE          <- flt$PtE
           far_points   <- flt$far_mask
           norm_XY      <- flt$norm_XY
           closest_mask <- flt$closest_mask

           if(flt$has_dup && !suppress_warnings){
             warning("There were points projected at the same location. Only the closest point was kept. To keep all the observations change 'duplicated_strategy' to 'jitter'.")
           }
           if(any(far_points)){
             if(!suppress_warnings){
               warning(paste("There were points that were farther than the tolerance. These points were removed. If you want them projected into the graph, please increase the tolerance. The total number of points removed due do being far is", sum(far_points)))
             }
             far_data <- lapply(data, function(dat) dat[far_points])
           }
           data <- lapply(data, function(dat) dat[!far_points])
           if(any(closest_mask)){
             removed_data <- lapply(data, function(dat) dat[closest_mask])
             data         <- lapply(data, function(dat) dat[!closest_mask])
           }
           if(include_distance_to_graph){
             data[[".distance_to_graph"]] <- norm_XY
           }

         } else{
           stop("The options for 'data_coords' are 'PtE' and 'spatial'.")
         }
       })

       if(verbose == 2) {
         message(sprintf("time: %.3f s", t[["elapsed"]]))

         message("Processing data")
       }


       t <- system.time({
         if(!is.null(group)){
           group_vector <- data[[".group"]]
         } else{
           group_vector <- NULL
         }

         lapply(data, function(dat){if(nrow(matrix(PtE, ncol=2)) != length(dat)){
           stop(paste(dat,"has a different number of elements than the number of
coordinates!"))
         }})

         if(!is.null(private$data[[".group"]])){
           group_vals <- unique(private$data[[".group"]])
           group_vals <- unique(union(group_vals, group_vector))
         } else{
           group_vals <- unique(group_vector)
         }

         # n_group <- length(unique(group_vector))
         n_group <- length(group_vals)
         n_group <- ifelse(n_group == 0, 1, n_group)

         data[[edge_number]] <- NULL
         data[[distance_on_edge]] <- NULL
         data[[coord_x]] <- NULL
         data[[coord_y]] <- NULL
         data[[".group"]] <- NULL
         private$data[[".coord_x"]] <- NULL
         private$data[[".coord_y"]] <- NULL

         ## Filtering data that are very close and are on a common edge
         if(length(tolerance_merge)>1){
           warning("tolerance_merge is not of length 1. Only the first element will be used.")
           tolerance_merge <- tolerance_merge[[1]]
         }

         if(is.null(tolerance_merge)){
           warning("tolerance_merge is NULL, so it was set to 0.")
           tolerance_merge <- 0
         }

         if(tolerance_merge < 0){
           stop("tolerance_merge cannot be negative.")
         }

         removed_merge <- NULL

         if(tolerance_merge > 0){
           # data, group_vector and PtE
           if(!is.null(group_vector)){
             ord_idx <- order(PtE[,1], PtE[,2], group_vector)
             group_vector <- group_vector[ord_idx]
             PtE <- PtE[ord_idx,,drop=FALSE]
           } else{
             ord_idx <- order(PtE[,1], PtE[,2])
             PtE <- PtE[ord_idx,,drop=FALSE]
           }

           data <- lapply(data, function(dat){dat[ord_idx]})

           aux_length <- self$edge_lengths[PtE[,1]] * PtE[,2]

           merge_idx <- get_idx_within_merge_tolerance(PtE, group_vector,
                                                       aux_length,
                                                       tolerance_merge)

           removed_merge_idx <- setdiff(1:length(ord_idx), merge_idx)

           removed_merge <- lapply(data, function(dat){dat[removed_merge_idx]})
           removed_merge[[".edge_number"]] <- PtE[removed_merge_idx, 1]
           removed_merge[[".distance_on_edge"]] <- PtE[removed_merge_idx, 2]

           data <- lapply(data, function(dat){dat[merge_idx]})
           group_vector <- group_vector[merge_idx]
           PtE <- PtE[merge_idx,,drop=FALSE]

           if(merge_strategy %in% c("average", "merge")){
             merge_idx_map <- setNames(seq_along(merge_idx),
                                       as.character(merge_idx))
             ref_idx_merges <- find_merged_indices_for_unselected(merge_idx,
                                                                  length(ord_idx))
             data <- apply_merge_strategy(data, removed_merge, merge_idx_map,
                                          ref_idx_merges, merge_strategy)
           }
         }

         # Process the data (find all the different coordinates
         # across the different replicates, and also merge the new data to the old data)
         length_data <- unique(unlist(lapply(data, length)))

         if(length(length_data)>1){
           stop("There was a problem when processing the data. The number of observations and observation locations (after projecting on the metric graph) are not matching.")
         }

         private$data <- process_data_add_obs(PtE, new_data = data,
                                              private$data,
                                              group_vector,
                                              suppress_warnings = suppress_warnings)

         private$data <- standardize_df_positions(private$data, self,
                                                  edge_number = ".edge_number",
                                                  distance_on_edge = ".distance_on_edge")

         ## convert to Spoints and add
         PtE <- self$get_PtE()

         spatial_points <- self$coordinates(PtE = PtE, normalized = TRUE)

         # Sparse format: use .loc_idx to map each row to its unique-location coords.
         # Legacy full-grid: replicate spatial_points n_group times.
         loc_idx_stored <- private$data[[".loc_idx"]]
         if (!is.null(loc_idx_stored)) {
           private$data[[".coord_x"]] <- spatial_points[loc_idx_stored, 1]
           private$data[[".coord_y"]] <- spatial_points[loc_idx_stored, 2]
         } else {
           private$data[[".coord_x"]] <- rep(spatial_points[, 1], times = n_group)
           private$data[[".coord_y"]] <- rep(spatial_points[, 2], times = n_group)
         }
         if(tibble){
           private$data <- tidyr::as_tibble(private$data)
         }
         private$group_col <- group
         # distance_graph_tmp <- private$data[[".distance_to_graph"]]

         class(private$data) <- c("metric_graph_data", class(private$data))
         if(!is.null(group)){
           attr(private$data, "group_variables") <- group
         } else{
           attr(private$data, "group_variables") <- ".none"
         }
         # attr(private$data, "distance_to_graph") <- distance_graph_tmp
       })
       if(verbose == 2) {
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }

       if(return_removed){
         ret_list <- list()
         if(!is.null(removed_data)){
           ret_list[["removed"]] <- as.data.frame(removed_data)
         }
         if(!is.null(far_data)){
           ret_list[["far_data"]] <- as.data.frame(far_data)
         }
         if(!is.null(removed_merge)){
           ret_list[["removed_merge"]] <- as.data.frame(removed_merge)
         }
         if(length(ret_list) > 0){
           return(ret_list)
         } else {
           return(invisible(NULL))
         }
       }
     },

     #' @description Use `dplyr::mutate` function on the internal edge weights object.
     #' @param ... Arguments to be passed to `dplyr::mutate()`.
     #' @param .drop_na Should the rows with at least one NA for one of the columns
     #' be removed? DEFAULT is `FALSE`.
     #' @param .drop_all_na Should the rows with all variables being NA be removed?
     #' DEFAULT is `TRUE`.
     #' @param format The format of the output: "tibble", "sf", or "sp".
     #' Default is "tibble".
     #' @details A wrapper to use `dplyr::mutate()` on the internal edge weights
     #' object and return the result in the requested format.
     #' @return A `tidyr::tibble`, `sf` or `sp` object containing the resulting
     #' data list after the mutate.
     mutate_weights = function(...,
                               .drop_na = FALSE,
                               .drop_all_na = TRUE,
                               format = "tibble") {
       if (!inherits(private$edge_weights, "tbl_df")) {
         edge_weights_res <- tidyr::as_tibble(private$edge_weights)
       } else {
         edge_weights_res <- private$edge_weights
       }

       if (.drop_all_na) {
         is_tbl <- inherits(edge_weights_res, "tbl_df")
         idx_temp <- idx_not_all_NA(edge_weights_res)
         edge_weights_res <- lapply(edge_weights_res, function(dat) { dat[idx_temp] })
         if (is_tbl) {
           edge_weights_res <- tidyr::as_tibble(edge_weights_res)
         }
       }

       if (.drop_na) {
         if (!inherits(edge_weights_res, "tbl_df")) {
           idx_temp <- idx_not_any_NA(edge_weights_res)
           edge_weights_res <- lapply(edge_weights_res, function(dat) { dat[idx_temp] })
         } else {
           edge_weights_res <- tidyr::drop_na(edge_weights_res)
         }
       }

       edge_weights_res <- dplyr::mutate(.data = edge_weights_res, ...)

       if (!inherits(edge_weights_res, "metric_graph_weights")) {
         class(edge_weights_res) <- c("metric_graph_weights", class(edge_weights_res))
       }

       return(private$format_weights(edge_weights_res, format))
     },


     #' @description Use `dplyr::select` function on the internal edge weights object.
     #' @param ... Arguments to be passed to `dplyr::select()`.
     #' @param .drop_na Should the rows with at least one NA for one of the
     #' columns be removed? DEFAULT is `FALSE`.
     #' @param .drop_all_na Should the rows with all variables being NA be removed?
     #' DEFAULT is `TRUE`.
     #' @param format The format of the output: "tibble", "sf", or "sp".
     #' Default is "tibble".
     #' @details A wrapper to use `dplyr::select()` on the internal edge weights
     #' object and return the result in the requested format.
     #' @return A `tidyr::tibble`, `sf` or `sp` object containing the resulting
     #' data list after the select.
     select_weights = function(...,
                               .drop_na = FALSE,
                               .drop_all_na = TRUE,
                               format = "tibble") {
       if (!inherits(private$edge_weights, "tbl_df")) {
         edge_weights_res <- tidyr::as_tibble(private$edge_weights)
       } else {
         edge_weights_res <- private$edge_weights
       }

       edge_weights_res <- dplyr::select(.data = edge_weights_res, ...)

       if (.drop_all_na) {
         is_tbl <- inherits(edge_weights_res, "tbl_df")
         idx_temp <- idx_not_all_NA(edge_weights_res)
         edge_weights_res <- lapply(edge_weights_res, function(dat) { dat[idx_temp] })
         if (is_tbl) {
           edge_weights_res <- tidyr::as_tibble(edge_weights_res)
         }
       }

       if (.drop_na) {
         if (!inherits(edge_weights_res, "tbl_df")) {
           idx_temp <- idx_not_any_NA(edge_weights_res)
           edge_weights_res <- lapply(edge_weights_res, function(dat) { dat[idx_temp] })
         } else {
           edge_weights_res <- tidyr::drop_na(edge_weights_res)
         }
       }

       if (!inherits(edge_weights_res, "metric_graph_weights")) {
         class(edge_weights_res) <- c("metric_graph_weights", class(edge_weights_res))
       }

       return(private$format_weights(edge_weights_res, format))
     },


     #' @description Use `dplyr::filter` function on the internal edge weights object.
     #' @param ... Arguments to be passed to `dplyr::filter()`.
     #' @param .drop_na Should the rows with at least one NA for one of the
     #' columns be removed? DEFAULT is `FALSE`.
     #' @param .drop_all_na Should the rows with all variables being NA be removed?
     #' DEFAULT is `TRUE`.
     #' @param format The format of the output: "tibble", "sf", or "sp".
     #' Default is "tibble".
     #' @details A wrapper to use `dplyr::filter()` on the internal edge weights
     #' object and return the result in the requested format.
     #' @return A `tidyr::tibble`, `sf` or `sp` object containing the resulting
     #' data list after the filter.
     filter_weights = function(...,
                               .drop_na = FALSE,
                               .drop_all_na = TRUE,
                               format = "tibble") {
       if (!inherits(private$edge_weights, "tbl_df")) {
         edge_weights_res <- tidyr::as_tibble(private$edge_weights)
       } else {
         edge_weights_res <- private$edge_weights
       }

       if (.drop_all_na) {
         is_tbl <- inherits(edge_weights_res, "tbl_df")
         idx_temp <- idx_not_all_NA(edge_weights_res)
         edge_weights_res <- lapply(edge_weights_res, function(dat) { dat[idx_temp] })
         if (is_tbl) {
           edge_weights_res <- tidyr::as_tibble(edge_weights_res)
         }
       }

       if (.drop_na) {
         if (!inherits(edge_weights_res, "tbl_df")) {
           idx_temp <- idx_not_any_NA(edge_weights_res)
           edge_weights_res <- lapply(edge_weights_res, function(dat) { dat[idx_temp] })
         } else {
           edge_weights_res <- tidyr::drop_na(edge_weights_res)
         }
       }

       edge_weights_res <- dplyr::filter(.data = edge_weights_res, ...)

       if (!inherits(edge_weights_res, "metric_graph_weights")) {
         class(edge_weights_res) <- c("metric_graph_weights", class(edge_weights_res))
       }

       return(private$format_weights(edge_weights_res, format))
     },


     #' @description Use `dplyr::summarise` function on the internal edge weights
     #' object grouped by the edge numbers.
     #' @param ... Arguments to be passed to `dplyr::summarise()`.
     #' @param .groups A vector of strings containing the names of the columns to
     #' be grouped, when computing the summaries. The default is `NULL`.
     #' @param .drop_na Should the rows with at least one NA for one of the
     #' columns be removed? DEFAULT is `FALSE`.
     #' @param .drop_all_na Should the rows with all variables being NA be removed?
     #' DEFAULT is `TRUE`.
     #' @param format The format of the output: "tibble", "sf", or "sp".
     #' Default is "tibble".
     #' @details A wrapper to use `dplyr::summarise()` on the internal edge weights
     #' object and return the result in the requested format.
     #' @return A `tidyr::tibble`, `sf` or `sp` object containing the resulting
     #' data list after the summarise.
     summarise_weights = function(...,
                                  .groups = NULL,
                                  .drop_na = FALSE,
                                  .drop_all_na = TRUE,
                                  format = "tibble") {
       if (!inherits(private$edge_weights, "tbl_df")) {
         edge_weights_res <- tidyr::as_tibble(private$edge_weights)
       } else {
         edge_weights_res <- private$edge_weights
       }

       if (.drop_all_na) {
         is_tbl <- inherits(edge_weights_res, "tbl_df")
         idx_temp <- idx_not_all_NA(edge_weights_res)
         edge_weights_res <- lapply(edge_weights_res, function(dat) { dat[idx_temp] })
         if (is_tbl) {
           edge_weights_res <- tidyr::as_tibble(edge_weights_res)
         }
       }

       if (.drop_na) {
         if (!inherits(edge_weights_res, "tbl_df")) {
           idx_temp <- idx_not_any_NA(edge_weights_res)
           edge_weights_res <- lapply(edge_weights_res, function(dat) { dat[idx_temp] })
         } else {
           edge_weights_res <- tidyr::drop_na(edge_weights_res)
         }
       }

       edge_weights_res <- dplyr::group_by_at(.tbl = edge_weights_res, .vars = .groups)
       edge_weights_res <- dplyr::summarise(.data = edge_weights_res, ...)
       edge_weights_res <- dplyr::ungroup(edge_weights_res)

       if (!inherits(edge_weights_res, "metric_graph_weights")) {
         class(edge_weights_res) <- c("metric_graph_weights", class(edge_weights_res))
       }

       return(private$format_weights(edge_weights_res, format))
     },

     #' @description Use `tidyr::drop_na()` function on the internal edge
     #' weights object.
     #' @param format The format of the output: "tibble", "sf", or "sp".
     #' Default is "tibble".
     #' @param ... Arguments to be passed to `tidyr::drop_na()`.
     #' @details A wrapper to use `tidyr::drop_na()` within the internal edge
     #' weights object.
     #' @return A `tidyr::tibble`, `sf`, or `sp` object containing the resulting
     #' data list after the drop_na.
     drop_na_weights = function(...,format = "tibble") {
       if (!inherits(private$edge_weights, "tbl_df")) {
         edge_weights_res <- tidyr::as_tibble(private$edge_weights)
       } else {
         edge_weights_res <- private$edge_weights
       }

       edge_weights_res <- tidyr::drop_na(data = edge_weights_res, ...)

       if (!inherits(edge_weights_res, "metric_graph_weights")) {
         class(edge_weights_res) <- c("metric_graph_weights", class(edge_weights_res))
       }

       return(private$format_weights(edge_weights_res, format))
     },


     #' @description Use `dplyr::mutate` function on the internal metric graph
     #' data object.
     #' @param ... Arguments to be passed to `dplyr::mutate()`.
     #' @param .drop_na Should the rows with at least one NA for one of the
     #' columns be removed? DEFAULT is `FALSE`.
     #' @param .drop_all_na Should the rows with all variables being NA be removed?
     #' DEFAULT is `TRUE`.
     #' @param format The format of the output: "tibble", "sf", or "sp".
     #' Default is "tibble".
     #' @details A wrapper to use `dplyr::mutate()` within the internal metric graph
     #' data object and return the result in the requested format.
     #' @return A `tidyr::tibble`, `sf`, or `sp` object containing the resulting
     #' data list after the mutate.
     mutate = function(...,
                       .drop_na = FALSE,
                       .drop_all_na = TRUE,
                       format = "tibble") {
       if (!inherits(private$data, "tbl_df")) {
         data_res <- tidyr::as_tibble(private$data)
       } else {
         data_res <- private$data
       }

       if (.drop_all_na) {
         is_tbl <- inherits(data_res, "tbl_df")
         idx_temp <- idx_not_all_NA(data_res)
         data_res <- lapply(data_res, function(dat) { dat[idx_temp] })
         if (is_tbl) {
           data_res <- tidyr::as_tibble(data_res)
         }
       }

       if (.drop_na) {
         if (!inherits(data_res, "tbl_df")) {
           idx_temp <- idx_not_any_NA(data_res)
           data_res <- lapply(data_res, function(dat) { dat[idx_temp] })
         } else {
           data_res <- tidyr::drop_na(data_res)
         }
       }

       data_res <- dplyr::mutate(.data = data_res, ...)

       if (!inherits(data_res, "metric_graph_data")) {
         class(data_res) <- c("metric_graph_data", class(data_res))
       }

       return(private$format_data(data_res, format))
     },

     #' @description Use `tidyr::drop_na()` function on the internal metric graph
     #' data object.
     #' @param ... Arguments to be passed to `tidyr::drop_na()`.
     #' @param format The format of the output: "tibble", "sf", or "sp".
     #' Default is "tibble".
     #' @details A wrapper to use `dplyr::drop_na()` within the internal metric
     #' graph data object.
     #' @return A `tidyr::tibble` object containing the resulting data list
     #' after the drop_na.
     drop_na = function(..., format = "tibble") {
       if(!inherits(private$data, "tbl_df")){
         data_res <- tidyr::as_tibble(private$data)
       } else{
         data_res <- private$data
       }

       data_res <- tidyr::drop_na(data = data_res, ...)

       if(!inherits(data_res, "metric_graph_data")){
         class(data_res) <- c("metric_graph_data", class(data_res))
       }

       return(private$format_data(data_res, format))
     },



     #' @description Use `dplyr::select` function on the internal metric graph
     #' data object.
     #' @param ... Arguments to be passed to `dplyr::select()`.
     #' @param .drop_na Should the rows with at least one NA for one of the
     #' columns be removed? DEFAULT is `FALSE`.
     #' @param .drop_all_na Should the rows with all variables being NA be
     #' removed? DEFAULT is `TRUE`.
     #' @param format The format of the output: "tibble", "sf", or "sp".
     #' Default is "tibble".
     #' @details A wrapper to use `dplyr::select()` within the internal metric
     #' graph data object. Observe that it is a bit different from directly
     #' using `dplyr::select()` since it does not allow to remove the internal
     #' positions that are needed for the metric_graph methods to work.
     #' @return A `tidyr::tibble` object containing the resulting data list
     #' after the selection.
     select = function(..., .drop_na = FALSE, .drop_all_na = TRUE, format = "tibble") {
       if(!inherits(private$data, "tbl_df")){
         data_res <- tidyr::as_tibble(private$data)
       } else{
         data_res <- private$data
       }
       data_res <- dplyr::select(.data = data_res, ...)
       data_res[[".group"]] <- private$data[[".group"]]
       data_res[[".edge_number"]] <- private$data[[".edge_number"]]
       data_res[[".distance_on_edge"]] <- private$data[[".distance_on_edge"]]
       data_res[[".coord_x"]] <- private$data[[".coord_x"]]
       data_res[[".coord_y"]] <- private$data[[".coord_y"]]


       if(.drop_all_na){
         is_tbl <- inherits(data_res, "tbl_df")
         idx_temp <- idx_not_all_NA(data_res)
         data_res <- lapply(data_res, function(dat){dat[idx_temp]})
         if(is_tbl){
           data_res <- tidyr::as_tibble(data_res)
         }
       }

       if(.drop_na){
         if(!inherits(data_res, "tbl_df")){
           idx_temp <- idx_not_any_NA(data_res)
           data_res <- lapply(data_res, function(dat){dat[idx_temp]})
         } else{
           data_res <- tidyr::drop_na(data_res)
         }
       }

       if(!inherits(data_res, "metric_graph_data")){
         class(data_res) <- c("metric_graph_data", class(data_res))
       }
       return(private$format_data(data_res, format))
     },

     #' @description Use `dplyr::filter` function on the internal metric graph
     #' data object.
     #' @param ... Arguments to be passed to `dplyr::filter()`.
     #' @param .drop_na Should the rows with at least one NA for one of the
     #' columns be removed? DEFAULT is `FALSE`.
     #' @param .drop_all_na Should the rows with all variables being NA be
     #' removed? DEFAULT is `TRUE`.
     #' @param format The format of the output: "tibble", "sf", or "sp".
     #' Default is "tibble".
     #' @details A wrapper to use `dplyr::filter()` within the internal metric
     #' graph data object.
     #' @return A `tidyr::tibble` object containing the resulting data list
     #' after the filter.
     filter = function(...,
                       .drop_na = FALSE,
                       .drop_all_na = TRUE,
                       format = "tibble") {
       if(!inherits(private$data, "tbl_df")){
         data_res <- tidyr::as_tibble(private$data)
       } else{
         data_res <- private$data
       }


       if(.drop_all_na){
         is_tbl <- inherits(data_res, "tbl_df")
         idx_temp <- idx_not_all_NA(data_res)
         data_res <- lapply(data_res, function(dat){dat[idx_temp]})
         if(is_tbl){
           data_res <- tidyr::as_tibble(data_res)
         }
       }

       if(.drop_na){
         if(!inherits(data_res, "tbl_df")){
           idx_temp <- idx_not_any_NA(data_res)
           data_res <- lapply(data_res, function(dat){dat[idx_temp]})
         } else{
           data_res <- tidyr::drop_na(data_res)
         }
       }

       data_res <- dplyr::filter(.data = data_res, ...)
       data_res <- dplyr::arrange(.data = data_res, `.group`, `.edge_number`,
                                  `.distance_on_edge`)

       if(!inherits(data_res, "metric_graph_data")){
         class(data_res) <- c("metric_graph_data", class(data_res))
       }

       return(private$format_data(data_res, format))
     },


     #' @description Use `dplyr::summarise` function on the internal metric graph
     #' data object grouped by the spatial locations and the internal group variable.
     #' @param ... Arguments to be passed to `dplyr::summarise()`.
     #' @param .include_graph_groups Should the internal graph groups be included
     #' in the grouping variables? The default is `FALSE`. This means that, when
     #' summarising, the data will be grouped by the internal group variable
     #' together with the spatial locations.
     #' @param .groups A vector of strings containing the names of the columns to
     #' be additionally grouped, when computing the summaries. The default is `NULL`.
     #' @param .drop_na Should the rows with at least one NA for one of the columns
     #' be removed? DEFAULT is `FALSE`.
     #' @param .drop_all_na Should the rows with all variables being NA be removed?
     #' DEFAULT is `TRUE`.
     #' @param format The format of the output: "tibble", "sf", or "sp". Default
     #' is "tibble".
     #' @details A wrapper to use `dplyr::summarise()` within the internal metric
     #' graph data object grouped by manually inserted groups (optional), the
     #' internal group variable (optional) and the spatial locations. Observe
     #' that if the integral group variable was not used as a grouping variable
     #' for the summarise, a new column, called `.group`, will be added, with the
     #' same value 1 for all rows.
     #' @return A `tidyr::tibble` object containing the resulting data list after
     #' the summarise.
     summarise = function(...,
                          .include_graph_groups = FALSE,
                          .groups = NULL,
                          .drop_na = FALSE,
                          .drop_all_na = TRUE,
                          format = "tibble") {
       if(!inherits(private$data, "tbl_df")){
         data_res <- tidyr::as_tibble(private$data)
       } else{
         data_res <- private$data
       }


       if(.drop_all_na){
         is_tbl <- inherits(data_res, "tbl_df")
         idx_temp <- idx_not_all_NA(data_res)
         data_res <- lapply(data_res, function(dat){dat[idx_temp]})
         if(is_tbl){
           data_res <- tidyr::as_tibble(data_res)
         }
       }

       if(.drop_na){
         if(!inherits(data_res, "tbl_df")){
           idx_temp <- idx_not_any_NA(data_res)
           data_res <- lapply(data_res, function(dat){dat[idx_temp]})
         } else{
           data_res <- tidyr::drop_na(data_res)
         }
       }


       group_vars <- c(".edge_number", ".distance_on_edge",
                       ".coord_x", ".coord_y")
       if(.include_graph_groups){
         group_vars <- c(".group", group_vars)
       }
       group_vars <- c(.groups, group_vars)
       data_res <- dplyr::group_by_at(.tbl = data_res, .vars = group_vars)
       data_res <- dplyr::summarise(.data = data_res, ...)
       data_res <- dplyr::ungroup(data_res)
       if(is.null(data_res[[".group"]])){
         data_res[[".group"]] <- 1
       }

       data_res <- dplyr::arrange(.data = data_res, `.group`, `.edge_number`,
                                  `.distance_on_edge`)

       if(!inherits(data_res, "metric_graph_data")){
         class(data_res) <- c("metric_graph_data", class(data_res))
       }

       return(private$format_data(data_res, format))

     },

     #' @description Return the internal data with the option to filter by groups.
     #' @param group A vector contaning which groups should be returned?
     #' The default is `NULL`, which gives the result for the all groups.
     #' @param format Which format should the data be returned? The options are
     #' `tibble` for `tidyr::tibble`, `sf` for `POINT`, `sp` for `SpatialPointsDataFrame`
     #' and `list` for the internal list format.
     #' @param drop_na Should the rows with at least one NA for one of the
     #' columns be removed? DEFAULT is `FALSE`.
     #' @param drop_all_na Should the rows with all variables being NA be removed?
     #' DEFAULT is `TRUE`.
     #' @param tibble `r lifecycle::badge("deprecated")` Use `format` instead.

     get_data = function(group = NULL,
                         format = c("tibble", "sf", "sp", "list"),
                         drop_na = FALSE,
                         drop_all_na = TRUE,
                         tibble = deprecated()){
       if(is.null(private$data)){
         stop("The graph does not contain data.")
       }

       if (lifecycle::is_present(tibble)) {
         lifecycle::deprecate_warn("1.3.0.9000", "get_edge_weights(tibble)",
                                   "get_edge_weights(format)",
                                   details = c("The argument `tibble` was deprecated in favor of the argument `format`.")
         )
         if(tibble){
           format <- "tibble"
         }
       }

       format <- format[[1]]

       format <- tolower(format)

       if(!(format %in% c("tibble", "sf", "sp", "list"))){
         stop("The possible formats are 'tibble', 'sf', 'sp' and 'list'.")
       }


       if(!is.null(group)){
         total_groups <- self$get_groups()
         if(!(all(group %in% total_groups))){
           if(all(group%%1 == 0)){
             group <- total_groups[group]
           } else{
             stop("At least one entry of 'group' is a not an existing group or an existing index.")
           }
         }

         data_temp <- select_group(private$data, group)
       } else{
         data_temp <- private$data
       }


       if(format == "tibble"){
         data_temp <- tidyr::as_tibble(data_temp)
       }

       if(drop_all_na){
         is_tbl <- inherits(data_temp, "tbl_df")
         idx_temp <- idx_not_all_NA(data_temp)
         data_temp <- lapply(data_temp, function(dat){dat[idx_temp]})
         if(is_tbl){
           data_temp <- tidyr::as_tibble(data_temp)
         }
       }

       if(drop_na){
         if(!inherits(data_temp, "tbl_df")){
           idx_temp <- idx_not_any_NA(data_temp)
           data_temp <- lapply(data_temp, function(dat){dat[idx_temp]})
         } else{
           data_temp <- tidyr::drop_na(data_temp)
         }
       }

       if(format == "sf"){
         data_temp <- as.data.frame(data_temp)
         data_geometries <- lapply(1:nrow(data_temp),
                                   function(i) sf::st_point(as.numeric(data_temp[i, c('.coord_x', '.coord_y')])))
         data_temp <- sf::st_sf(data_temp, geometry = sf::st_sfc(data_geometries),
                                crs = if(!is.null(private$crs)) private$crs else NULL)
       }

       if(!inherits(data_temp, "metric_graph_data")){
         class(data_temp) <- c("metric_graph_data", class(data_temp))
       }

       if(format == "sp"){
         data_temp <- as.data.frame(data_temp)
         sp::coordinates(data_temp) <- ~ .coord_x + .coord_y
       }

       return(data_temp)
     },
     #' @description Define the columns to be used for creating the directional vertex
     #' weights. Also possible to supply user defined functions for input and output
     #' to create ones own weights.
     #' @param f_in functions for the input vertex (default `w/sum(w)`) uses the
     #' columns of name_column
     #' @param f_out functions for the output vertex (deafult `rep(-1,length(w))`)
     #' uses the columns of name_column
     #' @details For more details see paper (that does not exists yet).
     #' @return No return value.
     setDirectionalWeightFunction = function(f_in = NULL,
                                             f_out = NULL){


       if(!is.null(self$C)){
         warning('The constraint matrix has been deleted')
       }
       self$C     = NULL
       self$CoB   = NULL
       self$CoB$T = NULL

       if(!is.null(f_in)){
         self$DirectionalWeightFunction_in = f_in
       }else{
         self$DirectionalWeightFunction_in  = function(w){ w/sum(w)}
       }
       if(!is.null(f_out)){
         self$DirectionalWeightFunction_out = f_out
       }else{
         self$DirectionalWeightFunction_out = function(w){ rep(-1,length(w))}
       }
     },

     #' @description Build directional ODE constraint matrix from edges.
     #' @param alpha how many derivatives the processes has
     #' @param weight weighting for each vertex used in the constraint (E x 2)
     #' @details Currently not implemented for circles (edges that start and end
     #' in the same vertex)
     #' @return No return value. Called for its side effects.
     buildDirectionalConstraints = function(alpha = 1){
       if(alpha %% 1 != 0){
         stop("alpha should be an integer")
       }

       weight <- self$get_edge_weights()
       weight <- as.vector(weight[[private$directional_weights]])
       V_indegree = self$get_degrees("indegree")
       V_outdegree = self$get_degrees("outdegree")

       temp_E <- apply(self$E, 2, as.integer)
       nE_int <- as.integer(self$nE)

       # Pre-compute per-edge weight values in R, then delegate assembly to C++.
       # w_out: one scalar per edge (applied to out-edge of a type-1 constraint row)
       # w_in:  one scalar per edge (applied to in-edge of a type-1 constraint row)
       f_out <- self$DirectionalWeightFunction_out  # local ref avoids repeated $ lookup
       f_in  <- self$DirectionalWeightFunction_in
       w_out_vec <- vapply(weight, f_out, numeric(1), USE.NAMES = FALSE)

       # Group in-edges by vertex (once, O(nE)); apply f_in per type-1 vertex
       # using lapply (C-loop) to avoid R for-loop overhead.
       in_edges_list <- split(seq_len(self$nE), self$E[, 2])
       type1_chars   <- as.character(which(V_indegree > 0 & V_outdegree > 0))
       type1_in_list <- in_edges_list[type1_chars]

       w_in_parts <- lapply(type1_in_list, function(ie) f_in(weight[ie]))

       w_in_vec <- numeric(self$nE)
       for (i in seq_along(type1_chars)) {
         w_in_vec[type1_in_list[[i]]] <- w_in_parts[[i]]
       }

       self$C <- construct_directional_constraint_matrix_fast(
         temp_E, as.integer(self$nV), nE_int, as.integer(alpha),
         as.integer(V_indegree), as.integer(V_outdegree),
         as.numeric(w_out_vec), as.numeric(w_in_vec))
       self$CoB <- c_basis2(self$C)
       self$CoB$T <- t(self$CoB$T)
       self$CoB$alpha <- 1
     },


     #' @description Build Kirchoff constraint matrix from edges.
     #' @param alpha the type of constraint (currently only supports 2)
     #' @param edge_constraint if TRUE, add constraints on vertices of degree 1
     #' @details Currently not implemented for circles (edges that start and end
     #' in the same vertex)
     #' @return No return value. Called for its side effects.
     buildC = function(alpha = 2, edge_constraint = FALSE) {

       if(alpha==2){
         temp_E <- self$E
         temp_E[] <- as.integer(temp_E)

         self$C <- construct_constraint_matrix(temp_E, as.integer(self$nV),
                                               as.integer(edge_constraint))
         self$CoB <- c_basis2_graph(temp_E, as.integer(self$nV),
                                    as.integer(edge_constraint))
         self$CoB$T <- t(self$CoB$T)
         self$CoB$alpha <- 2
       }else{
         stop("only alpha=2 implemented")
       }
     },

     #' @description Builds mesh object for graph.
     #' @param h Maximum distance between mesh nodes (should be provided if n is
     #' not provided).
     #' @param n Maximum number of nodes per edge (should be provided if h is not
     #' provided).
     #' @param  continuous If `TRUE` (default), the mesh contains only one node per vertex.
     #' If `FALSE`, each vertex v is split into deg(v) disconnected nodes to allow
     #' for the creation of discontinuities at the vertices.
     #' @param continuous.outs If `continuous = FALSE` and `continuous.outs = TRUE`,
     #' continuity is assumed for the outgoing edges from each vertex.
     #' @param continuous.deg2 If `TRUE`, continuity is assumed at degree 2 vertices.
     #' @details The mesh is a list with the objects:
     #' - `PtE` The mesh locations excluding the original vertices;
     #' - `V` The verties of the mesh;
     #' - `E` The edges of the mesh;
     #' - `n_e` The number of vertices in the mesh per original edge in the graph;
     #' - `h_e` The mesh width per edge in the graph;
     #' - `ind` The indices of the vertices in the mesh;
     #' - `VtE` All mesh locations including the original vertices.
     #' @return No return value. Called for its side effects. The mesh is stored in
     #' the `mesh` element of the `metric_graph` object.

     build_mesh = function(h = NULL, n = NULL, continuous = TRUE,
                           continuous.outs = FALSE, continuous.deg2 = FALSE) {
       if (is.null(h) && is.null(n)) {
         stop("You should specify either h or n!")
       }

       if (!is.null(h)) {
         if (length(h) > 1 || !is.numeric(h)) stop("h should be a single number")
         if (h <= 0) stop("h must be positive!")
       }

       if (!is.null(n)) {
         if (length(n) > 1 || !is.numeric(n)) stop("n should be a single number")
         if (n <= 0) stop("n must be positive!")
         if (n %% 1 != 0) {
           warning("A noninteger n was given, we are rounding it to an integer.")
           n <- round(n)
         }
       }

       mesh <- list(PtE = NULL, V = NULL, E = NULL,
                    n_e = integer(length(self$edges)),
                    h_e = NULL, ind = NULL, VtE = NULL)
       mesh$n_e <- integer(length(self$edges))
       attr(mesh, "continuous") <- continuous

       edge_lengths <- self$edge_lengths
       n_edges <- length(self$edges)

       if (continuous) {
         mesh$V <- self$V
         mesh$ind <- seq_len(self$nV)

         if (is.null(n)) {
           mesh$n_e <- ceiling(edge_lengths / h) + 1 - 2
         } else {
           mesh$n_e <- rep(n, n_edges)
         }

         # Call the Rcpp function
         mesh_data <- generate_mesh(n_edges, edge_lengths, mesh$n_e, self$E,
                                    mesh$ind, continuous)

         mesh$PtE <- cbind(mesh_data$PtE_edge, mesh_data$PtE_pos)
         mesh$h_e <- mesh_data$h_e
         mesh$E <- cbind(mesh_data$E_start, mesh_data$E_end)

         mesh$VtE <- rbind(self$VtEfirst(), mesh$PtE)
         if (!is.null(mesh$PtE) && nrow(mesh$PtE) > 0) {
           mesh$V <- rbind(mesh$V, self$coordinates(PtE = mesh$PtE))
         }
         self$mesh <- mesh
       } else {
         mesh$ind <- 0

         if (is.null(n)) {
           mesh$n_e <- ceiling(edge_lengths / h) + 1
         } else {
           mesh$n_e <- rep(n + 2, n_edges)
         }

         # Call the Rcpp function for the non-continuous case
         mesh_data <- generate_mesh(n_edges, edge_lengths, mesh$n_e, self$E,
                                    mesh$ind, continuous = FALSE)

         mesh$PtE <- cbind(mesh_data$PtE_edge, mesh_data$PtE_pos)
         mesh$h_e <- mesh_data$h_e
         mesh$E <- cbind(mesh_data$E_start, mesh_data$E_end)

         mesh$VtE <- mesh$PtE
         if(!is.null(mesh$PtE) && nrow(mesh$PtE) > 0) {
           mesh$V <- self$coordinates(PtE = mesh$PtE)
         }
         self$mesh <- mesh
         if (continuous.outs) private$mesh_merge_outs()
         private$move_V_first()
         if (continuous.deg2) private$mesh_merge_deg2()
       }
     },

     #' @description Get the version of MetricGraph package used to build the graph
     #' @return A character string with the version number
     get_version = function() {
       return(private$version)
     },

     #' @description Does this graph have more than one connected component?
     #' The decomposition is computed and cached at construction time, so
     #' this is an O(1) lookup.
     #' @return `TRUE` if the graph has two or more connected components,
     #' `FALSE` otherwise.
     is_disconnected = function() {
       isTRUE(private$nC > 1L)
     },

     #' @description Return the connected components of the graph as a
     #' list of `metric_graph` objects. For a connected graph this is
     #' simply `list(self)`. For a disconnected graph, the components are
     #' returned in order of decreasing total edge length and any
     #' observations stored on `self` are routed to the appropriate
     #' component. The result is cached internally; subsequent calls are
     #' O(1) until observations change (which invalidates the cache).
     #' @param verbose Verbosity level passed to the per-component
     #' constructors (default `0`).
     #' @return A list of `metric_graph` objects.
     get_components = function(verbose = 0) {
       if (!is.null(private$components_cache)) {
         return(private$components_cache)
       }
       if (self$nE == 0L) {
         private$components_cache <- list()
         return(private$components_cache)
       }
       if (private$nC <= 1L) {
         private$components_cache <- list(self)
         return(private$components_cache)
       }

       # Per-component edge ID lists, in canonical (length-sorted)
       # component order — `compute_component_membership()` already sorted
       # so that component 1 is the largest.
       edge_component <- private$component_membership[self$E[, 1]]
       out <- vector("list", private$nC)
       for (k in seq_len(private$nC)) {
         edge_keep <- which(edge_component == k)
         if (length(edge_keep) == 0L) next

         args <- list(
           edges = self$edges[edge_keep],
           check_connected = FALSE,
           perform_merges = FALSE,
           verbose = verbose,
           longlat = private$longlat,
           crs = private$crs,
           proj4string = private$proj4string,
           tolerance = private$tolerance
         )
         ew <- private$edge_weights
         if (!is.null(ew)) {
           if (is.data.frame(ew)) {
             args$edge_weights <- ew[edge_keep, , drop = FALSE]
           } else {
             args$edge_weights <- ew[edge_keep]
           }
         }
         g_k <- do.call(metric_graph$new, args)

         if (!is.null(private$data)) {
           idx <- private$data[[".edge_number"]] %in% edge_keep
           if (any(idx)) {
             d <- lapply(private$data, function(x) x[idx])
             d[[".edge_number"]] <- match(d[[".edge_number"]], edge_keep)
             class(d) <- "metric_graph_data"
             suppressMessages(suppressWarnings(
               g_k$add_observations(data = d, verbose = 0,
                                    suppress_warnings = TRUE)
             ))
           }
         }
         out[[k]] <- g_k
       }
       private$components_cache <- out[!vapply(out, is.null, logical(1))]
       private$components_cache
     },

     #' @description For each spatial point, determine which connected
     #' component of the graph it belongs to. The component is the one
     #' whose nearest edge is closest in Euclidean distance to the point.
     #' @param XY An `n x 2` matrix of spatial coordinates (or a
     #' length-2 numeric vector for a single point).
     #' @return An integer vector of length `n` with the component
     #' index for each point. Indices match those of
     #' `get_components()` (i.e. components are sorted by total edge
     #' length, descending).
     which_component = function(XY) {
       if (is.vector(XY)) {
         if (length(XY) != 2) {
           stop("XY is a vector but does not have length 2")
         }
         XY <- matrix(XY, 1, 2)
       }
       if (ncol(XY) != 2) {
         stop("XY must have two columns!")
       }
       if (private$nC <= 1L) {
         return(rep(1L, nrow(XY)))
       }
       # One snap to the full edge set; look up the component of the
       # nearest edge directly via the cached `component_membership`.
       res <- snapPointsToLines(
         points = XY,
         lines = self$edges,
         longlat = FALSE,
         crs = NULL
       )
       nearest_edge <- as.integer(res$df$nearest_line_index)
       private$component_membership[self$E[nearest_edge, 1]]
     },

     #' @description Build mass and stiffness matrices for given mesh object.
     #' @details The function builds: The matrix `C` which is the mass matrix with
     #' elements \eqn{C_{ij} = <\phi_i, \phi_j>}, the matrix `G` which is the stiffness
     #' matrix with elements \eqn{G_{ij} = <d\phi_i, d\phi_j>}, the matrix `B` with
     #' elements \eqn{B_{ij} = <d\phi_i, \phi_j>}, the matrix `D` with elements
     #' \eqn{D_{ij} = \sum_{v\in V}\phi_i(v)\phi_j(v)}, and the vector with weights
     #' \eqn{<\phi_i, 1>}.
     #' @param petrov Compute Petrov-Galerkin matrices? (default `FALSE`). These
     #' are defined as \eqn{Cpet_{ij} = <\phi_i, \psi_j>} and \eqn{Gpet_{ij} = <d\phi_i, \psi_j>},
     #' where \eqn{\psi_{i}} are piecewise constant basis functions on the edges of
     #' the mesh.
     #' @return No return value. Called for its side effects. The finite element
     #' matrices `C`, `G` and `B` are stored in the `mesh` element in the
     #' `metric_graph` object. If `petrov=TRUE`, the corresponding Petrov-Galerkin
     #' matrices are stored in `Cpet` and `Gpet`.
     compute_fem = function(petrov = FALSE) {
       if (is.null(self$mesh)) {
         stop("no mesh provided")
       }
       nV <- dim(self$mesh$V)[1]
       fem_temp <- assemble_fem(E = self$mesh$E, h_e = self$mesh$h_e, nV = nV,
                                petrov = petrov)
       self$mesh$C <- fem_temp$C
       self$mesh$G <- fem_temp$G
       self$mesh$B <- fem_temp$B
       self$mesh$D <- Diagonal(dim(self$mesh$C)[1],
                               c(rep(1, self$nV),
                                 rep(0, dim(self$mesh$C)[1] - self$nV)))
       #set weighted Krichhoff matrix
       self$mesh$K <- Diagonal(dim(self$mesh$C)[1],
                               c(rep(0, self$nV),
                                 rep(0, dim(self$mesh$C)[1] - self$nV)))

       if(!is.null(private$kirchhoff_weights)){
         nV_loc      <- self$nV
         mE_loc      <- self$mesh$E
         mVtE_loc    <- self$mesh$VtE
         mh_loc      <- self$mesh$h_e
         edges_loc   <- self$edges
         vertices_loc <- self$vertices
         K_dim       <- dim(self$mesh$C)[1]
         K_diag_loc  <- numeric(K_dim)

         # Precompute vertex-to-mesh-edge adjacency list (O(nE_mesh))
         nE_mesh <- nrow(mE_loc)
         vtx_mesh_edges <- vector("list", K_dim)
         for(k in seq_len(nE_mesh)) {
           v1 <- mE_loc[k, 1L]
           v2 <- mE_loc[k, 2L]
           vtx_mesh_edges[[v1]] <- c(vtx_mesh_edges[[v1]], k)
           vtx_mesh_edges[[v2]] <- c(vtx_mesh_edges[[v2]], k)
         }

         for(i in seq_len(nV_loc)) {
           deg_i <- attr(vertices_loc[[i]], "degree")
           if(deg_i > 1) {
             edges.mesh <- vtx_mesh_edges[[i]]
             n_em <- length(edges.mesh)
             w <- numeric(n_em)
             h <- numeric(n_em)
             for(j in seq_len(n_em)) {
               em_j <- edges.mesh[j]
               row_j <- mE_loc[em_j, ]
               V.e <- row_j[row_j != i]
               if(length(V.e) == 0){
                 V.e <- row_j[1]
               }
               E.e <- mVtE_loc[V.e, 1]            # the edge the mesh node is on
               edge_attrs <- edges_loc[[E.e]]
               kw    <- attr(edge_attrs, "kirchhoff_weight")
               w_tmp <- attr(edge_attrs, "weight")
               w[j]  <- w_tmp[[kw]]
               h[j]  <- mh_loc[em_j]
             }
             w1 <- w[1]
             acc <- 0
             for(j in 2:deg_i){
               acc <- acc + (w[j]/w1 - 1)/h[j]
             }
             K_diag_loc[i] <- acc
           }
         }
         self$mesh$K <- Diagonal(K_dim, K_diag_loc)
       }

       if(petrov) {
         self$mesh$Cpet <- fem_temp$Cpet
         self$mesh$Gpet <- fem_temp$Gpet
         private$set_petrov_matrices()
       }

       self$mesh$weights <- rowSums(self$mesh$C)
     },


     #' @description Compute the weights of the mesh nodes.
     #' @details Compute the weights of the mesh nodes.
     #' @return No return value. Called for its side effects.
     #' The weights are stored in the `mesh` element in the
     #' `metric_graph` object.
     compute_mesh_weights = function() {
       if (is.null(self$mesh)) {
         stop("no mesh provided")
       }
       nV <- dim(self$mesh$V)[1]
       self$mesh$weights <- compute_mesh_weights(E = self$mesh$E, h_e = self$mesh$h_e, nV = nV)
     },

     #' @description Deprecated - Computes observation matrix for mesh.
     #'
     #'  `r lifecycle::badge("deprecated")` in favour of `metric_graph$fem_basis()`.
     #' @param PtE Locations given as (edge number in graph, normalized location on
     #' edge)
     #' @details For n locations and a mesh with m nodes, `A` is an n x m matrix with
     #' elements \eqn{A_{ij} = \phi_j(s_i)}{A_{ij} = \phi_j(s_i)}.
     #' @return The observation matrix.
     #'

     mesh_A = function(PtE){
       lifecycle::deprecate_warn("1.2.0", "metric_graph$mesh_A()",
                                 "metric_graph$fem_basis()")
       self$fem_basis(PtE)
     },

     #' @description Computes observation matrix for mesh.
     #' @param PtE Locations given as (edge number in graph, normalized location on
     #' edge)
     #' @details For n locations and a mesh with m nodes, `A` is an n x m matrix with
     #' elements \eqn{A_{ij} = \phi_j(s_i)}{A_{ij} = \phi_j(s_i)}.
     #' @return The observation matrix.
     fem_basis = function(PtE) {
       if(ncol(PtE)!= 2){
         stop("PtE must have two columns!")
       }

       if (min(PtE[,2]) < 0) {
         stop("PtE[, 2] has negative values")
       }
       if ((max(PtE[,2]) > 1)) {
         stop("For normalized distances, the values in PtE[, 2] should not be
larger than 1")
       }
       if (is.null(self$mesh)) {
         stop("no mesh given")
       }

       x <- private$PtE_to_mesh(PtE)
       n <- dim(x)[1]

       A <- sparseMatrix(i = c(1:n, 1:n),
                         j = c(self$mesh$E[x[, 1], 1], self$mesh$E[x[, 1], 2]),
                         x = c(1 - x[, 2], x[, 2]),
                         dims = c(n, dim(self$mesh$V)[1]))
       return(A)
     },

     #' @description Find one edge corresponding to each vertex.
     #' @return A nV x 2 matrix the first element of the `i`th row is the edge
     #' number corresponding to the `i`th vertex and the second value is 0
     #' if the vertex is at the start of the edge and 1 if the vertex
     #' is at the end of the edge.
     VtEfirst = function() {
       E_local <- self$E
       n.V <- dim(self$V)[1]
       n.E <- dim(E_local)[1]

       # Defaults match the original: vertices not found in column 1 get pos = 1;
       # vertices not found at all stay (NA, 1).
       VtE <- matrix(0L, nrow = n.V, ncol = 2L)
       VtE[, 1L] <- NA_integer_
       VtE[, 2L] <- 1L

       if (n.E > 0L) {
         # Iterate edge indices in decreasing order so that, under R's
         # "last assignment wins" rule for duplicated subscripts, the SMALLEST
         # edge index ends up stored for each vertex — same as which(...)[1].
         idx <- n.E:1L

         # Lower-priority pass: column-2 matches (pos = 1).
         v2 <- E_local[idx, 2L]
         VtE[v2, 1L] <- idx
         # pos column already 1L; no need to touch it.

         # Higher-priority pass: column-1 matches (pos = 0). Overwrites col-2 hits.
         v1 <- E_local[idx, 1L]
         VtE[v1, 1L] <- idx
         VtE[v1, 2L] <- 0L
       }

       VtE
     },

     #' @description Plots the metric graph.
     #' @param data Which column of the data to plot? If `NULL`, no data will be
     #' plotted.
     #' @param newdata A dataset of class `metric_graph_data`, obtained by any
     #' `get_data()`, `mutate()`, `filter()`, `summarise()`, `drop_na()` methods
     #' of metric graphs, see the vignette on data manipulation for more details.
     #' @param group If there are groups, which group to plot? If `group` is a
     #' number and `newdata` is `NULL`, it will be the index of the group as stored
     #' internally and if `newdata` is provided, it will be the index of the group
     #' stored in `newdata`. If `group`
     #' is a character, then the group will be chosen by its name.
     #' @param type The type of plot to be returned. The options are `ggplot` (the default),
     #' that uses `ggplot2`; `plotly` that uses `plot_ly` for 3D plots, which
     #' requires the `plotly` package, and `mapview` that uses the `mapview` function,
     #' to build interactive plots, which requires the `mapview` package.
     #' @param interactive Only works for 2d plots. If `TRUE`, an interactive plot
     #' will be displayed. Unfortunately, `interactive` is not compatible with
     #' `edge_weight` if `add_new_scale_weights` is TRUE.
     #' @param vertex_size Size of the vertices.
     #' @param vertex_color Color of vertices.
     #' @param edge_width Line width for edges. If `edge_width_weight` is not `NULL`,
     #' this determines the maximum edge width.
     #' @param edge_color Color of edges.
     #' @param data_size Size of markers for data.
     #' @param support_width For 3D plot, width of support lines.
     #' @param support_color For 3D plot, color of support lines.
     #' @param mesh Plot the mesh locations?
     #' @param X Additional values to plot.
     #' @param X_loc Locations of the additional values in the format
     #' (edge, normalized distance on edge).
     #' @param p Existing objects obtained from 'ggplot2' or 'plotly' to add the graph to
     #' @param degree Show the degrees of the vertices?
     #' @param direction Show the direction of the edges? For `type == "mapview"`
     #' the arrows are not shown, only the color of the vertices indicating whether
     #' they are problematic or not.
     #' @param arrow_size The size of the arrows if direction is TRUE.
     #' @param edge_weight Which column from edge weights to determine the colors
     #' of the edges? If `NULL` edge weights are not plotted. To plot the edge
     #' weights when the metric graph `edge_weights` is a vector instead of a
     #' `data.frame`, simply set to 1. `edge_weight` is only available for 2d plots.
     #' For 3d plots with edge weights, please use the `plot_function()` method.
     #' @param edge_width_weight Which column from edge weights to determine the
     #' edges widths? If `NULL` edge width will be determined from `edge_width`.
     #' Currently it is not supported for `type = "mapview"`.
     #' @param scale_color_main Color scale for the data to be plotted.
     #' @param scale_color_weights Color scale for the edge weights. Will only
     #' be used if `add_new_scale_weights` is TRUE.
     #' @param scale_color_main_discrete Color scale for the data to be plotted,
     #' for discrete data.
     #' @param scale_color_weights_discrete Color scale for discrete edge weights.
     #' Will only be used if `add_new_scale_weights` is TRUE.
     #' @param scale_color_degree Color scale for the degrees.
     #' @param add_new_scale_weights Should a new color scale for the edge weights
     #' be created?
     #' @param scale_color_mapview Color scale to be applied for data when `type = "mapview"`.
     #' @param scale_color_weights_mapview Color scale to be applied for edge
     #' weights when `type = "mapview"`.
     #' @param scale_color_weights_discrete_mapview Color scale to be applied for
     #' degrees when `type = "mapview"`. If `NULL` `RColorBrewer::brewer.pal(n = n_weights, "Set1")`
     #' will be used where `n_weights` is the number of different degrees.
     #' @param scale_color_degree_mapview Color scale to be applied for degrees
     #' when `type = "mapview"`. If `NULL` `RColorBrewer::brewer.pal(n = n_degrees, "Set1")`
     #' will be used where `n_degrees` is the number of different degrees.
     #' @param plotly  `r lifecycle::badge("deprecated")` Use `type` instead.
     #' @param components Color the connected components separately.
     #' Either `FALSE` (the default; the graph is plotted as-is),
     #' `TRUE` (each component is drawn in a randomly-chosen color), or
     #' an `n x 3` numeric matrix of RGB values in `[0, 1]` (one row
     #' per component, indices matching `get_components()`).
     #' @param ... Additional arguments to pass to `ggplot()` or `plot_ly()`
     #' @return A `plot_ly` (if `type = "plotly"`) or `ggplot` object.
     plot = function(data = NULL,
                     newdata = NULL,
                     group = 1,
                     type = c("ggplot", "plotly", "mapview"),
                     interactive = FALSE,
                     vertex_size = 3,
                     vertex_color = 'black',
                     edge_width = 0.3,
                     edge_color = 'black',
                     data_size = 1,
                     support_width = 0.5,
                     support_color = "gray",
                     mesh = FALSE,
                     X = NULL,
                     X_loc = NULL,
                     p = NULL,
                     degree = FALSE,
                     direction = FALSE,
                     arrow_size = ggplot2::unit(0.25, "inches"),
                     edge_weight = NULL,
                     edge_width_weight = NULL,
                     scale_color_main = ggplot2::scale_color_viridis_c(option = "D"),
                     scale_color_weights = ggplot2::scale_color_viridis_c(option = "C"),
                     scale_color_degree = ggplot2::scale_color_viridis_d(option = "D"),
                     scale_color_weights_discrete = ggplot2::scale_color_viridis_d(option = "C"),
                     scale_color_main_discrete = ggplot2::scale_color_viridis_d(option = "C"),
                     add_new_scale_weights = TRUE,
                     scale_color_mapview = viridis::viridis(100, option = "D"),
                     scale_color_weights_mapview = viridis::viridis(100, option = "C"),
                     scale_color_weights_discrete_mapview = NULL,
                     scale_color_degree_mapview = NULL,
                     plotly = deprecated(),
                     components = FALSE,
                     ...) {
        
       if(!is.null(group)){
        group <- as.character(group)
       } 

       if (!isFALSE(components)) {
         comp_list <- self$get_components()
         nc <- length(comp_list)
         if (nc > 1L) {
           if (isTRUE(components)) {
             col_mat <- matrix(0, nrow = nc, ncol = 3)
             if (nc > 1L) {
               for (i in 2:nc) col_mat[i, ] <- runif(3)
             }
           } else if (is.matrix(components) && ncol(components) == 3 &&
                      nrow(components) == nc) {
             col_mat <- components
           } else {
             stop("'components' must be FALSE, TRUE, or an n x 3 matrix of RGB values, where n is the number of components.")
           }
           p_out <- p
           for (i in seq_len(nc)) {
             col_i <- rgb(col_mat[i, 1], col_mat[i, 2], col_mat[i, 3])
             g_data <- comp_list[[i]]$.__enclos_env__$private$data
             has_data_i <- is.null(data) || !is.character(data) ||
               (!is.null(g_data) && data %in% names(g_data))
             p_out <- suppressMessages(comp_list[[i]]$plot(
               data = if (has_data_i) data else NULL,
               newdata = newdata, group = group, type = type,
               interactive = interactive,
               vertex_size = vertex_size, vertex_color = col_i,
               edge_width = edge_width, edge_color = col_i,
               data_size = data_size,
               support_width = support_width, support_color = support_color,
               mesh = mesh, X = X, X_loc = X_loc, p = p_out,
               degree = degree, direction = direction,
               arrow_size = arrow_size,
               edge_weight = edge_weight,
               edge_width_weight = edge_width_weight,
               scale_color_main = scale_color_main,
               scale_color_weights = scale_color_weights,
               scale_color_degree = scale_color_degree,
               scale_color_weights_discrete = scale_color_weights_discrete,
               scale_color_main_discrete = scale_color_main_discrete,
               add_new_scale_weights = add_new_scale_weights,
               scale_color_mapview = scale_color_mapview,
               scale_color_weights_mapview = scale_color_weights_mapview,
               scale_color_weights_discrete_mapview = scale_color_weights_discrete_mapview,
               scale_color_degree_mapview = scale_color_degree_mapview,
               components = FALSE,
               ...))
           }
           return(p_out)
         }
       }

       if (lifecycle::is_present(plotly)) {
         lifecycle::deprecate_warn("1.3.0.9000", "plot(plotly)", "plot(type)",
                                   details = c("The argument `plotly` was deprecated in favor of the argument `type`.")
         )
         if(plotly){
           type <- "plotly"
         }
       }

       if(!is.null(data) && is.null(private$data) && is.null(newdata)) {
         stop("The graph does not contain data.")
       }
       if(is.numeric(group) && !is.null(data) && is.null(newdata)) {
         unique_group <- unique(private$data[[".group"]])
         group <- unique_group[group]
       } else if(!is.null(newdata) && is.numeric(group)){
         unique_group <- unique(newdata[[".group"]])
         group <- unique_group[group]
       }
       if(!is.null(newdata)){
         if(!inherits(newdata, "metric_graph_data")){
           stop("'newdata' must be of class 'metric_graph_data'!")
         }
       }

       type <- type[[1]]

       if(!(type %in% c("ggplot", "plotly", "mapview"))){
         stop("type must be one of the following: 'ggplot', 'plotly' or 'mapview'.")
       }

       if(type == "ggplot") {
         p <- private$plot_2d(line_width = edge_width,
                              marker_size = vertex_size,
                              vertex_color = vertex_color,
                              edge_color = edge_color,
                              data = data,
                              newdata = newdata,
                              data_size = data_size,
                              group = group,
                              mesh = mesh,
                              X = X,
                              X_loc = X_loc,
                              p = p,
                              degree = degree,
                              direction = direction,
                              edge_weight = edge_weight,
                              edge_width_weight = edge_width_weight,
                              scale_color_main = scale_color_main,
                              scale_color_weights = scale_color_weights,
                              scale_color_degree = scale_color_degree,
                              add_new_scale_weights = add_new_scale_weights,
                              arrow_size = arrow_size,
                              scale_color_main_discrete = scale_color_main_discrete,
                              scale_color_weights_discrete = scale_color_weights_discrete,
                              ...)
         if(!is.null(private$vertex_unit)){
           if(private$vertex_unit == "degree" && !private$transform){
             p <- p + labs(x = "Longitude",  y = "Latitude")
           } else{
             p <- p + labs(x = paste0("x (in ",private$vertex_unit, ")"),
                           y = paste0("y (in ",private$vertex_unit, ")"))
           }
         }
       } else if(type == "plotly") {
         requireNamespace("plotly")
         p <- private$plot_3d(line_width = edge_width,
                              marker_size = vertex_size,
                              vertex_color = vertex_color,
                              edge_color = edge_color,
                              data = data,
                              newdata = newdata,
                              data_size = data_size,
                              group = group,
                              mesh = mesh,
                              X = X,
                              X_loc = X_loc,
                              support_color = support_color,
                              support_width = support_width,
                              p = p,
                              edge_width_weight = edge_width_weight,
                              ...)
         p <-  plotly::layout(p, scene = list(xaxis = list(autorange = "reversed")))
         if(!is.null(private$vertex_unit)){
           if(private$vertex_unit == "degree" && !private$transform){
             p <- plotly::layout(p, scene = list(xaxis = list(title = "Longitude"),
                                                 yaxis = list(title = "Latitude")))
           } else{
             p <- plotly::layout(p, scene = list(xaxis = list(title = paste0("x (in ",
                                                                             private$vertex_unit, ")")),
                                                 yaxis = list(title = paste0("y (in ",
                                                                             private$vertex_unit, ")"))))
           }
         }
       } else if(type == "mapview"){
         requireNamespace("mapview")
         edge_width <- 2.5 * edge_width
         edges_sf <- self$get_edges(format = "sf")
         if(is.null(newdata) && !is.null(data)){
           data_sf <- self$get_data(format = "sf")
           idx_grp <- (data_sf[[".group"]] == group)
           data_sf <- data_sf[idx_grp, , drop=FALSE]
           class(data_sf) <- setdiff(class(data_sf), "metric_graph_data")
         } else if (!is.null(data)){
           data_sf <- as.data.frame(newdata)
           data_geometries <- lapply(1:nrow(data_sf),
                                     function(i) sf::st_point(as.numeric(data_sf[i, c('.coord_x', '.coord_y')])))
           data_sf <- sf::st_sf(data_sf, geometry = sf::st_sfc(data_geometries),
                                crs = if(!is.null(private$crs)) private$crs else NULL)
           idx_grp <- (data_sf[[".group"]] == group)
           data_sf <- data_sf[idx_grp, , drop=FALSE]
           class(data_sf) <- setdiff(class(data_sf), "metric_graph_data")
         }

         mapview_output <- p

         if(is.null(p)){
           if (!is.null(edge_weight)) {
             if (!(edge_weight %in% colnames(edges_sf))) {
               stop(paste(edge_weight, "is not a valid column in edges_sf"))
             }

             if(is.character(edges_sf[[edge_weight]]) || is.factor(edges_sf[[edge_weight]])){
               if(is.null(scale_color_degree_mapview)){
                 scale_color_weights_discrete_mapview <- RColorBrewer::brewer.pal(n = length(levels(edges_sf[[edge_weight]])), "Set1")
               }
               scale_weights <- scale_color_weights_discrete_mapview
             } else{
               scale_weights <- scale_color_weights_mapview
             }
             mapview_output <- mapview::mapview(
               x = edges_sf,
               zcol = edge_weight,
               color = scale_weights,
               lwd = edge_width,
               layer.name = "Edges",
               col.regions = scale_weights,
               ...
             )
           } else {
             mapview_output <- mapview::mapview(
               x = edges_sf,
               lwd = edge_width,
               color = edge_color,
               layer.name = "Edges",
               ...
             )
           }
         } else{
           if (!is.null(edge_weight)) {
             if (!(edge_weight %in% colnames(edges_sf))) {
               stop(paste(edge_weight, "is not a valid column in edges_sf"))
             }
             if(is.character(edges_sf[[edge_weight]]) || is.factor(edges_sf[[edge_weight]])){
               if(is.null(scale_color_degree_mapview)){
                 scale_color_weights_discrete_mapview <- RColorBrewer::brewer.pal(n = length(levels(edges_sf[[edge_weight]])), "Set1")
               }
               scale_weights <- scale_color_weights_discrete_mapview
             } else{
               scale_weights <- scale_color_weights_mapview
             }
             mapview_output <- mapview_output + mapview::mapview(
               x = edges_sf,
               zcol = edge_weight,
               color = scale_weights,
               lwd = edge_width,
               layer.name = "Edges",
               col.regions = scale_weights,
               ...
             )
           } else {
             mapview_output <- mapview_output + mapview::mapview(
               x = edges_sf,
               lwd = edge_width,
               color = edge_color,
               layer.name = "Edges",
               ...
             )
           }
         }



         if (degree) {
           vertices_sf <- self$get_vertices(format = "sf")
           vertices_sf$degree <- as.factor(vertices_sf$degree)
           if(is.null(scale_color_degree_mapview)){
             scale_color_degree_mapview <- RColorBrewer::brewer.pal(n = length(levels(vertices_sf$degree)), "Set1")
           }

           mapview_output <- mapview_output + mapview::mapview(
             x = vertices_sf,
             zcol = "degree",
             cex = vertex_size,
             col.regions = scale_color_degree_mapview,
             color = scale_color_degree_mapview,
             layer.name = "Vertices (Degree)",
             ...
           )
         } else if (direction) {
           vertices_sf <- self$get_vertices(format = "sf")
           problematic_vertices <- vertices_sf[vertices_sf$problematic == TRUE, ]
           non_problematic_vertices <- vertices_sf[vertices_sf$problematic == FALSE, ]

           mapview_output <- mapview_output + mapview::mapview(
             x = problematic_vertices,
             cex = vertex_size,
             col.regions = "red",
             color = "red",
             layer.name = "Problematic Vertices",
             ...
           )

           mapview_output <- mapview_output + mapview::mapview(
             x = non_problematic_vertices,
             cex = vertex_size,
             col.regions = "green",
             color = "green",
             layer.name = "Non-problematic Vertices",
             ...
           )
         } else if(vertex_size > 0){
           vertices_sf <- self$get_vertices(format = "sf")
           mapview_output <- mapview_output + mapview::mapview(
             x = vertices_sf,
             cex = vertex_size,
             col.regions = vertex_color,
             color = vertex_color,
             layer.name = "Vertices",
             ...
           )
         }

         if (!is.null(data)) {
           if (!(data %in% names(data_sf))) {
             stop(paste(data, "is not an existing column name in the dataset."))
           }
           data_size <- 2 * data_size

           mapview_output <- mapview_output + mapview::mapview(
             x = data_sf,
             zcol = data,
             cex = data_size,
             col.regions = scale_color_mapview,
             color = scale_color_mapview,
             layer.name = data,
             ...
           )
         }

         if(vertex_size > 0){
           if (mesh) {
             if (is.null(self$mesh)) {
               stop("The metric graph does not contain a mesh.")
             }

             mesh_df <- as.data.frame(self$mesh$V)
             colnames(mesh_df) <- c("X", "Y")
             mesh_sf <- sf::st_as_sf(mesh_df, coords = c("X", "Y"))

             if (!is.null(private$crs)) {
               sf::st_crs(mesh_sf) <- private$crs
             } else {
               sf::st_crs(mesh_sf) <- sf::NA_crs_
             }

             mapview_output <- mapview_output + mapview::mapview(
               x = mesh_sf,
               cex = vertex_size * 0.5,
               col.regions = "gray",
               color = "black",
               layer.name = "Mesh",
               ...
             )
           } else{
             warning("The mesh was not shown since vertex_size is zero.")
           }
         }

         if (!is.null(X)) {
           if (is.null(X_loc)) {
             stop("X supplied but not X_loc")
           }
           if (length(X) != nrow(X_loc)) {
             stop("The number of observations does not match the number of locations!")
           }

           points_xy <- self$coordinates(PtE = X_loc)
           x_loc_sf <- sf::st_as_sf(data.frame(x = points_xy[, 1],
                                               y = points_xy[, 2],
                                               val = as.vector(X)),
                                    coords = c("x", "y"))

           mapview_output <- mapview_output + mapview::mapview(
             x = x_loc_sf,
             zcol = "val",
             cex = data_size,
             col.regions = scale_color_mapview,
             layer.name = "X Points",
             ...
           )
         }

         return(mapview_output)

       }
       if(interactive && (type == "ggplot")){
         print(plotly::ggplotly(p))
         return(invisible(p))
       }
       return(p)
     },

     #' @description Plots the connections in the graph
     #' @return No return value. Called for its side effects.
     plot_connections = function(){
       g <- make_graph(edges = c(t(self$E)), directed = FALSE)
       plot(g)
     },

     #' @description Checks if the graph is a tree (without considering directions)
     #' @return TRUE if the graph is a tree and FALSE otherwise.
     is_tree = function(){
       g <- make_graph(edges = c(t(self$E)), directed = FALSE)
       return(igraph::is_tree(g, mode = "all"))
     },

     #' @description Plots continuous function on the graph.
     #' @param data Which column of the data to plot? If `NULL`, no data will be
     #' plotted.
     #' @param newdata A dataset of class `metric_graph_data`, obtained by any
     #' `get_data()`, `mutate()`, `filter()`, `summarise()`, `drop_na()` methods
     #' of metric graphs, see the vignette on data manipulation for more details.
     #' @param group If there are groups, which group to plot? If `group` is a
     #' number, it will be the index of the group as stored internally. If `group`
     #' is a character, then the group will be chosen by its name.
     #' @param type The type of plot to be returned. The options are `ggplot`
     #' (the default), that uses `ggplot2`; `plotly` that uses `plot_ly` for 3D
     #' plots, which requires the `plotly` package, and `mapview` that uses the
     #' `mapview` function, to build interactive plots, which requires the
     #' `mapview` package.
     #' @param continuous Should continuity be assumed when the plot uses `newdata`?
     #' @param interpolate_plot Should the values to be plotted be interpolated?
     #' @param vertex_size Size of the vertices.
     #' @param vertex_color Color of vertices.
     #' @param edge_width Width for edges.
     #' @param edge_weight Which column from edge weights to plot? If `NULL` edge
     #' weights are not plotted. To plot the edge weights when the metric graph
     #' `edge_weights` is a vector instead of a `data.frame`, simply set to 1.
     #' @param edge_color For 3D plot, color of edges.
     #' @param line_width For 3D plot, line width of the function curve.
     #' @param line_color Color of the function curve.
     #' @param scale_color Color scale to be used for data and weights.
     #' @param scale_color_mapview Color scale to be applied for data when `type = "mapview"`.
     #' @param support_width For 3D plot, width of support lines.
     #' @param support_color For 3D plot, color of support lines.
     #' @param mapview_caption Caption for the function if `type = "mapview"`.
     #' @param p Previous plot to which the new plot should be added.
     #' @param plotly  `r lifecycle::badge("deprecated")` Use `type` instead.
     #' @param improve_plot  `r lifecycle::badge("deprecated")` Use `interpolate`
     #' instead. There is no need to use it to improve the edges.
     #' @param X `r lifecycle::badge("deprecated")` Use `newdata` instead.
     #' @param ... Additional arguments for `ggplot()` or `plot_ly()`
     #' @return Either a `ggplot` (if `plotly = FALSE`) or a `plot_ly` object.
     plot_function = function(data = NULL,
                              newdata = NULL,
                              group = 1,
                              type = c("ggplot", "plotly", "mapview"),
                              continuous = TRUE,
                              interpolate_plot = TRUE,
                              edge_weight = NULL,
                              vertex_size = 5,
                              vertex_color = "black",
                              edge_width = 1,
                              edge_color = 'black',
                              line_width = NULL,
                              line_color = 'rgb(0,0,200)',
                              scale_color = ggplot2::scale_color_viridis_c(option = "D"),
                              scale_color_mapview = viridis::viridis(100, option = "D"),
                              support_width = 0.5,
                              support_color = "gray",
                              mapview_caption = "Function",
                              p = NULL,
                              plotly = deprecated(),
                              improve_plot = deprecated(),
                              X = deprecated(),
                              ...){
       if (is.null(line_width)) {
         line_width = edge_width
       }
       if(!is.null(group)){
        group <- as.character(group)
       }

       if(lifecycle::is_present(X)){
         lifecycle::deprecate_warn("1.3.0.9000", "plot_function(X)", "plot_function(newdata)",
                                   details = c("The argument `X` is deprecated; please use `newdata` to ensure the correct order when plotting.")
         )
       } else {
         X <- NULL
       }

       if (lifecycle::is_present(plotly)) {
         lifecycle::deprecate_warn("1.3.0.9000", "plot(plotly)", "plot(type)",
                                   details = c("The argument `plotly` was deprecated in favor of the argument `type`.")
         )
         if(plotly){
           type <- "plotly"
         }
       }

       type <- type[[1]]

       if(!(type %in% c("ggplot", "plotly", "mapview"))){
         stop("type must be one of the following: 'ggplot', 'plotly' or 'mapview'.")
       }

       mesh <- FALSE

       if(!is.null(edge_weight)){
         edge_weight <- edge_weight[[1]]
         continuous <- FALSE
         newdata <- do.call(rbind, self$edges)
         newdata <- self$edgeweight_to_data(loc = newdata, weight_col = edge_weight,
                                            data_coords = "spatial",
                                            add = FALSE,
                                            return = TRUE,
                                            verbose = 0,
                                            suppress_warnings = TRUE)
         meta_cols <- c(".edge_number", ".distance_on_edge", ".group",
                        ".loc_idx", ".coord_x", ".coord_y")
         data <- setdiff(names(newdata), meta_cols)[1]
       }

       if(is.null(data) && is.null(X) && is.null(edge_weight)){
         stop("You should provide either 'data', 'X' or 'edge_weight'.")
       }

       if(!is.null(data) && !is.null(X)){
         warning("Both 'data' and 'X' were provided. Only 'data' will be considered.")
         X <- NULL
       }

       if(!is.character(data) && (is.vector(data) || !is.null(dim(data)))){
         X <- data
       }

       if(!is.null(X)){
         mesh <- TRUE
         if(!is.vector(X) && is.null(dim(X))){
           stop("'X' should be a vector, or a row-matrix or a column-matrix!")
         }
         if(!is.null(dim(X)) && min(dim(X)) > 1){
           stop("If 'X' is a matrix, it needs to be either a row matrix or a column matrix!")
         }
         X <- as.vector(X)
       }

       if (mesh) {
         if (is.null(self$mesh)) {
           stop("X is a vector but no mesh provided")
         }

         if (is.null(self$mesh$PtE)) {
           PtE_dim <- 0
         } else {
           PtE_dim <- dim(self$mesh$PtE)[1]
         }

         if (length(X) == PtE_dim && attr(self$mesh, "continuous")) {
           X <- c(rep(NA, dim(self$V)[1]), X)
         }


         if (length(X) != dim(unique(self$mesh$V))[1] && length(X) != dim(self$mesh$V)[1]) {
           stop(paste0("X does not have the correct size (the possible sizes are ",
                       PtE_dim,", ", dim(self$mesh$V)[1], " and ",
                       dim(unique(self$mesh$V))[1],")"))
         }

         if(dim(unique(self$mesh$V))[1] != dim(self$mesh$V)[1]){
           if(length(X) == dim(unique(self$mesh$V))[1]){
             X_temp <-  rep(NA, dim(self$mesh$V)[1])
             X_temp[which(!duplicated(self$mesh$V))] <- X
             X <- X_temp
           }
         }

         if(attr(self$mesh, "continuous")){
           n.v <- dim(self$V)[1]
           XV <- X[1:n.v]
         }
       } else{
         if(is.null(newdata)){
           X <- self$get_data(group = group)
           X <- X[,c(".edge_number", ".distance_on_edge", data)]
         } else{
           if(!inherits(newdata, "metric_graph_data")){
             stop("'newdata' must be of class 'metric_graph_data'!")
           }
           X <- newdata[,c(".edge_number", ".distance_on_edge", data)]
         }
       }

       PtE_edges <- lapply(self$edges, function(edge){attr(edge, "PtE")})

       .nE        <- self$nE
       .edges_loc <- self$edges
       .Efrom     <- self$E[, 1]
       .Eto       <- self$E[, 2]
       .n_v       <- max(c(.Efrom, .Eto, dim(self$V)[1]))

       if (!mesh) {
         X <- as.data.frame(X)
         .Xm <- as.matrix(X[, 1:3])  # numeric matrix: edge_no, pos, value
         .X_split <- split(seq_len(nrow(.Xm)), .Xm[, 1])
         .X_by_edge <- vector("list", .nE)
         for (.nm in names(.X_split)) {
           .ei <- as.integer(.nm)
           if (.ei >= 1L && .ei <= .nE) {
             .xj <- .Xm[.X_split[[.nm]], 2:3, drop = FALSE]
             if (nrow(.xj) > 1L) .xj <- .xj[order(.xj[,1]), , drop = FALSE]
             .X_by_edge[[.ei]] <- .xj
           }
         }
       } else {
         .X_by_edge <- NULL
       }

       .edges_from_v <- vector("list", .n_v)  # integer-indexed adjacency
       .edges_to_v   <- vector("list", .n_v)
       for (.i in seq_len(.nE)) {
         .vf <- .Efrom[.i]; .vt <- .Eto[.i]
         .edges_from_v[[.vf]] <- c(.edges_from_v[[.vf]], .i)
         .edges_to_v[[.vt]]   <- c(.edges_to_v[[.vt]],   .i)
       }

       .mesh_idx_by_edge <- if (mesh && !is.null(self$mesh$PtE)) {
         .tmp <- vector("list", .nE)
         .ms  <- split(seq_len(nrow(self$mesh$PtE)), self$mesh$PtE[, 1])
         for (.nm in names(.ms)) {
           .ei <- as.integer(.nm)
           if (.ei >= 1L && .ei <= .nE) .tmp[[.ei]] <- .ms[[.nm]]
         }
         .tmp
       } else NULL

       .out <- vector("list", .nE)
       kk = 1L
       .mesh_continuous <- if (mesh) attr(self$mesh, "continuous") else FALSE
       .mesh_PtE <- if (mesh) self$mesh$PtE else NULL
       for (i in seq_len(.nE)) {
         Vs <- .Efrom[i]
         Ve <- .Eto[i]
         if (mesh) {
           ind_rows <- if (is.null(.mesh_idx_by_edge)) integer(0)
           else .mesh_idx_by_edge[[i]]
           if (is.null(ind_rows)) ind_rows <- integer(0)

           if (length(ind_rows) == 0) {
             if(.mesh_continuous){
               vals <- rbind(c(0, XV[Vs]),
                             c(1, XV[Ve]))
             } else{
               vals <- NULL
             }

           } else {
             if(.mesh_continuous) {
               vals <- rbind(c(0, XV[Vs]),
                             cbind(.mesh_PtE[ind_rows, 2], X[n.v + ind_rows]),
                             c(1, XV[Ve]))
             } else {
               vals <- cbind(.mesh_PtE[ind_rows, 2], X[ind_rows])
             }


           }

           if(interpolate_plot){
             PtE_tmp <- PtE_edges[[i]]
             PtE_new <- PtE_tmp[is.na(match(PtE_tmp, vals[,1]))]
             if(length(PtE_new) > 0){
               n_old <- nrow(vals)
               combined <- matrix(NA_real_, nrow = n_old + length(PtE_new),
                                  ncol = 2)
               combined[seq_len(n_old), ] <- vals
               combined[n_old + seq_along(PtE_new), 1] <- PtE_new
               vals <- combined[order(combined[,1]), , drop = FALSE]
             } else {
               vals <- vals[order(vals[,1]), , drop = FALSE]
             }

             if(nrow(vals) > 0) {
               # Add boundary points if needed
               if(vals[1,1] > 0) {
                 vals <- rbind(c(0,NA), vals)
               }
               if(vals[nrow(vals),1] < 1) {
                 vals <- rbind(vals, c(1,NA))
               }

               # Only proceed with interpolation if there are any non-NA values
               .ok <- !is.na(vals[,1]) & !is.na(vals[,2])
               if(any(.ok)) {
                 max_val <- max(vals[,2], na.rm = TRUE)
                 min_val <- min(vals[,2], na.rm = TRUE)

                 if(length(unique(vals[.ok, 1])) >= 2L) {
                   ap <- stats::approx(x = vals[.ok, 1], y = vals[.ok, 2],
                                       xout = vals[,1], rule = 1, ties = mean)
                   vals[,2] <- na.const(pmax(pmin(ap$y, max_val), min_val))
                 } else {
                   vals[,2] <- na.const(vals[,2])
                 }
               }
               # Keep only values in [0,1] range
               vals <- vals[(vals[,1] >= 0) & (vals[,1] <= 1), , drop = FALSE]
             }
           }


         } else {
           .Xi <- .X_by_edge[[i]]
           vals <- if (is.null(.Xi)) matrix(numeric(0), 0, 2) else .Xi

           if(continuous){
             if(nrow(vals)>0){

               if(!interpolate_plot){
                 if (max(vals[, 1]) < 1) {
                   # Check if we can add end value from another edge
                   start_Ei <- .edges_from_v[[Ve]]  # OPT: O(1)
                   end_Ei   <- .edges_to_v[[Ve]]  # OPT: O(1)

                   min.val <- NA
                   max.val <- NA

                   # Process edges starting at Ve
                   if (length(start_Ei) > 0) {
                     valid_X_start <- do.call(rbind, .X_by_edge[start_Ei])
                     if (is.null(valid_X_start)) valid_X_start <- matrix(numeric(0), 0, 2)
                     ind_start <- which(valid_X_start[, 1] == 0)
                     if (length(ind_start) > 0) {
                       ind_min <- which.min(valid_X_start[ind_start, 2])
                       min.val <- valid_X_start[ind_start, 2][ind_min]
                     }
                   }

                   # Process edges ending at Ve
                   if (length(end_Ei) > 0) {
                     valid_X_end <- do.call(rbind, .X_by_edge[end_Ei])
                     if (is.null(valid_X_end)) valid_X_end <- matrix(numeric(0), 0, 2)
                     ind_end <- which(valid_X_end[, 1] == 1)
                     if (length(ind_end) > 0) {
                       ind_max <- which.max(valid_X_end[ind_end, 2])
                       max.val <- valid_X_end[ind_end, 2][ind_max]
                     }
                   }

                   # Add the closest value to the current vertex
                   if (!is.na(min.val) && !is.na(max.val)) {
                     if (1 - max.val < min.val) {
                       vals <- rbind(vals, c(1, max.val))
                     } else {
                       vals <- rbind(vals, c(1, min.val))
                     }
                   } else if (!is.na(min.val)) {
                     vals <- rbind(vals, c(1, min.val))
                   } else if (!is.na(max.val)) {
                     vals <- rbind(vals, c(1, max.val))
                   }
                 }

                 if   (min(vals[, 1]) > 0) {
                   # Check if we can add start value from another edge
                   start_Ei <- .edges_from_v[[Vs]]
                   end_Ei   <- .edges_to_v[[Vs]]

                   min.val <- NA
                   max.val <- NA

                   # Process edges starting at Vs
                   if (length(start_Ei) > 0) {
                     valid_X_start <- do.call(rbind, .X_by_edge[start_Ei])
                     if (is.null(valid_X_start)) valid_X_start <- matrix(numeric(0), 0, 2)
                     ind_start <- which(valid_X_start[, 1] == 0)
                     if (length(ind_start) > 0) {
                       ind_min <- which.min(valid_X_start[ind_start, 2])
                       min.val <- valid_X_start[ind_start, 2][ind_min]
                     }
                   }

                   # Process edges ending at Vs
                   if (length(end_Ei) > 0) {
                     valid_X_end <- do.call(rbind, .X_by_edge[end_Ei])
                     if (is.null(valid_X_end)) valid_X_end <- matrix(numeric(0), 0, 2)
                     ind_end <- which(valid_X_end[, 1] == 1)
                     if (length(ind_end) > 0) {
                       ind_max <- which.max(valid_X_end[ind_end, 2])
                       max.val <- valid_X_end[ind_end, 2][ind_max]
                     }
                   }

                   # Add the closest value to the current vertex
                   if (!is.na(min.val) && !is.na(max.val)) {
                     if (1 - max.val < min.val) {
                       vals <- rbind(c(0, max.val), vals)
                     } else {
                       vals <- rbind(c(0, min.val), vals)
                     }
                   } else if (!is.na(min.val)) {
                     vals <- rbind(c(0, min.val), vals)
                   } else if (!is.na(max.val)) {
                     vals <- rbind(c(0, max.val), vals)
                   } else if (nrow(vals) > 0) {
                     # Add a placeholder value based on the closest existing value in vals
                     idx_tmp <- which.min(vals[, 1])
                     vals <- rbind(c(0, vals[idx_tmp, 2]), vals)
                   }
                 }
               } else {
                 PtE_tmp <- PtE_edges[[i]]

                 .Vs_i <- .Efrom[i]; .Ve_i <- .Eto[i]
                 .end_at_Vs   <- .edges_to_v[[.Vs_i]]
                 .start_at_Vs <- setdiff(.edges_from_v[[.Vs_i]], i)
                 .start_at_Ve <- .edges_from_v[[.Ve_i]]
                 .end_at_Ve   <- .edges_to_v[[.Ve_i]]

                 # Check for edges ending at the starting point of the current edge
                 if (length(.end_at_Vs) > 0) {
                   edge_new <- .end_at_Vs[1]
                   new_val <- .X_by_edge[[edge_new]]
                   if (NROW(new_val) > 0) {
                     sub_fact <- ifelse(any(vals[, 1] == 0), 1 + 1e-6,
                                        max(new_val[, 1]))
                     new_val[, 1] <- new_val[, 1] - sub_fact
                     vals <- rbind(vals, new_val)
                   }
                 } else if (length(.start_at_Vs) > 0) {
                   edge_new <- .start_at_Vs[1]
                   new_val <- .X_by_edge[[edge_new]]
                   if (NROW(new_val) > 0) {
                     sum_fact <- ifelse(any(vals[, 1] == 1), -1e-6, min(new_val[, 1]))
                     new_val[, 1] <- -new_val[, 1] + sum_fact
                     vals <- rbind(vals, new_val)
                   }
                 }

                 # Check for edges starting at the ending point of the current edge
                 if (length(.start_at_Ve) > 0) {
                   edge_new <- .start_at_Ve[1]
                   new_val <- .X_by_edge[[edge_new]]
                   if (NROW(new_val) > 0) {
                     sum_fact <- ifelse(any(vals[, 1] == 1), 1 + 1e-6,
                                        1 - min(new_val[, 1]))
                     new_val[, 1] <- new_val[, 1] + sum_fact
                     vals <- rbind(vals, new_val)
                   }
                 } else if (length(.end_at_Ve) > 0) {
                   edge_new <- .end_at_Ve[1]
                   new_val <- .X_by_edge[[edge_new]]
                   if (NROW(new_val) > 0) {
                     sub_fact <- ifelse(any(vals[, 1] == 0), 1 + 1e-6,
                                        -max(new_val[, 1]) - 1)
                     new_val[, 1] <- -new_val[, 1] - sub_fact
                     vals <- rbind(vals, new_val)
                   }
                 }

                 # Add remaining PtE values not already in vals
                 PtE_new <- PtE_tmp[is.na(match(PtE_tmp, vals[, 1]))]
                 if (length(PtE_new) > 0) {
                   n_old <- NROW(vals)
                   combined <- matrix(NA_real_, nrow = n_old + length(PtE_new),
                                      ncol = 2)
                   combined[seq_len(n_old), ] <- as.matrix(vals[, 1:2])
                   combined[n_old + seq_along(PtE_new), 1] <- PtE_new
                   vals <- combined[order(combined[,1]), , drop = FALSE]
                 } else {
                   vals <- as.matrix(vals[, 1:2])
                   vals <- vals[order(vals[, 1]), , drop = FALSE]
                 }

                 # Only proceed if there are any non-NA values
                 .ok <- !is.na(vals[,1]) & !is.na(vals[,2])
                 if(any(.ok)) {
                   max_val <- max(vals[.ok, 2])
                   min_val <- min(vals[.ok, 2])

                   if(length(unique(vals[.ok, 1])) >= 2L) {
                     ap <- stats::approx(x = vals[.ok, 1], y = vals[.ok, 2],
                                         xout = vals[,1], rule = 1, ties = mean)
                     vals[,2] <- na.const(pmax(pmin(ap$y, max_val), min_val))
                   } else {
                     vals[,2] <- na.const(vals[,2])
                   }
                 }

                 # Filter values to lie within [0, 1]
                 vals <- vals[(vals[, 1] >= 0) & (vals[, 1] <= 1), , drop = FALSE]

                 # Add a starting value if vals is non-empty and no value at 0
                 if (NROW(vals) > 0 && !any(vals[, 1] == 0)) {
                   vals <- rbind(c(0, vals[1, 2]), vals)
                 }
               }
             } else{
               if(interpolate_plot){
                 vals <- NULL
                 # Helper: combine observations from multiple edges into [pos, val] matrix
                 .gather_obs <- function(edge_ids) {
                   obs <- do.call(rbind, .X_by_edge[edge_ids])
                   if (is.null(obs) || nrow(obs) == 0) NULL else obs
                 }

                 # Find value at Ve (end of current edge) from neighbor edges
                 .ve_val <- NULL
                 Ei <- .edges_from_v[[Ve]]
                 .have_min <- FALSE
                 if (length(Ei) > 0) {
                   .obs <- .gather_obs(Ei)
                   if (!is.null(.obs)) {
                     .at0 <- which(.obs[, 1] == 0)
                     if(length(.at0) > 0){
                       .idx <- which.min(.obs[, 1])
                       min.val <- .obs[.idx, 2]
                       .ve_val <- min.val
                       .have_min <- TRUE
                     } else {
                       .idx <- which.min(.obs[, 1])
                       min.val <- .obs[.idx, 2]
                       .have_min <- TRUE
                     }
                   }
                 }
                 if (!is.null(.ve_val)) {
                   vals <- rbind(vals, c(1, .ve_val), c(1, .ve_val))
                 } else {
                   Ei <- .edges_to_v[[Ve]]
                   .ve_val2 <- NULL
                   if (length(Ei) > 0) {
                     .obs <- .gather_obs(Ei)
                     if (!is.null(.obs)) {
                       .at1 <- which(.obs[, 1] == 1)
                       if(length(.at1) > 0){
                         .idx <- which.max(.obs[, 1])
                         .ve_val2 <- .obs[.idx, 2]
                       } else {
                         .idx_max <- which.max(.obs[, 1])
                         max.val <- .obs[.idx_max, 2]
                         if(!.have_min){
                           .ve_val2 <- max.val
                         } else if (length(.idx_max) == 0){
                           .ve_val2 <- min.val
                         } else{
                           .ve_val2 <- ifelse(1-max.val < min.val, max.val, min.val)
                         }
                       }
                     } else if (.have_min) {
                       .ve_val2 <- min.val
                     }
                   } else if (.have_min) {
                     .ve_val2 <- min.val
                   }
                   if (!is.null(.ve_val2)){
                     vals <- rbind(vals, c(1, .ve_val2))
                   }
                 }

                 # Find value at Vs (start of current edge) from neighbor edges
                 .vs_val <- NULL
                 Ei <- .edges_from_v[[Vs]]
                 .have_min_vs <- FALSE
                 if (length(Ei) > 0) {
                   .obs <- .gather_obs(Ei)
                   if (!is.null(.obs)) {
                     .at0 <- which(.obs[, 1] == 0)
                     if(length(.at0) > 0){
                       .vs_val <- .obs[.at0[1], 2]
                     } else {
                       .idx <- which.min(.obs[, 1])
                       min.val <- .obs[.idx, 1]
                       .have_min_vs <- TRUE
                     }
                   }
                 }
                 if (!is.null(.vs_val)) {
                   vals <- rbind(c(0, .vs_val), vals)
                 } else {
                   Ei <- .edges_to_v[[Vs]]
                   .vs_val2 <- NULL
                   if (length(Ei) > 0) {
                     .obs <- .gather_obs(Ei)
                     if (!is.null(.obs)) {
                       .at1 <- which(.obs[, 1] == 1)
                       if(length(.at1) > 0){
                         .vs_val2 <- .obs[.at1[1], 2]
                       } else {
                         .idx_max <- which.max(.obs[, 1])
                         max.val <- .obs[.idx_max, 1]
                         if(!.have_min_vs){
                           .vs_val2 <- .obs[.idx_max, 2]
                         } else if (length(.idx_max) == 0){
                           .vs_val2 <- min.val
                         } else{
                           .vs_val2 <- ifelse(1-max.val < min.val, .obs[.idx_max, 2], min.val)
                         }
                       }
                     } else if (.have_min_vs) {
                       .vs_val2 <- min.val
                     } else if (!is.null(vals) && NROW(vals) > 0) {
                       .vs_val2 <- vals[1, 2]
                     }
                   } else if (.have_min_vs) {
                     .vs_val2 <- min.val
                   } else if (!is.null(vals) && NROW(vals) > 0) {
                     .vs_val2 <- vals[1, 2]
                   }
                   if (!is.null(.vs_val2)){
                     vals <- rbind(c(0, .vs_val2), vals)
                   }
                 }
                 if(!is.null(vals) && NCOL(vals)<2){
                   vals <- NULL
                 }
               }
             }
           } else if(interpolate_plot){

             PtE_tmp <- PtE_edges[[i]]
             PtE_new <- PtE_tmp[is.na(match(PtE_tmp, vals[,1]))]
             if(length(PtE_new) > 0){
               n_old <- NROW(vals)
               combined <- matrix(NA_real_, nrow = n_old + length(PtE_new), ncol = 2)
               combined[seq_len(n_old), ] <- as.matrix(vals[, 1:2])
               combined[n_old + seq_along(PtE_new), 1] <- PtE_new
               vals <- combined[order(combined[,1]), , drop = FALSE]
             } else {
               vals <- as.matrix(vals[, 1:2])
               vals <- vals[order(vals[,1]), , drop = FALSE]
             }

             if(nrow(vals) > 0) {
               # Add boundary points if needed
               if(vals[1,1] > 0) {
                 vals <- rbind(c(0,NA), vals)
               }
               if(vals[nrow(vals),1] < 1) {
                 vals <- rbind(vals, c(1,NA))
               }

               # Only proceed with interpolation if there are any non-NA values
               .ok <- !is.na(vals[,1]) & !is.na(vals[,2])
               if(any(.ok)) {
                 max_val <- max(vals[,2], na.rm = TRUE)
                 min_val <- min(vals[,2], na.rm = TRUE)

                 if(length(unique(vals[.ok, 1])) >= 2L) {
                   ap <- stats::approx(x = vals[.ok, 1], y = vals[.ok, 2],
                                       xout = vals[,1], rule = 1, ties = mean)
                   vals[,2] <- na.const(pmax(pmin(ap$y, max_val), min_val))
                 } else {
                   vals[,2] <- na.const(vals[,2])
                 }
               }
               # Keep only values in [0,1] range
               vals <- vals[(vals[,1] >= 0) & (vals[,1] <= 1), , drop = FALSE]
             }

           }
         }

         if(!is.null(vals) && NROW(vals) > 0){
           coords <- interpolate2(.edges_loc[[i]],
                                  pos = vals[, 1, drop = TRUE],
                                  normalized = TRUE)

           .out[[kk]] <- list(x = coords[, 1],
                              y = coords[, 2],
                              z = vals[, 2, drop = TRUE],
                              i = kk,
                              n = length(coords[, 1]))
           kk = kk+1L
         }



       }

       # single-shot assembly of the final data.frame
       .out <- .out[seq_len(kk - 1L)]
       if (length(.out) == 0L) {
         data <- data.frame(x = numeric(0), y = numeric(0),
                            i = integer(0), z = numeric(0))
       } else {
         .lens <- vapply(.out, `[[`, integer(1), "n")
         data <- data.frame(
           x = unlist(lapply(.out, `[[`, "x"), use.names = FALSE),
           y = unlist(lapply(.out, `[[`, "y"), use.names = FALSE),
           i = rep.int(vapply(.out, `[[`, integer(1), "i"), .lens),
           z = unlist(lapply(.out, `[[`, "z"), use.names = FALSE)
         )
       }

       if(type == "plotly"){
         requireNamespace("plotly")
         if(is.null(p)){
           p <- self$plot(type = "plotly",
                          vertex_color = vertex_color,
                          vertex_size = vertex_size,
                          edge_width = edge_width,
                          edge_color = edge_color)
         }
         p <- plotly::add_trace(p, data = data, x = ~y, y = ~x, z = ~z,
                                mode = "lines", type = "scatter3d",
                                line = list(width = line_width,
                                            color = line_color),
                                split = ~i, showlegend = FALSE, ...)
         if(support_width > 0) {
           data.mesh <- data.frame(x = c(data$x, data$x), y = c(data$y, data$y),
                                   z = c(rep(0, nrow(data)), data$z),
                                   i = rep(seq_len(nrow(data)), 2))
           p <- plotly::add_trace(p, data = data.mesh, x = ~y, y = ~x, z = ~z,
                                  mode = "lines", type = "scatter3d",
                                  line = list(width = support_width,
                                              color = support_color),
                                  split = ~i, showlegend = FALSE)
         }

         p <-  plotly::layout(p, scene = list(xaxis = list(autorange = "reversed")))

         if(!is.null(private$vertex_unit)){
           if(private$vertex_unit == "degree" && !private$transform){
             p <- plotly::layout(p, scene = list(xaxis = list(title = "Longitude"),
                                                 yaxis = list(title = "Latitude")))
           } else{
             p <- plotly::layout(p, scene = list(xaxis = list(title = paste0("x (in ",
                                                                             private$vertex_unit, ")")),
                                                 yaxis = list(title = paste0("y (in ",
                                                                             private$vertex_unit, ")"))))
           }
         }

       } else if (type == "ggplot"){
         if(is.null(p)) {
           p <- ggplot(data = data) +
             geom_path( mapping = aes(x = x, y = y,
                                      group = i,
                                      colour = z),
                        linewidth = line_width) + labs(colour = "") + scale_color
         } else {
           p <- p + geom_path(data = data, mapping =
                                aes(x = x, y = y,
                                    group = i, colour = z),
                              linewidth = line_width) + labs(colour = "") + scale_color
         }
         p <- self$plot(edge_width = 0, vertex_size = vertex_size,
                        vertex_color = vertex_color, p = p)
         if(!is.null(private$vertex_unit)){
           if(private$vertex_unit == "degree" && !private$transform){
             p <- p + labs(x = "Longitude",  y = "Latitude")
           } else{
             p <- p + labs(x = paste0("x (in ",private$vertex_unit, ")"),
                           y = paste0("y (in ",private$vertex_unit, ")"))
           }
         }
       } else if(type == "mapview"){
         requireNamespace("mapview")
         data <- na.omit(data[, c("x", "y", "z", "i")])
         data_split <- split(data, data$i)

         linestrings <- do.call(c, lapply(data_split, function(group_data) {
           if (nrow(group_data) < 2) {
             return(NULL)
           }
           lapply(1:(nrow(group_data) - 1), function(j) {
             sf::st_linestring(as.matrix(group_data[j:(j + 1), c("x", "y")]))
           })
         }))

         data_segment <- do.call(rbind, lapply(data_split, function(group_data) {
           data.frame(
             z = group_data$z[-nrow(group_data)],
             i = group_data$i[-nrow(group_data)]
           )
         }))

         data_sf <- sf::st_as_sf(
           data_segment,
           geometry = sf::st_sfc(linestrings),
           crs = if (!is.null(private$crs)) private$crs else sf::NA_crs_
         )

         edges_sf <- self$get_edges(format = "sf")

         if(is.null(p)){
           mapview_output <- mapview::mapview(
             x = edges_sf,
             lwd = edge_width,
             color = edge_color,
             layer.name = "Edges",
             ...
           )
         } else{
           mapview_output <- mapview::mapview(
             x = edges_sf,
             lwd = 1.75 * edge_width,
             color = edge_color,
             layer.name = "Edges",
             ...
           )
         }
         edge_width <- 2.5 * edge_width
         mapview_output <- mapview_output + mapview::mapview(
           x = data_sf,
           zcol = "z",
           color = scale_color_mapview,
           lwd = edge_width,
           cex = vertex_size,
           col.regions = scale_color_mapview,
           layer.name = mapview_caption
         )


         return(mapview_output)
       }
       return(p)
     },


     #' @description Plots a movie of a continuous function evolving on the graph.
     #' @param X A m x T matrix where the ith column represents the function at the
     #' ith time, evaluated at the mesh locations.
     #' @param type Type of plot. Either `"plotly"` or `"ggplot"`.
     #' @param vertex_size Size of the vertices.
     #' @param vertex_color Color of vertices.
     #' @param edge_width Width for edges.
     #' @param edge_color For 3D plot, color of edges.
     #' @param line_width For 3D plot, line width of the function curve.
     #' @param line_color Color of the function curve.
     #' @param ... Additional arguments for ggplot or plot_ly.
     #' @return Either a `ggplot` (if `plotly=FALSE`) or a `plot_ly` object.
     plot_movie = function(X,
                           type = "plotly",
                           vertex_size = 5,
                           vertex_color = "black",
                           edge_width = 1,
                           edge_color = 'black',
                           line_width = NULL,
                           line_color = 'rgb(0,0,200)',
                           ...){
       if (is.null(line_width)) {
         line_width = edge_width
       }

       if (type == "plotly") {
         requireNamespace("plotly")
         plotly <- TRUE
       } else if (type == "ggplot") {
         requireNamespace("ggplot2")
         plotly <- FALSE
       }

       if (is.null(self$mesh)) {
         stop("X is a vector but no mesh provided")
       }

       if (is.null(self$mesh$PtE)) {
         PtE_dim <- 0
       } else {
         PtE_dim <- dim(self$mesh$PtE)[1]
       }

       if (length(X) == PtE_dim) {
         X <- c(rep(NA, dim(self$V)[1]), X)
       }

       if (dim(X)[1] != dim(unique(self$mesh$V))[1]) {
         stop(paste0("X does not have the correct size (the possible sizes are ",
                     PtE_dim, " and ", dim(unique(self$mesh$V))[1],")"))
       }

       n.v <- dim(self$V)[1]
       XV <- X[1:n.v,]

       .nE_loc    <- self$nE
       .Efrom_loc <- self$E[, 1]
       .Eto_loc   <- self$E[, 2]
       .edges_loc <- self$edges
       .mesh_PtE  <- self$mesh$PtE
       .mesh_idx_by_edge <- vector("list", .nE_loc)
       if (!is.null(.mesh_PtE)) {
         .ms <- split(seq_len(nrow(.mesh_PtE)), .mesh_PtE[, 1])
         for (.nm in names(.ms)) {
           .ei <- as.integer(.nm)
           if (.ei >= 1L && .ei <= .nE_loc) .mesh_idx_by_edge[[.ei]] <- .ms[[.nm]]
         }
       }

       .out <- vector("list", .nE_loc)
       kk = 1L
       frames <- dim(X)[2]
       for (i in 1:self$nE) {
         Vs <- .Efrom_loc[i]
         Ve <- .Eto_loc[i]

         ind_rows <- .mesh_idx_by_edge[[i]]
         if (is.null(ind_rows)) ind_rows <- integer(0)

         if (length(ind_rows) == 0L) {
           vals <- rbind(c(0, XV[Vs,]),
                         c(1, XV[Ve,]))

         } else {
           vals <- rbind(c(0, XV[Vs,]),
                         cbind(.mesh_PtE[ind_rows, 2], X[n.v + ind_rows,]),
                         c(1, XV[Ve,]))

         }

         data.to.plot <- vals
         data.to.plot.order <- data.to.plot[order(data.to.plot[, 1]), ,
                                            drop = FALSE]


         coords <- interpolate2(.edges_loc[[i]],
                                pos = data.to.plot.order[, 1, drop = TRUE],
                                normalized = TRUE)
         .nc <- length(coords[, 1])
         .out[[kk]] <- list(x = rep(coords[, 1], frames),
                            y = rep(coords[, 2], frames),
                            z = c(data.to.plot.order[, 2:(frames + 1)]),
                            i = rep(rep(kk, .nc), frames),
                            f = rep(seq_len(frames), each = .nc),
                            n = .nc * frames)
         kk = kk + 1L
       }
       .out <- .out[seq_len(kk - 1L)]
       if (length(.out) == 0L) {
         data <- data.frame(x = numeric(0), y = numeric(0), z = numeric(0),
                            i = integer(0), f = integer(0))
       } else {
         data <- data.frame(
           x = unlist(lapply(.out, `[[`, "x"), use.names = FALSE),
           y = unlist(lapply(.out, `[[`, "y"), use.names = FALSE),
           z = unlist(lapply(.out, `[[`, "z"), use.names = FALSE),
           i = unlist(lapply(.out, `[[`, "i"), use.names = FALSE),
           f = unlist(lapply(.out, `[[`, "f"), use.names = FALSE)
         )
       }

       if(plotly){
         requireNamespace("plotly")
         ## OPT: preallocate + cache; avoids growing x/y/ei with c() each iter
         .xs <- vector("list", .nE_loc)
         .ys <- vector("list", .nE_loc)
         .es <- vector("list", .nE_loc)
         for (i in seq_len(.nE_loc)) {
           .ei <- .edges_loc[[i]]
           .xs[[i]] <- .ei[, 1]
           .ys[[i]] <- .ei[, 2]
           .es[[i]] <- rep.int(i, nrow(.ei))
         }
         x  <- unlist(.xs, use.names = FALSE)
         y  <- unlist(.ys, use.names = FALSE)
         ei <- unlist(.es, use.names = FALSE)
         frames <- dim(X)[2]
         data.graph <- data.frame(x = rep(x, frames),
                                  y = rep(y, frames),
                                  z = rep(rep(0,length(x)), frames),
                                  i = rep(ei, frames),
                                  f = rep(1:frames, each = length(x)))

         p <- plotly::plot_ly(data=data.graph, x = ~y, y = ~x, z = ~z,frame = ~f)
         p <- plotly::add_trace(p, data = data.graph, x = ~y, y = ~x, z = ~z,
                                frame = ~f,
                                mode = "lines", type = "scatter3d",
                                line = list(width = line_width,
                                            color = edge_color),
                                split = ~i, showlegend = FALSE)

         p <- plotly::add_trace(p, data = data, x = ~y, y = ~x, z = ~z,
                                frame = ~f,
                                mode = "lines", type = "scatter3d",
                                line = list(width = line_width,
                                            color = line_color),
                                split = ~i, showlegend = FALSE, ...)

         if(!is.null(private$vertex_unit)){
           if(private$vertex_unit == "degree" && !private$transform){
             p <- plotly::layout(p, scene = list(xaxis = list(title = "Longitude"),
                                                 yaxis = list(title = "Latitude")))
           } else{
             p <- plotly::layout(p, scene = list(xaxis = list(title = paste0("x (in ",
                                                                             private$vertex_unit, ")")),
                                                 yaxis = list(title = paste0("y (in ",
                                                                             private$vertex_unit, ")"))))
           }
         }

       } else {
         stop("not implemented")
       }
       return(p)
     },

     #' @description Add observations on mesh to the object.
     #' @param data A `data.frame` or named list containing the observations.
     #' In case of groups, the data.frames for the groups should be stacked vertically,
     #' with a column indicating the index of the group. If `data_frame` is not
     #' `NULL`, it takes priority over any eventual data in `Spoints`.
     #' @param group If the data_frame contains groups, one must provide the column
     #' in which the group indices are stored.
     #' @return No return value. Called for its side effects. The observations are
     #' stored in the `data` element in the `metric_graph` object.
     add_mesh_observations = function(data = NULL, group = NULL) {

       if(is.null(self$mesh)){
         stop("You should have a mesh!")
       }
       PtE_mesh <- self$mesh$PtE
       data[[".edge_number"]] <- PtE_mesh[,1]
       data[[".distance_on_edge"]] <- PtE_mesh[,2]
       self$add_observations(data = data, group = group,
                             edge_number = ".edge_number",
                             distance_on_edge = ".distance_on_edge",
                             normalized = TRUE)
     },

     #' @description Returns a copy of the initial metric graph.
     #' @return A `metric_graph` object.
     get_initial_graph = function() {
       tmp_graph <- private$initial_graph$clone()
       if(private$pruned){
         tmp_graph$prune_vertices()
       }
       return(tmp_graph)
     },

     #' @description Update an older version metric graph to the current package version.
     #' @details This function creates a new metric_graph object from an existing one,
     #' preserving all data, edge weights, mesh, distances, and other components while
     #' ensuring compatibility with the current package version. The new graph is created
     #' with minimal changes by disabling merges and other transformations.
     #' @param verbose Print progress messages. Default is TRUE.
     #' @return A new `metric_graph` object compatible with the current package version.
     update_graph = function(verbose = TRUE) {

       if (verbose) {
         message("Updating metric graph to current package version...")
       }

       # Extract all components from the current graph
       old_V <- self$V
       old_E <- self$E
       old_edges <- self$edges
       old_edge_lengths <- self$edge_lengths

       # Extract edge weights if they exist
       old_edge_weights <- NULL
       if (!is.null(private$edge_weights)) {
         old_edge_weights <- self$get_edge_weights(data.frame = TRUE)
       }

       # Extract data if it exists
       old_data <- NULL
       if (!is.null(private$data)) {
         old_data <- self$get_data(format = "list")
       }

       # Extract other private components
       old_longlat <- private$longlat
       old_crs <- private$crs
       old_proj4string <- private$proj4string
       old_length_unit <- private$length_unit
       old_vertex_unit <- private$vertex_unit
       old_which_longlat <- private$which_longlat

       # Extract directional weight functions if they exist
       old_dir_weights_in <- self$DirectionalWeightFunction_in
       old_dir_weights_out <- self$DirectionalWeightFunction_out

       if (verbose) {
         message("Creating new graph with minimal changes...")
       }

       # Create new graph with settings that minimize changes
       new_graph <- metric_graph$new(
         V = old_V,
         E = old_E,
         edge_weights = old_edge_weights,
         longlat = old_longlat,
         crs = old_crs,
         proj4string = old_proj4string,
         vertex_unit = old_vertex_unit,
         length_unit = old_length_unit,
         which_longlat = old_which_longlat,
         # Critical settings to minimize changes
         perform_merges = FALSE,           # No merges
         remove_circles = FALSE,           # Don't remove circles
         remove_deg2 = FALSE,             # Don't remove degree-2 vertices
         merge_close_vertices = FALSE,     # Don't merge close vertices
         check_connected = FALSE,          # Skip connectivity check
         auto_remove_point_edges = FALSE,  # Don't remove point edges
         tolerance = list(vertex_vertex = 0, vertex_edge = 0, edge_edge = 0), # Zero tolerances
         verbose = if (verbose) 1 else 0
       )

       # Manually set edges and edge_lengths to preserve exact structure
       if (!is.null(old_edges)) {
         new_graph$edges <- old_edges
       }
       if (!is.null(old_edge_lengths)) {
         new_graph$edge_lengths <- old_edge_lengths
       }

       # Set directional weight functions if they existed
       if (!is.null(old_dir_weights_in)) {
         new_graph$DirectionalWeightFunction_in <- old_dir_weights_in
       }
       if (!is.null(old_dir_weights_out)) {
         new_graph$DirectionalWeightFunction_out <- old_dir_weights_out
       }

       # Add data if it existed
       if (!is.null(old_data)) {
         if (verbose) {
           message("Adding observation data...")
         }
         tryCatch({
           internal_cols <- c(".edge_number", ".distance_on_edge")
           old_data[internal_cols] <- NULL
           if(inherits(old_data, "metric_graph_data")){
             class(old_data) <- setdiff(class(old_data), "metric_graph_data")
           }

           # Convert to sf object if CRS is available
           if(!is.null(old_crs) && all(c(".coord_x", ".coord_y") %in% names(old_data))) {
             old_data_df <- as.data.frame(old_data)
             old_data <- sf::st_as_sf(
               old_data_df,
               coords = c(".coord_x", ".coord_y"),
               crs = old_crs
             )
           }

           # Add observations
           new_graph$add_observations(
             data = old_data,
             coord_x = ".coord_x",
             coord_y = ".coord_y",
             data_coords = "spatial",
             group = ".group",
             verbose = if (verbose) 1 else 0
           )
         }, error = function(e) {
           if (verbose) message("Could not restore observation data: ", e$message)
         })
       }

       # Restore computed components if they existed
       if (verbose) {
         message("Restoring computed components...")
       }

       # Restore mesh if it existed
       if (!is.null(self$mesh)) {
         if (verbose) {
           message("Restoring mesh...")
         }
         new_graph$mesh <- self$mesh
       }

       # Restore geodesic distances if they existed
       if (!is.null(self$geo_dist)) {
         if (verbose) {
           message("Restoring geodesic distances...")
         }
         new_graph$geo_dist <- self$geo_dist
       }

       # Restore resistance distances if they existed
       if (!is.null(self$res_dist)) {
         if (verbose) {
           message("Restoring resistance distances...")
         }
         new_graph$res_dist <- self$res_dist
       }

       # Restore Laplacian if it existed
       if (!is.null(self$Laplacian)) {
         if (verbose) {
           message("Restoring Laplacian matrix...")
         }
         new_graph$Laplacian <- self$Laplacian
       }

       # Restore constraint matrix and CoB if they existed
       if (!is.null(self$C)) {
         new_graph$C <- self$C
       }
       if (!is.null(self$CoB)) {
         new_graph$CoB <- self$CoB
       }

       # Restore PtV if it existed
       if (!is.null(self$PtV)) {
         new_graph$PtV <- self$PtV
       }

       # Restore characteristics if they existed
       if (!is.null(self$characteristics)) {
         new_graph$characteristics <- self$characteristics
       }

       # Restore vertices with attributes if they existed
       if (!is.null(self$vertices)) {
         new_graph$vertices <- self$vertices
       }

       if (verbose) {
         message("Graph update completed successfully!")
         message(sprintf("New graph: %d vertices, %d edges", new_graph$nV, new_graph$nE))
         if (!is.null(old_data)) {
           message(sprintf("Total observations: %d", length(old_data[[".group"]])))
         }
       }

       return(new_graph)
     },

     #' @description Convert between locations on the graph and Euclidean
     #' coordinates.
     #' @param PtE Matrix with locations on the graph (edge number and normalized
     #' position on the edge).
     #' @param XY Matrix with locations in Euclidean space
     #' @param normalized If `TRUE`, it is assumed that the positions in `PtE` are
     #' normalized to (0,1), and the object returned if `XY` is specified contains
     #' normalized locations.
     #' @return If `PtE` is specified, then a matrix with Euclidean coordinates of
     #' the locations is returned. If `XY` is provided, then a matrix with the
     #' closest locations on the graph is returned.
     coordinates = function(PtE = NULL, XY = NULL, normalized = TRUE) {
       if(is.null(PtE) && is.null(XY)) {
         stop("PtE or XY must be provided")
       } else if(!is.null(PtE) && !is.null(XY)) {
         stop("Either PtE or XY must be provided, not both")
       }
       x <- y <- NULL
       if (!is.null(PtE)) {
         if(is.vector(PtE)) {
           if(length(PtE) != 2)
             stop("PtE is a vector but does not have length 2")

           PtE <- matrix(PtE,1,2)
         }
         if(ncol(PtE)!= 2){
           stop("PtE must have two columns!")
         }

         if (min(PtE[,2]) < 0) {
           stop("PtE[, 2] has negative values")
         }
         if ((max(PtE[,2]) > 1) && normalized) {
           stop("For normalized distances, the values in PtE[, 2] should not be
larger than 1")
         }
         if(max(PtE[,2] - self$edge_lengths[PtE[, 1]]) > 0 && !normalized) {
           stop("PtE[, 2] contains values which are larger than the edge lengths")
         }

         if(!normalized) {
           PtE <- cbind(PtE[, 1], PtE[, 2] / self$edge_lengths[PtE[, 1]])
         }

         Points <- matrix(NA_real_, nrow=nrow(PtE), ncol=2L)

         # Batch observations by edge: split indices once, then one C++ call per edge
         edge_ids <- PtE[, 1]
         idx_by_edge <- split(seq_len(nrow(PtE)), edge_ids)
         for (nm in names(idx_by_edge)) {
           idx <- idx_by_edge[[nm]]
           e <- as.integer(nm)
           pts <- interpolate2(self$edges[[e]],
                               pos = PtE[idx, 2], normalized = TRUE)
           Points[idx, ] <- pts
         }
         return(Points)
       } else {
         SP <- snapPointsToLines(XY, self$edges, longlat = private$longlat, crs = private$crs)
         # coords.old <- XY
         # colnames(coords.old) <- paste(colnames(coords.old), '_old', sep="")
         XY = t(SP[["coords"]])
         PtE <- cbind(match(SP[["df"]][["nearest_line_index"]], 1:length(self$edges)), 0)

         for (ind in unique(PtE[, 1])) {
           index.p <- PtE[, 1] == ind
           PtE[index.p,2]=projectVecLine2(self$edges[[ind]], XY[index.p, , drop=FALSE],
                                          normalized=TRUE)

         }

         if (!normalized) {
           PtE <- cbind(PtE[, 1], PtE[, 2] * self$edge_lengths[PtE[, 1]])
         }
         return(PtE)
       }
     }
   ),

   private = list(
     # Compute and cache the connected-component decomposition. Called once
     # at the end of `initialize()` (and after the `.assemble` shortcut),
     # then never recomputed: edges/vertices don't change after
     # construction, so `nC` and `component_membership` are stable for the
     # lifetime of the object. The lazy `components_cache` (per-component
     # `metric_graph` objects, with current observations routed in) is
     # populated on the first `get_components()` call and invalidated on
     # `add_observations()` / `clear_observations()`.
     compute_component_membership = function() {
       if (is.null(self$E) || nrow(self$E) == 0L) {
         private$component_membership <- integer(0)
         private$nC <- 0L
         return(invisible(NULL))
       }
       g_ig <- igraph::make_graph(edges = c(t(self$E)), directed = FALSE)
       comps <- igraph::components(g_ig, mode = "weak")
       membership_in <- as.integer(comps$membership)
       n_comp <- comps$no
       if (n_comp <= 1L) {
         private$component_membership <- rep(1L, self$nV)
         private$nC <- 1L
         return(invisible(NULL))
       }
       # Sort components by total edge length, descending. Component 1 is
       # the largest. Update `membership_in` to use the new ordering.
       totals <- vapply(seq_len(n_comp), function(k) {
         e_in_k <- which(membership_in[self$E[, 1]] == k)
         sum(as.numeric(self$edge_lengths[e_in_k]))
       }, numeric(1))
       new_order <- order(totals, decreasing = TRUE)
       remap <- integer(n_comp)
       remap[new_order] <- seq_len(n_comp)
       private$component_membership <- remap[membership_in]
       private$nC <- n_comp
       invisible(NULL)
     },

     #function for creating Vertex and Edges from self$edges
     line_to_vertex = function(tolerance = 0, longlat = FALSE, fact, verbose, crs,
                               proj4string, which_longlat, length_unit, vertex_unit,
                               project, which_projection, project_data) {

       # Step 0: Optional projection of all edge coordinates (unchanged)
       if(project_data && longlat){
         if(verbose == 2) {
           message("Projecting edges")
           bar_edges_proj <- msg_progress_bar(length(self$edges))
         }
         private$vertex_unit <- length_unit
         if(which_longlat == "sf"){
           if(which_projection == "Robinson"){
             str_proj <- "+proj=robin +datum=WGS84 +no_defs +over"
           } else if (which_projection == "Winkel tripel") {
             str_proj <- "+proj=wintri +datum=WGS84 +no_defs +over"
           } else{
             str_proj <- which_projection
           }
           fact <- process_factor_unit("m", length_unit)
           for(i in 1:length(self$edges)){
             if(verbose == 2) {
               bar_edges_proj$increment()
             }
             sf_points <- sf::st_as_sf(as.data.frame(self$edges[[i]]),
                                       coords = 1:2, crs = crs)
             sf_points_eucl <- sf::st_transform(sf_points, crs=sf::st_crs(str_proj))
             self$edges[[i]] <- sf::st_coordinates(sf_points_eucl) * fact
           }
         } else{
           if(which_projection == "Robinson"){
             str_proj <- "+proj=robin +datum=WGS84 +no_defs +over"
           } else if (which_projection == "Winkel tripel") {
             str_proj <- "+proj=wintri +datum=WGS84 +no_defs +over"
           } else{
             str_proj <- which_projection
           }
           fact <- process_factor_unit("km", length_unit)
           for(i in 1:length(self$edges)){
             if(verbose == 2) {
               bar_edges_proj$increment()
             }
             sp_points <- sp::SpatialPoints(coords = self$edges[[i]],
                                            proj4string = proj4string)
             sp_points_eucl <- sp::spTransform(sp_points,CRSobj=sp::CRS(str_proj))
             self$edges[[i]] <- sp::coordinates(sp_points_eucl) * fact
           }
         }
         private$longlat <- FALSE
         private$crs <- NULL
         private$proj4string <- NULL
         # local vars must reflect the new state
         longlat     <- FALSE
         crs         <- NULL
         proj4string <- NULL
       }


       nE <- length(self$edges)
       if (nE == 0) {
         self$V <- matrix(0, 0, 2)
         self$E <- matrix(0L, 0, 2)
         self$edge_lengths <- numeric(0)
         self$nV <- 0
         self$nE <- 0
         return(invisible(NULL))
       }

       if(verbose == 2) {
         message("Part 1/2 (vectorized)")
       }

       edges_local <- self$edges

       # Step 1: collect first/last point of every edge
       endpoints <- matrix(NA_real_, nrow = 2L * nE, ncol = 2L)
       for (i in seq_len(nE)) {
         pts <- edges_local[[i]]
         np <- nrow(pts)
         endpoints[2L*i - 1L, ] <- pts[1L, ]
         endpoints[2L*i,      ] <- pts[np, ]
       }

       # Step 2: build "working" Euclidean coords for the kd-tree
       # work_coords are scaled so that Euclidean distance is in `length_unit`,
       # which is the same unit as `tolerance`.
       #
       # For the longlat case we project the endpoints to a LOCAL azimuthal
       # equidistant CRS centered on the bbox of the endpoints. AEQD is accurate
       # to better than ~5cm absolute (and ~3e-3 relative) for the pairwise
       # distances at the tolerance scale -- which is what the kd-tree actually
       # uses. self$V, self$crs, etc. are NOT touched, and the user's
       # `project` / `which_projection` arguments only affect the legacy
       # `project_data = TRUE` path that physically rewrites the edge coords.
       #
       # previously this used sp::spTransform / sf::st_transform
       # via a full PROJ round-trip, which costs ~1 second for 40k points and
       # was the dominant lon/lat hot spot. We now compute the AEQD forward
       # formula directly via aeqd_project_cpp -- a closed-form trig
       # calculation that's ~460x faster and produces the same result to <6cm
       # in the worst case for nearby pairs. This is "scratch work" for the
       # kd-tree only, so the choice between WGS84 ellipsoidal and spherical
       # AEQD does not affect any user-visible coordinate.
       if (longlat && !project_data) {
         bb_x <- 0.5 * (min(endpoints[, 1]) + max(endpoints[, 1]))
         bb_y <- 0.5 * (min(endpoints[, 2]) + max(endpoints[, 2]))
         work_coords <- aeqd_project_cpp(endpoints, bb_x, bb_y)
         # AEQD output is metres; rescale to length_unit so it matches tolerance.
         fact_work <- process_factor_unit("m", length_unit)
         work_coords <- work_coords * fact_work
       } else {
         fact_work  <- process_factor_unit(vertex_unit, length_unit)
         work_coords <- endpoints * fact_work
       }

       # Step 3: cluster endpoints within `tolerance`
       n_pts <- nrow(work_coords)

       if (tolerance <= 0) {
         # Exact dedup: identical coordinates only
         keys    <- paste(endpoints[, 1], endpoints[, 2], sep = "\r")
         cluster <- match(keys, keys)
       } else {
         # Replicate the original semantics: drop point i iff some j < i has
         #   d(i, j) <= tolerance, then map every point to its nearest kept one.
         k_search <- as.integer(min(20L, n_pts))

         nn <- nn2(work_coords, work_coords,
                   k = k_search,
                   searchtype = "radius",
                   radius = tolerance)

         nn_idx  <- nn$nn.idx
         nn_dist <- nn$nn.dists
         row_idx <- .row(dim(nn_idx))

         # Treat self-matches and missing matches as "no neighbor".
         not_self_or_missing <- nn_idx > 0L & nn_idx != row_idx

         # For each row find the smallest index j != i within the radius.
         cand_earlier <- nn_idx
         cand_earlier[!not_self_or_missing | cand_earlier >= row_idx] <- NA_integer_

         has_earlier <- rowSums(!is.na(cand_earlier)) > 0L
         drop_pt     <- has_earlier
         kept_idx    <- which(!drop_pt)

         # Diagnostic: warn if any point may have hit the per-point search cap.
         n_within <- rowSums(not_self_or_missing)
         if (any(n_within >= (k_search - 1L))) {
           warning(
             "line_to_vertex: at least one endpoint had >= ",
             k_search - 1L,
             " other endpoints within tolerance; results should still be correct ",
             "but if this seems excessive consider lowering the tolerance."
           )
         }

         if (length(kept_idx) == n_pts) {
           cluster <- seq_len(n_pts)
         } else {
           # Each (possibly dropped) point goes to its nearest kept point.
           nn_assign <- nn2(work_coords[kept_idx, , drop = FALSE],
                            work_coords, k = 1L)
           cluster <- kept_idx[nn_assign$nn.idx[, 1L]]
         }
       }

       # Build a contiguous 1..nV labelling.
       unique_keep <- unique(cluster)
       remap <- integer(n_pts)
       remap[unique_keep] <- seq_along(unique_keep)
       cluster_id <- remap[cluster]

       # New vertex coordinates in the original (unprojected) coordinate system.
       V_new <- endpoints[unique_keep, , drop = FALSE]

       if(verbose == 2) {
         message(sprintf("Part 1/2 done: %d endpoints -> %d vertices",
                         n_pts, nrow(V_new)))
         message("Part 2/2 (vectorized)")
       }

       # Step 4: snap each edge's first/last point to its cluster vertex
       start_v <- cluster_id[seq.int(1L, n_pts, by = 2L)]
       end_v   <- cluster_id[seq.int(2L, n_pts, by = 2L)]

       for (i in seq_len(nE)) {
         e  <- edges_local[[i]]
         ne <- nrow(e)
         e[1L,  ] <- V_new[start_v[i], ]
         e[ne,  ] <- V_new[end_v[i],   ]
         edges_local[[i]] <- e
       }

       # write the locally-mutated edge list back to self in one shot
       self$edges <- edges_local

       # Step 5: compute all edge lengths in one batch
       edge_ll <- private$compute_lengths(longlat       = longlat,
                                          unit          = length_unit,
                                          crs           = crs,
                                          proj4string   = proj4string,
                                          which_longlat = which_longlat,
                                          vertex_unit   = vertex_unit,
                                          project_data  = project_data,
                                          transform     = private$transform)

       # Step 6: drop edges of length <= tolerance (matches original)
       keep_e <- edge_ll > tolerance
       if (!all(keep_e)) {
         self$edges <- self$edges[keep_e]
         edge_ll    <- edge_ll[keep_e]
         start_v    <- start_v[keep_e]
         end_v      <- end_v[keep_e]
         if (is.vector(private$edge_weights)) {
           private$edge_weights <- private$edge_weights[keep_e]
         } else {
           private$edge_weights <- private$edge_weights[keep_e, , drop = FALSE]
         }
       }

       self$V            <- V_new
       self$E            <- cbind(start_v, end_v)
       dimnames(self$E)  <- NULL
       self$edge_lengths <- edge_ll
       self$nV           <- nrow(self$V)
       self$nE           <- nrow(self$E)
     },

     #Compute PtE for mesh given PtE for graph
     PtE_to_mesh = function(PtE){
       Vertexes <- self$VtEfirst()
       PtE <- as.matrix(PtE)
       Vertexes <- as.matrix(Vertexes)
       self$mesh$PtE <- as.matrix(self$mesh$PtE)
       self$E <- as.matrix(self$E)
       self$mesh$E <- as.matrix(self$mesh$E)
       self$edge_lengths <- as.vector(self$edge_lengths)
       self$mesh$h_e <- as.vector(self$mesh$h_e)
       self$nV <- as.integer(self$nV)

       PtE_update <- PtE_to_mesh_cpp(
         PtE = PtE,
         VtE = Vertexes,
         mesh_PtE = self$mesh$PtE,
         E = self$E,
         mesh_E = self$mesh$E,
         edge_lengths = self$edge_lengths,
         mesh_h_e = self$mesh$h_e,
         nV = self$nV
       )

       return(PtE_update)
     },

     ## Adding column_y argument which tells which column of y to get

     plot_2d = function(line_width = 0.1,
                        marker_size = 1,
                        vertex_color = 'black',
                        edge_color = 'black',
                        data,
                        newdata,
                        data_size = 1,
                        group = 1,
                        mesh = FALSE,
                        X = NULL,
                        X_loc = NULL,
                        p = NULL,
                        degree = FALSE,
                        direction = FALSE,
                        edge_weight = NULL,
                        edge_width_weight = NULL,
                        scale_color_main = ggplot2::scale_color_viridis_c(option = "D"),
                        scale_color_weights = ggplot2::scale_color_viridis_c(option = "A"),
                        scale_color_degree = ggplot2::scale_color_viridis_d(option = "D"),
                        add_new_scale_weights = TRUE,
                        arrow_size,
                        scale_color_main_discrete,
                        scale_color_weights_discrete,
                        ...){
       xyl <- c()

       nc <- do.call(rbind,lapply(self$edges, function(x) dim(x)[1]))
       xyl <- cbind(do.call(rbind,self$edges), rep(1:length(nc), times = nc))
       df_plot <- data.frame(x = xyl[, 1], y = xyl[, 2], grp = xyl[, 3])

       if(!is.null(edge_weight)){
         edge_weight <- edge_weight[[1]]
         e_weights <- private$get_edge_weights_internal(data.frame = TRUE)
         e_weights <- e_weights[,edge_weight, drop = FALSE]
         colnames(e_weights) <- "weights"
         e_weights["grp"] <- 1:self$nE
         df_plot <- merge(df_plot, e_weights)
       } else{
         df_plot[["weights"]] <- rep(edge_color, nrow(df_plot))
       }
       if(!is.null(edge_width_weight)){
         edge_width_weight <- edge_width_weight[[1]]
         e_weights <- private$get_edge_weights_internal(data.frame = TRUE)
         e_weights <- e_weights[,edge_width_weight, drop = FALSE]
         e_weights[,1] <- e_weights[,1] * line_width / max(e_weights[,1])
         e_weights[,1] <- e_weights[,1]
         colnames(e_weights) <- "widths"
         e_weights["grp"] <- 1:self$nE
         df_plot <- merge(df_plot, e_weights)
       } else{
         df_plot[["widths"]] <- rep(line_width, nrow(df_plot))
       }

       if(is.null(p)){
         if(!is.null(edge_weight)){
           if(is.factor(df_plot[["weights"]]) || is.character(df_plot[["weights"]])){
             scale_weights <- scale_color_weights_discrete
           } else{
             scale_weights <- scale_color_weights
           }
           p <- ggplot() + geom_path(data = df_plot,
                                     mapping = aes(x = x, y = y, group = grp,
                                                   colour = weights, linewidth = widths),
                                     ...) + ggplot2::scale_linewidth_identity() + scale_weights + labs(colour = edge_weight)
           if(add_new_scale_weights){
             p <- p + new_scale_color()
           }
         } else{
           p <- ggplot() + geom_path(data = df_plot,
                                     mapping = aes(x = x, y = y, group = grp, linewidth = widths),
                                     color = edge_color,
                                     # linewidth = line_width,
                                     ...) + ggplot2::scale_linewidth_identity()
         }
       } else {
         if(!is.null(edge_weight)){
           if(is.factor(df_plot[["weights"]]) || is.character(df_plot[["weights"]])){
             scale_weights <- scale_color_weights_discrete
           } else{
             scale_weights <- scale_color_weights
           }
           p <- p + geom_path(data = df_plot,
                              mapping = aes(x = x, y = y, group = grp,
                                            colour = weights, linewidth =widths),
                              ...) + ggplot2::scale_linewidth_identity() + scale_weights + labs(colour = edge_weight)
           if(add_new_scale_weights){
             p <- p + new_scale_color()
           }
         } else{
           p <- p + geom_path(data = df_plot,
                              mapping = aes(x = x, y = y, group = grp,
                                            linewidth = widths), color = edge_color, ...) + ggplot2::scale_linewidth_identity()
         }
       }

       if(direction) {
         mid.l <- self$coordinates(PtE = cbind(1:self$nE, rep(0.49,self$nE)))
         mid.u <- self$coordinates(PtE = cbind(1:self$nE, rep(0.5,self$nE)))
         p <- p + geom_path(data = data.frame(x = c(mid.l[,1], mid.u[,1]),
                                              y = c(mid.l[, 2], mid.u[,2]),
                                              edge = c(1:self$nE,1:self$nE)),
                            mapping = aes(x = x, y = y, group = edge),
                            arrow = ggplot2::arrow(length=arrow_size),
                            linewidth = marker_size/2, ...)
       }

       if (marker_size > 0) {
         if(degree) {
           x <- self$V[,1]
           y <- self$V[,2]
           degrees <- self$get_degrees()
           p <- p + geom_point(data = data.frame(x = self$V[, 1],
                                                 y = self$V[, 2],
                                                 degree = degrees),
                               mapping = aes(x, y, colour = factor(degree)),
                               size= marker_size, ...) + scale_color_degree # +
           # scale_color_viridis(discrete = TRUE, guide_legend(title = ""))
         } else if (direction) {
           degrees <- self$get_degrees()
           start.deg <- end.deg <- rep(0,self$nV)
           for(i in 1:self$nV) {
             start.deg[i] <- sum(self$E[,1]==i)
             end.deg[i] <- sum(self$E[,2]==i)
           }
           problematic <- (degrees > 1) & (start.deg == 0 | end.deg == 0)
           p <- p + geom_point(data = data.frame(x = self$V[problematic, 1],
                                                 y = self$V[problematic, 2]),
                               mapping = aes(x, y),
                               colour = "red",
                               size= marker_size, ...)
           p <- p + geom_point(data = data.frame(x = self$V[!problematic, 1],
                                                 y = self$V[!problematic, 2]),
                               mapping = aes(x, y),
                               colour = "green",
                               size= marker_size, ...)

         } else {
           p <- p + geom_point(data = data.frame(x = self$V[, 1],
                                                 y = self$V[, 2]),
                               mapping = aes(x, y),
                               colour = vertex_color,
                               size= marker_size, ...)
         }
       }
       if (!is.null(data)) {
         x <- y <- NULL

         if(!is.null(newdata)){
           data_group <- select_group(newdata, group)
         } else{
           data_group <- select_group(private$data, group)
         }

         if(!(data%in%names(data_group))){
           stop(paste(data,"is not an existing column name of the dataset."))
         }

         y_plot <-data_group[[data]]

         x <- data_group[[".coord_x"]]
         y <- data_group[[".coord_y"]]

         if(is.factor(as.vector(y_plot[!is.na(as.vector(y_plot))])) || is.character(as.vector(y_plot[!is.na(as.vector(y_plot))]))){
           scale_main <- scale_color_main_discrete
         } else{
           scale_main <- scale_color_main
         }

         p <- p + geom_point(data = data.frame(x = x[!is.na(as.vector(y_plot))],
                                               y = y[!is.na(as.vector(y_plot))],
                                               val = as.vector(y_plot[!is.na(as.vector(y_plot))])),
                             mapping = aes(x, y, color = val),
                             size = data_size, ...) + labs(color = data) + scale_main #+
         # scale_colour_gradientn(colours = viridis(100), guide_legend(title = ""))

       }
       if (mesh) {
         p <- p + geom_point(data=data.frame(x = self$mesh$V[, 1],
                                             y = self$mesh$V[, 2]),
                             mapping = aes(x, y), size = marker_size * 0.5,
                             pch = 21,
                             colour = "black",
                             fill = "gray")
       }
       if(!is.null(X)){
         if(is.null(X_loc)){
           stop("X supplied but not X_loc")
         }
         x <- y <- NULL
         if(length(X) != nrow(X_loc)){
           stop("The number of observations does not match the number of observations!")
         }
         points_xy <- self$coordinates(PtE = X_loc)
         x <- points_xy[,1]
         y <- points_xy[,2]
         if(is.factor(as.vector(X)) || is.character(as.vector(X))){
           scale_main <- scale_color_main_discrete
         } else{
           scale_main <- scale_color_main
         }
         p <- p + geom_point(data = data.frame(x = x, y = y,
                                               val = as.vector(X)),
                             mapping = aes(x, y, color = val),
                             size = data_size) + labs(colour = "") + scale_main #+
         # scale_color_viridis()
       }
       p <- p + coord_fixed()
       return(p)
     },

     ## Adding column_y argument which tells which column of y to get

     plot_3d = function(line_width = 1,
                        marker_size = 1,
                        vertex_color = 'rgb(0,0,0)',
                        edge_color = 'rgb(0,0,0)',
                        data,
                        newdata,
                        data_size = 1,
                        group = 1,
                        mesh = FALSE,
                        p = NULL,
                        support_width = 0.5,
                        support_color = "gray",
                        edge_width_weight = NULL,
                        ...){
       x <- y <- ei <- NULL
       for (i in 1:self$nE) {
         xi <- self$edges[[i]][, 1]
         yi <- self$edges[[i]][, 2]
         ii <- rep(i,length(xi))
         x <- c(x, xi)
         y <- c(y, yi)
         ei <- c(ei, ii)
       }
       data.plot <- data.frame(x = x, y = y, z = rep(0,length(x)), i = ei)

       if(!is.null(edge_width_weight)){
         edge_width_weight <- edge_width_weight[[1]]
         e_weights <- private$get_edge_weights_internal(data.frame = TRUE)
         e_weights <- e_weights[,edge_width_weight, drop = FALSE]
         e_weights[,1] <- e_weights[,1] * line_width / max(e_weights[,1])
         e_weights[,1] <- e_weights[,1]
         colnames(e_weights) <- "widths"
         e_weights["i"] <- 1:self$nE
         data.plot <- merge(data.plot, e_weights)
       } else{
         data.plot[["widths"]] <- rep(line_width, nrow(data.plot))
       }

       if(is.null(p)) {
         p <- plotly::plot_ly(data=data.plot, x = ~y, y = ~x, z = ~z,...)
         p <- plotly::add_trace(p, data = data.plot, x = ~y, y = ~x, z = ~z,
                                mode = "lines", type = "scatter3d",
                                line = list(width = ~widths,
                                            color = edge_color),
                                split = ~i, showlegend = FALSE)
       } else {
         p <- plotly::add_trace(p, data = data.plot, x = ~y, y = ~x, z = ~z,
                                mode = "lines", type = "scatter3d",
                                line = list(width = ~widths,
                                            color = edge_color),
                                split = ~i, showlegend = FALSE)
       }


       if(marker_size > 0) {
         data.plot2 <- data.frame(x = self$V[, 1], y = self$V[, 2],
                                  z = rep(0, self$nV))
         p <- plotly::add_trace(p, data = data.plot2, x = ~y, y = ~x, z = ~z,
                                type = "scatter3d", mode = "markers",
                                marker = list(size = marker_size,
                                              color = vertex_color))
       }

       if (!is.null(data)) {
         x <- y <- NULL
         if(!is.null(newdata)){
           data_group <- select_group(newdata, group)
         } else{
           data_group <- select_group(private$data, group)
         }
         y_plot <- data_group[[data]]

         x <- data_group[[".coord_x"]]
         y <- data_group[[".coord_y"]]

         data.plot <- data.frame(x = x[!is.na(as.vector(y_plot))],
                                 y = y[!is.na(as.vector(y_plot))],
                                 z = rep(0,length(x[!is.na(as.vector(y_plot))])),
                                 val = as.vector(y_plot[!is.na(as.vector(y_plot))]),
                                 i =rep(1:length(y_plot), 2))

         p <- plotly::add_trace(p, data = data.plot, x = ~y, y = ~x, z = ~val,
                                type = "scatter3d", mode = "markers",
                                marker = list(size = marker_size,
                                              color = ~val,
                                              colorbar=list(title='', len = 0.5),
                                              colorscale='Viridis'),
                                showlegend=FALSE)
         if(support_width > 0) {
           data.support <- data.frame(x = c(data.plot$x, data.plot$x), y = c(data.plot$y, data.plot$y),
                                      z = c(rep(0, length(data.plot$z)), data.plot$val),
                                      i = rep(1:length(data.plot$val), 2))
           p <- plotly::add_trace(p, data = data.support, x = ~y, y = ~x, z = ~z,
                                  mode = "lines", type = "scatter3d",
                                  line = list(width = support_width,
                                              color = support_color),
                                  split = ~i, showlegend = FALSE)
         }
       }
       if (mesh) {
         data.plot <- data.frame(x = self$mesh$V[, 1],
                                 y = self$mesh$V[, 2],
                                 z = rep(0, dim(self$mesh$V)[1]))
         p <- plotly::add_trace(p, data = data.plot, x = ~y, y = ~x, z = ~z,
                                type = "scatter3d", mode = "markers",
                                marker = list(size = marker_size/2,
                                              color = 'rgb(100,100,100)'),
                                showlegend = FALSE)
       }
       return(p)
     },

     ## Coordinates function to return all the lines intersecting within a tolerance

     coordinates_multiple_snaps = function(XY, tolerance, verbose = verbose,
                                           crs, proj4string, longlat, fact,
                                           which_longlat) {

       coords_line <- c()
       coords_tmp <- c()

       if(!is.null(XY)){
         class(XY) <- setdiff(class(XY), "metric_graph_edge")
       }


       if(!private$longlat){
         lines_sf <- sf::st_sfc(lapply(self$edges, function(i){sf::st_linestring(i)}))
         points_sf <- sf::st_as_sf(as.data.frame(XY), coords = 1:2)
         crs <- NULL
       } else if (private$which_longlat == "sf"){
         points_sf <- sf::st_as_sf(as.data.frame(XY),
                                   coords = 1:2, crs = private$crs)
         lines_sf <- sf::st_sfc(lapply(self$edges,
                                       function(i){sf::st_linestring(i)}),
                                crs = private$crs)
       } else{
         lines_sf <- sf::st_sfc(lapply(self$edges,
                                       function(i){sf::st_linestring(i)}),
                                crs = sf::st_crs(private$proj4string))
         crs <- sf::st_crs(private$proj4string)
         points_sf <- sf::st_as_sf(as.data.frame(XY), coords = 1:2,
                                   crs = private$crs)
       }

       if(verbose == 2) {
         message("Computing auxiliary distances")
       }

       within_dist <- t(as.matrix(sf::st_is_within_distance(points_sf,
                                                            lines_sf,
                                                            dist = tolerance)))

       if(verbose == 2) {
         message("Done!")
       }

       if(verbose == 2) {
         message("Snapping vertices")
         bar_multiple_snaps <- msg_progress_bar(length(self$edges))
       }

       for(i in 1:length(self$edges)){
         if(verbose == 2) {
           bar_multiple_snaps$increment()
         }
         select_points <- matrix(XY[within_dist[i,],], ncol=2)
         if(nrow(select_points) > 0){
           SP <- snapPointsToLines(select_points, self$edges[i], longlat, crs, i)
           idx_tol <- (SP[["df"]][["snap_dist"]] <= tolerance)
           coords_line <- c(coords_line, SP[["df"]][["nearest_line_index"]][idx_tol])
           coords_tmp <- rbind(coords_tmp, (t(SP[["coords"]]))[idx_tol,])
         }
       }

       XY <- coords_tmp

       PtE = cbind(match(coords_line, 1:length(self$edges)), 0)

       for (ind in unique(PtE[, 1])) {
         if(verbose == 2) {
           bar_multiple_snaps$increment()
         }
         index.p <- PtE[, 1] == ind

         PtE[index.p,2] <- projectVecLine2(self$edges[[ind]],
                                           XY[index.p,,drop=FALSE],
                                           normalized=TRUE)
       }
       return(PtE)
     },

     #utility function to merge close vertices
     merge_close_vertices = function(tolerance, fact) {
       if (tolerance <= 0) return(invisible(NULL))
       nv <- self$nV
       if (nv < 2) return(invisible(NULL))

       # instead of building a full nV x nV pairwise
       # distance matrix and running an O(nV * nE) merge loop,
       # do a kd-tree neighbor query and resolve merges with a
       # single batched relabelling pass.

       # 1. working metric coords for nn2
       if (private$longlat) {
         # Closed-form spherical AEQD centered on the bbox of the vertices.
         # This is much faster than
         # sp::spTransform / sf::st_transform and produces identical clustering
         # decisions for any reasonable merge tolerance.
         bb_x <- 0.5 * (min(self$V[, 1]) + max(self$V[, 1]))
         bb_y <- 0.5 * (min(self$V[, 2]) + max(self$V[, 2]))
         work <- aeqd_project_cpp(self$V, bb_x, bb_y)
         fact_work <- process_factor_unit("m", private$length_unit)
         work <- work * fact_work
       } else {
         work <- self$V * fact
       }

       # 2. find merge pairs
       k_search <- as.integer(min(20L, nv))
       nn <- nn2(work, work, k = k_search,
                 searchtype = "radius", radius = tolerance)
       nn_idx  <- nn$nn.idx
       nn_dist <- nn$nn.dists
       row_idx <- .row(dim(nn_idx))

       # Original semantics: each vertex i (in order) merges with its NEAREST
       # earlier vertex if that distance < tolerance.
       valid <- nn_idx > 0L & nn_idx != row_idx & nn_idx < row_idx
       if (!any(valid)) return(invisible(NULL))

       # For each row, pick the nearest valid (j < i) neighbor.
       nn_dist_masked <- nn_dist
       nn_dist_masked[!valid] <- Inf
       best_col <- max.col(-nn_dist_masked, ties.method = "first")
       best_dist <- nn_dist_masked[cbind(seq_len(nv), best_col)]
       has_pair  <- is.finite(best_dist)
       if (!any(has_pair)) return(invisible(NULL))

       i_vec <- which(has_pair)
       j_vec <- nn_idx[cbind(i_vec, best_col[i_vec])]

       # 3. union-find to compute final cluster labels
       parent <- seq_len(nv)
       find_root <- function(x) {
         while (parent[x] != x) {
           parent[x] <- parent[parent[x]]
           x <- parent[x]
         }
         x
       }
       for (m in seq_along(i_vec)) {
         ra <- find_root(i_vec[m])
         rb <- find_root(j_vec[m])
         if (ra != rb) parent[max(ra, rb)] <- min(ra, rb)
       }
       roots <- vapply(seq_len(nv), find_root, integer(1))

       unique_roots <- sort(unique(roots))
       new_id <- integer(nv)
       new_id[unique_roots] <- seq_along(unique_roots)
       cluster_id <- new_id[roots]

       if (length(unique_roots) == nv) return(invisible(NULL))  # nothing changed

       # 4. apply relabelling in a single vectorized pass
       new_V <- self$V[unique_roots, , drop = FALSE]
       new_E <- self$E
       new_E[, 1] <- cluster_id[new_E[, 1]]
       new_E[, 2] <- cluster_id[new_E[, 2]]

       # Update each edge's first / last point to the new vertex coordinates.
       # Pull self$edges into a local first to avoid R6 active-binding overhead
       if (length(self$edges) > 0L) {
         edges_local <- self$edges
         for (e in seq_along(edges_local)) {
           ed <- edges_local[[e]]
           ne <- nrow(ed)
           ed[1L, ] <- new_V[new_E[e, 1L], ]
           ed[ne, ] <- new_V[new_E[e, 2L], ]
           edges_local[[e]] <- ed
         }
         self$edges <- edges_local
       }

       self$V  <- new_V
       self$E  <- new_E
       self$nV <- nrow(new_V)

       invisible(NULL)
     },

     # utility function to remove small circles
     remove_circles = function(threshold, verbose,longlat, unit, crs,
                               proj4string, which_longlat, vertex_unit,
                               project_data) {
       if(verbose == 2) {
         message("Removing small circles")
       }

       if(is.null(private$degrees)){
         degrees <- private$compute_degrees(verbose=verbose)$degrees
       } else{
         degrees <- private$degrees$degrees
       }

       if(threshold > 0) {
         loop.ind <- which(self$E[,1] == self$E[,2])
         if(length(loop.ind)>0) {
           loop.size <- self$edge_lengths[loop.ind]
           ind <- loop.ind[loop.size < threshold]
           if(length(ind)>0) {
             v.loop <- self$E[ind,1]
             v.degrees <- degrees[v.loop]

             ind.rem <- v.loop[v.degrees == 2]
             ind.keep <- v.loop[v.degrees > 2]

             if(length(ind.rem)>0) {
               self$V <- self$V[-ind.rem,]
               self$nV <- self$nV - length(ind.rem)
               i.sort <- sort(ind.rem, decreasing = TRUE)
               for(i in i.sort) {
                 self$E[self$E >= i] <- self$E[self$E >= i] - 1
               }
             }

             self$edges <- self$edges[-ind]
             if(!is.null(self$edge_lengths)){
               self$edge_lengths <- self$edge_lengths[-ind]
             }
             self$E <- self$E[-ind,]
             self$nE <- self$nE - length(ind)
             if(is.vector(private$edge_weights)){
               private$edge_weights <- private$edge_weights[-ind]
             } else{
               private$edge_weights <- private$edge_weights[-ind,,drop=FALSE]
             }

           }
         }
       }
     },

     # utility function to merge lines connected by degree 2 vertices
     merge.all.deg2 = function() {
       while(sum(private$compute_degrees()$degrees==2)>0) {
         private$remove.first.deg2()
       }
     },


     remove.first.deg2 = function(res, check_circles) {
       if(!check_circles){
         ind <- which(res$degrees==2 & !res$problematic)
       } else{
         ind <- which(res$degrees==2 & !res$problematic & !res$problematic_circles)
       }
       res.out <- res
       if(length(ind)>0) {
         ind <- ind[1]
         e1 <- which(self$E[,2]==ind)
         e2 <- which(self$E[,1]==ind)

         if(!check_circles || (self$E[e1,1] != self$E[e2,2])){
           order_edges <- order(c(e1,e2))
           e_rem <- c(e1,e2)[order_edges]

           # Finding the right order, so the edges can be merged.

           which_line_starts <- which(order_edges == 1)

           v1 <- setdiff(self$E[e_rem[1],],ind)
           v2 <- setdiff(self$E[e_rem[2],],ind)

           if(v1 > ind) {
             v1 <- v1-1
           }
           if(v2 > ind) {
             v2 <- v2 - 1
           }

           # Making sure it is not a single circle

           if( e_rem[1] != e_rem[2]){

             coords <- self$edges[[e_rem[1]]] #line from v1 to v.rem
             tmp <- self$edges[[e_rem[2]]] #line from v.rem to v2
             PtEedge1 <- attr(coords, "PtE")
             PtEedge2 <- attr(tmp, "PtE")

             if(which_line_starts == 1){
               coords <- rbind(coords, tmp[-1,,drop=FALSE])
               E_new <- matrix(c(v1,v2),1,2)
               PtEedge1 <- PtEedge1 * self$edge_lengths[e_rem[1]]
               PtEedge2 <- self$edge_lengths[e_rem[1]] + PtEedge2[-1] * self$edge_lengths[e_rem[2]]
               attr(coords, "PtE") <- c(PtEedge1,PtEedge2)/(self$edge_lengths[e_rem[1]] + self$edge_lengths[e_rem[2]])
             } else{
               coords <- rbind(tmp,coords[-1,,drop=FALSE])
               E_new <- matrix(c(v2,v1),1,2)
               PtEedge2 <- PtEedge2 * self$edge_lengths[e_rem[2]]
               PtEedge1 <- self$edge_lengths[e_rem[2]] + PtEedge1[-1] * self$edge_lengths[e_rem[1]]
               attr(coords, "PtE") <- c(PtEedge2,PtEedge1)/(self$edge_lengths[e_rem[1]] + self$edge_lengths[e_rem[2]])
             }

             # Updating the merged graph

             res.out$degrees <- res$degrees[-ind]
             res.out$problematic <- res$problematic[-ind]
             res.out$problematic_circles <- res.out$problematic_circles[-ind]

             #update vertices
             self$V <- self$V[-ind,]
             self$vertices[[ind]] <- NULL
             self$nV <- self$nV - 1
             # for(i in ind:length(self$vertices)){
             #   attr(self$vertices[[i]], "id") <- attr(self$vertices[[i]], "id") - 1
             # }

             #update edges
             self$E[self$E >= ind] <- self$E[self$E >= ind] - 1
             self$E <- self$E[-e_rem[2],,drop=FALSE]
             self$E[e_rem[1],] <- E_new
             self$edges[[e_rem[1]]] <- coords
             self$edges <- self$edges[-e_rem[2]]
             # for(i in e_rem[2]:length(self$edges)){
             #     attr(self$edges[[i]], "id") <- attr(self$edges[[i]], "id") - 1
             # }
             # attr(self$edges[[e_rem[1]]], "id") <- e_rem[1]

             self$edge_lengths[e_rem[1]] <- self$edge_lengths[e_rem[1]] + self$edge_lengths[e_rem[2]]
             self$edge_lengths <- self$edge_lengths[-e_rem[2]]

             self$nE <- self$nE - 1

             if(is.vector(private$edge_weights)){
               if(compare_with_na(private$edge_weights[e_rem[2]],
                                  private$edge_weights[e_rem[1]])){
                 private$prune_warning <- TRUE
               }
               private$edge_weights <- private$edge_weights[-e_rem[2]]
             } else{
               if(compare_with_na(private$edge_weights[e_rem[2],,drop=FALSE],
                                  private$edge_weights[e_rem[1],,drop=FALSE],
                                  is_matrix = TRUE)){
                 private$prune_warning <- TRUE
               }
               private$edge_weights <- private$edge_weights[-e_rem[2],,drop=FALSE]
             }
           }

         } else{
           res.out$problematic_circles[ind] <- TRUE
           res.out$circles_avoided <- TRUE
         }
       }
       class(self$edges) <- "metric_graph_edges"
       return(res.out)
     },

     # Compute lengths

     compute_lengths = function(longlat, unit, crs, proj4string, which_longlat,
                                vertex_unit, project_data, transform){

       # The fall-back branch (transform = TRUE) is rare -- it
       # triggers only when longlat is TRUE AND which_longlat == 'sp'
       # AND a non-WGS84 CRS was provided -- and goes through the
       # original per-edge sapply because it needs sp::spTransform
       # per edge.
       nE <- length(self$edges)
       if (nE == 0L) return(numeric(0))

       if (transform) {
         # rare fallback path; preserve original behavior verbatim
         ll <- sapply(self$edges,
                      function(edge){compute_line_lengths(edge,
                                                          longlat = longlat,
                                                          unit = unit,
                                                          crs = crs,
                                                          proj4string,
                                                          which_longlat,
                                                          vertex_unit,
                                                          project_data,
                                                          transform)})
         return(ll)
       }

       if (!longlat || project_data) {
         # planar / projected: edges are in `vertex_unit`, return in `unit`
         raw  <- compute_edge_lengths_cpp(self$edges, FALSE)
         fact <- process_factor_unit(vertex_unit, unit)
         return(raw * fact)
       }

       # true longlat path: C++ haversine returns metres
       raw  <- compute_edge_lengths_cpp(self$edges, TRUE)
       fact <- process_factor_unit("m", unit)
       raw * fact
     },

     approx_coordinates = function(edge){
       # Calculate the Euclidean distances between consecutive rows (vertices)
       dists <- sqrt(rowSums((edge[-1, ,drop=FALSE] - edge[-nrow(edge), ,drop=FALSE])^2))

       # Get cumulative sum to obtain positions along the edge
       cum_dists <- c(0, cumsum(dists))  # Start from 0 for the first vertex

       # Normalize the cumulative distances to get relative positions between 0 and 1
       rel_positions <- cum_dists / cum_dists[length(cum_dists)]

       return(rel_positions)
     },

     exact_PtE_coordinates = function(edge) {
       # Get distances using compute_aux_distances between consecutive rows
       lines <- edge[-1, , drop = FALSE]      # All rows except the first
       points <- edge[-nrow(edge), , drop = FALSE] # All rows except the last

       # Compute distances between each consecutive point
       dists <- compute_aux_distances(lines = lines, crs = private$crs,
                                      longlat = private$longlat,
                                      proj4string = private$proj4string,
                                      points = points,
                                      fact = private$fact,
                                      which_longlat = private$which_longlat,
                                      length_unit = private$length_unit,
                                      transform = private$transform)

       # Calculate the relative positions using cumulative sums
       total_length <- sum(dists)
       relative_positions <- c(0, cumsum(dists) / total_length)

       return(relative_positions)
     },

     ## @description Get the observation/prediction matrix A
     ## @param group A vector. If `NULL`, the A matrix for the first group will be
     ## returned. One can use all groups by simply setting the `group` variable
     ## to `.all`. Otherwise, the A matrix for the groups in the vector will be
     ## returned.
     ## @param obs_to_vert Should the observations be turned into vertices?
     ## @param include_NA Should the locations for which all observations are NA be
     ## included?
     ## @return The observation or prediction matrix.
     A = function(group = NULL,
                  obs_to_vert = FALSE,
                  drop_na = FALSE,
                  drop_all_na = FALSE){

       if(is.null(self$PtV) && !obs_to_vert){
         stop("The A matrix was not computed. If you want to compute rerun this
method with 'obs_to_vertex=TRUE', in which the observations will be
turned to vertices and the A matrix will then be computed")
       } else if(is.null(self$PtV)){
         self$observation_to_vertex(mesh_warning=FALSE)
       }

       if(is.null(group)){
         group <- unique(private$data[[".group"]])
         group <- group[1]
       } else if (group[1] == ".all"){
         group <- unique(private$data[[".group"]])
       }
       n_group <- length(unique(group))

       if(!drop_na && !drop_all_na){
         row_idx <- self$PtV
         A <- Matrix::sparseMatrix(
           i = seq_along(row_idx), j = row_idx,
           x = 1, dims = c(length(row_idx), self$nV))
         return(Matrix::kronecker(Diagonal(n_group),A))
       } else {
         data_group <- select_group(private$data, group[1])
         if(drop_na){
           idx_notna <- idx_not_any_NA(data_group)
         } else if(drop_all_na){
           idx_notna <- idx_not_all_NA(data_group)
         }
         row_idx <- self$PtV[idx_notna]
         A <- Matrix::sparseMatrix(
           i = seq_along(row_idx), j = row_idx,
           x = 1, dims = c(length(row_idx), self$nV))
         if(n_group > 1){
           for (i in 2:length(group)) {
             data_group <- select_group(private$data, group[i])
             if(drop_na){
               idx_notna <- idx_not_any_NA(data_group)
             } else if(drop_all_na){
               idx_notna <- idx_not_all_NA(data_group)
             }
             row_idx <- self$PtV[idx_notna]
             A <- Matrix::bdiag(A, Matrix::sparseMatrix(
               i = seq_along(row_idx), j = row_idx,
               x = 1, dims = c(length(row_idx), self$nV)))
           }
         }
         return(A)
       }
     },


     #'  Gets the edge weights
     #'  data.frame If the edge weights are given as vectors, should the result
     #'  be returned as a data.frame?
     #'  A vector or `data.frame` containing the edge weights.

     get_edge_weights_internal = function(data.frame = FALSE){
       tmp <- private$edge_weights
       row.names(tmp) <- NULL
       if(!is.data.frame(tmp) && data.frame){
         tmp <- data.frame(.weights = tmp)
       }
       return(tmp)
     },

     format_data = function(data_res, format) {

       if(!(format%in%c("tibble", "sf", "sp"))){
         stop("The possible formats are 'tibble', 'sf', 'sp'.")
       }

       if (format == "sf") {
         # Ensure the coordinates exist in the data
         if (!all(c(".coord_x", ".coord_y") %in% colnames(data_res))) {
           stop("Cannot convert to sf: .coord_x and .coord_y columns are missing.")
         }

         # Create sf object from coordinates
         data_res_sf <- sf::st_as_sf(data_res, coords = c(".coord_x", ".coord_y"),
                                     crs = sf::NA_crs_)
         class(data_res_sf) <- c("metric_graph_data", class(data_res_sf))
         return(data_res_sf)

       } else if (format == "sp") {
         # Ensure the coordinates exist in the data
         if (!all(c(".coord_x", ".coord_y") %in% colnames(data_res))) {
           stop("Cannot convert to sp: .coord_x and .coord_y columns are missing.")
         }

         # Create SpatialPointsDataFrame from coordinates
         coords <- cbind(data_res$.coord_x, data_res$.coord_y)
         sp_data <- sp::SpatialPointsDataFrame(
           coords = coords,
           data = data_res,
           proj4string = sp::CRS(NA_character_)
         )
         return(sp_data)

       } else {
         data_res <- tidyr::as_tibble(data_res)
         class(data_res) <- c("metric_graph_data", class(data_res))
         return(data_res)
       }
     },


     format_weights = function(edge_weights_res, format) {

       if(!(format%in%c("tibble", "sf", "sp"))){
         stop("The possible formats are 'tibble', 'sf', 'sp'.")
       }

       if (format == "sf") {
         edges_geometries <- lapply(self$edges, sf::st_linestring)

         if (is.vector(private$edge_weights)) {
           ew_tmp <- data.frame(.weights = private$edge_weights)
         } else {
           ew_tmp <- as.data.frame(private$edge_weights)
         }
         ew_tmp[[".edge_lengths"]] <- self$edge_lengths

         edges_sf <- sf::st_sf(ew_tmp, geometry = sf::st_sfc(edges_geometries),
                               crs = if (!is.null(private$crs)) private$crs else sf::NA_crs_)
         class(edges_sf) <- c("metric_graph_weights", class(edges_sf))
         return(edges_sf)

       } else if (format == "sp") {
         edges_list <- lapply(1:length(self$edges), function(i) {
           sp::Line(coords = matrix(self$edges[[i]], nrow = dim(self$edges[[i]])[1],
                                    ncol = dim(self$edges[[i]])[2]))
         })
         sp_edges <- sp::SpatialLines(
           lapply(1:length(edges_list), function(i) sp::Lines(list(edges_list[[i]]),
                                                              ID = as.character(i))),
           proj4string = if (!is.null(private$crs)) private$proj4string else sp::CRS(NA_character_)
         )

         if (is.vector(private$edge_weights)) {
           ew_tmp <- data.frame(.weights = private$edge_weights)
         } else {
           ew_tmp <- as.data.frame(private$edge_weights)
         }
         ew_tmp[[".ID"]] <- as.character(1:length(sp_edges))
         ew_tmp[[".edge_lengths"]] <- self$edge_lengths
         edges_sldf <- sp::SpatialLinesDataFrame(sp_edges, data = ew_tmp, match.ID = ".ID")
         return(edges_sldf)

       } else {
         edge_weights_res <- tidyr::as_tibble(edge_weights_res)
         class(edge_weights_res) <- c("metric_graph_weights", class(edge_weights_res))
         return(edge_weights_res)
       }
     },

     #' data List containing data on the metric graph.

     data = NULL,

     # Initial edges added

     initial_edges_added = NULL,

     # Initial graph

     initial_graph = NULL,

     # Version of MetricGraph package used to build the graph

     version = as.character(utils::packageVersion("MetricGraph")),

     # pruned

     pruned = FALSE,

     # should the information be saved when splitting edges?

     addinfo = FALSE,

     # vertex unit

     vertex_unit = NULL,

     # Length unit

     length_unit = NULL,

     # longlat

     longlat = FALSE,

     # crs

     crs = NULL,

     # proj4string

     proj4string = NULL,

     # which_longlat

     which_longlat = NULL,

     # connected

     connected = TRUE,

     # Connected-component bookkeeping. Computed eagerly at construction
     # time (in `initialize`) so that `is_disconnected()`,
     # `get_components()`, `which_component()`, and `plot(components = ...)`
     # are all O(1) lookups thereafter.
     #
     # - component_membership: integer vector of length nV, giving the
     #   component index of each vertex. Components are numbered in order
     #   of decreasing total edge length (so component 1 is the largest).
     # - nC: number of connected components (== max(component_membership)).
     # - components_cache: lazy cache for the list of per-component
     #   `metric_graph` objects returned by `get_components()`. NULL until
     #   the first call; invalidated on `add_observations` /
     #   `clear_observations` to keep per-component data in sync.
     component_membership = NULL,
     nC = 0L,
     components_cache = NULL,

     # group columns

     group_col = NULL,

     # Kichhoff weights

     kirchhoff_weights = NULL,

     # manual edge lengths

     manual_edge_lengths = FALSE,

     # perform merges?

     perform_merges = NULL,

     #grouping variables when adding data

     group_variables = NULL,

     project_data = NULL,

     degrees = NULL,

     # Warning if edges with different weights have been merged

     prune_warning = FALSE,

     clear_initial_info = function(){
       private$addinfo = FALSE
       private$initial_edges_added = NULL
     },

     # Observe that by construction of get_PtE, all PtEs are sorted.
     split_edge = function(Ei, t_values, indices = NULL) {

       # Calculate distances and determine if new vertices need to be added
       edge <- self$edges[[Ei]]
       edge_length <- self$edge_lengths[Ei]
       PtE_edge <- attr(edge, "PtE")

       # Data frame creation and filling NA values
       val_results <- interpolate2(edge, pos = t_values, normalized = TRUE,
                                   get_idx = TRUE)
       idx_positions <- val_results[["idx"]]
       val_lines <- val_results[["coords"]]

       # One-shot vertex growth (replaces per-i rbind + self$nV increment loop).
       n_t <- length(t_values)
       nV_old <- self$nV
       new_vertices <- nV_old + seq_len(n_t)
       self$V  <- rbind(self$V, val_lines)
       self$nV <- nV_old + n_t

       # Edge updates
       edge_updates <- self$nE + seq_len(length(t_values))

       if (!is.null(private$data) && !is.null(indices)) {
         private$temp_PtE[indices, 1] <- edge_updates
         private$temp_PtE[indices, 2] <- (private$temp_PtE[indices, 2] - t_values) / (1 - t_values)
       }
       edge_updates <- c(Ei, edge_updates)

       coords_list1 <- edge[1:idx_positions[1], , drop = FALSE]
       coords_list1 <- rbind(coords_list1, val_lines[1, , drop = FALSE])
       tmp_vec <- c(PtE_edge[1:idx_positions[1]], t_values[1])
       # Remove duplicate consecutive rows
       if (nrow(coords_list1) > 1L) {
         is_dup <- c(FALSE, rowSums(diff(coords_list1)^2) == 0)
         if (any(is_dup)) {
           coords_list1 <- coords_list1[!is_dup, , drop = FALSE]
           tmp_vec      <- tmp_vec[!is_dup]
         }
       }
       pos_edge_diff <- tmp_vec - tmp_vec[1]
       norm_factor <- tmp_vec[length(tmp_vec)] - tmp_vec[1]
       tmp_PtE <- if (norm_factor == 0) numeric(length(tmp_vec)) else pos_edge_diff / norm_factor

       # Add tmp_PtE as an attribute
       attr(coords_list1, "PtE") <- tmp_PtE

       n_t_values <- length(t_values)

       coords_list2 <- vector("list", n_t_values)

       for (i in seq_along(t_values)) {
         val_line_start <- matrix(val_lines[i, , drop = FALSE], nrow = 1)

         if (i < n_t_values) {
           val_line_end <- matrix(val_lines[i + 1, , drop = FALSE], nrow = 1)
           if (idx_positions[i] != idx_positions[i + 1]) {
             coords_list2[[i]] <- rbind(
               val_line_start,
               edge[(idx_positions[i] + 1):idx_positions[i + 1], , drop = FALSE],
               val_line_end
             )
             tmp_vec <- c(t_values[i],
                          PtE_edge[(idx_positions[i] + 1):idx_positions[i + 1]],
                          t_values[i + 1])
           } else {
             coords_list2[[i]] <- rbind(
               val_line_start,
               val_line_end
             )
             tmp_vec <- c(t_values[i], t_values[i + 1])
           }
         } else {
           coords_list2[[i]] <- rbind(
             val_line_start,
             edge[(idx_positions[i] + 1):nrow(edge), , drop = FALSE]
           )
           tmp_vec <- c(t_values[i], PtE_edge[(idx_positions[i] + 1):nrow(edge)])
         }

         # Remove duplicate consecutive rows
         if (nrow(coords_list2[[i]]) > 1L) {
           is_dup <- c(FALSE, rowSums(diff(coords_list2[[i]])^2) == 0)
           if (any(is_dup)) {
             coords_list2[[i]] <- coords_list2[[i]][!is_dup, , drop = FALSE]
             tmp_vec            <- tmp_vec[!is_dup]
           }
         }
         pos_edge_diff <- tmp_vec - tmp_vec[1]
         norm_factor <- tmp_vec[length(tmp_vec)] - tmp_vec[1]
         tmp_PtE <- if (norm_factor == 0) numeric(length(tmp_vec)) else pos_edge_diff / norm_factor

         # Add tmp_PtE as an attribute
         attr(coords_list2[[i]], "PtE") <- tmp_PtE
       }

       # Construct aux_matrix for self$E (hoist endpoints once)
       E_row_Ei <- self$E[Ei, ]
       if (length(t_values) == 1) {
         aux_matrix <- matrix(
           c(E_row_Ei[1], new_vertices[1], new_vertices[1], E_row_Ei[2]),
           nrow = 2, byrow = TRUE
         )
       } else {
         aux_matrix <- rbind(
           c(E_row_Ei[1], new_vertices[1]),
           cbind(new_vertices[-length(new_vertices)], new_vertices[-1]),
           c(new_vertices[length(new_vertices)], E_row_Ei[2])
         )
       }

       # Update self$E, self$edges, and related attributes
       self$E[Ei, ] <- aux_matrix[1, ]
       self$E <- rbind(self$E, aux_matrix[-1, ])
       self$edges[[Ei]] <- coords_list1
       self$edges <- c(self$edges, coords_list2)
       self$nE <- self$nE + length(t_values)

       # Update edge lengths and weights (reuse cached edge_length)
       segment_lengths <- c(t_values[1], diff(t_values),
                            1 - t_values[length(t_values)]) * edge_length
       self$edge_lengths <- c(self$edge_lengths, segment_lengths[-1])
       self$edge_lengths[Ei] <- segment_lengths[1]

       if (is.vector(private$edge_weights)) {
         private$edge_weights <- c(private$edge_weights,
                                   rep(private$edge_weights[Ei], length(t_values)))
       } else {
         private$edge_weights <- rbind(private$edge_weights,
                                       do.call(rbind, replicate(length(t_values),
                                                                private$edge_weights[Ei, , drop = FALSE],
                                                                simplify = FALSE)))
       }

       return(new_vertices)
     },


     # batch processing of multiple edges (sequential only)
     split_edge_batch = function(edge_groups, verbose = 0) {

       # Pushes the entire inner edge-splitting work into a single
       # batched C++ call (split_edges_batch_cpp). The R wrapper does:
       #   1. A cheap pre-pass to extract t_values/indices per group + compute
       #      first_new_v offsets
       #   2. ONE C++ call that processes all edges in compiled native code,
       #      returning per-edge (coords_list1, coords_list2, segment_lengths,
       #      aux_matrix, val_lines)
       #   3. A thin R loop that only does buffer assignments into pre-allocated
       #      locals + the temp_PtE updates
       #   4. A single batched write-back to self$* at the end

       n_groups <- length(edge_groups)
       if (n_groups == 0L) return(list())

       group_sizes <- vapply(edge_groups, function(x) {
         if (is.null(x)) return(0L)
         if (is.matrix(x)) return(nrow(x))
         if (is.data.frame(x)) return(nrow(x))
         if (is.vector(x) && length(x) == 2) return(1L)
         return(0L)
       }, FUN.VALUE = integer(1), USE.NAMES = FALSE)

       total_new_vertices <- sum(group_sizes)
       if (total_new_vertices == 0L) {
         return(vector("list", n_groups))
       }

       # Pull state into locals (R6 active bindings are slow in tight loops)
       V_loc        <- self$V
       E_loc        <- self$E
       edges_loc    <- self$edges
       edge_len_loc <- self$edge_lengths
       ew_loc       <- private$edge_weights
       temp_PtE_loc <- private$temp_PtE
       has_data     <- !is.null(private$data) && !is.null(temp_PtE_loc)

       nV_orig <- self$nV
       nE_orig <- self$nE
       ncol_V  <- ncol(V_loc)

       edge_names <- as.integer(names(edge_groups))

       # Pre-pass: extract t_values, indices per group; compute first_new_vs
       t_values_list <- vector("list", n_groups)
       indices_list  <- vector("list", n_groups)
       first_new_vs  <- integer(n_groups)
       valid_groups  <- logical(n_groups)
       v_ctr <- nV_orig
       for (i in seq_len(n_groups)) {
         grp <- edge_groups[[i]]
         if (is.null(grp)) next
         if (is.matrix(grp)) {
           if (nrow(grp) == 0L) next
           t_values_list[[i]] <- grp[, 1]
           indices_list[[i]]  <- grp[, 2]
         } else if (is.data.frame(grp)) {
           if (nrow(grp) == 0L) next
           t_values_list[[i]] <- grp[[1]]
           indices_list[[i]]  <- grp[[2]]
         } else if (is.vector(grp) && length(grp) == 2L) {
           t_values_list[[i]] <- grp[1]
           indices_list[[i]]  <- grp[2]
         } else {
           next
         }
         first_new_vs[i] <- v_ctr + 1L
         v_ctr <- v_ctr + group_sizes[i]
         valid_groups[i] <- TRUE
       }

       # Pre-extract PtE attributes once (avoids attr() calls in C++)
       PtE_full <- lapply(edges_loc, function(e) attr(e, "PtE"))

       # ONE batched C++ call processes all edge groups
       cpp_results <- split_edges_batch_cpp(edges_loc, PtE_full, E_loc,
                                            edge_len_loc,
                                            edge_names, t_values_list,
                                            first_new_vs)

       # Pre-allocate output buffers
       all_new_coords    <- matrix(0.0, nrow = total_new_vertices,
                                   ncol = ncol_V)
       new_E_rows        <- matrix(NA_integer_, nrow = total_new_vertices,
                                   ncol = 2L)
       new_edges_list    <- vector("list", total_new_vertices)
       new_edge_lengths  <- numeric(total_new_vertices)
       new_vertices_list <- vector("list", n_groups)
       src_edge_per_new_edge <- integer(total_new_vertices)

       vertex_counter <- 0L
       edge_counter   <- 0L

       # Thin R loop: only buffer assignments + temp_PtE update
       for (i in seq_len(n_groups)) {
         if (!valid_groups[i]) {
           new_vertices_list[[i]] <- integer(0); next
         }
         Ei    <- edge_names[i]
         n_new <- group_sizes[i]
         res   <- cpp_results[[i]]

         # Vertex coordinates and IDs
         vertex_indices <- (vertex_counter + 1L):(vertex_counter + n_new)
         all_new_coords[vertex_indices, ] <- res$val_lines
         new_vertices_list[[i]] <- nV_orig + vertex_indices
         vertex_counter <- vertex_counter + n_new

         # temp_PtE update
         if (has_data) {
           indices  <- indices_list[[i]]
           t_values <- t_values_list[[i]]
           edge_updates <- nE_orig + edge_counter + seq_len(n_new)
           temp_PtE_loc[indices, 1] <- edge_updates
           temp_PtE_loc[indices, 2] <- (temp_PtE_loc[indices, 2] - t_values) / (1 - t_values)
         }

         # Update local edge slot to first segment
         edges_loc[[Ei]] <- res$coords_list1
         seglens <- res$segment_lengths
         edge_len_loc[Ei] <- seglens[1]
         aux_matrix <- res$aux_matrix
         E_loc[Ei, ] <- aux_matrix[1, ]

         # Stage subsequent segments / aux rows / lengths
         edge_indices_out <- (edge_counter + 1L):(edge_counter + n_new)
         new_E_rows[edge_indices_out, ] <- aux_matrix[-1, , drop = FALSE]
         new_edge_lengths[edge_indices_out] <- seglens[-1]
         new_edges_list[edge_indices_out] <- res$coords_list2
         src_edge_per_new_edge[edge_indices_out] <- Ei

         edge_counter <- edge_counter + n_new
       }

       # Append new vertices to local V
       if (vertex_counter > 0L) {
         V_loc <- rbind(V_loc, all_new_coords[seq_len(vertex_counter), ,
                                              drop = FALSE])
       }

       # Append new edges to local E / edges / edge_lengths
       if (edge_counter > 0L) {
         E_loc        <- rbind(E_loc, new_E_rows[seq_len(edge_counter), ,
                                                 drop = FALSE])
         edges_loc    <- c(edges_loc, new_edges_list[seq_len(edge_counter)])
         edge_len_loc <- c(edge_len_loc, new_edge_lengths[seq_len(edge_counter)])

         # Vectorized edge_weights propagation
         # src_ids[k] is the original edge id of the k-th new edge.
         # ew_loc[src_ids] is the per-new-edge weight (or row of weights).
         src_ids <- src_edge_per_new_edge[seq_len(edge_counter)]
         if (is.vector(ew_loc)) {
           new_weights <- ew_loc[src_ids]
           ew_loc <- c(ew_loc, new_weights)
         } else if (is.data.frame(ew_loc)) {
           new_rows <- ew_loc[src_ids, , drop = FALSE]
           ew_loc   <- rbind(ew_loc, new_rows)
         } else if (is.matrix(ew_loc)) {
           new_rows <- ew_loc[src_ids, , drop = FALSE]
           ew_loc   <- rbind(ew_loc, new_rows)
         } else {
           warning("Unexpected edge weight format, resetting to default weights")
           ew_loc <- rep(1, nE_orig + edge_counter)
         }
       }

       self$V            <- V_loc
       self$E            <- E_loc
       self$edges        <- edges_loc
       self$edge_lengths <- edge_len_loc
       self$nV           <- nV_orig + vertex_counter
       self$nE           <- nE_orig + edge_counter
       private$edge_weights <- ew_loc
       if (has_data) private$temp_PtE <- temp_PtE_loc

       return(new_vertices_list)
     },


     compute_laplacian_PtE = function(PtE, normalized = TRUE, verbose = verbose) {
       if(verbose == 2){
         message("Processing the graph locations...")
       }
       t <- system.time({
         graph.temp <- self$clone()
         graph.temp$clear_observations()
         df_temp <- data.frame(y = rep(0, dim(PtE)[1]),
                               edge_number = PtE[,1],
                               distance_on_edge = PtE[,2])
         if(sum(duplicated(df_temp))>0){
           warning("Duplicated locations were found when computing the laplacian. The returned values are given for unique locations.")
           df_temp <- unique(df_temp)
         }

         graph.temp$build_mesh(h = 1000)

         df_temp2 <- data.frame(y = 0,
                                edge_number = graph.temp$mesh$VtE[1:nrow(self$V),1],
                                distance_on_edge = graph.temp$mesh$VtE[1:nrow(self$V),2])
         df_temp$included <- TRUE
         temp_merge <- merge(df_temp, df_temp2, all = TRUE)

         df_temp$included <- NULL
         df_temp2 <- temp_merge[is.na(temp_merge["included"]),]
         df_temp2$included <- NULL
         df_temp <- rbind(df_temp2, df_temp)

         nV_new <- sum(is.na(temp_merge["included"]))

         df_temp[["__dummy"]] <- 1:nrow(df_temp)

         graph.temp$add_observations(data = df_temp,
                                     normalized = normalized,
                                     verbose = 0,
                                     suppress_warnings = TRUE)
       })
       if(verbose == 2){
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }
       if(verbose == 2){
         message("Turning observations of the auxiliary graph to vertices...")
       }
       t <- system.time(
         graph.temp$observation_to_vertex(mesh_warning = FALSE)
       )
       if(verbose > 0){
         message("Computing the Laplacian...")
       }
       t <- system.time({
         Wmat <- Matrix(0,graph.temp$nV,graph.temp$nV)

         for (i in 1:graph.temp$nE) {
           Wmat[graph.temp$E[i, 1], graph.temp$E[i, 2]] <- 1 / graph.temp$edge_lengths[i]
           Wmat[graph.temp$E[i, 2], graph.temp$E[i, 1]] <- 1 / graph.temp$edge_lengths[i]
         }
         Laplacian <- Matrix::Diagonal(graph.temp$nV,
                                       as.vector(Matrix::rowSums(Wmat))) - Wmat

         # Reordering from vertices to points
         Laplacian <- Laplacian[graph.temp$PtV, graph.temp$PtV]
         # Order back to the input order
         Laplacian[graph.temp$.__enclos_env__$private$data[["__dummy"]],
                   graph.temp$.__enclos_env__$private$data[["__dummy"]]] <- Laplacian
       })
       if(verbose == 2){
         message(sprintf("time: %.3f s", t[["elapsed"]]))
       }

       attr(Laplacian, "nV_idx") <- nV_new

       return(Laplacian)
     },

     find_edge_edge_points = function(tol,verbose, crs,
                                      proj4string, longlat,
                                      fact, which_longlat) {

       if(!private$longlat){
         lines_sf <- sf::st_sfc(lapply(self$edges, function(i){sf::st_linestring(i)}))
         crs <- NULL
       } else if (private$which_longlat == "sf"){
         lines_sf <- sf::st_sfc(lapply(self$edges,
                                       function(i){sf::st_linestring(i)}),
                                crs = private$crs)
       } else{
         lines_sf <- sf::st_sfc(lapply(self$edges,
                                       function(i){sf::st_linestring(i)}),
                                crs = sf::st_crs(private$proj4string))
         crs <- sf::st_crs(proj4string)
       }

       dists <- t(as.matrix(sf::st_is_within_distance(lines_sf, dist = tol)))
       points_add <- NULL
       points_add_PtE <- NULL

       if(verbose == 2) {
         bar_line_line <- msg_progress_bar(length(self$edges)-1)
       }
       for(i in 1:(length(self$edges)-1)) {
         if(verbose == 2) {
           bar_line_line$increment()
         }
         #lines within tol of line i
         inds <- i+which(as.vector(dists[i, (i+1):length(self$edges)]))
         if(length(inds)>0) {
           for(j in inds) {
             #first check if there are intersections

             intersect_tmp <- intersection3(lines_sf[i], lines_sf[j])

             if( any(c("GEOMETRYCOLLECTION","GEOMETRY") %in% sf::st_geometry_type(intersect_tmp)) || (length(sf::st_geometry_type(intersect_tmp)) > 1)){
               intersect_tmp1 <- sf::st_collection_extract(intersect_tmp, type = "LINESTRING")
               intersect_tmp2 <- sf::st_collection_extract(intersect_tmp, type = "POINT")
               if(nrow(sf::st_coordinates(intersect_tmp1))>0){
                 intersect_tmp <- intersect_tmp1
               } else{
                 intersect_tmp <- intersect_tmp2
               }
             }

             p_cur <- NULL
             # if(!is.null(intersect_tmp)) {
             if(nrow(sf::st_coordinates(intersect_tmp))>0){
               # if("SpatialPoints"%in%is(intersect_tmp)){
               if( ("POINT"%in%sf::st_geometry_type(intersect_tmp))||("MULTIPOINT"%in%sf::st_geometry_type(intersect_tmp))){
                 # coord_tmp <- coordinates(intersect_tmp)
                 coord_tmp <- sf::st_coordinates(intersect_tmp)
                 coord_tmp <- coord_tmp[,1:2]
                 # } else if ("SpatialLines"%in%is(intersect_tmp)){
               } else if ( ("LINESTRING"%in%sf::st_geometry_type(intersect_tmp)) || ("MULTILINESTRING"%in%sf::st_geometry_type(intersect_tmp))){
                 intersect_tmp <- sf::st_coordinates(intersect_tmp)
                 intersect_tmp <- intersect_tmp[,1:2]
                 # coord_tmp <-gInterpolate(intersect_tmp, d=0.5, normalized = TRUE)
                 coord_tmp <- interpolate2(intersect_tmp, pos=0.5, normalized = TRUE)
                 coord_tmp <- matrix(coordinates(coord_tmp),1,2)
               }

               # for(k in 1:length(intersect_tmp)) {
               coord_tmp <- matrix(coord_tmp, ncol=2)

               for(k in 1:nrow(coord_tmp)){
                 p <- matrix(coord_tmp[k,],1,2)
                 #add points if they are not close to V or previous points
                 if(!is.matrix(self$V)){
                   self$V <- matrix(self$V,ncol=2)
                 }
                 if(min(compute_aux_distances(lines = self$V, crs=private$crs,
                                              longlat=private$longlat,
                                              proj4string = private$proj4string,
                                              points = p, fact = fact,
                                              which_longlat = private$which_longlat,
                                              length_unit = private$length_unit,
                                              transform = private$transform))>tol) {
                   p_cur <- rbind(p_cur,p)
                   p2 <- snapPointsToLines(p,self$edges[i], longlat, crs)
                   p2 <- t(p2[["coords"]])
                   # p2 <- cbind(p2["X",], p2["Y",])

                   points_add <- rbind(points_add, p, p2)
                   points_add_PtE <- rbind(points_add_PtE,
                                           c(i,projectVecLine2(self$edges[[i]],
                                                               p)),
                                           c(j,projectVecLine2(self$edges[[j]],p)))
                 }
               }
             }
             #now check if there are intersections with buffer

             lines_tmp_sf <- lines_sf[i]
             lines2_tmp_sf <- lines_sf[j]
             tmp_line <- sf::st_buffer(lines_tmp_sf, dist = tol)

             intersect_tmp <- intersection3(tmp_line, lines2_tmp_sf)

             if( "GEOMETRYCOLLECTION" %in% sf::st_geometry_type(intersect_tmp)){
               intersect_tmp <- sf::st_collection_extract(intersect_tmp, type = "LINESTRING")
             }
             # if(!is.null(intersect_tmp)) {
             if(nrow(sf::st_coordinates(intersect_tmp))>0){
               for(k in 1:length(intersect_tmp)) {
                 if ( ("LINESTRING"%in%sf::st_geometry_type(intersect_tmp)) || ("MULTILINESTRING"%in%sf::st_geometry_type(intersect_tmp))){
                   # coord_tmp <-gInterpolate(intersect_tmp[k], d=0.5, normalized = TRUE)
                   coord_int <- sf::st_coordinates(intersect_tmp[k])
                   coord_int <- coord_int[,c("X","Y")]
                   coord_tmp <- interpolate2(coord_int, pos=0.5, normalized = TRUE)
                   p <- matrix(coord_tmp,1,2)
                 } else {
                   coord_int <- sf::st_coordinates(intersect_tmp[k])
                   p <- matrix(coord_int[,c("X","Y")],1,2)
                   # p <- matrix(sf::st_coordinates(intersect_tmp[k]),1,2)
                 }

                 #add points if they are not close to V or previous points
                 if(min(compute_aux_distances(lines = self$V, crs=private$crs,
                                              longlat=private$longlat,
                                              proj4string = private$proj4string,
                                              points = p, fact = fact,
                                              which_longlat = private$which_longlat,
                                              length_unit = private$length_unit,
                                              transform = private$transform))>tol) {
                   # if(is.null(p_cur) || gDistance(SpatialPoints(p_cur), intersect_tmp[k])>tol) {
                   if(!private$longlat && !is.null(p_cur)){
                     dist_tmp <- sf::st_distance(sf::st_as_sf(as.data.frame(p_cur), coords = 1:2),
                                                 intersect_tmp[k])
                   } else if (!is.null(p_cur)) {
                     intersect_tmp_sfc <- sf::st_sfc(intersect_tmp[k], crs = private$crs)
                     dist_tmp <- sf::st_distance(sf::st_as_sf(as.data.frame(p_cur),
                                                              coords = 1:2, crs = private$crs),
                                                 intersect_tmp_sfc)
                     units(dist_tmp) <- private$length_unit
                     units(dist_tmp) <- NULL
                   }
                   if(is.null(p_cur) || min(dist_tmp) >tol) {
                     p2 <- snapPointsToLines(p,self$edges[i], private$longlat, private$crs)
                     p2 <- t(p2[["coords"]])
                     points_add <- rbind(points_add, p, p2)
                     points_add_PtE <- rbind(points_add_PtE,
                                             c(i,projectVecLine2(self$edges[[i]],p)),
                                             c(j,projectVecLine2(self$edges[[j]], p)))

                   }
                 }
               }
             }
           }
         }
       }
       # ret_tmp <- list(points = points_add, PtE = points_add_PtE)
       return(list(points = points_add, PtE = points_add_PtE))
     },

     add_vertices = function(PtE, tolerance = 1e-10, verbose) {
       e.u <- unique(PtE[,1])
       if(verbose == 2) {
         bar_eu <- msg_progress_bar(length(e.u))
       }
       for (i in 1:length(e.u)) {
         if(verbose == 2) {
           bar_eu$increment()
         }
         dists <- sort(PtE[which(PtE[,1]==e.u[i]),2])
         if(length(dists) > 0){
           if(dists[1] > tolerance){
             private$split_edge(e.u[i], dists[1])
           }
         }
         if(length(dists)>1) {
           dists_up <- dists
           for(j in 2:length(dists)){
             dists_up[j] <- (dists[j] - dists[j-1])/(1 - dists[j-1])
             if(dists_up[j] > tolerance){
               private$split_edge(self$nE, dists_up[j])
             }
           }
         }
       }
       return(self)
     },

     # Function to compute the degrees of the vertices,

     compute_degrees = function(verbose = 0, add = FALSE) {
       if (verbose == 2) {
         message("Computing degrees...")
       }

       # Vectorized computation of in-degrees and out-degrees
       degrees_out <- tabulate(self$E[, 1], nbins = self$nV)
       degrees_in <- tabulate(self$E[, 2], nbins = self$nV)

       # Compute total degrees
       degrees <- degrees_in + degrees_out

       if (add) {
         private$degrees <- list(degrees = degrees, indegrees = degrees_in,
                                 outdegrees = degrees_out)
       }

       return(list(degrees = degrees, indegrees = degrees_in,
                   outdegrees = degrees_out))
     },

     # Reference edges for the vertices

     ref_edges = NULL,

     #  Creates/updates the vertices element of the metric graph list

     create_update_vertices = function(verbose = 0) {
       degrees <- private$compute_degrees(verbose = verbose, add = TRUE)

       n_vertices <- nrow(self$V)
       if (length(degrees$degrees) != n_vertices ||
           length(degrees$indegrees) != n_vertices ||
           length(degrees$outdegrees) != n_vertices) {
         stop("Mismatch in the number of vertices and degree information. Please check your graph data.")
       }

       if (verbose == 2) {
         if (is.null(self$vertices)) {
           message("Creating vertices object")
         } else {
           message("Updating vertices object")
         }
       }

       colnames(self$V) <- c("X", "Y")

       X    <- self$V[, 1L]
       Y    <- self$V[, 2L]
       deg  <- degrees$degrees
       indg <- degrees$indegrees
       outg <- degrees$outdegrees
       problematic <- (deg > 1L) & ((indg == 0L) | (outg == 0L))

       longlat_val <- private$longlat
       has_crs     <- !is.null(private$crs$input)
       crs_val     <- if (has_crs) private$crs$input else NULL

       self$vertices <- lapply(seq_len(n_vertices), function(i) {
         vert <- c(X[i], Y[i])
         attr(vert, "degree")      <- deg[i]
         attr(vert, "indegree")    <- indg[i]
         attr(vert, "outdegree")   <- outg[i]
         attr(vert, "problematic") <- problematic[i]
         attr(vert, "longlat")     <- longlat_val
         if (has_crs) attr(vert, "crs") <- crs_val
         attr(vert, "id")          <- i
         class(vert) <- "metric_graph_vertex"
         vert
       })

       class(self$vertices) <- "metric_graph_vertices"
     },

     # Merge degree 2 vertices in mesh
     mesh_merge_deg2 = function() {
       outs <- rep(0,self$nV)
       ins <- rep(0, self$nV)
       for(i in 1:self$nV) {
         outs[i] <- sum(self$E[,1] == i)
         ins[i] <- sum(self$E[,2] == i)
       }
       ind <- which(outs == 1 & ins == 1)
       if(length(ind)>0) {
         for(i in 1:length(ind)) {
           V.keep <- self$mesh$V[ind[i],]
           V.rem <- which(self$mesh$V[,1] == V.keep[1] & self$mesh$V[,2] == V.keep[2])[2]
           self$mesh$PtE <- self$mesh$PtE[-V.rem,]
           self$mesh$V <- self$mesh$V[-V.rem,]
           self$mesh$E[self$mesh$E == V.rem] <- ind[i]
           self$mesh$E[self$mesh$E>V.rem] <- self$mesh$E[self$mesh$E>V.rem] - 1
         }
       }
     },

     mesh_merge_outs = function() {
       outs <- rep(0,self$nV)
       for(i in 1:self$nV) {
         outs[i] <- sum(self$E[,1] == i)
       }
       ind <- which(outs > 1)
       while(length(ind)>0) {
         #find edges going out
         e.ind <- which(self$E[,1]==ind[1])
         V.keep <- which(self$mesh$PtE[,1]==e.ind[1])[1]
         V.rem <- which(self$mesh$PtE[,1]==e.ind[2])[1]
         self$mesh$PtE <- self$mesh$PtE[-V.rem,]
         self$mesh$V <- self$mesh$V[-V.rem,]
         self$mesh$E[self$mesh$E == V.rem] <- V.keep
         self$mesh$E[self$mesh$E>V.rem] <- self$mesh$E[self$mesh$E>V.rem] - 1
         outs[ind[1]] <- outs[ind[1]] - 1
         ind <- which(outs > 1)
       }
       #now merge ins with outs if there is only one in
       ins <- rep(0,self$nV)
       outs <- rep(0,self$nV)
       for(i in 1:self$nV) {
         ins[i] <- sum(self$E[,2] == i)
         outs[i] <- sum(self$E[,1] == i)
       }
       ind <- which(ins == 1 & outs > 1)
       while(length(ind)>0) {
         #merge in vertex with out
         e.ind.in <- which(self$E[,2]==ind[1])
         e.ind <- which(self$E[,1]==ind[1])
         V.keep <- which(self$mesh$PtE[,1]==e.ind[1])[1]
         V.rem <- which(self$mesh$PtE[,1]==e.ind.in)
         V.rem <- V.rem[length(V.rem)]
         self$mesh$PtE <- self$mesh$PtE[-V.rem,]
         self$mesh$V <- self$mesh$V[-V.rem,]
         self$mesh$E[self$mesh$E == V.rem] <- V.keep
         self$mesh$E[self$mesh$E>V.rem] <- self$mesh$E[self$mesh$E>V.rem] - 1
         ins[ind[1]] <- ins[ind[1]] - 1
         ind <- which(ins == 1 & outs > 1)
       }
     },

     #find one mesh node corresponding to each vertex and move it first
     move_V_first = function() {
       nv <- dim(self$mesh$V)[1]
       for(i in 1:self$nV) {
         ind <- which(self$mesh$V[,1] == self$V[i,1] & self$mesh$V[,2] == self$V[i,2])[1]
         if(!is.na(ind) && length(ind)>0) {
           if(ind > i && i < nv) {
             if (i == 1) {
               reo <- c(ind, setdiff(i:nv,ind))
             } else {
               reo <- c(1:(i-1), ind, setdiff(i:nv,ind))
             }
             self$mesh$V <- self$mesh$V[reo,]
             self$mesh$PtE <- self$mesh$PtE[reo,]
             self$mesh$VtE <- self$mesh$VtE[reo,]
             Etmp <- self$mesh$E
             ind1 <- Etmp == ind
             ind2 <- Etmp >= i & Etmp < ind
             self$mesh$E[ind1] = i
             self$mesh$E[ind2] = self$mesh$E[ind2] + 1
           }
         }
       }
     },

     # find vertices and connections for Petrov-Galerkin matrices
     find_mesh_bc = function() {
       if(attr(self$mesh,"continuous")) {
         stop("mesh discontinuous")
       }
       starts <- which(self$mesh$PtE[,2]==0)
       edges <- self$mesh$PtE[starts,1]

       ind.keep <- rep(TRUE,length(starts))
       for(i in 1:length(starts)) {
         vert <- self$E[edges[i],1]
         if(length(which(self$E[,2] == vert)) == 1) {
           ind.keep[i] <- FALSE
         }
       }
       starts <- starts[ind.keep]
       edges <- edges[ind.keep]
       connections <-list()
       for(i in 1:length(starts)) {
         vert <- self$E[edges[i],1] #the vertex of the start point
         n.in <- sum(self$E[,2] == vert)
         if(n.in == 0) {
           connections[[i]] <- 0 #true starting value
         } else {
           #find edges ending in the vertex
           edge.in <- which(self$E[,2] == vert)
           #find edges starting in the vertex
           edge.out <- which(self$E[,1] == vert)

           mesh.in <- NULL
           for(j in 1:length(edge.in)){
             tmp <- which(self$mesh$PtE[,1] == edge.in[j]) #mesh nodes on the edge
             mesh.in <- c(mesh.in, tmp[length(tmp)])
           }
           connections[[i]] <- mesh.in
         }
       }
       return(connections)
     },

     # Function to add vertex conditions to Petrov-Galerkin matrices
     set_petrov_matrices = function() {
       if(attr(self$mesh,"continuous")) {
         V <- self$mesh$V[1:self$nV,]
         deg1 <- which(self$get_degrees() == 1)
         starts <- deg1[deg1 %in% self$E[,1]]

         if(length(starts)>1){

           G <- rbind(sparseMatrix(i = 1:length(starts), j = starts,
                                   x = rep(0, length(starts)),
                                   dims = c(length(starts),
                                            dim(self$mesh$Cpet)[1])),
                      t(self$mesh$Gpet[,-starts[-1]]))
         } else {
           C <- rbind(sparseMatrix(i = 1, j = starts, x = 1,
                                   dims = c(1,dim(self$mesh$Cpet)[1])),
                      t(self$mesh$Cpet))
           G <- rbind(sparseMatrix(i = 1, j = starts, x= 0,
                                   dims = c(1, dim(self$mesh$Cpet)[1])),
                      t(self$mesh$Gpet))
         }
       } else {
         bc <- private$find_mesh_bc()
         starts <- which(self$mesh$PtE[,2]==0)
         edges <- self$mesh$PtE[starts,1]

         ind.keep <- rep(TRUE,length(starts))
         for(i in 1:length(starts)) {
           vert <- self$E[edges[i],1]
           if(length(which(self$E[,2] == vert)) == 1) {
             ind.keep[i] <- FALSE
           }
         }
         starts <- starts[ind.keep]
         edges <- edges[ind.keep]
         C <- t(self$mesh$Cpet)
         G <- t(self$mesh$Gpet)

         for(i in length(bc):1) {
           G <- rbind(sparseMatrix(i = 1, j = 1, x = 0,
                                   dims = c(1, dim(self$mesh$Cpet)[1])), G)
           if(bc[[i]][1] == 0) {
             C <- rbind(sparseMatrix(i = 1,j = starts[i], x = 1,
                                     dims = c(1, dim(self$mesh$Cpet)[1])), C)
           } else {
             C <- rbind(sparseMatrix(i = rep(1,length(bc[[i]])+1),
                                     j = c(starts[i], bc[[i]]),
                                     x = c(1, rep(-1/length(bc[[i]]),
                                                  length(bc[[i]]))),
                                     dims = c(1, dim(self$mesh$Cpet)[1])), C)
           }

         }
       }
       self$mesh$Cpet = C
       self$mesh$Gpet = G
       self$mesh$n.bc = length(starts)
       self$mesh$h0 = which(unlist(lapply(bc,length))>1)
     },

     # Bounding box

     bounding_box = NULL,

     compute_bounding_box = function(){
       all_coords <- do.call(rbind, self$edges)

       # Calculate the bounding box
       min_x <- min(all_coords[, 1])
       max_x <- max(all_coords[, 1])
       min_y <- min(all_coords[, 2])
       max_y <- max(all_coords[, 2])

       private$bounding_box <- list(min_x = min_x, max_x = max_x,
                                    min_y = min_y, max_y = max_y)
     },

     # Temp PtE

     temp_PtE = NULL,

     # # longlat
     # longlat = NULL,

     # tolerance

     tolerance = NULL,

     # transform to long lat?

     transform = FALSE,

     # edge_weights

     edge_weights = NULL,

     #
     directional_weights = NULL,

     set_first_weights = function(weights = rep(1, self$nE)){
       if(is.null(weights)){
         weights <- rep(1, self$nE)
       }
       if(!is.vector(weights) && !is.data.frame(weights)){
         stop("'weights' must be either a vector or a data.frame!")
       }

       if(is.vector(weights)){
         if ( (length(weights) != 1) && (length(weights) != self$nE)){
           stop(paste0("The length of 'weights' must be either 1 or ", self$nE))
         }
         if(length(weights)==1){
           private$edge_weights <- rep(weights, self$nE)
         } else{
           private$edge_weights <- weights
         }
       } else{
         if(nrow(weights) != self$nE){
           stop("The number of rows of weights must be equal to the number of edges!")
         }
         private$edge_weights <- weights
       }

     }

   ))

#' Update an older version metric graph to the current package version
#'
#' @description This function creates a new metric_graph object from an existing one,
#' preserving all data, edge weights, mesh, distances, and other components while
#' ensuring compatibility with the current package version. The new graph is created
#' with minimal changes by disabling merges and other transformations.
#'
#' @param old_graph A metric_graph object from an older version of the package
#' @param verbose Logical. Print progress messages. Default is TRUE.
#'
#' @return A new metric_graph object compatible with the current package version
#'
#' @details This function is useful when loading metric graphs created with older
#' versions of the MetricGraph package. It ensures that all components (vertices,
#' edges, data, mesh, distances, etc.) are preserved while updating the internal
#' structure to be compatible with the current package version.
#'
#' The function works by:
#' \itemize{
#'   \item Extracting all components from the old graph
#'   \item Creating a new graph with settings that minimize structural changes
#'   \item Restoring all computed components (mesh, distances, etc.)
#'   \item Re-adding observation data if present
#' }
#'
#' @examples
#' \dontrun{
#' # Load an old graph object
#' old_graph <- readRDS("old_graph.rds")
#'
#' # Update to current version
#' new_graph <- update_graph(old_graph)
#'
#' # Or use the method directly
#' new_graph <- old_graph$update_graph()
#' }
#'
#' @export
update_graph <- function(old_graph, verbose = TRUE) {

# Check if input is a metric_graph object
if (!inherits(old_graph, "metric_graph")) {
stop("Input must be a metric_graph object")
}

# For older graphs without the method, implement it directly
if (verbose) {
message("Updating metric graph to current package version...")
}

# Extract all components from the current graph
old_V <- old_graph$V
old_E <- old_graph$E
old_edges <- old_graph$edges
old_edge_lengths <- old_graph$edge_lengths

# Extract edge weights if they exist
old_edge_weights <- NULL

if (!is.null(old_graph$.__enclos_env__$private$edge_weights)) {
tryCatch({
old_edge_weights <- old_graph$get_edge_weights(data.frame = TRUE)
}, error = function(e) {
if (verbose) message("Could not extract edge weights, using defaults")
})
}

# Extract data if it exists
old_data <- NULL
if (!is.null(old_graph$.__enclos_env__$private$data)) {
tryCatch({
old_data <- old_graph$get_data(format = "list")
}, error = function(e) {
if (verbose) message("Could not extract data, skipping")
})
}

# Extract other private components safely
private_env <- old_graph$.__enclos_env__$private
old_longlat <- if (!is.null(private_env$longlat)) private_env$longlat else NULL
old_crs <- if (!is.null(private_env$crs)) private_env$crs else NULL
old_proj4string <- if (!is.null(private_env$proj4string)) private_env$proj4string else NULL
old_length_unit <- if (!is.null(private_env$length_unit)) private_env$length_unit else NULL
old_vertex_unit <- if (!is.null(private_env$vertex_unit)) private_env$vertex_unit else NULL
old_which_longlat <- if (!is.null(private_env$which_longlat)) private_env$which_longlat else "sp"

# Extract directional weight functions if they exist
old_dir_weights_in <- old_graph$DirectionalWeightFunction_in
old_dir_weights_out <- old_graph$DirectionalWeightFunction_out

if (verbose) {
message("Creating new graph with minimal changes...")
}

# Create new graph with settings that minimize changes
new_graph <- metric_graph$new(
V = old_V,
E = old_E,
edge_weights = old_edge_weights,
longlat = old_longlat,
crs = old_crs,
proj4string = old_proj4string,
vertex_unit = old_vertex_unit,
length_unit = old_length_unit,
which_longlat = old_which_longlat,
# Critical settings to minimize changes
perform_merges = FALSE,           # No merges
remove_circles = FALSE,           # Don't remove circles
remove_deg2 = FALSE,             # Don't remove degree-2 vertices
merge_close_vertices = FALSE,     # Don't merge close vertices
check_connected = FALSE,          # Skip connectivity check
auto_remove_point_edges = FALSE,  # Don't remove point edges
tolerance = list(vertex_vertex = 0, vertex_edge = 0, edge_edge = 0), # Zero tolerances
verbose = if (verbose) 1 else 0
)

# Manually set edges and edge_lengths to preserve exact structure
if (!is.null(old_edges)) {
new_graph$edges <- old_edges
}

if (!is.null(old_edge_lengths)) {
new_graph$edge_lengths <- old_edge_lengths
}

# Set directional weight functions if they existed
if (!is.null(old_dir_weights_in)) {
new_graph$DirectionalWeightFunction_in <- old_dir_weights_in
}

if (!is.null(old_dir_weights_out)) {
new_graph$DirectionalWeightFunction_out <- old_dir_weights_out
}

# Add data if it existed
if (!is.null(old_data)) {
if (verbose) {
message("Adding observation data...")
}

tryCatch({
internal_cols <- c(".edge_number", ".distance_on_edge")
old_data[internal_cols] <- NULL
if(inherits(old_data, "metric_graph_data")){
class(old_data) <- setdiff(class(old_data), "metric_graph_data")
}

# Convert to sf object if CRS is available
if(!is.null(old_crs) && all(c(".coord_x", ".coord_y") %in% names(old_data))) {
old_data_df <- as.data.frame(old_data)
old_data <- sf::st_as_sf(
old_data_df,
coords = c(".coord_x", ".coord_y"),
crs = old_crs
)
}

# Add observations
new_graph$add_observations(
data = old_data,
coord_x = ".coord_x",
coord_y = ".coord_y",
data_coords = "spatial",
group = ".group",
verbose = if (verbose) 1 else 0
)
}, error = function(e) {
if (verbose) message("Could not restore observation data: ", e$message)
})
}

# Restore computed components if they existed
if (verbose) {
message("Restoring computed components...")
}

# Restore mesh if it existed
if (!is.null(old_graph$mesh)) {
if (verbose) {
message("Restoring mesh...")
}
new_graph$mesh <- old_graph$mesh
}

# Restore geodesic distances if they existed
if (!is.null(old_graph$geo_dist)) {
if (verbose) {
message("Restoring geodesic distances...")
}
new_graph$geo_dist <- old_graph$geo_dist
}

# Restore resistance distances if they existed
if (!is.null(old_graph$res_dist)) {
if (verbose) {
message("Restoring resistance distances...")
}
new_graph$res_dist <- old_graph$res_dist
}

# Restore Laplacian if it existed
if (!is.null(old_graph$Laplacian)) {
if (verbose) {
message("Restoring Laplacian matrix...")
}
new_graph$Laplacian <- old_graph$Laplacian
}

# Restore constraint matrix and CoB if they existed
if (!is.null(old_graph$C)) {
new_graph$C <- old_graph$C
}
if (!is.null(old_graph$CoB)) {
new_graph$CoB <- old_graph$CoB
}

# Restore PtV if it existed
if (!is.null(old_graph$PtV)) {
new_graph$PtV <- old_graph$PtV
}

# Restore characteristics if they existed
if (!is.null(old_graph$characteristics)) {
new_graph$characteristics <- old_graph$characteristics
}

# Restore vertices with attributes if they existed
if (!is.null(old_graph$vertices)) {
new_graph$vertices <- old_graph$vertices
}

if (verbose) {
message("Graph update completed successfully!")
message(sprintf("New graph: %d vertices, %d edges", new_graph$nV, new_graph$nE))
if (!is.null(old_data)) {
message(sprintf("Total observations: %d", length(old_data[[".group"]])))
}
}

return(new_graph)
}
