Skip to content

Commit

Permalink
partial updates to use new smoke-based system
Browse files Browse the repository at this point in the history
  • Loading branch information
deepayan committed Nov 7, 2009
1 parent 2ce8dc7 commit f0c984c
Show file tree
Hide file tree
Showing 6 changed files with 124 additions and 71 deletions.
83 changes: 42 additions & 41 deletions R/axis.R
Original file line number Diff line number Diff line change
Expand Up @@ -67,89 +67,90 @@ labelWidget <-

qxaxis <-
function(xlim, tick.number = 5,
at = pretty(xlim, tick.number),
labels = as.character(at),
font = qv.font(),
at = NULL,
labels = NULL,
font = qfont(),
side = c("bottom", "top"),
## y = switch(side, bottom = 1, top = 0),
tck = 1,
rot = 0,
hadj = 0.75,
vadj = 0.25, ##switch(side, bottom = 1, top = -0.5),
minheight = 0, minwidth = 0)
minheight = 0, minwidth = 0,
...,
item, painter, exposed)
{
force(labels)
if (is.null(at)) at <- pretty(xlim, tick.number)
if (is.null(labels)) labels <- as.character(at)
side <- match.arg(side)
id <- at >= xlim[1] & at <= xlim[2]
at <- at[id]
labels <- labels[id]
paintFun <-
switch(side,
bottom = function(item, painter, exposed)
{
switch(side,
bottom = {
mosaiq.segments(at, 1, at, 1.3,
col = "black", painter = painter)
qdrawText(painter, labels, at, 0.5,
halign = "center", valign = "center",
rot = rot)
},
top = function(item, painter, exposed)
{
top = {
mosaiq.segments(at, -0.3, at, 0,
col = "black", painter = painter)
qdrawText(painter, labels, at, 0.5,
halign = "center", valign = "center",
rot = rot)
})
axis.layer <- qlayer(NULL, paintFun)
qlimits(axis.layer) <-
qrect(xlim,
switch(side,
bottom = c(0, 1.3),
top = c(-0.3, 1)))
qminimumSize(axis.layer) <- qsize(20, 20)
qcacheMode(axis.layer) <- "none"
qsetItemFlags(axis.layer, "clipsToShape", FALSE)
axis.layer
## axis.layer <- qlayer(NULL, paintFun)
## qlimits(axis.layer) <-
## qrect(xlim,
## switch(side,
## bottom = c(0, 1.3),
## top = c(-0.3, 1)))
## qminimumSize(axis.layer) <- qsize(20, 20)
## qcacheMode(axis.layer) <- "none"
## qsetItemFlags(axis.layer, "clipsToShape", FALSE)
## axis.layer
}


qyaxis <-
function(ylim, tick.number = 5,
at = pretty(ylim, tick.number),
labels = as.character(at),
font = qv.font(),
at = NULL,
labels = NULL,
font = qfont(),
side = c("left", "right"),
x = switch(side, left = 1, right = 0),
tck = 1,
rot = 0,
hadj = switch(side, left = 1, right = 0),
vadj = 0.25,
minheight = 0, minwidth = 0)
minheight = 0, minwidth = 0,
...,
item, painter, exposed)
{
force(labels)
if (is.null(at)) at <- pretty(ylim, tick.number)
if (is.null(labels)) labels <- as.character(at)
side <- match.arg(side)
labels <- switch(side, # FIXME: temporary hack
left = paste(labels, "-"),
right = paste("-", labels))
id <- at >= ylim[1] & at <= ylim[2]
at <- at[id]
labels <- labels[id]
paintFun <- function(item, painter, exposed)
{
## FIXME: how to convey width?
## labsize <- lapply(qstrWidth(painter, labels), max)
qdrawText(painter, labels, x, at,
halign = switch(side, left = "right", right = "left"),
rot = rot)
## add segments
}
## FIXME: how to convey width?
## labsize <- lapply(qstrWidth(painter, labels), max)
qdrawText(painter, labels, x, at,
halign = switch(side, left = "right", right = "left"),
rot = rot)
## add segments

minwidth <- 10 * max(sapply(labels, nchar))
axis.layer <- qlayer(NULL, paintFun)
qlimits(axis.layer) <- qrect(c(0, 1), ylim)
qcacheMode(axis.layer) <- "none"
qsetItemFlags(axis.layer, "clipsToShape", FALSE)
qminimumSize(axis.layer) <- qsize(minwidth, 20)
axis.layer
## axis.layer <- qlayer(NULL, paintFun)
## qlimits(axis.layer) <- qrect(c(0, 1), ylim)
## qcacheMode(axis.layer) <- "none"
## qsetItemFlags(axis.layer, "clipsToShape", FALSE)
qminimumSize(item) <- qsize(minwidth, 20)
## axis.layer
}

55 changes: 42 additions & 13 deletions R/createComponents.R
Original file line number Diff line number Diff line change
Expand Up @@ -67,8 +67,7 @@ create.panels.new <-
qcacheMode(panel.layer) <- "none"
qsetZValue(panel.layer, z)
z <<- z + 1
shared.env$layer.envs[[ length(shared.env$layer.envs) + 1L ]] <-
environment()
registerLayerEnv(shared.env, environment())
})
})
box.layer <-
Expand Down Expand Up @@ -215,17 +214,47 @@ create.axis <-
i <- layout[p]
if (i > 0)
ans[[p]] <-
switch(which,
x = qxaxis(limits[[i]]$xlim,
side = side,
at = limits[[i]]$xat,
labels = limits[[i]]$xlabels,
font = font),
y = qyaxis(limits[[i]]$ylim,
side = side,
at = limits[[i]]$yat,
labels = limits[[i]]$ylabels,
font = font))
local(
{
# make local copy, used on repaint
side <- side
i <- i
paintFun <-
switch(side,
top = ,
bottom = function(item, painter, exposed) {
## str(list(exposed[, 1], side, limits[[i]]$xat))
qxaxis(exposed[, 1], #limits[[i]]$xlim,
side = side,
at = limits[[i]]$xat,
labels = limits[[i]]$xlabels,
font = font,
item = item, painter = painter, exposed = exposed)
},
left = ,
right = function(item, painter, exposed) {
qyaxis(exposed[, 2], #limits[[i]]$ylim,
side = side,
at = limits[[i]]$yat,
labels = limits[[i]]$ylabels,
font = font,
item = item, painter = painter, exposed = exposed)
})


axis.layer <- qlayer(NULL, paintFun = paintFun)
qlimits(axis.layer) <-
switch(side,
top = qrect(limits[[i]]$xlim, c(-0.3, 1)),
bottom = qrect(limits[[i]]$xlim, c(0, 1.3)),
left = ,
right = qrect(c(0, 1), limits[[i]]$ylim))
qminimumSize(axis.layer) <- qsize(20, 20)
qcacheMode(axis.layer) <- "none"
qsetItemFlags(axis.layer, "clipsToShape", FALSE)
registerLayerEnv(shared.env, environment())
axis.layer
})
}
ans
}
Expand Down
25 changes: 22 additions & 3 deletions R/interactors.R
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,12 @@ mosaiq.zoom <- function(which.packet,
}
}

registerLayerEnv <- function(env, layerenv)
{
env$layer.envs[[ length(env$layer.envs) + 1L ]] <- layerenv
}


updateLayerLimits <- function(env)
{
## take all registered layer environments in env and update their
Expand All @@ -43,8 +49,21 @@ updateLayerLimits <- function(env)
limits <- env$limits
lapply(env$layer.envs,
function(x) {
qlimits(x$panel.layer) <-
qrect(limits[[x$i]]$xlim,
limits[[x$i]]$ylim)
if (!is.null(x$panel.layer))
qlimits(x$panel.layer) <-
qrect(limits[[x$i]]$xlim,
limits[[x$i]]$ylim)
if (!is.null(x$axis.layer))
{
cl <- qlimits(x$axis.layer)
qlimits(x$axis.layer) <-
switch(x$side,
top = ,
bottom = qrect(limits[[x$i]]$xlim,
cl[, 2]),
left = ,
right = qrect(cl[, 1],
limits[[x$i]]$ylim))
}
})
}
20 changes: 11 additions & 9 deletions R/limits.R
Original file line number Diff line number Diff line change
Expand Up @@ -32,11 +32,12 @@ combine.limits <-
## combined.

xat <- unlist(lapply(limits, "[[", "xat"))
if (is.null(xat))
if (is.null(xat)) ## numeric: leave alone for auto-generation later
{
if (is.null(xlim)) xlim <- extendrange(unlist(lapply(limits, "[[", "xlim")))
xat <- pretty(xlim, tick.number)
xlabels <- format(xat)
## xat <- pretty(xlim, tick.number)
## xlabels <- format(xat)
xlabels <- NULL
}
else # factor? (not necessarily; e.g., date-time, explicit specification)
{
Expand All @@ -50,8 +51,9 @@ combine.limits <-
if (is.null(yat))
{
if (is.null(ylim)) ylim <- extendrange(unlist(lapply(limits, "[[", "ylim")))
yat <- pretty(ylim, tick.number)
ylabels <- format(yat)
## yat <- pretty(ylim, tick.number)
## ylabels <- format(yat)
ylabels <- NULL
}
else
{
Expand All @@ -77,8 +79,8 @@ combine.limits <-
if (is.null(limits[[i]][["xat"]]))
{
limits[[i]][["xlim"]] <- extendrange(limits[[i]][["xlim"]])
limits[[i]][["xat"]] <- pretty(limits[[i]][["xlim"]], tick.number)
limits[[i]][["xlabels"]] <- format(limits[[i]][["xat"]])
## limits[[i]][["xat"]] <- pretty(limits[[i]][["xlim"]], tick.number)
## limits[[i]][["xlabels"]] <- format(limits[[i]][["xat"]])
}
else
{
Expand All @@ -102,8 +104,8 @@ combine.limits <-
if (is.null(limits[[i]][["yat"]]))
{
limits[[i]][["ylim"]] <- extendrange(limits[[i]][["ylim"]])
limits[[i]][["yat"]] <- pretty(limits[[i]][["ylim"]], tick.number)
limits[[i]][["ylabels"]] <- format(limits[[i]][["yat"]])
## limits[[i]][["yat"]] <- pretty(limits[[i]][["ylim"]], tick.number)
## limits[[i]][["ylabels"]] <- format(limits[[i]][["yat"]])
}
else
{
Expand Down
2 changes: 1 addition & 1 deletion README
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,7 @@ Ideas:

* High-level function calls could be of the form

qvplot(data = environment(), enclos = .GlobalEnv,
mosaiq(data = environment(), enclos = .GlobalEnv,
margin.vars = list(a = expression(a), b = expression(b)),
packets = packets(margin.vars, data),

Expand Down
10 changes: 6 additions & 4 deletions demo/lattice-working.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,14 +4,16 @@ library(mosaiq)

## export.mosaiq("fig/mosaiq_%03g.png")

N <- 10000

mydata <-
data.frame(x = 1:10000, y = rnorm(10000),
g = gl(3, 1, 10000, labels = month.name[1:3]),
a = gl(1, 10000))
data.frame(x = 1:N, y = rnorm(N),
g = gl(3, 1, N, labels = month.name[1:3]),
a = gl(1, N))

mosaiq.xyplot(y ~ x, data = mydata,
margin = ~g,
layout = c(1, 1),
##layout = c(1, 1),
## groups = g,
grid = TRUE)

Expand Down

0 comments on commit f0c984c

Please sign in to comment.