XY <-
function(x, y=NULL, data=d, filter=NULL,  # keep y=NULL for if x is a ts

    by=NULL, facet=NULL,
    n_row=NULL, n_col=NULL, aspect="fill",
    
    type=c("scatter", "smooth", "contour", "hexbin"),

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

    enhance=FALSE, means=TRUE,
    pt_size=NULL, size_cut=NULL, 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"),

    vbs_plot="vbs", vbs_ratio=0.9, bw=NULL, bw_iter=10,
    violin_fill=getOption("violin_fill"),
    box_fill=getOption("box_fill"),
    vbs_pt_fill="black",
    vbs_mean=FALSE, fences=FALSE, k=1.5, box_adj=FALSE, a=-4, b=3,

    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, n_bins=1,
    contour_n=10, contour_nbins=50, contour_points=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="",
    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, ...) {


  if (is.null(fun_call)) fun_call <- match.call()
  if (nzchar(axis_fmt[1])) axis_fmt <- match.arg(axis_fmt)

  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 <- !missing(type) && identical(type, "dot")
  if (dot_type) type <- "scatter"  # satisfies match.arg; overridden below
  type <- match.arg(type)

  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

  if (!quiet && use_plotly) {
    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))
    type <- "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 (type %in% c("contour", "smooth")  &&  !is.null(substitute(by))) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Parameter  by  not active for \"contour\" or \"smooth\" plots.\n\n")
  }

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

  if (type %in% c("contour", "smooth")  &&  !is.null(add)) {
    cat("\n"); stop(call.=FALSE, "\n------\n",
      "Parameter  add  not active for  \"contour\" or \"smooth\" 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  type.\n",
      "  because  \"contour\"  is now another value of  type.\n",
      "Now enter: type=\"smooth\"  or  type=\"contour\"\n\n")
  }

  fit.ln <- ifelse (!missing(fit), match.arg(fit), "off")

  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 removed.\n",
         "Use  filter  instead, e.g., filter = (Age > 30)\n\n")
  }
  if ("size" %in% .mc_nms) {
    stop(call. = FALSE, "\n------\n",
         "Parameter  size  has been renamed to  pt_size.\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")
  }

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

  if (!is.null(dots)) if (length(dots) > 0) {
    for (i in seq_along(dots)) {
      if (names(dots)[i] == "lty") {
        line_type <- dots[[i]]
        cat("\n"); stop(call.=FALSE, "\n------\n",
          "Parameter  lty  renamed to  line_type\n\n")  # lty still valid R
      }
      if (names(dots)[i] == "lwd") {
        line_width <- dots[[i]]
        cat("\n"); stop(call.=FALSE, "\n------\n",
          "Parameter  lwd  renamed to  line_width\n\n")  # lwd still valid R
      }
      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 (names(dots)[i] == "vbs_size") vbs_ratio <- dots[[i]]
      if (grepl(".", names(dots)[i], fixed=TRUE)) {
        nm <- gsub(".", "_", names(dots)[i], fixed=TRUE)
        assign(nm, dots[[i]])
        get(nm)
      }
    }
  }

  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.miss <- missing(sort)
  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 <- "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
  }

  vbs_plot <- tolower(vbs_plot)
  violin <- grepl("v", vbs_plot)
  box    <- grepl("b", vbs_plot)

  iter.details <- !missing(bw_iter)

  k.iqr <- k   # k is a function name, so do not use internally

  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_cex <- getOption("lab_cex")  # NOT passed to .plt.main
  axis_cex <- getOption("axis_cex")
  main_cex <- getOption("main_cex")

  add_cex <- getOption("add_cex")
  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
    sty <- style(theme, reset=FALSE)
    trans <- sty$pt$trans_fill
    fill <- sty$pt$fill
    pt.color <- sty$pt$fill  # just solid color points
    ellipse_fill <- sty$ellipse$fill
    violin_fill <- sty$VBS$violin_fill
    box_fill <- sty$VBS$box_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(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)
  box_fill.miss  <- missing(box_fill)
  violin_fill.miss   <- missing(violin_fill)
  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)
  bw.miss        <- missing(bw)
  n_col.miss     <- missing(n_col)
  n_row.miss     <- missing(n_row)
  add_miss       <- missing(add)
  ylab.miss      <- missing(ylab)

  if (!missing(a) || !missing(b)) box_adj <- TRUE

  if (missing(vbs_ratio)) if (!violin)  # wider box if no violin
    vbs_ratio <- ifelse (y.miss || facet.miss, vbs_ratio*3.75, vbs_ratio*5)

  # "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 size here so ts_stack can set it before the pt_size eval block
  size <- NULL

  # default point size for a stacked time series
  if (ts_stack) {
    if (size.miss) 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.miss <- 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")
  }

  if (!is.null(x.name) && !(shiny && df.name == "NULL")) .in.global(x.name, quiet)
  x.in.global <- if (shiny && df.name == "NULL") TRUE
                 else .resolve.var(x.name, df.name, role="x", fun.name="XY")

  if (!x.in.global) {
    # force evaluation (not lazy) if data not specified, relies on default d
    if (data.miss) {
      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_cex") == 1.201) {
       if (getOption("l.cex") != 1.201) {
          style(lab_cex=getOption("l.cex"))
          style(axis_cex=getOption("l.axc"))
        }
        else
          style(quiet=TRUE)
      }
    }
  }

  eval_df <- !x.in.global


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

  if (!missing(filter)) {

    if (x.in.global) {
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "Parameter  filter  not applicable if no data frame\n\n")
    }

    txt <- .filter(deparse(substitute(filter)))

    # get r, label each row as TRUE or FALSE
    intYN <- try(eval(parse(text = txt)), silent = TRUE)
    if (is.numeric(intYN)) {
      r <- rep(FALSE, nrow(data))
      r[intYN] <- TRUE
    }
    else {
      r <- eval(str2expression(txt), envir=data, enclos=parent.frame())
      r <- r & !is.na(r)  # set missing for a row to FALSE
    }

    nr.before <- nrow(data)
    if (any(r))
      data <- data[r,,drop=FALSE]
    if (!quiet) {
      cat("\nfilter: ",  txt, "\n-----\n")
      cat("Rows of data before filtering: ", nr.before, "\n")
      cat("Rows of data after filtering:  ", nrow(data), "\n\n")
    }
  }  # end filter


# 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 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)
  # can only access x directly if it is not in a data frame
  else if (is.data.frame(x)) { # x a data frame
      cat("\n"); stop(call.=FALSE, "\n------\n",
        "Need to specify variables for analysis,\n",
        "not a full data frame\n\n")
  }

  # time series in global env
  # deconstruct to a data frame of dates for x var and then a df for y
  else if (is.ts(x)) {
    y.name <- deparse(substitute(x))  # get the name of the time series
    ylab <- y.name
    options(yname = y.name)
    date.var <- TRUE
    if (is.null(xlab)) xlab <- ""  # unless specified, drop the axis label
    tsPull <- .tsExtract(x, x.name)
    x.call <- tsPull$x.dates
    y.call <- tsPull$y
    n.yvar <- 1
  }  # end is.ts()

  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)
    }

    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=length(x.col))
      is.nmb <- logical(length=length(x.col))
      for (i in seq_along(x.col)) {  # see if variables are 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))
    }

    spmat <- FALSE
    if (!y.miss && same_xy_expr && all(is.nmb))  # do a scatterplot matrix
      spmat <- TRUE
    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
    n.yvar <- 1
  }
  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)

    in.global <- if (shiny && df.name == "NULL") TRUE
                 else .resolve.var(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 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 <- y
    }

    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 <- ""  # 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
    if (!date.var) 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",
      "Fit line only applicable if only one x variable, if y is present\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]))
  if (!is.null(y.call)) {
    ly <- length(y.call[,1])
    n.uy <- length(unique(y.call[,1]))
    x.unique <- n.ux == lx
    y.unique <- n.uy == ly
  } else {
    ly <- 0L
    n.uy <- 0L
    x.unique <- n.ux == lx
    y.unique <- 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)
  Trellis <- fnl$Trellis
  T.type <- fnl$T.type  # needed only for Trellis

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

  if (!data.do  &&  n.xvar == 1)
    if (!cat.x) violin <- FALSE

  # 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 <- deparse(substitute(by))
    if (by.name == "NULL")
      do.by <- FALSE  # specified by=NULL in call, including shiny
    by.in.global <- .resolve.var(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)
      .xcheck(by.name, df.name, names(data))

    if (!by.in.global) {  # get the 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 && !is.null(by.call) && shape[1]!="vary")
      shape  <- .align_vector(shape, by.call)  # convert named shape to unnamed
    shp <- .plt.shapes(shape, out_shape, n.by=by.unq)
    shape <- shp$shape
  }  # end a by var

  else {   # process shapes (without a by var)
    if (shape[1] == "sunflower")
      object <- "sunflower"
    else {  # get numeric code for shape, check for bad shapes
      shp <- .plt.shapes(shape, out_shape)
      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)) {
    is.sorted <- all(order(data[[by.name]]) == seq_len(nrow(data)))
    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)
    caller_env <- parent.frame()

    get_col <- function(nm) {
      in_global <- .resolve.var(nm, df.name, role="facet", fun.name="XY")
      if (!in_global) {
        .xcheck(nm, df.name, names(data))
        data[[nm]]
      } else {
        get(nm, envir = caller_env)
      }
    }

    # Resolve symbols to factors
    fac_list <- lapply(facet_vars, function(nm) {
      v <- get_col(nm)
      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 = ", "), ".")
    }
  }


  # evaluate pt_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
    suppressWarnings(size.num <- as.numeric(size.name))  # number or variable?

  if (is.na(size.num)) {  # size a variable (did not resolve to a number)
      in.global <- .resolve.var(size.name, df.name, role="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)  # col num of each var
      size <- data[,size.col]
      if (!is.numeric(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) # for later access
    }  # end not global
  }  # end size is a variable
  else {
    size <- pt_size  # numeric constant: safe to evaluate now
  }
    if (is.null(size[1])) size.miss <- TRUE

    if (length(size) > 1) {
      object <- "bubble"
      options(sizename = size.name) # for later access
    }
  }  # end pt_size specified

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

  if (!grepl("s", vbs_plot)) size <- 0


  # 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") {
        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 (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
  if (!is.null(by.call)) width <- width + .85  # wider plot

  sm.tbl <- NULL  # for pivot() output of Trellis plots

  # ---------------------------------
  #  manage regular-R or PDF graphics
  if (!Trellis) {
    if (!is.null(pdf_file)) {
      if (!grepl(".pdf", pdf_file))
        pdf_file <- paste(pdf_file, ".pdf", sep="")
      pdf(file=pdf_file, width=width, height=height, onefile=FALSE)
    }
    else {
      if (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(size) && length(size) > 1) df$..size <- 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(size) && length(size) > 1) size <- 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(size)) size <- 0  # by default, just plot 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 {
        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)
      }

      if (!quiet) {

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

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

        bx <- .bx.stats(x.call, box_adj, k.iqr, a, b)
        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"
        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.unsorted(x.call[,1]) && is.null(by.call) && is.null(facet1.call)) {
        if (is.null(b.name)) {  # not evaluated for by var
          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 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 is.unsorted
    } # end df.name not "NULL"
  }  # end date.var

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

  # size of fit line
  # windows line too thin at 1, but no increments allowed, and 2 is too thick
  if (fit.ln != "off") if (is.null(fit_lwd)) fit_lwd <- getOption("fit_lwd")
  #   fit_lwd <- ifelse(.Platform$OS.type == "windows", 2, 1.5)

  # size of points
  if (size.miss)  # pt.size not set yet
    pt.size <- 1.00
  else {  # size had been set
    if (length(size) == 1)
      scale.pt <- 1.00
    else  # size var
      scale.pt <- 1  # forget Win/Mac scaling for size var, ruins size for Mac
    pt.size <- size * scale.pt
  }

  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

  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
  }

  fc <- .plt.colors(object, nn.col, 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 && do_plot) {
    if (T.type %in% c("cont", "cont_cont", "cont_cat")) {

      # VBS plot
      txt <- ifelse (!is.null(facet1.call),
                     "[Trellis (facet)", "[Violin/Box/Scatterplot")
      if (!quiet)
        cat(paste(txt, "graphics from Deepayan Sarkar's lattice package]\n\n"))

      # total number of facets
      n.facet1 <- length(levels(facet1.call))
      n.facet2 <- if (facet2.miss) 1 else length(levels(facet2.call))
      n.lvl <- n.facet1 * n.facet2
      ord.by.call <- is.ordered(facet1.call)

      if (!y.miss) {
        if (xor(cat.x, cat.y)  &&  n.facet1 > 1) {
          cat("\n"); stop(call.=FALSE, "\n------\n",
            "The way to submit this analysis is to have both categorical\n",
            "  variables be  facet1  and  facet2  variables, respectively.\n\n")
        }
      }

      # if facets, vary box fill
      if (grepl("b", vbs_plot))
          box_fill <- .plt.fill(box_fill, box_fill.miss, ord.by.call,
                                n.facet1, n.lvl, theme)

      if (violin_fill.miss  &&  vbs_plot == "v") {
        if (n.lvl == 0) {
          if (theme != "gray")
            violin_fill <- getOption("box_fill")
          else
            violin_fill <- "gray75"
        }
        else {
          if (theme != "gray")
            violin_fill <- .plt.fill(box_fill, box_fill.miss, ord.by.call,
                                  n.facet1, n.lvl, theme)
          else
            for (i in seq_len(n.lvl)) violin_fill[i] <- "gray75"
        }
      }
      else {
        if (!violin_fill.miss)  # otherwise specified value
          violin_fill <- .plt.fill(violin_fill, violin_fill.miss, ord.by.call,
                                   n.facet1, n.lvl, theme)
        else
          for (i in seq_len(n.lvl)) violin_fill[i] <- violin_fill[1]
      }

      # VBS plot, cont_cont is a 2-var scatterplot, not a VBS plot
      if (y.miss  &&  !run  &&  T.type != "cont_cont") {

        if (n.by > 1) {
          if (color.miss) {
            if (getOption("theme") %in% c("gray", "white"))
              pt.color <- getColors("grays", n=n.by)
            else
              pt.color <- getColors("hues", n=n.by, l=40)
          }
          for (i in 1:n.by) {
            if (fill.miss) {
              pt.fill[i] <- pt.color[i]
              pt.fill[i] <- .maketrans(pt.fill[i], (1-trans)*256)
            }
            if (box_fill.miss) box_fill[i] <- .maketrans(box_fill[i], 0.6*256)
          }
        }
        else {  # n.by is 0 or 1
          if ("black" %in% vbs_pt_fill) {
            if (fill.miss) pt.fill <- "black"
            if (trans.miss) pt.trans <- 0.1
            if (color.miss) pt.color <- "black"
          }
          if ("default" %in% vbs_pt_fill) {
            if (fill.miss) pt.fill <- "black"
            if (trans.miss) pt.trans <- getOption("trans_pt_fill")
            if (color.miss) pt.color <- "black"
          }
          else {
            if (fill.miss) pt.fill <- vbs_pt_fill
            if (trans.miss) pt.trans <- getOption("trans_pt_fill")
            if (color.miss) pt.color <- getOption("pt_color")
          }
        }  # end n.by is 0 or 1

        # grayscale
        if (theme %in% c("gray", "white"))
          if (any(pt.size > 0.4)) if (out_shape.miss) out_shape <- 23
        if (getOption("sub_theme") == "black") {
          if (fill.miss) pt.fill <- "black"
          if (color.miss) pt.color <- "black"
        }

        # shiny kludge, where jitter_y is set at 0.01 to allow for set to 0
        # the issue with shiny is that parameter values are never missing
        # j.y.miss NOT USED
        # if (df.name == "NULL"  &&  jitter_y == 0.01) j.y.miss <- TRUE

        message("Warning: In the future, run VBS plots from X()\n")

        # get some VBS parameters, including: pt.size, jitter, bw
        # ss.numeric called there
        if (df.name == "NULL"  &&  out_size == 1) out_size.miss <- TRUE
        VBS <- .param.VBS(x.call[,1], ID.call, facet1.call, facet1.miss,
                by.call, by.miss, bw, bw.miss, bw_iter, iter.details,
                lx, n.ux, k.iqr, box_adj, a, b,
                x.name, facet1.name, by.name, vbs_plot,
                n_col.miss, n_row.miss,
                size, out_size, out_size.miss,
                jitter_x, jitter_y,
                bin, breaks, bin_start, bin_width, bin_end, proportion,
                digits_d, quiet, fun_call, ...)
        pt.size <- VBS$pt.size
        pt.out_size <- VBS$out_size
        jitter_y <- VBS$jitter_y
        jitter_x <- VBS$jitter_x
        bw <- VBS$bw
        adj.bx.ht <- VBS$adj.bx.ht
        output$out_stats <- VBS$output  # text output
#       print(output)
      }  # end single VBS plot

      else {  # Trellis but not a VBS plot, such as when there is a by-variable
        # 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)

      if (!missing(vbs_plot))
        if (!grepl("s", vbs_plot)) pt.size <- 0  # gets rescaled if earlier

      # n_col is null for at Plot(x), Plot(x, by=), Plot(x, facet1=)
      if (n_col.miss && n_row.miss && !is.null(facet1.call))
        n_col <- 1  # default n_col for Trellis

      options(facet1name=facet1.name)
      .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.trans, pt.size, line_width,
                   xlab, ylab, main, shape, lab_cex, axis_cex,
                   max(ellipse), ellipse_color, ellipse_lwd,
                   fit.ln, fit_power, fit_color, fit_lwd, fit_se,
                   plot_errors, ts_area_split, jitter_y,
                   violin, violin_fill, box, box_fill,
                   bw, vbs_ratio, box_adj, a, b, k.iqr, fences, vbs_mean,
                   out_shape, pt.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, VBS only

        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 (.allow.interactive()) {
        .viewer_notice_once(plot_name = type, window_target = "Plots")
      }
    }  # end T.type != "dot

    else {  # bar plot

      if (seg.x.miss) segments_x <- TRUE
      .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 && do_plot


  # ------------------
  # scatterplot matrix
  else if (spmat && 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)
  }

  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=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

      # do stats console output before reducing data
      if (!quiet) {
        if (!missing(y)) {
          if (cat.y) {
            cat("\n"); stop(call.=FALSE, "\n------\n",
            y.name, " is not numerical, so cannot compute its mean\n\n")
          }
          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"
      }  # end !quiet

    # set up new x.call and y.call for stats
    # only does overall stat, so not applicable if a by parameter
      if (stat == "sum") {
        ylab <- paste("Sum of", y.name)
        out <- tapply(y.call[,1], x.call[,1], sum, na.rm=TRUE)
      }
      else if (stat == "mean") {
        ylab <- paste("Mean of", y.name)
        out <- tapply(y.call[,1], x.call[,1], mean, na.rm=TRUE)
      }
      else if (stat == "sd") {
        ylab <- paste("Standard Deviation of", y.name)
        out <- tapply(y.call[,1], x.call[,1], sd, na.rm=TRUE)
      }
      else if (stat == "deviation") {
        ylab <- paste("Mean Deviations of", y.name)
        out <- tapply(y.call[,1], x.call[,1], mean, na.rm=TRUE)
        out <- out - mean(out, na.rm=TRUE)
      }
      else if (stat == "min") {
        ylab <- paste("Minimum of", y.name)
        out <- tapply(y.call[,1], x.call[,1], min, na.rm=TRUE)
      }
      else if (stat == "median") {
        ylab <- paste("Median of", y.name)
        out <- tapply(y.call[,1], x.call[,1], median, na.rm=TRUE)
      }
      else if (stat == "max") {
        ylab <- paste("Maximum of", y.name)
        out <- tapply(y.call[,1], x.call[,1], max, na.rm=TRUE)
      }

      x.call <- factor(names(out))
      x.call <- data.frame(x.call, stringsAsFactors=TRUE)
      y.call <- as.vector(out)
      y.call <- data.frame(y.call)
    }  # 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 && !quiet) {

        # 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(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.ts(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"
      }

      # minimum value of y across all of y.call without aggregation
      if (is.numeric(y.call[,1]))
        min.y <- min(as.matrix(y.call[sapply(y.call, is.numeric)]),
                       na.rm=TRUE)  # select only numeric vars
      else
        min.y <- NULL


# 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(d)) # 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(names(d)[1], names(d)[2])
        exog.df <- d[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
        y.all <- rbind(y.call, y.upr, y.lwr)  # data + PI
        y.all <- unlist(y.all)  # flatten the data frame
      }  # 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
        y.all <- unlist(y.call)  # convert data frame to a vector
      }

      # see if set origin of x-axes to 0
      min.x <- NULL
      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)
          remove(x.all)

          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
      }  # end is null origin_x

      if (!is.null(origin_x)  &&  !is.null(min.x)) {
        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")
        }
      }

      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_cex=main_cex, 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=shape, means=means,

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

          type=type,
          smooth_points=smooth_points, smooth_size=smooth_size,
          smooth_power=smooth_power, smooth_bins=smooth_bins,
          hex_bins=hex_bins,

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

          radius=radius, power=power, size_cut=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_cex=add_cex, 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, ...
        )

        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
        }

      if (!quiet) {  # text output

        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

          if (!exists("Rsq")) Rsq <- NULL   # NULL when no fit computed
          if (!exists("b0"))  b0  <- NULL
          if (!exists("b1"))  b1  <- NULL
          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, 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
  # -------------------------


  # terminate pdf graphics system if used
  if (!is.null(pdf_file)) {
    dev.off()
    if (!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)

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

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


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

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

  }  # end all the other analyses

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