rossellhayes / fracture
 1 ```#' Convert decimals to a matrix of numerators and denominators ``` 2 ```#' ``` 3 ```#' @param x A vector of decimals or, for `as.frac_mat()`, a character vector ``` 4 ```#' created by [fracture()] ``` 5 ```#' @param base_10 If `TRUE`, all denominators will be a power of 10. ``` 6 ```#' @param common_denom If `TRUE`, all fractions will have the same denominator. ``` 7 ```#' ``` 8 ```#' If the least common denominator is greater than `max_denom`, ``` 9 ```#' `max_denom` is used. ``` 10 ```#' ``` 11 ```#' @param mixed If `TRUE`, `integer` components will be displayed separately ``` 12 ```#' from fractional components for `x` values greater than 1. ``` 13 ```#' ``` 14 ```#' If `FALSE`, improper fractions will be used for `x` values greater than 1. ``` 15 ```#' ``` 16 ```#' @param max_denom All denominators will be less than or equal to ``` 17 ```#' `max_denom`. ``` 18 ```#' ``` 19 ```#' If `base_10` is `TRUE`, the maximum denominator will be the largest power ``` 20 ```#' of 10 less than `max_denom`. ``` 21 ```#' ``` 22 ```#' A `max_denom` greater than the inverse square root of ``` 23 ```#' [machine double epsilon][.Machine] will produce a warning because floating ``` 24 ```#' point rounding errors can occur when denominators grow too large. ``` 25 ```#' ``` 26 ```#' @return A matrix with the same number of columns as the length of `x` and ``` 27 ```#' rows for `integer`s (if `mixed` is `TRUE`), `numerator`s, ``` 28 ```#' and `denominator`s. ``` 29 ```#' @seealso [fracture()] to return a character vector of fractions. ``` 30 ```#' @export ``` 31 ```#' ``` 32 ```#' @example examples/frac_mat.R ``` 33 34 ```frac_mat <- function( ``` 35 ``` x, base_10 = FALSE, common_denom = FALSE, mixed = FALSE, max_denom = 1e7 ``` 36 ```) { ``` 37 1 ``` if (base_10) {max_denom <- 10 ^ floor(log(max_denom, base = 10))} ``` 38 39 1 ``` max_max_denom <- 1 / sqrt(.Machine\$double.eps) ``` 40 1 ``` if (max_denom > max_max_denom) { ``` 41 1 ``` warning( ``` 42 1 ``` "Using a `max_denom` greater than ", max_max_denom, ``` 43 1 ``` " is not recommended.", "\n", ``` 44 1 ``` "Using a larger `max_denom` may cause floating point errors." ``` 45 ``` ) ``` 46 ``` } ``` 47 48 1 ``` integer <- ifelse(x >= 0, x %/% 1, (x %/% 1 + 1)) ``` 49 1 ``` integer <- ((x > 0) * 1 + (x < 0) * -1) * (abs(x) %/% 1) ``` 50 1 ``` decimal <- x - integer ``` 51 52 1 ``` if (any(is.na(decimal)) || any(is.infinite(decimal))) { ``` 53 1 ``` stop("`x` must be a vector of finite numbers.") ``` 54 ``` } ``` 55 56 1 ``` matrix <- decimal_to_fraction(decimal, base_10, max_denom) ``` 57 58 1 ``` if (common_denom) { ``` 59 1 ``` denom <- lcm(matrix[2, ], max_denom) ``` 60 1 ``` matrix[1, ] <- round(matrix[1, ] * (denom / matrix[2, ])) ``` 61 1 ``` matrix[2, ] <- denom ``` 62 ``` } else { ``` 63 1 ``` extrema <- which( ``` 64 1 ``` (matrix[1, ] == 1 & matrix[2, ] == 1) | (matrix[1, ] == 0 & integer == 0) ``` 65 ``` ) ``` 66 1 ``` matrix[, extrema] <- matrix[, extrema] * max_denom ``` 67 ``` } ``` 68 69 1 ``` rownames(matrix) <- c("numerator", "denominator") ``` 70 71 1 ``` if (mixed) { ``` 72 1 ``` matrix <- rbind(integer, matrix) ``` 73 1 ``` negative <- which(matrix[1, ] < 0) ``` 74 1 ``` matrix[2, negative] <- abs(matrix[2, negative]) ``` 75 ``` } else { ``` 76 1 ``` matrix[1, ] <- integer * matrix[2, ] + matrix[1, ] ``` 77 ``` } ``` 78 79 1 ``` matrix ``` 80 ```} ``` 81 82 ```#' @rdname frac_mat ``` 83 ```#' @export ``` 84 85 ```as.frac_mat <- function(x) { ``` 86 1 ``` if (is.fracture(x)) { ``` 87 1 ``` split <- strsplit(x, " |/") ``` 88 1 ``` lengths <- vapply(split, length, integer(1)) ``` 89 90 1 ``` if (all(lengths == 2)) { ``` 91 1 ``` matrix <- do.call("cbind", split) ``` 92 1 ``` rownames(matrix) <- c("numerator", "denominator") ``` 93 ``` } else { ``` 94 1 ``` split[lengths == 1] <- lapply(split[lengths == 1], function(x) c(x, 0, 0)) ``` 95 1 ``` split[lengths == 2] <- lapply(split[lengths == 2], function(x) c(0, x)) ``` 96 1 ``` matrix <- do.call("cbind", split) ``` 97 1 ``` rownames(matrix) <- c("integer", "numerator", "denominator") ``` 98 ``` } ``` 99 100 1 ``` mode(matrix) <- "integer" ``` 101 1 ``` matrix ``` 102 ``` } else { ``` 103 1 ``` frac_mat(x) ``` 104 ``` } ``` 105 ```} ``` 106 107 ```#' @rdname frac_mat ``` 108 ```#' @export ``` 109 110 ```is.frac_mat <- function(x) { ``` 111 1 ``` is.matrix(x) && ``` 112 1 ``` is.numeric(x) && ``` 113 1 ``` all(x %% 1 == 0) && ``` 114 1 ``` nrow(x) %in% 2:3 && ``` 115 1 ``` !is.null(rownames(x)) && ``` 116 1 ``` all(rownames(x) %in% c("integer", "numerator", "denominator")) ``` 117 ```} ```

Read our documentation on viewing source code .