R/LinkedPairs-class.R

In npcooley/SynExtend: Tools for Working With Synteny Objects

`[.LinkedPairs` <- function(x, i, j, ...) {
  ans <- NextMethod("[", x)
  
  if (missing(j))
    return(ans)
  
  d <- dim(x)
  I <- seq_len(d[1])
  J <- seq_len(d[1])
  d <- dimnames(x)
  names(I) <- d[[1]]
  names(J) <- d[[1]]
  I <- I[i]
  J <- J[j]
  if (length(I) >= 2 &&
      length(I)==length(J) &&
      all(I==J) &&
      !any(duplicated(I))) {
    class(ans) <- "LinkedPairs"
  }
  attr(ans, "GeneCalls") <- attr(x, "GeneCalls")
  return(ans)
}

print.LinkedPairs <- function(x,
                            quote = FALSE,
                            right = TRUE,
                            ...) {
  d <- dim(x)
  if (is.null(d)) {
    stop ("x must be a square object of class 'LinkedPairs'.")
  }
  m <- matrix("",
              nrow = d[1],
              ncol = d[2],
              dimnames = dimnames(x))
  
  for (m1 in seq_len(d[1])) {
    for (m2 in seq_len(d[2])) {
      if (m1 > m2) {
        ######
        # Lower Triangle
        ######
        k <- nrow(x[m1, m2][[1]])
        m[m1, m2] <- paste(k,
                           ifelse(k == 1,
                                  "Kmer",
                                  "Kmers"),
                           sep = " ")
      } else if (m1 < m2) {
        ######
        # Upper Triangle
        ######
        k <- nrow(x[m1, m2][[1]])
        m[m1, m2] <- paste(k,
                           ifelse(k == 1,
                                  "Pair",
                                  "Pairs"),
                           sep = " ")
      } else if (m1 == m2 &
                 !is.null(x[m1, m2][[1]])) {
        k <- length(x[m1, m2][[1]])
        m[m1, m2] <- paste(k,
                           ifelse(k == 1,
                                  "Contig",
                                  "Contigs"),
                           sep = " ")
      } else if (m1 == m2 &
                 is.null(x[m1, m2][[1]])) {
        m[m1, m2] <- ""
      }
    }
  }
  print(m,
        quote = quote,
        right = right,
        ...)
  invisible(x)
}