The R Project SVN R-packages

Rev

Rev 1616 | Rev 1684 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 1616 Rev 1636
Line 140... Line 140...
140 
 
 140 
 
141 
densityplot <-
 141 
densityplot <-
142 
    function(formula,
 142 
    function(formula,
143 
             data = parent.frame(),
 143 
             data = parent.frame(),
144 
             allow.multiple = is.null(groups) || outer,
 144 
             allow.multiple = is.null(groups) || outer,
- 
 
 145 
             outer = !is.null(groups),
- 
 
 146 
##              allow.multiple = is.null(groups) || outer,
145 
             outer = FALSE,
 147 
##              outer = FALSE,
146 
             auto.key = FALSE,
 148 
             auto.key = FALSE,
147 
             aspect = "fill",
 149 
             aspect = "fill",
148 
             panel = if (is.null(groups)) "panel.densityplot" else "panel.superpose",
 150 
             panel = if (is.null(groups)) "panel.densityplot" else "panel.superpose",
149 
             prepanel = NULL,
 151 
             prepanel = NULL,
150 
             scales = list(),
 152 
             scales = list(),
Line 162... Line 164...
162 
             give.Rkern = FALSE,
 164 
             give.Rkern = FALSE,
163 
             n = 50,
 165 
             n = 50,
164 
             from = NULL,
 166 
             from = NULL,
165 
             to = NULL,
 167 
             to = NULL,
166 
             cut = NULL,
 168 
             cut = NULL,
167 
             na.rm = NULL,
 169 
             na.rm = TRUE,
168 
             drop.unused.levels = lattice.getOption("drop.unused.levels"),
 170 
             drop.unused.levels = lattice.getOption("drop.unused.levels"),
169 
             ...,
 171 
             ...,
170 
             default.scales = list(),
 172 
             default.scales = list(),
171 
             panel.groups = "panel.densityplot",
 173 
             panel.groups = "panel.densityplot",
172 
             subscripts = !is.null(groups),
 174 
             subscripts = !is.null(groups),
Line 277... Line 279...
277 
 
 279 
 
278 
    ## Step 4: Decide if log scales are being used:
 280 
    ## Step 4: Decide if log scales are being used:
279 
 
 281 
 
280 
    have.xlog <- !is.logical(foo$x.scales$log) || foo$x.scales$log
 282 
    have.xlog <- !is.logical(foo$x.scales$log) || foo$x.scales$log
281 
    have.ylog <- !is.logical(foo$y.scales$log) || foo$y.scales$log
 283 
    have.ylog <- !is.logical(foo$y.scales$log) || foo$y.scales$log
282 
    if (have.xlog) {
 284 
    if (have.xlog)
- 
 
 285 
    {
283 
        xlog <- foo$x.scales$log
 286 
        xlog <- foo$x.scales$log
284 
        xbase <-
 287 
        xbase <-
285 
            if (is.logical(xlog)) 10
 288 
            if (is.logical(xlog)) 10
286 
            else if (is.numeric(xlog)) xlog
 289 
            else if (is.numeric(xlog)) xlog
287 
            else if (xlog == "e") exp(1)
 290 
            else if (xlog == "e") exp(1)
288
291
289 
        x <- log(x, xbase)
 292 
        x <- log(x, xbase)
290 
        if (have.xlim) xlim <- log(xlim, xbase)
 293 
        if (have.xlim) xlim <- log(xlim, xbase)
291 
    }
 294 
    }
292 
    if (have.ylog) {
 295 
    if (have.ylog)
- 
 
 296 
    {
293 
        warning("Can't have log Y-scale")
 297 
        warning("Can't have log Y-scale")
294 
        have.ylog <- FALSE
 298 
        have.ylog <- FALSE
295 
        foo$y.scales$log <- FALSE
 299 
        foo$y.scales$log <- FALSE
296 
    }
 300 
    }
297 
 
 301 
 
298 
    ## Step 5: Process cond
 302 
    ## Step 5: Process cond
299 
 
 303 
 
300 
    cond.max.level <- unlist(lapply(cond, nlevels))
 304 
    cond.max.level <- unlist(lapply(cond, nlevels))
301 
 
 305 
 
- 
 
 306 
    ## old NA-handling
- 
 
 307 
    ##     id.na <- is.na(x)
- 
 
 308 
    ##     for (var in cond)
- 
 
 309 
    ##         id.na <- id.na | is.na(var)
- 
 
 310 
    ##     if (!any(!id.na)) stop("nothing to draw")
- 
 
 311 
 
- 
 
 312 
    ## new NA-handling: will retain NA's in x
302 
 
 313 
 
303 
    id.na <- is.na(x)
 - 
 
304 
    for (var in cond)
 - 
 
305 
        id.na <- id.na | is.na(var)
 314 
    id.na <- do.call("pmax", lapply(cond, is.na))
306 
    if (!any(!id.na)) stop("nothing to draw")
 315 
    if (!any(!id.na)) stop("nothing to draw")
307 
    ## Nothing simpler ?
 - 
 
- 
 
 316 
 
308 
 
 317 
 
309 
    ## Step 6: Evaluate layout, panel.args.common and panel.args
 318 
    ## Step 6: Evaluate layout, panel.args.common and panel.args
310 
 
 319 
 
311 
    foo$panel.args.common <- c(dots, list(darg = darg))
 320 
    foo$panel.args.common <- c(dots, list(darg = darg))
312 
    if (subscripts) {
 321 
    if (subscripts)
- 
 
 322 
    {
313 
        foo$panel.args.common$groups <- groups
 323 
        foo$panel.args.common$groups <- groups
314 
        foo$panel.args.common$panel.groups <- panel.groups
 324 
        foo$panel.args.common$panel.groups <- panel.groups
315 
    }
 325 
    }
316 
 
 326 
 
317 
 
 327 
 
318 
    nplots <- prod(cond.max.level)
 328 
    nplots <- prod(cond.max.level)
319 
    if (nplots != prod(sapply(foo$condlevels, length))) stop("mismatch")
 329 
    if (nplots != prod(sapply(foo$condlevels, length))) stop("mismatch")
320 
    foo$panel.args <- vector(mode = "list", length = nplots)
 330 
    foo$panel.args <- vector(mode = "list", length = nplots)
321 
 
 331 
 
322 
 
 - 
 
323 
    cond.current.level <- rep(1, number.of.cond)
 332 
    cond.current.level <- rep(1, number.of.cond)
324 
 
 333 
 
325 
 
 - 
 
326 
    for (panel.number in seq(length = nplots))
 334 
    for (panel.number in seq(length = nplots))
327 
    {
 335 
    {
328 
 
 - 
 
329
- 
 
330 
        id <- !id.na
 336 
        id <- !id.na
331 
        for(i in 1:number.of.cond)
 337 
        for(i in seq(length = number.of.cond))
332 
        {
 338 
        {
333 
            var <- cond[[i]]
 339 
            var <- cond[[i]]
334 
            id <- id &
 340 
            id <- id &
335 
            if (is.shingle(var))
 341 
            if (is.shingle(var))
336 
                ((var >=
 342 
                ((var >=
Line 350... Line 356...
350 
            cupdate(cond.current.level,
 356 
            cupdate(cond.current.level,
351 
                    cond.max.level)
 357 
                    cond.max.level)
352 
    }
 358 
    }
353 
 
 359 
 
354 
 
 360 
 
- 
 
 361 
    more.comp <-
355 
    more.comp <- c(limits.and.aspect(prepanel.default.densityplot,
 362 
        c(limits.and.aspect(prepanel.default.densityplot,
356 
                                     prepanel = prepanel,
363 
                            prepanel = prepanel,
357 
                                     have.xlim = have.xlim, xlim = xlim,
364 
                            have.xlim = have.xlim, xlim = xlim,
358 
                                     have.ylim = have.ylim, ylim = ylim,
365 
                            have.ylim = have.ylim, ylim = ylim,
359 
                                     x.relation = foo$x.scales$relation,
 366 
                            x.relation = foo$x.scales$relation,
360 
                                     y.relation = foo$y.scales$relation,
 367 
                            y.relation = foo$y.scales$relation,
361 
                                     panel.args.common = foo$panel.args.common,
 368 
                            panel.args.common = foo$panel.args.common,
362 
                                     panel.args = foo$panel.args,
 369 
                            panel.args = foo$panel.args,
363 
                                     aspect = aspect,
 370 
                            aspect = aspect,
364 
                                     nplots = nplots,
 371 
                            nplots = nplots,
365 
                                     x.axs = foo$x.scales$axs,
 372 
                            x.axs = foo$x.scales$axs,
366 
                                     y.axs = foo$y.scales$axs),
 373 
                            y.axs = foo$y.scales$axs),
367 
                   cond.orders(foo))
 374 
          cond.orders(foo))
368 
    foo[names(more.comp)] <- more.comp
 375 
    foo[names(more.comp)] <- more.comp
369 
 
 376 
 
370 
 
 377 
 
371 
    if (is.null(foo$legend) && !is.null(groups) &&
 378 
    if (is.null(foo$legend) && !is.null(groups) &&
372 
        (is.list(auto.key) || (is.logical(auto.key) && auto.key)))
 379 
        (is.list(auto.key) || (is.logical(auto.key) && auto.key)))