Last active
July 12, 2020 04:16
-
-
Save mrdwab/80bf1a8ae2fcbe7dbf51f853064de352 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#' 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" | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment