Проблемы устойчивости порядка в вектор-функции - PullRequest
0 голосов
/ 02 мая 2018

Я пытаюсь написать функцию, которая количественно определяет числовой ввод по порядку величины, используя префиксы SI и необязательный суффикс. Например:

1        => 1
23.4     => 23.4
1001     => 1.0k
12345678 => 12.3MB (i.e., "B" is the suffix)

Моя первая попытка в основном работает:

format.quantified <- function(n, base = 1000, suffix = "", multiplier = c("k", "M", "G", "T", "P"), threshold = 0.8, sep = "") {
  # Return n, quantified by order of magnitude (relative to base,
  # defaulting to SI prefixes) to one decimal place (or exactly, for
  # non-quantified integers) with an optional suffix for units
  n <- as.numeric(n)
  exponent <- trunc(log(n, base = base))

  is.decimal <- n != trunc(n)

  # Move up to the next multiplier if we're close enough
  # FIXME This condition only applies to the first element, but the
  # increment will be applied to everything
  # if (n / (base ^ (exponent + 1)) >= threshold) { exponent <- exponent + 1 }

  paste(
    ifelse(exponent | is.decimal, sprintf("%.1f", n / (base ^ exponent)), n),
    paste(ifelse(exponent, multiplier[exponent], ""), suffix, sep = ""),
    sep = sep)
}

Однако он страдает от двух проблем:

  1. Я хотел бы предоставить пороговое значение, которое будет количественно определять значение до следующего порядка при пересечении. Это не работает в приведенном выше примере, потому что я новичок в R и был удивлен, когда обнаружил, что моя функция применяется ко всей совокупности входных данных (а не по строкам).

  2. С этим вновь обретенным знанием векторизации, он, похоже, страдает от тонкой, переупорядоченной ошибки, которую я не могу определить причину:

    > format.quantified(c(1,1000,1000000,1000000000))
    [1] "1"    "1.0M" "1.0G" "1.0k"
    

    Интересно, что эта ошибка не проявляется при применении к фрейму данных с функцией mutate dplyr (например, mutate(data, foo = format.qualified(foo)))

Я попытался решить эту проблему, оценив векторизованный ввод и обработав все соответствующим образом:

format.quantified <- (function() {
  # Use a closure to define the default SI magnitude prefixes
  prefix.default <- data.frame(exponent = c(0,  1,   2,   3,   4,   5,   6),
                               prefix   = c("", "k", "M", "G", "T", "P", "E"))

  is.prefix  <- function(x) { is.data.frame(x) && all(c("exponent", "prefix") %in% colnames(x)) }
  is.decimal <- function(x) { x != trunc(x) }

  function(n, suffix = "", threshold = 0.8, base = 1000, prefix.alternative = NA, sep = "") {
    # Return n, quantified by order of magnitude (relative to base)
    # to one decimal place (or exactly, for non-quantified integers)
    # with an optional suffix for units
    prefix <- prefix.default
    if (is.prefix(prefix.alternative)) {
      prefix <- filter(prefix, !exponent %in% prefix.alternative$exponent) %>%
                bind_rows(prefix.alternative)
    }

    q <- data.frame(n = as.numeric(n), exponent = trunc(log(n, base = base))) %>%
         mutate(quantified = n / (base ^ exponent)) %>%
         merge(prefix, by = "exponent", all.x = TRUE)

    # TODO Threshold logic using filter and recombining with bind_rows

    paste(
      ifelse(q$exponent | is.decimal(q$n), sprintf("%.1f", q$quantified), q$n),
      paste(q$prefix, suffix, sep = ""),
      sep = sep)
  }
})()

Это, похоже, решило ошибку переупорядочения в оригинале:

> format.quantified(c(1,1000,1000000,1000000000))
[1] "1"    "1.0k" "1.0M" "1.0G"
> format.quantified(123)
[1] "123"

Однако, прежде чем я даже попытался реализовать пороговую логику, я заметил, что при применении к фрейму данных с mutate порядок на выходе полностью нарушен. При ближайшем рассмотрении оказывается, что стабильность нарушается всякий раз, когда ввод не в числовом порядке:

> format.quantified(c(1000000,1,1000,1000000,1000000000))
[1] "1e+06" "1.0k"  "1.0M"  "1.0M"  "1.0G" 

Что я делаю не так?


EDIT FWIW, моя пороговая логика для второй версии моей функции выглядит следующим образом:

q <- data.frame(n = as.numeric(n), exponent = trunc(log(n, base = base))) %>%
     mutate(quantified = n / (base ^ exponent))

q.below <- filter(q, quantified <  base * threshold)
q.above <- filter(q, quantified >= base * threshold) %>%
           mutate(exponent = exponent + 1, quantified = quantified / base)

Q <- bind_rows(q.below, q.above) %>%
     merge(prefix, by = "exponent", all.x = TRUE)

Само собой разумеется, это не делает проблему стабильности порядка лучше!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...