Как сохранить метод печати для пользовательского класса - PullRequest
0 голосов
/ 27 августа 2018

Я определил метод для печати вектора с помощью теста класса:

print.test <- function(x,  ...) {
    x <- formatC(
        as.numeric(x),
        format = "f",
        big.mark = ".",
        decimal.mark = ",",
        digits = 1
        )
    x[x == "NA"] <- "-"
    x[x == "NaN"] <- "-"
    print.default(x)
}

, который отлично работает для следующих

a <- c(1000.11, 2000.22, 3000.33)
class(a) <- c("test", class(a))
print(a)
[1] "1.000,11" "2.000,22" "3.000,33"

, это также работает:

round(a)
[1] "1.000,0" "2.000,0" "3.000,0"

это не так:

median(a)
[1] 2000.22
class(median(a))
[1] "numeric"

Теперь мой вопрос: мне нужно написать собственный метод для этого класса, чтобы использовать медиану, например, и если да, то как бы это выглядело или есть другой способ?(как я просто хотел бы, чтобы этот класс печатал данные в определенном формате)?

1 Ответ

0 голосов
/ 27 августа 2018

Проблема в том, что median.default возвращает объект класса numeric, поэтому автоматическая печать возвращенного объекта не вызывает ваш пользовательский метод print.
Это будет сделано следующим образом.

median.test <- function(x, na.rm = FALSE, ...){
    y <- NextMethod(x, na.rm = na.rm, ...)
    class(y) <- c("test", class(y))
    y
}

median(a)
#[1] "2.000,2"

Что касается обработки значений NA, я сначала определю другой метод для базовой функции R.Это не является строго необходимым, но сохраните некоторые строки кода, если объекты класса test используются часто.wMedian, метод по умолчанию и метод для объектов класса "currency", как запрашивается OP в комментарии.

Обратите внимание, что должен существовать метод print.currency, который я не переопределяю, поскольку он точно такой же, как print.test выше.Что касается других методов, я сделал их проще с помощью новой функции, as.currency.

median.currency <- function(x, na.rm = FALSE, ...){
  y <- NextMethod(x, na.rm = na.rm, ...)
  as.currency(y)
}

c.currency <- function(x, ...){
  y <- NextMethod(x, ...)
  as.currency(y)
}

as.currency <- function(x){
  class(x) <- c("currency", class(x))
  x
}

wMedian <- function(x, ...) UseMethod("wMedian")
wMedian.default <- function(x, ...){
    matrixStats::weightedMedian(x, ...)
}

wMedian.currency <- function(x, w = NULL, idxs = NULL, na.rm = FALSE, interpolate = is.null(ties), ties = NULL, ...) {
  y <- NextMethod(x, w = w, idxs = idxs, na.rm = na.rm, interpolate = interpolate, ties = ties, ... ) 
  as.currency(y)
}


set.seed(1)
x <- rnorm(10)
wMedian(x, w = (1:10)/10)
#[1] 0.4084684
wMedian(as.currency(x), w = (1:10)/10)
#[1] "0,4"
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...