Nothing
#' Calculate line tension and strain from the topology and node embeddings for high dimensional feature networks
#'
#' This function calculates the line tension and strain characteristics for the edges in a graph.
#' It is called by default by all the embedding functions (SETSe_*) but is included here for completeness.
#'
#' @param g An igraph object of the network.
#' @param height_embeddings_df A data frame. This is the results of Create_stabilised_blocks or Find_network_balance
#' @param distance A character string. The name of the edge attribute that contains the distance between two nodes. The default is "distance"
#' @param edge_name A character string. The name of the edge attribute that contains the edge name. The default is "edge_name".
#' @param k A character string. The name of the edge attribute that contains the spring coefficient
#'
#' @return The function returns a data frame of 7 columns. These columns are the edge name,
#' the change in elevation, The final distance between the two nodes (the hypotenuse of the original distance and the vertical distance),
#' the spring constant k, the edge tension, the edge strain, and the mean elevation.
#
#' @details Whilst the node embeddings dataframe contains the elevation of the setse algorithm this function produces a data frame that contains the Tension
#' and Strain. The dataframe that is returned contains a substantial amount of line information so reducing the number of variables may be
#' necessary if the data frame will be merged with previously generated data as there could be multiple columns of the same value.
#' This function is called by default at the end of all setse functions
#'
#' @examples
#'
#' g <- biconnected_network %>%
#' prepare_edges(., k = 1000) %>%
#' #prepare the continuous features as normal
#' prepare_continuous_force(., node_names = "name", force_var = "force") %>%
#' #prepare the categorical features as normal
#' prepare_categorical_force(., node_names = "name", force_var = "group")
#'
#' #embed them using the high dimensional function
#' two_dimensional_embeddings <- setse_auto_hd(g, force = c("group_A", "force"), k = "weight")
#'
#' edge_embeddings_df <- calc_tension_strain_hd(g, two_dimensional_embeddings$node_embeddings)
#' all.equal(two_dimensional_embeddings$edge_embeddings, edge_embeddings_df)
#'
#'
#' @export
calc_tension_strain_hd <- function(g, height_embeddings_df, distance = "distance", edge_name = "edge_name", k = "k"){
#convert the character strings to symbols
#afterwords the symbols can be evaluated by curly curly {{}}
#Really replacing the sym function with inline .data[[]] would be better but I'll have to leave that for another time
distance <- rlang::sym(distance)
edge_name <- rlang::sym(edge_name)
k <- rlang::sym(k)
#get the edge list for the network
temp <- igraph::as_data_frame(g, what = "edges") %>%
tibble::as_tibble(.)
#get the embedded node elevation across all dimensions
elevation_df <- height_embeddings_df %>% dplyr::select(node, dplyr::starts_with("elevation"))
#merge the edge list and the node elevations for both the from and to nodes
#The columns are also re-named for clarity
#This is a very slow way of doing this. Match would be much faster however I can't be bothered right now
#and I will change if this becomes a speed choke point
temp <- temp %>%
dplyr::left_join(.,
elevation_df %>% dplyr::rename_with(., .fn = ~paste0("from_",.), .cols = -node)
, by = c("from"= "node")) %>%
dplyr::left_join(.,
elevation_df %>% dplyr::rename_with(., .fn = ~paste0("to_",.), .cols = -node)
, by = c("to"= "node"))
from_elevation_df <- temp %>% dplyr::select(dplyr::starts_with("from_elevation"))
to_elevation_df <- temp %>% dplyr::select(dplyr::starts_with("to_elevation"))
diff_df <- {from_elevation_df - to_elevation_df}
names(diff_df) <- gsub("^from_", "elev_diff_", names(diff_df))
Out <- temp %>%
dplyr::bind_cols(diff_df) %>% #change in elevation in each axis
dplyr::mutate(
mean_e = sqrt(rowSums((diff_df/2)^2)), #mean elevation for the edge. simply the mean elevation for the nodes at both ends
H = sqrt(rowSums(diff_df^2) +({{distance}})^2), #The total length of the edge. This is the hypotenuse of the triangle
tension = {{k}}*(H-{{distance}}), #The tension in the edge following Hooks law
strain = (H-{{distance}})/{{distance}} #The mechanical strain of the edge
) %>%
dplyr::select({{edge_name}}, dplyr::starts_with("elev_diff_"), mean_e, H, k, tension, strain)
return(Out)
}
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.