Mark-Eis / BitsnBobs

For General Bits and Bobs of Code
https://mark-eis.github.io/BitsnBobs/
Other
1 stars 0 forks source link

in `boxcox3()`, consider `labile_data` argument, cf `retriever()` #60

Closed Mark-Eis closed 6 months ago

Mark-Eis commented 6 months ago

https://github.com/Mark-Eis/BitsnBobs/blob/bb2d9200117a1ddd54e746ce0ff4ed3460dc17e1/R/boxcox.R#L71

see: –

https://github.com/Mark-Eis/BitsnBobs/blob/bb2d9200117a1ddd54e746ce0ff4ed3460dc17e1/R/retriever.R#L109

boxcox4 <- function(x, labile_data = TRUE) {
    x <- {
        if (labile_data) enquo(x) else force(x)
    }

    function(lambda) {
        if (labile_data) x <- eval_tidy(x)
        if (lambda == 0) {
            log(x)
        } else {
            (x ^ lambda - 1) / lambda
        }
    }  
}
Mark-Eis commented 6 months ago

3c27cc6

Mark-Eis commented 6 months ago

Not quite there yet—different to retriever() as X not a DF. Needs further consideration…

Mark-Eis commented 6 months ago

Not quite there yet—different to retriever() as X not a DF. Needs further consideration…

OK, using eval_tidy() to resolve quosure, not data mask

Nevertheless, code improved: –

boxcox3 <- function(x, labile_data = TRUE) {
    if (labile_data) {
        x <- enquo(x)

        function(lambda) {
            eval_tidy(
                if (lambda == 0)
                    expr(log(!!x))
                else
                    expr(((!!x) ^ lambda - 1) / lambda)
            )
        }  
   } else
        function(lambda) {
            if (lambda == 0)
                log(x)
            else
                (x ^ lambda - 1) / lambda
        }
}
Mark-Eis commented 6 months ago

a2aabc9 and 2cb1d34