R/print.bertini.R

In dkahle/bertini: Interface to 'Bertini'

#' Pretty Printing of Bertini Output
#'
#' Pretty printing of Bertini output.
#'
#' @param x an object of class bertini
#' @param digits digits to round to
#' @param ... additional parameters
#' @usage \method{print}{bertini}(x, digits = 3, ...)
#' @return Invisible string of the printed object.
#' @export
#' @examples
#'
#' if (has_bertini()) {
#'
#' # see ?bertini
#'
#' variety("x^2 + 1")
#' variety(c("x^2 + 1 + y","y"))
#'
#' }
#'
print.bertini <- function(x, digits = 3, ...){

  ## argument checking and basic variable setting
  stopifnot(is.bertini(x))

  ## get variables
  vars <- x %>%
    pluck("main_data") %>% str_extract_all("(?<=Variables:  ).+") %>%
    flatten_chr() %>% str_split(" ") %>% pluck(1L)

  tuple <- glue("({str_c(vars, collapse = ',')})")

  p <- length(vars)

  ## determine number of solutions and kinds
  nFSolns  <- nrow(x$finite_solutions);      if(is.null(nFSolns))  nFSolns <- 0L
  nNsSolns <- nrow(x$nonsingular_solutions); if(is.null(nNsSolns)) nNsSolns <- 0L
  nSSolns  <- nrow(x$singular_solutions);    if(is.null(nSSolns))  nSSolns <- 0L
  nRSolns  <- nrow(x$real_finite_solutions); if(is.null(nRSolns))  nRSolns <- 0L

  ## print positive dimensional solution
  if (all(c(nFSolns, nNsSolns, nSSolns, nRSolns) == 0L)) {
    message("Positive dimensional solution; print method not yet implemented.")
    return(invisible())
  }

  ## round
  fSolns <- round(x$finite_solutions, digits = digits)
  nsSolns <- round(x$nonsingular_solutions, digits = digits)
  sSolns <- round(x$singular_solutions, digits = digits)
  rfSolns <- round(x$real_finite_solutions, digits = digits)

  ## make solns data frame, add in type variable (real or complex)
  solns <- as.data.frame(fSolns)
  complexSolnIndic <- apply(solns, 1, function(x) any(Im(x) != 0)) # T's and F's
  solns$type <- "real"
  solns$type[complexSolnIndic] <- "complex"

  ## count up solutions (for multiplicities)
  fSolnsString <- apply(fSolns, 1, paste, collapse = " ")
  fSolnsTab <- table(unname(fSolnsString))
  nDistinctSolns <- length(fSolnsTab)


  ## add in regularity (singular or nonsingular)
  solns$regularity <- ""

  # count up nonsingular solutions
  if(nNsSolns > 0){
    nsSolnsString <- apply(nsSolns, 1, paste, collapse = " ")
    nsSolnsTab <-table(unname(nsSolnsString))
    nDistinctNsSolns <- length(nsSolnsTab)
  } else {
    nsSolnsString <- character(0)
    nDistinctNsSolns <- 0
  }
  solns$regularity[fSolnsString %in% nsSolnsString] <- "nonsingular"

  # count up singular solutions
  if(nSSolns > 0){
    sSolnsString <- apply(sSolns, 1, paste, collapse = " ")
    sSolnsTab <-table(unname(sSolnsString))
    nDistinctSSolns <- length(sSolnsTab)
  } else {
    sSolnsString <- character(0)
    nDistinctSSolns <- 0
  }
  solns$regularity[fSolnsString %in% sSolnsString] <- "singular"

  # count up real solutions
  if(nRSolns > 0){
    rfSolnsString <- apply(rfSolns, 1, paste, collapse = " ")
    rfSolnsTab <- table(unname(rfSolnsString))
    nDistinctRSolns <- length(rfSolnsTab)
  } else {
    rfSolnsString <- character(0)
    nDistinctRSolns <- 0
  }


  ## message solutions found.
  if(nDistinctSolns == 1){
    rc <- ifelse(nRSolns > 0, "real", "complex")
    sing <- ifelse(nNsSolns > 0, "nonsinguar", "singular")
    cat(glue("One {rc}, {sing} solution {tuple} found."))
  } else {
    cat(glue(
      "{nDistinctSolns} solutions {tuple} found. ",
      "({nDistinctRSolns} real, {nDistinctSolns - nDistinctRSolns} complex)"
      # "{nDistinctNsSolns} nonsingular, {nDistinctSSolns} singular."
    ))
  }
  cat("\n")

  # add on multiplicities by joining a similar dataframe
  solns$soln <- fSolnsString
  mults <- as.data.frame(fSolnsTab)
  names(mults) <- c("soln", "mult")
  uniqueSolns <- unique(merge(solns, mults))
  uniqueSolns <- uniqueSolns[,-which(names(uniqueSolns) == "soln")]

  ## print out solutions
  printSolns <- uniqueSolns[,1:p, drop = FALSE]
  if(all(printSolns == round(printSolns))){
    formattedSolns <- apply(format(printSolns), 1, function(v){
      s <- paste0("(", paste(v, collapse = ","), ")")
      s <- str_replace_all(s, "0[-+]0i", "0")
      s <- str_replace_all(s, "0\\+", "")
      s <- str_replace_all(s, "0\\-", "-")
      s <- str_replace_all(s, "[-+]0i", "")
      s <- str_replace_all(s, "1i", "i")
      s
    })
  } else {
    formattedSolns <- apply(format(printSolns), 1, function(v){
      s <- paste0("(", paste(v, collapse = ","), ")")
      s <- str_replace_all(s, "0.0+[-+]0.0+i", "0")
      s <- str_replace_all(s, "0.0+\\+", "")
      s <- str_replace_all(s, "0.0+\\-", "-")
      s <- str_replace_all(s, "\\+0.0+i", "")
      s <- str_replace_all(s, "\\-0.0+i", "")
      s <- str_replace_all(s, "1.0+i", "i")
      s <- str_replace_all(s, "[-+]0i", "")
      s
    })
  }



  for(k in 1:nrow(uniqueSolns)){
    if(uniqueSolns$mult[k] == 1){
      regu <- if(uniqueSolns[k,"regularity"] == "nonsingular") "(R)" else "(S)"
      cat( paste("   ", formattedSolns[k], regu))
    } else {
      regu <- if(uniqueSolns[k,"regularity"] == "nonsingular") "(R, " else "(S, "
      cat( paste0("    ", formattedSolns[k], " ", regu, uniqueSolns$mult[k], ")"))
    }
    cat("\n")
  }

}