3

I have the following undirected graph (picture) that contains a cycle or a Hamiltonian path of length |V|= 8. The cycle (path) with no repeated edges and vertices is the red line. The adjacency matrix is :

A B C D E F G H
A 0 1 0 1 1 0 0 0
B 1 0 1 0 0 1 0 0
C 0 1 0 1 0 0 0 1
D 1 0 1 0 0 0 1 0
E 1 0 0 0 0 1 1 0
F 0 1 0 0 1 0 0 1
G 0 0 0 1 1 0 0 1
H 0 0 1 0 0 1 1 0

How can I plot this graph in R ?

Ham = matrix(c(0,1,0,1,1,0,0,0,
             1,0,1,0,0,1,0,0,
             0,1,0,1,0,0,0,1,
             1,0,1,0,0,0,1,0,
             1,0,0,0,0,1,1,0,
             0,1,0,0,1,0,0,1,
             0,0,0,1,1,0,0,1,
             0,0,1,0,0,1,1,0),8,8)
Ham

enter image description here

ThomasIsCoding
  • 96,636
  • 9
  • 24
  • 81
Homer Jay Simpson
  • 1,043
  • 6
  • 19

3 Answers3

3

Update

If you need only one of all the Hamilton circles, you can try graph.subisomorphic.lad (thanks for the advice from @Szabolcs), which speeds up a lot if you don't need to list out all the possibilities, e.g.,

g <- graph_from_adjacency_matrix(Ham, "undirected")
es <- graph.subisomorphic.lad(make_ring(vcount(g)), g)$map
g %>%
  set_edge_attr("color", value = "black") %>%
  set_edge_attr("color",
    get.edge.ids(g, c(rbind(es, c(es[-1], es[1])))),
    value = "red"
  ) %>%
  plot()

If you want to find all Hamilton circles:

You should be aware of the fact that the Hamilton circle is isomorphic to a ring consisting of all vertices, so we can resort to subgraph_isomorphisms to find out all those kinds of "rings", e.g.,

g <- graph_from_adjacency_matrix(Ham, "undirected")
lst <- lapply(
  subgraph_isomorphisms(make_ring(vcount(g)), g),
  function(es) {
    g %>%
      set_edge_attr("color", value = "black") %>%
      set_edge_attr("color",
        get.edge.ids(g, c(rbind(es, c(es[-1], es[1])))),
        value = "red"
      )
  }
)

where lst is a list of graphs, and you can see

  1. plot(lst[[1]] gives enter image description here
  2. plot(lst[[2]] gives enter image description here

and so on so forth.

ThomasIsCoding
  • 96,636
  • 9
  • 24
  • 81
  • 1
    Use `graph.subisomorphic.lad` instead, as this function is capable for returning only the first mapping that is found. Listing all mappings will typically take much, _much_ longer. – Szabolcs Dec 01 '22 at 20:53
  • 1
    @Szabolcs That makes sense! Thanks for the info! My first to know `graph.subisomorphic.lad` :) – ThomasIsCoding Dec 01 '22 at 21:00
  • 2
    I opened an issue for this: https://github.com/igraph/rigraph/issues/588 (feel free to open issues whenever you come across something fishy). I knew that this had to exist only because I know what the underlying C/igraph function is. – Szabolcs Dec 01 '22 at 21:02
1

Given the red line and the picture, calculate the graph with edges in order of occurrence.

## Make edge lists to prevent igraph from rearranging the edges.
elh <- as_edgelist(make_graph( ~ A-B-F-E-G-H-C-D) )
elr <- as_edgelist(make_graph( ~ D-A, A-E, B-C, F-H, G-D) )
g1  <- graph_from_edgelist(rbind(elh, elr), directed=FALSE )

Set the color to the first eight edges as red and otherwise black.

E(g1)$label         <- paste("a", seq(ecount(g1)), sep = "")
E(g1)[ (1:8)]$color <- "red" 
E(g1)[-(1:8)]$color <- "black"

Map vertices to x,y coordinates.

layout_as_homer <- matrix( c( -4,4, 4,4,  4,-4, -4,-4   # A:D.
                            , -2,2, 2,2, -2,-2,  2,-2   # E:H.
                           )
                         , ncol=2, byrow=TRUE
                   )

Reorder vertices in alphabetical order and plot.

g2 <- permute(g1, match(V(g1)$name, LETTERS[1:8]))
plot(g2, layout=layout_as_homer, edge.width=3, edge.label.cex = 1.5)
g2[] # adjacency matrix

Output.

8 x 8 sparse Matrix of class "dgCMatrix"
  A B C D E F G H
A . 1 . 1 1 . . .
B 1 . 1 . . 1 . .
C . 1 . 1 . . . 1
D 1 . 1 . . . 1 .
E 1 . . . . 1 1 .
F . 1 . . 1 . . 1
G . . . 1 1 . . 1
H . . 1 . . 1 1 .

Planar layout of hyper graph Q3.

Planar representation of hyper graph Q3

clp
  • 1,098
  • 5
  • 11
1

An alternative is not to rely on igraphs internal ordering.

q3 <- make_graph(~ A-B-C-D-A
                 , a-b-c-d-a
                 , A-a, B-b, C-c, D-d
      )
q3$main     =  "Planar layout of hyper graph Q3"
E(q3)$label <- paste("a", seq(ecount(q3)), sep = "")

hp <- c( "A","B", "B","b", "b","a", "a","d"
       , "d","c", "c","C", "C","D", "D","A"
       )

E(q3)[ get.edge.ids(q3, hp)]$color <- "red"
E(q3)[-get.edge.ids(q3, hp)]$color <- "black"

layout_as_homer <- matrix( c( -4,4, 4,4,  4,-4, -4,-4   # A:D
                            , -2,2, 2,2,  2,-2, -2,-2   # a:d
                           )
                         , ncol=2, byrow=TRUE
                   )            
plot(q3, layout=layout_as_homer, edge.width=3, edge.label.cex = 1.5)
q3[]
clp
  • 1,098
  • 5
  • 11