[R] histogram method for S4 class.

[Ernesto Jardim]

Deepayan Sarkar wrote:

>On 8/24/05, ernesto <ernesto at ipimar.pt> wrote:
>  
>
>>Hi,
>>
>>I'm trying to develop an histogram method for a class called "FLQuant"
>>which is used by the package FLCore (http://flr-project.org). FLQuant is
>>an extension to "array". There is an as.data.frame method that coerces
>>flquant into a data.frame suitable for lattice plotting. The problem is
>>that when I coerce the object and plot it after it works but if the
>>method is applied within the histogram method it does not work. See the
>>code below (the FLCore package is here
>>http://prdownloads.sourceforge.net/flr/FLCore_1.0-1.tar.gz?download)
>>
>>    
>>
>>>library(FLCore)
>>>      
>>>
>>Loading required package: lattice
>>    
>>
>>>data(ple4)
>>>histogram(~data|year, data=ple4 at catch.n)
>>>      
>>>
>>Error in inherits(x, "factor") : Object "x" not found
>>    
>>
>>>histogram(~data|year, data=as.data.frame(ple4 at catch.n))
>>>      
>>>
>>The catch.n slot is a FLQuant object and the code for histogram is the
>>following
>>
>>setMethod("histogram", signature(formula="formula", data="FLQuant"),
>>    function (formula, data = parent.frame(), allow.multiple =
>>is.null(groups) || outer,
>>        outer = FALSE, auto.key = FALSE, aspect = "fill", panel =
>>"panel.histogram", prepanel = NULL,
>>        scales = list(), strip = TRUE, groups = NULL, xlab, xlim, ylab,
>>ylim,
>>        type = c("percent", "count", "density"),
>>        nint = if (is.factor(x)) length(levels(x)) else
>>round(log2(length(x)) + 1),
>>        endpoints = extend.limits(range(x[!is.na(x)]), prop = 0.04),
>>        breaks = if (is.factor(x)) seq(0.5, length = length(levels(x)) +
>>1) else do.breaks(endpoints, nint),
>>        equal.widths = TRUE, drop.unused.levels =
>>lattice.getOption("drop.unused.levels"), ...,
>>        default.scales = list(), subscripts = !is.null(groups), subset =
>>TRUE) {
>>
>>        qdf <- as.data.frame(data)
>>
>>        histogram(formula, data = qdf, allow.multiple = allow.multiple,
>>outer = outer,
>>            auto.key = auto.key, aspect = aspect, panel = panel,
>>prepanel = prepanel, scales = scales,
>>            strip = strip, groups = groups, xlab=xlab, xlim=xlim,
>>ylab=ylab, ylim=ylim, type = type,
>>            nint = nint, endpoints = endpoints, breaks = breaks,
>>equal.widths = equal.widths,
>>            drop.unused.levels = drop.unused.levels, ..., default.scales
>>= default.scales,
>>            subscripts = subscripts, subset = subset)
>>    }
>>)
>>
>>
>>Any ideas ?
>>    
>>
>
>[I'm CC-ing to r-devel, please post follow-ups there]
>
>What version of lattice are you using? Please use the latest one, in
>which histogram is an S3 generic, with only one argument, formula. The
>eventual solution to your problem may involve changing that, but the
>first question to ask is whether any other formula makes sense in your
>context (if not, I would rather keep one argument and dispatch on
>signature(formula = "FLQuant").
>
>Disclaimer: I haven't actually had time to check out FLCore yet, I
>will as soon as I can.
>
>Deepayan
>  
>
Hi,

I've installed the version that is distributed with R-2.1.1, 0.11-8. I 
see there's a new version now so I'll install it and check the results. 
I've developed the code a little more using the approach you use for 
dotplot (see below) and I know where the problem is now. I'm not able to 
pass the argument nint, breaks and endpoints to the function call. I 
guess the problem is my programming skils :-(

Thanks

EJ

ps: I'm not a subscriber of r-devel so I guess I'm not able to post 
there, anyway I'm CC-ing there too.



setMethod("histogram", signature(formula="formula", data="FLQuant"), 
function (formula, data = parent.frame(), allow.multiple = 
is.null(groups) || outer, outer = FALSE, auto.key = FALSE, aspect = 
"fill", panel = "panel.histogram", prepanel = NULL, scales = list(), 
strip = TRUE, groups = NULL, xlab, xlim, ylab, ylim, type = c("percent", 
"count", "density"), nint = if (is.factor(x)) length(levels(x)) else 
round(log2(length(x)) + 1), endpoints = 
extend.limits(range(x[!is.na(x)]), prop = 0.04), breaks = if 
(is.factor(x)) seq(0.5, length = length(levels(x)) + 1) else 
do.breaks(endpoints, nint), equal.widths = TRUE, drop.unused.levels = 
lattice.getOption("drop.unused.levels"), ..., default.scales = list(), 
subscripts = !is.null(groups), subset = TRUE) {

# need to develop further, at the moment is not possible to control 
nint, breaks and endpoints.

data <- as.data.frame(data)

dots <- list(...)

groups <- eval(substitute(groups), data, parent.frame())
subset <- eval(substitute(subset), data, parent.frame())

call.list <- c(list(formula = formula, data = data, groups = groups, 
subset = subset, allow.multiple = allow.multiple, outer = outer, 
auto.key = auto.key, aspect = aspect, panel = panel, prepanel = 
prepanel, scales = scales, strip = strip, type = type, equal.widths = 
equal.widths, drop.unused.levels = drop.unused.levels, default.scales = 
default.scales, subscripts = subscripts), dots)

# include xlab & co if existent
if(!missing(xlab)) call.list$xlab <- xlab
if(!missing(ylab)) call.list$ylab <- ylab
if(!missing(xlim)) call.list$xlim <- xlim
if(!missing(ylim)) call.list$ylim <- ylim

ans <- do.call("histogram", call.list)
ans$call <- match.call()
ans

})