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 .

Loading