r how to keep print method for custom class

user_6899677 0
Viewed 1564

i have defined a method for printing a vector with the class test:

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)
}

which works fine for the following

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"

this also works:

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

this does not:

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

now my question is: do i need to write a custom method for this class to use median e.g. and if so what would it look like or is there another way (as i simply would like this class to print the data in a certain format)?

r printing class
1 Answers

The problem is that median.default returns an object of class numeric therefore autoprinting of the returned object does not call your custom print method.
The following will do so.

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"

As for the handling of NA values, I will first define another method for a base R function. It is not strictly needed but save some code lines if objects of class test are used frequently.

c.test <- function(x, ...){
    y <- NextMethod(x, ...)
    class(y) <- c("test", class(y))
    y
}


b <- c(a, NA)
class(b)
#[1] "test"    "numeric"

median(b)
#[1] "-"

median(b, na.rm = TRUE)
#[1] "2.000,2"

EDIT.

The following defines a generic function wMedian, a default method and a method for objects of class "currency", as requested by the OP in a comment.

Note that there must be a method print.currency, which I don't redefine since it's exactly the same as print.test above. As for the other methods, I have made them simpler with the help of a new function, 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"
user_82454060
Related