repel plot from contingency table

repel_plot.R

library(ca)
library(ggplot2)
library(ggrepel)
library(stringr)
library(scales)
library(magrittr)
library(factoextra)

repel_ca_from_table <- 
  function(
    tbl, # table to be repelled
    add_legend = F, # whether or not you want annotation included
    which_auto_dim = "col", # if automatic annotation, which it draws from
    dim1_annotate = add_legend,
    dim2_annotate = add_legend,
    dim1_text = NULL,
    dim2_text = NULL,
    row_mass = T,
    col_mass = T,
    mass_scale_factor = 1,
    row_mass_scale_factor = mass_scale_factor,
    col_mass_scale_factor = mass_scale_factor
  )
  {
    
    a <- tbl %>% ca 
    
    b <- summary(a)
    
    c <- 
      rbind.data.frame(
        cbind.data.frame(
          a$rowcoord,
          mass = a$rowmass * row_mass_scale_factor,
          inertia = a$rowinertia,
          variable = "statement"
        ),
        cbind.data.frame(
          a$colcoord,
          mass = a$colmass * col_mass_scale_factor,
          inertia =  a$colinertia,
          variable = "category"
        )
      ) %>% 
      mutate(label = rownames(.)) 

    c[c$variable == "statement", ]$mass <- rescale(c[c$variable == "statement", ]$mass)
    c[c$variable == "category", ]$mass <- rescale(c[c$variable == "category", ]$mass)

    if(row_mass == F && col_mass == F)
      c$mass <- 1

    if(row_mass == F)
      c[c$variable == "statement", ]$mass <- 1

    if(col_mass == F)
      c[c$variable == "category", ]$mass <- 1

    d <- c %>% 
      dplyr::select(starts_with("Dim"))

    # e <- d * (b$scree[, 3] / 100)

    f <- cbind.data.frame(
      d[, 1:2],
      c$mass,
      c$inertia,
      c$variable,
      c$label
    ) %>% 
      set_colnames(c("Dim1","Dim2", "mass", "inertia",
                     "variable","label")) 
    
    if(add_legend == T)
    {
      dim1 <- fviz_contrib(a, choice = which_auto_dim, axes = 1) %>% 
        use_series(data) %>% 
        mutate(total = sapply(1:nrow(.), function(x) sum(.$val[1:x]))) %>% 
        mutate(total = total - val)
      dim2 <- fviz_contrib(a, choice = which_auto_dim, axes = 2)%>% 
        use_series(data) %>% 
        mutate(total = sapply(1:nrow(.), function(x) sum(.$val[1:x]))) %>% 
        mutate(total = total - val)
      
      top_dim1 <- 
        dim1 %>% 
        filter(total < 80) %>% 
        use_series(name) 
      
      top_dim1 <- 
        top_dim1[1:2] %>% 
        as.character %>% 
        paste(collapse = " // ")
      
      top_dim2 <- 
        dim2 %>% 
        filter(total < 80)  %>% 
        use_series(name) 
      
       top_dim2 <- 
        top_dim2[1:2] %>% 
        as.character %>% 
        paste(collapse = " // ")
    }
    
    if(!is.null(dim1_text)) top_dim1 <- dim1_text
    if(!is.null(dim2_text)) top_dim2 <- dim2_text
    
    p <- ggplot(f, 
           aes(Dim1, Dim2, 
               color = variable, 
               alpha = mass,
               size = mass,
               label = label %>% str_wrap(width=15))) +
      geom_label_repel(family = "Consolas") +
      theme(legend.position = "none", axis.line = element_blank(), 
            axis.ticks = element_blank(), axis.title.x = element_blank(),
            axis.title.y = element_blank(), axis.text.x = element_blank(),
            axis.text.y = element_blank(),
            text = element_text(family = "Consolas", hjust = 0)) +
      scale_color_manual(values = c("black", "slateblue"))
    
    if(dim1_annotate == T | !is.null(dim1_text))
    { 
      p <- p +
        ggplot2::annotate("segment", x = min(f$Dim1), 
                         xend = min(f$Dim1) + 0.5, y = min(f$Dim2) - 1, 
                         yend = min(f$Dim2) - 1, color = "black", size = 0.75, 
                     arrow = arrow(angle = 25, length = unit(0.2, "cm"))) + 
        ggplot2::annotate("text", label = top_dim1, x = min(f$Dim1), y = min(f$Dim2) - 1.2, 
                   color = "black", hjust = 0, family = "Consolas")
      
    }
    if(dim2_annotate == T | !is.null(dim2_text))
    {
       p <- p + 
         ggplot2::annotate("segment", x = min(f$Dim1)-0.1, 
                         xend = min(f$Dim1)-0.1, y = min(f$Dim2)-1, 
                         yend = min(f$Dim2) - 0.5, color = "black", size = 0.75, 
                     arrow = arrow(angle = 25, length = unit(0.2, "cm"))) + 
        ggplot2::annotate("text", label = top_dim2, x = min(f$Dim1)-0.2, y = min(f$Dim2) - 1, 
                   color = "black", hjust = 0, angle = 90, family = "Consolas")
    }
     
    p <- p + coord_fixed(ratio = b$scree[2, 3] / b$scree[1, 3])   
    return(p)
  }

repel_plot_mca.R

library(ca)
library(ggplot2)
library(ggrepel)
library(stringr)
library(scales)
library(magrittr)
library(FactoMineR)
library(factoextra)

repel_mca_from_table <- 
  function(
    tbl, # table to be repelled
    add_legend = F, # whether or not you want annotation included
    which_auto_dim = "col", # if automatic annotation, which it draws from
    dim1_annotate = add_legend,
    dim2_annotate = add_legend,
    dim1_text = NULL,
    dim2_text = NULL
  )
  {
    
    a <- tbl %>% MCA
    
    coords <- 
      dist(a$var$coord) %>% 
      cmdscale
    
    group <- c(
      rep("1", length(unique(tbl[, 1]))),
      rep("2", length(unique(tbl[, 2]))),
      rep("3", length(unique(tbl[, 3])))
    )
    
    c <- 
      cbind.data.frame(
        coords,
        variable = group
      ) %>% 
      set_colnames(c("Dim1", "Dim2", "variable")) %>% 
      mutate(label = rownames(.))
    
    if(!is.null(dim1_text)) top_dim1 <- dim1_text
    if(!is.null(dim2_text)) top_dim2 <- dim2_text
    
    p <- ggplot(c, 
           aes(Dim1, Dim2, 
               color = variable,
               label = label %>% str_wrap(width=15))) +
      geom_label_repel(family = "Consolas", 
                         size = 3) +
      theme(legend.position = "none", axis.line = element_blank(), 
            axis.ticks = element_blank(), axis.title.x = element_blank(),
            axis.title.y = element_blank(), axis.text.x = element_blank(),
            axis.text.y = element_blank(),
            text = element_text(family = "Consolas", hjust = 0)) +
      scale_color_manual(values = c("black", "slateblue", "deeppink3"))
    
    if(dim1_annotate == T | !is.null(dim1_text))
    { 
      p <- p +
        ggplot2::annotate("segment", x = min(f$Dim1), 
                         xend = min(f$Dim1) + 0.5, y = min(f$Dim2) - 1, 
                         yend = min(f$Dim2) - 1, color = "black", size = 0.75, 
                     arrow = arrow(angle = 25, length = unit(0.2, "cm"))) + 
        ggplot2::annotate("text", label = top_dim1, x = min(f$Dim1), y = min(f$Dim2) - 1.2, 
                   color = "black", hjust = 0, family = "Consolas")
      
    }
    if(dim2_annotate == T | !is.null(dim2_text))
    {
       p <- p + 
         ggplot2::annotate("segment", x = min(f$Dim1)-0.1, 
                         xend = min(f$Dim1)-0.1, y = min(f$Dim2)-1, 
                         yend = min(f$Dim2) - 0.5, color = "black", size = 0.75, 
                     arrow = arrow(angle = 25, length = unit(0.2, "cm"))) + 
        ggplot2::annotate("text", label = top_dim2, x = min(f$Dim1)-0.2, y = min(f$Dim2) - 1, 
                   color = "black", hjust = 0, angle = 90, family = "Consolas")
    }
        
    return(p)
  }