[Rd] lattice/grid: problem with viewports for strips with zero height

Paul Murrell p.murrell at auckland.ac.nz
Fri Mar 19 00:34:37 MET 2004


Hi

Thanks for the bug report!
There is a fix in for R 1.9.0 (due in a couple of weeks)

Paul


Deepayan Sarkar wrote:
> On Wednesday 03 March 2004 04:08, Wolfram Fischer wrote:
> 
>>PROBLEM
>>        # Allocating strip labels by the function strip.fun():
>>
>>    strip.test()
>>        # Result: No strips: ok. No strings: NOT OK.
>>        # The distance ``y.text=unit(6,"points")'' is ignored;
>>        # the strings are not seen on the output.
> 
> 
> 
> Looks like a grid bug/feature where non-zero 'y' in grid.text doesn't work 
> for viewports with zero height, even if clipping is turned off. Simpler 
> example:
> 
> grid.text("some text", y = unit(6, "points"), 
>           just = c("center", "bottom"), 
>           vp = viewport(x = .5, y = .5, h = 0, clip = FALSE))
>                                         ^^^^^
> 
> (Works if h > 0)
> 
> 
> 
>>TRIALS FOR WORKAROUNDS
>>
>>    strip.test( strip.lines=1 )
>>        # Result: 2 strips: ok, but not whished. 2 strings: ok.
>>
>>    strip.test( y.text=0 )
>>        # Result: No strips: ok. 2 strings: ok, but not pretty.
>>
>>    strip.test( strip.lines=0.01 )
>>        # Result: 2 very narrow strips: ok, but not whished. 2 strings:
>>ok.
> 
> 
> The third workaround looks OK to me. You can make strip.lines as small as 
> you want as long as it's positive.
> 
> 
> Anyway, I would take a different approach (creating a new factor) for what 
> you are trying to do:
> 
> 
> 
> 
> combine.factors <- function(..., sep = "/",
>                             drop = FALSE,
>                             reverse = FALSE)
> {
>     ## each argument in ... should be a factor,
>     ## first varies fastest
> 
>     dots <- lapply(list(...), as.factor)
>     dotlevels <- lapply(dots, levels)
>     dotchars <- lapply(dots, as.character)
>     final.levels <- dotlevels[[1]]
>     if (length(dotlevels) > 1)
>         for (i in 2:length(dotlevels))
>             final.levels <-
>                 if (reverse)
>                     as.vector(t(outer(dotlevels[[i]],
>                                       final.levels,
>                                       paste, sep = sep)))
>                 else
>                     as.vector(outer(final.levels,
>                                     dotlevels[[i]],
>                                     paste, sep = sep))
>     final.chars <-
>         do.call("paste",
>                 c(if (reverse) rev(dotchars) else dotchars,
>                   list(sep = sep)))
>     ans <- factor(final.chars, levels = final.levels)
>     if (drop) ans <- ans[, drop = TRUE]
>     ans
> }
> 
> 
> data(barley)
> dotplot(variety ~ yield | combine.factors(year, site,
>                                           sep = "    ",
>                                           reverse = TRUE),
>         data = barley, layout = c(2, 6))
> 
> 
> 
> 
> Deepayan
> 
> 
> 
> 
>>CODE
>>    library( lattice )
>>    library( grid )
>>    data( barley )
>>
>>strip.test <- function( strip.lines=0, y.text=unit( 6, "points" ), ...
>>){ lset( list( clip = list( strip=F ) ) )
>>    strip.fun <- function( which.given, which.panel, factor.levels, ...
>>){ grid.text( label=factor.levels[which.panel[which.given]] , x= 0.5 - (
>>which.given - 1.5 ) * 0.7
>>            , y=y.text
>>            , just=c( c("right","left")[which.given], "bottom" )
>>            )
>>    }
>>    print( dotplot( variety ~ yield | year * site, data=barley
>>        , par.strip.text=list( lines=strip.lines )
>>        , strip=strip.fun
>>        , between=list( y=1.5 )
>>        , ...
>>        ))
>>}
>>
>>
>>Wolfram
>>
>>______________________________________________
>>R-devel at stat.math.ethz.ch mailing list
>>https://www.stat.math.ethz.ch/mailman/listinfo/r-devel
> 
> 
> ______________________________________________
> R-devel at stat.math.ethz.ch mailing list
> https://www.stat.math.ethz.ch/mailman/listinfo/r-devel


-- 
Dr Paul Murrell
Department of Statistics
The University of Auckland
Private Bag 92019
Auckland
New Zealand
64 9 3737599 x85392
paul at stat.auckland.ac.nz
http://www.stat.auckland.ac.nz/~paul/



More information about the R-devel mailing list