.plt.main <-
function(x, y, by=NULL,  # x and y dfs with vars x.call and y.call 
         cat.x=FALSE, cat.y=FALSE,
         object="point", stat="data",

         fill=getOption("pt_fill"),
         ts_area_fill="transparent",
         color=getOption("pt_color"),

         pt.trans=0, col.segment=getOption("segment_color"),

         xy_tics=TRUE,
         xlab=NULL, ylab=NULL, main=NULL, main_size=NULL, sub=NULL,
         rotate_x=0, rotate_y=0, offset=0.5, prop=FALSE,
         origin_x=NULL, origin_y=NULL,

         size=NULL, ln.width=1, shape=21, means=TRUE,
         segments=FALSE, segments_y=FALSE, segments_x=FALSE,
         segments_diff=FALSE,

         form="scatter", smooth_points=100, smooth_size=1,
         smooth_power=0.25, smooth_bins=128, hex_bins=30, hexbin_legend=TRUE,
         contour_n=8, contour_nbins=50, contour_points=FALSE,
         contour_legend=FALSE,

         radius=0.15, power=0.5, size_cut=TRUE,
         bbl.txt.col=getOption("bubble_text_color"),
         col.low=NULL, col.hi=NULL,

         ID=NULL, ID_color="gray50", ID_size=0.60, out_ind=NULL,
         out_fill, out_color, out_shape, out_shape.miss,

         fit.line="off", fit_power=1, fit_color="gray55",
         fit_lwd=getOption("fit_lwd"), fit_new=NULL,
         fit_se=1, se_fill="gray80", plot_errors=FALSE,
         span=0.75,

         ellipse=FALSE, ellipse_color="lightslategray",
         ellipse_fill="off", ellipse_lwd,

         run=FALSE, center_line="off", stack=FALSE,
         ts_unit=NULL, ts_agg="sum", do.agg=FALSE, ts_ahead=0,
         ts_fit=FALSE, n_date_tics=NULL,
         y.fit, y.hat, x.fit, x.hat, y.upr, y.lwr,
         mxf.x, mnf.y, mxf.y,

         freq.poly=FALSE, jitter_x=NULL, jitter_y=NULL,

         xlab.adj=0, ylab.adj=0,
         bm.adj=0, lm.adj=0, tm.adj=0, rm.adj=0,
         scale_x=NULL, scale_y=NULL, pad_x=c(0,0), pad_y=c(0,0),
         axis_fmt="K", axis_x_pre="", axis_y_pre="",
         legend_title=NULL, use_plotly=TRUE,

         add=NULL, x1=NULL, x2=NULL, y1=NULL, y2=NULL,
         add_size=NULL, add_lwd=1, add_lty="solid",
         add_color=NULL, add_fill=NULL, add_trans=NULL,

         quiet=FALSE, digits_d=NULL, style_opts = NULL, ...)  {




# preliminaries -----------------------------------------------------------

  fill_bg <- getOption("panel_fill")
  date.var <- .is.date(x[,1])
  if (is.null(size)) size <- 1
  size.pt <- size  # size is set in Plot.R, reduce a bit for here
  area_fill <- ts_area_fill
  theme <- getOption("theme")

  want.labels <- TRUE

  x.lv <- x[,1]
  y.lv <- y[,1]

# data structures dimensions ----------------------------------------------

  bubble1  <- length(unique(y[,1])) == 1
  unique.x <- length(unique(x[,1])) == length(x[,1])
  unique.y <- length(unique(y[,1])) == length(y[,1])
  n.by     <- if (is.null(by)) 1 else nlevels(by)
  do.ellipse <- ellipse[1] > 0

  # dimensions
  n.xcol <- ncol(x)
  n.ycol <- ncol(y)
  n.col <- max(n.xcol, n.ycol)
  nrows <- nrow(x)


# axis labels and title ---------------------------------------------------

  # size is a variable, these values passed to .plt.main
  # bubble.title=FALSE passed from .plt.bins to suppress title
  # bubble plot can be directly from object="point"

    main.lab <- NULL

  # get lab_x_size  lab_y_size    Synchronize with Plot() code, put in own sub
  lab_size <- getOption("lab_size")
  lab_x_size <- getOption("lab_x_size")
  lab_y_size <- getOption("lab_y_size")
  lab_x_size <- ifelse (is.null(lab_x_size), lab_size, lab_x_size)
  lab_y_size <- ifelse (is.null(lab_y_size), lab_size, lab_y_size)

  # get x.lab and y.lab
  if (date.var) xx.lab <- xlab
  if (want.labels) {
    gl <- .getlabels(xlab, ylab, main, lab_x_size=lab_x_size,
                     lab_y_size=lab_y_size)
    x.name <- gl$xn; x.lbl <- gl$xl; x.lab <- gl$xb
    y.name <- gl$yn; y.lab <- gl$yb
    if (is.null(main.lab)) main.lab <- gl$mb
    sub.lab <- gl$sb
    by.name <- getOption("byname")
  }
  else {
    x.lab <- xlab
    y.lab <- ylab
    if (is.null(main.lab)) main.lab <- main
    sub.lab <- sub
    x.name <- NULL
  }
  if (!is.null(x.lab)) if (n.xcol > 1  &&  substr(x.lab, 1, 2) == "c(")
      x.lab <- NULL  # e.g., get rid of == "c(Female, Male)"
  if (date.var && is.null(xx.lab)) x.lab <- ""

  # set title for bubble plot if proportions
  if (object == "bubble"  &&  prop  &&  is.null(main)  &&  cat.y) {
    main.lab <- paste("Percentage of", y.name, "\nwithin each level of", x.name)
    main <- "not null"
  }

  if (!is.null(x.name)) if (x.name == "Index") {
    if (n.ycol > 1) y.lab <- ""  # labels are on the legend
    if (!is.null(x.lbl)) y.lab <- paste(x.name, ": ", x.lbl, sep="")
  }

  
# all processing in terms of numeric variables ----------------------------

  # categorical variables x and/or y are converted to factors in Plot()
  # convert factors to numeric, save levels, so x and y are always numeric
  # x will always be a matrix
  x.lvl <- NULL; y.lvl <- NULL  # if remain null, then not factors
  y.frcst <- NULL
  nm.x <- names(x)
  if (cat.x) {
    x.lvl <- levels(x[,1])
    x <- as.matrix(as.integer(unclass(x[,1])))
  }
  else if (!date.var) {
    x <- as.matrix(x)
    colnames(x) <- nm.x

   }
  else {  # date.var
    if (n.by == 1)
      x.dates <- x[,1]  # save actual dates for later
    else {  # x-axis tics just for one level of by
      cnt <- sum(by == levels(by)[1])
      x.dates <- x[1:cnt,1]  # assumes by is sorted by level
    }

  if (ts_ahead > 0) x.dates <- c(x.dates, x.hat[,1])

   x <- as.matrix(x[,1], ncol=1)  # x to numeric version of dates
  }  # end if date.var

  # y to a matrix with 3 possibilities for y: cat.y, not date.var, date.var
  nm.y <- names(y)
  if (cat.y) {
    y.lvl <- levels(y[,1])  #  put into alphabetical order
    y <- as.matrix(as.integer(unclass(y[,1])))
  }
  else if (!date.var) {
    nm.y <- names(y)
    y <- as.matrix(y)
    colnames(y) <- nm.y
  }
  else {  # date.var
    y <- as.matrix(y)
  }

  # y decimal digits
  if (is.null(digits_d)) digits_d <- .max.dd(y[,1]) + 1
  options(digits_d=digits_d)

  if (n.col > 1) center_line <- "off"   # no center_line for multiple plots

  cleveland <- FALSE
  if (!cat.x && cat.y && unique.y  ||  !cat.y && cat.x && unique.x)
    cleveland <- TRUE

# get minimum and maximum values of x and y -------------------------------

  mx.x.val.ln <- 1
  mx.y.val.ln <- 1
  if (!date.var) {
    x.val <- x.lvl  # x.val is NULL if x is numeric, ignored
    y.val <- y.lvl  # y.val ignored if y is numeric
  }
  else {  # date.var
    x.val <- x[,1]
    y.val <- NULL
  }

  mn.x <- ifelse (cat.x, 1, min(x, na.rm=TRUE))
  if (ts_ahead > 0) {  # forecast margin adjustments
    mx.x <- mxf.x
    mx.y <- mxf.y
    mn.y <- mnf.y
  }
  else {
    mx.x <- ifelse (cat.x, length(x.lvl), max(x, na.rm=TRUE))
    mn.y <- ifelse (cat.y, 1, min(y, na.rm=TRUE))
    mx.y <- ifelse (cat.y, length(y.lvl), max(y, na.rm=TRUE))
  }


# set margins -------------------------------------------------------------

  # get max number of lines in x value labels
  if (cat.x) {
    stuff <- .get.val.ln(x.lvl, x.name)
    mx.x.val.ln <- stuff$mx.val.ln
  }

  # get max number of lines in y value labels
  if (cat.y  &&  y.name != "row.names"  && !cleveland) {
    stuff <- .get.val.ln(y.val, y.name)
    mx.y.val.ln <- stuff$mx.val.ln
  }

  # --------- get size of y-axis labels
  axis_y_size <- ifelse (is.null(getOption("axis_y_size")),
    getOption("axis_size"), getOption("axis_y_size"))

  if (cat.y) {  # y-axis labels are characters
    yv <- unlist(strsplit(y.val, "\n", fixed=TRUE))
    max.y.width <- max(strwidth(yv, units="inches", cex=axis_y_size))
    if (options("device") != "RStudioGD")  # not work in R, only RStudio
      max.y.width <- .09 * axis_y_size * max(nchar(yv))
  }
  else {  # y-axis labels are numeric
    prety <- pretty(c(mn.y, mx.y))
    ind <- which(nchar(prety) == max(nchar(prety)))[1]  # get largest nchar
    mx.num <-  ifelse (!prop, as.character(prety[ind]), .fmt(prety, 2))
    max.y.width <- max(strwidth(mx.num, cex=axis_y_size, units="inches"))
  }
  # --------

  margs <- .plt.marg(max.y.width, y.lab, x.lab, main.lab, sub.lab,
                rotate_x, mx.x.val.ln, mx.y.val.ln,
                lab_x_size=lab_x_size, lab_y_size=lab_y_size, 
                axis_y_pre=axis_y_pre)
  mm <- margs$lm  # left margin, lm is linear model
  tm <- margs$tm
  rm <- margs$rm 
  bm <- margs$bm
  n.lab_x.ln <- margs$n.lab_x.ln
  n.lab_y.ln <- margs$n.lab_y.ln

  # room in right margin for the vertical legend
  if (n.xcol > 1  ||  n.ycol > 1  ||  !is.null(by)) {
    rm <- rm - .025  # hack to reduce rm a bit
    if (n.xcol > 1) nm.v <- nm.x
    if (n.ycol > 1) nm.v <- nm.y
    if (!is.null(by)) nm.v <- by.name
    big.nm <- max(nchar(nm.v))  # nm.v could be a vector
    if (!is.null(legend_title)) {
      nm.lt <- nchar(legend_title)
      big.nm <- max(nm.lt, big.nm)
    }
    if (big.nm > 6) rm <- rm + (.05 * (big.nm - 6))
    if (n.ycol == 1) rm <- rm + .30  + (.65 * axis_y_size)
    if (axis_y_size > 1) if (!is.null(by)) rm <- rm + .1  # kludge
    if (length(size) > 1) rm <- rm - .76  # by and bubbles = too much rm
  }
    else rm <- rm - .06  # hack to reduce rm

  if (ts_ahead > 0)   # make room for vertical legend
    rm <- rm + getOption("axis_size")  # default is 0.75

  if (center_line != "off") rm <- rm + .4  # room for center_line label
  if (date.var) rm <- rm + 0.10  # make room: last axis date > last data value
  if ((options("device") != "RStudioGD")  &&  !is.null(by)) rm <- rm + .3

  if (date.var && n.by>1) rm <- rm - 0.05

  if (n.ycol>1 && date.var) {  # if not a time series, then no y label
#   mm <- mm + 0.25  # reduce size of plot in the left to make room for label
    ylab.adj <- ylab.adj + 0.2  # move label right when calling .axlabs()
  }

  if (!form %in% c("contour", "hexbin")) ylab.adj <- ylab.adj - 0.6

  if (n.ycol > 1) {
    rm <- rm + 0.80  # add right margin for legend
    if (max(nchar(colnames(y))) > 6) rm <- rm + 0.20
#   mm <- mm - .2  # kludge to reduce left margin
  }

  if (length(size) > 1)
    rm <- rm + 0.92  # add right margin for legend

  if (offset > 0.5) bm <- bm + (-0.05 + 0.2 * offset)  # offset kludge

  if (n.xcol>1  && !date.var  && !cleveland) {
    bm <- bm + 0.20  # allow for the bottom legend
    rm <- rm - 0.80  # kludge to remove superfluous right margin
  }

  if (form == "contour") {
    bm <- bm + .2
    mm <- mm + .2
  }

  # user manual adjustment
  bm <- bm + bm.adj
  mm <- mm + lm.adj
  tm <- tm + tm.adj
  rm <- rm + rm.adj

  orig.params <- par(no.readonly=TRUE)
  on.exit(par(orig.params))
  par(bg=getOption("window_fill"))
  par(mai=c(bm, mm, tm, rm))
  par(tcl=-0.28)  # axis tic length


# set-up region for coordinate system -------------------------------------

  # -----------------------
  # only with plot and form="n"
  # non-graphical parameters in ... Generate warnings when no plot

  # re-calibrate maximum of y-axis if stacking
  # wide format needs conversion to Long format to work properly
  if (stack  &&  n.ycol > 1) {  # data in wide format, one col for each y
    y.tot <- apply(y, 1, sum, na.rm=TRUE)
    mx.y <- max(y.tot)
  }
  if (stack  &&  (n.ycol == 1 &&  n.by > 1)) {  # data in tidy format
    for (i in 1:n.by) {
      if (i > 1) yo <- yl
      yl <- subset(y, by==levels(by)[i])
      if (i > 1) yl[,1] <- yl[,1] + yo[,1]
    }
    mx.y <- max(yl)
  }

  # get min and max of x and y
  if (!is.null(scale_x)) {
     if (length(scale_x) == 2) scale_x[3] <- par("xaxp")[3]
     mn.x <- min(mn.x, scale_x[1])
     mx.x <- max(mx.x, scale_x[2])
  }
  if (!is.null(scale_y)) {
     if (length(scale_y) == 2) scale_y[3] <- par("yaxp")[3]
     mn.y <- min(mn.y, scale_y[1])
     mx.y <- max(mx.y, scale_y[2])
  }

  # adjust margins for fit line, will be computing fit lines twice
  # more efficient to do all computations here, then plot fit line later
  # if multiple x or y variables, just first variable is checked
  if (fit.line!="off" && is.null(scale_y) && !cat.y && !date.var) {
    pf <- .plt.fit(x[,1], y[,1], fit.line, fit_power, fit_new, size,
                   span)  # fit line
    mn.yf <- min(pf$f.ln, na.rm=TRUE)  # f.ln are the fitted values
    mx.yf <- max(pf$f.ln, na.rm=TRUE)
    mn.y <- min(mn.y, mn.yf)
    mx.y <- max(mx.y, mx.yf)
  }

  if (!do.ellipse) {
    if (cat.x) {
      mn.x <- mn.x - .2
      mx.x <- mx.x + .2
    }
    if (cat.y) {
      mn.y <- mn.y - .2
      mx.y <- mx.y + .2
    }

    if (is.null(origin_x)) {  # set default for minimum x-value displayed
        origin_x <- mn.x
    }
    if (stat != "data" && (!all(y == 0))) mx.y <- mx.y + (.08 * (mx.y-mn.y))
    region <- matrix(c(origin_x, mx.x, mn.y, mx.y), nrow=2, ncol=2)
    ellipse.poly <- NULL
  }  # end no ellipse

  else {  # set plot with sufficient room for ellipse and data
    cxy <- cor(x[,1],y[,1], use="complete.obs")
    s.x <- sd(x[,1], na.rm=TRUE); s.y <- sd(y[,1], na.rm=TRUE)
    m.x <- mean(x[,1], na.rm=TRUE); m.y <- mean(y[,1], na.rm=TRUE)
    lvl <- max(ellipse)
    region <- ellipse(cxy, scale=c(s.x, s.y), centre=c(m.x, m.y), level=lvl)
    region <- rbind(region, c(mn.x, mn.y), c(mx.x, mx.y))
  }

  # revise min and max for x and y axes considering the ellipse
  mx.x <- max(region[,1])
  mn.x <- min(region[,1])
  mx.y <- max(region[,2])
  mn.y <- min(region[,2])

  # set y-axis origin for numeric variables
  if (!cat.y) {
    if (!is.null(origin_y)) {
      if (min(y, na.rm = TRUE) > 0) mn.y <- origin_y
      if (max(y, na.rm = TRUE) < 0) mx.y <- origin_y
    }
  }

  # add padding to x and y axes
  add.pad_lab <- FALSE
  if (all(pad_x == 0)) {  # pad extra for labels in 2-D plot
    if (!is.null(add))
      add.pad_lab <- ifelse ("labels" %in% add, TRUE, FALSE)
    if (add.pad_lab || (length(out_ind) > 0)) {
      if (all(pad_x == 0)) pad_x <- c(0.05, 0.05)
      if (all(pad_y == 0)) pad_y <- c(0.03, 0.03)
    }
  }

  # get plot region for coordinate system
  xp <- pretty(c(mn.x, mx.x))
  xP <- pad_x[2] * (xp[length(xp)] - xp[1])
  yp <- pretty(c(mn.y, mx.y))
  xN <- pad_x[1] * (xp[length(xp)] - xp[1])
  yP <- pad_y[2] * (yp[length(yp)] - yp[1])
  yN <- pad_y[1] * (yp[length(yp)] - yp[1])
  region <- rbind(region, c(mn.x-xN, mn.y-yN), c(mx.x+xP, mx.y+yP))


# set-up the coordinate system --------------------------------------------

  # filled.contour and hexbin do their own plot window
  if (!form %in% c("contour", "hexbin"))  
    base::plot(region, type="n", axes=FALSE, ann=FALSE, ...)
  rm(region)
  usr <- par("usr")

  
# axes ticks and labels axT1 and axT2 -------------------------------------

  # set axT1: x-axis tics and values, Date var uses x.zoo.dates, defined later
  if (cat.x)
    axT1 <- seq_along(x.lvl)   # mark category values
  else {  # numerical
    if (!date.var) {
      if (stat == "count") {
        if (mx.x <= 3)  # just want integers for count axis
          n.best <- 3
        else if (mx.x > 3  &&  mx.x < 100)
          n.best <- 4
        else
          n.best <- 5
        axT1 <- pretty(origin_x:mx.x, n=n.best)
      }
      else {  # stat != "count"
        if (is.null(scale_x))
          axT1 <- pretty(c(origin_x, x), eps.correct=0)  # numeric, so all tics
        else {
          if (!run)
            axT1 <- axTicks(1, axp=scale_x)
          else
            axT1 <- seq(scale_x[1], scale_x[2], by=scale_x[3])
        }
      }  # stat not "count"
    }  # end !date.var
  }  # end numerical

  # set axT2: y-axis tics and values
    if (segments_diff)
      axT2 <- 1:nrow(x)
  else if (cat.y)
    axT2 <- seq_along(y.lvl)
  else {
    if (is.null(scale_y))
      axT2 <- pretty(c(mn.y, mx.y))  # more extreme values than axTicks
    else
      axT2 <- axTicks(2, axp=scale_y)
  }

  if (bubble1) {  # 1-D scatter plot of categorical variable, MOVE to Chart()
    axT2 <- NULL
    y.val <- NULL
    y.lab <- ""
  }

  # axes value labels
  ax.info <- NULL  # defined inside xy_tics; guard for plotly paths

  if (xy_tics) {

    # adjust axis label from tick with mgp[2]
    # mgp does not work with rotate_x, see .axes()
    ax <- .axes_dim()  # get axis value parameters
    mgp2 <- -0.350 + (0.9 * ax$axis_x_size)

    my.mgp <- par("mgp")  # save to restore
    if (!form %in% c("contour", "hexbin")) {
      par(mgp = c(my.mgp[1], mgp2, my.mgp[3]))  # labels closer to axis
      adj <- .RSadj(axis_size=ax$axis_x_size); axis_x_size <- adj$axis_size

      if (!date.var) {  # call axis() for both axes
        if (segments_diff) {  # Cleveland dot plot
          if (n.xcol > 1) y.lvl <- rev(rownames(x))
          if (n.ycol > 1) x.lvl <- rev(rownames(x))
        }
        ax.info <- .axes(x.lvl, y.lvl, axT1, axT2,
              rotate_x=rotate_x, rotate_y=rotate_y, offset=offset, 
              axis_fmt=axis_fmt, axis_x_pre=axis_x_pre, axis_y_pre=axis_y_pre,
              ...)
      }  # end !date.var
    }  # end not contour or hexbin

    if (date.var) {  # date.var, y-axis
      ax.info <- .axes(NULL, y.val, NULL, axT2,
                       rotate_x=rotate_x, rotate_y=rotate_y, offset=offset,
                       y.only=TRUE,  # y-axis
                       axis_fmt=axis_fmt, axis_x_pre="no",
                       axis_y_pre=axis_y_pre, ...)

      # date.var, x-axis
      len.xtics <- length(x.dates)
      indices <- seq_along(x.dates)  # retain if num of data pts < n.tics
      step_range <- integer(50)

      if (ts_unit == "years") {
        x.zoo.dates <- format(x.dates, "%Y")
        n.tics <- ifelse (is.null(n_date_tics), 10, n_date_tics)
      }
      else if (ts_unit == "quarters") {
        x.zoo.dates <- as.character(zoo::as.yearqtr(x.dates))
        n.tics <- ifelse (is.null(n_date_tics), 9, n_date_tics)
        if (len.xtics >= 4*n.tics) {
          for (i in 1:50) step_range[i] <- 4*i
          tics_range <- ceiling(len.xtics / step_range)
          step <- step_range[which.min(abs(tics_range-n.tics))]
          indices <- seq(1, len.xtics, by=step)
        }
      }
      else if (ts_unit == "months") {
        x.zoo.dates <- as.character(zoo::as.yearmon(x.dates))
        n.tics <- ifelse (is.null(n_date_tics), 8, n_date_tics)
        if (len.xtics >= 12*n.tics) {
          for (i in 1:50) step_range[i] <- 12*i
          tics_range <- ceiling(len.xtics / step_range)
          step <- step_range[which.min(abs(tics_range-n.tics))]
          indices <- seq(1, length(x.dates), by=step)
        }
      }
      else {  # e.g., days
         x.zoo.dates <- as.character(x.dates)
         n.tics <- ifelse (is.null(n_date_tics), 7, n_date_tics)
      }

      # subset the indices to display for "years" and "days"
      if (ts_unit %in% c("years", "days")) {
        if (len.xtics >= n.tics) {
          step <- ceiling(len.xtics / n.tics)
          indices <- seq(1, len.xtics, by=step)
        }
      }

      # x.zoo.dates is the xts customized for char ts_unit date, Aug 2023
      # x.dates are the dates in Date format, e.g., 2023-08-01
      if (rotate_x == 0) {
        axis(1, x.zoo.dates, at=x.dates[indices], labels=x.zoo.dates[indices],
                  col=ax$axis_x_color, cex.axis=axis_x_size,
                  col.axis=ax$axis_x_text_color, ...)  # x-axis
      } else {  # rotate_x: draw ticks only, then add rotated text labels
        axis(1, at=x.dates[indices], labels=FALSE,
                  col=ax$axis_x_color, cex.axis=axis_x_size,
                  col.axis=ax$axis_x_text_color)
        usr <- par("usr")
        text(x=x.dates[indices], y=usr[3] - par("cxy")[2]/4.5,
             labels=x.zoo.dates[indices],
             pos=1, xpd=TRUE, cex=axis_x_size, col=ax$axis_x_text_color,
             srt=rotate_x, offset=offset)
      }
    }  # end date.var

    if (!form %in% c("contour", "hexbin")) par(mgp = my.mgp)  # restore back 
  }  # end xy_tics

  if (date.var) {  # create y.lab
    if (ts_unit != "unknown") {
      tu <- gsub("s$", "", ts_unit)
      if (tu == "days7") tu <- "days"
      substr(tu, 1, 1) <- toupper(substr(tu, 1, 1))
      if (do.agg) {
        if (ts_agg == "sum") show.agg <- "Total"
        if (ts_agg == "mean") show.agg <- "Mean"
      }
      else
        show.agg <- ""
      y.lab <- paste(show.agg, y.name, "by", tu)
    }
  }  # end date.var

  # axes labels
  if (!form %in% c("contour", "hexbin")) {
    .axlabs(x.lab, y.lab, main.lab, sub.lab,
           x.val, xy_tics, offset=offset,
           lab_x_size=lab_x_size, lab_y_size=lab_y_size, main_size,
           n.lab_x.ln, n.lab_y.ln, xlab.adj, ylab.adj, ...)
  }

# set-up plot background --------------------------------------------------

  if (date.var)
    .plt.bck(usr, x.dates[indices], axT2, do.h=!bubble1)
  else {
    if (!form %in% c("contour", "hexbin"))
      .plt.bck(usr, axT1, axT2, do.h=!bubble1)
  }


# set jitter for scatterplot with discrete levels -------------------------

#     do.jit <- FALSE
#     if (nrows < 100) {
#       if (max(table(x,y) > 1)) do.jit <- TRUE  # duplication
#     }

  if (object == "point") {
    # multiple sizes if n_bin>0
    if (size[1]>0 && n.xcol==1 && stat=="data") {
      if (is.null(jitter_x))  {  # ifelse() does not work
        if (length(unique(x[,1])) <= 14  &&  nrows > 14)
          jitter_x <- (diff(range(x[,1], na.rm=TRUE))) / 32
      }
      if (is.null(jitter_y))  {  # ifelse() does not work
        if (length(unique(y[,1])) <= 14  &&  nrows > 14)
          jitter_y <- (diff(range(y[,1], na.rm=TRUE))) / 32
      }
    }

    # for VBS need to set jitter, here only set if jitter is NULL
    if (is.null(jitter_x)) jitter_x <- 0
    if (is.null(jitter_y)) jitter_y <- 0

    # --- process jitter ---
    if (jitter_x > 0) {
      x.temp <- x[,1]
      x[,1] <- x[,1] + runif(length(x[,1]), -jitter_x, jitter_x)
    }
    if (jitter_y > 0) {
      y.temp <- y[,1]
      y[,1] <- y[,1] + runif(length(y[,1]), -jitter_y, jitter_y)
    }
  }


# plot points, lines (and area_fill) --------------------------------------

  # colors
  n.clrs <- max(n.col, n.by)

  ltype <- character(length=n.clrs)
  for (i in seq_along(ltype)) ltype[i] <- "solid"

  if (object == "point") {  # is point even if size=0, plotting just lines

    if (n.xcol == 1  &&  n.ycol == 1) {
      if (n.by <= 1) {  # pure single panel, data in wide format

        if (segments && ln.width>0)  # plot data line segments
            lines(x[,1], y[,1], col=color[1], lwd=ln.width, ...)
        if (area_fill[1] != "transparent") # fill area
          polygon(c(x[1], x, x[length(x)]), c(mn.y,y[,1],mn.y),
                  col=area_fill, border="transparent")


        if (ts_ahead > 0) {  # forecast
          h <- .get.h()
          if (getOption("theme") == "colors") h <- 0  # default is red
          if (!(getOption("theme") %in% c("gray", "white"))) {
                 if (h==0) {clr.f <- rgb(.6,0,0); clr.ft <- rgb(.6,0,0,.15)}
            else if (h==30) {clr.f <- rgb(.6,.3,0); clr.ft <- rgb(.6,.3,0,.15)} 
            else if (h==60) {clr.f <- rgb(.6,.6,0); clr.ft <- rgb(.6,.6,0,.15)} 
            else if (h==120) {clr.f <- rgb(0,.6,0); clr.ft <- rgb(0,.6,0,.15)} 
            else if (h==240) {clr.f <- rgb(0,.4,.6); clr.ft <- rgb(0,.4,.6,.15)} 
            else if (h==300) {clr.f <- rgb(.6,0,.4); clr.ft <- rgb(.6,0,.4,.15)} 
            trns.col <- .maketrans(clr.f, 0.25*256)
            poly.fill <- clr.ft
            pt.f.fill <- clr.f
            ln.f.col <- clr.f
          }
          else {  # gray or white background
            trns.col <- .maketrans("gray10", 0.35*256)
            poly.fill <- rgb(.5,.5,.5,.45)
            pt.f.fill <- "gray20"
            ln.f.col <- "black"
          }
          
          lines(x.fit[,1], y.fit[,1], col=trns.col, lwd=ln.width)
          lines(c(x.fit[nrow(x.fit),1], x.hat[1,1]),  # connect fit with hat
                c(y.fit[nrow(y.fit),1], y.hat[1,1]),
                col=trns.col, lwd=ln.width)
          f.size.pt <- ifelse (size.pt<0.5, .65, size.pt)
          points(x.hat[,1], y.hat[,1], pch=shape, bg=pt.f.fill, cex=f.size.pt)
          lines(x.hat[,1], y.hat[,1], col=ln.f.col, lwd=ln.width)
          lines(x.hat[,1], y.upr[,1], col=trns.col, lwd=ln.width)
          lines(x.hat[,1], y.lwr[,1], col=trns.col, lwd=ln.width)
          xx <- c(x.hat[,1], rev(x.hat[,1]))
          yy <- c(y.upr[,1], rev(y.lwr[,1]))
          polygon(xx, yy, border=NA, col=poly.fill)

          lgn.clr <- c(color[1], trns.col, ln.f.col)
          lgn.nm <- ifelse (nchar(y.name) < 6, y.name, "data")
          .plt.by.legend(c(lgn.nm, "model\nfit", "fore-\ncast"),
                         lgn.clr, lgn.clr, shp="lines", pt.trans, fill_bg,
                         usr, pt.size=size.pt, legend_title=legend_title)
        }  # end forecast
      }  # n.by is 1

      else {  # n.by > 1,  tidy format, all y data in same column
        for (i in 1:n.by) {  # only stack=TRUE makes sense
          xl <- x[by==levels(by)[i], , drop=FALSE]
          if (i > 1) yo <- yl
          yl <- y[by==levels(by)[i], , drop=FALSE]

          if (stack) {
            if (i == 1) {
              xx <- c(xl[1],xl,xl[length(xl)])
              yy <- c(min(yl[,1]),yl[,1],min(yl[,1]))
              if (fill[1] != "transparent")
                polygon(xx, yy, col=area_fill[1], border="transparent")
            }
            if (i > 1) {
              yl[,1] <- yl[,1] + yo[,1]
              xx <- c(c(xl[1],xl,xl[length(xl)]),
                    rev(c(xl[1],xl,xl[length(xl)])))
              yy <- c(c(min(yl[,1]),yl[,1],min(yl[,1])),
                         rev(c(min(yo[,1]),yo[,1],min(yo[,1]))))
              if (fill[1] != "transparent")
               polygon(xx, yy, col=area_fill[i], border="transparent")
            }
          }  # end stack

          if (segments && ln.width>0) {
            if (stack) ln.width <- 1  # no user option
            lines(xl, yl[,1], col=color[i], lty=ltype[i], lwd=ln.width, ...)
          }  # end ln.width > 0
        }
      }  # end n.by > 1
    }  # end n.xcol and n.ycol = 1

    if (n.ycol > 1) {
      for (i in 1:n.ycol) {
        if (stack) {  # polygons
          if (i == 1) { 
            xx <- c(x[1],x,x[length(x)])
            yy <- c(mn.y,y[,1],mn.y)  # starts at the scale_y setting
            if (fill[1] != "transparent")
              polygon(xx, yy, col=area_fill[1], border="transparent")
          }
          if (i > 1) {
            y[,i] <- apply(y[,(i-1):i], 1, sum, na.rm=TRUE)  # sum to stack
            xx <- c(c(x[1],x,x[length(x)]), rev(c(x[1],x,x[length(x)])))
            yy <- c(c(min(y[,i]),y[,i],min(y[,i])),
                       rev(c(min(y[,i-1]),y[,i-1],min(y[,i-1]))))
            if (fill[1] != "transparent")
              polygon(xx, yy, col=area_fill[i], border="transparent")
          }
        }  # end stack polygons

        if (segments && ln.width>0) {  # lines
          lines(x[,1], y[,i], col=color[i], lty=ltype[i], lwd=ln.width, ...)
        }  # end ln.width > 0

      }  # end i loop
    }  # end n.ycol > 1

    if (n.xcol > 1) {
      if (segments && ln.width>0) for (i in 1:n.xcol)
        lines(as.numeric(x.val),y[,1], col=fill[i], lwd=ln.width, ...)
    }


    if (is.null(by)) {


# smooth, contour, hexbin plot ------------------------------------------

      if (form == "smooth") {  # 2-D kernel density plot
        # grid lines only plot after the sp
        hue <- .get.h(getOption("theme"))  # get hue number from theme
        satur <- ifelse (getOption("theme") %in% c("gray", "white"), 0, 80)
        clr.den <- colorRampPalette(c(getOption("window_fill"),
                     hcl(hue, satur, 16)))
        if (!requireNamespace("KernSmooth", quietly=TRUE)) {
          stop("Package \"KernSmooth\" needed for this visualization\n",
               "Please install it:  install.packages(\"KernSmooth\")\n\n",
               call. = FALSE)
        }
        smoothScatter(x, y, nrpoints=smooth_points, nbin=smooth_bins,
                      transformation=function(x) x^(smooth_power),
                      colramp=clr.den, cex=smooth_size, add=TRUE)
      }
 
      else if (form == "hexbin") {
        if (!requireNamespace("hexbin", quietly=TRUE)) {
          stop("Package \"hexbin\" needed for this visualization\n",
               "Please install it:  install.packages(\"hexbin\")\n\n",
               call. = FALSE)
        }
        hc <- .getHC(getOption("pt_fill"))
          pt_hue   <- hc[1]
          pt_chroma <- hc[2]
          clr.hex <- colorRampPalette(c(
            hcl(pt_hue, pt_chroma * 0.3, 90),  # sparse — very light
            hcl(pt_hue, pt_chroma * 0.7, 50),  # mid
            hcl(pt_hue, pt_chroma,       15)   # dense — full color, dark
        ))
        hb <- hexbin::hexbin(x, y, xbins=hex_bins)
        # legend=0 suppresses hexbin's count-scale strip; 1.2 is its default
        # suppress default axes, then draw axis_fmt-formatted tick labels
        #   (e.g., 60K) in the returned hexViewport; ylab also drawn there
        #   because hexbin fixes it at -2 lines, under the tick labels
        ret <- hexbin::plot(hb, colramp=clr.hex, xlab=x.lab, ylab="",
                     main="", legend=if (hexbin_legend) 1.2 else 0,
                     xaxt="n", yaxt="n")
        hexbin::pushHexport(ret$plot.vp)
        xsc <- grid::current.viewport()$xscale
        ysc <- grid::current.viewport()$yscale
        axT1 <- pretty(xsc); axT1 <- axT1[axT1>=xsc[1] & axT1<=xsc[2]]
        ayT2 <- pretty(ysc); ayT2 <- ayT2[ayT2>=ysc[1] & ayT2<=ysc[2]]
        lbl.x <- .axis.format(axT1, axis_fmt, axis_x_pre, axis_y_pre="no")
        lbl.y <- .axis.format(ayT2, axis_fmt, axis_x_pre="no", axis_y_pre)
        # raw axis_size, as in the faceted hexbin: the .RSadj-inflated
        #   size overflows hexbin's fixed margins in plain R
        grid::grid.xaxis(at=axT1, label=lbl.x,
          gp=grid::gpar(cex=getOption("axis_size"),
                        col=ax$axis_x_text_color))
        grid::grid.yaxis(at=ayT2, label=lbl.y,
          gp=grid::gpar(cex=getOption("axis_size"),
                        col=ax$axis_y_text_color))
        grid::upViewport()
        # ylab anchored just inside the device edge, clear of tick labels
        grid::grid.text(y.lab, x=grid::unit(0.8, "lines"), rot=90,
          gp=grid::gpar(fontsize=16))  # matches hexbin xlab fontsize
      }

      else if (form == "contour") {
        ylab.adj <- ylab.adj - 0.75  # move y-axis title closer to axis
        .plt.contour(x, y,
           contour_n, contour_nbins, contour_points, size.pt[1],
           theme, scale_x, scale_y, pad_x, pad_y, x.lab, y.lab,
           ellipse, ellipse_color, ellipse_lwd,
           fit.line, fit_color, fit_lwd,
           axis_x_pre, axis_y_pre, axis_fmt, xlab.adj, ylab.adj,
           legend = contour_legend)
      }


# plot points, segments, means with no by --------------------------------- 

      else if (size.pt[1] > 0  &&  !segments_diff) {
        # plot points
        if (n.xcol == 1  &&  n.ycol == 1) {  # one x and one y variable
          if (length(out_ind) == 0)  # no outliers
            points(x[,1], y[,1], pch=shape, col=color[1], bg=fill[1],
                     cex=size.pt, ...)
          else {  # display outliers separately
            points(x[-out_ind,1], y[-out_ind,1],
               pch=shape, col=color[1], bg=fill[1], cex=size.pt, ...)
            points(x[out_ind,1], y[out_ind,1],
               pch=out_shape, col=out_color, bg=out_fill, cex=size.pt, ...)
            text(x[out_ind], y[out_ind], labels=ID[out_ind],
               pos=1, offset=0.4, col=ID_color, cex=ID_size)
          }
        }

        else if (n.ycol == 1) {  # one y
          for (i in 1:n.xcol) {  # one to many x's, Cleveland dots here
            points(x[,i], y[,1], pch=shape, col=color[i], bg=fill[i],
                   cex=size.pt, ...)
          }
        }

        else  if (n.xcol == 1) {  # one x
          for (i in 1:n.ycol) {  # one to many y's
              points(x[,1],y[,i], pch=shape, col=color[i], bg=fill[i],
                     cex=size.pt, ...)  # one x
          }
        }

        if (segments_y) {
          if (n.xcol == 1) # line segments from points to axis
            segments(x0=0, y0=y, x1=x, y1=y,
                     lty=1, lwd=.75, col=col.segment)
          else if (n.xcol == 2)  # Cleveland paired points
            segments(x0=x[,1], y0=y[,1], x1=x[,2], y1=y[,1],
                     lty=1, lwd=.75, col=col.segment)
        }

        if (!(stat %in% c("count", "prop", "%"))) {
          if (segments_x) {
            if (n.ycol == 1) # line segments from points to axis
              segments(y0=par("usr")[3], x0=x, y1=y, x1=x, lty=1, lwd=.75,
                       col=col.segment)
            else if (n.ycol == 2)  # line segments between points
              segments(y0=y[,1], x0=x[,1], y1=y[,2], x1=x[,1],
                       lty=1, lwd=.75, col=col.segment)
          }
        }
        else {  # stat is "count", etc.
          if (segments_x)
            if (n.xcol == 1)
              segments(y0=0, x0=x, y1=y, x1=x, lty=1, lwd=1, col=col.segment)
        }
        

# plot means --------------------------------------------------------------

        if (means  &&  stat == "data") {

        # get colors
          pch.avg <- ifelse (theme!="gray", 21, 23)
          bck.g <- ifelse (theme!="gray", rgb(130,90,70,
                          maxColorValue=255), "gray40")
          if (grepl(".black", theme, fixed=TRUE))
            bck.g <- "gray85"

          # restore un-jittered data
          if (jitter_x > 0) {
            x[,1] <- x.temp
            rm(x.temp)
          }
          if (jitter_y > 0) {
            y[,1] <- y.temp
            rm(y.temp)
          }

          m.lvl <- numeric(length = 0)

          # plot means for num y across levels of factor x
          if (cat.x && !cat.y && !unique.x) {
            for (i in seq_along(x.lvl))
              m.lvl[i] <- mean(y[x==i], na.rm=TRUE)
            abline(h=m.lvl, col="gray50", lwd=.5)
            points(m.lvl, pch=pch.avg, bg=bck.g, col=bck.g, cex=size.pt*1.5)
          }

          # plot means for num x across levels of factor y
          if (!cat.x && cat.y && !unique.y) {
            for (i in seq_along(y.lvl))
              m.lvl[i] <- mean(x[y==i], na.rm=TRUE)
            abline(v=m.lvl, col="gray50", lwd=.5)
            points(m.lvl, seq_len(length(y.lvl)), pch=pch.avg, bg=bck.g,
                   col=bck.g, cex=size.pt*1.5)
          }
        }  # end means

      }  # end size.pt[1] > 0  &&  !segments_diff

      else if (size.pt[1] > 0  &&  segments_diff) {  # paired dot plot

        paired_dot_plot <- function(x) {
          y.labels <- nrow(x):1
          segments(x0=x[, 1], y0=y.labels,
                   x1=x[, 2], y1=y.labels,
                   lty=1, lwd=0.75, col="black")

          points(x[, 1], y.labels, pch=shape,
                 col=color[1], bg=fill[1], cex=size.pt)
          points(x[, 2], y.labels, pch=shape,
                 col=color[2], bg=fill[2], cex=size.pt)
        }  # end paired_dot_plot()

        if (n.xcol > 1) paired_dot_plot(x)
        if (n.ycol > 1) paired_dot_plot(y)
      }  


# plot center line --------------------------------------------------------

      if (center_line != "off") {
        if (center_line == "mean") {
          m.y <- mean(y[,1], na.rm=TRUE)
          lbl <- " mean"
        }
        else if (center_line == "median") {
          m.y <- median(y[,1], na.rm=TRUE)
          lbl <- " median"
        }
        else if (center_line == "zero") {
          m.y <- 0
          lbl <- ""
        }

        abline(h=m.y, col="gray50", lty="dashed")  # draw center line
        mtext(lbl, side=4, cex=.7, col="gray50", las=2, at=m.y, line=0.1)

      }  # end center_line

      else
        m.y <- median(y[,1], na.rm=TRUE)

      # run chart (and attempted interaction chart)
      if (segments && n.xcol==1 && n.ycol==1 && !date.var) {
        for (j in 1:(nrow(x)-1)) {
          segments(x0=x[j,1], y0=y[j,1],
                   x1=x[j+1,1], y1=y[j+1,1],
                   lty="solid", lwd=ln.width, col=color[1])
        }
      }  # end segments
      x.lv <- x[,1]
      y.lv <- y[,1]
    }  # end is.null by


# by grouping variable ----------------------------------------------------

    else {
      clr <- character(n.by)

      if (length(color) == 1)
        for (i in 1:n.by) clr[i] <- color  # all levels get same color
      else
        clr <- color

      shp <- integer(n.by)
      if (length(shape) == 1)
        for (i in 1:n.by) shp[i] <- shape
      else
        shp <- shape
      # plot points and segments for each group
      for (i in 1:n.by) {
        x.lv <- subset(x, by==levels(by)[i])
        y.lv <- subset(y, by==levels(by)[i])
        if (size.pt > 0)
          points(x.lv, y.lv[,1], pch=shp[i], col=clr[i], bg=fill[i],
                 cex=size.pt, lwd=0.75, ...)

        # interaction means plot, ts without a date var and segments=TRUE
        if (segments && !stack && !date.var) {
          if (!is.null(ylab))  # thin line for ANOVA interaction plot
            if (grepl("Cell Means of", ylab, fixed=TRUE)) ln.width <- 0.75
          for (j in 1:(nrow(x.lv)-1)) {
            segments(x0=x.lv[j,1], y0=y.lv[j,1],
                     x1=x.lv[j+1,1], y1=y.lv[j+1,1],
                     lty="solid", lwd=ln.width, col=fill[i])  # not color[i]
          }
        }  # end segments
      }  # end 1:n.by

      # by legend
      if (size[1] == 0) shape <- "lines"
      if (fill[1] == "transparent") fill <- color
      if (stack) {  # default pt.size is 0
        point.size <- ifelse (size > 0, 2.5 * axis_x_size, 0)
        .plt.by.legend(levels(by), color, area_fill, shp=shape[1], pt.trans,
                       fill_bg, usr, pt.size=point.size,  # 22 is a rectangle
                       legend_title=legend_title)
      }
      else {  # not stack
        if (n.by > 1  &&  length(size) == 1)
          .plt.by.legend(levels(by), color, fill, shape, pt.trans,
                         fill_bg, usr, legend_title=legend_title)
      }
    }  # end by
    

# legend (more than 1 x or y) ---------------------------------------------

    if (fill[1] == "transparent") fill <- color

    if (n.xcol > 1) {
      if (!cleveland) {  # horizontal legend, on x-axis
        .plt.legend(colnms=colnames(x), horiz=TRUE,
                    color, fill, shape, fill_bg, usr,
                    lab_size=lab_x_size, pt.size=1.25, legend_title)
      }
      else {  # vertical legend
        point.size <- 1.25 * size.pt
        .plt.by.legend(colnames(x), color, fill, shp=shape[1], pt.trans,
                       fill_bg, usr, pt.size=point.size,  # 22 is a rectangle
                       legend_title=legend_title)
      }
    }

    if (n.ycol > 1) {  # vertical legend, on y-axis
      if (stack)  # ifelse form only returns the first value of the vector
        the.fill <- area_fill
      else
        the.fill <- fill
      .plt.legend(colnms=colnames(y), horiz=FALSE,
                  color, the.fill, shape, fill_bg, usr,
                  lab_size=lab_y_size, pt.size=1.25, legend_title)
    }

  }  # object is point


# bubble or sunflower plot  -----------------------------------------------

  else if ((object %in% c("bubble", "sunflower"))) {
    # colors
    if (is.null(col.low) || is.null(col.hi) || !bubble1) {
      if (fill[1] != "#46505A")  # default
        clr <- fill
      else
        clr <- getOption("bar_fill_cont")
      clr.color <- color
    }
    else {  # 1-var bubble plot and BPFM can have a color gradient
      color_palette <- colorRampPalette(c(col.low, col.hi))
      clr <- color_palette(length(unique(x)))
      clr.color <- "gray70"
    }

    # size is not a variable, do counts
    if (length(size) == 1) {  # MOVE to Chart()
      mytbl <- table(x, y)  # get the counts, all x-y combinations
      n.count <- nrow(mytbl) * ncol(mytbl)
      if (prop) {
        count <- numeric(length=n.count)
        if (cat.y)
          mytbl <- prop.table(mytbl, 1)
        else
          mytbl <- mytbl / sum(mytbl)
      }
      else
        count <- integer(length=n.count)

      # melt the table of counts to a data frame with xx, yy, count
      xx <- integer(length=n.count)
      yy <- integer(length=n.count)
      k <- 0
      for (i in seq_len(nrow(mytbl))) {
        for (j in seq_len(ncol(mytbl))) {
          k <- k + 1
          count[k] <- mytbl[i,j]
          if (count[k] == 0) count[k] <- NA  # 0 count not plotted
          xx[k] <- as.numeric(rownames(mytbl)[i])  # row names are factors
          yy[k] <- as.numeric(colnames(mytbl)[j])
        }
      }
      if (prop) count <- round(count, 2)

      # for categorical vars, size not a var
      if (object == "bubble") {
        .plt.bubble(xx, yy, count, radius, power, clr, clr.color,
                    size_cut, prop, bbl.txt.col, object, pt.trans)
      }
      else if (object == "sunflower") {
        cords <- data.frame(xx, yy, count, stringsAsFactors=TRUE)
        cords <- na.omit(cords)
        sunflowerplot(cords$xx, cords$yy, number=cords$count,
            seg.col=clr.color, col=clr,
            col.axis=getOption("axis_x_color"), add=TRUE)
      }

    }  # end length(size) == 1, counts

    # size is a variable (unless size is constant and bubble specified)
    else {
      for (i in 1:n.by) {
        if (is.null(by))
          d.sub <- data.frame(x=x[,1], y=y[,1], ind=rep(NA, nrow(x)), size=size)
        else
          d.sub <- data.frame(x=x[,1], y=y[,1], ind=by, size=size)
        if (!all(is.na(by))) d.sub <- d.sub[by==levels(by)[i], ]
        fill[i] <- .maketrans(fill[i], (1-pt.trans)*256)
        .plt.bubble(d.sub$x, d.sub$y, d.sub$size, radius, power, fill[i],
                    color[i], size_cut, prop, bbl.txt.col, object, pt.trans)
      }
      fill.bub.lgd <- ifelse (all(is.na(by)), fill, "gray70")  # by -> neutral
      .plt.sym.legend(size, fill=fill.bub.lgd, color="gray50", shape, usr,
                      radius, power, pt.trans)
      rm(d.sub)
    }
  }  # end bubble/sunflower


# ellipse option ----------------------------------------------------------

  if (do.ellipse) {
    ell_list <- setNames(vector("list", n.by), levels(by))  # for plt.plotly()

    for (i in 1:n.by) {
      if (n.by == 1) {  # one plot, all the data
          x.lv <- x[,1]
          y.lv <- y[,1]
      }
      else {  # multiple, pull out subset
        if (!is.null(by)) {  # multiple by plots
          ind <- which(by == levels(by)[i])
          x.lv <- x[ind]
          y.lv <- y[ind]
        }
        if (n.col > 1) {  # multiple variable plots
          if (n.xcol > 1) {
            x.lv <- x[,i]
            y.lv <- y[,1]
          }
          else {
            x.lv <- x[,1]
            y.lv <- y[,i]
          }
        }
        clr <- ifelse (length(color) == 1, color, color[i])
      }  # end multiple

      # ellipse stats
      cxy <- cor(x.lv, y.lv, use="pairwise.complete.obs")
      m.x <- mean(x.lv, na.rm=TRUE)
      m.y <- mean(y.lv, na.rm=TRUE)
      s.x <- sd(x.lv, na.rm=TRUE)
      s.y <- sd(y.lv, na.rm=TRUE)

      # build polygons for this slice (group or overall)
      ell_per_nm <- vector("list", length(ellipse))

      for (j in seq_along(ellipse)) {
        el <- ellipse::ellipse(cxy, scale = c(s.x, s.y),
                               centre = c(m.x, m.y), level = ellipse[j])
        # base R drawing (if you still want it)
        ln.type    <- "solid"
        col.border <- ifelse(n.by == 1, ellipse_color, clr)
        polygon(el, border=col.border, col=ellipse_fill,
                    lwd=ellipse_lwd, lty=ln.type)

        # close polygon for plotly and stash
        el <- rbind(el, el[1, , drop = FALSE])
        ell_per_nm[[j]] <- el
      }

      # single group (or no by): pass polygons directly
      # groups with the named list assignment
      if (is.null(by) || n.by <= 1L) {
        ellipse_region <- if (length(ellipse) == 1L) ell_per_nm[[1]]
                          else ell_per_nm
      }
      else {
        nm <- as.character(levels(by)[i])
        ell_list[[nm]] <- ell_per_nm
        ellipse_region <- ell_list
      }
    }  # ith group
  }  # do.ellipse

  else {
    ell_list <- NULL
    ellipse_region  <- NULL
    ellipse_lwd <- NULL
  }


# fit line option ---------------------------------------------------------

  f.ln <- double(0)
  if (fit.line != "off") {

    # if outliers noted then also do line w/o outliers
    fit.remove <- length(out_ind) > 0
    do.remove <- FALSE
    n.loops <- ifelse (n.by > 1, 1, as.numeric(fit.remove)+1)
    for (i.remv in 1:n.loops) {
      if (fit.remove) {
        fit_se[1] <- 0  # for line w/o outliers, no se band
        fit_lwd <- 1.5
        if (i.remv == 2) do.remove <- TRUE  # 2nd pass
      }

      mse.ln <- double(length=n.by)  # .ln is linear
      mse.nl <- double(length=n.by)  # .nl is nonlinear
      b0 <- double(length=n.by)
      b1 <- double(length=n.by)
      Rsq <- double(length=n.by)
      by.cat <- character(length=n.by)
      ind <- integer(0)

      for (i.by in 1:n.by) {  # double looping with i.remv and i

        if (n.by == 1) {  # one plot, all the data
          if (!date.var) {
            x.lv <- x[,1]

            y.lv <- y[,1]
          }
          else {  # date.var
            x.lv <- as.numeric(x.val)
            y.lv <- as.numeric(y[,i.by])
          }
          clr <- fit_color

          if (length(size) > 1)
            sz.lv <- size
          else
            sz.lv <- rep(size, length(x.lv))

        }  # end n.by = 1

        else {  # multiple by levels, pull out subset

          if (!is.null(by)) {  # multiple by plots
            x.lv <- subset(x, by==levels(by)[i.by])
            y.lv <- subset(y, by==levels(by)[i.by])
            ind <- c(ind, rep(levels(by)[i.by], length(x.lv)))
          }

          if (length(size) > 1)
            sz.lv <- size[which(by==levels(by)[i.by])]
          else
            sz.lv <- rep(size, length(x.lv))

          if (n.col > 1) {  # multiple variable plots
            if (n.xcol > 1) {
              x.lv <- x[,i.by]
              y.lv <- y[,1]
            }
            else {
              x.lv <- x[,1]
              y.lv <- y[,i.by]
            }
          }

          clr <- ifelse (length(color) == 1, color, color[i.by])
        }  # end multiple groups

        ln.type <- "solid"

        if (!is.null(out_ind)) if (do.remove) {
          x.lv <- x.lv[-out_ind]
          y.lv <- y.lv[-out_ind]
          ln.type <- ifelse (ln.type != "dashed", "dashed", "solid")
        }

        col.ln <- ifelse (n.clrs==1, fit_color, fill[i.by])

        pf <- .plt.fit(x.lv, y.lv, fit.line, fit_power, fit_new, sz.lv,
                       span)  # fit

        x.lv <- pf$x.lv  # x and y get reduced in .plt.fit if NA
        y.lv <- pf$y.lv
        fi.ln <- pf$f.ln  # fitted
        l.ln <- pf$l.ln  # linearized
        y.new <- pf$y.new  # computed from fitted function
        sz.lv <- pf$sz.lv 

        f.ln <- c(f.ln, fi.ln)

        if (i.remv == 1) {  # if outlier removal, only outlier line reported
          mse.ln[i.by] <- pf$mse.ln
          mse.nl[i.by] <- pf$mse.nl
          b0[i.by] <- pf$b0
          b1[i.by] <- pf$b1
          Rsq[i.by] <- pf$Rsq
        }

        if (n.by > 1)
          by.cat[i.by] <- levels(by)[i.by]

        # se bands about each eligible fit line
        if (!fit.line %in% c("exp", "quad", "log", "null")) {
          se.poly <- vector("list", length(fit_se))  # for plt.plotly()
          p.ln <- predict(l.ln, se=TRUE)
          nrows <- length(y.lv)
          sefit <- p.ln$se.fit
          for (j in seq_along(fit_se)) { # one or more prediction intervals 
            prb <- (1 + fit_se[j]) / 2   # upper tail: e.g. 0.975 for 95% CI
            up.ln <- fi.ln + (qt(prb, nrows-1) * sefit)
            dn.ln <- fi.ln - (qt(prb, nrows-1) * sefit)
            band <- cbind(c(x.lv, rev(x.lv)), c(up.ln, rev(dn.ln)))
            polygon(band, col=se_fill, border="transparent")
            se.poly[[j]] <- band  # for plt.plotly()
          }  # end for each se plot
        }
        else
          se.poly <- NULL

        # plot fit line(s) on top of se bands
        if (n.clrs == 2 && (fill[1] == fill[2]))
          ln.type <- ifelse(i.by == 2, "dashed", "solid")
        lines(x.lv, fi.ln, col=col.ln, lwd=fit_lwd, lty=ln.type)

        if (!("transparent" %in% clr)) {
          if (all(is.na(by)))
            g.temp <- data.frame(x.lv, y.lv, fi.ln,
              ind=rep(NA, length(x.lv)), sz.lv)
          else
            g.temp <- data.frame(x.lv, y.lv, fi.ln, levels(by)[i.by], sz.lv)
          names(g.temp)[3:5] <- c("f.ln", "ind", "size")
          if (i.by == 1)
            g <- g.temp
          else
            g <- rbind(g, g.temp)
        }

        # plot residuals option
        if (plot_errors) {
          red <- rgb(130,40,35, maxColorValue=255)
          pe.clr <- ifelse (theme %in% c("gray", "white"), "gray58", red)
          segments(y0=fi.ln, y1=y.lv, x0=x.lv, x1=x.lv,
                   col=pe.clr, lwd=1)
        }
      }  # ith group (clr)
    }  # fit.remove
    if (!quiet) cat ("\n")
  }  # end fit.line

  else {  # no fit.line
    se.poly <- NULL
    col.ln <- fit_color
    y.new <- NULL
    f.ln <- rep(NA, nrow(x))  # for plt.plotly()
    if (!is.null(by))
      ind <- by 
    else
      ind <- rep(NA, nrow(x)) 
  }


# annotations -------------------------------------------------------------

  if (!is.null(add)) {

    if (add[1] == "means") {
      add[1] <- "v_line"
      add[2] <- "h_line"
      x1 <- "mean_x"
      y1 <- "mean_y"
    }

    if (!is.null(x1)) {
      if (date.var) x1 <- julian(x1)  # dates to date serial numbers
      if (length(which(x1 == "mean_x")) > 0) {  # get mean of x if needed
        x1[which(x1 == "mean_x")] <- mean(x, na.rm=TRUE)
        x1 <- as.numeric(x1)
      }
    }
    if (!is.null(y1)) {
      if (length(which(y1 == "mean_y")) > 0) {  # get mean of y if needed
        y1[which(y1 == "mean_y")] <- mean(y, na.rm=TRUE)
        y1 <- as.numeric(y1)
      }
    }

    if (add[1] == "labels")
          text(x, y, labels=ID, pos=1, offset=0.4,
             pch=shape, col=getOption("add_color"), cex=getOption("add_size"))
        else
          .plt.add(add, x1, x2, y1, y2,
               add_size, add_lwd, add_lty, add_color, add_fill, add_trans)
  }  # end annotations
  

# interactive to plt.plotly() ----------------------------------------------

  # only consider eligible
  if (form!="contour" && form!="smooth" && length(shape)==1 &&
      n.xcol==1 && n.ycol==1 && !stack) {

    if (is.null(digits_d)) digits_d <- .max.dd(y[,1])

    if (use_plotly  &&  form=="scatter") {

    if (isTRUE(segments_x) || isTRUE(segments_y)) {  # dot plot

            cat_labels <- if (is.factor(x[,1])) levels(x[,1])[as.integer(x[,1])]
                          else as.character(x[,1])
            gridT1 <- ax.info$axT1
            gridT2 <- ax.info$axT2

            plt <- dot.plotly(
              x           = if (isTRUE(segments_x)) ax.info$axL1 else ax.info$axL2,
              y           = if (isTRUE(segments_x)) as.numeric(y[,1])
                            else                    as.numeric(x[,1]),
              orientation = if (isTRUE(segments_x)) "v" else "h",
              fill        = fill,
              border      = color,
              shape       = shape,
              pt.size     = size.pt,
              x_lab       = x.lab,
              y_lab       = y.lab,
              digits_d    = digits_d,
              pt_opacity  = 1 - pt.trans,
              gridT       = if (isTRUE(segments_x)) gridT2 else gridT1,
              style_opts  = style_opts %||% .plotly_style()
            )
        } else {


        if (fit.line == "off") {  # data not sorted
          if (length(x.lv) < nrow(x)) x.lv <- x[,1]
          if (length(y.lv) < nrow(y)) y.lv <- y[,1]
          g <- data.frame(x=x.lv, y=y.lv, f=f.ln, ind, size)
        }
        else {  # fit line, g already constructed
          names(g)[1:3] <- c("x", "y", "f")
          size <- g$size
        }

        if (date.var) {  # time series
          connect <- TRUE
          ax.info$axT1 <- as.numeric(x.dates[indices])
          ax.info$axL1 <- .format_date_labels(x.dates[indices], ts_unit)
        }

        else  # not time series
          connect <- FALSE

        if (run) connect <- TRUE
        if (segments) connect <- TRUE

        gridT1 <- ax.info$axT1
        gridT2 <- ax.info$axT2

        if (pt.trans == 0.1) pt.trans <- 0.05  # change default

        # build forecast bundle for plt.plotly() when applicable
        frcst_plotly <- NULL
        if (ts_ahead > 0 && date.var) {
          h <- .get.h()
          if (getOption("theme") == "colors") h <- 0
          if (!(getOption("theme") %in% c("gray", "white"))) {
                 if (h==0)   clr.f <- rgb(.6,0,0)
            else if (h==30)  clr.f <- rgb(.6,.3,0)
            else if (h==60)  clr.f <- rgb(.6,.6,0)
            else if (h==120) clr.f <- rgb(0,.6,0)
            else if (h==240) clr.f <- rgb(0,.4,.6)
            else if (h==300) clr.f <- rgb(.6,0,.4)
            else             clr.f <- rgb(.6,0,0)
            band.alpha <- 0.15
          } else {
            clr.f      <- "gray20"
            band.alpha <- 0.45
          }
          frcst_plotly <- list(
            x.fit      = as.numeric(x.fit[,1]),
            y.fit      = y.fit[,1],
            x.hat      = as.numeric(x.hat[,1]),
            y.hat      = y.hat[,1],
            y.upr      = y.upr[,1],
            y.lwr      = y.lwr[,1],
            clr.f      = clr.f,
            band.alpha = band.alpha
          )
        }  # end forecast

        # ensure y.lab honors passed ylab and not overwritten by y.name (".n")
        x.lab <- if (!is.null(xlab) && nzchar(xlab)) xlab else x.name
        y.lab <- if (!is.null(ylab)) ylab else y.name

        plt <- plt.plotly(
          x = g$x, y = g$y, by = g$ind, size = g$size, fit = g$f,
          by_name=by.name, n.by=n.by,
          fill=fill, border=color, shape=shape, pt.size=size.pt,
          x_lab=x.lab, y_lab=y.lab, main=main.lab,
          ax=ax.info, gridT1=gridT1, gridT2=gridT2,
          digits_d=digits_d, date.var=date.var,
          fit_color=fit_color, fit_lwd=fit_lwd, ln.type=1,
          connect=connect, ts_unit=ts_unit,
          power=power, radius.in=0.12, size.name=getOption("sizename"),
          ellipse_region=ellipse_region, ellipse_fill=ellipse_fill,
          ellipse_color=if (n.by <= 1L) ellipse_color else NULL,
          ellipse_lwd=ellipse_lwd,
          se.poly=se.poly, se_fill=se_fill,
          pt_opacity=1 - pt.trans,
          frcst=frcst_plotly,
          out_x      = if (length(out_ind) > 0) x[out_ind, 1] else NULL,
          out_y      = if (length(out_ind) > 0) y[out_ind, 1] else NULL,
          out_labels = if (length(out_ind) > 0) ID[out_ind]   else NULL,
          out_fill   = out_fill,
          out_color  = out_color,
          out_shape  = out_shape,
          ID_color   = ID_color,
          ID_size    = ID_size,
          style_opts = style_opts %||% .plotly_style()
        )
    }  # end else plt.plotly()

    if (.allow.interactive())
      .viewer_notice_once(plot_name="scatter", window_target="Both")

      if (.allow.interactive()) print(plt)  # show in Viewer
    }  # end use_plotly

  }  # end not eligible


# end, return -------------------------------------------------------------

  if (fit.line == "off") {
    mse.ln <- NULL;  mse.nl <- NULL;  b0 <- NULL;  b1 <- NULL;  Rsq <- NULL
    by.cat <- NULL
  }

  return(list(mse.ln=mse.ln, mse.nl=mse.nl, b0=b0, b1=b1, Rsq=Rsq,
              by.cat=by.cat, jitter_x=jitter_x, jitter_y=jitter_y,
              y.new=y.new))

}  # end plt.main
