XY <- function(x, y, data=d, filter=NULL,

    by=NULL,
    facet=NULL, n_row=NULL, n_col=NULL, aspect="fill",

    form=c("scatter", "smooth", "contour", "hexbin"),

    theme=getOption("theme"),
    fill=NULL, color=NULL,
    transparency=getOption("trans_pt_fill"),

    enhance=FALSE, means=TRUE,
    pt_size=NULL, pt_size_cut=NULL, pt_shape="circle", line_width=1.5,
    segments=FALSE, segments_y=FALSE, segments_x=FALSE,

    sort=c("0", "-", "+"),
    jitter_x=NULL, jitter_y=NULL,

    ID="row.name", ID_size=0.60,
    MD_cut=0, out_cut=0, out_shape="circle", out_size=1,

    fit=c("off","loess", "lm", "ls", "null", "exp", "quad",
          "power", "log"),
    fit_power=1, fit_se=0.95,
    fit_color=getOption("fit_color"), fit_lwd=getOption("fit_lwd"),
    fit_new=NULL, plot_errors=FALSE, ellipse=0,
    ellipse_fill=getOption("ellipse_fill"),
    ellipse_color=getOption("ellipse_color"),
    ellipse_lwd=getOption("ellipse_lwd"),

    ts_unit=NULL, ts_ahead=0, ts_method=c("es", "lm"),
    ts_source=c("fable", "classic"), ts_agg=c("sum", "mean"),
    ts_NA=NULL, ts_format=NULL, ts_fitted=FALSE, ts_PI=.95,
    ts_trend=NULL, ts_seasons=NULL, ts_error=NULL,
    ts_alpha=NULL, ts_beta=NULL, ts_gamma=NULL, ts_new_x=NULL,
    ts_stack=FALSE, ts_area_fill="transparent", ts_area_split=0,
    ts_n_x_tics=NULL,
    show_runs=FALSE,
    center_line=c("off", "mean", "median", "zero"),

    radius=NULL, power=0.5, low_fill=NULL, hi_fill=NULL,

    smooth_points=100, smooth_size=1,
    smooth_power=0.25, smooth_bins=128, hex_bins=30, hexbin_legend=TRUE,
    n_bins=1,
    contour_n=20, contour_nbins=50, contour_points=FALSE,
    contour_legend=FALSE,

    bin=FALSE, bin_start=NULL, bin_width=NULL, bin_end=NULL,
    breaks="Sturges", cumulate=FALSE,

    xlab=NULL, ylab=NULL, main=NULL, sub=NULL,
    label_adjust=c(0,0), margin_adjust=c(0,0,0,0),  # top, right, bottom, left
    pad_x=c(0,0), pad_y=c(0,0),

    scale_x=NULL, scale_y=NULL, origin_x=NULL, origin_y=NULL,

    rotate_x=getOption("rotate_x"), rotate_y=getOption("rotate_y"),
    offset=getOption("offset"),
    axis_fmt=c("K", ",", ".", ""), axis_x_prefix="", axis_y_prefix="",
    font_size=1,
    xy_ticks=TRUE, n_axis_x_skip=0, n_axis_y_skip=0,

    legend_title=NULL,

    add=NULL, x1=NULL, y1=NULL, x2=NULL, y2=NULL,

    quiet=getOption("quiet"), do_plot=TRUE,
    use_plotly=getOption("lessR.use_plotly"),
    pdf_file=NULL, width=6.5, height=6,
    digits_d=NULL,

    smooth=FALSE,
    stat=c("mean", "sum", "sd", "deviation", "min", "median", "max"),
    stat_x=c("count", "proportion", "%"),

    eval_df=NULL, fun_call=NULL, ...) {


  # y is required unless stat_x set, the freq_poly delegation from X()
  if (missing(y)  &&  missing(stat_x)) {
    if (tryCatch(is.ts(x), error = function(e) FALSE)) {
      stop(call.=FALSE, "\n------\n",
        "x is a time series (class ts).\n",
        "First extract the date and value vectors with tsExtract(),\n",
        "then pass them to XY().\n\n")
    } else {
      stop(call.=FALSE, "\n------\n",
        "Argument y is required.\n",
        "For the distribution of a single variable, use X().\n\n")
    }
  }

  if (is.null(fun_call)) fun_call <- match.call()

  if (nzchar(axis_fmt[1])) axis_fmt <- match.arg(axis_fmt)
  form <- match.arg(form)

  if (font_size != 1) {
    .fs_main   <- getOption("main_size", 1.1)
    .fs_lab    <- getOption("lab_size",  1.0)
    .fs_axis   <- getOption("axis_size", 0.76)
    .fs_axis_x <- getOption("axis_x_size")
    .fs_axis_y <- getOption("axis_y_size")
    options(main_size = .fs_main * font_size,
            lab_size  = .fs_lab  * font_size,
            axis_size = .fs_axis * font_size)
    if (!is.null(.fs_axis_x))
      options(axis_x_size = .fs_axis_x * font_size)
    if (!is.null(.fs_axis_y))
      options(axis_y_size = .fs_axis_y * font_size)
    on.exit({
      options(main_size = .fs_main,
              lab_size  = .fs_lab,
              axis_size = .fs_axis)
      if (!is.null(.fs_axis_x)) options(axis_x_size = .fs_axis_x)
      if (!is.null(.fs_axis_y)) options(axis_y_size = .fs_axis_y)
    }, add = TRUE)
  }

  # collected plotly style options, passed down to plotly internals so they
  # don't reach into getOption() themselves
  style.opts <- .plotly_style()

  ts_agg <- match.arg(ts_agg)
  ts_method <- match.arg(ts_method)
  ts_source <- match.arg(ts_source)
  # "dot" is undocumented but supported — routes to the Trellis dot chart
  # path (Base R, with facet support) until Chart() gains its own facet dots
  dot.type <- identical(form, "dot")
  if (dot.type) form <- "scatter"  # satisfies match.arg; overridden below

  stat.miss <- missing(stat)
  if (stat[1] != "data") stat <- match.arg(stat)  # if condition for shiny
  stat.x.miss <- missing(stat_x)
  stat_x <- match.arg(stat_x)

  trans.miss <- missing(transparency)
  trans <- transparency

  output <- NULL
  out_fitted <- NULL
  out_y.frcst <- NULL

  # Plotly renders only the interactive scatter/line form; the density and
  #   hexbin forms are static (base R / lattice), as is any faceted plot
  if (!quiet && use_plotly &&
      !(form %in% c("smooth", "contour", "hexbin")) &&
      is.null(substitute(facet))) {
    txt <- "[Interactive chart from the Plotly R package (Sievert, 2020)]"
    cat(txt, "\n")
  }

  if (!stat.miss && !stat.x.miss) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Cannot specify both parameters:  stat  and  stat_x\n\n")
  }
  y.miss <- missing(y)
  if (!stat.x.miss && !y.miss) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Use parameter  stat to aggregate numerical variable y.\n",
      "Parameter  stat_x  is only for the categorical variable x.\n\n")
  }
  if (stat.miss) stat <- "data"  # no aggregation
  if (stat.miss  &&  !stat.x.miss) stat <- stat_x

  if (!missing(contour_n) || !missing(contour_nbins) ||
      !missing(contour_points) || !missing(contour_legend))
    form <- "contour"

  if (!is.null(ts_unit)) {
    valid.units <- c("days", "weeks", "months", "quarters", "years", "days7")
    if (!(ts_unit %in% valid.units)) {
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "Invalid value for parameter ts_unit. Valid values:\n",
        "  \"days\", \"weeks\", \"months\", \"quarters\", \"years\", \"days7\"
        \n\n")
    }
  }

  if (!is.null(ts_error) && is.logical(ts_error)) {
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "Parameter  ts_error  now set to  'A' (additive) or ",
        "'M' (multiplicative).\n Enter  ?Plot  to view the details.\n\n")
    }

  if (!is.null(ts_trend) && is.logical(ts_trend)) {
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "Parameter  ts_trend  now set to  'A' (additive) or ",
        "'M' (multiplicative).\n Enter  ?Plot  to view the details.\n\n")
    }

  if (!is.null(ts_seasons) && is.logical(ts_seasons)) {
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "Parameter  ts_seasons  now set to  'A' (additive) or ",
        "'M' (multiplicative).\n Enter  ?Plot  to view the details.\n\n")
    }

  if (!is.null(ts_unit)  &&  !is.null(substitute(facet))) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Parameter  ts_unit  does not yet apply to facet plots.\n\n")
  }

  if (form %in% c("smooth", "contour", "hexbin")  &&
      !is.null(substitute(by))) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Parameter  by  is active only for a scatter plot, form=\"scatter\".\n\n")
  }

  if (form %in% c("contour", "smooth", "hexbin")  &&  !is.null(add)) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Parameter  add  not active for ", form, " plots.\n\n")
  }

  if (is.logical(fit[1])) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Now specify a value for  fit  such as \"loess\" or \"lm\".\n\n")
  }

  if (fit[1] %in% c("xlog", "xylog")) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Parameters  xlog  and  xylog  not yet implemented.\n\n")
  }
  if (smooth) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Parameter  smooth  is now the value of parameter  form.\n",
      "  because  \"contour\"  is now another value of  form.\n",
      "Now enter: form=\"smooth\"  or  form=\"contour\"\n\n")
  }

  fit.ln <- ifelse (!missing(fit), match.arg(fit), "off")
  if (fit.ln == "ls") fit.ln <- "lm"  # least squares synonym

  if (!is.null(fit_new))
    fit_new <- base::sort(fit_new)  # ensure ascending order of fit_new


# old stuff ---------------------------------------------------------------

  # Check for deprecated parameter names using the unevaluated call —
  # must use match.call() here, not names(list(...)), because expressions
  # like rows=(Gender=="M") would be evaluated in the caller's environment
  # before list(...) is reached, causing "object not found" errors.
  .mc_nms <- names(match.call())
  if ("facet1" %in% .mc_nms || "facet2" %in% .mc_nms) {
    stop(call. = FALSE, "\n------\n",
         "The arguments 'facet1' and 'facet2' are replaced.\n",
         "Please use 'facet' instead.\n",
         "For two facets, specify:  facet = c(Var1, Var2)\n\n")
  }
  if ("rows" %in% .mc_nms) {
    stop(call. = FALSE, "\n------\n",
         "Parameter  rows  has been renamed.\n",
         "Use  filter  instead, e.g., filter = (Age > 30)\n\n")
  }
  if ("area_fill" %in% .mc_nms) {
    stop(call. = FALSE, "\n------\n",
         "Parameter  area_fill  has been renamed to  ts_area_fill.\n\n")
  }
  if ("n_cat" %in% .mc_nms) {
    stop(call. = FALSE, "\n------\n",
         "Parameter  n_cat  has been removed.\n",
         "Convert categorical integer variables to factors instead:\n",
         "  e.g., d$Item1 <- factor(d$Item1)\n\n")
  }
  if ("value_labels" %in% .mc_nms) {
    stop(call. = FALSE, "\n------\n",
         "Parameter  value_labels  has been removed.\n",
         "Convert categorical integer variables to factors instead:\n",
         "  e.g., d$Item1 <- factor(d$Item1, levels=1:3,\n",
         "         labels=c(\"Disagree\", \"Neutral\", \"Agree\"))\n\n")
  }
  if ("size" %in% .mc_nms) {
    stop(call. = FALSE, "\n------\n",
         "Parameter  size  has been renamed to  pt_size.\n\n")
  }
  if ("size_cut" %in% .mc_nms) {
    stop(call. = FALSE, "\n------\n",
         "Parameter  size_cut  has been renamed to  pt_size_cut.\n\n")
  }
  if ("shape" %in% .mc_nms) {
    stop(call. = FALSE, "\n------\n",
         "Parameter  shape  has been renamed to  pt_shape.\n\n")
  }

  # a dot in a parameter name to an underscore and more
  dots <- list(...)
  .style.trap(names(dots))

  if (length(dots) > 0) {
    for (i in seq_along(dots)) {
      if (names(dots)[i] == "type") {
        cat("\n"); stop(call.=FALSE, "\n","------\n",
            "Parameter  type  renamed  form\n\n")
      }
      if (names(dots)[i] == "lty") {
        cat("\n"); stop(call.=FALSE, "\n------\n",
          "Parameter  lty  renamed to  line_type\n\n")
      }
      if (names(dots)[i] == "lwd") {
        cat("\n"); stop(call.=FALSE, "\n------\n",
          "Parameter  lwd  renamed to  line_width\n\n")
      }
      if (names(dots)[i] == "ts_PIlevel") {
        ts_PI <- dots[[i]]
        message("\nParameter  ts_PIlevel  is now named  ts_PI\n")
      }
      if (names(dots)[i] == "stack") {
        ts_stack <- dots[[i]]
        message("\nParameter  stack  is now named  ts_stack\n")
      }
      if (names(dots)[i] == "sort_yx") {
        sort <- dots[[i]]
        message("\nParameter  sort_yx  is now named  sort\n")
      }
      if (names(dots)[i] == "lab_adjust") {
        label_adjust <- dots[[i]]
        message("\nParameter  lab_adjust  is now named  label_adjust\n")
      }
      if (names(dots)[i] == "stat_yx") stat <- dots[[i]]
      if (names(dots)[i] == "smooth_exp") smooth_power <- dots[[i]]
      if (names(dots)[i] == "area_origin") ts_area_split <- dots[[i]]
      if (grepl(".", names(dots)[i], fixed=TRUE)) {
        nm <- gsub(".", "_", names(dots)[i], fixed=TRUE)
        assign(nm, dots[[i]])
      }
    }
  }

  if (!is.null(x1)) if ("mean.x" %in% x1) x1 <- "mean_x"
  if (!is.null(y1)) if ("mean.y" %in% y1) y1 <- "mean_y"
  if (!is.null(add)) if ("h.line" %in% add[1])  add[1] <- "h_line"
  if (!is.null(add)) if ("v.line" %in% add[1])  add[1] <- "v_line"

  if ("on" %in% fill) fill <- getOption("violin_fill")
  if ("on" %in% ts_area_fill) ts_area_fill <- getOption("violin_fill")

  # Note: stat is both object (dot plot) and statistic

  # limit actual argument to alternatives, perhaps abbreviated
  sort <- match.arg(sort)

  cl.miss <- missing(center_line)
  center_line <- match.arg(center_line)

  data.do <- stat == "data"

  proportion <- FALSE  # old signal, not used for stat_x="proportion"

  if (plot_errors)
    if (fit.ln == "off") fit.ln <- "lm"

  if (length(pad_x) == 1) {  # only the first element of pad_x specified
    temp <- pad_x
    pad_x <- double(length=2)
    pad_x[1] <- temp
    pad_x[2] <- temp
  }
  if (length(pad_y) == 1) {
    temp <- pad_y
    pad_y <- double(length=2)
    pad_y[1] <- temp
    pad_y[2] <- temp
  }

  cat.x <- FALSE;  cat.y <- FALSE

 if (is.null(fill))
    pt.fill <- getOption("pt_fill")
  else
    pt.fill <- fill
  pt.color <- color
  bbl.txt.col <- getOption("bubble_text_color")
  segment_color <- getOption("segment_color")
  ID_color <- getOption("ID_color")

  se_fill <- getOption("se_fill")

  out_fill <- getOption("out_fill")
  out_color <- getOption("out_color")
  out2_fill <- getOption("out2_fill")
  out2_color <- getOption("out2_color")

  panel_fill <- getOption("panel_fill")
  panel_color <- getOption("panel_color")

  lab_size <- getOption("lab_size")  # NOT passed to .plt.main
  axis_size <- getOption("axis_size")
  main_size <- getOption("main_size")

  add_size <- getOption("add_size")
  add_lwd <- getOption("add_lwd")
  add_lty <- getOption("add_lty")
  add_color <- getOption("add_color")
  add_fill <- getOption("add_fill")
  add_trans <- getOption("add_trans")

  if (theme != getOption("theme")) {  # not the current theme
    old_theme <- getOption("theme")
    style(theme)
    on.exit(style(old_theme), add=TRUE)
    style.opts <- .plotly_style()  # re-capture under new theme
    if (font_size != 1) {  # style() reset font sizes; re-scale
      options(main_size = getOption("main_size", 1.1) * font_size,
              lab_size  = getOption("lab_size",  1.0) * font_size,
              axis_size = getOption("axis_size", 0.76) * font_size)
      .new_x <- getOption("axis_x_size")
      .new_y <- getOption("axis_y_size")
      if (!is.null(.new_x)) options(axis_x_size = .new_x * font_size)
      if (!is.null(.new_y)) options(axis_y_size = .new_y * font_size)
    }
    sty <- style(theme, reset=FALSE)
    trans <- sty$pt$trans_fill
    fill <- sty$pt$fill
    pt.fill <- sty$pt$fill
    pt.color <- sty$pt$fill  # just solid color points
    ellipse_fill <- sty$ellipse$fill
    se_fill <- sty$se_fill
  }

  # missing function only reliable if arg not modified, so capture
  x.miss         <- missing(x)
  by.miss        <- missing(by)
  facet.miss     <- missing(facet)
  size.miss      <- missing(pt_size)
  shape.miss     <- missing(pt_shape)
  radius.miss    <- missing(radius)
  fill.miss      <- missing(fill)
  if (is.null(fill)) fill.miss <- TRUE  # shiny sets fill at NULL if by var
  color.miss     <- missing(color)
  ts.area.fill.miss  <- missing(ts_area_fill)
  seg.miss       <- missing(segments)
  seg.y.miss     <- missing(segments_y)
  seg.x.miss     <- missing(segments_x)
  ellipse.miss   <- missing(ellipse)
  fit.miss       <- missing(fit)
  fit.se.miss    <- missing(fit_se)
  MD.miss        <- missing(MD_cut)
  out.size.miss  <- missing(out_size)
  out.shape.miss <- missing(out_shape)
  n.col.miss     <- missing(n_col)
  n.row.miss     <- missing(n_row)
  add.miss       <- missing(add)
  ylab.miss      <- missing(ylab)

  fill.name <- deparse(substitute(fill))

  # "off" substitutes for official value of "transparent"
  fill[which(fill == "off")] <- "transparent"
  color[which(color == "off")] <- "transparent"
  ellipse_color[which(ellipse_color == "off")] <- "transparent"
  ellipse_fill[which(ellipse_fill == "off")] <- "transparent"
  add_fill[which(add_fill == "off")] <- "transparent"
  add_color[which(add_color == "off")] <- "transparent"

  if (enhance) {
    if (ellipse.miss) ellipse <- 0.95
    if (MD.miss) MD_cut <- 6
    if (add.miss) add <- "means"
    if (fit.miss) fit.ln <- "lm"
  }

  # initialise pt_size here so ts_stack can set it before the eval block
# pt_size <- NULL

  # default point size for a stacked time series
  if (ts_stack) {
    if (size.miss) pt_size <- 0
    size.miss <- FALSE
  }

  # presume text output to the console, could turn off at end of function
  outp <- TRUE

  xlab.adj <- label_adjust[1]; ylab.adj <- label_adjust[2]
  tm.adj <- margin_adjust[1];  rm.adj <- margin_adjust[2]
  bm.adj <- margin_adjust[3];  lm.adj <- margin_adjust[4]

  date.var <- FALSE  # default is not a date variable for x
  freq.poly <- FALSE  # default is not a frequency polygon

  if (!fit.se.miss) if (missing(fit))  fit.ln <- "loess"
  if (fit.se.miss && plot_errors) fit_se <- 0  # default for plot_errors
  if (!by.miss && fit.se.miss && fit.ln!="off") fit_se <- 0  # default for by

  # any bin parameter activates bins for VBS plot, or freq.poly=TRUE
  if (!missing(breaks)  ||  !missing(bin_start)  ||  !missing(bin_width)  ||
      !missing(bin_end))
    bin <- TRUE

  # set object
  if (!missing(radius) || !missing(power)) {
    object <- "bubble"  # any bubble parameter activates a bubble plot
  }
  else
    object <- "point"

  # ------
  # see if dated or inconsistent parameter values
  .param.old(..., fun.name = "XY")
  .plt.bad(x.miss, y.miss, stat, breaks, bin_start, n_row, n_col,
           MD_cut, out_cut, fit_se, ...)

  # if x is in a data frame, then in the function call it is a name
  # if x is in global, then in the function its name is a variable direct


# data frame stuff --------------------------------------------------------

  data.d <- missing(data)

  # let deprecated mydata work as default
  dfs <- .getdfs()
  mydata.ok <- FALSE
  if (!is.null(dfs)) {
    if ("mydata" %in% dfs  &&  !("d" %in% dfs)) {
      d <- mydata
      rm(mydata)
      df.name <- "mydata"
      mydata.ok <- TRUE
      options(dname = df.name)
    }
  }

  # get name of data table
  if (!mydata.ok) {
    df.name <- deparse(substitute(data))
    options(dname = df.name)
  }

  shiny <- FALSE
  if (!is.null(sys.call(-1)))  # is NULL when called directly from R console
    if (sys.call(-1) == "renderPlot()") {  # from shiny, user or interact()
      shiny <- TRUE
      data <- eval(substitute(data), envir=parent.frame())
    }

  # if a tibble, convert to data frame
  if (!shiny) {
    if (exists(df.name, envir=.GlobalEnv)) {
      if (any(grepl("tbl", class(data), fixed=TRUE)))
        data <- data.frame(data)
    }
  }
  else  # no check for existence of df.name
    if (any(grepl("tbl", class(data), fixed=TRUE)))
      data <- data.frame(data)

  x.name <- deparse(substitute(x), width.cutoff = 120L)
  if (length(x.name) > 1L)
    x.name <- if (!is.null(xlab) && length(xlab)==1L && nzchar(xlab))
                xlab else "x"
  options(xname = x.name)

  if (x.name != ".Index") {  # not a run chart
    run <- FALSE
  }
  else {  # run chart, create x as sequence of integers from 1
    run <- TRUE
    options(xname="Index")
  }

  # classify x: a computational expression evaluates directly, with a
  # data-column reference resolved from the data frame, then the
  # caller's environment; tryCatch avoids forcing the data=d promise
  x.expr    <- substitute(x)
  x.is.expr <- !missing(x) && .is_expr_arg(x.expr)
  x.uses.df <- FALSE
  if (x.is.expr)
    x.uses.df <- df.name != "NULL" && length(all.vars(x.expr)) > 0L &&
                 any(all.vars(x.expr) %in%
                     tryCatch(names(data), error=function(e) character(0)))

  if (!x.is.expr) {
    if (!(shiny && df.name == "NULL")) .in.global(x.name, quiet)
    x.in.global <- if (shiny && df.name == "NULL") TRUE
                   else df.or.global(x.name, df.name, role="x",
                                     fun.name="XY")
  }
  else
    x.in.global <- !x.uses.df

  if (!x.in.global) {
    # force evaluation (not lazy) if data not specified, relies on default d
    if (data.d) {
      if (!mydata.ok) .nodf(df.name)  # check to see if df exists
      # the 1.201 comes from Shiny, need to reset
      # l.cex and l.axc are set in interact() before shiny analysis
      if (getOption("lab_size") == 1.201) {
       if (getOption("l.cex") != 1.201) {
          style(lab_size=getOption("l.cex"))
          style(axis_size=getOption("l.axc"))
        }
        else
          style(quiet=TRUE)
      }
    }
  }

  # respect a caller-supplied eval_df
  if (is.null(eval_df)) eval_df <- !x.in.global


# subset filter -----------------------------------------------------------

  if (!missing(filter))
    data <- .apply_filter(data,
                          deparse(substitute(filter)),
                          parent.frame(),
                          x.in.global, quiet)


# process x variable ------------------------------------------------------

  # process row.names if specified, is now LEGACY, should be in Chart()
  if (x.name %in% c("row_names", "row.names")) {
    # retain order of row names, otherwise will be alphabetical
    x.call <- data.frame(factor(row.names(data), levels=row.names(data)))
    if (is.null(xlab)) xlab <- ""  # unless specified, drop the axis label
    cat.x <- TRUE
  }

  # x is a computational expression, evaluate directly
  else if (x.is.expr) {
    val <- .expr_eval(x.expr, x.name, if (x.uses.df) data else NULL,
                      parent.frame(), role="x", fun.name="XY")
    x.call <- as.data.frame(val)
    if (ncol(x.call) == 1L) names(x.call) <- x.name
  }

  # x not in global env, in df, specify data= forces to data frame
  else if (!x.in.global) {
    if (eval_df) {
      if (!mydata.ok) .nodf(df.name)  # check to see if df exists
      if (x.name != ".Index")
        .xcheck(x.name, df.name, names(data))  # stop if x an expression
    }

    if (!run) {  # not a run chart
      data.vars <- as.list(seq_along(data))
      names(data.vars) <- names(data)
      x.col <- eval(substitute(x), envir=data.vars)  # col num of each var

      if (!("list" %in% class(data))) {
        x.call <- data[, x.col]
        x.call <- data.frame(x.call)
      }
      else {  # class of data is "list"
         x.call <- data.frame(data[[x.col]])
      }
      if (is.numeric(x.col))
        names(x.call) <- names(data.vars)[x.col]
      else
        names(x.call) <- x.col  # if x a vector, x.col can return names
    }
    else {  # run chart, create x as sequence of integers from 1
      x.call <- data.frame(seq_len(nrow(data)))
      names(x.call) <- "Index"
    }
  }  # end x in df

  # x is in the global environment (vector or data frame)
  else if (is.data.frame(x)) {  # x a global data frame: analyze its columns
    x.call <- as.data.frame(x)  # drop any tibble class; keep column names
  }

  else if (is.ts(x)) {
    stop(call.=FALSE, "\n------\n",
      "x is a time series (class ts).\n",
      "First extract the date and value vectors with tsExtract(),\n",
      "then pass them to XY().\n\n")
  }

  else {  # x is a not ts vector in global
    if (!is.function(x))
      x.call <- data.frame(x)  # x is 1 var
    else  # x is 1 var
      x.call <- data.frame(eval(substitute(data$x)))
    names(x.call) <- x.name
  }

  n.xvar <- ncol(x.call)  # number of x-variables

  cat.x <- is.character(x.call[,1]) || is.factor(x.call[,1])

  # get x.call data to be analyzed into x.call, except for BPFM
  BPFM <- FALSE
  spmat <- FALSE


# see if convert to variable of type Date ---------------------------------

  if (n.xvar == 1) { # one x variable, a vector of cat or num values

    if (grepl("POSIX",  class(x.call[,1]), fixed=TRUE)[1])
      x.call[,1] <- as.Date(x.call[,1])
    date.var <- .is.date(x.call[,1])

    # if sequence of integer years, then convert to type Date
    if (.is.integer(x.call[,1])  &&  !run) {
      diff1 <- all(diff(x.call[,1]) == 1)  # see if consecutive years
      yr.range <- all(x.call[,1] >= 10 & x.call[,1] <= 9999)  # range for yrs
      if (diff1 && yr.range) {
        x.call[,1] <- as.Date(paste0(x.call[,1], "-01-01"))  # to Date
        date.var <- TRUE
        if (!quiet)
          message("\n>>> Note: Variable ", x.name, " assumed ",
                  "to be annual years\n",
                  "Converted to a type Date variable\n",
                  "If forecasting, there will be no seasonality.\n\n")
      }
    }

    # if x.call[,1] has char string values, see if convert to type Date
    if (is.character(x.call[1,1])) {
      if (!is.null(ts_format))  # specify the date format
        x.call[,1] <- as.Date(x.call[,1], format=ts_format)
      else  # see if a date, and if so, infer the date format
        x.call <- date.infer(x.call, quiet)
    }

    if (.is.date(x.call[1,1])) {
     cat.x <- FALSE  # is.char x.call[1,1]
     date.var <- TRUE
    }

    if (cat.x && run) {
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "A run chart applies only to continuous variables\n",
        x.name, " is a categorical variable\n\n")
    }

  }  # end n.xvar == 1

  # more than one x-variable
  else {
    # no y, see if eligible for BPFM where all selected vars are cat
    # multiple lines of a continuous x-variable also can occur
      is.cat <- logical(length=ncol(x.call))
      is.nmb <- logical(length=ncol(x.call))
      for (i in seq_len(ncol(x.call))) {  # variables all categorical?
        is.string <- is.factor(x.call[,i]) || is.character(x.call[,i])
        is.cat[i] <- is.string
        is.nmb[i] <- is.numeric(x.call[,i])
      }  # end for

      if (all(is.cat)) {
        BPFM <- TRUE
        cat.x <- TRUE
      }
      else if (all(is.nmb)) {
        BPFM <- FALSE
        cat.x <- FALSE
      }
      else {
        cat("\n"); stop(call.=FALSE, "\n------\n",
          "Multiple x-variables must all be numeric or all R factors\n\n")
      }


# --- scatterplot matrix detection -----------------------------------

    same.xy.expr <- FALSE
    if (!y.miss) {  # compare *expressions* exactly as typed by the user
      same.xy.expr <- identical(substitute(x), substitute(y))
    }

    if (!y.miss && same.xy.expr && all(is.nmb)) {  # do a scatterplot matrix
      spmat <- TRUE
      # by design, a scatterplot matrix supports neither by nor facet: its
      #   points are small, so group colors from by would not be
      #   distinguishable, and faceting would require multiple large matrices
      if (!by.miss || !facet.miss) {
        cat("\n"); stop(call.=FALSE, "\n------\n",
          "A scatterplot matrix does not support  by  or  facet.\n",
          "Its many small points make group colors from  by  hard to\n",
          "  distinguish, and faceting would require multiple large\n",
          "  matrices. Both are omitted by design.\n\n")
      }
    }
    else {
      if (y.miss && all(is.nmb)) {
        cat("\n"); stop(call.=FALSE, "\n------\n",
          "Scatterplot matrices in lessR have a new interface.\n",
          "  Old shortcut:  XY(Salary, Age, Years)\n",
          "  New syntax:    XY(x = c(Salary, Age, Years),\n",
          "                    y = c(Salary, Age, Years))\n\n",
          "The y-missing shortcut is deprecated. Specify the\n",
          "same vector of numeric variables for both x= and y=.\n")
      }
    }

  }  # end more than 1 x-variable


  if (!is.factor(x.call[,1])) if (cat.x) x.call[,1] <- factor(x.call[,1])

  if (!BPFM)
    nrows <- if (is.matrix(x.call[,1])) nrow(x.call[,1]) else length(x.call[,1])
  else
    nrows <- nrow(x.call)

  # date and run chart settings
  if (date.var || run) {  # points and line segments
    object <- "point"
    if (seg.miss) segments <- TRUE
  }
  if (run) {
    if (cl.miss) center_line <- "default"
    if (fill.miss) fill <- "gray20"
    if (color.miss) color <- "gray60"
  }  # end run


  #-----------
  # evaluate y
  if (!y.miss) {
    # get actual variable name before potential call of y.call
    y.name <- deparse(substitute(y))
    if (length(y.name) > 1L)
      y.name <- if (!is.null(ylab) && length(ylab)==1L && nzchar(ylab)) ylab
                else "y"
    options(yname = y.name)

    # classify y as a computational expression, as for x
    y.expr    <- substitute(y)
    y.is.expr <- .is_expr_arg(y.expr)
    y.uses.df <- FALSE
    if (y.is.expr)
      y.uses.df <- df.name != "NULL" &&
                   length(all.vars(y.expr)) > 0L &&
                   any(all.vars(y.expr) %in%
                       tryCatch(names(data),
                                error=function(e) character(0)))

    in.global <- if (shiny && df.name == "NULL") TRUE
                 else if (y.is.expr) !y.uses.df
                 else df.or.global(y.name, df.name, role="y", fun.name="XY")

    # row.names deprecated in favor of row_names
    if (deparse(substitute(y)) %in% c("row_names", "row.names")) {
      # retain order of row names, otherwise will be alphabetical
      y.call <- factor(row.names(data), levels=row.names(data))
      if (is.null(ylab)) ylab <- ""  # unless specified, drop the axis label
      cat.y <- TRUE
      y.call <- data.frame(y.call)
    }


    # y is a computational expression, evaluate directly
    else if (y.is.expr) {
      val <- .expr_eval(y.expr, y.name, if (y.uses.df) data else NULL,
                        parent.frame(), role="y", fun.name="XY")
      y.call <- as.data.frame(val)
      if (ncol(y.call) == 1L) names(y.call) <- y.name
      if (!is.null(x.call)  &&  nrow(y.call) != nrow(x.call)) {
        cat("\n"); stop(call.=FALSE, "\n------\n",
          "x has ", nrow(x.call), " values, but the  y  expression\n",
          "  ", y.name, "  yields ", nrow(y.call), " values\n\n")
      }
    }

    # y not in global env, in df, specify data= forces to data frame
    else if (!in.global) {
      if (eval_df) .xcheck(y.name, df.name, names(data))  # var in df?
      data.vars <- as.list(seq_along(data))  # even if only a single var
      names(data.vars) <- names(data)  # all data in data frame
      y.col <- eval(substitute(y), envir=data.vars)  # col num selected vars

      if (!("list" %in% class(data))) {
        y.call <- data[, y.col]
        y.call <- data.frame(y.call)
      }
      else  # class of data is "list"
        y.call <- data.frame(data[[y.col]])

      if (is.numeric(y.col))
        names(y.call) <- names(data.vars)[y.col]
      else
        names(y.call) <- y.col
    }  # end not global y

    # y is a data frame in the global env (vector or data frame)
    else if (is.data.frame(y)) { # y a data frame
        y.call <- as.data.frame(y)  # drop any tibble class
    }

    else {  # y a vector in global
      if (!is.function(y))
        y.call <- data.frame(y, stringsAsFactors=TRUE)  # y is 1 var
      else  # y is 1 var
        y.call <- data.frame(eval(substitute(data$y)), stringsAsFactors=TRUE)
      names(y.call) <- y.name
    }

    n.yvar <- ncol(y.call)  # number of y-variables

    if (ncol(y.call) == 1) {  # y is one variable
      if (is.character(y.call[,1]) || is.factor(y.call[,1])) cat.y <- TRUE
      if (!is.factor(y.call[,1])) if (cat.y) y.call[,1] <- factor(y.call[,1])
    }
    else {  # 2 or more y vars
      cat.y <- FALSE  #  multiple y-vars must be numerical
      if (ylab.miss) ylab <- NULL  # use legend instead
      y.call <- data.frame(y.call)
    }
    # if specified, change y NA's to 0 or other specified numerical value
    if (!is.null(ts_NA))
      y.call[is.na(y.call)] <- ts_NA  # reference entire data frame

  }  # end y not missing

  else { # missing y
    y.call <- NULL
    n.yvar <- 0
  }  # end missing y

  if (ts_ahead > 0 && n.yvar > 1) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Can only do a forecast for a single y-variable\n\n")
  }

  if (!is.null(y.call) && !is.numeric(y.call[,1]) && run) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Run chart only applies to a numerical variable\n\n")
  }


  # ---------------------------------
  # ellipse, fit line stop conditions
  if (ellipse[1] > 0) {
    many.y <- FALSE
    if (!y.miss) if (is.matrix(y.call)) many.y <- TRUE
    if ((ncol(x.call)>1 || many.y)  ||  cat.x  ||  cat.y) {
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "An ellipse only applies to a scatterplot of two, ",
        "continuous variable\n\n")
    }
    if (y.miss) {
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "Need a y-variable to compute an ellipse\n\n")
    }
  }

  if (y.miss && (fit.ln != "off") && n.xvar == 1 && (!date.var && !run)) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "A fit line requires a  y  variable.\n\n")
  }

  if (!facet.miss && cat.x && cat.y) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Parameter  facet  does not work with bubble plots,\n",
      "  that is, with non-numeric categorical variables for  x  and  y.\n\n")
  }


  # ---------------------------------------
  # ---------------------------------------
  # master control funnel for analysis type
  # ---------------------------------------
  lx <- length(x.call[,1])
  n.ux <- length(unique(x.call[,1]))
  x.unique <- n.ux == lx
  y.unique <- if (!is.null(y.call))
    length(unique(y.call[,1])) == length(y.call[,1])
  else
    FALSE

  # get Trellis and T.type
  fnl <- .plt.funnel(data.do, n.xvar, y.miss, cat.x, cat.y, run, date.var,
                     facet.miss, y.unique,
                     x.name=x.name, y.name=y.name,
                     facet.name=if (!facet.miss) deparse(substitute(facet))
                                else NULL)
  Trellis <- fnl$Trellis
  T.type <- fnl$T.type  # needed only for Trellis

  # a facet= would otherwise flip Trellis on and route these to the generic
  #   lattice scatter path; contour/smooth have their own base-R faceted grid,
  #   and hexbin has its own lattice paneling (.plt.hexbin.facet), so keep all
  #   three off the generic Trellis path
  if (form %in% c("contour", "smooth", "hexbin")) Trellis <- FALSE

  # type="dot" requested: force Trellis dot chart path regardless of data shape
  if (dot.type) {
    Trellis <- TRUE
    T.type  <- "dot"
  }

  # end master control funnel
  # -------------------------

  if (is.logical(ellipse))
    ellipse <- if (ellipse) 0.95 else 0.00
  if (ellipse[1] > 0  &&  !Trellis  &&  !quiet  &&  df.name != "NULL") {
    if (!use_plotly) cat("\n")
    txt <- "[Ellipse with Murdoch and Chow's function ellipse"
    cat(txt, "from their ellipse package]\n\n")
  }


  # evaluate by
  #------------
  # cannot directly evaluate is.null(by) if by is present as a variable
  # so instead process as below to either get by.call or it is NULL
  # can get by.name

  do.by <- TRUE
  if (by.miss)
    do.by <- FALSE
  else {
    by.name <- paste(deparse(substitute(by), width.cutoff=120L),
                     collapse="")
    # XY() permits only one  by  variable, e.g., by=c(V1, V2) is not allowed
    by.expr <- substitute(by)
    if (is.call(by.expr) && identical(by.expr[[1L]], as.name("c"))) {
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "Only one  by  variable is permitted, but more than one specified:\n",
        "  by = ", by.name, "\n",
        "  Additional grouping variables are not permitted, as the resulting\n",
        "  visual clutter compromises interpretability.\n",
        "  To display a second grouping variable, use  facet.\n\n")
    }
    if (by.name == "NULL")
      do.by <- FALSE  # specified by=NULL in call, including shiny
    # classify by as a computational expression, as for x
    by.is.expr <- .is_expr_arg(by.expr)
    by.uses.df <- FALSE
    if (by.is.expr) {
      by.uses.df <- df.name != "NULL" &&
                    length(all.vars(by.expr)) > 0L &&
                    any(all.vars(by.expr) %in%
                        tryCatch(names(data),
                                 error=function(e) character(0)))
      by.in.global <- !by.uses.df
    }
    else {
      by.in.global <- df.or.global(by.name, df.name, role="by",
                                   fun.name="XY")
      if (by.in.global) if (is.null(by))
        do.by <- FALSE
    }
  }

  if (do.by)  {  # a by var
    options(byname = by.name)

    # see if var exists in data frame, if x not in global Env or function call
    if (!missing(x) && !by.in.global && !by.is.expr)
      .xcheck(by.name, df.name, names(data))

    if (by.is.expr) {  # by is a computational expression
      by.call <- .expr_eval(by.expr, by.name,
                            if (by.uses.df) data else NULL,
                            parent.frame(), role="by", fun.name="XY")
      if (!is.null(x.call)  &&  length(by.call) != nrow(x.call)) {
        cat("\n"); stop(call.=FALSE, "\n------\n",
          "x has ", nrow(x.call), " values, but the  by  expression\n",
          "  ", by.name, "  yields ", length(by.call), " values\n\n")
      }
    }
    else if (!by.in.global) {  # get variable's values from data frame col(s)
      data.vars <- as.list(seq_along(data))  # even if only a single var
      names(data.vars) <- names(data)  # all var names in data frame
      by.col <- eval(substitute(by), envir=data.vars)  # col num selected vars
      by.call <- data[, by.col]  # values are original labels here
    }
    else {  # vars that are function names get assigned to global
      by.call <- by
      if (is.function(by.call)) by.call <- eval(substitute(data$by))
    }

   # need by to be a factor
   # .plt.by.legend, plt.main #818, needs levels(by)
    if (!is.factor(by.call)) by.call <- factor(by.call)
    by.unq <- length(unique(by.call))

#   if (shape.miss) pt_shape <- "vary"  # default: vary shapes across by groups
    if (!shape.miss && !is.null(by.call) && pt_shape[1]!="vary")
      pt_shape  <- .align_vector(pt_shape, by.call)  # named shape to unnamed
    shp <- .plt.shapes(pt_shape, out_shape, n.by=by.unq)
    pt_shape <- shp$shape
    out_shape <- shp$out_shape
  }  # end a by var

  else {   # process shapes (without a by var)
    if (pt_shape[1] == "sunflower")
      object <- "sunflower"
    else {  # get numeric code for shape, check for bad shapes
      shp <- .plt.shapes(pt_shape, out_shape)
      pt_shape <- shp$shape
      out_shape <- shp$out_shape
    }
    by.call <- NULL
    by.miss <- TRUE  # just need is.null(by.call) from here forward
  }

  n.by <- if (is.null(by.call)) 0 else nlevels(by.call)

  # already converted to Date if needed, now sort if needed
  if (date.var && !is.null(by.call)) {
    # by from an expression is not a column of data, so check by.call
    is.sorted <- if (by.name %in% names(data))
                   all(order(data[[by.name]]) == seq_len(nrow(data)))
                 else
                   all(order(by.call) == seq_along(by.call))
    if (!is.sorted) {  # then sort by by.call
      ix <- order(by.call)
      x.call <- data.frame(x.call[ix,]);  names(x.call) <- x.name
      y.call <- data.frame(y.call[ix,]);  names(y.call) <- y.name
      by.call <- by.call[ix]
    }
  }

  if (!by.miss) {
    if (all(is.na(by.call))) { # x a data frame
        cat("\n"); stop(call.=FALSE, "\n------\n",
          "All values of  by  are missing. You need some data.\n\n")
    }
  }


# --- resolve facet --------------------------------------------------

  # Initialize legacy internal vars
  facet1.call <- facet2.call <- NULL
  facet1.name <- facet2.name <- NULL
  facet1.miss <- facet2.miss <- TRUE

  if (!missing(facet)) {
    facet.expr <- substitute(facet)
    facet.vars <- all.vars(facet.expr)

    if (.is_expr_arg(facet.expr)) {  # a computational expression
      f.name <- paste(deparse(facet.expr, width.cutoff=120L),
                      collapse="")
      uses.df <- df.name != "NULL" &&
                 any(facet.vars %in%
                     tryCatch(names(data),
                              error=function(e) character(0)))
      v <- .expr_eval(facet.expr, f.name,
                      if (uses.df) data else NULL,
                      parent.frame(), role="facet", fun.name="XY")
      facet1.call <- droplevels(factor(v))
      facet1.name <- f.name
      facet1.miss <- FALSE
      if (!is.null(x.call)  &&
          length(facet1.call) != nrow(x.call)) {
        cat("\n"); stop(call.=FALSE, "\n------\n",
          "x has ", nrow(x.call), " values, but the  facet  expression\n",
          "  ", f.name, "  yields ", length(facet1.call), " values\n\n")
      }
    }
    else {
    if (length(facet.vars) == 0L) {
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "Parameter  facet  names a categorical variable for its panels.\n\n")
    }
    caller.env <- parent.frame()

    get.col <- function(nm)
      .resolve_named_var(nm, df.name, data, caller.env,
                         role = "facet", fun.name = "XY")

    # Resolve symbols to factors
    fac.list <- lapply(facet.vars, function(nm) {
      v <- get.col(nm)
      if (is.numeric(v)  &&  length(unique(v)) > 25) {
        cat("\n"); stop(call.=FALSE, "\n------\n",
          "Parameter  facet  requires a categorical variable, but  ", nm,
          "\n  is numeric with ", length(unique(v)), " unique values.\n",
          "\nIf  ", nm, "  is categorical, convert it to an R factor:\n",
          "  d$", nm, " <- factor(d$", nm, ")\n\n")
      }
      if (!is.factor(v)) v <- factor(v)
      droplevels(v)
    })

    # Map into legacy internal vars
    if (length(fac.list) >= 1L) {
      facet1.call <- fac.list[[1L]]
      facet1.name <- facet.vars[1L]
      facet1.miss <- FALSE
    }
    if (length(fac.list) >= 2L) {
      facet2.call <- fac.list[[2L]]
      facet2.name <- facet.vars[2L]
      facet2.miss <- FALSE
    }
    if (length(fac.list) > 2L) {
      message("`facet` has ", length(fac.list),
              " variables; using the first two: ",
              paste(facet.vars[1:2], collapse = ", "), ".")
      fac.list   <- fac.list[1:2]
      facet.vars <- facet.vars[1:2]
    }
    }  # end facet names categorical variable(s), not the x/y vector
  }

  # a facet= with a vector of x (or y) variables panels the multi-series
  #   overlay by the facet variable(s), drawn by the facet-series dispatch
  #   below, so keep it off the generic lattice scatter path
  if (!date.var  &&  !run  &&  !facet1.miss  &&
      (ncol(x.call) > 1  ||  (!is.null(y.call) && ncol(y.call) > 1)))
    Trellis <- FALSE


  # evaluate size (NULL, numeric constant, or a variable)
  # internally called 'size' from here forward
  #--------------

  if (!missing(pt_size)) {
    size.name <- deparse(substitute(pt_size))
    if (size.name == "NULL") {
      size.miss <- TRUE
    }
    else {
      suppressWarnings(size.num <- as.numeric(size.name))
      if (is.na(size.num)) {
        # Check caller frame first — handles Shiny pre-evaluated vectors
        # (e.g. size_val defined in renderPlot) without forcing evaluation
        # of a bare variable name like Pre that lives in the data frame.
        if (exists(size.name, envir=parent.frame(), inherits=TRUE) &&
            is.numeric(get(size.name, envir=parent.frame(),
                           inherits=TRUE))) {
          pt_size <- get(size.name, envir=parent.frame(), inherits=TRUE)
        } else {
          in.global <- df.or.global(size.name, df.name, role="pt_size",
                                    fun.name="XY")
          if (!in.global) {
            data.vars <- as.list(seq_along(data))
            names(data.vars) <- names(data)
            size.col <- eval(substitute(pt_size), envir=data.vars)
            pt_size <- data[,size.col]
            if (!is.numeric(pt_size)) {
              cat("\n"); stop(call.=FALSE, "\n------\n",
                "Variable ", size.name, " must be numeric\n\n",
                "Perhaps use: by=", size.name, "\n\n")
            }
            options(sizename = size.name)
          }  # end not global
        }  # end else data frame lookup
      }  # end is.na(size.num)

      if (is.null(pt_size[1])) size.miss <- TRUE
      if (length(pt_size) > 1) {
        object <- "bubble"
        options(sizename = size.name)
      }
    }  # end size.name not "NULL"
  }  # end pt_size specified

  if (is.null(pt_size_cut)) {
    if (length(pt_size) > 1)
      pt_size_cut <- 2
    else
      pt_size_cut <- if (cat.x) 1 else 2
  }


  # evaluate ID
  #------------
  get.ID <- FALSE
  if (!is.null(add)) if (add[1] == "labels") get.ID <- TRUE
  if (MD_cut>0 || out_cut>0) get.ID <- TRUE

  if (get.ID) {
    # ID.name is the actual var name if specified directly,
    #  or the name of the var that contains the var name
    ID.name <- deparse(substitute(ID))
    ID.name <- gsub("\"", "", ID.name)  # remove extra quotes if "row.name"
    if (ID.name == "row.name") ID.name <- "row.names"
    if (!x.in.global) {
  # if x is in a data frame, then in the function call it is a name
  # if x is in global, then in the function its name is a variable direct
  # ID.col is the actual var column if specified directly,
  #  or the var name if a variable that contains the name was entered
      if (ID.name != "row.names") {
        # data.vars only built when x was specified and is in the data frame
        if (!exists("data.vars", inherits=FALSE)) {
          data.vars <- as.list(seq_along(data))
          names(data.vars) <- names(data)
        }
        ID.col <- eval(substitute(ID), envir=data.vars, parent.frame())
        if (!is.numeric(ID.col)) {
          ID.col <- which(names(data) == ID.col)
          ID.name <- names(data)[ID.col]
        }
      .xcheck(ID.name, df.name, names(data))  # var exists in data frame?
      ID.call <- data[, ID.col]
      }  # end not row.names
      else  # ID is row.names
        ID.call <- row.names(data)
    } # end !x.in.global

    else {  # in global
      ID.call <- eval(substitute(ID), parent.frame())
    }
  }  # end get.ID

  else  # no ID to get
    ID.call <- NULL


  # -----------  x, y, by, size, and ID variables established -------
  # -----------------------------------------------------------------

  if (missing(height)  ||  is.null(height)) {
    if (is.null(y.call)  &&  !BPFM
        &&  data.do  &&  object != "point"  &&  !.is.date(x.call))
      height <- if (is.null(main)) 4 else 4.6  # narrow for 1-D dot plot
    else
      height <- 6

    if (BPFM)  # more than 7 variables, make plot extra long
      height <- height + ((ncol(x.call) - 7) * 0.5)
  }

  if (is.null(width)) width <- 6.5  # the formal default, if NULL passed
  if (!is.null(by.call)) width <- width + .85  # wider plot

  # ---------------------------------
  #  manage regular-R or PDF graphics
  #  for Trellis, .plt.lattice plots to and closes the pdf device opened
  #  here, but .bar.lattice does not support direct pdf output
  pdf.trellis <- Trellis  &&  do_plot  &&
                 T.type %in% c("cont", "cont_cont", "cont_cat")
  if (!is.null(pdf_file)) {
    if (!Trellis  ||  pdf.trellis) {
      if (!grepl(".pdf", pdf_file))
        pdf_file <- paste(pdf_file, ".pdf", sep="")
      pdf(file=pdf_file, width=width, height=height, onefile=FALSE)
    }
  }
  else {
    if (!Trellis  &&  df.name != "NULL")  # not dev.new for shiny
        .opendev(pdf_file, width, height)
  }


# drop rows with missing data across x, y, by, facet, and size ------------

  if (!date.var) {  # except for time series
    if (!spmat) {  # not a scatterplot matrix
      # 1) Build a temporary data frame that contains all relevant columns
      df <- data.frame(x.call)
      if (!is.null(y.call)) df <- cbind(df, y.call)
      if (!is.null(by.call)) df$..by <- by.call
      if (!is.null(facet1.call)) df$..facet1 <- facet1.call
      if (!is.null(facet2.call)) df$..facet2 <- facet2.call
      if (!is.null(pt_size) && length(pt_size) > 1) df$..size <- pt_size

      # 2) Compute complete cases
      cc <- stats::complete.cases(df)

      # 3) Delete rows with missing data
      if (!all(cc)) {
        x.call <- x.call[cc, , drop = FALSE]
        if (!is.null(y.call)) y.call <- y.call[cc, , drop = FALSE]
        if (!is.null(by.call)) by.call <- by.call[cc]
        if (!is.null(facet1.call)) facet1.call <- facet1.call[cc]
        if (!is.null(facet2.call)) facet2.call <- facet2.call[cc]
        if (!is.null(pt_size) && length(pt_size) > 1) pt_size <- pt_size[cc]
      }

      rm(df)
    }
  }


# set object and values where needed --------------------------------------

  # prep 1-variable bubble plot
  # y.call to 0   >> Move all no y to X()
  if (is.null(y.call)  &&  cat.x  &&  n.xvar == 1  &&  data.do) {
    y.call <- data.frame(rep(0, nrow(x.call)), stringsAsFactors=TRUE)
    cat.y <- FALSE
    object <- "bubble"
    if (is.null(low_fill)) low_fill <- "gray20"
    if (is.null(hi_fill)) hi_fill <- "gray20"
  }
  # if numeric x is sorted with equal intervals, set as line chart
  #   unless doing a fit line as only want one line
  # x.call does not exist for BPFM
  if (!cat.x && fit.ln=="off") {
    if (is.numeric(x.call[,1]) && nrows>2) {
      if (object == "point") {
        eq.int <- !any(is.na(x.call[,1]))
        if (eq.int) {
          d.x <- diff(x.call[,1])  # only look at first x-variable
          for (i in 2:(length(d.x)))
            if ((abs(d.x[i-1] - d.x[i]) > 0.0000000001)) {
              eq.int <- FALSE
              break
            }
          rm(d.x)
        }  # also no y missing
        if (!is.unsorted(x.call) && eq.int && sum(is.na(y.call))==0) {
          if (is.null(pt_size)) pt_size <- 0  # by default, line w/o points
          if (seg.miss) segments <- TRUE
        }
      }
    }
  }

  if (object == "point") {  # see if bubble plot, already set if size a var
    if (!y.miss) {
      if (data.do) if (cat.x && cat.y) object <- "bubble"
    }
    else {
      if (data.do) object <- if (cat.x) "bubble" else "point"
      if (BPFM) object <- "bubble"  # BPFM
    }
  }

  pt.trans <- trans
  if (object == "bubble"  &&  trans.miss) pt.trans <- 0.4

  if (!stat.x.miss) n.yvar <- 1

  if (y.miss  &&  !date.var  &&  object != "bubble" && !stat.x.miss) {

    if (!cat.x) {  # freq polygon

      ssstuff <- .ss.numeric(x.call[,1], digits_d=digits_d, brief=TRUE)

      # get x.call binned  values and corresponding y.call count values
      # do the actual freq poly in .plt.main
      # do not do a histogram (do_plot=FALSE)
      hist.cumul <- ifelse(cumulate, "on", "off")
      reg <- "snow2"  # applies to cumulative histogram
      digits_d <- .max.dd(x.call[,1])
      h <- .hst.main(x.call[,1], by=NULL, by.name=NULL, n.by=1,
         pt.fill, pt.color, pt.trans, reg,
         rotate_x, rotate_y, offset,
         breaks, bin_start, bin_width, bin_end,
         proportion, counts=NULL, hist.cumul,
         xlab, ylab, main, sub,
         bm.adj=0, lm.adj=0, tm.adj=0, rm.adj=0,
         axis_fmt="K", axis_x_pre="", axis_y_pre="",
         use_plotly=FALSE, digits_d=NULL,
         quiet=FALSE, do_plot=FALSE, fun_call=NULL, ...)

      x.call <- h$mids
      y.call <- h$counts
      if (stat_x == "count")
        ylab <- paste("Count of", x.name)
      else if (stat_x == "%") {
        y.call <- (y.call / sum(y.call)) * 100
        ylab <- paste("Percentage of", x.name)
      }
      else {
        y.call <- y.call / sum(y.call)
        ylab <- paste("Proportion of", x.name)
      }

      # last assignment of object, now determined
      object <- "point"  # do freq poly as a line chart
      segments <- TRUE
      freq.poly <- TRUE  # need to indicate fill possibility
      center_line <- "off"  # not meaningful here

      cat.y <- FALSE

      txsug <- ""
      if (getOption("suggest")) {
        txsug <- ">>> Suggestions  or  enter: style(suggest=FALSE)"

        fncl <- .fun_call.deparse(fun_call)
        fncl <- gsub(")$", "", fncl)  # get function call less closing )
        fncl <- gsub(" = ", "=", fncl)

        fc <- ""
        if (!grepl("pt_size", fncl))
          fc <- paste(fc, ", pt_size=0", sep="")
        if (nzchar(fc)) {
          fc <- gsub(" = ", "=", fc)
          fc <- paste(fncl, fc, ")   # just line segments, no points", sep="")
          txsug <- paste(txsug, "\n", fc, "\n", sep="")
        }

        bw.new <- pretty((x.call[2] - x.call[1]) / 1.5)  # arbitrary new bw
        fc <- ""
        if (!grepl("bin_width", fncl))
          fc <- paste(fc, ", bin_width=", as.character(bw.new[1]), sep="")
        if (nzchar(fc)) {
          fc <- paste(fncl, fc, ") ", sep="")
          txsug <- paste(txsug, fc, sep="")
        }

        txsug <- .rm.arg.2(" x=", txsug)
      }

      txss <- ssstuff$tx  # stats output before reduce data

      txdst <- h$ttx
      if (is.null(txdst)) txdst <- ""

      bx <- .bx.stats(x.call)
      txotl <- bx$txotl

      class(txsug) <- "out"
      class(txss) <- "out"
      class(txdst) <- "out"
      class(txotl) <- "out"
      output <- list(out_suggest=txsug, out_ss=txss, out_freq=txdst,
                     out_outliers=txotl)
      class(output) <- "out_all"
      if (!quiet) print(output)

      x.call <- data.frame(x.call, stringsAsFactors=TRUE)
      y.call <- data.frame(y.call, stringsAsFactors=TRUE)
    }  # end freq polygon

    else {  # cat.x
      # just x variable, so set y.call to plot points for count and prop
      if (stat_x %in% c("count", "proportion", "%")) {

        if (Trellis) {  # follow dot plot format and do horizontal plot
          cat.y <- FALSE
          if (seg.x.miss) segments_x <- TRUE
          if (ylab.miss) {
            ylab <- ifelse (stat == "count", "Count of",
                    ifelse (stat == "%", "Percentage of", "Proportion of"))
            ylab <- paste(ylab, x.name)
          }
          x.call <- data.frame(x.call, stringsAsFactors=TRUE)
        }  # end if Trellis

        else {  # not Trellis, so manually flip to match dot plot style
          cat.x <- FALSE
          if (seg.y.miss) segments_y <- TRUE
          if (stat == "count")
            xlab <- "Count of"
          else if (stat == "proportion")
            xlab <- "Proportion of"
          else
            xlab <- "Percentage of"
          xlab <- paste(xlab, x.name)
          ylab <- NULL
          frq <- table(x.call)
          if (stat == "proportion") frq <- frq / sum(frq)
          if (stat == "%") frq <- (frq / sum(frq)) * 100
          if (is.factor(x.call))  # preserve ordering, will lose order attribute
            y.call <- factor(names(frq), levels=levels(x.call))
          else
            y.call <- factor(names(frq))
          cat.y <- TRUE
          options(yname=x.name)
          y.call <- data.frame(y.call, stringsAsFactors=TRUE)
          x.call <- data.frame(as.vector(frq), stringsAsFactors=TRUE)
        }
      }  # end values in
    }  # end cat.x

  }  # end is null y.call


  # ----------------------------------------------------------------
  # object now determined: "point", "bubble", or "sunflower"

  # flag unsorted data for time series
  if (date.var) {

    b.name <- NULL
    sort.flag <- NULL
    if (!is.null(by.call)) if (!is.null(by.name)) {
      b.name <- by.name
      sort.flag <- !is.unsorted(by.call)
    }
    if (!is.null(facet1.call)) if (!is.null(facet1.name)) {
      b.name <- facet1.name
      sort.flag <- !is.unsorted(facet1.call)
    }

    # is.unsorted() flags sorted but in descending order
    if (df.name != "NULL") {  # by var not detected at first with shiny
      if (is.null(b.name)) {  # no by or facet variable
        if (is.unsorted(x.call[,1])) {
          message(">>> Note\n",
            "The  Date  variable is not sorted in Increasing Order.\n\n",
            "For a data frame named d, enter: \n    ",
             paste("d <- order_by(d, ", x.name, ")", sep=""), "\n",
            "Maybe you have a  by  variable with repeating Date values?\n",
          "Enter  ?order_by  for more information and examples.\n\n")
        }
      }
      else {  # a by or facet variable
        if (!sort.flag) {
          message(">>> Warning\n",
            "The  by  variable is not sorted in Increasing Order.\n\n",
            "For a data frame named d, enter: \n    ",
            paste("d <- order_by(d, by=c(", b.name, ", ", x.name, "))",
                sep=""), "\n",
                "Enter  ?order_by  for more information and examples.\n\n")
        }
      }  # end else
    } # end df.name not "NULL"
  }  # end date.var

  # bubble size
  if (radius.miss)
    radius <- ifelse (length(pt_size) > 1, .12, .22)

  # size of points
  if (size.miss)  # pt.size not set yet
    pt.size <- 1.00
  else  # size had been set
    pt.size <- pt_size

  if (size.miss) {  # pt.size is a scaler
    if (object=="point" && segments) {  # pts and lines specified
      pt.size <- 0.85 * pt.size  # default pt size when segments specified
      if (!("transparent" %in% ts_area_fill))
        pt.size[1] <- 0  # default no points if area shown
      else if (nrows > 50) {
        pt.size <- .75 - 0.002*nrows
        if (pt.size < 0.10) pt.size <- 0
      }
    }  # end point and segments
  }

  n.xcol <- ncol(x.call)
  if (y.miss && !run) n.xcol <- 1
  n.ycol <- if (y.miss) 0 else ncol(y.call)
  nn.col <- max(n.xcol, n.ycol)  # n_col goes into lattice, do not change

  # a vector of x (or y) variables, but not a scatterplot matrix, which is
  #   handled earlier. The bivariate-density forms need a single x and a
  #   single y, and by= is not meaningful across a vector of x variables.
  if (!spmat) {
    if ((n.xcol > 1 || n.ycol > 1) &&
        form %in% c("smooth", "contour", "hexbin")) {
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "A  ", form, "  plot displays the joint density of a single\n",
        "  continuous  x  and a single continuous  y, so it does not\n",
        "  accept a vector of  x  or  y  variables.\n\n")
    }
    if (n.xcol > 1 && !by.miss) {
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "Parameter  by  is not meaningful with a vector of  x  variables,\n",
        "  which already occupy the color (series) dimension of the plot.\n\n")
    }
  }

  if (substr(fill.name[1], 1, 9) == "getColors") {
    if (!fill.miss && !is.null(by.call))
      fill <- .resolve_getColors_n(fill.name, n.by)
    else if (!fill.miss && !quiet) {
      message("Note: multi-color fill ignored without by=. ",
              "Use by= to map gradient across groups, or set fill= ",
              "to a single color.")
    }
  }

  ord.by.call <- is.ordered(by.call)
  if (!fill.miss && !is.null(by.call)) {
    if (!.is.palette(fill[1]))
      fill  <- .align_vector(fill, by.call)  # named fill to legacy unnamed
  }
  if (!color.miss && !is.null(by.call)) {
    if (!.is.palette(color[1]))
      color  <- .align_vector(color, by.call)  # convert named color to legacy
  }

  # scatterplot matrix has no by= grouping, so all points share one color;
  #   multiple x/y columns must not be read as multiple color groups
  n.col.clr <- if (spmat) 1 else nn.col
  fc <- .plt.colors(object, n.col.clr, n.by, segments, theme, fill, fill.miss,
          color, color.miss, ts_area_fill, ts.area.fill.miss, trans, ts_stack,
          n.ycol, n.yvar, ord.by.call, run, pt.size)

  # assign fills and colors
  pt.fill <- fc$pt_fill
  pt.color <- fc$pt_col
  ts_area_fill <- fc$area_fill


  # ------------------------------------------------
  # analysis
  # ------------------------------------------------

  txstats <- NULL  # remains NULL if stat analysis (e.g., mean) does not occur

  # Trellis plot
  # ------------
  if (Trellis) {
    if (T.type %in% c("cont", "cont_cont", "cont_cat")) {

      if (!quiet)
        cat("[Trellis (facet) graphics from Deepayan Sarkar's",
            "lattice package]\n\n")

      n.facet1 <- length(levels(facet1.call))

      if (!y.miss) {
        if (xor(cat.x, cat.y)  &&  n.facet1 > 1) {
          cont.nm <- if (cat.x) y.name else x.name  # the continuous variable
          cat.nm  <- if (cat.x) x.name else y.name  # the categorical variable
          fname <- if (!is.null(facet2.name))
                     paste0("c(", facet1.name, ", ", facet2.name, ")")
                   else facet1.name
          cat("\n"); stop(call.=FALSE, "\n------\n",
            "XY() requires a continuous  x  and a continuous  y.\n",
            "For a faceted distribution of the continuous  ", cont.nm,
            "  across\n  the levels of the categorical  ", cat.nm,
            ", use  X()  with a  by  variable:\n",
            "  X(", cont.nm, ", by=", cat.nm, ", facet=", fname, ")\n\n")
        }
      }

      # VBS plots (a single numeric variable) now processed by X()
      # e.g., y.miss=FALSE,  Plot(Years, Salary, facet1=Gender)
      adj.bx.ht <- nrows  # just to adjust box height
      if (size.miss) pt.size <- pt.size * .8

      if (!is.null(jitter_x)) if (jitter_x > 0)  # not available in stripplot
        x.call[,1] <- jitter(x.call[,1], factor=jitter_x)

      # n_col is null for XY(x), XY(x, by=), XY(x, facet=)
      if (n.col.miss && n.row.miss && !is.null(facet1.call))
        n_col <- 1  # default n_col for Trellis

      options(facet1name=facet1.name)
      if (do_plot)
      .plt.lattice(x.call[,1], if (!is.null(y.call)) y.call[,1] else NULL,
                   facet1.call, facet2.call, by.call,
                   adj.bx.ht, object, n_row, n_col, aspect,
                   pt.fill, ts_area_fill, pt.color, panel_fill, panel_color,
                   pt.size, line_width,
                   xlab, ylab, main, pt_shape, lab_size, axis_size,
                   max(ellipse), ellipse_color, ellipse_lwd,
                   fit.ln, fit_power, fit_color, fit_lwd, fit_se,
                   plot_errors, ts_area_split, jitter_y,
                   violin=FALSE, violin_fill=getOption("violin_fill"),
                   box=FALSE, box_fill=getOption("box_fill"),
                   bw=NULL, vbs_ratio=0.9, box_adj=FALSE, a=-4, b=3,
                   k.iqr=1.5, fences=FALSE, vbs_mean=FALSE,
                   out_shape, out_size,
                   out_fill, out_color, out2_fill, out2_color,
                   ID.call, out_cut, ID_color, ID_size,
                   axis_fmt, axis_x_prefix, axis_y_prefix,
                   rotate_x, rotate_y, n_axis_x_skip, n_axis_y_skip,
                   width, height, pdf_file, T.type, quiet, ...)


# pivot tables ------------------------------------------------------------

      if (!date.var && !run) {  # no time vars

        x_vec <- x.call[[ x.name ]]   # e.g., data[["Salary"]]
        group.vars <- character(0)

        if (!quiet) cat("\n---------- Summary Statistics for", x.name)

        if (!by.miss) {
          group.vars <- c(group.vars, by.name)
          out.by <- .vbs_summary_table(
            x_vec    = x_vec,
            grp_vec  = by.call,
            grp.label = by.name,
            digits_d  = .max.dd(x_vec)
          )
          if (!quiet) {
            cat("\n\n")
            print(out.by)
          }
        }

        if (!facet.miss) {
          # Use facet1.call/facet2.call which were updated by the cc NA filter,
          #   not fac.list which still holds the original pre-filter data.
          facet.calls <- list(facet1.call, facet2.call)[seq_along(facet.vars)]
          out.facet <- vector("list", length(facet.vars))
          for (.fi in seq_along(facet.vars)) {
            group.vars <- c(group.vars, facet.vars[.fi])
            out.facet[[.fi]] <- .vbs_summary_table(
              x_vec     = x_vec,
              grp_vec   = facet.calls[[.fi]],
              grp.label = facet.vars[.fi],
              digits_d  = .max.dd(x_vec)
            )
            if (!quiet) {
              cat("\n\n")
              print(out.facet[[.fi]])
            }
          }
        }

        if (length(group.vars) == 0) {
          out.all <- .vbs_summary_table(
            x_vec  = x_vec,
            grp_vec = NULL,
            grp.label = x.name,
            digits_d  = .max.dd(x_vec)
          )
          if (!quiet) {
            cat("\n\n")
            print(out.all)
          }
        }
      }  # end pivot tables with no time vars

      if (do_plot  &&  .allow.interactive()) {
        .viewer_notice_once(plot_name = form, window_target = "Plots")
      }
    }  # end T.type != "dot

    else {  # bar plot

      if (seg.x.miss) segments_x <- TRUE
      if (do_plot)
      .bar.lattice(x.call[,1], facet1.call, facet2.call, n_row, n_col, aspect,
                   proportion, pt.fill, pt.color,
                   pt.trans, pt.size, xlab, ylab, main,
                   rotate_x, offset,
                   axis_fmt, axis_x_prefix, axis_y_prefix,
                   width, height, pdf_file,
                   segments_x, breaks=NULL, T.type,
                   quiet=quiet, ...)
    }


  }  # end Trellis


  # ------------------
  # scatterplot matrix
  else if (spmat) {
    if (do_plot) {
      bckg <- ifelse(panel_fill=="transparent",
                     getOption("window_fill"), panel_fill)
      .plt.mat(x.call, fit=fit.ln, col_fill=pt.fill, col_color=pt.color,
                       col.bg=bckg, col_trans=pt.trans,
                       pt.size=pt.size, size.miss=size.miss)
    }
  }

  # ------------------
  # faceted contour or smooth density: base-R panel grid, shared density scale
  else if (form %in% c("contour", "smooth")  &&  !facet1.miss) {
    if (do_plot) {
      xlb <- if (!is.null(xlab) && nzchar(xlab)) xlab else x.name
      ylb <- if (!is.null(ylab) && nzchar(ylab)) ylab else y.name
      .plt.contour.facet(x.call[,1], y.call[,1],
         facet1.call, facet2.call, facet1.name, facet2.name,
         contour_n, contour_nbins, contour_points, pt.size[1],
         getOption("theme"), scale_x, scale_y, pad_x, pad_y, xlb, ylb,
         ellipse, ellipse_color, ellipse_lwd, fit.ln, fit_color, fit_lwd,
         axis_x_prefix, axis_y_prefix, axis_fmt, n_row, n_col, quiet,
         render = form, smooth_power = smooth_power,
         smooth_points = smooth_points, smooth_bins = smooth_bins,
         main = main)
    }
  }

  # ------------------
  # faceted hexbin: hexbin's native lattice paneling, one shared count legend
  else if (form == "hexbin"  &&  !facet1.miss) {
    if (do_plot) {
      xlb <- if (!is.null(xlab) && nzchar(xlab)) xlab else x.name
      ylb <- if (!is.null(ylab) && nzchar(ylab)) ylab else y.name
      .plt.hexbin.facet(x.call[,1], y.call[,1],
         facet1.call, facet2.call, facet1.name, facet2.name,
         hex_bins, hexbin_legend, xlb, ylb, n_row, n_col, aspect, quiet,
         axis_fmt = axis_fmt, axis_x_pre = axis_x_prefix,
         axis_y_pre = axis_y_prefix)
    }
  }

  # ------------------
  # facet= with a vector of x (or y) variables: the multi-series overlay
  #   repeated across the panels of the facet variable(s), each panel the
  #   full overlay for one facet level, all panels on a common scale
  else if (nn.col > 1  &&  !facet1.miss) {
    if (do_plot) {
      if (!quiet)
        cat("[Trellis (facet) graphics from Deepayan Sarkar's",
            "lattice package]\n\n")
      if (n.xcol > 1) {
        ylb <- if (!is.null(ylab) && nzchar(ylab)) ylab else y.name
        .plt.facet.series(x.call, y.call[,1], ylb, "x",
           facet1.call, facet2.call,
           pt.fill, pt.color, pt.size, pt_shape,
           fit.ln, fit_lwd, n_row, n_col, aspect)
      }
      else {
        xlb <- if (!is.null(xlab) && nzchar(xlab)) xlab else x.name
        .plt.facet.series(y.call, x.call[,1], xlb, "y",
           facet1.call, facet2.call,
           pt.fill, pt.color, pt.size, pt_shape,
           fit.ln, fit_lwd, n_row, n_col, aspect)
      }
    }
  }

  else if (n_bins > 1) {  # bin the x-axis, compute mean or median of y by bin

    if (stat.miss) stat <- "mean"
    if (seg.miss) segments <- TRUE
    if (size.miss) pt.size <- 1.1
    if (is.null(digits_d)) digits_d <- 3
    nm.x <- x.name
    nm.y <- y.name
    # size is NULL if not specified
    .plt.bins(x.call[,1], y.call[,1], nm.x, nm.y, stat, n_bins,
              segments=segments, size=pt_size, digits_d, scale_x, scale_y,
              fill=pt.fill, color=pt.color, trans=pt.trans,
              quiet=quiet)
    use_plotly <- FALSE
  }

  # all the other analyses
  # ----------------------

  else {
    if (stat %in% c("sum", "mean", "sd", "deviation", "min", "median", "max")) {

      means <- FALSE
      if (seg.x.miss) segments_x <- TRUE

      if (!missing(y) && cat.y) {
        cat("\n"); stop(call.=FALSE, "\n------\n",
        y.name, " is not numerical, so cannot compute its mean\n\n")
      }

      # compute stats text before reducing data, printed later if !quiet
      if (!missing(y)) {
        options(yname = x.name)  # reverse order of x and y for .ss.numeric
        options(xname = y.name)
        stats <- .ss.numeric(y.call[,1], by=x.call[,1],
                             digits_d=digits_d, brief=TRUE, y.name=x.name)
        txstats <- stats$tx
        options(xname = x.name)  # reverse back
        options(yname = y.name)
      }
      else  {  # y is missing, so counts
        stats <- .ss.factor(x.call, digits_d=digits_d, x.name=x.name,
                            brief=TRUE)
        txstats <- stats$counts
      }

      class(txstats) <- "out"

    # set up new x.call and y.call for stats
    # only does overall stat, so not applicable if a by parameter
      stat.out <- .agg(x.call[,1], y.call[,1], stat=stat, y.name=y.name)
      ylab <- stat.out$ylab

      x.call <- data.frame(x.call=stat.out$out$x, stringsAsFactors=TRUE)
      y.call <- data.frame(y.call=stat.out$out$y)
    }  # end stat transform


    # ----------------------------------------------------
    # ----------------------------------------------------
    # 2-variable scatter plot
    # bubble plot for 1-variable (y.call=0) and 2-variable
    # line chart

    if ((!is.null(y.call) || date.var) &&
        object %in% c("point", "bubble", "sunflower")) {

      # Cleveland dot plot
      if (object == "point"  &&  data.do) {
        if (!cat.x && cat.y && y.unique) {
          if (seg.y.miss) if (y.unique && cat.y) segments_y <- TRUE
          if (is.null(origin_x)) origin_x <- 0
        }
        if (cat.x && !cat.y && x.unique) {
          if (seg.x.miss) if (x.unique && cat.x) segments_x <- TRUE
          if (is.null(origin_y)) origin_y <- 0
        }
      }

      # sort y by x option for 1 var Cleveland dot plot
      srt.dwn <- sort == "-"  # TRUE = descending
      if (sort != "0") {
        if (n.xvar == 1) {  # one x-variable
          if (cat.x && !cat.y && x.unique) {
            x.vals <- as.character(x.call[,1])  # factor to char vec
            y.vals <- y.call[,1]  # Extract numeric vector from df
            ord <- order(y.vals, decreasing=srt.dwn)
            x.sort <- x.vals[ord]
            x.call[,1] <- factor(x.sort, levels=x.sort)
            y.call[,1] <- y.vals[ord]
          }
          if (!cat.x && cat.y && y.unique) {
            y.vals <- as.character(y.call[,1])  # factor to char vec
            x.vals <- x.call[,1]  # Extract numeric vector from df
            ord <- order(x.vals, decreasing=srt.dwn)
            y.sort <- y.vals[ord]
            y.call[,1] <- factor(y.sort, levels=y.sort)
            x.call[,1] <- x.vals[ord]
          }
        }
      }  # end 1 x var sort

      # for Cleveland paired-dot plot, two x-vars
      # sort by diffs AND print differences, y must be cat
      segments_diff <- n.xvar == 2 && ncol(x.call) == 2 && cat.y && y.unique

      txdif <- NULL
      if (segments_diff) {

        # compute diffs and a single ordering
        difs <- x.call[, 2] - x.call[, 1]
        ord  <- order(difs, decreasing = srt.dwn)

        x.call <- x.call[ord, , drop = FALSE]
        y.call <- y.call[ord, , drop = FALSE]
        difs   <- difs[ord]

        # printed output table now in the same order as the plot
        tx <- character(0)

        dd <- .max.dd(c(x.call[, 1], x.call[, 2])) + 1L
        if (dd > getOption("digits")) dd <- getOption("digits")

        ny   <- nrow(y.call)
        mx.i <- nchar(as.character(ny))
        mx.d <- max(nchar(.fmt(difs, dd)))
        y.labels <- as.character(y.call[, 1])
        mx.f <- max(5L, nchar(y.labels), na.rm = TRUE)

        tx[length(tx) + 1L] <- paste(.fmtc("n", mx.i), " ",
                                     .fmtc(" diff", mx.d), "  Row", sep = "")
        tx[length(tx) + 1L] <- .dash2(mx.i + mx.d + mx.f + 2L, "-")

        if (ny <= 20L)
          rng <- 1:ny
        else
          rng <- c(1:10, (ny - 9L):ny)

        # for the printed list to match the visual "top of plot first",
        # print from last row to first row
        for (i in 1:ny) {
          k <- ny - (i - 1L)
          if (i %in% rng) {
            txt <- paste(.fmti(i, mx.i), .fmt(difs[k], dd, mx.d), y.labels[k])
            tx[length(tx) + 1L] <- txt
          }
        }

        txdif <- tx  # displayed later in .plt.txt
      }  # end two var Cleveland dot plot

      # bigger point for scatterplot of stats (instead of data)
      if (!data.do  &&  object == "point")
        if (is.null(pt_size)) pt.size <- 1.25

      # outlier analysis, need before .plt.main
      outlpts <- NULL
      out_outliers <- ""
      if (!y.miss && !Trellis)
        if (n.xvar==1 && n.yvar==1
             && is.numeric(x.call[,1]) && is.numeric(y.call[,1]))
        if (MD_cut > 0  ||  out_cut > 0) {
          otl <- .plt.MD(x.call[,1], y.call[,1], ID.call, MD_cut, out_cut)
          out_outliers <- otl$tx  # descriptive text
          outlpts <- otl$outlpts  # the outliers
      }

      if (!is.null(y.call)) {
        if (nrow(x.call) != nrow(y.call))  {
          cat("\n"); stop(call.=FALSE, "\n-----\n",
            "number of elements in x: ", nrow(x.call), "\n",
            "number of elements in y: ", nrow(y.call), "\n\n",
            "The number of elements must be equal, probably\n",
            "  have variables from user workspace so maybe\n",
            "  use the  remove function, e.g., remove(x)\n\n")
        }
      }

      # by default display center_line only if runs about a mean
      if (run  &&  center_line == "default") {
        y.clean <- y.call[complete.cases(y.call), 1]  # converts df to vector
        m <- mean(y.clean)
        n.change <- 0
        for (i in 1:(length(y.clean)-1))
          if ((y.clean[i+1] > m) != (y.clean[i] > m)) n.change <- n.change+1
        if (n.change/(length(y.clean)-1) < .15)
          center_line <- "off"
        else
          center_line <- "median"
      }


# if x is a Date variable -------------------------------------------------

      #   if not specified, get the existing ts_unit
      #   if specified, may need to aggregate the values of y.call over x.call
      if (date.var) {
        if (!quiet) {
          txt <- "Ryan, Ulrich, Bennett, and Joy's xts package]"
          cat("[with functions from", txt, "\n")
          if (!(ts_source=="fable" && ts_ahead > 0)) cat("\n")
        }

        tsdata <- .plt.time(x.call, y.call, by.call, x.name, n.by,
                            ts_unit, ts_agg)
        ts_unit <- tsdata$ts_unit
        x.call <- tsdata$x.call
        y.call <- tsdata$y.call
        by.call <- tsdata$by.call
        do.agg <- tsdata$do.agg
      }
      else
        do.agg <- FALSE

      # forecast
      # --------
      if (ts_ahead > 0) {
        if (ts_unit=="unknown") {
          cat("\n"); stop(call.=FALSE, "\n------\n",
            "ts_unit: ", ts_unit, "\n",
            "Cannot forecast without a consistent time unit.\n\n")
        }
        if (any(is.na(y.call))) {
          cat("\n"); stop(call.=FALSE, "\n------\n",
            "Missing values not allowed for a variable for which\n",
            "  to forecast future values.\n\n")
        }

      # process any exogenous variables
      exog.df <- NULL  # default: no exogenous variables
      if (!is.null(ts_new_x)) {  # df of future values of exogenous variables
        exog.names <- names(ts_new_x)
        missing.vars <- setdiff(exog.names, names(data)) # all exog vars exist
        if (length(missing.vars) > 0) {
          stop("\n------\n",
               "The following exogenous variables are not in existing data:\n",
               paste(missing.vars, collapse = ", "), "\n\n",
               "Please ensure all specified columns are in the input data.\n",
               call. = FALSE)
        }
        # keep only exogenous predictors except index and y variable
        drop.names <- c(x.name, y.name)
        exog.df <- data[setdiff(exog.names, drop.names)]
      }

      f.out <- .plt.forecast(x.call, y.call, by.call,
          exog.df, ts_new_x,
          ts_unit, ts_ahead, ts_method, ts_fitted, ts_source, ts_n_x_tics,
          ts_trend, ts_seasons, ts_error,
          ts_alpha, ts_beta, ts_gamma, ts_PI, digits_d, quiet)

        y.fit <- f.out$y.fit;  y.hat <- f.out$y.hat
        x.fit <- f.out$x.fit;  x.hat <- f.out$x.hat
        y.upr <- f.out$y.upr;  y.lwr <- f.out$y.lwr
        mx.x <- f.out$mx.x;  mn.y <- f.out$mn.y;  mx.y <- f.out$mx.y
        out_y.frcst <- f.out$y.frcst
        out_decomp <- f.out$out_decomp
        out_fitted <- f.out$out_fitted
        out_report <- f.out$out_report
      }  # end forecast

      else {  # no forecast
        y.fit <- NULL;  y.hat <- NULL
        x.fit <- NULL;  x.hat <- NULL
        y.upr <- NULL;  y.lwr <- NULL
        mx.x <- NULL;  mn.y <- NULL;  mx.y <- NULL
        out_y.frcst <- NULL; out_decomp <- NULL
        out_fitted <- NULL; out_report <- NULL
      }

      # see if set origin of x-axes to 0
      if (is.null(origin_x)) {
        x.all <- unlist(x.call)
        numr <- all(is.numeric(x.all))
        if (numr) {
          if (all(x.all < 0)) x.all <- -x.all  # account for - values
          min.x <- min(x.all, na.rm=TRUE)
          max.x <- max(x.all, na.rm=TRUE)

          if (!date.var) {
            if (min.x > 0) {  # all + or all - which were converted to +
              rng <- max.x - min.x
              prp <- rng / min.x
              if (prp > 2.40) origin_x <- 0  # 2.40 cutoff is a heuristic
            }
          }
        }  # end numr
        remove(x.all)
      }  # end is null origin_x

      else if (!date.var) {  # validate the user-supplied origin_x
        x.all <- unlist(x.call)
        if (all(is.numeric(x.all))) {
          min.x <- min(x.all, na.rm=TRUE)
          if (origin_x > min.x) {
            cat("\n"); stop(call.=FALSE, "\n------\n",
              "Minimum value of x: ", min.x, "\n",
              "Value you set for origin_x: ", origin_x, "\n",
              "origin_x cannot be larger than the minimum x data value.\n\n")
          }
        }
        remove(x.all)
      }

      mse.ln <- NULL;  mse.nl <- NULL;  by.cat <- NULL;  y.new <- NULL

      # m out, mostly the visualization, sometimes some stats

      if (do_plot)  {
        m.out <- .plt.main(
          x=x.call, y=y.call, by=by.call,
          cat.x=cat.x, cat.y=cat.y,
          object=object, stat=stat,

          fill=pt.fill,
          ts_area_fill=ts_area_fill,
          color=pt.color,
          pt.trans=pt.trans,
          col.segment=segment_color,

          xy_tics=xy_ticks,
          xlab=xlab, ylab=ylab, main=main, main_size=main_size, sub=sub,
          rotate_x=rotate_x, rotate_y=rotate_y,

          offset=offset, prop=proportion,
          origin_x=origin_x, origin_y=origin_y,

          size=pt.size, ln.width=line_width, shape=pt_shape, means=means,

          segments=segments, segments_y=segments_y, segments_x=segments_x,
          segments_diff=segments_diff,

          form=form,
          smooth_points=smooth_points, smooth_size=smooth_size,
          smooth_power=smooth_power, smooth_bins=smooth_bins,
          hex_bins=hex_bins, hexbin_legend=hexbin_legend,

          contour_n=contour_n,
          contour_nbins=contour_nbins, contour_points=contour_points,
          contour_legend=contour_legend,

          radius=radius, power=power, size_cut=pt_size_cut,
          bbl.txt.col=bbl.txt.col,

          col.low=low_fill, col.hi =hi_fill,

          ID=ID.call, ID_color=ID_color, ID_size=ID_size, out_ind=outlpts,

          out_fill=out_fill, out_color=out_color,
          out_shape=out_shape, out_shape.miss=out.shape.miss,

          fit.line=fit.ln, fit_power=fit_power, fit_color=fit_color,
          fit_lwd=fit_lwd, fit_new=fit_new,

          fit_se=fit_se, se_fill=se_fill,
          plot_errors=plot_errors,

          ellipse=ellipse,
          ellipse_color=ellipse_color,
          ellipse_fill=ellipse_fill,
          ellipse_lwd=ellipse_lwd,

          run=run, center_line=center_line, stack=ts_stack,

          ts_unit=ts_unit, ts_agg=ts_agg, do.agg=do.agg,
          ts_ahead=ts_ahead, ts_fit=ts_fitted,
          n_date_tics=ts_n_x_tics,

          y.fit=y.fit, y.hat=y.hat,
          x.fit=x.fit, x.hat=x.hat,
          y.upr=y.upr, y.lwr=y.lwr,

          mxf.x=mx.x, mnf.y=mn.y, mxf.y=mx.y,

          freq.poly=freq.poly,
          jitter_x=jitter_x, jitter_y=jitter_y,

          xlab.adj=xlab.adj, ylab.adj=ylab.adj,
          bm.adj=bm.adj, lm.adj=lm.adj, tm.adj=tm.adj, rm.adj=rm.adj,

          scale_x=scale_x, scale_y=scale_y,
          pad_x=pad_x, pad_y=pad_y,

          axis_fmt=axis_fmt,
          axis_x_pre=axis_x_prefix, axis_y_pre=axis_y_prefix,

          legend_title=legend_title,
          use_plotly=use_plotly,

          add=add,
          x1=x1, x2=x2, y1=y1, y2=y2,
          add_size=add_size, add_lwd=add_lwd, add_lty=add_lty,
          add_color=add_color, add_fill=add_fill, add_trans=add_trans,

          quiet=quiet, digits_d=digits_d, style_opts=style.opts, ...
        )

        if (fit.ln != "off") {
          b0 <- m.out$b0;  b1 <- m.out$b1
          mse.ln <- m.out$mse.ln;  Rsq <- m.out$Rsq;  mse.nl <- m.out$mse.nl
          by.cat <- m.out$by.cat
          y.new <- m.out$y.new
        }

      # build text output even when quiet so the stats are returned;
      # printing of the result is gated by quiet at the end of the function
      {
        txjit <- NULL
        if (!is.null(jitter_x) && !is.null(jitter_y)) {
          if (jitter_x != 0  ||  jitter_y != 0) {  # show jitter
            tx <- character(length = 0)
            tx[length(tx)+1] <- "Some Parameter values (can be manually set)"
            tx[length(tx)+1] <- .dash2(55)
            tx[length(tx)+1] <- paste("size:", .fmt(pt.size,2),
                " size of plotted points")
            if (!is.null(jitter_y)) if (jitter_y != 0)
              tx[length(tx)+1] <- paste("jitter_y:", .fmt(jitter_y,2),
                " random vertical movement of points")
            if (!is.null(jitter_x)) if (jitter_x != 0)
              tx[length(tx)+1] <- paste("jitter_x:", .fmt(jitter_x,2),
                " random horizontal movement of points")
            txjit <- tx
          }
        }

        #  radius, power values in the analysis
        txbub <- NULL
        if (object == "bubble") {   # move to .plt.txt
          tx <- character(length = 0)
          tx[length(tx)+1] <- "Some Parameter values (can be manually set)"
          tx[length(tx)+1] <- .dash2(55)
          tx[length(tx)+1] <- paste("radius:", .fmt(radius,2),
              "   size of largest bubble")
          tx[length(tx)+1] <- paste("power:", .fmt(power,2),
              "    relative bubble sizes")
          txbub <- tx
        }

        if (n_bins == 1) {  # if binning, .plt.bins does its own output

          # NULL when no fit computed; inherits=FALSE so that a user
          # object of the same name in the global env is not picked up
          if (!exists("Rsq", inherits=FALSE)) Rsq <- NULL
          if (!exists("b0", inherits=FALSE))  b0  <- NULL
          if (!exists("b1", inherits=FALSE))  b1  <- NULL
          # .plt.txt prints some run-chart output directly, so capture
          # and discard its console output when quiet
          if (quiet)
            invisible(capture.output(
              o <- .plt.txt(x.call, y.call, stat, object, cat.x, cat.y,
                date.var, xlab, ylab, fit.ln, n.by, mse.ln, mse.nl,
                b0, b1, Rsq, fit_new, y.new, by.cat,
                center_line, run, show_runs,
                proportion, pt_size, radius, digits_d, fun_call)))
          else
            o <- .plt.txt(x.call, y.call, stat, object, cat.x, cat.y,
              date.var, xlab, ylab, fit.ln, n.by, mse.ln, mse.nl,
              b0, b1, Rsq, fit_new, y.new, by.cat,
              center_line, run, show_runs,
              proportion, pt_size, radius, digits_d, fun_call)

          # cumulate existing output pieces from o into final output
          output <- NULL

          if (getOption("suggest"))
            if (ts_ahead==0) output <- list(out_suggest=o$out_suggest)

          if (!is.null(txdif))
            output$out_dif <- txdif

          if (!is.null(outlpts)) {
            class(outlpts) <- "out"  # MD outliers
            output$outlpts <- outlpts
          }
          if (length(out_outliers) > 1)  # source is here
            output$out_outliers <- out_outliers
          if (length(o$out_outliers) > 1)  # source is .plt.txt
            output$out_outliers <- o$out_outliers

          if (!is.null(o$out_stats) && any(nzchar(o$out_stats))) {
            output$out_stats <- o$out_stats
          }

          if (!is.null(txstats))  # from stat option earlier in this file
            output$out_txt <- txstats

          if (!is.null(o$out_y.new)) {  # a data frame, not the usual tx
            if (all(nzchar(o$out_y.new))) {
              output$out_y.new <- o$out_y.new  # leave a df for print.out_all()
            }
          }

          if (length(o$out_reg) == 1) {
            if (nzchar(o$out_reg))
              output$out_reg <- o$out_reg
          }
          else if (length(o$out_reg) > 1)  # by activated
            output$out_reg <- o$out_reg

          if (!is.null(o$out_XV)) if (length(o$out_XV) > 1)
            output$out_XV <- o$out_XV


          if (!is.null(txjit)) {
            class(txjit) <- "out"  # jitter parameter
            output$out_jitter <- txjit
          }

          if (!is.null(txbub)) {
            class(txbub) <- "out"  # bubble plot parameters
            output$out_bubble <- txbub
          }

          if (!is.null(out_report)) {
            class(out_report) <- "out"
            output$out_report <- out_report
          }

          if (!is.null(output)) class(output) <- "out_all"
        }  # end n_bins==1
      }  #  end text output

    }  #  end do_plot

    else {  # no plot
      output <- NULL
    }

  }  # end all other analyses
  # -------------------------


  # display text output from XY() unless turned off
  # T.type is the type of Trellis plot, otherwise is NULL

    if (n_bins == 1  &&  Trellis) {  # only VBS output is processed here
      if (!(T.type %in% c("cont", "cont_cat"))) outp <- FALSE
    }
    if (n.xvar > 1  &&  y.miss) outp <- FALSE  # scatterplot matrix

    if (ts_ahead > 0  &&  !is.null(out_decomp)) class(out_decomp) <- "out"

    if (outp  &&  !quiet) {
      if (!is.null(output)) print(output)  # output what exists till now

      if (ts_ahead > 0) {  # did a forecast
        if (!is.null(out_decomp)) print(out_decomp)
        if (!is.null(out_fitted)) {
          fitted.title <- "\nFitted\n------\n"
          class(fitted.title) <- "out"
          print(fitted.title)
          print(out_fitted)
          cat("\n")
        }
        if (!is.null(out_y.frcst)) {
          frcst.title <- "Forecast\n--------\n"
          class(frcst.title) <- "out"
          print(frcst.title)
          print(out_y.frcst)
          cat("\n")
        }
      }  # end ts_ahead > 0
    }  # end outp

    # make forecast results retrievable from the returned object
    if (ts_ahead > 0) {
      if (!is.null(out_decomp))  output$out_decomp   <- out_decomp
      if (!is.null(out_fitted))  output$out_fitted   <- out_fitted
      if (!is.null(out_y.frcst)) output$out_forecast <- out_y.frcst
      if (!is.null(output) && !inherits(output, "out_all"))
        class(output) <- "out_all"
    }

  }  # end all the other analyses

  # terminate pdf graphics system if used
  # for Trellis, .plt.lattice closes the pdf device that it plots to
  if (!is.null(pdf_file)) {
    if (!Trellis) dev.off()
    if ((!Trellis || pdf.trellis)  &&  !quiet  &&  df.name != "NULL")
      .showfile(pdf_file, "Plot")
  }

  # reset for next analysis
  options(xname=NULL)
  options(yname=NULL)
  options(facet1name=NULL)
  options(facet2name=NULL)
  options(byname=NULL)

  if (!is.null(output)) return(invisible(output))  # to stored object
}
