Select a data source: utility_A utility_B

dum = capture.output({library(lattice);library(grid);library(Hmisc)})
if (!exists("DATA")) {
  load("utility_A.RData")
} else {
  load(RpadBaseFile(paste(DATA,".RData", sep = "")))
} 

varLabels = c(
  events = "Interruption events",
  ci = "Customer interruptions",
  cmi = "Customer minutes of interruption",
  temp = "Mean temperature for the day in degrees Fahrenheit",
  dewp = "Mean dew point for the day in degrees Fahrenheit",
  slp = "Mean sea level pressure for the day in millibars",
  stp = "Mean station pressure for the day in millibars",
  visib = "Mean visibility for the day in miles",
  wdsp = "Mean wind speed for the day in knots",
  mxspd = "Maximum sustained wind speed reported for the day in knots",
  gust = "Maximum wind gust reported for the day in knots",
  max = "Maximum temperature reported during the day in Fahrenheit",
  min = "Minimum temperature reported during the day in Fahrenheit",
  prcp = "Total precipitation (rain and/or melted snow) reported during the day in inches",
  sndp = "Snow depth in inches",
  Fog = "Fog indicator",
  Rain = "Rain indicator",
  Snow = "Snow indicator",
  Hail = "Hail indicator",
  Thunder = "Thunder indicator",
  Tornado = "Tornado indicator",
  Weather = "Any of snow/fog/rain/hail/thunder/tornado indicators",
  wind = "Maximum of mxspd and gust in knots",
  hasGust = "Gusts were reported")


# defaults:
Y = names(a)[1]; X = names(a)[2]; panel = group = "NONE"; lineFit = FALSE
autoAgFunNames = c("mean",  "q05", "q25", "median", "q75", "q95")
vnames = names(a)
HTMLon()
H("form", onSubmit="alert('hello');return true",
  H("p",
    "Y variable:",
    HTMLselect("Y", dojoType="combobox", autocomplete="false", names(a)),
    "X variable:",
    HTMLselect("X", dojoType="combobox", autocomplete="false", names(a), default = 4),
    "Panel variable:",
    HTMLselect("panel", dojoType="combobox", autocomplete="false", c("NONE",names(a)))),
  H("p",
    H("b", "Groupings: "),
    "Color:",
    HTMLselect("colgroup", dojoType="combobox",  autocomplete="false", c("NONE",names(a)), default = 1 + which(names(a) == "dewp")),
    "Size:",
    HTMLselect("sizegroup", dojoType="combobox", c("NONE",names(a)), default = 1 + which(names(a) == "wind")),
    "Shape:",
    HTMLselect("shapegroup", dojoType="combobox", c("NONE",names(a)), default = 1 + which(names(a) == "prcp")),
    "Fill:",
    HTMLselect("fillgroup", dojoType="combobox", c("NONE",names(a)), default = 1 + which(names(a) == "Thunder"))),
  H("p",
##     "Auto-aggregation function:",
##     HTMLselect("agFun", c("NONE",autoAgFunNames)),
    H("input", name="lineFit", id="lineFit", type="checkbox"),
    H("label", "for"="lineFit", "Include line fit"),
    H("input", name="lowessFit", id="lowessFit", type="checkbox"),
    H("label", "for"="lowessFit", "Include smooth fit")),
  H("p",
    "Date from:",
    H("input", dojoType = "dropdowndatepicker", name = "fromDate",
      value = as.character(min(a$date)), displayFormat = "yyyy/MM/dd"),
    "to:",
    H("input", dojoType = "dropdowndatepicker", name="toDate",
      value = as.character(max(a$date)), displayFormat = "yyyy/MM/dd"),
    H("input", type="button", value="Plot", onclick="javascript:rpad.calculatePage()")))

trim = function(x)  gsub(pattern = "^ *| *$", "", x)

X = trim(X); Y = trim(Y); panel = trim(panel)
colgroup = trim(colgroup); sizegroup = trim(sizegroup)
shapegroup = trim(shapegroup); fillgroup = trim(fillgroup)
if (!is.null(panel) && panel == "NONE") panel = NULL
if (!is.null(colgroup) && colgroup == "NONE") colgroup = NULL
if (!is.null(sizegroup) && sizegroup == "NONE") sizegroup = NULL
if (!is.null(shapegroup) && shapegroup == "NONE") shapegroup = NULL
if (!is.null(fillgroup) && fillgroup == "NONE") fillgroup = NULL

plotType = c("p", if (lineFit) "r", if (lowessFit) "smooth")

a.subset = subset(a, date >= as.Date(fromDate) & date <= as.Date(toDate))
a.subset$date = as.POSIXct(a.subset$date)

## make group and/or panel numerics into factors:
getVar = function(x) with(a.subset, eval(parse(text=x)))
ag = data.frame(                                               
  X = getVar(X),                                           
  Y = getVar(Y))                                           
if (!is.null(panel))     ag$panel      = getVar(panel)     
if (!is.null(colgroup))  ag$colgroup   = getVar(colgroup)
if (!is.null(sizegroup)) ag$sizegroup  = getVar(sizegroup) 
if (!is.null(shapegroup))ag$shapegroup = getVar(shapegroup)
if (!is.null(fillgroup)) ag$fillgroup  = getVar(fillgroup)

# defaults:
col = fill = "forestgreen"; pch = 21; cex = .7; lwd = 1; legend = NULL

makeFactors = function(x, levs = 4) {
  if (is.numeric(x) && length(unique(x)) > levs)
    x = cut2(x, g = levs)
  if (is.logical(x))
    x = factor(x)
  x
}
if (!is.null(panel)) { 
  ag$panel = makeFactors(ag$panel)
  levels(ag$panel) = paste(panel, ": ", levels(ag$panel), sep = "")
}
keys = list()
if (!is.null(colgroup)) { 
  ag$colgroup = makeFactors(ag$colgroup)
  col = fill = c("forestgreen", "darkred", "darkblue", "violet")[as.numeric(ag$colgroup)]
  keys[["colgroup"]] = list(border = FALSE, colums = 2,
        title = colgroup, 
        text = list(levels(ag$colgroup)),
        points = list(pch = 15, col = c("forestgreen", "darkred", "darkblue", "violet"), cex = 2))
}
if (!is.null(sizegroup)) { 
  ag$sizegroup = makeFactors(ag$sizegroup)
  cex = approx(x=range(as.numeric(ag$sizegroup)), y=c(.5,1), xout=as.numeric(ag$sizegroup))$y
  keys[["sizegroup"]] = list(border = FALSE, colums = 2,
        title = sizegroup, 
        text = list(levels(ag$sizegroup)),
        points = list(pch = 15, col = "forestgreen", cex = sort(unique(cex))))
}
if (!is.null(shapegroup)) { 
  ag$shapegroup = makeFactors(ag$shapegroup)
  pch = (21:24)[ag$shapegroup]
  keys[["shapegroup"]] = list(border = FALSE, colums = 2,
##         cex.title = 1.2,
##         lines.title = 2,
        title = shapegroup, 
        text = list(levels(ag$shapegroup)),
        points = list(pch = (21:24)[1:nlevels(ag$shapegroup)]))
}
if (!is.null(fillgroup)) { 
  ag$fillgroup = makeFactors(ag$fillgroup, levs = 2)
  fill = ifelse(as.numeric(ag$fillgroup) == 2, col, NA)
  keys[["fillgroup"]] = list(border = FALSE, colums = 2,
        title = fillgroup, 
        text = list(levels(ag$fillgroup)),
        points = list(pch = c(1,19), col = "forestgreen"))
}
pnl = function(x, y, groups, subscripts, col, pch, fill, cex, ...) {
  getIdx = function(x) if (length(x) > 1) subscripts else TRUE
  panel.xyplot(x, y, col = col[getIdx(col)], pch = pch[getIdx(pch)],
               fill = fill[getIdx(fill)], cex = cex[getIdx(cex)], ...)
}

# accumulate legends
grobkeys = lapply(keys, function(x) draw.key(x, draw=F))
## gf = frameGrob()
## for (i in seq(len=length(grobkeys))) {
##   gf = packGrob(gf, grobkeys[[i]], row = i)
## }

# adapted from the reshape library
width = do.call(max, lapply(grobkeys, widthDetails))
heights = do.call(unit.c, lapply(grobkeys, function(x) heightDetails(x) * 
   1.1))
fg = frameGrob(grid.layout(nrow = length(grobkeys), 1, widths = width, 
               heights = heights, just = "centre"), name = "legends")
for (i in 1:length(grobkeys)) {
    fg = placeGrob(fg, grobkeys[[i]], row = i)
}
if (length(keys) > 0)
  legend = list(right = list(fun=fg))

newgraph(width = 8)
trellis.par.set(theme = col.whitebg())
frm = as.formula(paste("Y ~ X", if (!is.null(panel)) "| panel"))
xyplot(frm, data = ag,
       as.table = TRUE,
       xlab = X,
       ylab = Y,
       type = plotType,
       col = col,
       pch = pch,
       lwd = 2,
       cex = cex,
       fill = fill,
       legend = legend,
       panel = pnl
       )
HTMLon()
showgraph(link = TRUE)
BR
varGroup = setdiff(unique(c(X, Y, panel, colgroup, sizegroup, shapegroup, fillgroup)),
                   "date")
idx = !is.na(varLabels[varGroup])
H(NULL, H("p", paste(varGroup[idx], "=", varLabels[varGroup][idx]), collapseContents = FALSE))