Nothing
#' fix elevation to origin
#'
#' Internal function. This function makes the elevation of the different blocks all relative to the same fixed point,
#' this allows easy use of bi-connected components This is a helper function only.
#'
#' @param relative_blocks a data frame containing the outputs from the
#' @param ArticulationVect The names of the articulation nodes of the network.
#'
#' @details When a network is broken into bi-connected components the elevation of the nodes is relative to the
#' local origin. This means all bi-connected components have there own "center of gravity". This function makes sure
#' all nodes are relative to a fixed point
#' @noRd
fix_elevation_to_origin <- function(relative_blocks, ArticulationVect){
#This is an integer vector of blocks that have been converted to absolute values
#This is one of the growing vectors.
absolute_blocks <- c(0)
#The first block to be made absolute is the origin block indexed at 0
target_blocks <- 0
#The queued articulation nodes.
#These are articulation nodes that have been converted to absolute elevation in at least one of thier blocks
#They can be used to make subsequent blocks absolute
queued_articulation_nodes <- as.numeric(list())
#This vector stores articulation nodes that have already been used,
#This stops the same node being recycled which causes errors
#The vector begins as an empty vector
used_articulation_nodes <- as.numeric(list())
#The block reference number.The origin block is always 0
reference_id <- relative_blocks$Reference_ID
#The node IDs
node_vect <- relative_blocks$node
#A logical vector stating whether node is an articulation vector
articulation_vect <- relative_blocks$Articulation_node
#The node elevation vector. This is converted block by block from relative elevation to
#absolute elevation
elevation_vect <- relative_blocks$elevation
#The while loop continues as long as used articulation nodes vector is smaller than the total number
#of articulation nodes in the network
while(length(used_articulation_nodes) < length(ArticulationVect)){
#while(sum(used_articulation_nodes %in% ArticulationVect) == length(ArticulationVect)){
# while(Art_n != 190){
#add new articulation nodes to the queue
#It has four logical conditions
#1 the nodes must be in the target block
#2 The nodes must be an articulation node
#3 the node cannot already be in the queue
#4 cannot be a node that has already been used
#The removal of previously used articulation nodes is important as all articulation nodes are in the network at least twice.
# not removing later occurrences can lead to leveling errors and crazy results
#The 4th logical constraint is because the target blocks from the previous round also contain the previous rounds
#Art_n node (active node), this means it will be added in again.
#The first round adds the articulation nodes in the origin block to the queue
queued_articulation_nodes <- c(queued_articulation_nodes, node_vect[reference_id %in% target_blocks &
articulation_vect &
!(node_vect %in% queued_articulation_nodes) &
!(node_vect %in% used_articulation_nodes)])
#print(queued_articulation_nodes)
#get the next articulation node in the queue
#This is the active articulation node
Art_n <-queued_articulation_nodes[1] #
#add the current articulation node to the vector of used nodes
used_articulation_nodes <- c(used_articulation_nodes, Art_n)
#print(Art_n)
#subtract art_n relative from all elevation scores
#ass art_n abs to all values
#The blocks that this articulation node is in excluding the current active block
#1 The block is not already absolute
#2 The node is the active articulation node
#Only unique values are used, this is more a security blanket than anything. I don't know if it is necessary
target_blocks <- unique(reference_id[!(reference_id %in% absolute_blocks) & node_vect == Art_n])
#This is the value that the nodes in the target blocks will be adjusted by
#It is the elevation that matches the following conditions
#1 The reference id of the block has to already been adjusted to absolute terms
#2 The node has to be the articulation node being adjusted
elevation_adjust <- unique(elevation_vect[(reference_id %in% absolute_blocks) & node_vect == Art_n])
for(n in target_blocks){
#print(n)
#The local origin is the active articulation node's elevation in the target block
#This is the node which is both
#1 in the target block
#2 the active articulation node
local_origin <- elevation_vect[(reference_id %in% n) & node_vect == Art_n]
#The elevation of all nodes in the target block have the local origin removed to place everything relative to 0
#then the absolute height of the articulation node is added making the entire bi-connected component elevation absolute.
elevation_vect[(reference_id %in% n)] <- elevation_vect[(reference_id %in% n)] - local_origin + elevation_adjust
}
#add to the absolute blocks vector
absolute_blocks <- c(absolute_blocks, target_blocks)
#The active articulation node is removed from the queue
queued_articulation_nodes <- queued_articulation_nodes[-1]
}
#The elevation vector is now absolute and can be inserted back into the original dataframe
relative_blocks$elevation <- elevation_vect
return(relative_blocks)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.