inst/doc/separate-peels-quintet.R

## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----results = 'hide', message=FALSE------------------------------------------
library(rsetse)
library(dplyr)
library(tidyr)
library(ggplot2)
library(purrr)
library(ggraph)
library(igraph)

## ----results = 'hide', message=FALSE------------------------------------------
#This is a bit of a contorted way to get 5 networks into the same plot as 
#igraph::union does not also merge attributes
set.seed(1263)
peels_networks <- 1:5 %>%
  map(~generate_peels_network(LETTERS[.x]) %>%
        #The nodes in all the networks are numbered 1:40, this line ensures
        #each class has distinct node names
        set.vertex.attribute(., "type", value = paste("type", LETTERS[.x])) %>%
        set.vertex.attribute(., "name",
                             value = as.numeric(get.vertex.attribute(., "name"))+(.x-1)*40) %>%
      #The networks are going to be joined into a single network so need to be converted into a
      #list of dataframes
      igraph::as_data_frame(., what = "both")
      ) %>%
  #the list is now two elements long and made up of a edge and vertex part
  transpose() %>%
  #join the elements from each part of the list into dataframes
  map(~bind_rows(.x)) %>%
  {graph_from_data_frame(d = .$edges, directed = FALSE, vertices = .$vertices)}



ggraph(peels_networks) +
  geom_edge_fan()+
  geom_node_point(aes(fill = class, shape = grepl("1", sub_class)), size=3) +
  scale_shape_manual(values=c(21, 24)) +
  guides(fill = "none", shape = "none") +
  facet_nodes(~type, scale = "free")


## -----------------------------------------------------------------------------
set.seed(4563)
all_peels <- LETTERS[1:5] %>% map(~{
  
  peel_type <- .x
  
  out <- 1:10 %>% map(~{
    
    generate_peels_network(peel_type)
    
    })
  
})


## ----message = FALSE----------------------------------------------------------

#The first map cycles though each of the graph types from A to E
all_embeddings <- 1:5 %>% map(~{

temp_list <- all_peels[[.x]]
  
node_type = LETTERS[.x]
#The inner map embeds each of the 10 networks of that type
out <- 1:10 %>%
  map(~{
    id_number <- .x
    g <- temp_list[[.x]]
    embeddings_data <-g%>%
      #standard edge preparation is fine as k is included in the dataset
      prepare_edges() %>%
      #k has already been generated by the generate_peels_network function 
      prepare_categorical_force(., node_names = "name",
                     force_var = "class") %>%
      #The system is considered converged when the static force is 1/10000 of 
      #absolute sum of the force exerted by all the nodes
    setse_auto(force = "class_A", tol = sum(abs(vertex_attr(., "class_A")))/10000) 
    #create the aggregated node details
    #embeddings_data$node_details <- create_node_details(g, embeddings_data)
    embeddings_data$node_details <- create_node_edge_df( embeddings_data)
    
    element_names <- names(embeddings_data)
    #add the id data onto each df in the list
    embeddings_data <- 1:length(embeddings_data) %>%
      map(~embeddings_data[[.x]] %>% mutate(type = node_type,
                         id = id_number))
    
    names(embeddings_data) <- element_names
    
    return(embeddings_data)
  })

return(out)
  
})

#the list of embedding networks is then transposed and all the dataframes 
#representing the networks are made into a list of 5 dataframes using bind_rows
all_embeddings <-all_embeddings %>%
  flatten() %>%
  transpose() %>%
  map(bind_rows)



## ----message = FALSE----------------------------------------------------------



all_embeddings$node_details %>%
  group_by(type, id) %>%
  summarise(mean_tension = mean(tension_mean),
            elevation = sum(abs(elevation))) %>%
  ggplot(aes(x = mean_tension, y = elevation , colour = type)) + geom_point()

Try the rsetse package in your browser

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

rsetse documentation built on June 11, 2021, 5:07 p.m.