R/plot_network.R

Defines functions plot_network

Documented in plot_network

#' @title Plots of value-edged networks.
#' @description Generates a visualization of a value-edged network.
#'
#' @param sociomatrix A square numeric matrix (sociomatrix) with real valued edges
#'(no NA's).
#' @param threshold The threshold for removing edges from the network in order to
#' calculate the positions for the nodes using the Futcherman-Reingold algorithm.
#' The value is multiplied against max(abs(sociomatrix)) to determine the
#' threshold. Defaults to 0.5.
#' @param save_pdf Logical indicating whether the plot should be saved to a PDF.
#' @param pdf_name The name we would like to give to the output file. Be sure to
#' include a ".pdf" extension.
#' @param output_directory The directory where the user would like to output the
#' PDF if save_pdf == TRUE.
#' @param comparison_network An optional argument providing a second square
#' numeric matrix (sociomatrix) with real valued edges (no NA's) to be visually
#' compared to sociomatrix. The second network will be Procrustes transformed so
#' that it appears most similar without changing the relativel positions of
#' nodes. Defaults to NULL.
#' @param comparison_names An optional string vector of length two providing
#' titles for each of the two networks to be compared. Defaults to NULL.
#' @param seed Optional argument to set the seed for the network layout
#' algorithm so that plots look the same across multiple runs. Defaults to NULL
#' but can be a positive integer (eg. 12345).
#' @param white_background Defaults to FALSE. If TRUE, then network is plotted
#' on a white background with black lettering.
#' @param show_legend Logical indicating whether a legend with extremal edge
#' values should be shown. Defaults to TRUE.
#' @param title The title we wish to give our plot.
#' @param identical_node_positions Logical indicating whether node positions
#' should be fixed to be the same when comparing networks. Defaults to FALSE.
#' @examples
#' set.seed(12345)
#' sociomatrix <- matrix(rnorm(400,0,20),20,20)
#' colnames(sociomatrix) <- rownames(sociomatrix) <- letters[1:20]
#' plot_network(sociomatrix)
#' @export
plot_network <- function(sociomatrix,
                         threshold = 0.5,
                         save_pdf = FALSE,
                         pdf_name = "Test.pdf",
                         output_directory = "./",
                         comparison_network = NULL,
                         comparison_names = NULL,
                         seed = NULL,
                         white_background = FALSE,
                         show_legend = TRUE,
                         title = "",
                         identical_node_positions = FALSE
                         ){

  if (!is.null(seed)) {
    set.seed(seed)
  }

  par(mar = c(1,0,1,0))
  # check input
  if (class(sociomatrix)[1] != "matrix" & class(sociomatrix)[1] != "data.frame") {
    stop("You must provide the network as a numeric matrix.")
  }

  if (nrow(sociomatrix) != ncol(sociomatrix)) {
    stop("You must provide a square matrix.")
  }

  if (white_background) {
    # generate edge colors
    negcolors <- colorRampPalette(c('red','white'))
    poscolors <- colorRampPalette(c('white','blue'))
    negcolors <- negcolors(25)
    poscolors <- poscolors(25)
  } else {
    # generate edge colors
    negcolors <- colorRampPalette(c('red','black'))
    poscolors <- colorRampPalette(c('black','blue'))
    negcolors <- negcolors(25)
    poscolors <- poscolors(25)
  }

  # check to see if we provided a comparison network, and if so, deal with it.
  COMPARISON <- FALSE
  if (!is.null(comparison_network)) {

    if (is.null(comparison_names)) {
      comparison_names <- c("","")
    } else {
      if(length(comparison_names) != 2) {
        stop("You must provide a comparison_names object as a vector containing two strings.")
      }
    }

    # check optional input
    if (class(comparison_network) != "matrix" &
       class(comparison_network) != "data.frame") {
      stop("You must provide the network as a numeric matrix.")
    }

    if (nrow(comparison_network) != ncol(comparison_network)) {
      stop("You must provide a square matrix.")
    }

    if (nrow(comparison_network) != nrow(sociomatrix)) {
      stop("You must provide two matrices with the same dimensions.")
    }
    COMPARISON <- TRUE

    # get the network ready for plotting

    diag(comparison_network) <- 0

    # create temporary matrices that can be altered
    temp <- temp2 <- matrix(comparison_network[,],
                            nrow(comparison_network),
                            ncol(comparison_network))

    # determine the threshold for removing edges
    cutoff <- max(abs(temp))*threshold

    # remove edges
    temp[which(abs(temp ) < cutoff)] <- 0

    # create a network object using adjacency matrix with edges removed
    net3 <- igraph::graph.adjacency(temp - min(c(0,min(c(temp)))) ,mode="directed",
                                   weighted=TRUE,diag=FALSE)

    #create layout with Fuchterman Reingold
    layout_c <- igraph::layout_with_fr(net3, weights = igraph::E(net3)$weight)

    # create a second network object with the un-truncated network
    net4 <- igraph::graph.adjacency(temp2,mode="directed",
                                    weighted=TRUE,diag=FALSE)

    # get an edgelist
    edgelist_c <- igraph::get.edgelist(net4)
    # get the edge weights
    weights_c <- igraph::E(net4)$weight

    # order edgeweights from smallest absolute value to largest
    ordering <- order(abs(weights_c), decreasing = F)
    edgelist_c <- edgelist_c[ordering,]
    weights_c <- weights_c[ordering]

    # generate edge widths
    # negbreaks_c <- seq(min(weights_c), 0, length.out = 26)
    # posbreaks_c <- seq(0, max(weights_c), length.out = 26)
    # widbreaks_c <- seq(0,max(abs(weights_c)),length.out = 50)
    # widths_c <- seq(0,5,length.out = 50)
  }

  diag(sociomatrix) <- 0

  # create temporary matrices that can be altered
  temp <- temp2 <- matrix(sociomatrix[,],nrow(sociomatrix),ncol(sociomatrix))

  # determine the threshold for removing edges
  cutoff <- max(abs(temp))*threshold

  # remove edges
  temp[which(abs(temp ) < cutoff)] <- 0

  # create a network object using adjacency matrix with edges removed
  net <- igraph::graph.adjacency(temp - min(c(0,min(c(temp)))),mode="directed",
                                 weighted=TRUE,diag=FALSE)

  #create layout with Fuchterman Reingold
  layout <- igraph::layout_with_fr(net, weights = igraph::E(net)$weight)

  # create a second network object with the un-truncated network
  net2 <- igraph::graph.adjacency(temp2,mode="directed",
                                 weighted=TRUE,diag=FALSE)

  # get an edgelist
  edgelist <- igraph::get.edgelist(net2)
  # get the edge weights
  weights <- igraph::E(net2)$weight

  # order edgeweights from smallest absolute value to largest
  ordering <-order(abs(weights), decreasing = F)
  edgelist <- edgelist[ordering,]
  weights <- weights[ordering]

  # generate edge widths
  negbreaks <- seq(-max(abs(weights)), 0, length.out = 26)
  posbreaks <- seq(0,max(abs(weights)), length.out = 26)
  widbreaks <- seq(0,max(abs(weights)),length.out = 50)
  widths <- seq(0,5,length.out = 50)

  if (COMPARISON) {
    negbreaks <- seq(-max(abs(c(weights, weights_c))), 0, length.out = 26)
    posbreaks <- seq(0, max(abs(c(weights, weights_c))), length.out = 26)
    widbreaks <- seq(0,max(abs(c(weights, weights_c))),length.out = 50)
    widths <- seq(0,5,length.out = 50)
  }

  if (COMPARISON) {
    if (identical_node_positions) {
      # if we are using the same positions, then just make the layouts identical
      layout_c <- layout
    } else {
      layout_c <- vegan::procrustes(layout, layout_c, scale = F)$Yrot
    }
  }

  ##### If we are saving a PDF
  if(save_pdf) {
    #get current working directory
    cur_directory <- getwd()
    setwd(output_directory)

    # if we are making a comparison, two plots next to eachother
    if (COMPARISON) {
      pdf(file = pdf_name, width = 24, height = 12)
      #start plot
      if (white_background) {
        par(bg = "white", oma = c(1,1,2,1) + 0.1,
            mar = c(0,0.5,1,0.5) + 0.5, xpd=TRUE, mfrow = c(1,2))
        plot(layout,pch = 20, cex = 1, col = "white", axes = F,
             xlab = "", ylab = "", main = comparison_names[1],col.main = "black",
             xlim = c((min(layout[,1])-0.1), (max(layout[,1])+0.1)),
             ylim = c((min(layout[,2])-1.3), (max(layout[,2])+0.5)))
      } else {
        par(bg = "black", oma = c(1,1,2,1) + 0.1,
            mar = c(0,0.5,1,0.5) + 0.5, xpd=TRUE, mfrow = c(1,2))
        plot(layout,pch = 20, cex = 1, col = "black", axes = F,
             xlab = "", ylab = "", main = comparison_names[1],col.main = "white",
             xlim = c((min(layout[,1])-0.1), (max(layout[,1])+0.1)),
             ylim = c((min(layout[,2])-1.3), (max(layout[,2])+0.5)))
      }

      # add in edges
      max_bin <- 1
      min_bin <- 1
      for(i in 1:length(weights)){
        cur1 <- layout[edgelist[i,1],]
        cur2 <- layout[edgelist[i,2],]
        curweight <- weights[i]

        # find edge color
        nf <- TRUE
        counter <- 1
        bin <- 1
        while(nf){
          if(curweight > 0){
            if(posbreaks[counter] >= curweight){
              bin <- counter
              nf <- FALSE
            }
          }else{
            if(negbreaks[counter] >= curweight){
              bin <- counter
              nf <- FALSE
            }
          }
          counter <- counter +1
        }

        # find edge width
        nf <- TRUE
        counter <- 1
        wid <- 1
        while(nf){
          if(widbreaks[counter] >= abs(curweight)){
            wid <- counter
            nf <- FALSE
          }
          counter <- counter +1
        }
        if(curweight > 0){
          lines(c(cur1[1],cur2[1]) , c(cur1[2],cur2[2]),
                col = poscolors[bin], lwd = widths[wid])
          if (bin > max_bin) {
            max_bin <- bin
          }
        }else{
          lines(c(cur1[1],cur2[1]) , c(cur1[2],cur2[2]),
                col = negcolors[bin], lwd = widths[wid])
          if (bin > min_bin) {
            min_bin <- bin
          }
        }
      }
      if (white_background) {
        text(layout,labels = rownames(sociomatrix), col = "black")
        if (show_legend) {
          legend("bottom", inset = 0, title = "Edge Values",title.col = "black",
                 legend = c(round(min(sociomatrix),2), round(max(sociomatrix),2)),
                 fill = c(negcolors[min_bin - 1],
                          poscolors[max_bin - 1]),
                 horiz = T,
                 bg = "white",
                 text.col = "black",
                 box.col = "white")
        }
      } else {
        text(layout,labels = rownames(sociomatrix), col = "white")
        if (show_legend) {
          legend("bottom", inset = 0, title = "Edge Values",title.col = "white",
                 legend = c(round(min(sociomatrix),2), round(max(sociomatrix),2)),
                 fill = c(negcolors[min_bin - 1],
                          poscolors[max_bin - 1]),
                 horiz = T,
                 bg = "black",
                 text.col = "white")
        }
      }


      # now for the comparison network

      if (white_background) {
        plot(layout_c ,pch = 20, cex = 1, col = "white", axes = F,
             xlab = "", ylab = "", main = comparison_names[2],col.main = "black",
             xlim = c((min(layout_c[,1]) - 0.1), (max(layout_c[,1]) + 0.1)),
             ylim = c((min(layout_c[,2]) - 1.3), (max(layout_c[,2]) + 0.5)))
      } else {
        plot(layout_c ,pch = 20, cex = 1, col = "black", axes = F,
             xlab = "", ylab = "", main = comparison_names[2],col.main = "white",
             xlim = c((min(layout_c[,1]) - 0.1), (max(layout_c[,1]) + 0.1)),
             ylim = c((min(layout_c[,2]) - 1.3), (max(layout_c[,2]) + 0.5)))
      }

      max_bin_c <- 1
      min_bin_c <- 1
      # add in edges
      for(i in 1:length(weights_c)){
        cur1 <- layout_c[edgelist_c[i,1],]
        cur2 <- layout_c[edgelist_c[i,2],]
        curweight <- weights_c[i]

        # find edge color
        nf <- TRUE
        counter <- 1
        bin <- 1
        while(nf){
          if(curweight > 0){
            if(posbreaks[counter] >= curweight){
              bin <- counter
              nf <- FALSE
            }
          }else{
            if(negbreaks[counter] >= curweight){
              bin <- counter
              nf <- FALSE
            }
          }
          counter <- counter +1
        }

        # find edge width
        nf <- TRUE
        counter <- 1
        wid <- 1
        while(nf){
          if(widbreaks[counter] >= abs(curweight)){
            wid <- counter
            nf <- FALSE
          }
          counter <- counter +1
        }
        if(curweight > 0){
          lines(c(cur1[1],cur2[1]) , c(cur1[2],cur2[2]),
                col = poscolors[bin], lwd = widths[wid])
          if (bin > max_bin_c) {
            max_bin_c <- bin
          }
        }else{
          lines(c(cur1[1],cur2[1]) , c(cur1[2],cur2[2]),
                col = negcolors[bin], lwd = widths[wid])
          if (bin > min_bin_c) {
            min_bin_c <- bin
          }
        }
      }
      if (white_background) {
        text(layout_c,labels = rownames(comparison_network), col = "black")
        if (show_legend) {
          legend("bottom", inset = 0, title = "Edge Values",title.col = "black",
                 legend = c(round(min(comparison_network),2),
                            round(max(comparison_network),2)),
                 fill = c(negcolors[min_bin_c - 1],
                          poscolors[max_bin_c - 1]),
                 horiz = T,
                 bg = "white",
                 text.col = "black",
                 box.col = "white")
        }
      } else {
        text(layout_c,labels = rownames(comparison_network), col = "white")
        if (show_legend) {
          legend("bottom", inset = 0, title = "Edge Values",title.col = "white",
                 legend = c(round(min(comparison_network),2),
                            round(max(comparison_network),2)),
                 fill = c(negcolors[min_bin_c - 1],
                          poscolors[max_bin_c - 1]),
                 horiz = T,
                 bg = "black",
                 text.col = "white")
        }
      }

      dev.off()
    } else {
      # for only a single plot
      pdf(file = pdf_name, width = 12, height = 12)
      #start plot
      if (white_background) {
        par(bg = "white", oma = c(0.1,0.1,0.1,0.1) + 0.1,
            mar = c(0,0,0,0), xpd=TRUE, mfrow = c(1,1))
        plot(layout,pch = 20, cex = 1, col = "white", axes = F,
             xlab = "", ylab = "", main = title,
             xlim = c((min(layout[,1]) - 2), (max(layout[,1]) + 2)),
             ylim = c((min(layout[,2]) - 2), (max(layout[,2]) + 2)))
      } else {
        par(bg = "black", oma = c(0.1,0.1,0.1,0.1) + 0.1,
            mar = c(0,0,0,0), xpd=TRUE, mfrow = c(1,1))
        plot(layout,pch = 20, cex = 1, col = "black", axes = F,
             xlab = "", ylab = "", main = title,
             xlim = c((min(layout[,1]) - 2), (max(layout[,1]) + 2)),
             ylim = c((min(layout[,2]) - 2), (max(layout[,2]) + 2)))
      }

      # add in edges
      for(i in 1:length(weights)){
        cur1 <- layout[edgelist[i,1],]
        cur2 <- layout[edgelist[i,2],]
        curweight <- weights[i]

        # find edge color
        nf <- TRUE
        counter <- 1
        bin <- 1
        while(nf){
          if(curweight > 0){
            if(posbreaks[counter] >= curweight){
              bin <- counter
              nf <- FALSE
            }
          }else{
            if(negbreaks[counter] >= curweight){
              bin <- counter
              nf <- FALSE
            }
          }
          counter <- counter +1
        }

        # find edge width
        nf <- TRUE
        counter <- 1
        wid <- 1
        while(nf){
          if(widbreaks[counter] >= abs(curweight)){
            wid <- counter
            nf <- FALSE
          }
          counter <- counter +1
        }
        if(curweight > 0){
          lines(c(cur1[1],cur2[1]) , c(cur1[2],cur2[2]),
                col = poscolors[bin], lwd = widths[wid])
        }else{
          lines(c(cur1[1],cur2[1]) , c(cur1[2],cur2[2]),
                col = negcolors[bin], lwd = widths[wid])
        }
      }
      if (white_background) {
        text(layout,labels = rownames(sociomatrix), col = "black")
        if (show_legend) {
          legend("bottom", inset = 0, title = "Edge Values",title.col = "black",
                 legend = c(round(min(sociomatrix),2), round(max(sociomatrix),2)),
                 fill = c("red","blue"), horiz = T, bg = "white",text.col = "black",
                 box.col = "white")
        }

      } else {
        text(layout,labels = rownames(sociomatrix), col = "white")
        if (show_legend) {
          legend("bottom", inset = 0, title = "Edge Values",title.col = "white",
                 legend = c(round(min(sociomatrix),2), round(max(sociomatrix),2)),
                 fill = c("red","blue"), horiz = T, bg = "black",text.col = "white")
        }
      }
      dev.off()

    } # end of comparison or not conditional else statement
    #reset working directory
    setwd(cur_directory)
  } else {


    # if we are making a comparison, two plots next to eachother
    if (COMPARISON) {
      #start plot
      if (white_background) {
        par(bg = "white", oma = c(1,1,2,1) + 0.1,
            mar = c(0,0.5,1,0.5) + 0.5, xpd=TRUE, mfrow = c(1,2))
        plot(layout,pch = 20, cex = 1, col = "white", axes = F,
             xlab = "", ylab = "", main = comparison_names[1],col.main = "black",
             xlim = c((min(layout[,1])-0.1), (max(layout[,1])+0.1)),
             ylim = c((min(layout[,2])-1.3), (max(layout[,2])+0.5)))
      } else {
        par(bg = "black", oma = c(1,1,2,1) + 0.1,
            mar = c(0,0.5,1,0.5) + 0.5, xpd=TRUE, mfrow = c(1,2))
        plot(layout,pch = 20, cex = 1, col = "black", axes = F,
             xlab = "", ylab = "", main = comparison_names[1],col.main = "white",
             xlim = c((min(layout[,1])-0.1), (max(layout[,1])+0.1)),
             ylim = c((min(layout[,2])-1.3), (max(layout[,2])+0.5)))
      }

      # add in edges
      max_bin <- 1
      min_bin <- 1
      for(i in 1:length(weights)){
        cur1 <- layout[edgelist[i,1],]
        cur2 <- layout[edgelist[i,2],]
        curweight <- weights[i]

        # find edge color
        nf <- TRUE
        counter <- 1
        bin <- 1
        while(nf){
          if(curweight > 0){
            if(posbreaks[counter] >= curweight){
              bin <- counter
              nf <- FALSE
            }
          }else{
            if(negbreaks[counter] >= curweight){
              bin <- counter
              nf <- FALSE
            }
          }
          counter <- counter +1
        }

        # find edge width
        nf <- TRUE
        counter <- 1
        wid <- 1
        while(nf){
          if(widbreaks[counter] >= abs(curweight)){
            wid <- counter
            nf <- FALSE
          }
          counter <- counter +1
        }
        if(curweight > 0){
          lines(c(cur1[1],cur2[1]) , c(cur1[2],cur2[2]),
                col = poscolors[bin], lwd = widths[wid])
          if (bin > max_bin) {
            max_bin <- bin
          }
        }else{
          lines(c(cur1[1],cur2[1]) , c(cur1[2],cur2[2]),
                col = negcolors[bin], lwd = widths[wid])
          if (bin > min_bin) {
            min_bin <- bin
          }
        }
      }
      print(max_bin)
      if (white_background) {
        text(layout,labels = rownames(sociomatrix), col = "black")
        if (show_legend) {
          legend("bottom", inset = 0, title = "Edge Values",title.col = "black",
                 legend = c(round(min(sociomatrix),2), round(max(sociomatrix),2)),
                 fill = c(negcolors[min_bin - 1],
                          poscolors[max_bin - 1]),
                 horiz = T, bg = "white",text.col = "black",
                 box.col = "white")
        }
      } else {
        text(layout,labels = rownames(sociomatrix), col = "white")
        if (show_legend) {
          legend("bottom", inset = 0, title = "Edge Values",title.col = "white",
                 legend = c(round(min(sociomatrix),2), round(max(sociomatrix),2)),
                 fill = c(negcolors[min_bin - 1],
                          poscolors[max_bin - 1]),
                 horiz = T, bg = "black",text.col = "white")
        }
      }

      # now for the comparison network

      if (white_background) {
        plot(layout_c ,pch = 20, cex = 1, col = "white", axes = F,
             xlab = "", ylab = "", main = comparison_names[2],col.main = "black",
             xlim = c((min(layout_c[,1]) - 0.1), (max(layout_c[,1]) + 0.1)),
             ylim = c((min(layout_c[,2]) - 1.3), (max(layout_c[,2]) + 0.5)))
      } else {
        plot(layout_c ,pch = 20, cex = 1, col = "black", axes = F,
             xlab = "", ylab = "", main = comparison_names[2],col.main = "white",
             xlim = c((min(layout_c[,1]) - 0.1), (max(layout_c[,1]) + 0.1)),
             ylim = c((min(layout_c[,2]) - 1.3), (max(layout_c[,2]) + 0.5)))
      }

      # add in edges
      max_bin_c <- 1
      min_bin_c <- 1
      for(i in 1:length(weights_c)){
        cur1 <- layout_c[edgelist_c[i,1],]
        cur2 <- layout_c[edgelist_c[i,2],]
        curweight <- weights_c[i]

        # find edge color
        nf <- TRUE
        counter <- 1
        bin <- 1
        while(nf){
          if(curweight > 0){
            if(posbreaks[counter] >= curweight){
              bin <- counter
              nf <- FALSE
            }
          }else{
            if(negbreaks[counter] >= curweight){
              bin <- counter
              nf <- FALSE
            }
          }
          counter <- counter +1
        }

        # find edge width
        nf <- TRUE
        counter <- 1
        wid <- 1
        while(nf){
          if(widbreaks[counter] >= abs(curweight)){
            wid <- counter
            nf <- FALSE
          }
          counter <- counter +1
        }
        if(curweight > 0){
          lines(c(cur1[1],cur2[1]) , c(cur1[2],cur2[2]),
                col = poscolors[bin], lwd = widths[wid])
          if (bin > max_bin_c) {
            max_bin_c <- bin
          }
        }else{
          lines(c(cur1[1],cur2[1]) , c(cur1[2],cur2[2]),
                col = negcolors[bin], lwd = widths[wid])
          if (bin > min_bin_c) {
            min_bin_c <- bin
          }
        }
      }

      if (white_background) {
        text(layout_c,labels = rownames(comparison_network), col = "black")
        if (show_legend) {
          legend("bottom", inset = 0, title = "Edge Values",title.col = "black",
                 legend = c(round(min(comparison_network),2),
                            round(max(comparison_network),2)),
                 fill = c(negcolors[min_bin_c - 1],
                          poscolors[max_bin_c - 1]),
                 horiz = T, bg = "white",text.col = "black",
                 box.col = "white")
        }
      } else {
        text(layout_c,labels = rownames(comparison_network), col = "white")
        if (show_legend) {
          legend("bottom", inset = 0, title = "Edge Values",title.col = "white",
                 legend = c(round(min(comparison_network),2),
                            round(max(comparison_network),2)),
                 fill = c(negcolors[min_bin_c - 1],
                          poscolors[max_bin_c - 1]),
                 horiz = T, bg = "black",text.col = "white")
        }
      }

    } else {
      #start plot
      if (white_background) {
        par(bg = "white", oma = c(0.1,0.1,0.1,0.1) + 0.1,
            mar = c(0,0,0,0), xpd=TRUE, mfrow = c(1,1))
        plot(layout,pch = 20, cex = 1, col = "white", axes = F,
             xlab = "", ylab = "", main = title,
             xlim = c((min(layout[,1]) - 0.2), (max(layout[,1]) + 0.2)),
             ylim = c((min(layout[,2]) - 0.2), (max(layout[,2]) + 0.2)))
      } else {
        par(bg = "black", oma = c(0.1,0.1,0.1,0.1) + 0.1,
            mar = c(0,0,0,0), xpd=TRUE, mfrow = c(1,1))
        plot(layout,pch = 20, cex = 1, col = "black", axes = F,
             xlab = "", ylab = "", main = title,
             xlim = c((min(layout[,1]) - 0.2), (max(layout[,1]) + 0.2)),
             ylim = c((min(layout[,2]) - 0.2), (max(layout[,2]) + 0.2)))
      }

      # add in edges
      for (i in 1:length(weights)) {
        cur1 <- layout[edgelist[i,1],]
        cur2 <- layout[edgelist[i,2],]
        curweight <- weights[i]

        # find edge color
        nf <- TRUE
        counter <- 1
        bin <- 1
        while(nf){
          if(curweight > 0){
            if(posbreaks[counter] >= curweight){
              bin <- counter
              nf <- FALSE
            }
          }else{
            if(negbreaks[counter] >= curweight){
              bin <- counter
              nf <- FALSE
            }
          }
          counter <- counter +1
        }

        # find edge width
        nf <- TRUE
        counter <- 1
        wid <- 1
        while(nf){
          if(widbreaks[counter] >= abs(curweight)){
            wid <- counter
            nf <- FALSE
          }
          counter <- counter +1
        }
        if(curweight > 0){
          lines(c(cur1[1],cur2[1]) , c(cur1[2],cur2[2]),
                col = poscolors[bin], lwd = widths[wid])
        }else{
          lines(c(cur1[1],cur2[1]) , c(cur1[2],cur2[2]),
                col = negcolors[bin], lwd = widths[wid])
        }
      }
      if (white_background) {
        text(layout,labels = rownames(sociomatrix), col = "black")
        if (show_legend) {
          legend("bottom", inset = 0, title = "Edge Values",title.col = "black",
                 legend = c(round(min(sociomatrix),2), round(max(sociomatrix),2)),
                 fill = c("red","blue"), horiz = T, bg = "white",text.col = "black",
                 box.col = "white")
        }
      } else {
        text(layout,labels = rownames(sociomatrix), col = "white")
        if (show_legend) {
          legend("bottom", inset = 0, title = "Edge Values",title.col = "white",
                 legend = c(round(min(sociomatrix),2), round(max(sociomatrix),2)),
                 fill = c("red","blue"), horiz = T, bg = "black",text.col = "white")
        }
      }
    }
  }

  par(bg = "white")
  # do not return anything.
}
matthewjdenny/GERGM documentation built on May 24, 2023, 1:28 a.m.