Writing a BFS Search Algorithm by Hand

I am trying to learn more about search algorithms for network graphs. To illustrate this, I created the following example.

Step 1: Suppose there are 100 countries (country_1....country_100) that are randomly connected to each other

set.seed(123)


library(igraph)


countries <- paste0("country_", 1:100)


g <- make_empty_graph(100)


num_edges <- 200
edge_list <- sample(countries, size = num_edges * 2, replace = TRUE)
edge_list <- matrix(edge_list, ncol = 2, byrow = TRUE)
g <- graph_from_edgelist(edge_list, directed = FALSE)


V(g)$name <- countries

plot(g, vertex.label.cex = 0.7, vertex.label.color = "black", vertex.label.dist = 2)

Step 2: Now, suppose 20 people (person_A...person_T) live in these countries (each country can only have at most one person - 80 of the countries will be empty):

edge_list <- as_edgelist(g)

df <- as.data.frame(edge_list)

colnames(df) <- c("from", "to")

people <- paste0("person_", LETTERS[1:20])

assignment <- sample(countries, size = length(people), replace = FALSE)
names(assignment) <- people

df2 <- data.frame(country = countries)


df2$person <- ifelse(df2$country %in% assignment, names(assignment)[match(df2$country, assignment)], "empty")

Step 3: As an optional step, we can visualize the results:

library(visNetwork)

df2$color <- ifelse(df2$person == "empty", "grey", "red")

df2$label <- ifelse(df2$person == "empty", df2$country, paste0(df2$person, "\n", df2$country))

nodes <- data.frame(id = df2$country, label = df2$label, color = df2$color)

edges <- df

visNetwork(nodes, edges) %>% 
    visInteraction(navigationButtons = TRUE)

My Problem: Suppose we take "person_A" - I want to find out who is the nearest person to "person_A" and which country this person lives in. I am interested in learning how to write a BFS algorithm for this problem by hand - for example: take person_A and search everyone in a radius of degree1 - if no one is found, now search everyone in a radius of degree2 ... continue until you find the first person(s).

I know how to use a pre-built implementation of this algorithm :

adj_matrix <- as_adjacency_matrix(g)

diag(adj_matrix) <- 0

shortest_paths <- shortest.paths(g)

df2_filtered <- subset(df2, person != "empty")
selected_countries <- intersect(rownames(shortest_paths), df2_filtered$country)

filtered_paths <- shortest_paths[selected_countries, selected_countries]

item = df2[df2$person %in% c("person_A"), ]

#answer (exclude distance = 0, i.e. the same country itself)
sort(filtered_paths[rownames(filtered_paths) == item$country, ])[2]

Can someone please show me how I could write a search algorithm (by hand) to accomplish this task which starts with a person's name - and then prints the results of the search at each step until a person is found?

Background/Overview

The big picture idea of Breadth First Search is that you start at a point in a graph (let's call it a), and you add all of the neighbours to a list of unexplored points (which we'll call the frontier). You then go through the list, one by one, and for each point, you add the unseen neighbours of that point to the end of the queue, and so on, until you either find the point you are looking for (which could be a specific point b, or just any point which meets a certain criteria you've set), or alternatively you run out of places (because you've explored everywhere).

Tidying the data

First, I'm going to clean up the data a bit. I create a dataframe which is just the people that exist (no empties):

people_df <- df2 %>% 
    filter(person != "empty") %>%
    select(person, country)

I then turn the country connections dataframe df into a dataframe neighbours_df which gives me the neighbours of each point. The way the dataframe was structured, it has (for example) a row:

> from to
> country_31 country_79
but none for the reverse, i.e.

> from to
> country_79 country_31

So I switch the columns, add the reversed ones onto the end of the first one, and group each point's neighbours into a list, to make it tidier:

reversed_df <- df %>% 
    mutate(new_from = to, to = from, from = new_from) %>% 
    select(from, to)

neighbours_df <- df %>% 
    bind_rows(reversed_df) %>% 
    filter(from != to) %>%
    group_by(from) %>%
    summarise(to = list(to))
 	
#          from                            to
# 1    country_1   c("country_8", "country_92")

Implementation

breadth_first_search <- function(person, neighbours_df, people_df) {
  # get the country of the person
    starting_country <- people_df$country[people_df$person == person]

  # initialise the visited list 
    visited <- c()

  # initialise the frontier with the starting point
    frontier <- list()
    frontier[[starting_country]] <- 0

  # initialise distance from start variable (so we can print how far we are from the start)
    distance_from_start <- 0

  # while the frontier is not empty
    while (length(frontier) > 0) {

      # get the first element of the frontier
        current <- names(frontier)[1]

      # get the distance from current to start
        distance_from_start <- frontier[[1]]
      
      print(paste0("Current point: ", current, " (", distance_from_start, " steps from start)"))

      # remove the first element of the frontier (the one we just selected)
        frontier <- frontier[-1]

        # if the current point is in the country column of our `people_df` (i.e. someone lives there), and it's not the starting country, return the person who lives there
        if (current %in% people_df$country && current != starting_country) {
          found_person <- people_df$person[people_df$country == current]
          print(paste0("Found person: ", found_person, ", " , distance_from_start , " steps from start, in country ", current))
            return(found_person)
        }

        # add the current point to the visited list
        visited <- c(visited, current)

        # get the neighbors of the current point
        neighbs <- neighbours_df$to[neighbours_df$from == current][[1]]

        # add the neighbors to the frontier if they haven't been visited already
        neighbs <- neighbs[!neighbs %in% visited]
        frontier <- c(frontier, setNames(rep(distance_from_start + 1, length(neighbs)), neighbs))
        }
    # if we search through all the points, and didn't find anyone, return NA
    return(NA)
}

print(breadth_first_search("person_R", neighbours_df, people_df))
# [1] "person_J"

References / More Information

I'm cribbed fairly extensively from this article by Red Blob Games (the companion to this other piece, which provides a great introduction to how breadth first search (and other similar graph search algorithms, like A* work). If you would like a more comprehensive take on how they work, the drawbacks and strengths of BFS, and/or want to play around with some interactive things, I would recommend checking that out!

Update

I don't think you are looking for BFS but just the ego networks defined by the nearest valid neighbors. Probably you can try the code below

f <- function(p, df = df2, graph = g) {
    v <- df %>%
        filter(person == p) %>%
        select(country) %>%
        pluck(1)

    nulls <- df2 %>%
        filter(person == "empty") %>%
        select(country) %>%
        pluck(1)

    pers <- df2 %>%
        filter(person != "empty")

    d <- distances(graph, v, setdiff(names(V(graph)), c(v, nulls)))
    split(pers$person[match(colnames(d), pers$country)], d)
}

such that

> f("person_A")
$`2`
[1] "person_N" "person_K"

$`3`
[1] "person_C" "person_E" "person_I"

$`4`
[1] "person_P" "person_M" "person_Q"

$`5`
[1] "person_J" "person_S" "person_O" "person_T" "person_G" "person_F" "person_R"
[8] "person_H"

$`6`
[1] "person_L"

$`7`
[1] "person_B"


> f("person_B")
$`2`
[1] "person_F"

$`3`
[1] "person_S" "person_G"

$`4`
[1] "person_J" "person_P" "person_H"

$`5`
[1] "person_M" "person_N" "person_K" "person_T" "person_R" "person_E" "person_L"

$`6`
[1] "person_Q" "person_O" "person_C" "person_I"

$`7`
[1] "person_A"


> f("person_C")
$`1`
[1] "person_N"

$`3`
[1] "person_P" "person_M" "person_A" "person_K"

$`4`
[1] "person_J" "person_Q" "person_O" "person_G" "person_R" "person_H" "person_E"
[8] "person_I"

$`5`
[1] "person_S" "person_T" "person_F" "person_L"

$`6`
[1] "person_B"

Previous

Not sure about your motivation and/or necessity of implementing the BFS algorithm by yourself, but I guess it is worthy to try bfs from igraph (since you are using igraph anyway in your question)

f <- function(p, df = df2, graph = g) {
    v <- df %>%
        filter(person == p) %>%
        select(country) %>%
        pluck(1)

    df %>%
        arrange(match(country, names(bfs(graph, v)$order))) %>%
        filter(person != "empty") %>%
        slice(2) %>%
        select(person) %>%
        pluck(1)
}

such that

> f("person_A")
[1] "person_N"

> f("person_B")
[1] "person_F"

> f("person_C")
[1] "person_N"