math.R

#' All Factors of a Number
#'
#' @param x The number that you want to find the factors of.
#' @examples 
#' factors_of(8)
#' @export
factors_of <- function(x) which(!x %% seq_len(x))

#' Common Factors of Multiple Numbers
#' 
#' @param \dots The numbers that you want to get the common factors of.
#' @param greatest Logical. Should the result be only the greatest common factor? Defaults to `FALSE`.
#' @examples 
#' common_factors(18, 48)
#' common_factors(25, 50, 100)
#' @export
common_factors <- function(..., greatest = FALSE) {
  out <- Reduce(intersect, lapply(
    unlist(list(...), use.names = FALSE), factors_of))
  if (isTRUE(greatest)) max(out) else out
}

# Get the  first million primes
# tmp <- tempfile()
# curl_download("https://primes.utm.edu/lists/small/millions/primes1.zip", tmp)

#' Prime Factors of a Number
#' 
#' @param x The number that you want the prime factors of.
#' @param unique Logical. Should the function return all prime factors 
#' (where `prod(prime_factors(x)) == x`) or just the unique prime factors?
#' Defaults to `TRUE`.
#' 
#' @examples 
#' prime_factors(100, unique = FALSE)
#' prime_factors(100)
#' @export
prime_factors <- function(x, unique = TRUE) {
  if (x %in% primes) {
    facs <- x
  } else {
    facs <- c()
    i <- 2
    rem <- x
    while (prod(facs) != x) {
      if (!rem %% i) {
        facs <- c(facs, i)
        rem <- rem/i
        i <- 1
      }
      i <- i + 1
    }
  }
  if (isTRUE(unique)) unique(facs) else facs
}

#' Least Common Multiple of a Set of Numbers
#' 
#' @param \dots The numbers for which you want the least common multiple.
#' 
#' @examples 
#' least_common_multiple(4, 7, 11)
#' @export
least_common_multiple <- function(...) {
  L <- list(...)
  l <- sort(unlist(L, use.names = FALSE))
  if (all(!max(l) %% l)) {
    max(l)
  } else {
    out <- lapply(l, prime_factors, unique = FALSE)
    out <- unique(do.call(rbind, lapply(
      out, function(y) data.frame(unclass(rle(y))))))
    out <- out[as.logical(with(
      out, ave(lengths, values, FUN = function(x) x == max(x)))), ]
    prod(do.call("^", rev(out)))
  }
}

#' Convert a Decimal to an Approximate Fraction
#' 
#' @param number The decimal you want to convert to a fraction.
#' @param precision The number of digits to round the decimal to before trying
#' to convert the result to a fraction. Must be greater than 1 but less than 8.
#' @param improper Logical. Should the fraction be a returned as an improper 
#' fraction or a proper fraction? Defaults to `TRUE`.
#' @return A formatted `list` printed with `print.fraction()`. The `list`
#' includes four elements:
#' * `whole`: The absolute value of the whole number part of the decimal. This
#' is `NULL` if `improper = TRUE`.
#' * `numerator`: The numerator of the resulting fraction.
#' * `denominator`: The denominator of the resulting fraction.
#' * `sign`: `-1` if the input is negative; `1` if the input is positive.
#' @examples
#' as_fraction(3.2454)
#' as_fraction(3.2454, 2, TRUE)
#' as_fraction(3.2454, 2, FALSE)
#' as_fraction(3.2454, 1, FALSE)
#' @export
as_fraction <- function(number, precision = 3, improper = TRUE) {
  if (as.integer(number) == as.numeric(number)) {
    structure(list(whole = abs(as.integer(number)),
                   numerator = NULL,
                   denominator = NULL,
                   sign = sign(number)), 
              class = c("fraction", "whole", "list"))
  } else {
    if (precision <= 0) stop("frac is intended for decimals")
    if (precision >= 8) stop("precision is limited to truncating numbers 7 digits after the decimal")
    number <- round(number, precision)
    decimal <- as.integer(sub(".*\\.", "", number))
    whole <- abs(as.integer(sub("(.*)\\..*", "\\1", number)))
    whole_sign <- sign(number)
    
    fraction <- .frac(decimal, den = NULL)
    
    if (isTRUE(improper)) {
      structure(list(whole = NULL,
                     numerator = (whole * fraction[[2]]) + fraction[[1]],
                     denominator = fraction[[2]],
                     sign = whole_sign),
                class = c("fraction", "improper", "list"))
    } else {
      structure(list(whole = whole, 
                     numerator = fraction[[1]], 
                     denominator = fraction[[2]], 
                     sign = whole_sign), 
                class = c("fraction", "proper", "list"))
    }
  }
}

.frac <- function(num, den = NULL) {
  if (is.null(den)) den <- 10^nchar(num)
  a <- prime_factors(num)
  b <- prime_factors(den)
  
  while (any(as.logical(intersect(a, b)))) {
    m <- prod(intersect(a, b))
    num <- num/m
    den <- den/m
    a <- prime_factors(num)
    b <- prime_factors(den)
  }
  
  list(num, den)
}

print.fraction <- function(x, ...) {
  cl <- intersect(class(x), c("improper", "proper", "whole"))
  out <- switch(
    cl,
    improper = sprintf("%s/%s", format(x[["numerator"]] * x[["sign"]], scientific = FALSE),
              format(x[["denominator"]], scientific = FALSE)),
    proper = if (x[["whole"]] == 0) {
      sprintf("%s/%s", format(x[["sign"]] * x[["numerator"]], scientific = FALSE),
              format(x[["denominator"]], scientific = FALSE))
      } else {
        sprintf("%s %s/%s", format(x[["sign"]] * x[["whole"]], scientific = FALSE),
                format(x[["numerator"]], scientific = FALSE), 
                format(x[["denominator"]], scientific = FALSE))
        },
    whole = format(x[["whole"]] * x[["sign"]], scientific = FALSE))
  print(out)
}

#' Parse a String as a Fraction
#' 
#' @param string The input character to be parsed. 
#' 
#' @return A formatted `list` printed with `print.fraction()`. The `list`
#' includes four elements:
#' * `whole`: The absolute value of the whole number part of the decimal. This
#' is `NULL` if `improper = TRUE`.
#' * `numerator`: The numerator of the resulting fraction.
#' * `denominator`: The denominator of the resulting fraction.
#' * `sign`: `-1` if the input is negative; `1` if the input is positive.
#' 
#' @note The string can be entered either as an improper fraction 
#' (for example, `"5/2"`) or as a proper fraction (for example,
#' `"2 1/2"`). Depending on how it is entered, the resulting `list`
#' will have a value in `"whole"` or `"whole"` will be `NULL`.
#' 
#' @examples 
#' parse_fraction
parse_fraction <- function(string, improper = TRUE, reduce = TRUE) {
  if (!grepl("[ /]", string)) {
    cl <- "whole"
    whole <- abs(as.integer(string))
    numerator <- NULL
    denominator <- NULL
    whole_sign <- sign(as.integer(string))
  } else {
    a <- strsplit(string, "[ /]")[[1]]
    b <- as.integer(a)
    whole_sign <- sign(b[1])
    cl <- if (improper) "improper" else "proper"
    
    if (length(b) == 3) {
      denominator <- b[3]
      numerator <- if (improper) (abs(b[1]) * b[3]) + b[2] else b[2]
      whole <- if (improper) 0L else abs(b[1])
      if (reduce) {
        tmp <- .frac_reduce(whole, numerator, denominator, cl)
        numerator <- tmp[["numerator"]]
        denominator <- tmp[["denominator"]]
        whole <- tmp[["whole"]]
        cl <- tmp[["cl"]]
      }
    } else {
      denominator <- b[2]
      numerator <- abs(b[1])
      whole <- 0L
      if (improper) {
        if (reduce) {
          tmp <- .frac_reduce(whole, numerator, denominator, cl)
          numerator <- tmp[["numerator"]]
          denominator <- tmp[["denominator"]]
          whole <- tmp[["whole"]]
          cl <- tmp[["cl"]]
        }
      } else {
        if (numerator > denominator) {
          whole <- whole + (numerator %/% denominator)
          numerator <- numerator %% denominator
        } else if (numerator < denominator) {
          numerator <- numerator
        } else if (numerator == denominator ) {
          whole <- whole + 1
          numerator <- 0L
          denominator <- 0L
        }
        if (reduce) {
          tmp <- .frac_reduce(whole, numerator, denominator, cl)
          numerator <- tmp[["numerator"]]
          denominator <- tmp[["denominator"]]
          whole <- tmp[["whole"]]
          cl <- tmp[["cl"]]
        }
      }
    }
  }
 
  structure(list(whole = whole,
                 numerator = numerator,
                 denominator = denominator,
                 sign = whole_sign),
            class = c("fraction", cl, "list"))
}

.frac_reduce <- function(who, num, den, cla) {
  whole <- who
  cl <- cla
  if (any(c(num == 0, den == 0))) {
    cl <- "whole"
  } else {
    if (num == den) {
      whole <- whole + 1L
      cl <- "whole"
    } else {
      tmp <- .frac(num = num, den = den)
      if (tmp[[2]] == 1L) {
        whole <- whole + tmp[[1]]
        cl <- "whole"
      } else {
        numerator <- tmp[[1]]
        denominator <- tmp[[2]]          
      }
    }
  }
  list(whole = whole, 
       numerator = if (cl == "whole") NULL else numerator, 
       denominator = if (cl == "whole") NULL else denominator, cl = cl)
}


parse_fraction("4/4")                   # "1"
parse_fraction("4/4", reduce = FALSE)   # "4/4"
parse_fraction("4/4", FALSE)            # "1"

parse_fraction("32/4")                  # "8"
parse_fraction("32/4", reduce = FALSE)  # "32/4"
parse_fraction("32/4", FALSE)           # "8"
parse_fraction("33/4")                  # "33/4"
parse_fraction("33/4", FALSE)           # "8 1/4"
parse_fraction("34/4", reduce = FALSE)  # "34/4"
parse_fraction("34/4")                  # "17/2"
parse_fraction("34/4", FALSE, FALSE)    # "8 2/4"
parse_fraction("34/4", FALSE, TRUE)     # "8 1/2"

parse_fraction("4")                     # "4"

parse_fraction("4 2/4")                 # "9/2"
parse_fraction("4 2/4", TRUE, FALSE)    # "18/4"
parse_fraction("4 2/4", FALSE)          # "4 1/2"

parse_fraction("4 4/4")                 # "5"
parse_fraction("4 4/4", reduce = FALSE) # "20/4"