R - 带有自定义标签的剪切功能？答案

【问题标题】：R - cut function with custom labels?R - 带有自定义标签的剪切功能？
【发布时间】：2020-08-17 21:57:49
【问题描述】：

例子：

> x <- c(1e6,2e6,500e3,10e6,233e3,50e3)
> cut(x,c(0,250e3,500e3,1e6,2.5e6,99e6),dig.lab=10)
[1] (500000,1000000]   (1000000,2500000]  (250000,500000]    (2500000,99000000] (0,250000]        
[6] (0,250000]        
Levels: (0,250000] (250000,500000] (500000,1000000] (1000000,2500000] (2500000,99000000]

有没有办法可以将剪切功能与自定义标签一起使用？我希望它显示标签，例如：(0,250k],(250k,500k],(500k,1m],(1m,2.5m],(2.5m,inf]

有没有办法做到这一点？

【问题讨论】：

?cut 有一个 labels 参数
@user20650，请作为答案发布！
@BenBolker ;我正在考虑将其标记为 dup； stackoverflow.com/questions/30491419/…

标签： r

【解决方案1】：

正如@user20650 所说，labels= 将允许您手动执行此操作（为此，这是Adding labels to cut function in R 的欺骗问题）。

如果您想要一种编程方式将级别转换为这种 SI（或 IEC）格式，我们可以借鉴 utils:::format.object_size 并定义我们自己的函数：

#' Kilo, Mega, Giga
#'
#' Convert numbers to SI or IEC format.
#' 
#' @param x numeric
#' @param standard one of "SI" (1000-based) or "IEC" (1024)
#' @param digits number of significant digits to round to
#' @param sep character, what to put between the number and the letter
#' @param suffix character what to put immediately after the K/M/G
#'   (e.g., "b" or "B")
#' @return character
#' @export
KMG <- function(x, standard = "SI", digits = 1L, sep = "", suffix = "") {
  known_bases <- c(legacy = 1024, IEC = 1024, SI = 1000)
  known_units <- list(SI = c("", "k", "M", "G", "T", "P", 
      "E", "Z", "Y"), IEC = c("", "Ki", "Mi", "Gi", 
      "Ti", "Pi", "Ei", "Zi", "Yi"), legacy = c("", "K", 
      "M", "G", "T", "P"))
  standard <- match.arg(standard, c("auto", names(known_bases)))
  if (is.null(digits)) 
      digits <- 1L
  base <- known_bases[[standard]]
  units_map <- known_units[[standard]]
  powers <- rep(0L, length(x))
  powers[x > 0] <- pmin(as.integer(log(x[x > 0], base = base)), length(units_map) - 1L)
  units <- paste0(units_map[powers + 1L], suffix)
  paste(round(x/base^powers, digits = digits), units, sep = sep)
}

（编辑以矢量化函数并删除"LEGACY"，并添加suffix= 参数。）

它的用途：

x <- c(1e6,2e6,500e3,10e6,233e3,50e3)

cuts <- cut(x, c(0,250e3,500e3,1e6,2.5e6,99e6), dig.lab=10)
lvls <- levels(cuts)
lvls
# [1] "(0,250000]"         "(250000,500000]"    "(500000,1000000]"   "(1000000,2500000]"  "(2500000,99000000]"

gre <- gregexpr("[[:digit:].]+", lvls)
regmatches(lvls, gre) <- 
  lapply(regmatches(lvls, gre), function(lvl) KMG(as.numeric(lvl)))
lvls
# [1] "(0,250k]"    "(250k,500k]" "(500k,1M]"   "(1M,2.5M]"   "(2.5M,99M]" 
levels(cuts) <- lvls
cuts
# [1] (500k,1M]   (1M,2.5M]   (250k,500k] (2.5M,99M]  (0,250k]    (0,250k]   
# Levels: (0,250k] (250k,500k] (500k,1M] (1M,2.5M] (2.5M,99M]

【讨论】：