Drawing tables and arrows connecting them

Viewed 94

I would like to know whether it is possible to draw something like the example below with ggplot2. If not, could you please direct me to an appropriate tool to accomplish that in R? Thanks!

enter image description here

3 Answers

Short answer: Yes, of course it's possible. It depends a bit on what your use case is on how much automatisation you want to put into it. The tricky bit is clearly the arrow bit, and on trying an automated approach it became slightly convoluted, so I'll leave that to you - just showing one principle way to get this in ggplot2.

library(tidyverse)
ls_tbl <- replicate(3, data.frame(label = paste0("Field", 5:1)), simplify = FALSE)
## make the data frames for tables and rects
ls_df <- lapply(seq_along(ls_tbl), function(i){
  df <- rbind(ls_tbl[[i]], paste0("Table", i))
  df$y <- seq_len(nrow(df))
  df$x <- i
  df_rect <- data.frame(xmin = i-.2, xmax = i+.2, ymin = min(df$y)-.5, ymax = max(df$y)+.5)
  y_seg <-  (df$y[length(df$y)] + df$y[length(df$y)-1])/2
  df_seg <- data.frame(x = i-.2, xend = i+.2, y =y_seg, yend = y_seg)
  setNames(list(df, df_rect, df_seg), c("text", "rect", "seg"))
})
## draw arrows, this can be automated based on the position of fields and tables
## that's not suuuuper straight forward, so I won't do that here
arrow_df <- data.frame(x = c(1, 3), xend = rep(2, 2), y = c(5, 5), yend = c(2, 4)) %>%
  mutate(x = ifelse(xend > x, x + .2, x - .2), 
         xend = ifelse(xend > x, xend- .2, xend + .2))

## now plotting fun
ggplot() +
  geom_rect(data = bind_rows(map(ls_df, "rect")), color = "black", fill = NA,
            aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax)) +
  geom_segment(data = bind_rows(map(ls_df, "seg")), aes(x, y, xend = xend, yend = yend))+
  geom_text(data = bind_rows(map(ls_df, "text")), aes(x, y, label = label)) +
  geom_segment(data = arrow_df, arrow = arrow(type = "closed"), 
               aes(x, y, xend = xend, yend = yend)) +
  theme_void()

Created on 2021-12-24 by the reprex package (v2.0.1)

I have meanwhile found a way with DiagrammeR and graphviz ports:

library(DiagrammeR)

grViz("
digraph G {
    graph [layout=neato overlap = true]     
    node [shape=plaintext]

    a [label=<<TABLE BORDER='0' CELLBORDER='1' CELLSPACING='0'>
                           <TR><TD>Table 1</TD></TR>
                           <TR><TD PORT='11'>Field 1</TD></TR>
                           <TR><TD PORT='12'>Field 2</TD></TR>
                           <TR><TD PORT='13'>Field 3</TD></TR>
                           <TR><TD PORT='14'>Field 4</TD></TR>
                           <TR><TD PORT='15'>Field 5</TD></TR>
              </TABLE>> pos = '0,0!'];

    b [label=<<TABLE BORDER='0' CELLBORDER='1' CELLSPACING='0'>
                           <TR><TD>Table 2</TD></TR>
                           <TR><TD PORT='21'>Field 1</TD></TR>
                           <TR><TD PORT='22'>Field 2</TD></TR>
                           <TR><TD PORT='23'>Field 3</TD></TR>
                           <TR><TD PORT='24'>Field 4</TD></TR>
                           <TR><TD PORT='25'>Field 5</TD></TR>
              </TABLE>> pos = '1.5,-0.5!'];

    c [label=<<TABLE BORDER='0' CELLBORDER='1' CELLSPACING='0'>
                           <TR><TD>Table 3</TD></TR>
                           <TR><TD PORT='31'>Field 1</TD></TR>
                           <TR><TD PORT='32'>Field 2</TD></TR>
                           <TR><TD PORT='33'>Field 3</TD></TR>
                           <TR><TD PORT='34'>Field 4</TD></TR>
                           <TR><TD PORT='35'>Field 5</TD></TR>
              </TABLE>> pos = '3,0!'];

    a:11 -> b:21;
    c:31 -> b:24;

}")

enter image description here

You might want to look into the DiagrammeR package, as it has a lot of options for visualizing information like this. So, for example, you could do the following to do something similar to your example:

library(DiagrammeR)

grViz(" 
      digraph CFA {
      a [label = <<u><b>Table 2</b></u> <br/> Field 1 <br/> Field 2 <br/> Field 3 <br/> Field 4 <br/> Field 5>, shape = rectangle]; 

      node [shape = rectangle]
      T1    [label = <<u><b>Table 3</b></u> <br/> Field 1 <br/> Field 2 <br/> Field 3 <br/> Field 4 <br/> Field 5>];
      T2    [label = <<u><b>Table 1</b></u> <br/> Field 1 <br/> Field 2 <br/> Field 3 <br/> Field 4 <br/> Field 5>];

      {rank = same; a T1 T2}

      # Connect nodes with edges and labels
      a -> T1[dir=back]
      T2 -> a[dir=forward]
       }

      ")

Output

enter image description here

You can see Richard Iannone's webpage for more in depth information on how to manipulate the layout, different shapes, etc.

Related