rENA coverage - 75.31%

Files
Source

#' ENARotationSet R6class
#
#' @docType class
#' @importFrom R6 R6Class
#' @import data.table
#' @export
#
#' @field rotation TBD
#' @field node.positions TBD
#' @field codes TBD
#' @field eigenvalues TBD
ENARotationSet = R6::R6Class("ENARotationSet",
  public = list(

    ## Public Functions ----
      #' Create ENARotationSet
      #'
      #' @param rotation TBD
      #' @param codes TBD
      #' @param node.positions TBD
      #' @param eigenvalues TBD
      #'
      #' @return ENARotationsSet
      initialize = function(
        rotation,
        codes,
        node.positions,
        eigenvalues = NULL
      ) {
        self$node.positions = node.positions;
        self$rotation = rotation;
        self$codes = codes;
        if(!is.null(codes) && !is.null(self$node.positions)) {
         rownames(self$node.positions) = codes;
        }
        self$eigenvalues = eigenvalues;
      },

    ## Public Properties ----
      rotation = NULL,
      node.positions = NULL,
      codes = NULL,
      eigenvalues = NULL
  ),
  private = list(
    #####
    ## Private Properties
    #####
      args = NULL
    #####
    ## END: Private Properties
    #####
  )
)

#' @title hENA rotation for ENA
#'
#' @description hENA rotation function.
#'
#' @param enaset ena set
#' @param params list of parameters
#'
#' @return ena set
#' @export
ena.rotation.h <- function(
  enaset,
  params
) {
  # check arguments
    if ( !is.list(params) || is.null(params$x_var) ) {
      stop("params must be provided as a list() and provide `x_var`")
    }
    x_var = params$x_var;
    y_var = params$y_var;
    control_vars = params$control_vars;
    centering = ifelse(!is.null(params$centering), params$centering, TRUE);
    include_xy = ifelse(!is.null(params$include_xy), params$include_xy, FALSE);
    formula = params$formula;

  # get centered data
    if (!is.null(enaset$model$points.for.projection)) {
      data = data.table::copy(enaset$model$points.for.projection)
    }
    else {
      data = data.table::copy(enaset$points.normed.centered)
    }

  # Prep
    value_vars = colnames(as.matrix(data))
    data.table::set(x = data, j = value_vars, value = data[, lapply(.SD, function(x) x - mean(x)), .SDcols = value_vars])

  # dummy code x_var
    if (!is.numeric(data[[x_var]])) {
      x_var_f = paste0(x_var,"_f")
      data[[x_var_f]] = data.table::rleidv(x = data, cols = x_var) - 1
      x_var = x_var_f;
    }

  # dummy code y_var
    if (!is.null(y_var) && !is.numeric(data[[y_var]])) {
      y_var_f = paste0(y_var,"_f")
      data[[y_var_f]] = data.table::rleidv(x = data, cols = y_var) - 1
      y_var = y_var_f;
    }
    both_vars = c(x_var, y_var)

  # centering x_var and y_var
    if ( centering ) {
      data[, c(both_vars) := lapply(.SD, function(x) x - mean(x)), .SDcols = c(both_vars)]
    }

  # prepare regression formula
    f = paste(c(both_vars, control_vars), collapse = " + ")

    if ( include_xy ) {
      xy_var = paste(both_vars, collapse = "_");
      data[[xy_var]] = data[[x_var]] * data[[y_var]];
      f = paste(c(f, xy_var), collapse = " + ");
    }

    if (!is.null(formula)) {
      f = formula;
    }

  # run regression models and get slope variables
    v = matrix(sapply(value_vars, function(v) {
      formula = as.formula(paste0("data$`", v, "` ~ ", f));
      lm(formula, data = data)$coefficients[seq_along(both_vars) + 1];
    }), ncol = length(both_vars), byrow = TRUE)

  # Prep deflation
    R = NULL;
    '..value_vars' = NULL;
    A = as.matrix(data[, ..value_vars]);

  # Normalize x rotation vector
    v1 = v[, 1, drop = FALSE];
    norm_v1 = sqrt(sum( v1 * v1 ));
    if (norm_v1 != 0) {
      v1 = v1 / norm_v1;
      R = v1;
    }
    defA = as.matrix(A) - as.matrix(A) %*% v1 %*% t(v1);

  # Normalize y rotation vector, if applicable
    v2 = NULL;
    if (!is.null(y_var)) {
      v2 = v[, 2]
      v2 = as.numeric(v2) - as.numeric(t(v2) %*% v1) * v1;
      norm_v2 = sqrt(sum( v2 * v2 ));

      if (norm_v2 != 0) {
        v2 = v2 / norm_v2;
        if( is.null(R) ) {
          R = matrix(c(v2), ncol = 1)
        }
        else {
          R = matrix(c(R, v2), ncol = 2)
        }
      }

      defA = defA - defA %*% v2 %*% t(v2);
    }

  # get svd for deflated points
    # svd_result = svd(defA)
    # svd_v = svd_result$v;
    svd_result = prcomp(defA, retx=FALSE, scale=FALSE, center=FALSE, tol=0)
    svd_v = svd_result$rotation

  # Merge rotation vectors
    vcount = ncol(R);
    combined = cbind(R, svd_v[, 1:(ncol(svd_v) - vcount)]);

    colnames(combined) = c(
      paste(c("x","y")[seq_len(vcount)], both_vars[seq_len(vcount)], sep = "_"),
      paste0("SVD", ((vcount + 1):ncol(combined)))
    );

  # put into ENARotationSet
    # browser()
    rotation_set <- ENARotationSet$new(
      node.positions = NULL,
      rotation = combined,
      codes = enaset$rotation$codes,
      eigenvalues = svd_result$sdev ^ 2
    )

  # Done
    return(rotation_set)
}

#' @title ENAplot Class
#' 
#' @description
#' The ENAplot R6 class provides a structure for visualizing ENAset objects using plotly.
#' It encapsulates the ENAset data, the plotly visualization, and related plotting parameters.
#'
#' @section Fields:
#' \describe{
#'   \item{enaset}{The \code{\link{ENAset}} object from which the ENAplot was constructed.}
#'   \item{plot}{The plot as an htmlwidget: a plotly object, or a qeviz widget
#'     when the plot was created with \code{backend = "qeviz"}.}
#'   \item{qe}{With \code{backend = "qeviz"}, the \code{qeviz::qe_plot()} the
#'     layer functions build on; \code{NULL} for plotly.}
#'   \item{axes}{Axes information for the plot (TBD).}
#'   \item{point}{Point information for the plot (TBD).}
#'   \item{palette}{Color palette used for plotting (TBD).}
#'   \item{plotted}{Indicates whether the plot has been rendered (TBD).}
#' }
#'
#' @examples
#' # Example usage:
#' # enaplot <- ENAplot$new(enaset = myENAset)
#'
#' @docType class
#' @importFrom R6 R6Class
#' @import data.table
#' @export
#'
#' @field enaset - The \code{\link{ENAset}} object from which the ENAplot was constructed
#' @field plot - The plot as an htmlwidget (plotly, or qeviz with \code{backend = "qeviz"})
#' @field qe - The \code{qeviz::qe_plot()} behind a qeviz-backend plot, else \code{NULL}
#' @field axes A list or object specifying the axes configuration for the ENA plot, such as axis labels, limits, or scaling.
#' @field point A structure representing the data points to be plotted, including coordinates and visual properties.
#' @field palette A set of colors or a function defining the color scheme used for plotting elements in the ENA plot.
#' @field plotted A logical or status indicator showing whether the plot has been rendered or updated.
#' @field title Character. The title of the plot.
#' @field showticklabels Logical. Indicates whether to show tick labels on the axes.
#' @field autosize Logical. Indicates whether the plot should automatically resize.
#' @field automargin Logical. Indicates whether the plot should automatically adjust margins.
#' @field axispadding Numeric. Padding factor for the axes.
ENAplot = R6::R6Class("ENAplot",

  public = list(

    ## Public Functions ----
      #' Create ENApolot
      #'
      #' @param enaset An ENA set object containing the data to be plotted.
      #' @param title The title of the plot.
      #' @param dimension.labels Labels for the dimensions shown in the plot.
      #' @param font.size Numeric value specifying the font size for plot text.
      #' @param font.color Color value for the plot text.
      #' @param font.family Font family to use for plot text.
      #' @param scale.to Numeric value to scale the plot axes.
      #' @param showticklabels Logical; whether to display axis tick labels.
      #' @param autosize Logical; whether the plot should automatically size itself.
      #' @param automargin Logical; whether the plot should automatically adjust margins.
      #' @param axispadding Numeric value specifying padding around axes.
      #' @param backend \code{"plotly"} or \code{"qeviz"}; see \link{rENA-plot-backends}.
      #' @param ... Additional arguments passed to the plotting function.      #' 
      #'
      #' @return ENAplot
      initialize = function(
        enaset = NULL,

        title = "ENA Plot",

        dimension.labels = c("",""),

        font.size = 14,
        font.color = "#000000",
        font.family = "Arial",
        scale.to = "network",
        backend = c("plotly", "qeviz"),
        ...
      ) {
        backend <- match.arg(backend)
        if (is(enaset, "ENAset")) {
          warning(paste0("Usage of ENAset objects will be deprecated ",
            "and potentially removed altogether in future versions."))

          enaset <- ena.set(enaset);
        }

        code.cols = !colnames(enaset$line.weights) %in% colnames(enaset$meta.data)

        args = list(...);
        if(!is.null(args$multiplier)) {
          private$multiplier = args$multiplier
        }
        # qeviz backend: an explicit edge magnification (ena.plotter's
        # multipliers), labelled "(scaled Nx)" on the plot.
        if(!is.null(args$magnify)) {
          private$magnify = args$magnify
        }
        if(!is.null(args$point.size)) {
          self$point$size = args$point.size
        }
        if(!is.null(args$showticklabels)) {
          self$showticklabels = args$showticklabels
        }
        if(!is.null(args$axispadding)) {
          self$axispadding = args$axispadding
        }
        if(!is.null(args$autosize)) {
          self$autosize = args$autosize
        }
        if(!is.null(args$automargin)) {
          self$automargin = args$automargin
        }
        self$enaset <- list(
          connection.counts = data.table::copy(enaset$connection.counts),
          meta.data = data.table::copy(enaset$meta.data),
          model = list(
            model.type = enaset$model$model.type,
            raw.input = data.table::copy(enaset$model$raw.input),
            row.connection.counts = data.table::copy(enaset$model$row.connection.counts),
            unit.labels = enaset$model$unit.labels,
            points.for.projection = data.table::copy(enaset$model$points.for.projection),
            centroids = data.table::copy(enaset$model$centroids),
            variance = enaset$model$variance
          ),
          points = data.table::copy(enaset$points),
          line.weights = data.table::copy(enaset$line.weights),
          rotation = list(
            adjacency.key = data.table::copy(enaset$rotation$adjacency.key),
            codes = enaset$rotation$codes,
            rotation.matrix = data.table::copy(enaset$rotation$rotation.matrix),
            center.vec = enaset$rotation$center.vec,
            nodes = data.table::copy(enaset$rotation$nodes)
          ),
          plots = list()
        );
        self$title <- title;

        private$dimension.labels <- dimension.labels;
        private$font.size <- font.size;
        private$font.color <- font.color;
        private$font.family <- font.family;
        private$font = list (
          size = private$font.size,
          color = private$font.color,
          family = private$font.family
        );
        private$backend <- backend
        if (backend == "qeviz") {
          .require_qeviz()
          self$palette <- qeviz::qe_palette()
          self$qe <- .qe_base_plot(enaset, title, dimension.labels, scale.to,
                                   font.size, font.color, font.family)
          return(invisible(self))
        }

        self$plot <- plotly::plot_ly(
          mode = "markers",
          type ="scatter"
        );

        self$plot <- plotly::config(p = self$plot, displayModeBar = args$displayModeBar);

        if (is.list(scale.to)) {
          max.axis = max(abs(as.matrix(enaset$points)))*self$axispadding
          if(is.null(scale.to$x)) {
            axis.range.x = c(-max.axis, max.axis)
          }
          else {
            axis.range.x = scale.to$x
          }
          if(is.null(scale.to$y)) {
            axis.range.y = c(-max.axis, max.axis)
          }
          else {
            axis.range.y = scale.to$y
          }
        }
        else {
          if(is.character(scale.to) && scale.to == "points") {
            max.axis = max(abs(as.matrix(enaset$points)))*self$axispadding
          }
          else if (is.numeric(scale.to)) {
            max.axis = tail(scale.to, 1)
          }
          else {
            max.axis = max(abs(as.matrix(enaset$rotation$nodes)))*self$axispadding;
          }
          axis.range.x = axis.range.y = c(-max.axis, max.axis)
        }

        graph.axis <- list(
          titlefont = private$font,
          showgrid = F,
          zeroline = T,
          showticklabels = self$showticklabels,
          showgrid = T
          # range=c(-max.axis,max.axis)
        );
        if(!is.null(args$ticks)) {
          graph.axis$showticklabels = T;
          graph.axis$ticks = args$ticks$location;
          graph.axis$tickcolor = args$ticks$color;
          graph.axis$tickangle = args$ticks$angle;
        }
        self$axes$x = graph.axis
        self$axes$x$title = dimension.labels[1];
        self$axes$x$range = axis.range.x
        self$axes$y = graph.axis
        self$axes$y$title = dimension.labels[2];
        self$axes$y$range = axis.range.y

        self$plot = plotly::layout(
          self$plot,
          title =  title,
          xaxis = self$axes$x,
          yaxis = self$axes$y,
          autosize = self$autosize,
          font = list (
            size = 12,
            color = private$font.color,
            family = private$font.family
          )
        );
      },

      #' Print ENA plot
      #'
      #' @return
      print = function() {
        print(self$plot);
      },

      #' Get property from object
      #'
      #' @param x character key to retrieve from object
      #' @return value from object at x
      get = function(x) {
        return(private[[x]])
      },

    ## Public Properties ----
      enaset = NULL,
      title = "ENA Plot",
      qe = NULL,
      axes = list(
        x = NULL, y = NULL
      ),
      point = list(
        size = 5
      ),
      showticklabels = F,
      autosize = F,
      automargin = T,
      axispadding = 1.2,
      palette = c("#386CB0", "#F0027F", "#7FC97F", "#BEAED4",
                  "#FDC086","#FFFF99", "#BF5B17"),
      plotted = list(
        points = list(), networks = list(),
        trajectories = list(), means = list()
      )
  ),

  active = list(
    # plotly: the stored plotly object. qeviz: a widget built from self$qe on
    # each read, so it always reflects the layers added so far.
    plot = function(value) {
      if (missing(value)) {
        if (identical(private$backend, "qeviz")) return(qeviz::qe_widget(self$qe))
        return(private$.plot)
      }
      if (identical(private$backend, "qeviz"))
        stop("$plot of a qeviz-backend ENAplot is read-only; add layers with ",
             "ena.plot.network() / ena.plot.points() / ena.plot.group().", call. = FALSE)
      private$.plot <- value
    }
  ),

  private = list(
    ####
    ## Private Properties
    ####
      backend = "plotly",
      .plot = NULL,
      magnify = NULL,

      dimension.labels = c("X","Y"),

      font = list(),
      font.size = 14,
      font.color = "#000000",
      font.family = "Arial",
      #plot.color = I("black"),

      multiplier = 5
    ####
    ## END: Private Properties
    ####
  )
)


# The empty qeviz plot an ENAplot starts from (backend = "qeviz"). The full
# set is extracted so colour ramps and widths use model-wide scales; nothing
# is drawn until the layer functions add networks, points or means.
.qe_base_plot <- function(enaset, title, dimension.labels, scale.to,
                          font.size, font.color, font.family) {
  if (is.list(scale.to))
    stop("scale.to = list(x =, y =) is not supported on the qeviz backend: ",
         "qeviz ranges are symmetric. Use \"network\", \"points\" or a number.",
         call. = FALSE)
  range <- if (is.numeric(scale.to)) utils::tail(scale.to, 1)
           else if (identical(scale.to, "points")) "points"
           else "network"
  lbl <- function(i) {
    v <- if (length(dimension.labels) >= i) dimension.labels[i] else ""
    if (is.null(v) || is.na(v) || !nzchar(v)) FALSE else v
  }
  p <- qeviz::qe_plot(enaset, title = if (!is.null(title) && nzchar(title)) title,
                      group_col = NULL, range = range, scale_points = FALSE)
  p <- qeviz::qe_group(p, show = FALSE)
  p <- qeviz::qe_axes(p, x = lbl(1), y = lbl(2))
  qeviz::qe_labels(p, font_size = font.size, font_family = font.family,
                   font_color = font.color)
}

#' @title with.ena.matrix
#' @description This function sets up a context using the provided data (typically an ENA matrix),
#' allowing the evaluation of an expression (`expr`) with access to both the matrix and
#' its metadata. Optionally, a custom matrix `V` and other arguments can be supplied.
#'
#' @param data An ENA matrix or data frame containing the data to be used.
#' @param expr An R expression to be evaluated within the context of the ENA matrix.
#' @param ... Additional arguments, including an optional custom matrix `V` and other parameters.
#'
#' @details
#' - If a custom matrix `V` is provided in `...`, it will be used; otherwise, `data` is converted to a matrix.
#' - Metadata columns are coerced to numeric if they are character vectors.
#' - The expression is evaluated with access to both the matrix (`V`) and metadata.
#'
#' @return The result of evaluating `expr` in the constructed context.
#'
#' @export
with.ena.matrix <- function(data, expr, ...) {
  dot_args <- list(...);

  # Points
  V <- NULL;
  if(length(dot_args) > 0 && !is.null(dot_args$V)) {
    V <- dot_args$V;
  }
  else {
    V <- as.matrix(data);
  }

  # Meta data
  x <- unclass(data);
  l <- lapply(x, function(i_val) {
    # i_val <- get(i);
    if(is.character(i_val)) {
      i_val <- as.numeric(as.factor(i_val));
    }
    return(i_val);
  });

  # frm <- dot_args$frm;
  # if(!is(frm, "formula")) {
  #   frm <- formula(frm);
  # }

  l$V <- V;
  # with(l, {
  #   lm(formula = frm)
  # })

  ll <- c(l, dot_args);
  eval(substitute(expr), ll, enclos = parent.frame());
  # lm(formula = frm, data = l)
}

###
#' @title ENA Rotate by regression (second way)
#'
#' @description This function allows user to provide a regression formula for rotation on x and optionally on y.
#'    If regression formula for y is not provide, svd is applied to the residual data deflated by x to get y coordinates.
#'    The regression formula should use ENA points as major predictors and a binary or numerical variable as dependent variable.
#'    Control and interaction variables are allowed to be included as predictors in the formula.
#'
#' @param enaset An \code{\link{ENAset}}
#' @param params list of parameters, may include:
#'     x_var: Regression formula for x direction, such as "lm(formula= Condition ~ V + GameHalf + Condition : GameHalf)",
#'     where V always stands for the ENA points.
#'     y_var: Regression formula, similar to x_var for y direction (optional).
#'
#' @export
#' @return \code{\link{ENARotationSet}}
ena.rotate.by.hena.regression_2 = function( enaset, params ) {

  # check arguments
  if ( !is.list(params) || is.null(params$x_var) ) {
    stop("params must be provided as a list() and provide `x_var`")
  }

  x <- formula(params$x_var);

  if (is.null(enaset$points.normed.centered)) {
    p <- as.matrix(enaset$model$points.for.projection);
  }
  else {
    p <- as.matrix(enaset$points.normed.centered);
  }

  #get variables
  V <- as.matrix(p);
  n <- ncol(V);

  #regress to get v1 using x regression formula
  # attach(enaset$meta.data,warn.conflicts = F)
  # v1 <- eval(parse(text = x))$coefficients;
  # v1_res <- with(enaset$model$points.for.projection, NULL, formula = x);
  v1_res <- with.ena.matrix(enaset$model$points.for.projection, {
    prm_var <- params$x_var;
    prm <- if(is.character(prm_var))
        prm_var
      else
        enquote(prm_var)
    ;
    vars <- all.vars(formula(prm));
    all_exists <- sapply(vars, function(x) x == "V" || exists(x))
    if(!all(all_exists)) {
      stop(paste0("The following columns in the formula are not found in the unique metadata for the units: ", paste0(vars[!all_exists], collapse = ", ")))
    }
    lm(formula(prm));
  });
  v1 <- v1_res$coefficients;

  # remove intercept
  if(is.null(dim(v1))) {
    v1 <- v1[2:(n+1)];
  }
  else {
    v1 <- v1[2,];
  }

  # make v1  a unit vector
  norm_v1 <- sqrt(sum(v1 * v1));
  if (norm_v1 != 0) {
    v1 <- v1 / norm_v1;
  }

  # name v1 vector
  if(is.na(all.vars(x)[2])) {
    xName <- names(v1)[1];
  }
  else {
    xName <- all.vars(x)[2];
  }

  # Save v1
  R <- matrix(c(v1), ncol = 1);
  colnames(R) <- c(paste0(xName,"_reg"));

  #deflate matrix by x dimension
  A <- as.matrix(p);
  defA <- as.matrix(A) - as.matrix(A) %*% v1 %*% t(v1);

  #if y formula is given, regress by y formula
  if (!is.null(params$y_var)) {
    y <- formula(params$y_var);

    # regress to get v2 vector using formula y
    V <- defA;

    v2_res <- with.ena.matrix(enaset$model$points.for.projection, {
      prm_var <- params$y_var;
      prm <- if(is.character(prm_var))
        prm_var
      else
        enquote(prm_var)
      ;
      vars <- all.vars(formula(prm));
      all_exists <- sapply(vars, function(x) x == "V" || exists(x))
      if(!all(all_exists)) {
        stop(paste0("The following columns in the formula are not found in the unique metadata for the units: ", paste0(vars[!all_exists], collapse = ", ")))
      }
      lm(formula(prm));
    });
    v2 <- v2_res$coefficients;
    v2 <- v2[2:length(v2)];

    #make v2 a unit vector
    norm_v2 <- sqrt(sum(v2 * v2));

    if (norm_v2 != 0) {
      v2 <- v2 / norm_v2;
    }

    #name v2 vector
    if(is.na(all.vars(y)[2])) {
      yName <- names(v2)[1];
    }
    else {
      yName <- all.vars(y)[2];
    }

    # save both v1 and v2
    R <- cbind(v1, v2);
    colnames(R) <- c(paste0(xName,"_reg"), paste0(yName,"_reg"));

    #deflat by v2
    defA <- as.matrix(defA) - as.matrix(defA) %*% v2 %*% t(v2);
  }

  # get svd for deflated points
  svd_result <- prcomp(defA, retx=FALSE, scale=FALSE, center=FALSE, tol=0);
  svd_v <- svd_result$rotation;

  # Merge rotation vectors
  vcount <- ncol(R);
  colNamesR <- colnames(R);
  combined <- cbind(R, svd_v[, 1:(ncol(svd_v) - vcount)]);
  colnames(combined) <- c(
    colNamesR,
    paste0("SVD", ((vcount + 1):ncol(combined)))
  );

  #create rotation set
  rotation_set <- ENARotationSet$new(
    node.positions = NULL,
    rotation = combined,
    codes = enaset$rotation$codes,
    eigenvalues = NULL
  )

  return(rotation_set);
}


ena.set <- function(x) {
  newset = list()
  class(newset) <- c("ena.set", class(newset))
  x.is.set <- T
  if("ENAdata" %in% class(x)) {
    x <- list(enadata = x);
    x.is.set <- F
  }
  code.columns <- apply(x$enadata$adjacency.matrix, 2, paste, collapse = " & ")

  newset$connection.counts <- x$enadata$adjacency.vectors;
  colnames(newset$connection.counts) <- code.columns
  for (i in seq(ncol(newset$connection.counts))) {
    set(newset$connection.counts, j = i, value = as.ena.co.occurrence(newset$connection.counts[[i]]))
  }

  if (grepl(x = x$enadata$model, pattern = "Traj", ignore.case = T)) {
    newset$meta.data <- data.table::copy(x$enadata$trajectories$units)
    newset$meta.data[, ENA_UNIT := apply(x$enadata$trajectories$units, 1, paste, collapse = "::")]

    newset$trajectories <- cbind(newset$meta.data, x$enadata$trajectories$step)
    for (i in seq(ncol(newset$trajectories))) {
      set(newset$trajectories, j = i, value = as.ena.metadata(newset$trajectories[[i]]))
    }
  }
  else {
    newset$meta.data <- x$enadata$metadata
  }

  if (!is.null(newset$meta.data) && ncol(newset$meta.data) > 0) {
    for (i in seq(ncol(newset$meta.data))) {
      set(newset$meta.data, j = i,
          value = as.ena.metadata(newset$meta.data[[i]]))
    }
  }
  newset$meta.data <- as.ena.matrix(newset$meta.data);

  if (x.is.set) {
    newset$line.weights <- as.data.table(cbind(x$enadata$metadata, x$line.weights))
    to_cols <- names(which(!find_meta_cols(newset$line.weights)))
    for(col in to_cols) {
      set(x = newset$line.weights, j = col, value = as.ena.co.occurrence(newset$line.weights[[col]]))
    }
    class(newset$line.weights) <- c("ena.line.weights", class(newset$line.weights))

    newset$points <- cbind(x$enadata$metadata, x$points.rotated)
    to_cols <- names(which(!find_meta_cols(newset$points)))
    for(col in to_cols) {
      set(x = newset$points, j = col, value = as.ena.dimension(newset$points[[col]]))
    }
    newset$points <- as.ena.matrix(newset$points, "ena.points")

    newset$rotation.matrix <- x$rotation.set$rotation
  }

  newset$connection.counts <- cbind(newset$meta.data, newset$connection.counts)
  class(newset$connection.counts) <- c("ena.connections",
                                        class(newset$connection.counts))

  newset$model <- list(
    model.type = x$enadata$model,
    raw.input = x$enadata$raw,
    row.connection.counts = x$enadata$accumulated.adjacency.vectors[,
            unique(names(x$enadata$accumulated.adjacency.vectors)), with = F],
    unit.labels = x$enadata$unit.names
  )

  #####
  # if(quote(x$enadata$function.params$weight.by) != "binary") {
  #   newset$model$unweighted.connection.counts <- x$enadata$adjacency.vectors.raw
  #   class(newset$model$unweighted.connection.counts) <- c("ena.connections",
  #                             class(newset$model$unweighted.connection.counts))
  #   are.codes <- find_code_cols(newset$model$unweighted.connection.counts)
  #   for (i in seq(are.codes)) {
  #     if (are.codes[i]) {
  #       set(newset$model$unweighted.connection.counts, j = i,
  #         value = as.ena.co.occurrence(
  #           newset$model$unweighted.connection.counts[[i]]
  #         )
  #       )
  #     } else {
  #       set(newset$model$unweighted.connection.counts, j = i,
  #         value = as.ena.metadata(
  #           newset$model$unweighted.connection.counts[[i]]
  #         )
  #       )
  #     }
  #   }
  # }
  #####

  cols <- grep("adjacency.code", colnames(newset$model$row.connection.counts))
  colnames(newset$model$row.connection.counts)[cols] <- code.columns
  for(i in cols) {
    set(newset$model$row.connection.counts, j = i,
        value = as.ena.co.occurrence(newset$model$row.connection.counts[[i]]))
  }
  for (i in which(colnames(newset$model$row.connection.counts)
      %in% colnames(newset$meta.data))
  ) {
    set(newset$model$row.connection.counts, j = i,
          value = as.ena.metadata(newset$model$row.connection.counts[[i]]))
  }
  for (i in which(colnames(newset$model$row.connection.counts) %in%
        x$enadata$codes)
  ) {
    set(newset$model$row.connection.counts, j = i,
          value = as.ena.code(newset$model$row.connection.counts[[i]]))
  }
  class(newset$model$row.connection.counts) <- c("row.connections",
                                      class(newset$model$row.connection.counts))

  if (x.is.set) {
    newset$model$centroids <- x$centroids
    newset$model$correlations <- x$correlations
    newset$model$function.call <- x$function.call
    newset$model$function.params <- x$function.params
    newset$model$points.for.projection <- cbind(x$enadata$metadata,
                                               x$points.normed.centered)
    newset$model$variance <- x$variance
    names(newset$model$variance) <- colnames(newset$rotation.matrix)
  }

  newset$rotation <- list(
    adjacency.key = as.data.table(x$enadata$adjacency.matrix),
    codes = x$enadata$codes
  )
  class(newset$rotation) <- c("ena.rotation.set", class(newset$rotation))

  for (i in seq(ncol(newset$rotation$adjacency.key))) {
    set(newset$rotation$adjacency.key, j = i,
          value = as.ena.codes(newset$rotation$adjacency.key[[i]]))
  }

  if(x.is.set) {
    newset$rotation$eigenvalues = x$rotation.set$eigenvalues
    newset$rotation$nodes = x$node.positions
    newset$rotation$rotation.matrix = x$rotation.set$rotation
  }

  newset$`_function.call` <- sys.calls()[[1]]
  back.frame <- sapply(sys.frames(), function(f) {
                                  "window.size.back" %in% ls(envir = f) })
  if (any(back.frame)) {
    call.frame <- sys.frame(which(back.frame))
    newset$`_function.params` <- mget(ls(envir = call.frame),
                                                  envir = call.frame)
  } else {
    newset$`_function.params` <- list()
  }

  return(newset);
}

.onLoad <- function(libname, pkgname) {
  globalVariables(c(
    ".","ENA_ROW_IDX","ENA_UNIT","V1","V2","V3",
    "ci.x","ci.y","e","handle","name","unit.groups",
    "V","graph_from_data_frame","|>","X1","X2",
    "dfDT.points","points.raw","lines","KEYCOL","ENA_CONV",
    "..groupCol","..units","..metadata", "..codes", "..conversation","ENA_GROUP_NAME",
    "label.font.color","label.font.family","label.font.size",
    "label.offset","legend.include.edges","legend.name",
    "network.edges.shapes","nodes","rows.to.keep","show.legend",
    "..connection_name", "..dimension_names", "..first_meta",
    "..codeNames", "..conversation_cols",
    "count","window","entropy","ground_type","n_obs","n_unique",
    "method","n_conversations",".group"
  ))
#   op <- options()
#   op.rENA <- list(
#     UNIT_NAMES = "ena.unit.names",
#     TRAJ_TYPES = c("accumulated","non-accumulated")
#   );
#
#   toset <- !("rENA" %in% names(op))
#   print(paste("ToSet:", toset));
#
#   if(toset) {
#     options(rENA = op.rENA)
#   }
#
#   invisible()
}

.onAttach <- function(libname, pkgname) {
  packageStartupMessage("For the latest features and updates, install from https://cran.qe-libs.org");
  invisible();
}

## ── qeviz backend for the ena.plot.* layer functions ─────────────────────────
##
## With ena.plot(backend = "qeviz"), ena.plot.network() / ena.plot.points() /
## ena.plot.group() hand off to the functions here, which add layers to the
## ENAplot's qeviz::qe_plot() ($qe) instead of plotly traces. The mapping is
## documented in qeviz's docs/rena-qeviz-backend.md.
##
## Arguments qeviz cannot honour warn once per session when they change the
## picture (see .qe_ignored()); plotly-only layout options are ignored quietly.
## ─────────────────────────────────────────────────────────────────────────────

.qe_backend <- function(enaplot) {
  !is.null(enaplot) && is(enaplot, "ENAplot") && identical(enaplot$get("backend"), "qeviz")
}

.qe_warned <- new.env(parent = emptyenv())

# Warn once per session for each supplied argument qeviz ignores.
.qe_ignored <- function(fn, supplied, args, why) {
  for (a in intersect(args, supplied)) {
    key <- paste(fn, a, sep = "::")
    if (isTRUE(.qe_warned[[key]])) next
    assign(key, TRUE, envir = .qe_warned)
    warning(sprintf("%s(): '%s' is ignored on the qeviz backend (%s).", fn, a, why),
            call. = FALSE)
  }
}

# Colours as hex (qeviz derives complements from hex; rENA passes names / I()).
.qe_hex <- function(colors) {
  if (is.null(colors)) return(NULL)
  cols <- as.character(unclass(colors))
  m <- grDevices::col2rgb(cols, alpha = FALSE)
  stats::setNames(grDevices::rgb(m[1, ], m[2, ], m[3, ], maxColorValue = 255), names(colors))
}

# Plot-wide label fonts, applied only when a layer call supplied them.
.qe_fonts <- function(qe, supplied, size, family, color) {
  args <- list(qe)
  if ("label.font.size" %in% supplied)   args$font_size   <- size
  if ("label.font.family" %in% supplied) args$font_family <- family
  if ("label.font.color" %in% supplied)  args$font_color  <- color
  if (length(args) > 1) do.call(qeviz::qe_labels, args) else qe
}

# Points in rENA's accepted forms (ena.points, data.frame / matrix, a numeric
# vector for one point) -> id + the first two dimension columns, named as the
# model's axes so qeviz reads them.
.qe_point_df <- function(points, enaplot, ids = NULL) {
  m <- enaplot$qe$model
  if (is.numeric(points) && is.null(dim(points))) points <- matrix(points, nrow = 1)
  unit <- if (!is.null(ids)) as.character(ids)
          else if (is.data.frame(points) && "ENA_UNIT" %in% names(points)) as.character(points$ENA_UNIT)
          else if (!is.null(rownames(points))) rownames(points)
          else NULL
  dims <- as.data.frame(if (is(points, "ena.points") || is.data.table(points)) remove_meta_data(points)
                        else points, check.names = FALSE)
  dims <- dims[, vapply(dims, is.numeric, logical(1)), drop = FALSE]
  if (ncol(dims) < 2) stop("points need at least two dimension columns.", call. = FALSE)
  out <- data.frame(id = if (is.null(unit)) as.character(seq_len(nrow(dims))) else unit,
                    stringsAsFactors = FALSE)
  names(out) <- m$id_col
  out[[m$x_col]] <- as.numeric(dims[[1]])
  out[[m$y_col]] <- as.numeric(dims[[2]])
  out
}

# ── ena.plot.network ─────────────────────────────────────────────────────────
.qe_plot_network <- function(enaplot, supplied, network, node.positions, adjacency.key,
                             colors, edge_type, show.all.nodes, threshold,
                             thin.lines.in.front, layers, labels,
                             label.font.size, label.font.color, label.font.family,
                             legend.name, dots) {
  fn <- "ena.plot.network"
  .qe_ignored(fn, supplied,
              c("thickness", "opacity", "saturation", "scale.range", "node.size", "scale.weights"),
              "qeviz's model-wide width and colour scaling replaces them")
  .qe_ignored(fn, supplied, c("label.offset", "legend.include.edges"), "not supported")
  if ("edge_type" %in% supplied && !identical(edge_type, "line"))
    .qe_ignored(fn, "edge_type", "edge_type", "edges are always solid lines")
  if ("thin.lines.in.front" %in% supplied && isFALSE(thin.lines.in.front))
    .qe_ignored(fn, "thin.lines.in.front", "thin.lines.in.front", "thin lines are always drawn on top")

  qe <- enaplot$qe
  if (is.data.frame(network) || is.matrix(network)) {
    nw <- as.data.frame(network, check.names = FALSE)
    network <- colMeans(as.matrix(nw[, vapply(nw, is.numeric, logical(1)), drop = FALSE]))
  }
  network <- stats::setNames(as.numeric(unclass(network)), names(network))
  # Same length rule as the plotly path: one weight per pair of nodes, or per
  # pair plus each node's self-connection (upper triangle with the diagonal).
  n_nodes <- NROW(node.positions)
  n_self <- n_nodes * (n_nodes + 1) / 2
  if (!length(network) %in% c(choose(n_nodes, 2), n_self))
    stop(paste0("Network vector needs to be of length ", choose(n_nodes, 2),
                " (or ", n_self, " with self-connections)"), call. = FALSE)
  # Unnamed weights follow the adjacency key, exactly as the plotly path reads
  # them: the key given, else the one implied by node.positions' codes.
  if (!is.null(adjacency.key) || is.null(names(network))) {
    codes <- if (is(node.positions, "ena.nodes")) as.character(node.positions$code)
             else rownames(node.positions)
    key <- as.matrix(if (!is.null(adjacency.key)) adjacency.key
                     else namesToAdjacencyKey(codes, diagonal = length(network) == n_self &&
                                                                n_self != choose(n_nodes, 2)))
    names(network) <- paste(key[1, ], key[2, ], sep = " & ")
  }

  if ("node.positions" %in% supplied)
    qe <- qeviz::qe_nodes(qe, positions = node.positions)
  if ("labels" %in% supplied && !is.null(labels)) {
    codes <- if (is(node.positions, "ena.nodes")) as.character(node.positions$code)
             else rownames(node.positions)
    qe <- qeviz::qe_nodes(qe, labels = stats::setNames(as.character(labels), codes))
  }
  show <- if (!"edges" %in% layers) "always" else if (!"nodes" %in% layers) "never" else "auto"
  qe <- qeviz::qe_nodes(qe, show = show, unconnected = if (isFALSE(show.all.nodes)) "hide" else "dot")
  if (isTRUE(dots$labels.hide)) qe <- qeviz::qe_labels(qe, nodes = "off")

  thr <- threshold[is.finite(threshold)]
  if (!length(thr) || (length(thr) == 1 && thr[1] <= 0)) thr <- NULL
  # Magnification: a layer's own (add_network(edge.multiplier)), else the
  # plot's (ena.plotter multipliers), else ena.plot(multiplier) relative to
  # rENA's default of 5.
  mult <- enaplot$get("multiplier")
  magnify <- if (!is.null(dots$magnify)) dots$magnify
             else if (!is.null(enaplot$get("magnify"))) enaplot$get("magnify")
             else if (!is.null(mult) && mult != 5) mult / 5
  if ("edges" %in% layers)
    qe <- qeviz::qe_edges(qe, weights = network, colors = unname(.qe_hex(colors)),
                          threshold = thr, name = legend.name, magnify = magnify)
  enaplot$qe <- .qe_fonts(qe, supplied, label.font.size, label.font.family, label.font.color)
  enaplot
}

# ── ena.plot.points ──────────────────────────────────────────────────────────
.qe_plot_points <- function(enaplot, supplied, points, point.size, labels, shape, colors,
                            label.font.size, label.font.color, label.font.family, texts,
                            legend.name) {
  fn <- "ena.plot.points"
  .qe_ignored(fn, supplied, c("confidence.interval.values", "outlier.interval.values",
                              "confidence.interval", "outlier.interval"),
              "per-point intervals are not supported; use ena.plot.group() for means")
  .qe_ignored(fn, supplied, c("label.offset", "label.group", "show.legend"), "not supported")
  if (is.null(points)) points <- enaplot$enaset$points
  df <- .qe_point_df(points, enaplot,
                     ids = if (!is.null(labels) && length(labels) == NROW(points) &&
                               !(is.numeric(points) && is.null(dim(points)))) labels)
  qe <- qeviz::qe_points(enaplot$qe, points = df,
                         color = unname(.qe_hex(colors)),
                         shape = if ("shape" %in% supplied) shape,
                         labels = if (!is.null(texts)) as.character(texts),
                         size = if ("point.size" %in% supplied) point.size / 2,
                         # legend.name names the point set (add_points() passes
                         # one per group); calls with the same name replace it.
                         name = if ("legend.name" %in% supplied) legend.name)
  enaplot$qe <- .qe_fonts(qe, supplied, label.font.size, label.font.family, label.font.color)
  enaplot
}

# ── ena.plot.group ───────────────────────────────────────────────────────────
.qe_plot_group <- function(enaplot, supplied, points, method, labels, colors, shape,
                           confidence.interval, outlier.interval,
                           label.font.size, label.font.color, label.font.family) {
  fn <- "ena.plot.group"
  if (!is.null(method) && !identical(method, "mean"))
    stop("ena.plot.group(): only method = \"mean\" is supported on the qeviz backend.",
         call. = FALSE)
  if (is.null(points)) stop("Points must be provided.")
  .qe_ignored(fn, supplied, c("label.offset", "show.legend", "legend.name"), "not supported")
  if (identical(outlier.interval, "crosshairs"))
    .qe_ignored(fn, "outlier.interval", "outlier.interval",
                "crosshairs are not available for the outlier interval; it is drawn as a box")

  df <- .qe_point_df(points, enaplot)
  cols <- if ("colors" %in% supplied) .qe_hex(colors)
  # rENA draws one mean per distinct colour when colors is given per point.
  split <- if (length(cols) == nrow(df) && length(unique(cols)) > 1) unique(cols) else NULL
  groups <- if (is.null(split)) list(list(rows = seq_len(nrow(df)), color = cols[1], label = labels[1]))
            else lapply(seq_along(split), function(k)
              list(rows = which(cols == split[k]), color = split[k],
                   label = if (length(labels) >= k) labels[k]))
  qe <- enaplot$qe
  for (g in groups) {
    sub <- df[g$rows, , drop = FALSE]
    qe <- qeviz::qe_group(qe, points = sub, label = g$label, color = unname(g$color),
                          shape = shape,
                          intervals = if (nrow(sub) < 2) "none" else confidence.interval,
                          outlier = nrow(sub) >= 2 && outlier.interval != "none")
  }
  enaplot$qe <- .qe_fonts(qe, supplied, label.font.size, label.font.family, label.font.color)
  enaplot
}

# ── Multipliers (ena.plotter, ena.plot.subtraction, add_network) ─────────────
# The plotly path multiplies the weights. On qeviz the weights stay as they are
# (so they sit correctly on the model-wide colour scale) and the multiplier
# becomes the plot's magnification instead.
.qe_weight_mult <- function(backend, k) if (identical(backend, "qeviz")) 1 else k
.qe_magnify <- function(backend, k, labelled = k != 1) {
  if (identical(backend, "qeviz") && isTRUE(labelled)) k else NULL
}

# ── check_range on qeviz ─────────────────────────────────────────────────────
# Same rule as the plotly path: grow the symmetric range to 1.2x the largest
# plotted point / mean when they exceed it, shrink when they use under half.
.qe_check_range <- function(x) {
  numbers <- as.numeric(sapply(x$plotted$points, function(p) max(abs(as.matrix(remove_meta_data(p$data[[1]]))))))
  means   <- as.numeric(sapply(x$plotted$means, function(p) max(abs(as.numeric(p$data)))))
  if (!length(numbers) && !length(means)) return(x)
  curr_max <- max(c(numbers, means))
  m <- x$qe$model
  current <- x$qe$graph_opts[["range"]]
  current <- if (is.numeric(current)) current else {
    nodes <- do.call(rbind, lapply(m$nodes$data, function(r) c(r[[m$x_col]], r[[m$y_col]])))
    max(abs(nodes)) * 1.2
  }
  if (curr_max * 1.2 > current || curr_max < current * 0.5)
    x$qe <- qeviz::qe_range(x$qe, curr_max * 1.2)
  x
}

# ── Trajectories / movies: plotly only ───────────────────────────────────────
# Not drawn on the qeviz backend (qeviz has no trajectories yet). The call is a
# no-op with a warning; the plotly path is unchanged.
.qe_no_trajectories <- function(fn) {
  warning(structure(class = c("rENA_qeviz_unsupported", "warning", "condition"), list(
    message = sprintf(paste0("%s() is not drawn on the qeviz backend; the plot is returned ",
                             "unchanged. Use ena.plot(..., backend = \"plotly\") for trajectories."), fn),
    call = NULL)))
}

accumulate.data <- function(enadata) {
  dfDT <- enadata$raw;

  units.used <- enadata$get("units.used")
  units.by <- enadata$get("units.by")
  trajectory.by <- enadata$get("trajectory.by")
  codes <- enadata$codes

  if (is.data.frame(codes)) {
    codes <- colnames(codes);
  }

  conversations.by <- enadata$get("conversations.by")
  window <- enadata$get("window.size")
  # binaryStanzas <- F
  units.exclude <- enadata$get("units.exclude")

  if(is.null(trajectory.by)) {
    trajectory.by = conversations.by
  }

  ### should work to determine if binary is desired
  binary <- T;
  if (!identical(enadata$get("weight.by"), "binary")) {
    binary <- F
  }
  else {
    binary <- T
  }

  ### We need data
  if (is.null(dfDT) || nrow(dfDT) < 1) {
    stop("The provided data is NULL")
  }

  ###
  # We need a data.table, it's worth it.
  ###
  if(!data.table::is.data.table(dfDT)) {
    dfDT <- data.table::as.data.table(dfDT)
  }

  ###
  # Make a copy of the data for safe usage
  ###
  dfDT_codes <- data.table::copy(dfDT)

  ###
  # Create a column representing the ENA_UNIT as defined
  # by the the `units.by` parameter
  ###
  if(!"ENA_UNIT" %in% colnames(dfDT_codes)) {
    dfDT_codes$ENA_UNIT <- enadata$raw$ENA_UNIT <- merge_columns_c(
      dfDT_codes,
      cols = units.by, sep = "::"
    )
  }

  ##
  # String vector of codesnames representing the names of the co-occurrences
  ##
  vL <- length(codes);
  adjacency.length <- ( (vL * (vL + 1)) / 2) - vL ;
  codedTriNames <- paste("adjacency.code",rep(1:adjacency.length), sep=".");

  initial_cols <- c(units.by, codes)
  just_codes <- c(codes)

  ##
  # Accumulated windows appended to the end of each row
  #
  # FIXME: Don't append on the results to the initial data.table,
  #        keep a separate to lookup the results for the co-occurred
  #        values later on.
  ##
  if (window$back == 1 && window$forward == 0) {
    dfDT.co.occurrences <- dfDT_codes[,{
        ocs <- data.table::as.data.table(
                rows_to_co_occurrences(
                  .SD[,.SD,.SDcols=codes, with=T],
                  binary = binary
                )
              );

        # Return value from data.table back to dfDT.co.occurrences
        data.table::data.table(.SD, ocs)
      },
      .SDcols = c(codes, conversations.by, trajectory.by),
      with = T
    ]

    ### Generate the ENA_UNIT column
    dfDT.co.occurrences$ENA_UNIT <- dfDT_codes$ENA_UNIT

    ### Keep original columns used for units
    dfDT.co.occurrences[, (units.by) := dfDT_codes[, .SD, .SDcols = units.by]]
  }
  else if (window$back == "Conversation") {
    ###
    # First sum all lines by conversation and unit to get vectors of codes
    # occurring in the whole conversation for each unit
    ###
    dfDT.conv.sum <- dfDT_codes[,
      lapply(.SD, sum), by = c(unique(conversations.by)),
      .SDcols = c(codes),
      with = T
    ]

    ###
    # Convert each units converstation sums into adjacency vectors
    ###
    # browser()
    dfDT.co.occurrences <- dfDT.conv.sum[,{
        ocs = data.table::as.data.table(rows_to_co_occurrences(.SD[,.SD,.SDcols=codes, with=T], binary = binary));
        data.table::data.table(.SD,ocs, ENA_UNIT=merge_columns_c(.SD, cols = units.by, sep="::"))
      },
      .SDcols=unique(c(codes, conversations.by, trajectory.by, units.by)),
      with=T
    ];
  }
  else {
    ## parallell: https://stackoverflow.com/questions/14759905/data-table-and-parallel-computing
    ### Calculate occurrences of code within the provided window

    # if(enadata$function.params$in.par == T) {
    #   grainSize = ifelse(!is.null(enadata$function.params$grainSize), enadata$function.params$grainSize, 10);
    #   dfDT.co.occurrences = dfDT_codes[,
    #                            (codedTriNames) := try_one(
    #                              .SD[,.SD, .SDcols=just_codes],
    #                              window=window$back,
    #                              binary = binary,
    #                              grainSize = grainSize
    #                            ),
    #                            by=conversations.by,
    #                            .SDcols=initial_cols,
    #                            with=T
    #                          ];
    #
    # } else {
            # ,binaryStanzas = binaryStanzas
      dfDT.co.occurrences <- dfDT_codes[,
          (codedTriNames) := ref_window_df(
            .SD[, .SD, .SDcols = just_codes],
            windowSize = window$back,
            windowForward = window$forward,
            binary = binary
          ),
          by = conversations.by,
          .SDcols = initial_cols,
          with = T
      ];
    # }
  }
  # browser()

  if( is.function(enadata$get("weight.by")) ) {
    cols <- colnames(dfDT.co.occurrences)[
              grep("adjacency.code", colnames(dfDT.co.occurrences))
            ]
    dfDT.co.occurrences <- dfDT.co.occurrences[,
                                (cols) := lapply(
                                  .SD,
                                  enadata$get("weight.by")
                                ),
                                .SDcols = cols,
                                by = 1:nrow(dfDT.co.occurrences)
                           ]
  }


  ###
  # Convert the generic `V` names to corresponding `adjacency.vector` names
  ###
    vCols <- grep("V\\d+", colnames(dfDT.co.occurrences))
    if(length(vCols) == length(codedTriNames)) {
      colnames(dfDT.co.occurrences)[vCols] <- codedTriNames
    }

  ##
  # If units aren't supplied, use all available
  ##
    if (is.null(units.used)) {
      units.used <- dfDT_codes$ENA_UNIT
    }


  ###
  # Trajectory Checks
  ###

  ## Not a Trajectory
  if (enadata$model == "EndPoint") {
    ###
    # Sum each unit found in dfDT.co.occurrences
    ###
    dfDT.summed.units <- dfDT.co.occurrences[ENA_UNIT %in% units.used,lapply(.SD,sum),by=units.by,.SDcols=codedTriNames]
    dfDT.summed.units$ENA_UNIT <- merge_columns_c(dfDT.summed.units, units.by, sep="::");

    enadata$unit.names <- dfDT.summed.units$ENA_UNIT;
  }
  ## Trajectory
  else {
    ## First sum all units within each Trajectory Group (trajectory.by)
    dfDT.summed.traj.by <- dfDT.co.occurrences[
      ENA_UNIT %in% units.used,
      {
        sums <- lapply(.SD, sum)
        data.frame(ENA_ROW_IDX = .GRP, sums); # Return value
      },
      by = c(units.by, trajectory.by),
      .SDcols = (codedTriNames)
    ];
    dfDT.summed.traj.by$ENA_UNIT <- merge_columns_c(
      dfDT.summed.traj.by, units.by, sep = "::"
    )
    dfDT.summed.traj.by$TRAJ_UNIT <- merge_columns_c(
      dfDT.summed.traj.by, trajectory.by, sep = "::"
    );

    enadata$trajectories$step <- dfDT.summed.traj.by$TRAJ_UNIT;

    # Accumulated
    if (enadata$model == opts$TRAJ_TYPES[1]) {
      dfDT.summed.units <- dfDT.summed.traj.by[
        ENA_UNIT %in% unique(units.used), {
          cols <- colnames(.SD)
          ENA_UNIT <- paste(as.character(.BY), collapse = "::")
          TRAJ_UNIT <- .SD[, c(trajectory.by), with = F]
          inc_cols <- cols[! cols %in% c(trajectory.by, "ENA_ROW_IDX")]
          lag <- ref_window_lag(.SD[, .SD, .SDcols = inc_cols], .N)

          data.table::data.table(
            ENA_ROW_IDX,
            TRAJ_UNIT, lag, ENA_UNIT = ENA_UNIT
          )
        },
        by = c(units.by),
        .SDcols = c(codedTriNames, trajectory.by, "ENA_ROW_IDX")
      ]
      dfDT.summed.units$TRAJ_UNIT <- merge_columns_c(
        dfDT.summed.units, trajectory.by, sep = "::"
      )
    }
    # Non-accumulated
    else if (enadata$model == opts$TRAJ_TYPES[2]) {
      dfDT.summed.units <- dfDT.summed.traj.by;
    }
    else {
      stop("Unsupported Model type.");
    }

    dfDT.summed.units$ENA_UNIT <- merge_columns_c(
      dfDT.summed.units, units.by, sep = "::"
    )
  }
  ###
  # END: Trajectory Checks
  ###

  ###
  # Name the rows and columns accordingly
  ###
    colnames(dfDT.summed.units)[
      grep("V\\d+", colnames(dfDT.summed.units))
    ] <- codedTriNames

  ###
  # Set attributes
  #
  # TODO Most of this should be moved to a more prominent spot on ENAdata
  ###
    adjRows <- triIndices(length(codes)) + 1
    codedRow1 <- codes[adjRows[1, ]]
    codedRow2 <- codes[adjRows[2, ]]
    attr(dfDT.summed.units, "adjacency.matrix") <- rbind(codedRow1, codedRow2)
    attr(dfDT.summed.units, "adjacency.codes") <- codedTriNames
    attr(dfDT.summed.units, opts$UNIT_NAMES)  <- dfDT.summed.units[,
        .SD, with = T, .SDcols = units.by]

    enadata$adjacency.matrix <- rbind(codedRow1, codedRow2)
    enadata$accumulated.adjacency.vectors <- dfDT.co.occurrences
    enadata$adjacency.vectors <- dfDT.summed.units
  ###
  # END: Set attributes
  ###

  return(enadata);
}

##
#' @title Plot of ENA set groups
#'
#' @description Plot a point based on a summary statistic computed from a given method (typically, mean) for a set of points in a projected ENA space
#'
#' @details Plots a point based on a summary statistic for a group (typically, mean)
#'
#' @export
#'
#' @param enaplot \code{\link{ENAplot}} object to use for plotting
#' @param points A matrix or data.frame where columns contain coordinates of points in a projected ENA space
#' @param method A function for computing a summary statistic for each column of points
#' @param labels A character which will be the label for the group's point
#' @param colors A character, determines color of the group's point, default: enaplot$color
#' @param shape A character, determines shape of the group's point, choices:  square, triangle, diamond, circle, default: square
#' @param confidence.interval A character that determines how the confidence interval is displayed, choices: none, box, crosshair, default: none
#' @param outlier.interval A character that determines how outlier interval is displayed, choices: none, box, crosshair, default: none
#' @param label.offset character: top left (default), top center, top right, middle left, middle center, middle right, bottom left, bottom center, bottom right
#' @param label.font.size An integer which determines the font size for label, default: enaplot$font.size
#' @param label.font.color A character which determines the color of label, default: enaplot$font.color
#' @param label.font.family A character which determines font type, choices: Arial, Courier New, Times New Roman, default: enaplot$font.family
#' @param show.legend Logical indicating whether to show the point labels in the in legend
#' @param legend.name Character indicating the name to show above the plot legend
#' @param ... Additional parameters
#'
#' @seealso \code{\link{ena.plot}}, \code{ena.plot.points}
#'
#' @examples
#' data(RS.data)
#'
#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
#'   'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
#'
#' accum = ena.accumulate.data(
#'   units = RS.data[,c("UserName","Condition")],
#'   conversation = RS.data[,c("Condition","GroupName")],
#'   metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post")],
#'   codes = RS.data[,codeNames],
#'   window.size.back = 4
#' )
#'
#' set = ena.make.set(
#'   enadata = accum,
#'   rotation.by = ena.rotate.by.mean,
#'   rotation.params = list(
#'       accum$meta.data$Condition=="FirstGame",
#'       accum$meta.data$Condition=="SecondGame"
#'   )
#' )
#'
#' plot = ena.plot(set)
#'
#' unitNames = set$enadata$units
#'
#' ### Plot Condition 1 Group Mean
#' plot = ena.plot.group(plot, as.matrix(set$points$Condition$FirstGame), labels = "FirstGame",
#'     colors = "red", confidence.interval = "box")
#'
#' ### plot Condition 2 Group Mean
#' plot = ena.plot.group(plot, as.matrix(set$points$Condition$SecondGame), labels = "SecondGame",
#'     colors  = "blue", confidence.interval = "box")
#'
#' print(plot);
#'
#' @return The  \code{\link{ENAplot}} provided to the function, with its plot updated to include the new group point.
##
ena.plot.group <- function(
  enaplot,
  points = NULL,
  method = "mean",
  labels = NULL,
  colors = default.colors[1],
  shape = c("square", "triangle-up", "diamond", "circle"),
  confidence.interval = c("none", "crosshairs", "box"),
  outlier.interval = c("none", "crosshairs", "box"),
  label.offset = "bottom right",
  label.font.size = NULL,
  label.font.color = NULL,
  label.font.family = NULL,
  show.legend = T,
  legend.name = NULL,
  ...
) {
  shape = match.arg(shape);
  confidence.interval = match.arg(confidence.interval);
  outlier.interval = match.arg(outlier.interval);

  if (.qe_backend(enaplot))
    return(.qe_plot_group(enaplot, supplied = names(match.call())[-1],
      points = points, method = method, labels = labels, colors = colors, shape = shape,
      confidence.interval = confidence.interval, outlier.interval = outlier.interval,
      label.font.size = label.font.size, label.font.color = label.font.color,
      label.font.family = label.font.family))

  if(is.null(points)) {
    stop("Points must be provided.");
  }
  else if(is(points, "ena.points")) {
    points = remove_meta_data(points)
  }

  ### problem if outlier and confidence intervals selected for crosshair
  if(confidence.interval == "crosshairs" && outlier.interval == "crosshairs") {
    message("Confidence Interval and Outlier Interval cannot both be crosshair. Plotting Outlier Interval as box");
    outlier.interval = "box";
  }

  ### if group more than one row, combine to mean
  confidence.interval.values = NULL;
  outlier.interval.values = NULL;
  if(
    (is(points, "data.frame") || is(points, "matrix")) &&
    nrow(points) > 1
  ) {
    if(is.null(method) || method == "mean") {
      if(confidence.interval != "none") {
        confidence.interval.values = matrix(
          c(as.vector(t.test(points[,1], conf.level = 0.95)$conf.int), as.vector(t.test(points[,2], conf.level = 0.95)$conf.int)),
          ncol=2
        );
      }
      if(outlier.interval != "none") {
        outlier.interval.values = c(IQR(points[,1]), IQR(points[,2])) * 1.5;
        outlier.interval.values = matrix(rep(outlier.interval.values, 2), ncol = 2, byrow = T) * c(-1, 1)
      }

      if(length(unique(colors)) > 1) {
        points = t(sapply(unique(colors), function(color) colMeans(points[color == colors,]), simplify = T))
        colors = unique(colors)
        attr(enaplot, "means") <- length(attr(enaplot, "means")) + length(colors)
      } else {
        points = colMeans(points);
        attr(enaplot, "means") <- length(attr(enaplot, "means")) + 1
      }
    }
    else {
      if(confidence.interval != "none") warning("Confidence Intervals can only be used when method=`mean`")
      if(outlier.interval != "none") warning("Outlier Intervals can only be used when method=`mean`")

      points = apply(points, 2, function(x) do.call(method, list(x)) )
      attr(enaplot, "means") <- length(attr(enaplot, "means")) + 1
    }
  }

  enaplot <- ena.plot.points(
    enaplot,
    points = points,
    labels = labels,
    colors = colors,
    shape = shape,
    confidence.interval = confidence.interval,
    confidence.interval.values = confidence.interval.values,
    outlier.interval = outlier.interval,
    outlier.interval.values = outlier.interval.values,
    label.offset = label.offset,
    label.font.size = label.font.size,
    label.font.color = label.font.color,
    label.font.family = label.font.family,
    show.legend = show.legend,
    legend.name = legend.name,
    ...
  )
  return(enaplot)

  #
  # group.layout = data.frame(dfDT.points);
  #
  # ### INTERVAL CALCULATIONS
  # error = NULL;
  # lines = list();
  #
  # if(confidence.interval == "crosshair") {
  #   ci.x = t.test(points.raw, conf.level = .95)$conf.int[1];
  #   ci.y = t.test(points.raw, conf.level = .95)$conf.int[2];
  #   error = list(
  #     x = list(type = "data", array = ci.x),
  #     y = list(type = "data", array = ci.y)
  #   )
  # } else if(outlier.interval == "crosshair") {
  #   oi.x = IQR(points.raw$V1) * 1.5;
  #   oi.y = IQR(points.raw$V2) * 1.5;
  #   error = list(
  #     x = list(type = "data", array = oi.x),
  #     y = list(type = "data", array = oi.y)
  #   )
  # }
  #
  # if(confidence.interval == "box") {
  #
  #   conf.ints = t.test(points.raw, conf.level = .95)$conf.int;
  #   dfDT.points[,c("ci.x", "ci.y") := .(conf.ints[1], conf.ints[2])]
  #
  #   #add cols for coordinates of CI lines
  #   dfDT.points[, c("ci.x1", "ci.x2", "ci.y1", "ci.y2") := .(V1 - ci.x, V1 + ci.x, V2 - ci.y, V2 + ci.y)]
  #
  #   lines.CI = apply(dfDT.points,1,function(x) {
  #     list(
  #       "type" = "square",
  #       "line" = list(
  #         width = 1,
  #         color = color,
  #         dash="dash"
  #       ),
  #       "xref" = "x",
  #       "yref" = "y",
  #       "x0" = x[['ci.x1']],
  #       "x1" = x[['ci.x2']],
  #       "y0" = x[['ci.y1']],
  #       "y1" = x[['ci.y2']]
  #     );
  #   });
  #   lines = lines.CI;
  # }
  # if(outlier.interval == "box") {
  #
  #   oi.x = IQR(points.raw$V1) * 1.5;
  #   oi.y = IQR(points.raw$V2) * 1.5;
  #
  #   dfDT.points[,c("oi.x", "oi.y") := .(oi.x, oi.y)]
  #
  #   #add cols for coordinates of CI lines
  #   dfDT.points[, c("oi.x1", "oi.x2", "oi.y1", "oi.y2") := .(V1 - oi.x, V1 + oi.x, V2 - oi.y, V2 + oi.y)]
  #
  #   lines.OI = apply(dfDT.points,1,function(x) {
  #     list(
  #       "type" = "square",
  #       "line" = list(
  #         width = 1,
  #         color = color,
  #         dash="dash"
  #       ),
  #       "xref" = "x",
  #       "yref" = "y",
  #       "x0" = x[['oi.x1']],
  #       "x1" = x[['oi.x2']],
  #       "y0" = x[['oi.y1']],
  #       "y1" = x[['oi.y2']]
  #     );
  #   });
  #
  #   lines = c(lines, lines.OI);
  # }
  #
  #
  # if(!is.null(error)) {
  #   #plot group w/ crosshair error bars
  #   enaplot$plot = plotly::add_trace(
  #     enaplot$plot,
  #     data = group.layout,
  #     type="scatter",
  #     x = ~V1, y = ~V2,
  #     mode="markers",
  #     marker = list(
  #       symbol =  shape,
  #       color = color,
  #       size = size
  #     ),
  #     error_x = error$x,
  #     error_y = error$y,
  #     showlegend = F,
  #     text = label,
  #     hoverinfo = "text+x+y"
  #   )
  # } else {
  #   #plot group w/o crosshair error bars
  #   enaplot$plot = plotly::add_trace(
  #     enaplot$plot,
  #     data = group.layout,
  #     type="scatter",
  #     x = ~V1, y = ~V2,
  #     mode="markers",
  #     marker = list(
  #       symbol =  shape,  #c(rep("circle",nrow(data)),rep("square", ifelse(!is.null(dfDT.groups), nrow(dfDT.groups), 0))),
  #       color = color,
  #       #size = c(rep(unit.size * unit.size.multiplier, nrow(data)), rep(group.size, ifelse(!is.null(dfDT.groups),nrow(dfDT.groups), 0)))
  #       size = size
  #     ),
  #     showlegend = F,
  #     text = label,
  #     hoverinfo = "text+x+y"
  #   )
  # }
  #
  # ##### WEIGHTING OFFSET
  # if(is.null(label.offset)) { label.offset = c(.05,.05) }
  # else label.offset = c(label.offset[1] * 0.1, label.offset[2] * 0.1)
  #
  # enaplot$plot = plotly::add_annotations(
  #   enaplot$plot,
  #   x = group.layout$V1[1] + label.offset[1],
  #   y = group.layout$V2[1] + label.offset[2],
  #   text = label,
  #   font = text.info,
  #   xref = "x",
  #   yref = "y",
  #   ax = label.offset[1],
  #   ay = label.offset[2],
  #   #xanchor = "left",
  #   showarrow = F
  # );
  #
  # enaplot$plot = plotly::layout(
  #   enaplot$plot,
  #   shapes = lines
  #   #annotations = label.info
  # )
  #
  # return(enaplot);
}

#####
#' @title Plot of ENA trajectories
#'
#' @description Function used to plot trajectories
#'
#' @export
#'
#' @param enaplot \code{\link{ENAplot}} object to use for plotting
#' @param points dataframe of matrix - first two column are X and Y coordinates, each row is a point in a trajectory
#' @param by vector used to subset points into individual trajectories, length nrow(points)
#' @param names character vector - labels for each trajectory of points, length length(unique(by))
#' @param labels character vector - point labels, length nrow(points)
#' @param labels.show A character choice: Always, Hover, Both.  Default: Both
#' @param colors A character vector, that determines marker color, default NULL results in
#' alternating random colors. If single color is supplied, it will be used for all
#' trajectories, otherwise the length of the supplied color vector should be equal
#' to the length of the supplied names (i.e a color for each trajectory being plotted)
#' @param shape A character which determines the shape of markers, choices: square, triangle, diamond, circle, default: circle
#' @param label.offset A numeric vector of an x and y value to offset labels from the coordinates of the points
#' @param label.font.size An integer which determines the font size for labels, default: enaplot$font.size
#' @param label.font.color A character which determines the color of label font, default: enaplot$font.color
#' @param label.font.family A character which determines font type, choices: Arial, Courier New, Times New Roman, default: enaplot$font.family
#' @param default.hidden A logical indicating if the trajectories should start hidden (click on the legend to show them) Default: FALSE
#' @param smooth Character choice: "none" (connect discrete points) or "poly" (fit orthogonal polynomial curve with LOOCV-2D). Default: "none"
#' @param poly.degree Fixed integer polynomial degree (default NULL = auto-select via LOOCV-2D / AIC)
#' @param poly.max.degree Maximum polynomial degree to search when auto-selecting (default: 3)
#' @param poly.criterion Criterion for polynomial degree selection: "loocv" or "aic"
#' @param poly.n.eval Number of evaluation points along the curve (default: 200)
#' @param show.points Logical: whether to display original discrete points when smooth = "poly" (default: TRUE)
#' @param show.curve Logical: whether to display smooth polynomial curve when smooth = "poly" (default: TRUE)
#'
#' @seealso \code{\link{ena.plot}}
#'
#' @examples
#' data(RS.data)
#'
#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
#'   'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
#'
#' accum = ena.accumulate.data(
#'   units = RS.data[,c("UserName","Condition")],
#'   conversation = RS.data[,c("GroupName","ActivityNumber")],
#'   metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post","C.Change")],
#'   codes = RS.data[,codeNames],
#'   window.size.back = 4,
#'   model = "A"
#' );
#'
#' set = ena.make.set(accum);
#'
#' ### get mean network plots
#' first.game.lineweights = as.matrix(set$line.weights$Condition$FirstGame)
#' first.game.mean = colMeans(first.game.lineweights)
#'
#' second.game.lineweights = as.matrix(set$line.weights$Condition$SecondGame)
#' second.game.mean = colMeans(second.game.lineweights)
#'
#' subtracted.network = first.game.mean - second.game.mean
#'
#' # Plot dimension 1 against ActivityNumber metadata
#' dim.by.activity = cbind(
#'     as.matrix(set$points)[,1],
#'     set$trajectories$ActivityNumber * .8/14-.4  #scale down to dimension 1
#' )
#'
#' plot = ena.plot(set)
#' plot = ena.plot.network(plot, network = subtracted.network, legend.name="Network")
#' plot = ena.plot.trajectory(
#'   plot,
#'   points = dim.by.activity,
#'   names = unique(set$model$unit.label),
#'   by = set$trajectories$ENA_UNIT
#' );
#' print(plot)
#'
#' @return The \code{\link{ENAplot}} provided to the function, with its plot updated to include the trajectories
#' #####
ena.plot.trajectory = function(
  enaplot,
  points,
  by = NULL,
  labels = NULL,
  labels.show = c("Always","Hover","Both"),
  names = NULL,
  label.offset = NULL,
  label.font.size = enaplot$get("font.size"),
  label.font.color = enaplot$get("font.color"),
  label.font.family = c("Arial", "Courier New", "Times New Roman"),
  shape = c("circle", "square", "triangle-up", "diamond"),
  colors = NULL,
  default.hidden = FALSE,
  smooth = c("none", "poly"),
  poly.degree = NULL,
  poly.max.degree = 3L,
  poly.criterion = c("loocv", "aic"),
  poly.n.eval = 200L,
  show.points = TRUE,
  show.curve = TRUE
) {
  if (.qe_backend(enaplot)) {
    .qe_no_trajectories("ena.plot.trajectory")
    return(enaplot)
  }

  if(!is.character(label.font.family)) {
    label.font.size = enaplot$get("font.family");
  }
  labels.show <- match.arg(labels.show);
  shape <- match.arg(shape);
  smooth <- match.arg(smooth);
  poly.criterion <- match.arg(poly.criterion);

  if(is.null(by)) {
    by <- list(all = rep(TRUE, nrow(points)));
  }
  if (is.character(by) && length(by) == 1L && by %in% names(points)) {
    by <- points[[by]]
  }

  if (is(points, "ena.matrix") || any(find_meta_cols(points))) {
    clean_points <- remove_meta_data(points)
  } else {
    clean_points <- points
  }

  if(length(colors) == 1 && !is.null(names))
    colors <- rep(colors, length(names))

  mode <- "lines+markers+text";
  hoverinfo <- "x+y";
  tbl <- data.table::as.data.table(clean_points);
  if (!is.null(labels)) {
    if (labels.show %in% c("Always","Both"))
      mode <- paste0(mode,"+text");
    if (labels.show %in% c("Hover","Both"))
      hoverinfo <- paste0(hoverinfo,"+text");

    tbl[, labels := labels]
  }

  if(!is.null(by)) {
    if(is.character(by) && length(by) == nrow(tbl))
        by <- as.factor(by)

    dfdt_trajs <- tbl[,{ data.table::data.table(lines = list(.SD))  }, by = by]
  } else {
    dfdt_trajs <- tbl[,{ data.table::data.table(lines = list(.SD))  }]
  }

  valid_label_offsets = c("top left","top center","top right","middle left",
              "middle center","middle right","bottom left","bottom center",
              "bottom right")
  if(!all(label.offset %in% valid_label_offsets))
    stop(sprintf( "Unrecognized label.offsets: %s",
      paste(unique(label.offset[!(label.offset %in% valid_label_offsets)]),
      collapse = ", ") ))

  if(length(label.offset) == 1)
    label.offset = rep(label.offset, nrow(dfdt_trajs))

  if (!is.null(colors) &&
      length(colors) > 1 && !is.null(names) && length(colors) != length(names)
  ) {
    stop("Length of the colors must be 1 or the same length as by")
  }

  for (x in 1:nrow(dfdt_trajs)) {
    d <- as.data.frame(dfdt_trajs[x,]$lines[[1]])
    d.names <- colnames(d)
    traj_name <- if (!is.null(names) && length(names) >= x) names[x] else paste0("Trajectory ", x)
    traj_color <- if(!is.null(colors) && length(colors) >= x) colors[x] else NULL

    if (smooth == "poly" && nrow(d) >= 2L && ncol(d) >= 2L) {
      curve_fit <- .fit_etm_poly_curve(
        points = d[, 1:2, drop = FALSE],
        degree = poly.degree,
        max_degree = poly.max.degree,
        criterion = poly.criterion
      )

      # Smooth curve evaluation
      if (isTRUE(show.curve)) {
        curve_df <- .eval_etm_poly_curve(curve_fit, poly.n.eval)

        enaplot$plot = plotly::add_trace(
          enaplot$plot,
          data = curve_df,
          x = ~x,
          y = ~y,
          name = paste0(traj_name, " (fit deg ", curve_fit$degree, ")"),
          mode = "lines",
          hoverinfo = "none",
          showlegend = !isTRUE(show.points),
          line = list (
            color = traj_color,
            width = 2.5
          ),
          visible = ifelse(default.hidden, "legendonly", TRUE)
        )
      }

      # Original discrete points
      if (isTRUE(show.points)) {
        pts_mode <- if (!is.null(labels) && labels.show %in% c("Always", "Both")) "markers+text" else "markers"
        enaplot$plot = plotly::add_trace(
          enaplot$plot,
          data = d,
          x = as.formula(paste0("~", d.names[1])),
          y = as.formula(paste0("~", d.names[2])),
          name = traj_name,
          mode = pts_mode,
          text = dfdt_trajs[x,]$lines[[1]]$labels,
          textposition = label.offset[x],
          hoverinfo = hoverinfo,
          showlegend = TRUE,
          marker = list (
            symbol = shape,
            color = traj_color,
            size = 6
          ),
          textfont = list (
            family = label.font.family,
            size = label.font.size,
            color = label.font.color
          ),
          visible = ifelse(default.hidden, "legendonly", TRUE)
        )
      }
    } else {
      # Standard piecewise linear trajectory
      enaplot$plot = plotly::add_trace(
        enaplot$plot,
        data = d,
        x = as.formula(paste0("~", d.names[1])),
        y = as.formula(paste0("~", d.names[2])),
        name = traj_name,
        mode = mode,
        text = dfdt_trajs[x,]$lines[[1]]$labels,
        textposition = label.offset[x],
        hoverinfo = hoverinfo,
        showlegend = TRUE,
        line = list (
          color = traj_color
        ),
        marker = list (
          symbol = shape,
          color = traj_color
        ),
        textfont = list (
          family = label.font.family,
          size = label.font.size,
          color = label.font.color
        ),
        visible = ifelse(default.hidden, "legendonly", TRUE)
      );
    }
  }

  enaplot$plotted$trajectories[[
    length(enaplot$plotted$trajectories) + 1
  ]] <- dfdt_trajs

  return(enaplot);
}

#' Compute Between-Group Scatter Matrix
#'
#' This function calculates the between-group scatter matrix (\code{SB}) for a given numeric matrix and grouping variable.
#'
#' @param A A numeric matrix of dimensions \code{m x n}, where rows represent observations and columns represent features.
#' @param g A grouping variable of length \code{m}, either a factor or a character vector, indicating group membership for each observation.
#'
#' @return A numeric matrix representing the between-group scatter matrix (\code{SB}).
#'
#' @details
#' The function computes the total mean of the matrix \code{A} and the mean for each group defined by \code{g}.
#' It then calculates the between-group scatter matrix by summing the outer product of the mean differences, weighted by the group sizes.
#'
#' @examples
#' # Example usage:
#' A <- matrix(rnorm(20), nrow = 5, ncol = 4)
#' g <- factor(c("A", "B", "A", "B", "A"))
#' SB <- rENA:::compute_SB(A, g)
compute_SB <- function(A, g) {
  if (!is.matrix(A)) stop("A must be a numeric matrix.")
  if (length(g) != nrow(A)) stop("g must have the same length as number of rows in A.")

  g <- as.factor(g);
  groups <- levels(g);
  n_features <- ncol(A);
  m <- nrow(A);

  # Total mean
  mu_total <- colMeans(A);

  # Initialize matrices
  SB <- matrix(0, n_features, n_features);

  for (grp in groups) {
    idx <- which(g == grp);
    A_grp <- A[idx, , drop = FALSE];
    n_g <- nrow(A_grp);
    mu_g <- colMeans(A_grp);

    # Between-group component
    mean_diff <- matrix(mu_g - mu_total, ncol = 1);
    SB <- SB + n_g * (mean_diff %*% t(mean_diff));
  }

  return(SB);
}


#' Generalized Means Rotation (GMR) with optional subsetting and interaction control
#'
#' Computes a rotation (direction) `r` representing the contribution of the
#' first column of `X` to the multivariate ENA matrix `V`. Supports optional
#' subsetting by `groups`, optional inclusion of interaction terms when
#' computing adjusted contributions.
#'
#' @param V Numeric ENA matrix (units x connections) ready for rotation.
#' @param X Data frame or matrix of predictors; the first column is the target.
#' @param groups Optional vector specifying target groups to subset. If `NULL`
#'   (default), all rows are used.
#' @param alpha Elastic-net mixing parameter forwarded to `get_x1_main_effect`
#'   (default `1` - Lasso).
#' @param lambda Lambda selection for `cv.glmnet` forwarded to
#'   `get_x1_main_effect` (default `"lambda.min"`).
#' @param interactions Logical; if `TRUE` (default) interactions are included when computing the adjusted contribution.
#' @param verbose Logical; if `TRUE` (default) the function emits messages about
#'   fails or successes.
#'
#' @return A numeric vector `r` (length = ncol(V)) giving the normalized
#'   rotation direction. Attributes attached:
#'   \describe{
#'     \item{`target`}{The full-length target vector (un-subsetted).}
#'     \item{`Vx1`}{The unadjusted fitted values (`lm(V ~ target)`) embedded in
#'         a full-length matrix (rows outside subset filled with zeros).}
#'   }
#'   If no valid direction can be found (including SVD failure), returns `NULL`
#'   and issues a warning.
#'
#' @examples
#' \dontrun{
#' set.seed(1)
#' V <- matrix(rnorm(200), nrow = 40)
#' X <- data.frame(group = rep(letters[1:4], each = 10),
#'                 x2 = rnorm(40), x3 = rnorm(40))
#' r_all <- gmr2(V, X)
#' r_subset <- gmr2(V, X, groups = c("a", "b"), interactions = TRUE)
#' }
#'
#' @seealso [get_x1_main_effect()]
#' @importFrom stats lm model.matrix
#' @importFrom glmnet cv.glmnet
#' @export

gmr <- function(V, X, groups = NULL, alpha = 1, lambda = "lambda.min",
  interactions = TRUE, verbose = TRUE) {
  # prepare a function for almost zero check
  is_zero <- function(x, tol = 1e-12) all(abs(x) < tol)
  # get full target variable, namely, the first variable in X
  target_full <- X[[1]]
  if (is.list(target_full)) target_full <- unlist(target_full, recursive = FALSE)
  target_full <- as.vector(target_full)

  # --- Fail if target is constant ---
  unique_targets <- unique(target_full)
  if (length(unique_targets) == 1) {
    warning("Target variable is constant; returning NULL.")
    return(NULL)
  }

  # --- Subset by groups if selected groups are provided ---
  if (!is.null(groups)) {
    valid_groups <- intersect(groups, unique(target_full))
    if (length(valid_groups) > 1) {
      subset_idx <- which(target_full %in% valid_groups)
      V_sub <- V[subset_idx, , drop = FALSE]
      X_sub <- X[subset_idx, , drop = FALSE]
      target_sub <- target_full[subset_idx]
    } else {
      warning("Less than 2 valid groups selected; returning NULL.")
      return(NULL)
    }
  } else { # use full data if no groups are selected
    V_sub <- V
    X_sub <- X
    target_sub <- target_full
    subset_idx <- NULL
  }

  # --- Base regression model ---
  model <- lm(V_sub ~ target_sub)
  Vx1_sub <- model$fitted.values

  # --- Compute contributions via Lasso (if covariates exist) ---
  Vx_sub <- NULL
  if (ncol(X_sub) == 1) { # no corariates, use base model
    Vx_sub <- Vx1_sub
  } else { # covariates exist, use Lasso model
    Vx_sub <- get_x1_main_effect(V_sub, X_sub, alpha = alpha,
                                 lambda = lambda, include_interactions = interactions)
  }
  if (is_zero(Vx_sub)) {
    warning("Regression resulted in zeor contribution; returning NULL.")
    return(NULL)
  }
  # --- Compute rotation direction r ---
  r <- NULL
  if (is.numeric(target_sub)) {
    if (verbose) message("Computing direction for numeric target...")
    model =  model <- lm(Vx_sub ~ target_sub)
    beta <- model$coefficients[2,]
    if (is_zero(beta)) {
      warning("Numerical target with zero beta; returning NULL.")
      return(NULL)
    } else {
      r <- beta
    }
  } else {
    if (verbose) message("Computing direction for categorical target...")
    sb <- compute_SB(Vx_sub, target_sub)
    r <- tryCatch(svd(sb)$v[, 1], error = function(e) NULL)
  }

  # --- Final SVD fallback if r is NULL or zero ---
  if (is.null(r) || all(r == 0)) {
    warning("Uable to compute any valid direction; returning NULL.")
    return(NULL)
  }

  # --- Normalize ---
  r <- r / sqrt(sum(r^2))

  # --- Build full-length Vx1 ---
  Vx1_full <- matrix(0, nrow = nrow(V), ncol = ncol(V))
  Vx1_full[subset_idx %||% seq_len(nrow(V)), ] <- Vx_sub
  colnames(Vx1_full) <- colnames(V)

  # --- Attach metadata ---
  attr(r, "target") <- target_full
  attr(r, "Vx1") <- Vx1_full
  #attr(r, "fallback_stage") <- fallback_stage

  if (verbose) message(" gmr completed successfully ")
  return(r)
}

#' Extract the Main Effect of X on V with Optional Interactions
#'
#' Computes the main-effect contribution of the first column of `X` (the
#' "target") to the multivariate ENA matrix `V`. The function fits penalized
#' regression models (via glmnet) and can optionally include interactions
#' between the target and other covariates. It returns the fitted contribution
#' matrix (units x connections).
#'
#' The function can compute contributions using either only main-effect columns
#' (no interactions) or main-effect plus all interaction columns that start
#' with the target name. If no matching columns are found or all fitted
#' coefficients are zero, the function returns a zero matrix and emits a
#' warning.
#'
#' @param V A numeric matrix (units x connections) of dependent variables.
#' @param X A data frame or matrix of predictors / covariates. The **first**
#'   column is treated as the target variable whose contribution will be extracted.
#' @param alpha Elastic-net mixing parameter passed to `cv.glmnet`. `alpha = 1`
#'   (default) is Lasso; `alpha = 0` is ridge.
#' @param lambda Character or numeric. Which lambda from the `cv.glmnet` fit to
#'   use; e.g. `"lambda.min"` (default) or `"lambda.1se"`, or a numeric value.
#' @param include_interactions Logical; if `TRUE`, include main-effect columns
#'   **and** all interaction columns that begin with the target name (default:
#'   `FALSE`, only main-effect columns).
#'
#' @return A numeric matrix with the same dimensions as `V` containing the
#'   estimated contribution of `X[,1]` to each response. If no columns are
#'   matched or all coefficients are zero, a zero matrix is returned and a
#'   warning is issued.
#'
#' @details
#' Internally this function builds `model.matrix(~ .^2, data = X)` to obtain
#' main effects and pairwise interactions. It sets a `penalty.factor` that
#' leaves the target-related columns unpenalized (0) and fits a multivariate
#' `glmnet` (`family = "mgaussian"`). The returned matrix is dense (numeric).
#'
#' @examples
#' \dontrun{
#' set.seed(1)
#' V <- matrix(rnorm(50), ncol = 5)
#' X <- data.frame(CONFIDENCE = rnorm(10), Condition = factor(rep(1:2, 5)))
#' # main effects only
#' Vx_main <- get_x1_main_effect(V, X, include_interactions = FALSE)
#' # include interactions
#' Vx_full <- get_x1_main_effect(V, X, include_interactions = TRUE, alpha = 0) # ridge
#' }
#'
#' @seealso [gmr2()] for the rotation routine that uses this function.
#' @importFrom stats lm model.matrix
#' @importFrom glmnet cv.glmnet
#' @export

get_x1_main_effect <- function(V, X, alpha = 1, lambda = "lambda.min", include_interactions = FALSE) {
  x1_name <- colnames(X)[1]

  # 1. Formula & Model Matrix
  formula_str <- if (include_interactions) "~ .^2" else "~ ."
  mm <- model.matrix(as.formula(formula_str), data = X)[, -1, drop = FALSE]

  # 2. Identify Main Effect Columns for x1
  safe_x1 <- gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", x1_name)
  x1_main_regex <- paste0("^", safe_x1, "[^:]*$")
  x1_cols <- grep(x1_main_regex, colnames(mm))

  if (length(x1_cols) == 0) {
    warning("No main effect columns found for X[,1]; returning zeros.")
    return(matrix(0, nrow = nrow(V), ncol = ncol(V), dimnames = list(NULL, colnames(V))))
  }

  # 3. Penalty Factors
  p <- ncol(mm)
  penalty_factors <- rep(1, p)
  penalty_factors[x1_cols] <- 0

  # 4. Fitting Logic
  x1_contribution <- matrix(0, nrow = nrow(V), ncol = ncol(V), dimnames = list(NULL, colnames(V)))
  use_ols <- (p <= (nrow(X) - 10)) # Heuristic: Use OLS only if we have enough degrees of freedom

  if (!use_ols) {
    fit <- tryCatch(
      # We add lower.limits/upper.limits or tiny penalty to ensure x1 is NEVER zero if it has signal
      glmnet::cv.glmnet(x = mm, y = V, family = "mgaussian",
                        alpha = alpha, penalty.factor = penalty_factors),
      error = function(e) NULL
    )

    if (!is.null(fit)) {
      coefs_list <- coef(fit, s = lambda)
      # coefs_list is a list of sparse matrices (one per response)
      for (i in seq_along(coefs_list)) {
        # Extract coefs, skipping intercept ([1,])
        # Force to numeric to avoid sparse matrix indexing issues
        beta_all <- as.matrix(coefs_list[[i]])[-1, , drop = FALSE]
        beta_x1 <- beta_all[x1_cols, , drop = FALSE]
        x1_contribution[, i] <- mm[, x1_cols, drop = FALSE] %*% beta_x1
      }
      return(x1_contribution)
    }
    use_ols <- TRUE
  }

  if (use_ols) {
    fit_ols <- lm(V ~ mm)
    # as.matrix handles the 'incorrect number of dimensions' for single response
    beta_ols <- as.matrix(coef(fit_ols))[-1, , drop = FALSE]
    beta_x1_ols <- beta_ols[x1_cols, , drop = FALSE]

    # Handle NAs that OLS produces for rank-deficient matrices
    beta_x1_ols[is.na(beta_x1_ols)] <- 0
    x1_contribution <- mm[, x1_cols, drop = FALSE] %*% beta_x1_ols
  }

  return(x1_contribution)
}


## ── qeviz interactive plot integration ───────────────────────────────────────
##
## Public API (thin wrappers over the qeviz package)
##   ena.plot.interactive()   — create an interactive qeviz htmlwidget
##   ena.export.html()        — write a self-contained HTML file
##   enaInteractiveOutput()   — Shiny output binding
##   renderEnaInteractive()   — Shiny render function
##
## The widget, its JavaScript bundle and the ena.set -> ModelData conversion
## live in qeviz (qe_plot(), qe_widget(), qeOutput(), renderQe()).
## ─────────────────────────────────────────────────────────────────────────────


.require_qeviz <- function() {
  if (!requireNamespace("qeviz", quietly = TRUE) || utils::packageVersion("qeviz") < "0.5.0") {
    stop("The 'qeviz' package (>= 0.5.0) is required for interactive plots. Install with:\n",
         "  install.packages(\"qeviz\", repos = c(\"https://cran.qe-libs.org\", getOption(\"repos\")))",
         call. = FALSE)
  }
}

#' Interactive ENA plot using qeviz
#'
#' Renders an interactive ENA plot inside RStudio, R Markdown / Quarto, and
#' Shiny using the qeviz visualization library. This is a shortcut for a
#' \code{qeviz::qe_plot()} chain; use qeviz directly for full control.
#'
#' @param set         An \code{\link{ena.make.set}} result.
#' @param group_col   Character. Name of the grouping column in \code{set$points}
#'                    (e.g. \code{"Condition"}).  Controls point colours and group
#'                    mean networks.
#' @param group       Character. Which group's mean network to display.  Defaults
#'                    to the first group.
#' @param unit        Character. A specific unit ID to display its individual
#'                    network instead of a group mean.
#' @param compare     Character. Second group or unit for a subtraction view
#'                    (\code{group} minus \code{compare}).
#' @param also        Character. Second group for an overlay view (both networks
#'                    drawn simultaneously).
#' @param dim_cols    Character vector of two dimension names to plot.
#'                    Default \code{c("SVD1", "SVD2")}.
#' @param label_nodes \code{"on"} | \code{"off"} | \code{"auto"} | \code{"click"}.
#'                    Visibility of code-node labels.  Default \code{"on"}.
#' @param label_means Visibility of group-mean labels.  Default \code{"on"}.
#' @param label_points Visibility of unit-point labels.  Default \code{"off"}.
#' @param confidence  Logical. Draw the confidence interval box around each
#'                    shown group mean. Default \code{TRUE}.
#' @param outlier     Logical. Also draw the outlier interval (Q1 - 1.5 IQR to
#'                    Q3 + 1.5 IQR). Default \code{FALSE}.
#' @param scale_points Logical. Rescale unit points to match the node coordinate
#'                    space.  Default \code{TRUE}.
#' @param conf_level  Numeric. Confidence level for CI boxes. Default \code{0.95}.
#' @param iqr_factor  Deprecated; the outlier interval always uses 1.5 IQR.
#' @param width,height Widget size in pixels or CSS units.  \code{NULL} uses
#'                    the qeviz defaults (100\% x 440).
#'
#' @return An \code{htmlwidget} object that renders in RStudio Viewer, R Markdown,
#'   Quarto, and Shiny.
#'
#' @examples
#' \dontrun{
#' data(RS.data)
#' codeNames <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'                "Client.and.Consultant.Requests", "Design.Reasoning", "Collaboration")
#' accum <- ena.accumulate.data(
#'   units        = RS.data[, c("UserName", "Condition")],
#'   conversation = RS.data[, c("Condition", "GroupName")],
#'   codes        = RS.data[, codeNames],
#'   window.size.back = 4
#' )
#' set <- ena.make.set(enadata = accum)
#'
#' # Basic plot coloured by Condition
#' ena.plot.interactive(set, group_col = "Condition")
#'
#' # Show only FirstGame mean network
#' ena.plot.interactive(set, group_col = "Condition", group = "FirstGame")
#'
#' # Subtraction: FirstGame minus SecondGame
#' ena.plot.interactive(set, group_col = "Condition",
#'                      group = "FirstGame", compare = "SecondGame")
#' }
#'
#' @export
ena.plot.interactive <- function(
  set,
  group_col     = NULL,
  group         = NULL,
  unit          = NULL,
  compare       = NULL,
  also          = NULL,
  dim_cols      = c("SVD1", "SVD2"),
  label_nodes   = "on",
  label_means   = "on",
  label_points  = "off",
  confidence    = TRUE,
  outlier       = FALSE,
  scale_points  = TRUE,
  conf_level    = 0.95,
  iqr_factor    = 1.5,
  width         = NULL,
  height        = NULL
) {
  .require_qeviz()
  if (!missing(iqr_factor) && !identical(iqr_factor, 1.5))
    warning("ena.plot.interactive(): iqr_factor is deprecated and ignored; ",
            "the outlier interval uses 1.5 IQR.", call. = FALSE)

  p <- qeviz::qe_plot(set, dims = dim_cols, scale_points = scale_points,
                      group_col = group_col,
                      width  = if (is.null(width)) "100%" else width,
                      height = if (is.null(height)) 440 else height)

  # A group mean network: the requested group, else the first group (as
  # before). A unit network is drawn instead when `unit` is given.
  groups <- if (is.null(group_col)) character(0)
            else unique(as.character(as.data.frame(set$points)[[group_col]]))
  if (is.null(group) && is.null(unit) && length(groups)) group <- groups[1L]
  if (!is.null(group) || !is.null(unit))
    p <- qeviz::qe_edges(p, group = group, unit = unit, compare = compare, also = also)

  # Means (with CI) for the groups whose networks are shown.
  # Means (with CI) for the groups whose networks are shown; none otherwise.
  shown <- intersect(c(group, compare, also), groups)
  p <- if (length(shown))
    do.call(qeviz::qe_group, c(list(p), as.list(shown), list(
      intervals  = if (isTRUE(confidence)) "box" else "none",
      conf_level = conf_level,
      outlier    = isTRUE(outlier))))
  else qeviz::qe_group(p, show = FALSE)

  p <- qeviz::qe_axes(p)
  p <- qeviz::qe_labels(p, nodes = label_nodes, means = label_means, points = label_points)
  qeviz::qe_widget(p)
}

#' Export a self-contained interactive ENA plot as HTML
#'
#' Writes a single \code{.html} file containing the qeviz bundle and embedded
#' model data.  No R, no Python, and no server are required to open the file —
#' share it with collaborators, attach it to a paper submission, or archive it
#' as supplementary material.
#'
#' @param set       An \code{\link{ena.make.set}} result.
#' @param file      Output file path, e.g. \code{"ena_plot.html"}.
#' @param group_col Character. Grouping column in \code{set$points}.
#' @param ...       Additional arguments passed to \code{\link{ena.plot.interactive}}
#'                  (e.g. \code{group}, \code{compare}, \code{label_nodes}).
#' @param width,height Plot dimensions in pixels. Default 700 × 600.
#' @param selfcontained Logical. Inline the qeviz bundle in the HTML file.
#'                    Default \code{TRUE}.  Set to \code{FALSE} to reference the
#'                    bundle via a relative path (smaller file, not portable).
#'
#' @return The resolved absolute path of the written file (invisibly).
#'
#' @examples
#' \dontrun{
#' set <- ena.make.set(enadata = accum)
#' ena.export.html(set, "model.html", group_col = "Condition")
#' }
#'
#' @export
ena.export.html <- function(
  set,
  file,
  group_col     = NULL,
  ...,
  width         = 700L,
  height        = 600L,
  selfcontained = TRUE
) {
  widget <- ena.plot.interactive(
    set,
    group_col = group_col,
    width     = width,
    height    = height,
    ...
  )
  abs_file <- normalizePath(file, mustWork = FALSE)
  htmlwidgets::saveWidget(widget, abs_file, selfcontained = selfcontained)
  message("Written: ", abs_file)
  invisible(abs_file)
}

#' Shiny output binding for interactive ENA plots
#'
#' Equivalent to \code{qeviz::qeOutput()}.
#'
#' @param outputId Shiny output ID.
#' @param width,height CSS dimensions. Defaults: \code{"100\%"}, \code{"600px"}.
#' @export
enaInteractiveOutput <- function(outputId, width = "100%", height = "600px") {
  .require_qeviz()
  qeviz::qeOutput(outputId, width = width, height = height)
}

#' Shiny render function for interactive ENA plots
#'
#' Equivalent to \code{qeviz::renderQe()}; \code{expr} may return an
#' \code{\link{ena.plot.interactive}} widget or a \code{qeviz::qe_plot()}.
#'
#' @param expr    Expression that returns an \code{\link{ena.plot.interactive}} widget.
#' @param env     Environment for \code{expr}. Default: \code{parent.frame()}.
#' @param quoted  Logical. Is \code{expr} already quoted? Default \code{FALSE}.
#' @export
renderEnaInteractive <- function(expr, env = parent.frame(), quoted = FALSE) {
  .require_qeviz()
  if (!quoted) expr <- substitute(expr)
  qeviz::renderQe(expr, env = env, quoted = TRUE)
}

#' @title ENA SVD
#' @description Computes a dimensional reduction of points in an ENA set using Singular Value Decomposition (SVD).
#' @param enaset An \code{ENAset} object containing the points to be reduced.
#' @param params A list of parameters. Use \code{params$as_object = TRUE} to return an ENARotationSet object, or \code{FALSE} (default) to return a list.
#' @details This function computes the SVD of the points in the ENA set and returns either an ENARotationSet object or a list with the rotation matrix, codes, node positions, and eigenvalues, depending on \code{params$as_object}.
#' @return An ENARotationSet object or a list containing:
#'   \item{rotation}{The rotation matrix from SVD}
#'   \item{codes}{The code names used for the matrix}
#'   \item{node.positions}{(Currently NULL) Node positions}
#'   \item{eigenvalues}{The eigenvalues (squared singular values) from SVD}
#' @examples
#' data(RS.data)
#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'            "Client.and.Consultant.Requests", "Design.Reasoning",
#'            "Collaboration")
#' units <- c("Condition", "UserName")
#' horizon <- c("Condition", "GroupName")
#' enaset <- RS.data |>
#'   accumulate(units, codes, horizon) |>
#'   model()
#' # SVD as list:
#' svd_result <- ena.svd(enaset, list(as_object = FALSE))
#' # SVD as ENARotationSet object:
#' svd_obj <- ena.svd(enaset, list(as_object = TRUE))
#' @export
ena.svd <- function(enaset, params) {
  # to.norm = data.table::data.table(
  #   enaset$points.normed.centered,
  #   enaset$enadata$unit.names
  # )
  # to.norm = as.matrix(to.norm[,tail(.SD,n=1),.SDcols=colnames(to.norm)[which(colnames(to.norm) != "V2")],by=c("V2")][,2:ncol(to.norm)]);
  # pcaResults = pca_c(to.norm, dims = enaset$get("dimensions"));
  # pcaResults = pca_c(enaset$points.normed.centered, dims = enaset$get("dimensions"));
  as_object = FALSE;
  if(!is.null(params$as_object)) {
    as_object = params$as_object
  }

  # pts = enaset$model$points.for.projection[,!colnames(enaset$model$points.for.projection) %in% colnames(enaset$meta.data), with=F]
  pts = as.matrix(enaset$model$points.for.projection)
  pcaResults = prcomp(pts, retx=FALSE, scale=FALSE, center=FALSE, tol=0)

  ### used to be  enaset$data$centered$pca
  #enaset$rotation.set = pcaResults$pca;


  colnames(pcaResults$rotation) = c(
    paste('SVD',as.character(1:ncol(pcaResults$rotation)), sep='')
  );

  # rotationSet = ENARotationSet$new(rotation = pcaResults$pca, codes = enaset$codes, node.positions = NULL, eigenvalues = pcaResults$latent)
  if(isTRUE(as_object)) {
    rotationSet = ENARotationSet$new(
      rotation = pcaResults$rotation,
      codes = enaset$rotation$codes,
      node.positions = NULL,
      eigenvalues = pcaResults$sdev^2
    )
  }
  else {
    rotationSet <- list(
      rotation = pcaResults$rotation,
      codes = enaset$rotation$codes,
      node.positions = NULL,
      eigenvalues = pcaResults$sdev^2
    )
  }
  return(rotationSet)
}

ena.svd.R6 <- function(enaset, ...) {
  pcaResults = prcomp(enaset$points.normed.centered, retx=FALSE,scale=FALSE,center=FALSE, tol=0)

  colnames(pcaResults$rotation) = c(
    paste('SVD',as.character(1:ncol(pcaResults$rotation)), sep='')
  );

  rotationSet = ENARotationSet$new(
    rotation = pcaResults$rotation, codes = enaset$codes,
    node.positions = NULL, eigenvalues = pcaResults$sdev^2
  )
  return(rotationSet)
}

##
#' @title Generate ENA Set
#'
#' @description Generates an ENA model by constructing a dimensional reduction of adjacency (co-occurrence) vectors in an ENA data object
#'
#' @details This function generates an ENAset object from an ENAdata object. Takes
#' the adjacency (co-occurrence) vectors from enadata, computes a dimensional
#' reduction (projection), and calculates node positions in the projected ENA
#' space. Returns location of the units in the projected space, as well as
#' locations for node positions, and normalized adjacency (co-occurrence) vectors
#' to construct network graphs
#'
#' @export
#'
#' @param enadata \code{\link{ENAdata}} that will be used to generate an ENA model
#' @param dimensions The number of dimensions to include in the dimensional reduction
#' @param norm.by A function to be used to normalize adjacency (co-occurrence) vectors before computing the dimensional reduction, default: sphere_norm_c()
#' @param rotation.by	A function to be used to compute the dimensional reduction, default: ena.svd()
#' @param rotation.params (optional) A character vector containing additional parameters for the function in rotation.by, if needed
#' @param rotation.set A previously-constructed  ENARotationSet object to use for the dimensional reduction
#' @param endpoints.only A logical variable which determines whether to only show endpoints for trajectory models
#' @param center.align.to.origin A logical variable when TRUE (default) determines aligns both point center and centroid center to the origin
#' @param node.position.method A function to be used to determine node positions based on the dimensional reduction, default: lws.position.es()
#' @param as.list R6 objects will be deprecated, but if this is TRUE, the original R6 object will be returned, otherwise a list with class `ena.set`
#' @param ... additional parameters addressed in inner function
#'
#' @examples
#' data(RS.data)
#'
#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
#'   'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
#'
#' accum = ena.accumulate.data(
#'   units = RS.data[,c("UserName","Condition")],
#'   conversation = RS.data[,c("Condition","GroupName")],
#'   metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post")],
#'   codes = RS.data[,codeNames],
#'   window.size.back = 4
#' )
#'
#' set = ena.make.set(
#'   enadata = accum
#' )
#'
#' set.means.rotated = ena.make.set(
#'   enadata = accum,
#'   rotation.by = ena.rotate.by.mean,
#'   rotation.params = list(
#'       accum$meta.data$Condition=="FirstGame",
#'       accum$meta.data$Condition=="SecondGame"
#'   )
#' )
#'
#' @seealso \code{\link{ena.accumulate.data}}, \code{\link{ENAset}}
#'
#' @return \code{\link{ENAset}} class object that can be further processed for analysis or plotting
##
ena.make.set <- function(
  enadata,
  dimensions = 2,
  norm.by = fun_sphere_norm,
  rotation.by = ena.svd,
  rotation.params = NULL,
  rotation.set = NULL,
  endpoints.only = TRUE,
  center.align.to.origin = TRUE,
  node.position.method = lws.positions.sq,
  as.list = TRUE,
  ...
) {
  if (as.list == F) {
    warning(paste0("Usage of ENAdata and ENAset objects will be deprecated ",
                   "and potentially removed altogether in future versions."))

    if (!is(enadata, "ENAdata")) {
      stop(paste0("Use of ena.make.set with as.list=FALSE requires `enadata` ",
                  "be an ENAdata object. Re-run the accumulation with as.list=FALSE"))
    }

    set <- ENAset$new(
      enadata = enadata,
      dimensions = dimensions,
      rotation.by = ifelse(
        !is.null(rotation.by) && identical(rotation.by, ena.svd),
        ena.svd.R6,
        rotation.by
      ),
      rotation.params = rotation.params,
      rotation.set = rotation.set,
      norm.by = norm.by,
      node.position.method = ifelse(
        identical(node.position.method, lws.positions.sq),
        lws.positions.sq.R6,
        node.position.method
      ),
      endpoints.only = endpoints.only,
      center.align.to.origin = center.align.to.origin,
      ...
    )
    return(set$process());
  }
  else {
    if ("ENAdata" %in% class(enadata)) {
      warning(paste0("Usage of ENAdata objects will be deprecated and ",
                     "potentially removed altogether in future versions. See ",
                     "ena.accumulate.data() or ena.set()."))

      enadata <- ena.set(enadata)
    }

    enadata$`_function.params`$center.align.to.origin <- center.align.to.origin;
    enadata$`_function.params`$rotation.by <- rotation.by;
    enadata$`_function.params`$rotation.params <- rotation.params;

    ###
    # Convert the string vector of code names to their corresponding
    # co-occurence names
    #####
    code_columns <- svector_to_ut(enadata$rotation$codes)

    ###
    # Normalize the raw data using self$function.params$norm.by,
    # which defaults to calling rENA::dont_sphere_norm_c
    #####
    line.weights <- norm.by(as.matrix(enadata$connection.counts))
    colnames(line.weights) <- code_columns

    line.weights.dt <- data.table::as.data.table(line.weights)
    for (i in seq(ncol(line.weights.dt)))
      set(line.weights.dt, j = i,
          value = as.ena.co.occurrence(line.weights.dt[[i]]))

    enadata$line.weights <- cbind(enadata$meta.data, line.weights.dt)
    class(enadata$line.weights) <- c("ena.line.weights", "ena.matrix",
                                     class(enadata$line.weights))
    #####

    ###
    # Center the normed data
    #####
    # if ( inherits(rotation.set, "ena.rotation.set") ) {

    # if ( !is.null(rotation.by) && is.null(rotation.set) ) {
    #   points.for.projection <- center_data_c(line.weights)
    # }
    if ( !is.null(rotation.set)  ) {
      if( inherits(rotation.set, "ena.rotation.set") ) {
        if(center.align.to.origin) {
          points.for.projection <- line.weights

          non_zero_rows <- rowSums(as.matrix(line.weights)) != 0;
          if(sum(non_zero_rows) > 0) {
            points.for.projection[rowSums(as.matrix(line.weights))!=0,] <- center.projection(lws = line.weights[rowSums(as.matrix(line.weights))!=0,], rotation = rotation.set);
          }
          else {
            stop("There were no co-occurrences of codes for any of the units within the model as defined.");
          }
        }
        else {
          points.for.projection <- center.projection(lws = line.weights, rotation = rotation.set);
        }
      }
      else {
        stop("Supplied rotation.set is not an instance of ENARotationSet");
      }
    }
    else {
      if(center.align.to.origin) {
        points.for.projection <- line.weights

        non_zero_rows <- rowSums(as.matrix(line.weights))!=0;
        if(sum(non_zero_rows) > 0) {
          points.for.projection[rowSums(as.matrix(line.weights))!=0,] <- center_data_c(line.weights[rowSums(as.matrix(line.weights))!=0,])
        }
        else {
          stop("There were no co-occurrences of codes for any of the units within the model as defined.");
        }
      }
      else {
        points.for.projection <- center_data_c(line.weights)
      }
    }

    colnames(points.for.projection) <- code_columns;
    enadata$model$points.for.projection = data.table::as.data.table(points.for.projection)
    for (i in seq(ncol(enadata$model$points.for.projection))) {
      set(
        enadata$model$points.for.projection,
        j = i,
        value = as.ena.co.occurrence(enadata$model$points.for.projection[[i]])
      )
    }
    enadata$model$points.for.projection <- as.ena.matrix(cbind(
      enadata$meta.data,
      enadata$model$points.for.projection
    ), "ena.points")
    #####

    ###

    ###
    # Generate and Assign the rotation set
    #####
    if (!is.null(rotation.by) && is.null(rotation.set)) {
      rotation <- do.call(rotation.by, list(enadata, rotation.params))
      # added by Carl, 2026.1.6
      if(is.null(rotation))
      {
        stop("Unable to create a rotation set")
      }
      #
      enadata$rotation.matrix <- as.data.table(rotation$rotation, keep.rownames = "codes")
      for (i in seq(ncol(enadata$rotation.matrix))) {
        if(i == 1) {
          set(enadata$rotation.matrix,
              j = i, value = as.ena.metadata(enadata$rotation.matrix[[i]])
          )
        }
        else {
          set(enadata$rotation.matrix,
              j = i, value = as.ena.dimension(enadata$rotation.matrix[[i]])
          )
        }
      }
      class(enadata$rotation.matrix) <- c("ena.rotation.matrix", class(enadata$rotation.matrix))

      enadata$rotation$rotation.matrix <- enadata$rotation.matrix
      enadata$rotation$eigenvalues <- rotation$eigenvalues;
      if(center.align.to.origin) {
        enadata$rotation$center.vec = colMeans(line.weights[rowSums(as.matrix(line.weights))!=0,]) # ADD CENTERING VEC HERE
      }
      else {
        enadata$rotation$center.vec = colMeans(line.weights) # ADD CENTERING VEC HERE
      }
    }
    else if (!is.null(rotation.set)) {
      if (is(rotation.set, "ena.rotation.set")) {
        enadata$rotation.matrix <- rotation.set$rotation.matrix
        enadata$rotation$rotation.matrix <- rotation.set$rotation.matrix
        enadata$rotation$nodes <- rotation.set$nodes;
        enadata$rotation$eigenvalues <- rotation.set$eigenvalues
        enadata$rotation$center.vec = rotation.set$center.vec # ADD CENTERING VEC HERE
      }
      else {
        stop("Supplied rotation.set is not an instance of ENARotationSet")
      }
    }
    else {
      stop("Unable to find or create a rotation set")
    }
    #####

    ###
    # Generate the rotated points
    #####
    if (!is.null(enadata$rotation.matrix)) {
      points <- points.for.projection %*% as.matrix(enadata$rotation.matrix)
      points.dt <- as.data.table(points)
      for (i in seq(ncol(points.dt))) {
        set(points.dt, j = i, value = as.ena.dimension(points.dt[[i]]))
      }
      if(grepl(x = enadata$model$model.type, pattern = "Trajectory")) {
        enadata$points <- cbind(enadata$trajectories, points.dt)
      }
      else {
        enadata$points <- cbind(enadata$meta.data, points.dt)
      }
      enadata$points <- as.ena.matrix(enadata$points, "ena.points")
    }
    else {
      stop(paste0("There is no rotation matrix, if you supplied a custom ",
                  "rotation.set, be sure it contains a rotation.matrix"))
    }
    #####

    ###
    # Calculate node positions
    #  - The supplied methoed is responsible is expected to return a list
    #    with two keys, "node.positions" and "centroids"
    #####
    if (exists("rotation") && !is.null(rotation) && is.null(rotation.set)) {
      positions <- node.position.method(enadata)

      if (all(names(positions) %in% c("node.positions", "centroids"))) {
        enadata$rotation$nodes <- as.data.table(positions$node.positions)
        colnames(enadata$rotation$nodes) <- colnames(points)
        rownames(enadata$rotation$nodes) <- enadata$rotation$codes

        for (i in seq(ncol(enadata$rotation$nodes))) {
          set(enadata$rotation$nodes, j = i,
              value = as.ena.dimension(enadata$rotation$nodes[[i]]))
        }
        enadata$rotation$nodes <- data.table(
          code = structure(enadata$rotation$codes,
                           class = c("code", class(enadata$rotation$codes))),
          enadata$rotation$nodes
        )
        class(enadata$rotation$nodes) = c("ena.nodes",
                                          class(enadata$rotation$nodes))

        enadata$model$centroids <- as.data.table(positions$centroids)
        for (i in seq(ncol(enadata$model$centroids))) {
          set(enadata$model$centroids, j = i,
              value = as.ena.dimension(enadata$model$centroids[[i]])
          )
        }
        colnames(enadata$model$centroids) <- colnames(as.matrix(enadata$rotation.matrix))
        enadata$model$centroids = cbind(
          data.table(unit = enadata$model$unit.labels),
          enadata$model$centroids
        )
        set(enadata$model$centroids, j = 1L,
            value = as.ena.metadata(enadata$model$centroids[[1L]])
        )
        enadata$model$centroids <- as.ena.matrix(enadata$model$centroids)
      }
      else {
        stop(paste0("The node position method didn't return back the ",
                    "expected objects:\n",
                    "\tExpected: c('node.positions','centroids')\n",
                    "\tReceived: ", names(positions), sep = ""))
      }
    } else if (!is.null(rotation.set)) {
      enadata$rotation$nodes <- rotation.set$nodes
    }

    if (is.null(enadata$rotation$nodes)) {
      stop("Unable to determine the node positions either by calculating
                    them using `node.position.method` or using a supplied
                    `rotation.set`")
    }
    #####

    ###
    # Variance
    #####
    var_rot_data <- var(points)
    diagonal_variance <- as.vector(diag(var_rot_data))
    enadata$model$variance <- diagonal_variance / sum(diagonal_variance)
    names(enadata$model$variance) <- colnames(enadata$rotation$rotation.matrix)[-1]
    #####

    enadata$plots <- list() #default = ena.plot(enadata, ...))
    # class(enadata$model$plot) <- c("ena.plot", class(enadata$model$plot))

    enadata$`_function.params`$norm.by <- norm.by
    return(enadata)
  }
}

plot_nodes <- function(...) {
  enaplot$plot <- plotly::add_trace(
    enaplot$plot,
    type = "scatter",
    data = nodes,
    x = ~X1,
    y = ~X2,
    mode = mode,
    textposition = label.offset[rows.to.keep],
    marker = list(
      color = "#000000",
      size = abs(nodes$weight),
      line = list(
        width = 0
      )
      #,name = labels[i] #rownames(nodes)[i]
    ),
    textfont = list (
      family = label.font.family,
      size = label.font.size,
      color = label.font.color
    ),
    text = labels[rows.to.keep], #rownames(nodes),
    legendgroup = legend.name,
    name = legend.name,
    showlegend = show.legend,
    hoverinfo = 'none'
  );

  return(enaplot$plot);
}

plot_edges <- function(...) {
  if (length(network.edges.shapes) > 0 ) {
    enaplot$plotted$networks[[length(enaplot$plotted$networks) + 1]] <- network.edges.shapes

    for (n in 1:length(network.edges.shapes)) {
      e = network.edges.shapes[[n]];

      name = NULL;
      show.legend = F;
      this.name = paste(e$nodes[1],e$nodes[2], sep=".")
      if(legend.include.edges) {
        name = this.name;
        show.legend = T;
      }

      if (isTRUE(e$self)) {
        if (e$line$width > 0) {
          enaplot$plot = plotly::add_trace(
            enaplot$plot,
            type = "scatter",
            mode = "markers",
            data = data.frame(X1 = e$x0, X2 = e$y0),
            x = ~X1, y = ~X2,
            marker = list(color = e$line$color, size = e$line$width, line = list(width = 0)),
            opacity = e$opacity,
            legendgroup = if(legend.include.edges == T) this.name else legend.name,
            showlegend = show.legend,
            name = name,
            hoverinfo = 'none'
          )
        }
        next
      }

      enaplot$plot = plotly::add_trace(
        enaplot$plot,
        type = "scatter",
        mode = "lines",
        data = data.frame(X1=c(e$x0,e$x1), X2=c(e$y0,e$y1)),
        x = ~X1, y = ~X2,
        line = e$line,
        opacity = e$opacity,
        legendgroup = if(legend.include.edges == T) this.name else legend.name,
        showlegend = show.legend,
        name = name
      )
    }
  }

  return(enaplot$plot);
}

##
#' @title Plot an ENA network
#'
#' @description Plot an ENA network: nodes and edges
#'
#' @details lots a network graph, including nodes (taken from codes in the ENAplot) and the edges (provided in network)
#'
#' @export
#'
#' @param enaplot \code{\link{ENAplot}} object to use for plotting
#' @param network dataframe or matrix containing the edge weights for the network graph; typically comes from ENAset$line.weights
#' @param node.positions matrix containing the positiions of the nodes. Defaults to enaplot$enaset$node.positions
#' @param adjacency.key matrix containing the adjacency key for looking up the names and positions
#' @param colors A String or vector of colors for positive and negative line weights. E.g. red or c(pos= red, neg = blue), default: c(pos= red, neg = blue)
#' @param edge_type A String representing the type of line to draw, either "line", "dash", or "dot"
#' @param show.all.nodes A Logical variable, default: true
#' @param threshold A vector of numeric min/max values, default: c(0,Inf) plotting . Edge weights below the min value will not be displayed; edge weights above the max value will be shown at the max value.
#' @param thin.lines.in.front A logical, default: true
#' @param layers ordering of layers, default: c("nodes", "edges")
#' @param thickness A vector of numeric min/max values for thickness, default:  c(min(abs(network)), max(abs(network)))
#' @param opacity A vector of numeric min/max values for opacity, default: thickness
#' @param saturation A vector of numeric min/max values for saturation, default: thickness
#' @param scale.range A vector of numeric min/max to scale from, default: c(0.1,1) or if min(network) is 0, c(0,1)
#' @param node.size A lower and upper bound used for scaling the size of the nodes, default c(0, 20)
#' @param labels A character vector of node labels, default: code names
#' @param label.offset A character vector of representing the positional offset relative to the respective node. Defaults to "middle right" for all nodes. If a single values is provided, it is used for all positions, else the length of the
#' @param label.font.size An integer which determines the font size for graph labels, default: enaplot$font.size
#' @param label.font.color A character which determines the color of label font, default: enaplot$font.color
#' @param label.font.family A character which determines font type, choices: Arial, Courier New, Times New Roman, default: enaplot$font.family
#' @param legend.name A character name used in the plot legend. Not included in legend when NULL (Default), if legend.include.edges is TRUE will always be "Nodes"
#' @param legend.include.edges Logical value indicating if the edge names should be included in the plot legend. Forces legend.name to be "Nodes"
#' @param scale.weights Logical indicating to scale the supplied network
#' @param ... Additional parameters
#'
#' @seealso \code{\link{ena.plot}}, \code{\link{ena.plot.points}}
#' @importFrom scales rescale

#' @examples
#' data(RS.data)
#'
#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
#'   'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
#'
#' accum = ena.accumulate.data(
#'   units = RS.data[,c("UserName","Condition")],
#'   conversation = RS.data[,c("Condition","GroupName")],
#'   metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post")],
#'   codes = RS.data[,codeNames],
#'   window.size.back = 4
#' )
#'
#' set = ena.make.set(
#'   enadata = accum,
#'   rotation.by = ena.rotate.by.mean,
#'   rotation.params = list(
#'     accum$meta.data$Condition=="FirstGame",
#'     accum$meta.data$Condition=="SecondGame"
#'   )
#' )
#'
#' plot = ena.plot(set)
#'
#' ### Subset rotated points and plot Condition 1 Group Mean
#' as.matrix(set$points$Condition$FirstGame)
#'
#' first.game.points = as.matrix(set$points$Condition$FirstGame)
#' plot = ena.plot.group(plot, first.game.points, labels = "FirstGame",
#'     colors = "red", confidence.interval = "box")
#'
#' ### Subset rotated points and plot Condition 2 Group Mean
#' second.game.points = as.matrix(set$points$Condition$SecondGame)
#' plot = ena.plot.group(plot, second.game.points, labels = "SecondGame",
#'     colors  = "blue", confidence.interval = "box")
#'
#' ### get mean network plots
#' first.game.lineweights = as.matrix(set$line.weights$Condition$FirstGame)
#' first.game.mean = colMeans(first.game.lineweights)
#'
#' second.game.lineweights = as.matrix(set$line.weights$Condition$SecondGame)
#' second.game.mean = colMeans(second.game.lineweights)
#'
#' subtracted.network = first.game.mean - second.game.mean
#' plot = ena.plot.network(plot, network = subtracted.network)
#' print(plot)
#'
#' @return The \code{\link{ENAplot}} provided to the function, with its plot updated to include the nodes and provided connecting lines.
##
ena.plot.network = function(
  enaplot = NULL,
  network = NULL,
  node.positions = enaplot$enaset$rotation$nodes,
  adjacency.key = NULL, #enaplot$enaset$enadata$adjacency.matrix,
  colors = c(pos=enaplot$palette[1], enaplot$palette[2]),
  edge_type = "line", #c("line", "dash", "dot"),
  show.all.nodes = T,
  threshold = c(0),
  thin.lines.in.front = T,
  layers = c("nodes", "edges"),

  thickness = c(min(abs(network)), max(abs(network))),
  opacity = thickness,
  saturation = thickness,
  scale.range = c(ifelse(min(network)==0, 0, 0.1), 1),

  node.size = c(3,10),

  labels = NULL,
  label.offset = "middle right",
  label.font.size = enaplot$get("font.size"),
  label.font.color = enaplot$get("font.color"),
  label.font.family = enaplot$get("font.family"),
  legend.name = NULL,
  legend.include.edges = F,
  scale.weights = F,
  ...
) {
  if (.qe_backend(enaplot))
    return(.qe_plot_network(enaplot, supplied = names(match.call())[-1],
      network = network, node.positions = node.positions, adjacency.key = adjacency.key,
      colors = colors, edge_type = edge_type, show.all.nodes = show.all.nodes,
      threshold = threshold, thin.lines.in.front = thin.lines.in.front, layers = layers,
      labels = labels, label.font.size = label.font.size, label.font.color = label.font.color,
      label.font.family = label.font.family, legend.name = legend.name, dots = list(...)))

  # One weight per pair of nodes, or per pair plus each node's self-connection
  # (upper triangle with the diagonal, as accumulate(self_connections = TRUE)).
  n.nodes <- nrow(node.positions)
  expected_codes <- c(choose(n.nodes, 2), n.nodes * (n.nodes + 1) / 2)
  if(!length(network) %in% expected_codes) {
    if(is.data.frame(network) && ncol(as.matrix(network)) %in% expected_codes) {
      network = as.vector(as.matrix(network))
    }
    else {
      stop(paste0("Network vector needs to be of length ", choose(n.nodes, 2),
                  " (or ", n.nodes * (n.nodes + 1) / 2, " with self-connections)"))
    }
  }
  diagonal <- length(network) == expected_codes[2] && expected_codes[2] != expected_codes[1]
  node.rows <- NULL
  if(is(node.positions, "ena.nodes")) {
    if(is.null(adjacency.key)) {
      adjacency.key <- namesToAdjacencyKey(node.positions$code, diagonal = diagonal)
    }
    node.rows <- node.positions$code

    if(is.null(labels)) {
      labels <- node.positions$code
    }
  }
  else {
    if(is.matrix(node.positions)) {
      node.positions <- as.data.frame(node.positions)
    }
    adjacency.key <- namesToAdjacencyKey(rownames(node.positions), diagonal = diagonal)
    node.rows <- rownames(node.positions)
    if(is.null(labels)) {
      labels  <- rownames(node.positions)
    }
  }
  args = list(...);
  network.edges.shapes = list();
  edge_type = match.arg(arg = edge_type, choices = c("line", "dash", "dot"));

  nodes = data.frame(as.matrix(node.positions));
  colnames(nodes) = paste0("X", seq(colnames(nodes)))
  nodes$weight = rep(0, nrow(nodes))
  nodes$color = "black";

  # Handle label parameters
  if(length(label.offset) == 1) {
    label.offset = rep(label.offset[1], length(labels))
  }
  if(length(label.offset) != length(labels)) {
    stop("length(label.offset) must be equal to 1 or length(labels)")
  }

  # Handle legend parameters
  if(legend.include.edges == T && !is.null(legend.name)) {
    legend.name = "Nodes"
  }

  network.scaled = network;
  if(!is.null(threshold)) {
    multiplier.mask = ((network.scaled >= 0) * 1) - ((network.scaled < 0) * 1)
    if(length(threshold) == 1) {
      threshold[2] = Inf;
    }
    else if(threshold[2] < threshold[1]) {
      stop("Minimum threshold value must be less than the maximum value.");
    }

    if(threshold[1] > 0) {
      # network.scaled = network.scaled[sizes > threshold[1]]
      network.scaled[abs(network.scaled) < threshold[1]] = 0
    }
    if(threshold[2] < Inf && any(abs(network.scaled) > threshold[2]))  {
      to.threshold = abs(network.scaled) > threshold[2]
      network.scaled[to.threshold] = threshold[2]
      network.scaled[to.threshold] = network.scaled[to.threshold] * multiplier.mask[to.threshold]
    }
  }
  network.thickness = abs(network.scaled);
  network.saturation = abs(network.scaled);
  network.opacity = abs(network.scaled);

  network.to.keep = (network != 0) * 1
  if(scale.weights == T && any(network != 0)) {
    weight.multiplier = 1 / max(abs(network));
    network.scaled = network * weight.multiplier;
    # thickness/saturation/opacity ranges are given in unscaled units; bring
    # them onto the same scale as network.scaled so the rescales stay in range.
    # Force the saturation/opacity defaults (= thickness) before thickness changes.
    force(saturation); force(opacity);
    thickness = thickness * weight.multiplier;
    saturation = saturation * weight.multiplier;
    opacity = opacity * weight.multiplier;
    network.thickness = scales::rescale(x = abs(network.scaled), to = scale.range, from = thickness);
  }
  network.scaled = network.scaled * network.to.keep
  network.thickness = network.thickness * network.to.keep

  # hsv() and the edge opacity both require values in [0, 1]
  network.saturation = scales::squish(scales::rescale(x = abs(network.scaled), to = scale.range, from = saturation), c(0, 1));
  network.opacity = scales::squish(scales::rescale(x = abs(network.scaled), to = scale.range, from = opacity), c(0, 1));

  pos.inds = as.numeric(which(network.scaled >=0));
  neg.inds = as.numeric(which(network.scaled < 0));

  colors.hsv = rgb2hsv(col2rgb(colors))

  if(ncol(colors.hsv) == 1) {
    colors.hsv[[4]] = colors.hsv[1] + 0.5;
    if(colors.hsv[4] > 1) {
      colors.hsv[4] = colors.hsv[4] - 1;
    }

    colors.hsv[[5]] = colors.hsv[2];
    colors.hsv[[6]] = colors.hsv[3];
    dim(colors.hsv) = c(3,2);
  }

  mat = as.matrix(adjacency.key);
  for (i in 1:length(network)) {
    v0 <- nodes[node.rows==mat[1,i], ];
    v1 <- nodes[node.rows==mat[2,i], ];
    is.self <- mat[1,i] == mat[2,i]
    # A self-connection counts once toward its node's size, so the node
    # stays larger than the circle drawn on it.
    nodes[node.rows==mat[1,i],]$weight = nodes[node.rows==mat[1,i],]$weight + abs(network.thickness[i]);
    if(!is.self) {
      nodes[node.rows==mat[2,i],]$weight = nodes[node.rows==mat[2,i],]$weight + abs(network.thickness[i]);
    }

    color = NULL
    if(i %in% pos.inds) {
      color = colors.hsv[,1];
    } else {
      color = colors.hsv[,2];
    }
    color[2] = network.saturation[i];

    edge_shape = list(
      type = "line",
      opacity = network.opacity[i],
      nodes = c(mat[,i]),
      line = list(
        name = "test",
        color= hsv(color[1],color[2],color[3]),
        width= abs(network.thickness[i]) * enaplot$get("multiplier"),
        dash = edge_type
      ),
      x0 = as.numeric(v0[1]),
      y0 = as.numeric(v0[2]),
      x1 = as.numeric(v1[1]),
      y1 = as.numeric(v1[2]),
      layer = "below",
      size = as.numeric(abs(network.scaled[i])),
      self = is.self
    );
    network.edges.shapes[[i]] = edge_shape
  };

  if(thin.lines.in.front) {
    network.edges.shapes = network.edges.shapes[rev(order(sapply(network.edges.shapes, "[[", "size")))]
  }
  else {
    network.edges.shapes = network.edges.shapes[order(sapply(network.edges.shapes, "[[", "size"))]
  }

  rows.to.keep = rep(T, nrow(nodes))
  if(show.all.nodes == F) {
    rows.to.keep = nodes$weight != 0
    # nodes = nodes[rownames(nodes) %in% unique(as.character(sapply(network.edges.shapes, "[[", "nodes"))), ]
  }
  nodes = nodes[rows.to.keep,];
  mode = "markers+text"
  if(!is.null(args$labels.hide) && args$labels.hide == T) {
    mode="markers"
  }
  if( any(nodes$weight > 0)) {
    nodes$weight = scales::rescale((nodes$weight * (1 / max(abs(nodes$weight)))), node.size) # * enaplot$get("multiplier"));
  }
  else {
    nodes$weight = node.size[2]
  }
  # Self-connections are circles on their node, as wide as an edge of the same
  # weight (the edges' scale); a node is never drawn smaller than its circle.
  for (e in network.edges.shapes) {
    if (isTRUE(e$self)) {
      on.node <- node.rows[rows.to.keep] == e$nodes[1]
      nodes$weight[on.node] = pmax(nodes$weight[on.node], e$line$width)
    }
  }

  show.legend = !is.null(legend.name);
  if(legend.include.edges) {
    if(is.null(legend.name)) {
      legend.name = "Nodes"
    }
    show.legend = T;
  }

  # browser()
  environment(plot_nodes) <- environment()
  environment(plot_edges) <- environment()

  for(layer in layers) {
    enaplot$plot <- do.call(what = paste0("plot_", layer), args = list())
  }

  enaplot
}

#' Accumulate Connection Counts for ENA
#'
#' This function takes a data.frame and accumulates co-occurrences of codes within specified units and conversations (horizon), preparing it for ENA. It's designed to be used with pipes (`|>`)..
#'
#' @param x A data.frame or similar object containing the data to be analyzed.
#' @param units A character vector specifying the columns that define the units of analysis.
#' @param codes A character vector specifying the columns that contain the codes for co-occurrence analysis.
#' @param horizon A character vector specifying the columns that define the conversational boundaries (horizon).
#' @param ... Additional arguments passed to underlying accumulation functions.
#' @param ordered A logical value. If TRUE, creates ordered networks (A -> B is different from B -> A). Defaults to FALSE.
#' @param binary A logical value. If TRUE, each line's connection counts are binarized (0 or 1) before they are summed per unit (unordered networks; ordered counts are always summed raw). Defaults to TRUE. Ignored when `weight_by` is given.
#' @param weight_by Weight model applied to each line's connection counts before they are summed into the unit network (the same stage as `weight.by` in `ena.accumulate.data()`): `"binary"`, `"product"` (the raw, non-binarized counts), `"sqrt"`, or `"log1p"` (alias `"log"`). For unordered networks the weight is applied after each line is folded to the upper triangle; for ordered networks, to each directed cell, and `"binary"` keeps the raw directed counts. Defaults to `"binary"` when `binary = TRUE`, otherwise `"product"`. Passed to [tma::accumulate()].
#' @param misses A logical value. If TRUE (the default), also accumulate missed co-occurrences -- for each line, the ground count of code i when code j is absent from the response -- kept as `miss.counts` / `model$row.miss.counts` (and self-misses as `self.miss.counts`) alongside the connection counts; they are not used by the model. FALSE skips them (less memory for many codes or long data). Passed to [tma::accumulate()].
#' @param self_connections A logical value, default FALSE. Unordered networks only: also include each code's self-connection (ground i -> response i, weighted per line like the other columns) as a connection column (A & A, A & B, B & B, ...), so normalization, rotation and node positions include it; nodes then count a self-connection `self_weight` times, as ordered models do (see [model()]). Ordered networks always include the diagonal. Passed to [tma::accumulate()].
#'
#' @return An ena.set object containing the accumulated connection counts and metadata.
#' @export
#'
#' @examples
#' data(RS.data)
#'
#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'            "Client.and.Consultant.Requests", "Design.Reasoning",
#'            "Collaboration")
#' units <- c("Condition", "UserName")
#' horizon <- c("Condition", "GroupName")
#' enaset <- RS.data |>
#'   accumulate(units, codes, horizon)
#'
#' # square-root weighting of each line's co-occurrence counts
#' enaset_sqrt <- RS.data |>
#'   accumulate(units, codes, horizon, weight_by = "sqrt")
#'
accumulate <- function(
    x,
    units = rENA::units(x),
    codes = rENA::codes(x),
    horizon = rENA::horizon(x),
    ...,
    ordered = FALSE,
    binary = TRUE,
    weight_by = NULL,
    misses = TRUE,
    self_connections = FALSE
) {
  # set <- ena.accumulate.data.file(
  #   file = x,
  #   units.by = units,
  #   conversations.by = horizon,
  #   codes = codes,
  #   ...
  # )
  args <- list(...)
  force(units);
  force(codes);
  force(horizon);

  hoo_rules <- list(
    str2lang(paste0("(", paste0(sapply(horizon, function(cb) paste0(cb, " %in% UNIT$", cb)), collapse = " & "), ")"))
  )
  contexts <- tma::contexts(
    x,
    units_by = make.names(units),
    hoo_rules = hoo_rules,
    split_rules = function(unit, unit_context) {
      split(unit_context, by = horizon)
    }
  )

  win_wgts <- if(is.null(args$tensor)) {
    args$default_window <- if (is.null(args$default_window)) 1 else args$default_window;
    args$default_weight <- if (is.null(args$default_weight)) 1 else args$default_weight;
    tma::context_tensor(
      df = x,
      sender_cols = args$tma_ground_cols,
      receiver_cols = args$tma_response_cols,
      mode_column = ifelse(is.null(args$mode_column), tma::ATTR_NAMES$CONTEXT_ID, args$mode_column),
      default_window = args$default_window,
      default_weight = args$default_weight
    )
  }
  else {
    args$tensor
  }

  # args$ordered <- if (is.null(args$ordered)) TRUE else FALSE
  # browser()
  set <- tma::accumulate(
    context_model = contexts,
    # multidim_arr = multidim_arr,
    tensor = win_wgts,
    # time_column = args$time_column,
    codes = make.names(codes),
    ordered = ordered,
    binary = binary,
    weight_by = weight_by,
    misses = misses,
    self_connections = self_connections
  )

  set$rotation <- list(
    rotation.matrix = NULL,
    codes = codes,
    adjacency.key = sapply(colnames(as.matrix(set$connection.counts)), function(y) strsplit(y, "\\s?&\\s?")[[1]], simplify = T),
    node.positions = NULL,
    eigenvalues = NULL,
    centervec = NULL
  )

  return(set)
}

##' Build a Complete ENA Model
#'
#' This function applies a full ENA modeling pipeline to accumulated data. It is a convenience wrapper that chains together normalization, centering, rotation, projection, and optional optimization. Each step can be customized by supplying an alternative function.
#'
#' @param data An `ena.set` object, typically the result of `accumulate()`.
#' @param ... Additional arguments passed to the rotation function specified by `rotate_fun`.
#' @param normalize A function to normalize the connection counts. Defaults to `sphere_norm`.
#' @param center_with A function to center the normalized data. Defaults to `center`.
#' @param rotate_with A function to perform the rotation (e.g., SVD). Defaults to `rotate`.
#' @param project_with A function to project the points into the rotated space. Defaults to `project`.
#' @param optimize_with A function to optimize node positions. Defaults to `optimize`. Can be set to `NULL` or `FALSE` to skip.
#' @param rotate_fun The specific rotation function to be used by `rotate_with`. Defaults to `ena.rotate.by.generalized`.
#' @param rotate_params A list of parameters passed to `rotate_fun` as its
#'   `params` argument -- for example the two group-membership vectors for
#'   `ena.rotate.by.mean`, or `list(x_var = "Condition")` for
#'   `ena.rotate.by.generalized`. The nested form `list(params = <params>)` is
#'   also accepted. When empty (the default), `rotate()` picks its default
#'   parameters.
#' @param exclude_zero_networks A logical value passed to `center_with` and
#'   `optimize_with`. When `TRUE` (default), units whose line weights are all
#'   zero are left at the origin: they do not enter the centering mean, the
#'   rotation or the node optimization, and their points and centroids are
#'   zero. This is `ena.make.set(center.align.to.origin = TRUE)`, the webtool's
#'   rule, for every kind of set. `FALSE` centers on all units, as
#'   `center.align.to.origin = FALSE` does.
#' @param center_to_origin A logical value. When `TRUE`, the mean of all projected
#'   points is subtracted from both the points and the node positions after
#'   optimization, placing the centroid of the space at the origin. This is the
#'   default behavior for ONA (Ordered Network Analysis). Defaults to `FALSE`.
#' @param self_weight Ordered sets: weight of a self-connection in its code's
#'   node weight, passed to `optimize_with` when it takes `self_weight`. 2
#'   (default) = the node's row plus column sum, so a self-connection counts
#'   twice (Zhiqiang Cai's 2021 rule); 1 counts it once.
#'
#' @return An `ena.set` object with a complete ENA model, including projected points and node positions.
#' @export
#'
#' @examples
#' data(RS.data)
#'
#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'            "Client.and.Consultant.Requests", "Design.Reasoning",
#'            "Collaboration")
#' units <- c("Condition", "UserName")
#' horizon <- c("Condition", "GroupName")
#' enaset <- RS.data |>
#'   accumulate(units, codes, horizon) |>
#'   model()
model <- function(
  data, ...,
  normalize = sphere_norm,
  center_with = center,
  rotate_with = rotate,
  project_with = project,
  optimize_with = optimize,
  # Rotation specific parameters
  rotate_fun = ena.rotate.by.generalized,
  rotate_params = list(),
  # Centering options
  exclude_zero_networks = TRUE,
  center_to_origin = FALSE,
  # Ordered node optimization: weight of a self-connection in its node's weight
  self_weight = 2
) {
    x <- normalize(data)
    x <- center_with(x, exclude_zero_networks = exclude_zero_networks)

    # rotate() hands `params` to the rotation function. rotate_params used to
    # be passed as `by` -- flattened with unlist() when it had more than one
    # element -- which rotate() either ignored (one element) or failed on
    # (several), e.g. the two groups of a means rotation.
    if (length(rotate_params) == 0) {
      x <- rotate_with(x, wh = rotate_fun, by = rotate_params)
    }
    else {
      params <- if (identical(names(rotate_params), "params")) rotate_params$params else rotate_params
      x <- rotate_with(x, wh = rotate_fun, params = params)
    }

    x <- project_with(x)

    if (!is.null(optimize_with) && !isFALSE(optimize_with)) {
      opt_args <- list(x)
      opt_formals <- names(formals(optimize_with))
      if ("self_weight" %in% opt_formals) opt_args$self_weight <- self_weight
      if ("exclude_zero_networks" %in% opt_formals) opt_args$exclude_zero_networks <- exclude_zero_networks
      x <- do.call(optimize_with, opt_args)
    }

    if (isTRUE(center_to_origin) && !is.null(x$points)) {
      # x$points dimension columns are classed ena.co.occurrence (not ena.dimension),
      # so use !find_meta_cols to locate them.
      dim_cols      <- which(!find_meta_cols(x$points))
      node_dim_cols <- which(find_dimension_cols(x$rotation$nodes))
      # Compute per-dimension means from the projected points
      pt_means <- as.list(colMeans(x$points[, dim_cols, with = FALSE]))
      # Translate points so their centroid is at the origin
      x$points[, c(dim_cols) := lapply(.SD, function(col) col - mean(col)), .SDcols = dim_cols]
      # Translate nodes by the same vector
      x$rotation$nodes[, c(node_dim_cols) := Map(`-`, .SD, pt_means), .SDcols = node_dim_cols]
    }

  return(x)
}

##' Apply Spherical Normalization to ENA Data
#'
#' This function applies spherical normalization to the connection counts in an `ena.set` object or to a raw matrix of connection counts. Normalization is a key step before centering and rotation in ENA.
#'
#' @param x An `ena.set` object or a numeric matrix of connection counts.
#' @param add.meta A logical value. If `TRUE` (the default), metadata from the `ena.set` is preserved and included in the output. This parameter is ignored if `x` is a matrix.
#'
#' @return If `x` is an `ena.set`, it returns the modified `ena.set` with a new `line.weights` matrix and an updated `centervec` in the `rotation` object. If `x` is a matrix, it returns a matrix of normalized line weights.
#' @export
#'
#' @examples
#' data(RS.data)
#'
#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'            "Client.and.Consultant.Requests", "Design.Reasoning",
#'            "Collaboration")
#' units <- c("Condition", "UserName")
#' horizon <- c("Condition", "GroupName")
#' enaset <- RS.data |>
#'   accumulate(units, codes, horizon) |>
#'   sphere_norm()
sphere_norm <- function(x, add.meta = TRUE) {
  x_ <- NULL
  names_ <- NULL
  meta_ <- NULL

  # verify that the connection.counts exist

  if (is(x, "ena.set")) {
    if (is.null(x$connection.counts)) {
      stop("Connection counts are missing.")
    }

    x_ <- as.matrix(x$connection.counts)
    names_ <- colnames(x_)
    if (isTRUE(add.meta)) {
      meta_ <- x$meta.data
    }

    x$line.weights <- fun_sphere_norm(x_)
    colnames(x$line.weights) <- names_

    x$line.weights <- as_line_weights_matrix(x$line.weights, meta_)
    x$rotation$centervec <- colMeans(x$line.weights)
  }
  else {
    x_ <- as.matrix(x);
    names_ <- colnames(x_);
    x <- fun_sphere_norm(x_);
    colnames(x) <- names_;
  }

  return(x)
}


##' Scale ENA Data Without Spherical Normalization
#'
#' The counterpart of [sphere_norm()] for `norm.by = fun_skip_sphere_norm`:
#' instead of scaling each unit's network to length 1, every network is divided
#' by the length of the longest one, so relative magnitudes across units are
#' kept. Pass it as `normalize` to [model()] (or to `ona::model()`, which hands
#' it on) to build a model without sphere normalization.
#'
#' @param x An `ena.set` object or a numeric matrix of connection counts.
#' @param add.meta A logical value. If `TRUE` (the default), metadata from the `ena.set` is preserved and included in the output. This parameter is ignored if `x` is a matrix.
#'
#' @return If `x` is an `ena.set`, it returns the modified `ena.set` with a new `line.weights` matrix and an updated `centervec` in the `rotation` object. If `x` is a matrix, it returns a matrix of scaled line weights.
#' @export
#'
#' @examples
#' data(RS.data)
#'
#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'            "Client.and.Consultant.Requests", "Design.Reasoning",
#'            "Collaboration")
#' units <- c("Condition", "UserName")
#' horizon <- c("Condition", "GroupName")
#' enaset <- RS.data |>
#'   accumulate(units, codes, horizon) |>
#'   model(normalize = skip_sphere_norm)
skip_sphere_norm <- function(x, add.meta = TRUE) {
  if (is(x, "ena.set")) {
    if (is.null(x$connection.counts)) {
      stop("Connection counts are missing.")
    }

    x_ <- as.matrix(x$connection.counts)
    names_ <- colnames(x_)
    meta_ <- if (isTRUE(add.meta)) x$meta.data else NULL

    x$line.weights <- fun_skip_sphere_norm(x_)
    colnames(x$line.weights) <- names_

    x$line.weights <- as_line_weights_matrix(x$line.weights, meta_)
    x$rotation$centervec <- colMeans(x$line.weights)
  }
  else {
    x_ <- as.matrix(x)
    names_ <- colnames(x_)
    x <- fun_skip_sphere_norm(x_)
    colnames(x) <- names_
  }

  return(x)
}

as_points_matrix <- function(x, metadata = NULL) {
  x_ <- data.table::as.data.table(x)
  for (i in seq(ncol(x_))) {
    set(x_,
      j = i,
      value = as.ena.co.occurrence(x_[[i]])
    )
  }

  if (!is.null(metadata)) {
    x_ <- cbind(metadata, x_)
  }

  class(x_) <- c("ena.points", "ena.matrix", class(x_))

  return(x_)
}

as_line_weights_matrix <- function(x, metadata = NULL) {
  line.weights.dt <- data.table::as.data.table(x)
  for (i in seq(ncol(line.weights.dt))) {
    set(line.weights.dt,
      j = i,
      value = as.ena.co.occurrence(line.weights.dt[[i]])
    )
  }

  x_ <- line.weights.dt
  if (!is.null(metadata)) {
    x_ <- cbind(metadata, line.weights.dt)
  }

  class(x_) <- c("ena.line.weights", "ena.matrix", class(line.weights.dt))

  return(x_)
}

as_rotation_matrix <- function(x) {
  x_ <- data.table::as.data.table(x, keep.rownames = "codes")
  for (i in seq(ncol(x_))) {
    if (i == 1) {
      set(x_, j = i, value = as.ena.metadata(x_[[i]]))
    } else {
      set(x_, j = i, value = as.ena.dimension(x_[[i]]))
    }
  }
  class(x_) <- c("ena.rotation.matrix", class(x_))

  return(x_)
}

as_nodes_matrix <- function(x, rows, cols = NULL, cls = "ena.matrix") {
  x_ <- data.table::data.table(rows[[1]], x)
  rownames(x_) <- rows[[1]]

  if (!is.null(cols)) {
    colnames(x_) <- c(names(rows), cols)
  }

  for (i in seq(ncol(x_))) {
    if (i == 1) {
      set(x_, j = i, value = as.ena.metadata(x_[[i]]))
    } else {
      set(x_, j = i, value = as.ena.dimension(x_[[i]]))
    }
  }

  class(x_) <- c(cls, class(x_))

  return(x_)
}

##' Center ENA Data
#'
#' This function centers the line weights of an `ena.set` by subtracting the mean of each connection from all units. This is a standard step in preparing data for rotation.
#'
#' @param x An `ena.set` object (typically after `sphere_norm()`) or a numeric matrix.
#' @param add.meta A logical value. If `TRUE` (the default), metadata is preserved. Ignored if `x` is a matrix.
#' @param exclude_zero_networks A logical value. If `TRUE`, units whose line
#'   weights are all zero are left at zero: the column means are computed from
#'   the other units and subtracted from those units only, so an empty network
#'   sits at the centroid of the others and projects to the origin. This is
#'   what `ena.make.set(center.align.to.origin = TRUE)` does. `FALSE` (default
#'   here; `model()` defaults to `TRUE`) subtracts the mean of all units from
#'   every unit, so an empty network becomes minus the mean.
#'
#' @return If `x` is an `ena.set`, it returns the modified `ena.set` with the centered data stored in `x$model$points.for.projection`. If `x` is a matrix, it returns a centered matrix.
#' @export
#'
#' @examples
#' data(RS.data)
#'
#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'            "Client.and.Consultant.Requests", "Design.Reasoning",
#'            "Collaboration")
#' units <- c("Condition", "UserName")
#' horizon <- c("Condition", "GroupName")
#' enaset <- RS.data |>
#'   accumulate(units, codes, horizon) |>
#'   sphere_norm() |>
#'   center()
center <- function(x, add.meta = TRUE, exclude_zero_networks = FALSE) {
  x_ <- NULL
  names_ <- NULL
  meta_ <- NULL

  # Center the non-zero rows on their own mean and leave all-zero rows at
  # zero, as ENAset's center.align.to.origin does: an empty network then sits
  # at the centroid of the others rather than at minus their mean.
  center_excluding_zeros <- function(m) {
    nonzero <- rowSums(m) != 0
    if (!any(nonzero)) {
      return(center_data_c(m))
    }
    m[nonzero, ] <- center_data_c(m[nonzero, , drop = FALSE])
    m
  }

  if (is(x, "ena.set")) {
    # make sure the line weights exist and are a matrix
    if (is.null(x$line.weights)) {
      stop("Missing line.weights on the provided ENA set. This is typically created using the 'accumulate' and 'sphere_norm' functions.")
    }

    x_ <- as.matrix(x$line.weights)
    # Column names from the codes, for the three layouts: unordered
    # (choose(p, 2)), unordered with self-connections (p(p+1)/2; A & A, A & B,
    # B & B, ...) and ordered (p^2).
    p_codes <- length(x$rotation$codes)
    key_ <- if (ncol(x_) == choose(p_codes, 2)) {
      tma::adjacency_key(x$rotation$codes, TRUE)
    } else if (ncol(x_) == p_codes * (p_codes + 1) / 2) {
      tma::adjacency_key(x$rotation$codes, TRUE, diagonal = TRUE)
    } else {
      tma::adjacency_key(x$rotation$codes, FALSE)
    }
    names_ <- apply(key_, 2, paste, collapse = " & ")
    if (isTRUE(add.meta)) {
      meta_ <- x$meta.data
    }

    centered <- if (isTRUE(exclude_zero_networks)) {
      center_excluding_zeros(x_)
    } else {
      center_data_c(x_)
    }

    colnames(centered) <- names_
    x$model$points.for.projection <- as_points_matrix(centered, meta_)
  }
  else {
    x_ <- as.matrix(x)
    names_ <- colnames(x_)
    x <- if (isTRUE(exclude_zero_networks)) {
      center_excluding_zeros(x_)
    } else {
      center_data_c(x_)
    }
    colnames(x) <- names_
  }

  return(x)
}

#' Rotate ENA Data
#'
#' Rotates ENA data using a specified rotation function (default: SVD), optionally using formulas or grouping variables.
#'
#' @param x An \code{ena.set} object to be rotated.
#' @param ... Optional formulas or additional arguments for rotation.
#' @param wh Function to use for rotation (default: \code{ena.svd}).
#'
#' @return The rotated \code{ena.set} object with updated rotation matrices.
#' @export
#'
#' @examples
#' # Assuming 'set' is an ena.set object:
#' data(RS.data)
#'
#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'            "Client.and.Consultant.Requests", "Design.Reasoning",
#'            "Collaboration")
#' units <- c("Condition", "UserName")
#' horizon <- c("Condition", "GroupName")
#' enaset <- RS.data |>
#'   accumulate(units, codes, horizon) |>
#'   sphere_norm() |>
#'   center() |>
#'   rotate()
rotate <- function(
  x,
  ...,
  wh = ena.rotate.by.generalized
) {
  x_ <- NULL
  names_ <- NULL
  codes_ <- NULL
  meta_ <- NULL
  dot_args <- list(...)

  if (is(x, "ena.set")) {
    # Make sure points.for.projection exists
    if (is.null(x$model$points.for.projection)) {
      stop("Missing `points.for.projection` on the provided ENA set. This is typically created using ?center()")
    }

    if (!is.null(dot_args$add.meta) && isTRUE(dot_args$add.meta)) {
      meta_ <- x$meta.data
    }
  }
  else {
    # Construct ENAset-like list from provided matrix
    x_ <- as.matrix(x);
    names_ <- colnames(as.matrix(x_));
    codes_ <- unique(unlist(strsplit(names_, " & ")));

    x <- list(
      model = list(
        points.for.projection = x_
      ),
      rotation = list(
        codes = codes_
      )
    )
  }

  by_vals <- NULL

  # if (length(dot_args) == 0) {
  #   wh <- ena.svd
  # }
  # else {
    dot_formulas <- sapply(dot_args, function(d) {
      d2 <- tryCatch(
        {
          d3 <- as.formula(d)
          TRUE
        },
        error = function(e) FALSE
      )
      return(d2)
    })
    if (any(dot_formulas)) {
      if (all(dot_formulas)) {
        wh <- ena.rotate.by.hena.regression_2
        by_vals <- list(params = dot_args)
        names(by_vals$params) <- c("x_var", "y_var")[seq_along(by_vals)]
      }
      else {
        stop("If rotating using a formula, all must be formulas")
      }
    }
    else {
      # Means rotation?
      by_vals <- list();
      if (!is.null(dot_args$params)) {
        by_vals <- dot_args$params
      }
      else if (!is.null(dot_args$by$params)) {
        by_vals <- dot_args$by$params
      }
      else {
        by_vals <- list(
          x_var = NULL,
          y_var = NULL
        )

        first_meta <- setdiff(colnames(x$connection.counts)[find_meta_cols(x$connection.counts)], c("QEUNIT", "ENA_UNIT"))[1]
        # args$rotate.by is a list of columns to subset from accum$connection.counts
        by_vals$x_var <- x$connection.counts[, ..first_meta, drop = FALSE];
      }
    }
  # }

  # The rotation function returns a new rotation; keep what describes the
  # columns (the adjacency key, which node optimization reads) and the
  # centering vector.
  kept <- if (is.list(x$rotation)) x$rotation[intersect(c("adjacency.key", "centervec"), names(x$rotation))] else list()

  x$rotation <- do.call(wh, list(enaset = x, params = by_vals))

  # Ensure x$rotation is a list with required elements
  if (!is.list(x$rotation)) {
    stop("Rotation function did not return a list as expected.")
  }

  # Only extract elements that exist in the returned list
  rotation_elements <- c("eigenvalues", "codes", "node.positions", "rotation")
  x$rotation <- x$rotation[intersect(rotation_elements, names(x$rotation))]
  for (nm in names(kept)) if (!is.null(kept[[nm]])) x$rotation[[nm]] <- kept[[nm]]

  if (!is.null(x$rotation$rotation)) {
    x$rotation.matrix <- as_rotation_matrix(x$rotation$rotation)
    x$rotation$rotation.matrix <- x$rotation.matrix
    x$rotation$rotation <- NULL
  }
  else {
    x$rotation.matrix <- NULL
    x$rotation$rotation.matrix <- NULL
  }

  x$rotation.matrix <- as_rotation_matrix(x$rotation$rotation)
  x$rotation$rotation.matrix <- x$rotation.matrix
  x$rotation$rotation <- NULL

  return(x)
}

##' Project ENA Points onto Rotated Space
#'
#' This function projects ENA points onto the rotated space using the rotation matrix.
#' Optionally, metadata can be included in the resulting points matrix.
#'
#' @param x An \code{ena.set} object containing the points for projection and rotation matrix.
#' @param rotation Optional. A rotation matrix to use for projection if \code{x} is not an \code{ena.set}.
#' @param add.meta Logical. If \code{TRUE} (default), metadata will be included in the output.
#'
#' @return The input \code{ena.set} object with the projected points matrix (and metadata if requested).
#' @export
#'
#' @examples
#' # Assuming 'set' is an ena.set object:
#' data(RS.data)
#'
#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'            "Client.and.Consultant.Requests", "Design.Reasoning",
#'            "Collaboration")
#' units <- c("Condition", "UserName")
#' horizon <- c("Condition", "GroupName")
#' enaset <- RS.data |>
#'   accumulate(units, codes, horizon) |>
#'   sphere_norm() |>
#'   center() |>
#'   rotate() |>
#'   project()
project <- function(x, rotation = NULL, add.meta = TRUE) {
  meta_ <- NULL

  if (is(x, "ena.set")) {
    points <- as.matrix(x$model$points.for.projection) %*% as.matrix(x$rotation.matrix);

    if (isTRUE(add.meta)) {
      meta_ <- x$meta.data;
    }
    x$points <- as_points_matrix(points, meta_);

    var_rot_data <- var(points)
    diagonal_variance <- as.vector(diag(var_rot_data))
    x$model$variance <- diagonal_variance / sum(diagonal_variance)
    names(x$model$variance) <- colnames(x$rotation$rotation.matrix)[-1]

    return(x)
  }
  else {
    if(is.null(rotation)) {
      stop("When providing a matrix, a rotation matrix must also be provided")
    }

    points <- as.matrix(x) %*% as.matrix(rotation);
    return(points);
  }
}


##' Optimize Node and Centroid Positions in ENA Set
#'
#' This function computes and assigns node positions and centroids for an ENA set object
#' using the current points and rotation information.
#'
#' @param x An \code{ena.set} object for which to optimize node and centroid positions.
#' @param weights Optional. A numeric matrix of connection weights. If provided, the function will use this matrix instead of the connection counts from the \code{ena.set}.
#' @param exclude_zero_networks A logical value. If `TRUE` (default), units
#'   whose line weights are all zero are left out of the fit, their centroids
#'   are zero, and for unordered sets the nodes and centroids are shifted so the
#'   mean centroid of the fitted units is at the origin, as
#'   `ena.make.set(center.align.to.origin = TRUE)` does. Ordered sets are fit
#'   on the other units without that shift, as ONA does. With no empty units
#'   the result is unchanged.
#' @param self_weight Weight of a self-connection (a column connecting a code to itself: the ordered diagonal, or an unordered set's A & A columns from accumulate(self_connections = TRUE)) in its code's node weight. 2 (default) counts it in both the node's row and column sums, the in + out rule of Zhiqiang Cai's 2021 fix; 1 counts it once. Recorded as \code{x$rotation$self.weight}.
#'
#' @return The input \code{ena.set} object with updated node and centroid positions.
#' @export
#'
#' @examples
#' # Assuming 'set' is an ena.set object:
#' data(RS.data)
#'
#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'            "Client.and.Consultant.Requests", "Design.Reasoning",
#'            "Collaboration")
#' units <- c("Condition", "UserName")
#' horizon <- c("Condition", "GroupName")
#' enaset <- RS.data |>
#'   accumulate(units, codes, horizon) |>
#'   sphere_norm() |>
#'   center() |>
#'   rotate() |>
#'   project() |>
#'   optimize()
optimize <- function(x, weights = NULL, self_weight = 2, exclude_zero_networks = TRUE) {
  if(!is(x, "ena.set")) {
    if(is.null(weights)) {
      stop("When providing a matrix, weights must also be provided")
    }

    x_ <- x;
    x <- list(
      points = x_,
      line.weights = weights,
      rotation = list(
        codes = unique(unlist(strsplit(colnames(as.matrix(weights)), " & ")))
      )
    )
  }

  points = as.matrix(x$points);
  weights = as.matrix(x$line.weights);
  ordered <- is(x, "ena.ordered.set")

  # Units with no connections carry no information about where the nodes go:
  # fit on the others and give the empty units a zero centroid (they sit at
  # the origin after center(exclude_zero_networks = TRUE)).
  fit_rows <- rep(TRUE, nrow(weights))
  if (isTRUE(exclude_zero_networks)) {
    fit_rows <- rowSums(abs(weights)) != 0
    if (!any(fit_rows)) fit_rows[] <- TRUE
  }
  fit_points <- points[fit_rows, , drop = FALSE]
  fit_weights <- weights[fit_rows, , drop = FALSE]

  if(ordered) {
    positions <- directed_node_positions(fit_weights, fit_points, ncol(points), self_weight = self_weight);
  }
  else {
    # Unordered: libena's layout-agnostic solver, driven by the set's
    # adjacency key -- the same result as lws_lsq_positions() for the usual
    # choose(n, 2) columns, and it also places self-connection columns
    # (A & A; accumulate(self_connections = TRUE)), each counted
    # `self_weight` times as in ordered models. Sets without a key matching
    # the columns use the upper-triangle solver.
    key <- x$rotation$adjacency.key
    if (!is.null(key) && ncol(as.matrix(key)) == ncol(weights)) {
      positions <- node_positions_by_key(fit_weights, fit_points, ncol(points), key,
                                         key_codes(key, x$rotation$codes), self_weight = self_weight);
    }
    else {
      positions <- lws_lsq_positions(fit_weights, fit_points, ncol(points));
    }
    if (!all(fit_rows)) {
      # ENAset's center.align.to.origin rule for unordered sets: put the mean
      # centroid of the fitted units at the origin, moving the nodes with it.
      mean_centroid <- colMeans(positions$centroids)
      positions$centroids <- sweep(positions$centroids, 2, mean_centroid, "-")
      positions$nodes <- sweep(positions$nodes, 2, mean_centroid, "-")
    }
  }

  if (!all(fit_rows)) {
    centroids <- matrix(0, nrow = nrow(weights), ncol = ncol(positions$centroids))
    centroids[fit_rows, ] <- positions$centroids
    positions$centroids <- centroids
  }

  # Recorded so post-fit centroid recomputation (move_nodes_to_unit_circle)
  # uses the weighting the nodes were fit with.
  x$rotation$self.weight <- self_weight;
  x$rotation$nodes <- as_nodes_matrix(positions$nodes, list("code" = x$rotation$codes), cols = colnames(as.matrix(x$points)), cls = "ena.nodes")

  x$model$centroids <- as_nodes_matrix(positions$centroids, rows = list("ENA_UNIT" = x$points$ENA_UNIT), cols = colnames(as.matrix(x$points)))

  return(x)
}

#' Plot an ena.set object
#'
#' @param x ena.set to plot
#' @param y ignored.
#' @param ... Additional parameters passed along to ena.plot functions
#' @param empty Logical; if TRUE, creates an empty plot without points. Default is TRUE.
#' @param title Character; title for the plot. Default is "ENA Plot".
#'
#' @examples
#'
#' data(RS.data)
#'
#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
#'   'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
#'
#' accum = ena.accumulate.data(
#'   units = RS.data[,c("UserName","Condition")],
#'   conversation = RS.data[,c("Condition","GroupName")],
#'   metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post")],
#'   codes = RS.data[,codeNames],
#'   window.size.back = 4
#' )
#'
#' set = ena.make.set(
#'   enadata = accum
#' )
#'
#' plot(set) |>
#'   add_points(Condition$FirstGame, colors = "blue", with.mean = TRUE) |>
#'   add_points(Condition$SecondGame, colors = "red", with.mean = TRUE) |>
#'   with_means() |>
#'   add_nodes()
#'
#' myENAplot <- plot(set) |>
#'   add_network(Condition$FirstGame - Condition$SecondGame)
#' 
#' 
#' # Add a group mean to an existing ENA plot
#' add_group(myENAplot, wh = Condition$FirstGame)
#' 
#' # Add a trajectory to an existing ENA plot
#' add_trajectory(myENAplot, wh = Condition$FirstGame)
#' 
#' @example inst/examples/example-plot-piping.R
#' 
#' @return ena.plot.object
#' @export
plot.ena.set <- function(x, y, ..., empty = TRUE, title = "ENA Plot") {
  args <- list(...);

  if(is(x, "ena.ordered.set")) {
    stop("Plotting of ena.ordered.set objects requires using the 'ona' package.");
  }

  p = ena.plot(enaset = x, title = title, ...);
  if (isFALSE(empty)) {
    add_points(p, ...);
  }

  return(p)
}


#' Add points to an ENA plot
#'
#' This function adds points to an existing ENA plot or ENA set. It supports various input types for the `wh` parameter, including unevaluated expressions and language objects.
#'
#' @param x An `ENAplot` object or an ENA set containing plots.
#' @param wh Specifies the points to plot. Can be an unevaluated expression or a language object.
#' @param ... Additional parameters passed to the plotting functions.
#' @param colors A vector of colors for the plotted points. Default is `NULL`.
#'
#' @details
#' The function determines the type of the `wh` parameter and processes it accordingly:
#' - If `wh` is an unevaluated expression, it is captured and evaluated in the parent frame.
#' - If `wh` is a language object, it is processed to extract the relevant points information.
#'
#' The function updates the plot with the new points and stores the updated plot back in the ENA set.
#'
#' @example inst/examples/example-plot-piping.R
#' 
#' @return Invisibly returns the modified ENA set.
#'
#' @export
add_points <- function(
  x,
  wh = NULL, ...,
  colors = NULL
) {
  plot <- x;
  set <- plot$enaset;

  if(is.null(plot)) {
    stop("No existing plot found in the ENA set. Did you call plot(set) first?")
  }
  # plot <- set$plots[[length(set$plots)]]
  more.args <- list(...)

  wh_subbed <- substitute(wh)
  if (is.language(wh_subbed)) {
    # points <- list(do.call(`[`, list(x = set$points, i = wh)));
    points <- list(eval(prefix_expr(wh_subbed, quote(set$points))));
    colors <- if (is.null(colors)) plot$palette[length(plot$plotted$points) + 1] else colors[1];  # one group, one color
    named <- paste(as.character(wh_subbed)[-1], collapse = " ");
  }
  else if (!is.null(wh_subbed) && length(wh_subbed) > 0) {
    wh_subbed <- as.character(wh_subbed);
    if (length(wh_subbed) > 1 && wh_subbed[[2]] %in% colnames(set$points)) {
      cc <- call(wh_subbed[[1]], set$points, wh_subbed[[2]])
      part1 <- eval(cc);
      name <- paste(wh_subbed[-1], collapse = "$");
      if(grepl(set$model$model.type, pattern="Trajectory")) {
        points <- set$points[part1 == wh_subbed[[3]], ]
        more.args$points = points[, .SD[nrow(.SD)], by = ENA_UNIT]
      }
      else {
        more.args$points = points <- set$points[part1 == wh_subbed[[3]], ]
      }

      if(is.null(colors)) {
        colors = plot$palette[length(plot$plotted$points) + 1]
      }
    }
    else if (length(wh_subbed) == 1 && wh_subbed[[1]] %in% colnames(set$points)) {
      more.args$points = points = set$points
      if(is.null(colors)) {
        colors <- plot$palette[as.numeric(as.factor(set$points[[wh_subbed]])) + length(plot$plotted$points)]
      }
      else {
        colors <- colors[as.numeric(as.factor(set$points[[wh_subbed]]))]
      }
    }
    else {
      points <- wh
      colors <- if (is.null(colors)) plot$palette[length(plot$plotted$points) + 1] else colors[1];  # one group, one color
    }
  }
  else {
    # first_meta <- setdiff(colnames(set$connection.counts)[find_meta_cols(set$connection.counts)], c("QEUNIT", "ENA_UNIT"))[1]
    # meta_grps <- split(set$points, by = first_meta)
    
    # points = meta_grps
    # named <- paste0(names(points), ".Points")
    # # colors = ifelse(is.null(colors), plot$palette[length(plot$plotted$points) + 1], colors)
    # colors <- plot$palette[seq.int(from=length(plot$plotted$points)+1,length.out=length(meta_grps))];
    points <- list(set$points);
    named <- "all.points";
    colors <- if (is.null(colors)) plot$palette[length(plot$plotted$points) + 1] else colors[1];  # one group, one color
  }

  mean <- ifelse(!is.null(more.args$mean), more.args$mean, FALSE);
  more.args$enaplot = plot
  for(i in seq_along(colors)) {
    color <- colors[i];
    name <- named[i];
    pts <- points[[i]];
    more.args$colors <- color;
    more.args$legend.name <- name;
    more.args$points <- pts;
    plot <- do.call(ena.plot.points, more.args);

    plot$plotted$points[[length(plot$plotted$points) + 1]] <- list(
      data = points,
      color = color
    )
    names(plot$plotted$points)[length(plot$plotted$points)] <- name;

    if(isTRUE(mean) && nrow(pts) > 1) {
      more.args$labels <- name;
      plot <- do.call(ena.plot.group, more.args);
    }
  }
  # if(!is.null(colors)) {
  #   more.args$colors = colors
  # }
  # else {
  #   more.args$colors = plot$palette[length(plot$plotted$points) + 1]
  # }
  

  # if(!is.null(mean) && (is.list(mean) || mean == T)) {
  #   # if (is.list(mean)) {
  #   #   more.args <- c(mean, more.args[!names(more.args) %in% names(mean)])
  #   # }
  #   # more.args$enaplot <- plot
  #   # more.args$points <- points
  #   # more.args$labels <- name
  #   #
  #   # plot <- do.call(ena.plot.group, more.args).
  #   set <- add_group(set, substitute(wh), ...);
  # }

  # set$plots[[length(set$plots)]] <- plot

  return(plot);
}

#' Add all groups to an ENA plot
#'
#' This function iterates over all unique values of the first metadata column (excluding 'QEUNIT' and 'ENA_UNIT')
#' in the ENA set and adds each group as a set of points to the ENA plot. This is useful for quickly visualizing
#' all groups in a categorical variable on the same plot.
#'
#' @param x An `ENAplot` object (as returned by `plot.ena.set`).
#' @param wh (Ignored) Included for compatibility with other plotting functions.
#'
#' @details
#' The function finds the first metadata column in the ENA set (excluding 'QEUNIT' and 'ENA_UNIT'),
#' and for each unique value in that column, calls `add_points()` to add the group's points to the plot.
#'
#' @return The modified `ENAplot` object with all groups added as points.
#' 
#' @example inst/examples/example-plot-piping.R
#'
#' @export
group <- function(x, wh = NULL) {
  plot <- x;
  set <- plot$enaset;

  first_meta <- setdiff(colnames(set$connection.counts)[find_meta_cols(set$connection.counts)], c("QEUNIT", "ENA_UNIT"))[1]
  
  plot$plotted$points <- list();
  # meta_grps <- split(set$points, by = first_meta);
  meta_grps <- unique(set$points[[first_meta]]);
  for(grp in meta_grps) {
    add_points(plot, wh = call("==", as.name(first_meta), grp));
  }

  # points = meta_grps
  return(plot);
}

#' Add a trajectory to an ENA plot
#'
#' This function adds a trajectory to an existing ENA plot or ENA set. It supports various input types for the `wh` parameter, including unevaluated expressions and language objects.
#'
#' @param x An `ENAplot` object or an ENA set containing plots.
#' @param wh Specifies the trajectory to plot. Can be an unevaluated expression or a language object.
#' @param ... Additional parameters passed to the plotting functions.
#' @param name A character string specifying the name of the plot. Default is "plot".
#'
#' @details
#' The function determines the type of the `wh` parameter and processes it accordingly:
#' - If `wh` is an unevaluated expression, it is captured and evaluated in the parent frame.
#' - If `wh` is a language object, it is processed to extract the relevant trajectory information.
#'
#' The function updates the plot with the new trajectory and stores the updated plot back in the ENA set.
#'
#' @return Invisibly returns the modified ENA set.
#'
#' @example inst/examples/example-plot-piping.R 
#'
#' @export
add_trajectory <- function(x, wh = NULL, ..., name = "plot") {
  plot <- x;
  if (.qe_backend(plot)) {
    .qe_no_trajectories("add_trajectory")
    return(plot)
  }
  set <- plot$enaset;

  subbed <- substitute(wh)
  args_list <- as.character(subbed)
  points <- set$points

  if (!is.null(args_list) && !is.null(subbed)) {
    if (length(args_list) > 1) {
      wh_subbed <- as.character(substitute(wh))
      cc <- call(wh_subbed[[1]], set$points, wh_subbed[[2]])
      part1 <- eval(cc)
      points <- set$points[part1 == wh_subbed[[3]], ]
      by <- "ENA_UNIT"
    }
    else {
      by <- args_list[[1]]
    }
  }
  else {
    by <- "ENA_UNIT"
  }
  plot <- ena.plot.trajectory(plot, points = points, by = by)

  # set$model$plot <- plot
  # set$plots[[length(x$plots)]] <- plot
  
  # .return(set, from_plot = T, invisible = F)
  return(plot)
}


#' Add a group mean to an ENA plot
#'
#' This function adds a group mean to an existing ENA plot or ENA set. It supports various input types for the `wh` parameter, including unevaluated expressions and language objects.
#'
#' @param x An `ENAplot` object or an ENA set containing plots.
#' @param wh Specifies the group to plot. Can be an unevaluated expression or a language object.
#' @param ... Additional parameters passed to the plotting functions.
#'
#' @details
#' The function determines the type of the `wh` parameter and processes it accordingly:
#' - If `wh` is an unevaluated expression, it is captured and evaluated in the parent frame.
#' - If `wh` is a language object, it is processed to extract the relevant group information.
#'
#' The function updates the plot with the new group mean and stores the updated plot back in the ENA set.
#'
#' @example inst/examples/example-plot-piping.R
#' 
#' @return Invisibly returns the modified ENA set.
#'
#' @export
add_group <- function(x, wh = NULL, ...) {
  plot <- x;
  set <- plot$enaset;

  # Capture the expression passed to wh
  wh.expr <- substitute(wh)

  # Check if the expression is a call to `substitute()`. This happens when
  # add_group is called from another function like add_points, which has
  # already substituted the user's original input.
  if (is.call(wh.expr) && deparse(wh.expr[[1]]) == "substitute") {
    # If so, evaluate it in the parent frame to get the actual language object
    wh.clean <- eval(wh.expr, parent.frame())
  } else {
    # Otherwise, the captured expression is what we want
    wh.clean <- wh.expr
  }

  # set <- x
  # # plot <- set$model$plot
  # # plot <- set$plots[[length(set$plots)]]

  if (
    identical(as.character(wh.clean), "wh.clean") ||
    identical(as.character(wh.clean), "y")
  ) {
    wh.clean <- wh;
  }

  more_args = list(...)
  more_args$enaplot <- plot
  if(is.null(more_args$color)) {
    more_args$colors <- plot$palette[length(plot$plotted$means) + 1]
  }
  else {
    more_args$colors <- more_args$color;
  }

  group.rows.log <- NULL;
  if (is.null(wh.clean)) {
    plot <- do.call(ena.plot.group, more_args)
    group.rows.log <- rep(TRUE, nrow(set$points));
  }
  else {
    parts <- as.character(wh.clean)

    if (parts[2] %in% colnames(set$line.weights)) {
      label <- parts[3]
      group.rows.log <- set$points[[parts[2]]] == parts[3];
      group.rows <- set$points[group.rows.log, ]
      if(nrow(group.rows) > 0) {
        group.means <- colMeans(group.rows)

        more_args$points <- group.means
        more_args$labels <- label
        plot <- do.call(ena.plot.group, more_args)
      }
      else {
        warning("No points in the group")
      }
    }
    else {
      warning("Unable to plot group")
    }
  }

  plot$plotted$means[[length(plot$plotted$means) + 1]] = list(
    rows = group.rows.log,
    data = more_args$points,
    color = more_args$colors
  )

  # set$plots[[length(set$plots)]] <- plot
  
  # .return(plot, from_plot = T, invisible = F)
  return(plot)
}


##' Add a network to an ENA plot
#'
#' Adds a network (set of edges) to an existing ENA plot or ENA set. The network can be specified in several ways, including as an unevaluated expression, a numeric matrix, or a language object. This function is typically used to visualize group means, differences between groups, or custom networks on an ENA plot.
#'
#' @param x An `ENAplot` object or an ENA set containing plots.
#' @param wh Specifies the network to plot. Can be:
#'   \itemize{
#'     \item An unevaluated expression (e.g., `Condition$FirstGame - Condition$SecondGame`)
#'     \item A numeric matrix or data.frame of edge weights
#'     \item A language object
#'     \item NULL (defaults to the mean network)
#'   }
#' @param ... Additional parameters passed to the plotting functions.
#' @param with.mean Logical; if `TRUE`, also plots the mean for the points in the network. Default is `FALSE`.
#' @param edge.multiplier Numeric scalar to multiply the edge weights. Useful for scaling the network visualization. Default is 1.
#' @param colors Optional vector of colors for the network. If not specified, colors are chosen from the plot palette.
#'
#' @details
#' The function determines the type of the `wh` parameter and processes it accordingly:
#' \itemize{
#'   \item If `wh` is an unevaluated expression, it is captured and evaluated in the parent frame. This allows for flexible specification of group means or differences.
#'   \item If `wh` is a numeric matrix or data.frame, its column means are plotted; a numeric vector (e.g. a subtracted network) is plotted as is.
#'   \item If `wh` is a language object, it is processed to extract the relevant network information.
#'   \item If `wh` is NULL, the mean network is plotted.
#' }
#'
#' The function updates the plot with the new network and returns the modified plot object. The ENA set is not modified in-place.
#'
#' @section Examples:
#'   See `inst/examples/example-plot-piping.R` for usage examples.
#'
#' @return The modified ENAplot object with the new network added.
#'
#' @export
add_network <- function(
  x, wh = NULL, 
  ..., 
  with.mean = F, 
  edge.multiplier = 1,
  colors = NULL
) {
  plot <- x;
  set <- plot$enaset;

  more_args <- list(...);
  # qeviz: weights unscaled, edge.multiplier -> magnify on this layer.
  backend <- if (.qe_backend(plot)) "qeviz" else "plotly"
  em <- .qe_weight_mult(backend, edge.multiplier)
  more_args$magnify <- .qe_magnify(backend, edge.multiplier)

  wh_subbed <- substitute(wh)
  network <- colMeans(set$line.weights);
  
  if (is.language(wh_subbed)) {
    network <- try(eval(wh_subbed, parent.frame()), silent = TRUE)
    if(inherits(network, "try-error")) {
      if(wh_subbed[[1]] == "-") {
        means <- sapply(c(wh_subbed[[2]], wh_subbed[[3]]), function(y) {
          colMeans(eval(prefix_expr(y, quote(set$line.weights))));
        })

        network <- means[,1] - means[,2];
        named <- as.character(enquote(wh_subbed))[2];
        colors <- if(is.null(colors)) {
          plot$palette[seq.int(length(plot$plotted$points) + 1, 2)]
        } else {
          if(length(colors) < 2) {
            stop("Please provide two colors for the two groups being compared.")
          } else {
            colors
          }
        }
      }
      else {
        network <- colMeans(eval(prefix_expr(wh_subbed, quote(set$line.weights))));
        if (is.null(colors)) colors <- plot$palette[length(plot$plotted$points) + 1];
        named <- paste(as.character(wh_subbed)[-1], collapse = " ");
      }
    }
    else if (is.matrix(network) || is.data.frame(network) || is.numeric(network)) {
      # a matrix of networks is averaged; a single network is used as is
      if (!is.null(dim(network))) network <- colMeans(network);
      if (is.null(colors)) colors <- plot$palette[length(plot$plotted$points) + 1];
      named <- paste(as.character(wh_subbed)[-1], collapse = " ");
    }
  }

  more_args$enaplot = plot;
  more_args$colors = colors;
  if(is.data.frame(network) || is.matrix(network) || is.numeric(network)) {
    more_args$network = network * em;
    plot <- do.call(ena.plot.network, more_args);
  }

  
  # .return(set, from_plot = T, invisible = F)
  return(plot);
}


#' Add nodes to an ENA plot
#'
#' This function adds nodes to an existing ENA plot or ENA set. It can be used to customize the nodes displayed on the plot, including their size and other graphical parameters.
#'
#' @param x An \code{ENAplot} object or an ENA set containing plots.
#' @param ... Additional arguments passed to \code{ena.plot.points}, such as \code{nodes}, \code{size}, and other graphical parameters.
#' @param return_plot Logical; if \code{TRUE}, returns the modified ENA set. If \code{FALSE} (default), returns the modified plot invisibly.
#'
#' @details
#' If \code{x} is an \code{ENAplot}, the function extracts the associated ENA set and plot. Otherwise, it assumes \code{x} is an ENA set and uses the last plot in the set.
#' The nodes to be added can be specified via the \code{nodes} argument; otherwise, the default nodes from the set's rotation are used.
#' Node size can be customized via the \code{size} argument.
#'
#' The function updates the plot with the new nodes and stores the updated plot back in the ENA set.
#'
#' @return Invisibly returns the modified plot or ENA set, depending on the value of \code{return_plot}.
#'
#' @example inst/examples/example-plot-piping.R
#'
#' @export
add_nodes <- function(x, ..., return_plot = FALSE) {
  plot <- x;
  set <- plot$enaset;

  dot_args <- list(...);
  if(!is.null(dot_args$nodes)) {
    nodes <- dot_args$nodes;
  }
  else {
    nodes <- set$rotation$nodes;
  }

  node_sizes <- 1;
  if(!is.null(dot_args$size)) {
    node_sizes <- dot_args$size;
  }

  plot <- ena.plot.points(plot,
            points = as.matrix(nodes),
            texts = as.character(nodes$code),
            point.size = node_sizes,
            ...
          );

  plot$plotted$networks[[length(plot$plotted$networks) + 1]] <- list(
    nodes = nodes,
    data = NULL,
    color = NULL
  );

  # set$plots[[length(set$plots)]] <- plot

  return(plot);
}

#' Adds group means to the ENA plot.
#'
#' This function iterates over the plotted points in the ENA plot and calculates
#' the mean for each group of points. The calculated means are then added to the
#' plot as group means.
#'
#' @param x An ENA set object containing the plots.
#'
#' @return Invisibly returns the modified ENA set object with updated plots.
#'
#' @export
with_means <- function(x) {
  plot <- x;
  set <- plot$enaset;

  for(point_group in plot$plotted$points) {
    plot <- ena.plot.group(plot, point_group$data[[1]], colors = point_group$color[1])

    plot$plotted$means[[length(plot$plotted$means) + 1]] <- list(
      data = colMeans(point_group$data[[1]]),
      color = point_group$color[1]
    )
  }

  return(plot)
}


#' Adds trajectories to an ENA plot.
#'
#' This function generates trajectories for the plotted points in the ENA plot based on the specified grouping variables.
#' It supports options for jittering, animation, and scaling.
#'
#' @param x An ENA set object containing the plots.
#' @param ... Additional arguments passed to the plotting functions.
#' @param by A character vector specifying the grouping variables for the trajectories. Default is the first conversation parameter in the ENA set.
#' @param add_jitter Logical; if `TRUE`, adds jitter to the trajectory points. Default is `TRUE`.
#' @param frame Numeric; the duration of each frame in the animation. Default is 1100.
#' @param transition Numeric; the duration of the transition between frames. Default is 1000.
#' @param easing A character string specifying the easing function for the animation. Default is "circle-in-out".
#'
#' @return Invisibly returns the modified ENA set object with updated plots.
#'
#' @export
with_trajectory <- function(
  x, ...,
  by = x$`_function.params`$conversation[1],
  add_jitter = TRUE,
  frame = 1100,
  transition = 1000,
  easing = "circle-in-out"
) {
  set <- x
  if (length(set$plots) && .qe_backend(set$plots[[length(set$plots)]])) {
    .qe_no_trajectories("with_trajectory")
    return(invisible(set))
  }
  if(!grepl(x = set$model$model.type, pattern = "Trajectory")) {
    stop(paste0("Unable to plot trajectories on model of type: ", set$model$model.type))
  }
  plot <- set$plots[[length(set$plots)]]

  args = list(...)

  all_steps_w_zero <- data.table(rbind(
    rep(0, length(by)),
    expand.grid(
      sapply(by, function(b) sort(unique(set$points[[b]]))),
      stringsAsFactors = F
    )
  ))
  colnames(all_steps_w_zero) <- by
  point_group_names <- seq(plot$plotted$points)
  points_cleaned <- lapply(point_group_names, function(n) {
    prepare_trajectory_data(
      points = plot$plotted$points[[n]]$data,
      by = by,
      units = plot$plotted$points[[n]]$data,
      units_by = set$`_function.params`$units,
      steps = all_steps_w_zero
    )
  })
  names(points_cleaned) <- sapply(plot$plotted$points, "[[", "color")
  points_cleaned <- rbindlist(points_cleaned, idcol = "color")

  meta_data = unique(set$meta.data)
  setkey(points_cleaned, ENA_UNIT)
  setkey(meta_data, ENA_UNIT)
  points_cleaned = meta_data[points_cleaned]
  setkeyv(points_cleaned, by)

  size = ifelse(is.null(args$size), 10, args$size)
  opacity = ifelse(is.null(args$opacity), 1, args$opacity)

  dims = as.matrix(points_cleaned[, find_dimension_cols(points_cleaned), with = F])[, 1:2]
  if(add_jitter) {
    dims[, 1] = jitter(dims[, 1])
    dims[, 2] = jitter(dims[, 2])
  }

  if(is.null(args$scale)) {
    max_abs = max(abs(dims))
    scale = c(-1*max_abs, max_abs)
  }
  else {
    scale = args$scale
  }

  ax <- list(
    range = scale, title = "",
    zeroline = TRUE, showline = FALSE,
    showticklabels = FALSE, showgrid = FALSE
  )

  #####
  ### Add to the plot
  #####
    thisPlot <- plotly::plot_ly(
        data = points_cleaned,
        x = dims[,1], y = dims[,2],
        text = ~ENA_UNIT,
        frame = as.formula(paste0("~", by)),
        type = 'scatter',
        mode = 'markers',
        marker = list(
          size = size,
          opacity = opacity,
          hoverinfo = "text",
          color = as.numeric(as.factor(points_cleaned[["color"]]))
        )
      ) |>
      plotly::layout(
        xaxis = ax,
        yaxis = ax,
        showlegend = T
      ) |>
      plotly::animation_opts(
        frame = frame,
        transition = transition,
        easing = easing,
        redraw = T
      )
  #####

  # set$model$plot <- plot
  set$plots[[length(set$plots) + 1]] <- thisPlot
  invisible(set)
}

#' Prepares trajectory data for an ENA plot.
#'
#' This function processes and prepares trajectory data for plotting in an ENA set. It handles rotation, grouping, and filling missing steps in the trajectory.
#'
#' @param x An ENA set object. If `NULL`, other parameters must be provided.
#' @param by A character vector specifying the grouping variables for the trajectory. Default is the first conversation parameter in the ENA set.
#' @param rotation_matrix A matrix used to rotate the points. Default is the rotation matrix from the ENA set.
#' @param points A data table of points to be processed. Default is the points from the ENA set.
#' @param units A data table of units corresponding to the points. Default is the trajectories or points from the ENA set.
#' @param units_by A character vector specifying the unit grouping variables. Default is the unit parameters from the ENA set.
#' @param steps A data table specifying the steps for the trajectory. If `NULL`, steps are generated automatically.
#'
#' @return A data table containing the processed trajectory data, including dimensions and metadata.
prepare_trajectory_data <- function(
  x = NULL,
  by = x$`_function.params`$conversation[1],
  rotation_matrix = x$rotation.matrix,
  points = NULL,
  units = points,
  units_by = x$`_function.params`$units,
  steps = NULL
) {
  if(is(x, "ena.set")) {
    if(is.null(points))
      points <- x$points
    if(is.null(units))
      units <- x$trajectories #points[, find_meta_cols(points), with = FALSE]
  }

  unique_unit_values <- unique(units[, c(units_by, "ENA_UNIT"), with = FALSE])

  if(!is.null(rotation_matrix)) {
    rotation_matrix = as.matrix(rotation_matrix)
    full_data <- cbind(units, as.matrix(points) %*% rotation_matrix)
  } else {
    full_data <- cbind(units, as.matrix(points))
  }
  full_data <- full_data[, unique(names(full_data)), with = FALSE]

  if(is.null(steps)) {
    all_steps_w_zero <- data.table(rbind(
      rep(0, length(by)),
      expand.grid(
        sapply(by, function(b) sort(unique(units[[b]]))),
        stringsAsFactors = F
      )
    ))
    colnames(all_steps_w_zero) <- by
  } else {
    all_steps_w_zero <- steps
  }
  all_step_data <- CJ(all_steps_w_zero[[by]], unique_unit_values$ENA_UNIT)
  colnames(all_step_data) <- c(by, "ENA_UNIT")

  dimension_col_names = colnames(points)[
                          which(sapply(points, function(col) {
                            is(col, "ena.dimension")
                          }))
                        ]
  all_step_data[, c(dimension_col_names) := 0]
  all_step_data[[by]] = as.ena.metadata(all_step_data[[by]])
  all_step_data = merge(unique_unit_values, all_step_data, by = "ENA_UNIT")
  setkey(all_step_data, "ENA_UNIT")

  filled_data = all_step_data[ , {
      by_names = names(.BY)
      user_rows = sapply(1:length(by_names), function(n) {
          full_data[[by_names[n]]] == .BY[n]
      })
      existing_row = which(rowSums(user_rows * 1) == 2)
      if(length(existing_row) > 0) {
        full_data[existing_row, c(dimension_col_names), with = FALSE]
      } else {
        prev_row = tail(full_data[ENA_UNIT == .BY$ENA_UNIT & full_data[[by]] < .BY[[by]],], 1)
        if(nrow(prev_row) == 0) {
          data.table(matrix(rep(0, length(dimension_col_names)), nrow = 1, dimnames = list(NULL, c(dimension_col_names))))
        } else {
          prev_row[, c(dimension_col_names), with = FALSE]
        }
      }

  },  by = c("ENA_UNIT", by)]
  for(col in dimension_col_names) {
    set(filled_data, j = col, value = as.ena.dimension(filled_data[[col]]))
  }
  return(filled_data)
}

#' Clears specified plots from an ENA set.
#'
#' This function removes the plots specified by their indices from the `plots` field of the ENA set.
#'
#' @param x An ENA set object containing the plots.
#' @param wh A numeric vector specifying the indices of the plots to clear. Default is all plots.
#'
#' @return Invisibly returns the modified ENA set object with the specified plots removed.
#'
#' @example inst/examples/example-plot-piping.R
#' 
#' @export
clear <- function(x, wh = seq(x$plots)) {
  if(length(wh) > 0) {
    x$plots[[wh]] <- NULL
  }
  invisible(x)
}

#' Scales the points in an ENA set.
#'
#' This function adjusts the scale of the points in the ENA set to match the range of the network.
#'
#' @param x An ENAplot object containing the set to scale.
#' @param center Unused parameter, included for compatibility.
#' @param scale A numeric value specifying the scaling factor. If `NULL`, the function will determine the scale based on the data.
#'
#' @return The modified ENAplot object with scaled points.
#'
#' @export
scale.ENAplot <- function(x, center = NULL, scale = NULL) {
  plot <- x
  set <- plot$enaset;

  point_range <- range(set$points);
  network_range <- range(set$rotation$nodes);

  if(is.null(scale)) {
    scale <- min(abs(network_range) / abs(point_range));
  }

  set$points <- set$points * scale;

  return(plot)
}

#' Updates the axis ranges of an ENA plot based on the plotted data.
#'
#' This function adjusts the x and y axis ranges of the ENA plot to ensure that all plotted points, networks, and means are visible.
#'
#' @param x An ENA plot object containing the plotted data and axis configurations.
#'
#' @return The updated ENA plot object with adjusted axis ranges.
#'
#' @export
check_range <- function(x) {
  if (.qe_backend(x)) return(.qe_check_range(x))
  numbers <- as.numeric(sapply(x$plotted$points, function(p) max(as.matrix(p$data))));
  means <- as.numeric(sapply(x$plotted$means, function(p) max(as.matrix(p$data))));

  network <- NULL;
  if(length(x$plotted$networks) > 0) {
    network <- abs(as.numeric(sapply(x$plotted$networks, function(nn) sapply(nn, `[`, c("x0","x1","y0","y1")))));
  }

  if(
    length(numbers) == 0 &&
    length(means) == 0
  ) {
    return(x)
  }

  curr_max = max(c(numbers, network, means))
  if(curr_max*1.2 > max(x$axes$y$range)) {
    this.max = curr_max * 1.2
    x$axes$x$range = c(-this.max, this.max)
    x$axes$y$range = c(-this.max, this.max)
    x$plot = plotly::layout(
      x$plot,
      xaxis = x$axes$x,
      yaxis = x$axes$y
    );
  } else if (curr_max < max(x$axes$y$range*0.5)) {
    this.max = curr_max * 1.2
    x$axes$x$range = c(-this.max, this.max)
    x$axes$y$range = c(-this.max, this.max)
    x$plot = plotly::layout(
      x$plot,
      xaxis = x$axes$x,
      yaxis = x$axes$y
    );
  }

  x
}

#' Display and update plot objects within a custom object
#'
#' This function updates the plots within the provided object by applying the `check_range` function to each plot.
#' It then prints the updated object using custom print options and returns the object invisibly.
#'
#' @param x An object containing a list of plots in the `plots` field.
#' @param ... Additional arguments passed to the `print` method.
#'
#' @return The updated object `x`, returned invisibly.
#'
#' @export
show <- function(x, ...) {
  # browser()
  x$plots <- lapply(x$plots, check_range)
  print(x, ..., plot = T, set = F)
  invisible(x)
}

# Prefix the leftmost name of a selector such as `Condition$FirstGame` with
# `prefix`, giving `set$points$Condition$FirstGame`, without deparsing and
# re-parsing the expression.
prefix_expr <- function(expr, prefix) {
  if (is.symbol(expr)) return(call("$", prefix, expr))
  expr[[2]] <- prefix_expr(expr[[2]], prefix)
  expr
}

# R wrappers that preserve rENA's long-standing function names.  The math
# lives in C++: ENA model code in libena (inst/include/libena, wrapped in
# src/libena_rcpp.cpp), accumulation in tma (libtma) and generic numerics in
# libqe.
#
# Public API functions (exported) are marked @export.
# Internal functions (not exported) have no @export tag.

# ── public API ────────────────────────────────────────────────────────────────

#' Merge data frame columns
#'
#' Paste together multiple columns of a data frame or data.table with a
#' separator, used internally to construct unit-ID strings.
#'
#' @param df    A data.frame or data.table
#' @param cols  Character vector of column names to paste together
#' @param sep   Separator string (default "::")
#' @return A character vector of length \code{nrow(df)}
#' @export
merge_columns_c <- function(df, cols, sep = "::") {
  do.call(paste, c(lapply(cols, function(col) df[[col]]), list(sep = sep)))
}

#' Row-wise L2 (Sphere) Normalization
#'
#' Normalizes each row of a numeric data frame or matrix to unit L2 norm.
#'
#' @param dfM A data.frame or matrix
#' @return A numeric matrix with each row normalized to unit L2 length
#' @export
fun_sphere_norm <- function(dfM) {
  libqe::normalize_networks(as.matrix(dfM))
}

#' Row-wise Max-Norm Scaling
#'
#' Scales all rows of a numeric data frame by dividing by the largest row
#' L2 norm.
#'
#' @param dfM A data.frame or matrix
#' @return A numeric matrix scaled by the largest row L2 norm
#' @export
fun_skip_sphere_norm <- function(dfM) {
  libqe::scale_networks(as.matrix(dfM))
}

#' Upper Triangle from Vector (numeric)
#'
#' Compute pairwise products v[j] * v[i] for all j < i.
#'
#' @param v Numeric vector or single-row matrix
#' @return Numeric row vector of pairwise products
#' @export
vector_to_ut <- function(v) {
  libqe::code_connections(as.matrix(v))
}

#' Directed ENA node positions
#'
#' Least-squares node positions for directed ENA.
#'
#' @param line_weights Numeric matrix (units x connections)
#' @param points       Numeric matrix of rotated points (units x dims)
#' @param numDims      Number of dimensions
#' @param self_weight  Weight of a self-connection (the diagonal: ground i -> response i) in its code's node weight: 2 (default) counts it in both the node's row and column sums (Zhiqiang Cai's 2021 in + out rule); 1 counts it once.
#' @return List with nodes, centroids, weights, points
#' @export
directed_node_positions <- function(line_weights, points, numDims, self_weight = 2) {
  directed_node_positions_c(line_weights, points, numDims, self_weight)
}

#' Directed node positions with ground+response combined
#'
#' Directed node positions with paired ground+response rows combined.
#'
#' @param line_weights Numeric matrix (units x connections)
#' @param points       Numeric matrix of rotated points (units x dims)
#' @param numDims      Number of dimensions
#' @param self_weight  Weight of a self-connection (the diagonal: ground i -> response i) in its code's node weight: 2 (default) counts it in both the node's row and column sums (Zhiqiang Cai's 2021 in + out rule); 1 counts it once.
#' @return List with nodes, centroids, weights, points
#' @export
directed_node_positions_with_ground_response_added <- function(line_weights,
                                                                points,
                                                                numDims,
                                                                self_weight = 2) {
  directed_node_positions_combine_pairs(line_weights, points, numDims, self_weight)
}

#' Layout-agnostic node positions from an adjacency key
#'
#' Node optimization for any connection layout -- undirected, undirected with
#' self-connections, or ordered: every connection counts toward each code it
#' connects, a self-connection (a column whose two codes are the same) toward
#' its code \code{self_weight} times; each unit's weights are then
#' L1-normalised and the nodes solved by least squares against the points.
#' With an undirected key it matches \code{lws_lsq_positions()}; with an
#' ordered key, \code{directed_node_positions()} at the same \code{self_weight}.
#'
#' @param line_weights Numeric matrix (units x connections)
#' @param points       Numeric matrix of rotated points (units x dims)
#' @param numDims      Number of dimensions
#' @param key          Adjacency key: a 2 x n_connections matrix of code names,
#'   one column per connection (e.g. \code{set$rotation$adjacency.key})
#' @param codes        Character vector of codes; node order
#' @param self_weight  Weight of a self-connection in its code's node weight
#'   (2 = row + column sum, as ordered models; 1 = once)
#' @return List with nodes, centroids, weights, points
#' @export
node_positions_by_key <- function(line_weights, points, numDims, key, codes, self_weight = 2) {
  ft <- key_indices(key, codes)
  node_positions_by_key_c(as.matrix(line_weights), as.matrix(points), numDims,
                          ft$from, ft$to, length(codes), self_weight)
}

#' Layout-agnostic node centroids from an adjacency key
#'
#' The weighting of \code{node_positions_by_key()} times \code{nodes}.
#'
#' @inheritParams node_positions_by_key
#' @param nodes Numeric matrix of node positions (codes x dims), in \code{codes} order
#' @return Numeric matrix of centroids (units x dims)
#' @export
node_centroids_by_key <- function(line_weights, nodes, key, codes, self_weight = 2) {
  ft <- key_indices(key, codes)
  node_centroids_by_key_c(as.matrix(line_weights), as.matrix(nodes), ft$from, ft$to, self_weight)
}

# The codes as the key names them: the key is built from the connection
# column names, which may be make.names() of the codes.
key_codes <- function(key, codes) {
  named <- unique(as.character(as.matrix(key)))
  if (all(named %in% codes)) codes else make.names(codes)
}

# 0-based code indices of each key column.
key_indices <- function(key, codes) {
  key <- as.matrix(key)
  if (nrow(key) != 2) stop("key must have 2 rows (one column per connection)")
  from <- match(as.character(key[1, ]), codes)
  to   <- match(as.character(key[2, ]), codes)
  if (anyNA(c(from, to))) {
    stop("key names codes not in `codes`: ",
         paste(unique(c(key[1, is.na(from)], key[2, is.na(to)])), collapse = ", "))
  }
  list(from = from - 1L, to = to - 1L)
}

#' Calculate ENA correlations
#'
#' Pearson correlation with confidence interval between ENA points and
#' centroids.
#'
#' @param points     Numeric matrix (units x dims)
#' @param centroids  Numeric matrix (units x dims)
#' @param conf_level Confidence level (default 0.95)
#' @return Numeric matrix with columns: r, lower CI, upper CI
#' @export
ena_correlation <- function(points, centroids, conf_level = 0.95) {
  ena_correlation_c(points, centroids, conf_level)
}

#' Confidence intervals around group mean positions
#'
#' Per-dimension t-based confidence intervals around the column means of a
#' numeric matrix of ENA points.
#'
#' @param points     Numeric matrix (units x dims)
#' @param conf_level Confidence level (default 0.95)
#' @return Numeric matrix (dims x 3): mean, lower CI, upper CI
#' @export
ena_mean_ci <- function(points, conf_level = 0.95) {
  libqe::mean_ci(as.matrix(points), conf_level)
}

#' Outlier (Tukey-fence) intervals for group positions
#'
#' Per-dimension Tukey-fence intervals: Q1 - k*IQR to Q3 + k*IQR.
#'
#' @param points     Numeric matrix (units x dims)
#' @param iqr_factor IQR multiplier (default 1.5)
#' @return Numeric matrix (dims x 2): lower fence, upper fence
#' @export
ena_outlier_ci <- function(points, iqr_factor = 1.5) {
  libqe::outlier_ci(as.matrix(points), iqr_factor)
}

#' Two-group comparison statistics for ENA points
#'
#' Per-dimension parametric (Welch t-test, Cohen's d) and non-parametric
#' (Wilcoxon rank-sum, rank-biserial r) statistics comparing two groups.
#'
#' @param g1 Numeric matrix of group 1 points (units x dims)
#' @param g2 Numeric matrix of group 2 points (units x dims)
#' @return List with: n1, n2, t, df, pvalue_t, cohens_d, means, sds,
#'   U, pvalue_u, effect_r, medians — each a vector/matrix of length dims
#' @export
ena_group_stats <- function(g1, g2) {
  libqe::group_stats(as.matrix(g1), as.matrix(g2))
}

# ── internal (not exported) ───────────────────────────────────────────────────

# Per-row upper-triangle co-occurrence.
# @param df     A data.frame or matrix of code columns
# @param binary If TRUE, binarise non-zero products
rows_to_co_occurrences <- function(df, binary = TRUE) {
  tma::row_connections(as.matrix(df), binary)
}

# Stanza-window co-occurrence accumulation.
# @param df            A data.frame or matrix of code columns
# @param windowSize    Rows to look back (default 1; Inf = whole conversation)
# @param windowForward Rows to look forward (default 0)
# @param binary        Binarise co-occurrence counts (default TRUE)
ref_window_df <- function(df, windowSize = 1, windowForward = 0,
                           binary = TRUE) {
  INT_MAX <- .Machine$integer.max
  wb <- if (is.infinite(windowSize)    || windowSize    >= INT_MAX) INT_MAX
        else as.integer(windowSize)
  wf <- if (is.infinite(windowForward) || windowForward >= INT_MAX) INT_MAX
        else as.integer(windowForward)
  data.table::as.data.table(tma::accumulate_stanza(as.matrix(df), wb, wf, binary))
}

# Rolling backward window sum of code columns.
# @param df         A data.frame or matrix of code columns
# @param windowSize Number of rows to look back (default 0, treated as 1)
# @param binary     Unused; kept for API compatibility
ref_window_lag <- function(df, windowSize = 0, binary = TRUE) {
  tma::rolling_window_sum(as.matrix(df), windowSize)
}

# Upper-triangle index pairs (0-based, +1 before use as R indices).
# @param len Side length of square code matrix
# @param row -1 = both rows, 0 = row indices, 1 = col indices
triIndices <- function(len, row = -1L) {
  libqe::connection_indices(len, row)
}

# Least-squares node positions (undirected ENA).
# @param adjMats  Numeric matrix of line weights (units x connections)
# @param t        Numeric matrix of rotated points (units x dims)
# @param numDims  Number of dimensions
lws_lsq_positions <- function(adjMats, t, numDims) {
  node_positions(adjMats, t, numDims)
}

# String upper-triangle pairs: "A" "B" "C" -> "A & B" "A & C" "B & C".
# @param v Character vector of code names
svector_to_ut <- function(v) {
  libqe::connection_names(v)
}

# Center data by subtracting column means.
# @param values Numeric matrix or data.frame
center_data_c <- function(values) {
  libqe::center_points(as.matrix(values))
}

####
#' ENAdata R6class
#'
#' @docType class
#' @importFrom R6 R6Class
#' @import data.table
#' @export
#'
#' @field raw A data frame constructed from the unit, convo, code, and metadata parameters of ena.accumulate.data
#' @field adjacency.vectors A data frame of adjacency (co-occurrence) vectors by row
#' @field accumulated.adjacency.vectors A data frame of adjacency (co-occurrence) vectors accumulated per unit
#' @field model The type of ENA model: EndPoint, Accumulated Trajectory, or Separate Trajectory
#' @field units A data frame of columns that were combined to make the unique units. Includes column for trajectory selections. (unique)
#' @field unit.names A vector of unique unit values
#' @field metadata A data frame of unique metadata for each unit
#' @field trajectories A list: units - data frame, for a given row tells which trajectory it's a part; step - data frame, where along the trajectory a row sits
#'
#' @field adjacency.matrix TBD
#' @field adjacency.vectors.raw TBD
#' @field codes A vector of code names
#' @field function.call The string representation of function called and parameters provided
#' @field function.params A list of all parameters sent to function call
####
ENAdata <- R6::R6Class("ENAdata", public = list(

  #' Construct ENAdata
  #'
  #' @param file TBD
  #' @param units TBD
  #' @param units.used TBD
  #' @param units.by TBD
  #' @param conversations.by TBD
  #' @param codes TBD
  #' @param model TBD
  #' @param weight.by TBD
  #' @param window.size.back TBD
  #' @param window.size.forward TBD
  #' @param mask TBD
  #' @param include.meta logical, if TRUE (default) unit metadata is attached to the resulting ENAdata object and accessible via the set; set to FALSE to omit metadata from the model output
  #' @param ... TBD
  #'
  #' @return
  initialize = function(
    file,
    units = NULL,
    units.used = NULL,
    units.by = NULL,
    conversations.by = NULL,
    codes = NULL,
    model = NULL,
    weight.by = "binary",
    window.size.back = 1,
    window.size.forward = 0,
    mask = NULL,
    include.meta = T,
    ...
  ) {
    args <- list(...);
    self$function.call <- sys.call(-1);
    self$function.params <- list();

    private$file <- file;
    self$units <- units;
    private$units.used <- units.used;
    private$units.by <- units.by
    private$conversations.by <- conversations.by;
    self$codes <- codes;

    if (is.data.frame(self$codes)) {
      self$codes <- colnames(self$codes);
    }

    private$weight.by <- weight.by;
    private$window.size <- list(
      "back" = window.size.back,
      "forward" = window.size.forward
    );

    for (p in c("units", "units.used", "units.by",
               "conversations.by", "codes", "model", "weight.by",
               "window.size.back", "window.size.forward", "mask",
               "in.par", "grainSize", "include.meta")
    ) {
      if (exists(p, inherits = FALSE)) {
        self$function.params[[p]] <- get(p, inherits = FALSE)
      }
      else if (!is.null(args[[p]])) {
        self$function.params[[p]] <- args[[p]]
      }
    }

    self$model <- model

    private$mask <- mask

    return(self)
  },

    ## Public Properties ----
      model = NULL,
      raw = NULL,
      adjacency.vectors = NULL,
      adjacency.matrix = NULL,
      accumulated.adjacency.vectors = NULL,
      adjacency.vectors.raw = NULL,
      units = NULL,
      unit.names = NULL,
      metadata = NULL,
      trajectories = list(
        units = NULL,
        step = NULL
      ),
      codes = NULL,
      function.call = NULL,
      function.params = NULL,

    ## Public Functions ----

      #' Process accumulation
      #'
      #' @return ENAdata
      process = function() {
        private$loadFile();
      },

      #' Get property from object
      #'
      #' @param x character key to retrieve from object
      #' @return value from object at x
      get = function(x = "data") {
        return(private[[x]])
      },

      #' Add metadata
      #'
      #' @param merge logical (default: FALSE)
      #'
      #' @return data.frame
      add.metadata = function(merge = F) {
        meta_avail <- colnames(self$raw)[
          -which(colnames(self$raw) %in%
                  c(self$codes, private$units.by, private$conversations.by))]
                  # c(self$codes, private$units.by))] # private$conversations.by))]

        meta_avail <- meta_avail[which(meta_avail != "ENA_UNIT")]
        meta_cols_to_use <- meta_avail[apply(self$raw[, lapply(.SD, uniqueN),
                                                    by = c(private$units.by),
                                                    .SDcols = meta_avail
                                                 ][, c(meta_avail), with = F]
                                    , 2, function(x) all(x == 1))
                                  ]
        raw.meta <- self$raw[!duplicated(ENA_UNIT)][
                      ENA_UNIT %in% unique(
                        self$accumulated.adjacency.vectors$ENA_UNIT
                      ),
                      c("ENA_UNIT", private$units.by, meta_cols_to_use),
                      with = F
                    ]

        df_to_return <- raw.meta[ENA_UNIT %in% self$unit.names,];

        return(df_to_return)
      }

  ),

  ### Private ----
  private = list(

    ## Private Properties ----
      file = NULL,
      window.size = NULL,
      units.used = NULL,
      units.by = NULL,
      conversations.by = NULL,
      weight.by = NULL,
      trajectory.by = NULL,
      mask = NULL,

    ## Private Functions ----
      loadFile = function() {
      if(any(class(private$file) == "data.table")) {
        df_DT <- private$file
      } else {
        if(any(class(private$file) == "data.frame")) {
          df <- private$file
        } else {
          df <- read.csv(private$file)
        }
        df_DT <- data.table::as.data.table(df)
      }

      self$raw <- data.table::copy(df_DT)
      self$raw$ENA_UNIT <- merge_columns_c(self$raw, private$units.by, "::")

      self <- accumulate.data(self)
      self$units <- self$adjacency.vectors[, private$units.by, with = F]

      if (!self$model %in% c("AccumulatedTrajectory", "SeparateTrajectory")) {
        self$unit.names <- self$adjacency.vectors$ENA_UNIT
      }
      else {
        self$trajectories$units <- self$units
        conversation <- self$adjacency.vectors[, private$conversations.by, with = F];

        self$trajectories$step <- conversation
        self$units <- cbind(self$units, conversation)
        self$unit.names <- paste(
          self$adjacency.vectors$ENA_UNIT,
          self$adjacency.vectors$TRAJ_UNIT,
          sep = "::"
        )
      }

      self$adjacency.vectors.raw <- self$adjacency.vectors

      adjCols <- colnames(self$adjacency.vectors)[
                  grep("adjacency.code", colnames(self$adjacency.vectors))
                ];

      if (is.null(private$mask)) {
        private$mask <- matrix(1,
                          nrow = length(self$codes),
                          ncol = length(self$codes),
                          dimnames = list(self$codes, self$codes))
      }

      self$adjacency.vectors[, c(adjCols)] <-
        self$adjacency.vectors[, c(adjCols), with = F] *
          rep(
            private$mask[upper.tri(private$mask)],
            rep(nrow(self$adjacency.vectors), length(adjCols))
          )

      # if( is.function(private$weight.by) ) {
      #   cols <- colnames(self$adjacency.vectors)[
      #             grep("adjacency.code", colnames(self$adjacency.vectors))
      #           ]
      #   self$adjacency.vectors <- self$adjacency.vectors[,
      #                               lapply(
      #                                 .SD,
      #                                 private$weight.by
      #                               ),
      #                               .SDcols = cols,
      #                               by = 1:nrow(self$adjacency.vectors)
      #                             ]
      # }

      if( self$function.params$include.meta == T) {
        self$metadata <- self$add.metadata(merge = F);
      } else {
        self$metadata <- data.frame();
      }

      self$adjacency.vectors <- self$adjacency.vectors[,
                                  grep("adjacency.code",
                                    colnames(self$adjacency.vectors)),
                                  with = F
                                ]

      return(self);
    }
  )
)

#' ENA line weights as matrix
#'
#' @param x ena.line.weights data.table to covert to matrix
#' @param ... additional arguments to be passed to or from methods
#' @param square [TBD]
#'
#' @return matrix
#' @export
as.matrix.ena.line.weights <- function(x, ..., square = FALSE) {
  args = list(...)

  # if(!is.null(args$square))
  #   square = args$square

  # class(x) = class(x)[-1]
  x.unclass <- data.table::as.data.table(unclass(x))
  rows = x.unclass[, !find_meta_cols(x.unclass), with = F]

  if(square) {
    upperTriSize = ncol(rows)
    number = ( (ceiling(sqrt(2*upperTriSize)) ^ 2) ) - (2*upperTriSize)
    codes = unique(unlist(sapply(colnames(rows), strsplit, split = " & ")))
    cm = sapply(seq(nrow(rows)), function(unit) {
      m = matrix(NA, number,  number, dimnames = list(codes, codes))
      m[upper.tri(m)] = as.numeric(rows[unit,])
      m
    }, simplify = F);
    return(cm)
  }
  else {
    as.matrix(remove_meta_data(rows), ...)
  }
}

#' ENA rotations as matrix
#'
#' @param x ena.rotation.matrix to conver to matrix
#' @param ... 	additional arguments to be passed to or from methods
#'
#' @return matrix
#' @export
as.matrix.ena.rotation.matrix <- function(x, ...) {
  class(x) = class(x)[-1]
  x = remove_meta_data(x)
  as.matrix(x, ...)
}

#' ENA points as matrix
#'
#' @param x ena.points to convert to a matrix
#' @param ... 	additional arguments to be passed to or from methods
#'
#' @return matrix
#' @export
as.matrix.ena.points <- function(x, ...) {
  class(x) = class(x)[-1]
  x = remove_meta_data(x)
  as.matrix(x, ...)
}

#' Matrix without metadata
#'
#' @param x Object to convert to  a matrix
#' @param ... 	additional arguments to be passed to or from methods
#'
#' @return matrix
#' @export
as.matrix.ena.matrix <- function(x, ...) {
  class(x) = class(x)[-1]
  x = remove_meta_data(x)
  as.matrix(x, ...)
}

#' ENA nodes as matrix
#'
#' @param x ena.nodes to convert to matrix
#' @param ... 	additional arguments to be passed to or from methods
#'
#' @return matrix
#' @export
as.matrix.ena.nodes <- function(x, ...) {
  class(x) = class(x)[-1]
  as.matrix(x[,-c("code")], ...)
}

#' ENA row connections as matrix
#'
#' @param x ena.row.connections to conver to a matrix
#' @param ... 	additional arguments to be passed to or from methods
#'
#' @return matrix
#' @export
as.matrix.row.connections <- function(x, ...) {
  class(x) = class(x)[-1]
  as.matrix(x[, sapply(x, is, class2="ena.co.occurrence"), with = F], ...)
}


#' ENA Connections as a matrix
#'
#' @param x ena.connections object
#' @param ... 	additional arguments to be passed to or from methods
# @param square Logical. If TRUE, each row is converted to a square matrix
# @param simplify Logical. If TRUE, returns back a single result as vector
# @param names Ignored
#'
#' @return If square is FALSE (default), a matrix with all metadata columns removed, otherwise a list with square matrices
#' @export
as.matrix.ena.connections <- function(x, ...) {
  class(x) = class(x)[-1]
  xx = remove_meta_data(x)
  rows = as.data.frame(x)[, !find_meta_cols(x), drop = F]

  args = list(...)
  if(is.null(args$square))
    square = F
  else
    square = args$square

  names = args$names

  if(is.null(args$simplify))
    simplify = ifelse(nrow(x) > 1, F, T)
  else
    simplify = args$simplify

  if(square) {
    upperTriSize = ncol(rows)
    number = ( (ceiling(sqrt(2*upperTriSize)) ^ 2) ) - (2*upperTriSize)
    codes = unique(unlist(sapply(colnames(rows), strsplit, split = " & ")))
    cm = sapply(seq(nrow(rows)), function(unit) {
      m = matrix(NA, number, number, dimnames = list(codes, codes))
      m[upper.tri(m)] = as.numeric(rows[unit,])
      m
    }, simplify = F)

    if(simplify) {
      cm = cm[[1]]
    } else {
      names(cm) = names
    }
  } else {
    cm = as.matrix(rows)
    rownames(cm) = names
  }

  cm
}

#' Tune Window Size for ENA Accumulation
#'
#' Estimates the optimal moving window size for discourse accumulation and returns a new
#' accumulation object constructed with the tuned window size. By default, uses Cross-Covariance
#' Decay (CCD; \code{method = "ccd"}) to estimate the discourse coherence length.
#' Alternatively, the legacy SVD projection stability heuristic (\code{method = "stability"})
#' can be used.
#'
#' @param accum_object An \code{ENAAccumulation}/\code{ENAdata}/\code{ena.set} object.
#' @param min_size Integer. The minimum window size (default=1) to test.
#' @param max_size Integer. The maximum window size (default=20) to test.
#' @param method Character. Window estimation method: \code{"ccd"} (default, Cross-Covariance Decay)
#'   or \code{"stability"} (legacy SVD stability plateau).
#' @param cutoff Numeric. The threshold (default 0.95) of the maximum correlation used when
#'   \code{method = "stability"}.
#' @param min_overlap Integer. Minimum required overlapping rows per conversation when
#'   \code{method = "ccd"} (default=10).
#' @param ... Additional arguments passed to the underlying window estimation function.
#'
#' @details
#' When \code{method = "ccd"} (default), the function uses \code{\link{ena.ccd.window}} to calculate
#' the discourse coherence half-life decay lag directly from the conversation stream.
#'
#' When \code{method = "stability"}, the function iteratively rebuilds accumulation objects across
#' candidate window sizes, generates ENA sets, and computes distance-space correlations
#' between adjacent window sizes until reaching \code{cutoff * max_correlation}.
#'
#' @return A new \code{ENAdata}/\code{ena.set} object accumulated with the \code{best_window_size}.
#'
#' @export
#' @importFrom rENA ena.make.set ena_space_dist_corr ena.ccd.window
#'
#' @examples
#' \dontrun{
#' data(RS.data)
#' codeNames <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'                "Client.and.Consultant.Requests", "Design.Reasoning", "Collaboration")
#' accum <- ena.accumulate.data(
#'   units = RS.data[, c("UserName", "Condition")],
#'   conversation = RS.data[, c("Condition", "GroupName")],
#'   codes = RS.data[, codeNames],
#'   window.size.back = 4
#' )
#' tuned_accum <- ena.tune.window.size(accum, method = "ccd")
#' }
ena.tune.window.size <- function(
  accum_object,
  min_size = 1,
  max_size = 20,
  method = c("ccd", "stability"),
  cutoff = 0.95,
  min_overlap = 10,
  ...
) {
  method <- match.arg(method)

  if (method == "ccd") {
    best_window_size <- ena.ccd.window(
      x = accum_object,
      max_window = max_size,
      min_overlap = min_overlap
    )
  } else {
    # Legacy stability plateau method
    window_range <- min_size:max_size
    all_points <- list()

    for (i in seq_along(window_range)) {
      window_size <- window_range[i]
      new_accum <- rebuild_accumulation(accum_object, window_size)
      if (is.null(new_accum))
        stop("method = \"stability\" needs an accumulation made by ena.accumulate.data().")
      curr_set <- rENA::ena.make.set(new_accum)
      points <- as.matrix(curr_set$points)
      all_points[[i]] <- points
    }

    n_steps <- length(window_range) - 1
    adj_correlations <- numeric(n_steps)

    for (i in 1:n_steps) {
      adj_correlations[i] <- rENA::ena_space_dist_corr(all_points[[i]], all_points[[i + 1]])
    }

    max_corr <- max(adj_correlations, na.rm = TRUE)
    threshold <- cutoff * max_corr
    best_idx <- which(adj_correlations >= threshold)[1]
    best_window_size <- window_range[best_idx]
  }

  # Rebuild accumulation at best_window_size
  # Method 1: re-run ena.accumulate.data() with the original arguments
  res <- rebuild_accumulation(accum_object, best_window_size)
  if (!is.null(res)) return(res)

  # Method 2: Robust fallback - rebuild directly from object fields
  raw_df <- if (!is.null(accum_object$model$raw.input)) {
    as.data.frame(accum_object$model$raw.input)
  } else if (!is.null(accum_object$raw)) {
    as.data.frame(accum_object$raw)
  } else if (!is.null(accum_object$data)) {
    as.data.frame(accum_object$data)
  } else if (!is.null(accum_object$`_function.params`$data)) {
    as.data.frame(accum_object$`_function.params`$data)
  } else {
    NULL
  }

  if (!is.null(raw_df) && any(duplicated(colnames(raw_df)))) {
    raw_df <- raw_df[, !duplicated(colnames(raw_df)), drop = FALSE]
  }

  units_by <- if (!is.null(accum_object$units.by)) {
    accum_object$units.by
  } else if (!is.null(accum_object$model$units.by)) {
    accum_object$model$units.by
  } else if (!is.null(accum_object$`_function.params`$units.by)) {
    accum_object$`_function.params`$units.by
  } else if (!is.null(accum_object$unit.names)) {
    accum_object$unit.names
  } else {
    NULL
  }

  convo_by <- if (!is.null(accum_object$conversations.by)) {
    accum_object$conversations.by
  } else if (!is.null(accum_object$model$conversations.by)) {
    accum_object$model$conversations.by
  } else if (!is.null(accum_object$`_function.params`$conversations.by)) {
    accum_object$`_function.params`$conversations.by
  } else {
    NULL
  }

  codes_by <- if (!is.null(accum_object$model$codes)) {
    accum_object$model$codes
  } else if (!is.null(accum_object$codes)) {
    if (is.data.frame(accum_object$codes) || is.matrix(accum_object$codes)) {
      colnames(accum_object$codes)
    } else {
      as.character(accum_object$codes)
    }
  } else if (!is.null(accum_object$`_function.params`$codes)) {
    if (is.data.frame(accum_object$`_function.params`$codes) || is.matrix(accum_object$`_function.params`$codes)) {
      colnames(accum_object$`_function.params`$codes)
    } else {
      as.character(accum_object$`_function.params`$codes)
    }
  } else {
    NULL
  }

  if (!is.null(raw_df) && !is.null(units_by) && !is.null(convo_by) && !is.null(codes_by)) {
    return(ena.accumulate.data(
      units = raw_df[, units_by, drop = FALSE],
      conversation = raw_df[, convo_by, drop = FALSE],
      codes = raw_df[, codes_by, drop = FALSE],
      window.size.back = best_window_size
    ))
  }

  return(best_window_size)
}

# Re-run ena.accumulate.data() with the arguments `accum_object` was made with
# (its `_function.params`), changing only window.size.back.  Returns NULL when
# those arguments aren't available (e.g. an accumulation from a file).
#
# The stored `_function.call` is never evaluated: it is the *outermost* call on
# the stack when the set was made (a user's wrapper function, test_that(), a
# Shiny observer, ...), so evaluating it re-runs arbitrary code, and for an
# accumulation loaded from a file it is whatever call that file contains.
#
# The window argument is deliberately not called window.size.back: ena.set()
# records the parameters of the first frame on the stack that has a variable
# of that name, which must be ena.accumulate.data()'s, not this function's.
rebuild_accumulation <- function(accum_object, window_size) {
  params <- accum_object$`_function.params`
  arg_names <- setdiff(names(formals(ena.accumulate.data)), "...")
  args <- params[intersect(names(params), arg_names)]
  if (!all(c("units", "conversation", "codes") %in% names(args))) return(NULL)
  args[["window.size.back"]] <- window_size
  do.call(ena.accumulate.data, args)
}

#' Re-class matrix as ena.matrix
#'
#' @param x data.frame, data.table, or matrix to extend
#' @param new.class Additional class to extend the matrix with, default: NULL
#'
#' @return Object of same st
#' @export
as.ena.matrix <- function(x, new.class = NULL) {
  class(x) = c(new.class, "ena.matrix", class(x))
  x
}

#' Re-class matrix as ena.metadata
#'
#' @param x data.frame, data.table, or matrix to extend
#'
#' @return Object of same st
#' @export
as.ena.metadata <- function(x) {
  if(is.factor(x)) {
    x = as.character(x)
  }
  class(x) = c("ena.metadata", "character") # This fails in the $.ena.metadata if is extending character, class(x))
  x
}
as.ena.code <- function(x) {
  if(is.factor(x)) {
    x = as.character(x)
  }
  class(x) = c("ena.code", class(x))
  x
}
as.ena.codes <- function(x) {
  if(is.factor(x)) {
    x = as.character(x)
  }
  class(x) = c("ena.codes", class(x))
  x
}
#' Re-class vector as ena.co.occurrence
#'
#' @param x Vector to re-class
#'
#' @return re-classed vector
#' @export
as.ena.co.occurrence <- function(x) {
  if(is.factor(x)) {
    x = as.character(x)
  }
  class(x) = c("ena.co.occurrence", class(x))
  x
}
#' Re-class vector as ena.dimension
#'
#' @param x Vector to re-class
#'
#' @return re-classed vector
#' @export
as.ena.dimension <- function(x) {
  if(is.factor(x)) {
    x = as.character(x)
  }
  class(x) = c("ena.dimension", class(x))
  x
}

##
#' @title Compute summary statistic for groupings of units using given method (typically, mean)
#'
#' @description Computes summary statistics for groupings (given as vector) of units in ena data using given method (typically, mean); computes summary statistic for point locations and edge weights for each grouping
#'
#' @export
#'
#' @param enaset An \code{\link{ENAset}} or a vector of values to group.
#' @param by A vector of values the same length as units. Uses rotated points for group positions and normed data to get the group edge weights
#' @param method A function that is used on grouped points. Default: mean().  If `enaset` is an ENAset, enaset$points.rotated will be groups using `mean` regardless of `method` provided
#' @param names A vector of names to use for the results. Default: unique(by)
#'
#' @examples
#' data(RS.data)
#'
#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
#'   'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
#'
#' accum = ena.accumulate.data(
#'   units = RS.data[,c("UserName","Condition")],
#'   conversation = RS.data[,c("Condition","GroupName")],
#'   metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post")],
#'   codes = RS.data[,codeNames],
#'   window.size.back = 4
#' )
#'
#' set = ena.make.set(
#'   enadata = accum
#' )
#'
#' means = ena.group(set, "Condition")
#'
#'
#' @return A list containing names, points, and edge weights for each of the unique groups formed by the function
##
ena.group <- function(
  enaset = NULL,
  by = NULL,
  method = mean,
  names = as.vector(unique(by))
) {
  run.method = function(pts, m = method) {
    to_matrix <- class(pts)[1];
    points.dt = pts;

    if(is.logical(by)) {
      points.dt.means = points.dt[by, { lapply(.SD, m) }, .SDcols = find_dimension_cols(points.dt) | find_code_cols(points.dt)];
      if(length(names) == 1) {
        points.dt.means[['ENA_GROUP_NAME']] <- as.ena.metadata(names)
      }
    }
    else if(all(by %in% colnames(pts))) {
      points.dt.means <- points.dt[,
                          {lapply(.SD, function(x) {
                            get(paste0("as.", class(x)[1]))(m(x))
                          })},
                          by = by,
                          .SDcols = find_dimension_cols(points.dt) | find_code_cols(points.dt)
                        ];
      points.dt.means[, ENA_GROUP_NAME := do.call(paste, c(.SD, sep = ".")) , .SDcols = c(by)]
      points.dt.means <- points.dt.means[, !find_meta_cols(points.dt.means), with = F]
      set(points.dt.means, j = "ENA_GROUP_NAME", value = as.ena.metadata(points.dt.means[["ENA_GROUP_NAME"]]))
    }
    else {
      to_what <- get(paste0("as.", class(pts[[which(!find_meta_cols(pts))[1]]])[1]))
      to_cols <- names(which(!find_meta_cols(pts)))

      points.dt.means = as.data.frame(aggregate(as.matrix(points.dt), by = list(by), FUN = m)) #"mean"))
      set(points.dt.means, j = "Group.1", value = as.ena.metadata(points.dt.means$Group.1))
      colnames(points.dt.means)[colnames(points.dt.means) == "Group.1"] <- "ENA_GROUP_NAME"
      set(x = points.dt.means, j = to_cols, value = lapply(points.dt.means[, to_cols], to_what))
      points.dt.means <- as.data.table(points.dt.means)

      # agg.df[as.vector(unique(group.by)),]u
      # return (points.dt.means[as.vector(unique(by)),]);
      return(as.ena.matrix(points.dt.means[which(points.dt.means$ENA_GROUP_NAME %in% unique(by)),], to_matrix))
    }

    return(as.ena.matrix(points.dt.means, to_matrix));
  }

  if(is.character(method)) {
    method = get(method)
  }

  if(is(enaset, "ENAset")) {
    enaset <- ena.set(enaset);
  }

  if (is(enaset, "ena.set")) {
    pts <- run.method(enaset$points)
    return(list(
      "names" = pts$ENA_GROUP_NAME,
      "points" = pts,
      "line.weights" = run.method(enaset$line.weights)
    ));
  }
  else {
    return(run.method(enaset))
  }
}

#' Calculate ENA Moving Window Size via Cross-Covariance Decay (CCD)
#'
#' Calculates the recommended moving window size for Epistemic Network Analysis (ENA)
#' by estimating the half-life decay lag of the noise-corrected Frobenius norm across
#' pooled conversation cross-covariance matrices.
#'
#' @param x A \code{data.frame}, \code{data.table}, or an \code{ENAdata}/\code{ena.set} accumulation object.
#' @param codeNames A \code{character} vector of column names representing binary codes (optional if \code{x} is an ENA object).
#' @param conversation_cols A \code{character} vector of column names defining discrete conversations (optional if \code{x} is an ENA object).
#' @param max_window A \code{numeric} value indicating the maximum lag window size to evaluate. Default is \code{20}.
#' @param min_overlap A \code{numeric} value specifying the minimum required overlapping rows (\eqn{N - lag}) per conversation subset. Default is \code{10}.
#'
#' @details
#' The function computes pooled cross-covariance curves over lags \code{0:max_window}. It normalizes
#' the noise-corrected Frobenius norm relative to its peak value and identifies the first lag step strictly
#' after the peak where the normalized norm falls below 0.5 (half-life threshold).
#'
#' @references
#' Shaffer, D. W. & Cai, Z. (2026). Discourse Coherence Length:
#' Noise-Corrected Covariance Estimation of Window-Size in Epistemic Network Analysis.
#' International Conference on Quantitative Ethnography (ICQE26).
#'
#' @return An integer scalar representing the estimated half-life lag window size.
#'
#' @export
#'
#' @examples
#' data(RS.data)
#' codeNames <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'                "Client.and.Consultant.Requests", "Design.Reasoning", "Collaboration")
#' w <- ena.ccd.window(RS.data, codeNames = codeNames,
#'                     conversation_cols = c("Condition", "GroupName"))
#' print(w)
ena.ccd.window <- function(
  x,
  codeNames = NULL,
  conversation_cols = NULL,
  max_window = 20,
  min_overlap = 10
) {
  res <- ena.ccd(
    x = x,
    codeNames = codeNames,
    conversation_cols = conversation_cols,
    max_window = max_window,
    min_overlap = min_overlap
  )
  return(res$window_size)
}

#' Compute Cross-Covariance Decay Curves and Noise Floor
#'
#' Evaluates window-matched cross-covariance matrices and noise-floor corrected
#' Frobenius norms across multiple conversation subsets over a range of lag steps.
#'
#' @param x A \code{data.frame}, \code{data.table}, or an \code{ENAdata}/\code{ena.set} accumulation object.
#' @param codeNames A \code{character} vector of column names corresponding to ENA codes.
#' @param conversation_cols A \code{character} vector of column names defining discrete conversations.
#' @param max_window An \code{integer} specifying the maximum lag to evaluate. Default is \code{20}.
#' @param min_overlap An \code{integer} specifying the minimum effective row overlap required per conversation at lag \eqn{l}. Default is \code{10}.
#'
#' @return An S3 object of class \code{ena.ccd} containing:
#' \describe{
#'   \item{window_size}{The estimated optimal window size (integer).}
#'   \item{peak_lag}{The lag corresponding to the peak cross-covariance norm.}
#'   \item{curves}{A \code{data.frame} of pooled cross-covariance metrics by lag.}
#'   \item{codeNames}{The evaluated code names.}
#'   \item{conversation_cols}{The conversation column names.}
#' }
#'
#' @export
#'
#' @examples
#' data(RS.data)
#' codeNames <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'                "Client.and.Consultant.Requests", "Design.Reasoning", "Collaboration")
#' ccd_res <- ena.ccd(RS.data, codeNames = codeNames,
#'                    conversation_cols = c("Condition", "GroupName"))
#' print(ccd_res)
#' plot(ccd_res)
ena.ccd <- function(
  x,
  codeNames = NULL,
  conversation_cols = NULL,
  max_window = 20,
  min_overlap = 10
) {
  # 1. Extract from ENAdata / ena.set if provided
  if (inherits(x, c("ENAdata", "ena.set", "ENAset", "rENA.data", "rENA.set"))) {
    if (is.null(codeNames)) {
      if (!is.null(x$model$codes)) {
        codeNames <- x$model$codes
      } else if (!is.null(x$codes)) {
        codeNames <- if (is.data.frame(x$codes) || is.matrix(x$codes)) colnames(x$codes) else as.character(x$codes)
      } else if (!is.null(x$`_function.params`$codes)) {
        codeNames <- if (is.data.frame(x$`_function.params`$codes) || is.matrix(x$`_function.params`$codes)) {
          colnames(x$`_function.params`$codes)
        } else {
          as.character(x$`_function.params`$codes)
        }
      }
    }
    if (is.null(conversation_cols)) {
      if (!is.null(x$conversations.by)) {
        conversation_cols <- x$conversations.by
      } else if (!is.null(x$model$conversations.by)) {
        conversation_cols <- x$model$conversations.by
      } else if (!is.null(x$`_function.params`$conversations.by)) {
        conversation_cols <- x$`_function.params`$conversations.by
      }
    }
    raw_df <- if (!is.null(x$model$raw.input)) {
      as.data.frame(x$model$raw.input)
    } else if (!is.null(x$raw)) {
      as.data.frame(x$raw)
    } else if (!is.null(x$data)) {
      as.data.frame(x$data)
    } else if (!is.null(x$`_function.params`$data)) {
      as.data.frame(x$`_function.params`$data)
    } else {
      NULL
    }
  } else if (is.data.frame(x)) {
    raw_df <- as.data.frame(x)
  } else {
    stop("'x' must be a data.frame or an ENA accumulation/set object.")
  }

  if (is.null(raw_df)) {
    stop("Could not extract raw data from the provided ENA object.")
  }

  # Deduplicate columns in raw_df if present (e.g. from intersecting units/convo specifications)
  if (any(duplicated(colnames(raw_df)))) {
    raw_df <- raw_df[, !duplicated(colnames(raw_df)), drop = FALSE]
  }

  if (is.null(codeNames) || length(codeNames) == 0) {
    stop("'codeNames' must be specified.")
  }
  if (is.null(conversation_cols) || length(conversation_cols) == 0) {
    stop("'conversation_cols' must be specified.")
  }

  # 2. Validate columns existence
  missing_cols <- setdiff(c(conversation_cols, codeNames), colnames(raw_df))
  if (length(missing_cols) > 0) {
    stop("The following columns were not found in 'x': ", paste(missing_cols, collapse = ", "))
  }

  # 3. Numeric matrix conversion & conversation splitting
  # Factors and characters are converted by their labels ("0"/"1" -> 0/1);
  # data.matrix() would use factor level positions (1/2) instead. Missing or
  # non-numeric values are an error rather than a silent 0.
  code_mat <- vapply(raw_df[, codeNames, drop = FALSE], function(col) {
    if (is.factor(col)) col <- as.character(col)
    suppressWarnings(as.numeric(col))
  }, numeric(nrow(raw_df)))
  code_mat <- matrix(code_mat, nrow = nrow(raw_df), dimnames = list(NULL, codeNames))
  bad <- codeNames[colSums(is.na(code_mat)) > 0]
  if (length(bad)) {
    stop("Code columns have missing or non-numeric values: ", paste(bad, collapse = ", "))
  }

  conv_factor <- interaction(raw_df[conversation_cols], drop = TRUE, lex.order = FALSE)
  x_subsets   <- split.data.frame(code_mat, conv_factor)

  lags <- 0:max_window

  # Pre-filter conversation subsets by length
  sub_lens <- vapply(x_subsets, nrow, integer(1))
  valid_idx <- which(sub_lens >= min_overlap)

  if (length(valid_idx) == 0) {
    warning(paste0("No conversation subsets had length >= min_overlap (", min_overlap, "). Returning window size = 1."))
    out_curves <- data.frame(
      lag                  = lags,
      frob                 = NA_real_,
      frob_sq_unbiased     = NA_real_,
      frob_unbiased_signed = NA_real_,
      total_weight         = 0,
      stringsAsFactors     = FALSE
    )
    res <- list(
      window_size       = 1L,
      peak_lag          = 0L,
      curves            = out_curves,
      codeNames         = codeNames,
      conversation_cols = conversation_cols
    )
    class(res) <- "ena.ccd"
    return(res)
  }

  x_subsets <- x_subsets[valid_idx]

  # 4. Delegate the cross-covariance decay computation to the shared libena
  #    kernel (qe::ccd_window, src/libena_rcpp.cpp). The numeric core lives in C++ so that R, the
  #    WASM build, and the Python package (ena) all share a single implementation; only the
  #    data.frame wrangling and S3 assembly stay here.
  kern <- ccd_window(
    lapply(x_subsets, function(s) matrix(as.numeric(s), nrow = nrow(s))),
    max_window  = max_window,
    min_overlap = min_overlap
  )

  pooled_out <- data.frame(
    lag                  = kern$lag,
    frob                 = kern$frob,
    frob_sq_unbiased     = kern$frob_sq_unbiased,
    frob_unbiased_signed = kern$frob_unbiased_signed,
    total_weight         = kern$total_weight,
    stringsAsFactors     = FALSE
  )

  best_window <- as.integer(kern$window_size)
  peak_lag    <- as.integer(kern$peak_lag)

  # 5. Preserve the informational warnings the pure-R implementation emitted.
  #    (The window size / peak lag themselves are decided inside the kernel.)
  f <- pooled_out$frob_unbiased_signed
  if (peak_lag == 0L) {
    warning("Corrected Cross Covariance is non-positive or all NA across evaluated lags. Defaulting to window size = 1.")
  } else {
    max_f <- f[pooled_out$lag == peak_lag]
    after <- pooled_out$lag >= peak_lag
    if (!any((f[after] / max_f) <= 0.5, na.rm = TRUE)) {
      warning(paste0("Cross-covariance did not decay below half-life (50%) within max_window = ", max_window, "."))
    }
  }

  res <- list(
    window_size       = best_window,
    peak_lag          = peak_lag,
    curves            = pooled_out,
    codeNames         = codeNames,
    conversation_cols = conversation_cols
  )
  class(res) <- "ena.ccd"
  return(res)
}

#' @export
print.ena.ccd <- function(x, ...) {
  cat("ENA Cross-Covariance Decay (CCD) Window Size Estimation\n")
  cat("------------------------------------------------------\n")
  cat("Estimated Window Size :", x$window_size, "\n")
  cat("Peak Lag              :", x$peak_lag, "\n")
  cat("Codes Evaluated       :", paste(x$codeNames, collapse = ", "), "\n")
  cat("Conversations By      :", paste(x$conversation_cols, collapse = ", "), "\n")
  invisible(x)
}

#' Plot Cross-Covariance Decay Curve
#'
#' Plots the noise-corrected Frobenius norm across lags with the half-life threshold marker.
#'
#' @param x An object of class \code{ena.ccd}.
#' @param ... Additional arguments passed to \code{plot}.
#'
#' @return The \code{ena.ccd} object invisibly.
#' @export
plot.ena.ccd <- function(x, ...) {
  df <- x$curves
  valid <- !is.na(df$frob_unbiased_signed)
  df_sub <- df[valid, ]

  if (nrow(df_sub) == 0) {
    message("No valid cross-covariance curve points to plot.")
    return(invisible(x))
  }

  ylim <- range(c(0, df_sub$frob_unbiased_signed, df_sub$frob), na.rm = TRUE)
  graphics::plot(
    df_sub$lag, df_sub$frob_unbiased_signed,
    type = "b", pch = 19, col = "royalblue",
    xlab = "Lag (Window Size)",
    ylab = "Frobenius Norm",
    main = paste0("Cross-Covariance Decay (Estimated Window = ", x$window_size, ")"),
    ylim = ylim,
    ...
  )
  graphics::lines(df_sub$lag, df_sub$frob, type = "l", lty = 2, col = "gray50")
  graphics::abline(v = x$window_size, col = "firebrick", lty = 2, lwd = 2)
  graphics::legend(
    "topright",
    legend = c("Corrected Norm", "Uncorrected Norm", paste0("Chosen Window (", x$window_size, ")")),
    col = c("royalblue", "gray50", "firebrick"),
    lty = c(1, 2, 2), pch = c(19, NA, NA), lwd = c(1, 1, 2),
    bty = "n"
  )
  invisible(x)
}

#' Find metadata columns
#'
#' @param x data.table (or frame) to search for columns of class ena.metadata
#'
#' @return logical vector
#' @export
find_meta_cols <- function(x) {
   sapply(x, is, class2 = "ena.metadata")
}

#' Find code columns
#'
#' @param x data.table (or frame) to search for columns of class ena.co.occurrence
#'
#' @return logical vector
#' @export
find_code_cols <- function(x) {
   grepl("adjacency.code", x = names(x)) | sapply(x, function(col) {
     is(col, class2 = "ena.co.occurrence")
   })
}

#' Find Binary Columns
#'
#' Identifies columns in a data.frame or data.table that are binary (i.e., contain only two unique values), optionally including logical columns.
#'
#' @param x A data.frame or data.table to search for binary columns.
#' @param include_logical Logical. If TRUE, logical columns are also considered binary. Default is FALSE.
#'
#' @return A character vector of column names that are binary, or NULL if none are found.
#' @export
#'
#' @examples
#' df <- data.frame(a = c(0, 1, 1), b = c(TRUE, FALSE, TRUE), c = c(1, 2, 3))
#' find_binary_cols(df)
#' find_binary_cols(df, include_logical = TRUE)
find_binary_cols <- function(x, include_logical = FALSE) {
   nm <- colnames(x)[sapply(x, is_binary_col, include_logical)];
   if(length(nm) > 0) nm else NULL;
}

#' Find dimension columns
#'
#' @param x data.table (or frame) to search for columns of class ena.dimension
#'
#' @return logical vector
#' @export
find_dimension_cols <- function(x) {
   sapply(x, is, class2 = "ena.dimension")
}

#' Remove meta columns from data.table
#'
#' @param x [TBD]
#'
#' @return data.table withe columns of class ena.meta.data removed
#' @export
remove_meta_data <- function(x) {
   as.data.frame(x)[, !find_meta_cols(x), drop = F]
}

#' Extract metadata easily
#'
#' @param x [TBD]
#' @param i [TBD]
#'
#' @return [TBD]
#' @export
"$.ena.metadata" <- function(x, i) {
   #browser()
   parts <- unlist(strsplit(
               x = as.character(sys.call())[2], split = "\\$"
            ))[1:2]

   set <- get(parts[1], envir = parent.frame())
   m <- set[[parts[2]]][x == i, ]
   m
}

#' Extract line.weignts easily
#'
#' @param x [TBD]
#' @param i [TBD]
#'
#' @return [TBD]
#' @export
"$.line.weights" <- function (x, i) {
   vals <- x[[which(colnames(x) == i)]]

   vals
}

#' Extract points easily
#'
#' @param x [TBD]
#' @param i [TBD]
#'
#' @return [TBD]
#' @export
"$.ena.points" <- function (x, i) {
   # Match base `$`: an absent column is NULL, not an error. Without this,
   # which() returns integer(0) and x[[integer(0)]] raises "attempt to select
   # less than one element in get1index", so callers cannot test for an
   # optional column (e.g. ENA_DIRECTION) the ordinary way. Duplicate column
   # names take the first match rather than recursively indexing on a vector.
   idx <- which(colnames(x) == i)
   if (length(idx) == 0) {
     return(NULL)
   }
   vals <- x[[idx[1]]]

   vals
}

#' Extract from ena.matrix easily using metadata
#'
#' @param x [TBD]
#' @param i [TBD]
#'
#' @return [TBD]
#' @export
"$.ena.matrix" <- function (x, i) {
   # See `$.ena.points` above: absent column is NULL, duplicates take the first.
   idx <- which(colnames(x) == i)
   if (length(idx) == 0) {
     return(NULL)
   }
   vals <- x[[idx[1]]]

   vals
}

#' Multiply ena.matrix objects
#' Element-wise multiplication of dimension columns in an ena.matrix by another ena.matrix or numeric matrix.
#' If e2 is an ena.matrix, it is converted to a standard matrix before multiplication.
#' The multiplication is applied only to the dimension columns of e1, while other columns remain
#' unchanged.
#' 
#' @param e1 An ena.matrix object whose dimension columns will be multiplied.
#' @param e2 An ena.matrix or numeric matrix to multiply with the dimension columns of
#' e1.
#' 
#' @return An ena.matrix object with the dimension columns of e1 multiplied by e2.
#' @exportS3Method "*" ena.matrix
"*.ena.matrix" <- function (e1, e2) {
   e2m <- e2
   if(is(e2, "ena.matrix")) {
      e2m <- as.matrix(e2)
   }
   
   dim_cols <- colnames(e1)[find_dimension_cols(e1)]
   e1[, (dim_cols) := Map(function(col, mult) col * mult, .SD, as.data.frame(e2m)), .SDcols = dim_cols]
}

# "$.ena.plot" <- function(x, i) {
#  browser()
# }
# "[[.ena.plot" <- function(x, i) {
#  browser()
# }
#' @export
.DollarNames.ena.metadata <- function(x, pattern = "") {
   unique(x)
}

# "[.ena.matrix" = function(x, ...)
# {
#    browser()
#    original.class = class(x)[1]
#    class(x) = class(x)[-1]
#    x = x[...]
#
# #   y = as.data.frame(x)
# }

#' @export
summary.ena.set <- function(object, ...) {
   x <- object
   print_dims <- function(n = 2) {
      cat("\t", paste("Dimension", 1:n, collapse = "\t"), "\n")
   }
   cat("Units: ", nrow(x$points), "\t\t")
   cat("Codes: ", length(x$rotation$codes), "\n")

   cat("Variance: \n")
   print_dims()
   cat("\t", paste(round(x$model$variance[1:2], 3), collapse = "\t\t"), "\n\n")

   cat("Eigenvalues: \n")
   print_dims()
   cat("\t", paste(round(
      x$rotation$eigenvalues[1:2], 3), collapse = "\t\t"), "\n\n")

   cat("Correlations: \n")
   cors <- ena.correlations(x)
   rownames(cors) <- paste("Dimension", 1:2)
   print(cors)
}
# as.data.frame.ena.connections <- function(x) {
#   class(x) = class(x)[-1]
#   y = as.data.frame(x)
#   y
# }
# format.co.occurrence = format.metadata = function(x, justify = "none") {
#   y = as.character(x)
#   format(y, justify = justify)
# }

#' Title
#'
#' @param x [TBD]
#' @param ... [TBD]
#' @param plot [TBD]
#' @param set [TBD]
#'
#' @return [TBD]
#' @export
print.ena.set <- function(x, ..., plot = FALSE, set = TRUE) {
   x.unclass <- unclass(x)

   if(
      !is.null(x.unclass$`_plot_op`) &&
      x.unclass$`_plot_op` == T
   ) {
      base::print(x.unclass$plots)
   }
   else {
      if(plot == FALSE) {
         x.unclass$plots <- NULL
      }
      base::print(x.unclass)
   }

   invisible(x);
}

#' Title
#'
#' @param x [TBD]
#' @param by [TBD]
#' @param model [TBD]
#' @param ... [TBD]
#'
#' @return [TBD]
#' @export
as_trajectory <- function(x,
   by = x$`_function.params`$conversation[1],
   model = c("AccumulatedTrajectory", "SeperateTrajectory"),
   ...
) {
   model = match.arg(model)
   orig_args = x$`_function.params`
   orig_args$model = model

   more_args <- list(...)
   for(arg in names(more_args)) {
      orig_args[[arg]] <- more_args[[arg]]
   }
   #c(mean, more.args[!names(more.args) %in% names(mean)])

   do.call(ena, orig_args)
}

#' Title
#'
#' @param x [TBD]
#' @param by [TBD]
#' @param ... [TBD]
#'
#' @return [TBD]
#' @export
project_in <- function(x, by = NULL, ...) {
   if(is.null(by)) {
      stop("A second parameter (ena.set or rotation.set) is required")
   }

   rotation.set <- NULL
   if(is(by, "ena.set")) {
      rotation.set <- by$rotation
   } else if(is(by, "ena.rotation.set")) {
      rotation.set <- by
   }

   if(!identical(x$rotation$adjacency.key, rotation.set$adjacency.key)) {
      stop("Rotation sets must have identical adjacency keys")
   }

   x$rotation.matrix <- rotation.set$rotation.matrix
   x$rotation$rotation.matrix <- rotation.set$rotation.matrix
   x$rotation$nodes <- rotation.set$nodes;
   x$rotation$eigenvalues <- rotation.set$eigenvalues

   points <- as.matrix(x$model$points.for.projection) %*% as.matrix(x$rotation.matrix)
   points.dt <- as.data.table(points)
   for (i in seq(ncol(points.dt))) {
    set(points.dt, j = i, value = as.ena.dimension(points.dt[[i]]))
   }
   if(grepl(x = x$model$model.type, pattern = "Trajectory")) {
    x$points <- cbind(x$trajectories, points.dt)
   } else {
    x$points <- cbind(x$meta.data, points.dt)
   }
   x$points <- as.ena.matrix(x$points, "ena.points")

   .return(x, invisible = T)
}

#' Title
#'
#' @param x [TBD]
#' @param on [TBD]
#'
#' @return [TBD]
#' @export
means_rotate <- function(x, on = NULL) {
   groupVar = NULL
   groups = NULL
   if(is.null(on)) {
      col_counts = as.numeric(x$model$raw.input[, lapply(.SD, function(s) {
                  length(unique(s))
               }),
               .SDcols = c(x$`_function.params`$units)
            ])
      groupVar = x$`_function.params`$units[order(col_counts) == 1]
      group_vars = unique(x$model$raw.input[[groupVar]])
      if(!is.null(levels(group_vars))) {
        groups = levels(group_vars)[1:2]
      }
      else {
        groups = group_vars[1:2]
      }
      # on_grps = list()
      # on_grps[[on]] = sapply(on_vals, function(v) {
      #    x$meta.data[[on]] == v
      # }, simplify = F)
   } else if(!is.null(names(on))) {
      groupVar = names(on)
      groups = on[[groupVar]]
   }

   if(is.null(groupVar) || is.null(groups)) {
      stop("Unable to determine groups for rotation.")
   }

   orig_args <- x$`_function.params`
   orig_args$groupVar = groupVar
   orig_args$groups = groups
   new_set <- do.call(ena, orig_args)
   new_set$plots <- x$plots
   invisible(new_set)
}

.return <- function(x, invisible = T, from_plot = F) {
   x$`_plot_op` = from_plot
   if(isTRUE(from_plot)) {
      
   }

   if(invisible == T) {
      invisible(x)
   }
   else {
      return(x)
   }
}

is_logical_col <- function(col) {
  n_cols = col == TRUE | col == FALSE;
  is_col <- is.logical(col) & all(n_cols);

  return(is_col);
}

is_binary_col <- function(col, include_logical = TRUE) {
  n_cols = col == 1 | col == 0;
  is_col <- is.numeric(col) && all(is.wholenumber(col) & all(n_cols));

  if(isTRUE(include_logical)) {
    is_col <- is_col | is_logical_col(col);
  }

  return(is_col);
}

is.wholenumber <- function(x, tol = .Machine$double.eps^0.5)  abs(x - round(x)) < tol


#' Extract points easily
#'
# @param x [TBD]
# @param i [TBD]
# @param j [TBD]
# @param ... Passed to `[.data.table`
# @param with.meta logical, currently defaults to TRUE, which includes the metadata columns.
#
# @return [TBD]
# @export
# "[.ena.matrix" <- function (x, i, j, by, keyby, ..., with.meta = TRUE) {
#   orig.class <- class(x)
#   x.unclass <- data.table::as.data.table(unclass(x))
#
#   if(with.meta == FALSE) {
#     x.nometa <- x.unclass[, !find_meta_cols(x.unclass), with = F]
#     x_ <- x.nometa[i, ..j, ...]
#   }
#   else {
#     x_ <- x.unclass[i, j, by = by, keyby = keyby, ...]
#     # if (!is.null(j)) {
#     #   x_ <- x_[, ..j]
#     # }
#   }
#   class(x_) <- orig.class
#   x_
# }


#' Correlation between distances in two ENA spaces
#'
#' @description
#' Calculates the Pearson correlation between the pairwise Euclidean distances
#' of points in two ENA spaces (\code{A} and \code{B}). For smaller datasets,
#' it computes the exact correlation. For larger datasets, it estimates the
#' correlation using a sampled subset of pairs.
#'
#' @param A A matrix or data frame representing the first ENA space (rows as points).
#' @param B A matrix or data frame representing the second ENA space (must have the same number of rows as A).
#' @param max_sample_size Numeric. The maximum number of pairwise distances to compute.
#' If the total possible pairs exceeds this value, sampling is used. Default is 100,000.
#'
#' @return A numeric value representing the Pearson correlation.
#' @importFrom stats dist cor
#' @export
ena_space_dist_corr <- function(A, B, max_sample_size = 100000) {
  m <- nrow(A)

  if (is.null(m) || m == 0 || nrow(B) != m) {
    stop("The spaces must have the same non-zero number of rows.")
  }

  # Calculate total unique pairs m(m-1)/2
  total_possible_pairs <- choose(m, 2)

  # Use Exact if total pairs is less than limit
  if (total_possible_pairs <= max_sample_size) {
    # CASE 1: Small m - Exact calculation
    d_A <- as.vector(dist(A))
    d_B <- as.vector(dist(B))
    return(cor(d_A, d_B, method = "pearson"))

  } else {
    # CASE 2: Large m - Simple Sample & Filter
    # Sample indices with replacement
    idx1 <- sample.int(m, max_sample_size, replace = TRUE)
    idx2 <- sample.int(m, max_sample_size, replace = TRUE)

    # Filter out identity pairs (per user instruction for large m)
    keep <- idx1 != idx2
    idx1 <- idx1[keep]
    idx2 <- idx2[keep]

    # Vectorized Euclidean Distance: sqrt(sum((x-y)^2))
    dist_A <- sqrt(rowSums((A[idx1, , drop = FALSE] - A[idx2, , drop = FALSE])^2))
    dist_B <- sqrt(rowSums((B[idx1, , drop = FALSE] - B[idx2, , drop = FALSE])^2))

    return(cor(dist_A, dist_B, method = "pearson"))
  }
}

#####
#' @title Wrapper to generate plots of units, groups, and networks
#'
#' @description Plots individual units, all units, groups of units, networks, and network subtractions
#'
#' @details This function includes options to plots individual units, all units,
#' groups of units, networks, and network subtractions, given an ena.set objects. Plots are stored
#' on the supplied ena.set object.
#'
#'
#' @param set an ena.set object
#' @param groupVar vector, character, of column name containing group identifiers.
#' @param groups vector, character, of values of groupVar column you wish to plot. Maxium of two groups allowed.
#' @param points logical, TRUE will plot points (default: FALSE)
#' @param mean logical, TRUE will plot the mean position of the groups defined in the groups argument (default: FALSE)
#' @param network logical, TRUE will plot networks (default: TRUE)
#' @param networkMultiplier numeric, scaling factor for non-subtracted networks (default: 1)
#' @param subtractionMultiplier numeric, scaling factor for subtracted networks (default: 1)
#' @param unit vector, character, name of a single unit to plot
#' @param colors vector, character, of colors for groups or points. For two-group models supply two values (group1, group2); for single-group or no-group models supply one value. Defaults to "blue"/"red" for two groups and "black" otherwise.
#' @param confidence.interval character, style of confidence interval shown on mean points: "box" (default), "crosshairs", or "none"
#' @param print.plots logical, TRUE will show plots in the Viewer (default: FALSE)
#' @param backend \code{"plotly"} (default) or \code{"qeviz"}; default
#'   \code{getOption("rENA.plot.backend", "plotly")}. On qeviz the weights are
#'   not multiplied: the multipliers become each plot's magnification
#'   (labelled "(scaled Nx)"). See \link{rENA-plot-backends}.
#' @param ... Additional parameters passed to set creation and plotting functions
#' @export
#' @return ena.set object
#####
ena.plotter = function(
  set,
  groupVar = NULL,
  groups = NULL,
  points = FALSE,
  mean = FALSE,
  network = TRUE,
  networkMultiplier = 1,
  subtractionMultiplier = 1,
  unit = NULL,
  colors = NULL,
  confidence.interval = "box",
  print.plots = F,
  backend = getOption("rENA.plot.backend", "plotly"),
  ...
) {
  backend <- match.arg(backend, c("plotly", "qeviz"))
  # qeviz: weights unscaled, networkMultiplier -> magnify (see .qe_magnify()).
  wm  <- .qe_weight_mult(backend, networkMultiplier)
  mag <- .qe_magnify(backend, networkMultiplier)
  data = set$connection.counts;

  # set$plots[[length(set$plots)]] <- plot
  # plot <- set$plots[[length(set$plots)]]
  if(is.null(unit) == FALSE) {
    plot = ena.plot(enaset = set, title = unit, backend = backend, magnify = mag)

    if(any(set$points$ENA_UNIT == unit) == FALSE){
      stop("Unit does not exist!")
    }

    point.row = set$points$ENA_UNIT == unit
    point = as.matrix(set$points)[point.row,]
    point.lw = as.matrix(set$line.weights)[point.row,]* wm

    unit.color = if (!is.null(colors)) colors[1] else "black"
    plot = ena.plot.points(enaplot = plot,points = point, colors = unit.color)
    plot = ena.plot.network(enaplot = plot, network = point.lw, colors = unit.color)

    set$plots[[length(set$plots) + 1]] <- plot

    if(print.plots == TRUE) {
      print(set$plots[[length(set$plots)]])
    }

    return(set)
  }

  if(is.null(groupVar) == TRUE) {
    plot = ena.plot(enaset = set, title = "All Units", backend = backend, magnify = mag)
    base.color = if (!is.null(colors)) colors[1] else "black"

    if(network == TRUE) {
      lineweights = as.matrix(set$line.weights)
      mean.lineweights = colMeans(lineweights) * wm

      plot = ena.plot.network(plot, network = mean.lineweights, colors = base.color)
    }

    if(points == TRUE) {
      points.for.plot = as.matrix(set$points)

      plot = ena.plot.points(enaplot = plot,points = points.for.plot,colors = base.color)
    }

    if(mean == TRUE) {
      points.for.plot = as.matrix(set$points)

      plot = ena.plot.group(plot, points.for.plot, colors = base.color, labels = "Mean", confidence.interval = confidence.interval)
    }

    else if(TRUE %in% c(network,points, mean) == FALSE) {
      stop("You must set at least one of points, mean, or network to TRUE to obtain a plot.")
    }

    set$plots[[length(set$plots) + 1]] <- plot

    if(print.plots == TRUE) {
      print(set$plots)
    }

    return(set)
  }
  else if(is.null(groups) == TRUE) {
    unique.groups = unique(data[[groupVar]])

    if(length(unique.groups) == 1){
      warning("No groups specified and group variable only contains one unique value. Generating plot for one group.")

      group = unique.groups

      group.rows = set$points[[groupVar]] == group
      g.plot = ena.plot(enaset = set, title = group, backend = backend, magnify = mag)
      base.color = if (!is.null(colors)) colors[1] else "black"

      if(network == TRUE) {
        g.lw = as.matrix(set$line.weights)[group.rows, , drop = FALSE]
        g.mean.lw = colMeans(g.lw) * wm
        g.plot = ena.plot.network(g.plot, network = g.mean.lw, colors = base.color)
      }

      if(points == TRUE) {
        g.points.for.plot = as.matrix(set$points)[group.rows, , drop = FALSE]
        g.plot = ena.plot.points(enaplot = g.plot,points = g.points.for.plot,colors = base.color)
      }

      if(mean == TRUE) {
        g.points.for.plot = as.matrix(set$points)[group.rows, , drop = FALSE]
        g.plot = ena.plot.group(g.plot, g.points.for.plot, colors = base.color, labels = group, confidence.interval = confidence.interval)
      }

      else if(TRUE %in% c(network,points, mean) == FALSE) {
        stop("You must set at least one of points, mean, or network to TRUE to obtain a plot.")
      }
      set$plots[[length(set$plots) + 1]] <- g.plot

      if(print.plots == TRUE) {
        print(set$plots)
      }

      return(set)
    }
    else {
      group1 = unique.groups[1]
      group2 = unique.groups[2]

      warning(paste0("No groups specified. Generating plots of first two unique values of group variable: ",group1," and ",group2))

      set = ena.plot.subtraction(set = set,
               groupVar = groupVar,
               group1 = group1,
               group2 = group2,
               points = points,
               mean = mean,
               network = network,
               networkMultiplier = networkMultiplier,
               subtractionMultiplier = subtractionMultiplier,
               group1.color = if (!is.null(colors)) colors[1] else "blue",
               group2.color = if (!is.null(colors)) colors[2] else "red",
               confidence.interval = confidence.interval, backend = backend)


      if(print.plots == TRUE) {
        print(set$plots)
      }

       return(set)
    }
  }
  else if(length(groups) == 1) {
    group = groups

    if(any(data[[groupVar]] == group) == FALSE){
      stop("Group column does not contain group1 value!")
    }

    group.rows = set$points[[groupVar]] == group
    g.plot = ena.plot(enaset = set, title = group, backend = backend, magnify = mag)
    base.color = if (!is.null(colors)) colors[1] else "black"

    if(network == TRUE) {
      g.lw = as.matrix(set$line.weights)[group.rows, , drop = FALSE]
      g.mean.lw = colMeans(g.lw) * wm

      g.plot = ena.plot.network(g.plot, network = g.mean.lw, colors = base.color)
    }

    if(points == TRUE) {
      g.points.for.plot = as.matrix(set$points)[group.rows, , drop = FALSE]
      g.plot = ena.plot.points(enaplot = g.plot,points = g.points.for.plot,colors = base.color)
    }

    if(mean == TRUE) {
      g.points.for.plot = as.matrix(set$points)[group.rows, , drop = FALSE]
      g.plot = ena.plot.group(g.plot, g.points.for.plot, colors = base.color, labels = group, confidence.interval = confidence.interval)
    }

    else if(TRUE %in% c(network,points, mean) == FALSE) {
      stop("You must set at least one of points, mean, or network to TRUE to obtain a plot.")
    }
    set$plots[[length(set$plots) + 1]] <- g.plot

    if(print.plots == TRUE) {
      print(set$plots)
    }

    return(set)
  }
  else if (length(groups) >= 2) {
    if (length(groups) > 2) {
      warning(paste0("More than two groups specified. Plotting the first two groups: ", groups))
    }

    groups.missing = groups[which(!groups %in% data[[groupVar]])]
    if(length(groups.missing) > 0) {
      stop(paste0("Group column does not contain group value(s): ", groups.missing))
    }

    set = ena.plot.subtraction(
      set = set,
      groupVar = groupVar,
      group1 = groups[1],
      group2 = groups[2],
      points = points,
      mean = mean,
      network = network,
      networkMultiplier = networkMultiplier,
      subtractionMultiplier = subtractionMultiplier,
      group1.color = if (!is.null(colors)) colors[1] else "blue",
      group2.color = if (!is.null(colors)) colors[2] else "red",
      confidence.interval = confidence.interval, backend = backend,
      ...
    )

    if(print.plots == TRUE) {
      print(set$plots)
    }

    return(set)
  }
}


##
#' @title Find conversations by unit
#'
#' @description Find rows of conversations by unit
#'
#' @details [TBD]
#'
#' @param set [TBD]
#' @param units [TBD]
#' @param units.by [TBD]
#' @param codes [TBD]
#' @param conversation.by [TBD]
#' @param window [TBD]
#' @param conversation.exclude [TBD]
#'
#' @examples
#' data(RS.data)
#'
#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
#'               'Client.and.Consultant.Requests','Design.Reasoning',
#'               'Collaboration');
#'
#' accum = ena.accumulate.data(
#'   units = RS.data[,c("Condition","UserName")],
#'   conversation = RS.data[,c("Condition","GroupName")],
#'   metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre",
#'                         "CONFIDENCE.Post","C.Change")],
#'   codes = RS.data[,codeNames],
#'   model = "EndPoint",
#'   window.size.back = 4
#' );
#' set = ena.make.set(
#'   enadata = accum,
#'   rotation.by = ena.rotate.by.mean,
#'   rotation.params = list(accum$meta.data$Condition=="FirstGame",
#'                          accum$meta.data$Condition=="SecondGame")
#' );
#' ena.conversations(set = RS.data,
#'   units = c("FirstGame.steven z"), units.by=c("Condition","UserName"),
#'   conversation.by = c("Condition","GroupName"),
#'   codes=codeNames, window = 4
#' )
#'
#' @export
#' @return list containing row indices representing conversations
##
ena.conversations = function(set, units, units.by=NULL, codes=NULL, conversation.by = NULL, window = 4, conversation.exclude = c()) {
  # rawData = data.table::copy(set$enadata$raw);
  if(is.null(units.by)) {
    if(!is(set, "ena.set")) {
      stop("If units.by is NULL, set must be an ena.set object")
    }
    units.by = set$`_function.params`$units.by;
  }
  # conversation.by = set$enadata$function.params$conversations.by;
  # window = set$enadata$function.params$window.size.back;
  # rawAcc = data.table::copy(set$enadata$accumulated.adjacency.vectors);
  if(is(set, "ena.set")) {
    rawAcc2 = set$model$raw.input
  } else {
    rawAcc2 = data.table::data.table(set) #$enadata$raw);
  }

  # rawAcc$KEYCOL = merge_columns_c(rawAcc, conversation.by)
  rawAcc2$KEYCOL = merge_columns_c(rawAcc2, conversation.by, sep = "::")

  # conversationsTable = rawAcc[, paste(.I, collapse = ","), by = c(conversation.by)]
  conversationsTable2 = rawAcc2[, paste(.I, collapse = ","), by = c(conversation.by)]

  # rows = sapply(conversationsTable$V1, function(x) as.numeric(unlist(strsplit(x, split=","))),USE.NAMES = T)
  rows2 = lapply(conversationsTable2$V1, function(x) as.numeric(unlist(strsplit(x, split=","))))
  # browser()
  # names(rows) = merge_columns_c(conversationsTable,conversation.by); #unique(rawAcc[,KEYCOL])
  names(rows2) = merge_columns_c(conversationsTable2,conversation.by, sep = "::"); #unique(rawAcc[,KEYCOL])

  # unitRows = merge_columns_c(rawAcc[,c(units.by),with=F], units.by)
  unitRows2 = merge_columns_c(rawAcc2[,c(units.by),with=F], units.by, sep = "::")

  # adjCol = set$enadata$adjacency.matrix[1,] %in%  codes[1] & set$enadata$adjacency.matrix[2,] %in% codes[2]
  # adjColName = paste("adjacency.code.", which(adjCol), sep = "")
  # codedUnitRows = which(unitRows %in% units & rawAcc[[adjColName]] == 1)

  codedRows = rawAcc2[, rowSums(.SD), .SDcols = codes] > 0
  codedUnitRows2 = which(unitRows2 %in% units & codedRows)
  codedUnitRows2 = codedUnitRows2[!(codedUnitRows2 %in% as.vector(unlist(rows2[conversation.exclude])))]
  # codedUnitRowConvs = rawAcc[codedUnitRows,KEYCOL];
  codedUnitRowConvs2 = rawAcc2[codedUnitRows2,KEYCOL];

  codedUnitRowConvsAll = NULL;
  codedUnitRowConvsAll2 = NULL;
  unitRowsNotCooccurred = c()
  if(length(codedUnitRows2) > 0) {
    codedUnitRowConvsAll = unique(unlist(sapply(X = 1:length(codedUnitRows2), simplify = F, FUN = function(x) {
      thisConvRows = rows2[[codedUnitRowConvs2[x]]]
      thisRowInConv = which(thisConvRows == codedUnitRows2[x])
      winUse = ifelse(is.infinite(window), thisRowInConv, window)
      thisRowAndWindow = rep(thisRowInConv,winUse) - (winUse-1):0
      coOccursFound = all(rawAcc2[thisConvRows[thisRowAndWindow[thisRowAndWindow > 0]], lapply(.SD, sum), .SDcols=codes] > 0)
      if(coOccursFound) {
        thisConvRows[thisRowAndWindow[thisRowAndWindow > 0]]
      } else {
        unitRowsNotCooccurred <<- c(unitRowsNotCooccurred, thisConvRows[thisRowInConv])
        # coOccursFound
        NULL
      }
    })))
  }
  return(list(
    conversations = as.list(rows2),
    unitConvs = unique(rawAcc2[codedUnitRows2,KEYCOL]),
    allRows = codedUnitRowConvsAll,
    unitRows = codedUnitRows2,
    toRemove = unitRowsNotCooccurred
  ));
}

###
#' @title ENA Rotate by regression
#'
#' @description This function allows user to provide a regression formula for rotation on x and optionally on y.
#'    If regression formula for y is not provide, svd is applied to the residual data deflated by x to get y coordinates.
#'    The regression formula uses ENA dimensions are dependent variables.
#'    The first predictor has to be two-group categorical, binary, or numerical.
#'
#' @param enaset An \code{\link{ENAset}}
#' @param params list of parameters, may include:
#'     x_var: Regression formula for x direction, such as "lm(formula=V ~ Condition + GameHalf + Condition : GameHalf)",
#'      where V always stands for the ENA points.
#'     y_var: Regression formula, similar to x_var, for y direction (optional).
#'
#' @export
#' @return \code{\link{ENARotationSet}}
ena.rotate.by.hena.regression = function(enaset, params) {
  # check arguments
  if ( !is.list(params) || is.null(params$x_var) ) {
    stop("params must be provided as a list() and provide `x_var`")
  }

  x <- params$x_var;
  y <- params$y_var;
  points <- params$points;
  fullNames <- params$fullNames;

  if(is.null(fullNames)) {
    fullNames = F;
  }

  #get points
  if(!is.null(points)) {
    p <- points
  }
  else  if (is.null(enaset$points.normed.centered)) {
    p <- as.matrix(enaset$model$points.for.projection);
  }
  else {
    p <- as.matrix(enaset$points.normed.centered);
  }

  #regress to get v1 using x
  V <- p;

  # only works using attach()
  # attach(enaset$meta.data,warn.conflicts = F)
  # v1 = eval(parse(text = x))$coefficients[2,]

  # v1 <- with(enaset$meta.data, {
  #   eval(parse(text = x))$coefficients[2,]
  # });
  # v1 <- with(enaset$model$points.for.projection, NULL, formula = x);
  v1_res <- with.ena.matrix(enaset$model$points.for.projection, {
    lm(formula(params$x_var));
  });
  v1 <- v1_res$coefficients[2,]

  # make v1  a unit vector
  norm_v1 <- sqrt(sum(v1 * v1));
  if (norm_v1 != 0) {
    v1 <- v1 / norm_v1;
  }

  # name v1 vector
  if(is.na(all.vars(x)[2])) {
    xName <- names(v1)[1];
  }
  else {
    if(fullNames) {
      warning("FullName param is likely wrong.")
      xName <- parse(text = x)[[1]][["formula"]][[3]];
    }
    else {
      xName <- all.vars(x)[2];
    }
  }

  # Save v1
  R <- matrix(c(v1), ncol = 1);
  colnames(R) <- c(paste0(xName,"_reg"));

  #deflate matrix by x dimension
  A <- as.matrix(p)
  defA <- as.matrix(A) - as.matrix(A) %*% v1 %*% t(v1)

  #if y formula is given, regress by y formula
  if (!is.null(y)) {

    # regress to get v2 vector using formula y
    V <- defA;

    # Removed attach abvove
    # v2 = eval(parse(text = y))$coefficients[2,]
    # v2 <- with(enaset$meta.data, {
    #   eval(parse(text = y))$coefficients[2,]
    # });
    # v2 <- with(enaset$model$points.for.projection, NULL, formula = y, V = V);
    v2_res <- with.ena.matrix(enaset$model$points.for.projection, {
      lm(formula(params$y_var));
    });
    v2 <- v2_res$coefficients[2,]

    #make v2 a unit vector

    norm_v2 <- sqrt(sum(v2 * v2));
    if (norm_v2 != 0) {
      v2 <- v2 / norm_v2;
    }

    #name v2 vector
    if(is.na(all.vars(y)[2])) {
      yName <- names(v2)[1]
    }
    else {
      if(fullNames) {
        warning("FullName param is likely wrong.")
        yName <- parse(text = y)[[1]][["formula"]][[3]];
      }
      else {
        yName <- all.vars(y)[2]
      }
    }

    # save both v1 and v2
    R <- cbind(v1, v2);
    colnames(R) <- c(paste0(xName,"_reg"), paste0(yName,"_reg"));

    #deflat by v2
    defA <- as.matrix(defA) - as.matrix(defA) %*% v2 %*% t(v2);
  }

  # get svd for deflated points
  svd_result <- prcomp(defA, retx=FALSE, scale=FALSE, center=FALSE, tol=0);
  svd_v <- svd_result$rotation;

  # Merge rotation vectors
  vcount <- ncol(R);
  colNamesR <- colnames(R);
  combined <- cbind(R, svd_v[, 1:(ncol(svd_v) - vcount)]);
  colnames(combined) <- c(
    colNamesR,
    paste0("SVD", ((vcount + 1):ncol(combined)))
  );

  #create rotation set
  rotation_set <- ENARotationSet$new(
    node.positions = NULL,
    rotation = combined,
    codes = enaset$rotation$codes,
    eigenvalues = NULL
  )

  return(rotation_set);
}

##
#' @title Plot points on an ENAplot
#'
#' @description Plot all or a subset of the points of an ENAplot using the plotly plotting library
#'
#' @export
#'
#' @param enaplot \code{\link{ENAplot}} object to use for plotting
#' @param points A dataframe of matrix where the first two column are X and Y coordinates
#' @param point.size A data.frame or matrix where the first two column are X and Y coordinates of points to plot in a projected ENA space defined in ENAplot
#' @param labels A character vector of point labels, length nrow(points); default: NULL
#' @param confidence.interval A character determining markings to use for confidence intervals, choices: none, box, crosshair, default: none
#' @param outlier.interval A character determining markings to use for outlier interval, choices: none, box, crosshair, default: none
#' @param confidence.interval.values A matrix/dataframe where columns are CI x and y values for each point
#' @param outlier.interval.values A matrix/dataframe where columns are OI x and y values for each point
#' @param shape A character which determines the shape of point markers, choices:   square, triangle, diamond, circle, default: circle
#' @param colors A character vector of the point marker colors; if one given it is used for all, otherwise must be same length as points; default: black
#' @param label.offset character: top left (default), top center, top right, middle left, middle center, middle right, bottom left, bottom center, bottom right
#' @param label.group A string used to group the labels in the legend. Items plotted with the same label.group will show/hide together when clicked within the legend.
#' @param label.font.size An integer which determines the font size for point labels, default: enaplot$font.size
#' @param label.font.color A character which determines the color of label font, default: enaplot$font.color
#' @param label.font.family	A character which determines label font type, choices: Arial, Courier New, Times New Roman, default: enaplot$font.family
#' @param show.legend Logical indicating whether to show the point labels in the in legend
#' @param legend.name Character indicating the name to show above the plot legend
#' @param texts [TBD]
#' @param ... additional parameters addressed in inner function
#'
#'
#' @seealso \code{\link{ena.plot}}, \code{\link{ENAplot}}, \code{\link{ena.plot.group}}
#'
#' @examples
#' data(RS.data)
#'
#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
#'   'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
#'
#' accum = ena.accumulate.data(
#'   units = RS.data[,c("UserName","Condition")],
#'   conversation = RS.data[,c("Condition","GroupName")],
#'   metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post")],
#'   codes = RS.data[,codeNames],
#'   window.size.back = 4
#' )
#'
#' set = ena.make.set(
#'   enadata = accum,
#'   rotation.by = ena.rotate.by.mean,
#'   rotation.params = list(
#'       accum$meta.data$Condition=="FirstGame",
#'       accum$meta.data$Condition=="SecondGame"
#'   )
#' )
#'
#' plot = ena.plot(set)
#'
#' group1.points = set$points[set$meta.data$Condition == "FirstGame",]
#' group2.points = set$points[set$meta.data$Condition == "SecondGame",]
#' plot = ena.plot.points(plot, points = group1.points);
#' plot = ena.plot.points(plot, points = group2.points);
#' print(plot);
#'
#' @return \code{\link{ENAplot}} The ENAplot provided to the function, with its plot updated to include the new points.
##
ena.plot.points = function(
  enaplot,

  points = NULL,    #vector of unit names or row indices
  point.size = enaplot$point$size,
  labels = NULL, #unique(enaplot$enaset$enadata$unit.names),
  label.offset = "top left",
  label.group = NULL,

  label.font.size = NULL, #enaplot$get("font.size"),
  label.font.color = NULL, #enaplot$get("font.color"),
  label.font.family = NULL, #enaplot$get("font.family"),

  shape = "circle",
  colors = NULL, # c("blue"), #rep(I("black"), nrow(points)),

  confidence.interval.values = NULL,
  confidence.interval = c("none", "crosshairs", "box"),

  outlier.interval.values = NULL,
  outlier.interval = c("none", "crosshairs", "box"),
  show.legend = T,
  legend.name = "Points",
  texts = NULL,
  ...
) {
  ###
  # Parameter Checking and Cleaning
  ###
    if (.qe_backend(enaplot))
      return(.qe_plot_points(enaplot, supplied = names(match.call())[-1],
        points = points, point.size = point.size, labels = labels, shape = shape,
        colors = colors, label.font.size = label.font.size, label.font.color = label.font.color,
        label.font.family = label.font.family, texts = texts, legend.name = legend.name))

    env = environment();
    for(n in c("font.size", "font.color", "font.family")) {
      if(is.null(get(paste0("label.",n))))
        env[[paste0("label.",n)]] = enaplot$get(n);
    }

    if(is.null(points)) {
      # stop("Must provide points to plot.")
      points = enaplot$enaset$points
    }

    if(is(points, "numeric")){
      points = matrix(points);
      dim(points) = c(1,nrow(points))
      points.layout = data.table::data.table(points);
    }
    else if (is.data.table(points)) {
      # points.layout = remove_meta_data(points)
      points.layout = data.table::copy(points)
    }
    else {
      points.layout = data.table::data.table(points);
    }

    if(!is.character(label.font.family)) {
      label.font.family = enaplot$get("font.family");
    }

    confidence.interval = match.arg(confidence.interval);
    outlier.interval = match.arg(outlier.interval);

    # shape = match.arg(shape);
    valid.shapes = c("circle", "square", "triangle-up", "diamond");
    if(!all(shape %in% valid.shapes))
      stop(sprintf( "Unrecognized shapes: %s", paste(unique(shape[!(shape %in% valid.shapes)]), collapse = ", ") ))
    if(length(shape) == 1)
      shape = rep(shape, nrow(points.layout))

    valid.label.offsets = c("top left","top center","top right","middle left","middle center","middle right","bottom left","bottom center","bottom right");
    if(!all(label.offset %in% valid.label.offsets))
      stop(sprintf( "Unrecognized label.offsets: %s", paste(unique(label.offset[!(label.offset %in% valid.label.offsets)]), collapse = ", ") ))
    if(length(label.offset) == 1)
      label.offset = rep(label.offset, nrow(points.layout))

    if(grepl("^c", confidence.interval) && grepl("^c", outlier.interval)) {
      message("Confidence Interval and Outlier Interval cannot both be crosshair");
      message("Plotting Outlier Interval as box");
      outlier.interval = "box";
    }

    if(length(colors) == 1) {
      colors = rep(colors, nrow(points.layout))
    }
    if(length(point.size) == 1)
      point.size = rep(point.size, nrow(points.layout))
    if(is.null(labels))
      show.legend = F
  ###
  # END: Parameter Checking and Cleaning
  ###

  ###
  # Set error value for CI|OI crosshair on plot
  ###
    error = list(x = list(visible=T, type="data"), y = list(visible=T, type="data"));
    int.values = NULL;
    if(grepl("^c", confidence.interval) && !is.null(confidence.interval.values)) {
      int.values = confidence.interval.values;
    }
    else if(grepl("^c", outlier.interval) && !is.null(outlier.interval.values)) {
      int.values = outlier.interval.values;
    }
    error$x$array = int.values[, 1];
    error$y$array = int.values[, 2];
  ###
  # END: Set error value for crosshair on plot
  ###

  ###
  # Set box value for CI|OI box on plot
  #####
    box.values = NULL;
    if(grepl("^b", confidence.interval) && !is.null(confidence.interval.values)) {
      box.values = confidence.interval.values;
      box.label = "Conf. Int.";
    }
    if(grepl("^b", outlier.interval) && !is.null(outlier.interval.values)) {
      box.values = outlier.interval.values;
      box.label = "Outlier Int.";
    }
  ######
  # END: Set box value for CI|OI box on plot
  ###

  ###
  # Plot
  #####
    points.matrix = remove_meta_data(points.layout)
    colnames(points.matrix) = paste0("X", rep(1:ncol(points.matrix)));
    this.max = max(points.matrix);
    for(m in 1:nrow(points.matrix)) {
      enaplot$plot = plotly::add_trace(
        p = enaplot$plot,
        data = points.matrix[m,],
        type ="scatter",
        x = ~X1, y = ~X2,
        mode = "markers+text",
        marker = list(
          symbol = shape[m],
          color = colors[m],
          size = point.size[m]
        ),
        error_x = error$x, error_y = error$y,
        showlegend = show.legend,
        # legendgroup = label.group,
        # legendgroup = ifelse(!is.null(box.label), labels[1], NULL),
        name = labels[m],
        text = texts[m], #labels[m],
        textfont = list(
          family = label.font.family,
          size = label.font.size,
          color = label.font.color
        ),
        legendgroup = legend.name,
        textposition = label.offset[m],
        hoverinfo = "x+y+name"
      )
    }

    if(!is.null(box.values)) {
      boxv = data.frame(
        X1 = c(box.values[1,1], box.values[2,1], box.values[2,1], box.values[1,1] ,box.values[1,1]),
        X2 = c(box.values[1,2], box.values[1,2], box.values[2,2], box.values[2,2], box.values[1,2])
      )
      this.max = max(boxv, this.max)
      enaplot$plot = plotly::add_trace(
        p = enaplot$plot,
        data = boxv,
        type = "scatter",
        x = ~X1, y = ~X2,
        mode = "lines",
        line = list(
          width = 1,
          color = colors[1],
          dash = "dash"
        ),
        # "legendgroup" = labels[1],
        showlegend = show.legend,
        name = box.label
      )
    }

    if(this.max*1.2 > max(enaplot$axes$y$range)) {
      this.max = this.max * 1.2
      enaplot$axes$x$range = c(-this.max, this.max)
      enaplot$axes$y$range = c(-this.max, this.max)
      enaplot$plot = plotly::layout(
        enaplot$plot,
        xaxis = enaplot$axes$x,
        yaxis = enaplot$axes$y
      );
    }
  #####
  # END: Plot
  ###

  return(enaplot);
}


# Post-fit node moves for display. The math is libena's
# (inst/include/libena/positions.hpp: unit_circle_nodes, node_centroids),
# shared with qe-ena, rena-wasm and ENA.jl.

#' Move nodes onto a circle along their own rays
#'
#' A post-fit display transform: in the plane of two dimensions, pushes every
#' node out along its own ray to the length of the longest node there, then
#' recomputes the centroids for the moved nodes. Nothing is refit.
#'
#' Nodes of length zero in the plane are left where they are, as are the
#' nodes' other dimensions. Unit points never change. The centroids, all
#' dimensions of them, are the model's node weights times the moved nodes:
#' each unit's line weights split between the codes they connect (half to
#' each code for unordered networks; for ordered ones, as the fit weights
#' them) and normalised to sum to 1, the weighting the fit's own centroids
#' use. So the goodness of fit (\code{\link{ena.correlations}}) reflects the
#' moved nodes.
#'
#' Works for unordered and ordered (\code{accumulate(ordered = TRUE)}) sets.
#'
#' @param set An \code{ena.set}, e.g. from \code{\link{model}} or
#'   \code{\link{ena.make.set}}.
#' @param dimension_name_1 Name of the plane's x dimension (a column of
#'   \code{set$rotation$nodes}). Defaults to the first dimension.
#' @param dimension_name_2 Name of the plane's y dimension. Defaults to the
#'   second dimension.
#'
#' @return \code{set}, with \code{set$rotation$nodes} moved on the two
#'   dimensions and \code{set$model$centroids} recomputed.
#'
#' @seealso \code{\link{move_nodes_to_unit_circle_with_equal_space}}, which
#'   also spaces the nodes equally around the circle.
#' @examples
#' data(RS.data)
#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'            "Client.and.Consultant.Requests", "Design.Reasoning",
#'            "Collaboration")
#' set <- RS.data |>
#'   accumulate(c("Condition", "UserName"), codes, c("Condition", "GroupName")) |>
#'   model()
#' circled <- move_nodes_to_unit_circle(set)
#' circled$rotation$nodes
#' @export
move_nodes_to_unit_circle <- function(
    set,
    dimension_name_1 = colnames(as.matrix(set$rotation$nodes))[1],
    dimension_name_2 = colnames(as.matrix(set$rotation$nodes))[2]
) {
  move_nodes_on_circle(set, dimension_name_1, dimension_name_2, "radial")
}

#' Move nodes onto a circle, equally spaced
#'
#' A post-fit display transform: in the plane of two dimensions, places the
#' nodes on a circle with the radius of the longest node there, keeping
#' their order around the origin and spacing them \eqn{2\pi/n} apart,
#' starting from the longest node, which stays where it is. Then recomputes
#' the centroids for the moved nodes. Nothing is refit.
#'
#' The order around the origin is: nodes with a non-negative y coordinate by
#' decreasing x, then nodes with a negative y coordinate by increasing x
#' (ties keep the codes' order). When two nodes are equally long, the first
#' stays fixed. Nodes of length zero in the plane are left where they are and
#' do not count towards \eqn{n}. The rest is as for
#' \code{\link{move_nodes_to_unit_circle}}.
#'
#' @inheritParams move_nodes_to_unit_circle
#' @inherit move_nodes_to_unit_circle return
#'
#' @seealso \code{\link{move_nodes_to_unit_circle}}, which moves each node
#'   along its own ray instead.
#' @examples
#' data(RS.data)
#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
#'            "Client.and.Consultant.Requests", "Design.Reasoning",
#'            "Collaboration")
#' set <- RS.data |>
#'   accumulate(c("Condition", "UserName"), codes, c("Condition", "GroupName")) |>
#'   model()
#' spaced <- move_nodes_to_unit_circle_with_equal_space(set)
#' spaced$rotation$nodes
#'
#' # Another plane, e.g. the second and third dimensions
#' dims <- colnames(as.matrix(set$rotation$nodes))
#' move_nodes_to_unit_circle_with_equal_space(set, dims[2], dims[3])
#' @export
move_nodes_to_unit_circle_with_equal_space <- function(
  set,
  dimension_name_1 = colnames(as.matrix(set$rotation$nodes))[1],
  dimension_name_2 = colnames(as.matrix(set$rotation$nodes))[2]
) {
  move_nodes_on_circle(set, dimension_name_1, dimension_name_2, "equal")
}

# Shared body: libena moves the nodes (mode "radial" or "equal") and
# recomputes the centroids; the set gets them back with its column classes.
move_nodes_on_circle <- function(set, dimension_name_1, dimension_name_2, mode) {
  nodes <- as.matrix(set$rotation$nodes)
  dimension_names <- c(dimension_name_1, dimension_name_2)
  idx <- match(dimension_names, colnames(nodes))
  if (anyNA(idx)) {
    stop("Unknown dimension(s): ",
         paste(dimension_names[is.na(idx)], collapse = ", "),
         ". Use columns of set$rotation$nodes: ",
         paste(colnames(nodes), collapse = ", "))
  }

  # Ordered sets: recompute centroids with the self-connection weight the
  # nodes were fit with. Sets fit before it was recorded used 1 (libena
  # counted self-connections once from 2026-05 until rENA 0.4.16).
  self_weight <- if (is.null(set$rotation$self.weight)) 1 else set$rotation$self.weight
  lw <- as.matrix(set$line.weights)
  key <- set$rotation$adjacency.key
  moved <- if (!is(set, "ena.ordered.set") && !is.null(key) && ncol(as.matrix(key)) == ncol(lw)) {
    # Unordered: centroids from the same key-driven weighting the fit used
    # (self-connection columns included).
    ft <- key_indices(key, key_codes(key, set$rotation$codes))
    move_nodes_to_unit_circle_by_key_c(lw, nodes, idx[1] - 1L, idx[2] - 1L, mode,
                                       ft$from, ft$to, self_weight)
  } else {
    move_nodes_to_unit_circle_c(lw, nodes, idx[1] - 1L, idx[2] - 1L, mode,
                                is(set, "ena.ordered.set"), self_weight)
  }

  set$rotation$nodes <- replace_dimension_columns(
    set$rotation$nodes, moved$nodes[, idx, drop = FALSE], dimension_names
  )
  set$model$centroids <- replace_dimension_columns(
    set$model$centroids, moved$centroids, colnames(nodes)
  )
  set
}

# A copy of the data.table x (nodes or centroids) with columns `cols` replaced
# by the columns of the matrix `values`, each keeping its attributes (class).
replace_dimension_columns <- function(x, values, cols) {
  x <- data.table::copy(x)
  for (k in seq_along(cols)) {
    value <- as.numeric(values[, k])
    attributes(value) <- attributes(x[[cols[k]]])
    data.table::set(x, j = cols[k], value = value)
  }
  x
}

#####
#' @title Animated movie of growing ENA trajectories
#'
#' @description Creates an animated Plotly visualization of trajectories growing
#' across shared calendar time / conversation turns.
#'
#' @export
#'
#' @param enaplot \code{\link{ENAplot}} object to use for plotting base canvas
#' @param points Data frame or matrix of points with 2 coordinate dimensions
#' @param by Vector identifying trajectory groupings (e.g. speaker/unit)
#' @param time Monotonic time/turn index vector corresponding to points
#' @param names Character vector of labels for each trajectory
#' @param colors Character vector of colors for each trajectory
#' @param smooth Character indicating smoothing method: "none" (default, point-to-point) or "poly" (LOOCV-2D polynomial curve)
#' @param poly.degree Optional integer degree for polynomial fit. If NULL, selected automatically via LOOCV-2D
#' @param poly.max.degree Maximum polynomial degree to test in LOOCV-2D (default 3)
#' @param poly.eval.points Number of points along smooth curve (default 100)
#' @param show.points Logical; whether to show discrete point markers along the trajectory (default TRUE)
#' @param frame_ms Milliseconds per animation frame (default 250)
#' @param show_tips Logical; whether to show glowing tip markers at current time position
#' @param title Optional title string
#' @return Plotly widget with play/pause controls and slider
#' #####
ena.plot.movie = function(
  enaplot,
  points,
  by,
  time,
  names = NULL,
  colors = NULL,
  smooth = c("none", "poly"),
  poly.degree = NULL,
  poly.max.degree = 3L,
  poly.eval.points = 100L,
  show.points = TRUE,
  frame_ms = 250,
  show_tips = TRUE,
  title = NULL
) {
  if (.qe_backend(enaplot)) {
    .qe_no_trajectories("ena.plot.movie")
    return(enaplot$plot)
  }

  if (!requireNamespace("plotly", quietly = TRUE)) {
    stop("plotly is required for animated trajectory movies")
  }

  if (is(points, "ena.matrix") || any(find_meta_cols(points))) {
    pts_clean <- remove_meta_data(points)
    pts_df <- data.frame(
      X1 = as.numeric(pts_clean[[1L]]),
      X2 = as.numeric(pts_clean[[2L]])
    )
  } else if (is.matrix(points)) {
    pts_df <- data.frame(
      X1 = as.numeric(points[, 1L]),
      X2 = as.numeric(points[, 2L])
    )
  } else {
    pts_raw <- as.data.frame(points)
    num_cols <- vapply(pts_raw, is.numeric, logical(1))
    if (sum(num_cols) >= 2L) {
      num_df <- pts_raw[, num_cols, drop = FALSE]
      pts_df <- data.frame(
        X1 = as.numeric(num_df[[1L]]),
        X2 = as.numeric(num_df[[2L]])
      )
    } else {
      stop("`points` must contain at least 2 numeric coordinate columns (X and Y).")
    }
  }
  dim_cols <- c("X1", "X2")

  by_vec <- as.character(by)
  time_vec <- as.numeric(time)

  unique_by <- unique(by_vec)
  n_by <- length(unique_by)

  if (is.null(names)) {
    names <- unique_by
  }
  if (is.null(colors)) {
    palette <- c("#1650FF", "#CD0BBC", "#00A86B", "#FF8C00", "#9932CC", "#008080")
    colors <- palette[((seq_len(n_by) - 1L) %% length(palette)) + 1L]
  }

  smooth <- match.arg(smooth)

  # Precompute polynomial curves if smooth == "poly"
  poly_curves <- list()
  if (smooth == "poly") {
    for (b_idx in seq_along(unique_by)) {
      u <- unique_by[b_idx]
      u_pts <- pts_df[by_vec == u, , drop = FALSE]
      if (nrow(u_pts) >= 2L) {
        curve_fit <- .fit_etm_poly_curve(
          points = u_pts[, dim_cols, drop = FALSE],
          degree = poly.degree,
          max_degree = poly.max.degree,
          criterion = "loocv"
        )
        poly_curves[[u]] <- as.matrix(.eval_etm_poly_curve(curve_fit, poly.eval.points))
      }
    }
  }

  # All unique time steps in chronological order
  all_times <- sort(unique(time_vec))
  if (length(all_times) == 0L) {
    stop("No valid time points provided for movie.")
  }

  # Build cumulative frame data
  frame_list <- vector("list", length(all_times) * n_by * 3L)
  fi <- 0L

  for (t_idx in seq_along(all_times)) {
    cur_t <- all_times[t_idx]
    for (b_idx in seq_along(unique_by)) {
      u <- unique_by[b_idx]
      u_all_mask <- (by_vec == u)
      u_mask <- u_all_mask & (time_vec <= cur_t)
      if (!any(u_mask)) next

      sub_pts <- pts_df[u_mask, , drop = FALSE]
      tip_pt <- sub_pts[nrow(sub_pts), , drop = FALSE]

      # Determine line coordinates: either smooth poly curve or discrete points
      if (smooth == "poly" && !is.null(poly_curves[[u]])) {
        total_n <- sum(u_all_mask)
        cur_n <- nrow(sub_pts)
        frac <- if (total_n > 1L) (cur_n - 1L) / (total_n - 1L) else 1.0
        n_eval <- max(2L, as.integer(ceiling(frac * nrow(poly_curves[[u]]))))
        curve_sub <- poly_curves[[u]][seq_len(min(n_eval, nrow(poly_curves[[u]]))), , drop = FALSE]
        line_x <- curve_sub[, 1L]
        line_y <- curve_sub[, 2L]
      } else {
        line_x <- sub_pts[[dim_cols[1L]]]
        line_y <- sub_pts[[dim_cols[2L]]]
      }

      fi <- fi + 1L
      frame_list[[fi]] <- data.frame(
        x = line_x,
        y = line_y,
        unit = u,
        unit_name = names[b_idx],
        color = colors[b_idx],
        time_frame = cur_t,
        trace_type = "line",
        stringsAsFactors = FALSE
      )

      if (isTRUE(show.points) && smooth == "poly") {
        fi <- fi + 1L
        frame_list[[fi]] <- data.frame(
          x = sub_pts[[dim_cols[1L]]],
          y = sub_pts[[dim_cols[2L]]],
          unit = u,
          unit_name = names[b_idx],
          color = colors[b_idx],
          time_frame = cur_t,
          trace_type = "points",
          stringsAsFactors = FALSE
        )
      }

      if (isTRUE(show_tips)) {
        fi <- fi + 1L
        frame_list[[fi]] <- data.frame(
          x = tip_pt[[dim_cols[1L]]],
          y = tip_pt[[dim_cols[2L]]],
          unit = u,
          unit_name = names[b_idx],
          color = colors[b_idx],
          time_frame = cur_t,
          trace_type = "tip",
          stringsAsFactors = FALSE
        )
      }
    }
  }

  movie_df <- do.call(rbind, frame_list[seq_len(fi)])

  # Add traces onto base enaplot
  p <- enaplot$plot

  for (b_idx in seq_along(unique_by)) {
    u <- unique_by[b_idx]
    u_line <- movie_df[movie_df$unit == u & movie_df$trace_type == "line", , drop = FALSE]

    p <- plotly::add_trace(
      p,
      data = u_line,
      x = ~x,
      y = ~y,
      frame = ~time_frame,
      name = names[b_idx],
      type = "scatter",
      mode = if (smooth == "poly") "lines" else (if (isTRUE(show.points)) "lines+markers" else "lines"),
      line = list(color = colors[b_idx], width = 2.5),
      marker = if (smooth != "poly" && isTRUE(show.points)) list(color = colors[b_idx], size = 5) else NULL,
      showlegend = TRUE
    )

    if (smooth == "poly" && isTRUE(show.points)) {
      u_pts <- movie_df[movie_df$unit == u & movie_df$trace_type == "points", , drop = FALSE]
      p <- plotly::add_trace(
        p,
        data = u_pts,
        x = ~x,
        y = ~y,
        frame = ~time_frame,
        name = paste0(names[b_idx], " (points)"),
        type = "scatter",
        mode = "markers",
        marker = list(color = colors[b_idx], size = 5, opacity = 0.7),
        showlegend = FALSE
      )
    }

    if (isTRUE(show_tips)) {
      u_tips <- movie_df[movie_df$unit == u & movie_df$trace_type == "tip", , drop = FALSE]
      p <- plotly::add_trace(
        p,
        data = u_tips,
        x = ~x,
        y = ~y,
        frame = ~time_frame,
        name = paste0(names[b_idx], " (head)"),
        type = "scatter",
        mode = "markers",
        marker = list(color = colors[b_idx], size = 12, symbol = "diamond"),
        showlegend = FALSE
      )
    }
  }

  p <- plotly::animation_opts(
    p,
    frame = frame_ms,
    transition = 0,
    redraw = TRUE
  )

  p <- plotly::animation_slider(
    p,
    currentvalue = list(prefix = "Time / Turn: ", font = list(color = "#333333"))
  )

  if (!is.null(title)) {
    p <- plotly::layout(p, title = list(text = title))
  }

  p
}

# Ellipsoidal scaling version
lws.positions.sq <- function(enaset) {
  points = as.matrix(enaset$points)
  weights = as.matrix(enaset$line.weights)
  positions = lws_lsq_positions(weights, points, ncol(points));

  node.positions = positions$nodes;
  rownames(node.positions) = enaset$rotation$codes
  colnames(node.positions) = colnames(points)
  
  return(list("node.positions" = node.positions, "centroids" = positions$centroids))
}

lws.positions.sq.R6 <- function(enaset) {
  if( enaset$function.params$center.align.to.origin ) {
    non_zero_rows <- rowSums(as.matrix(enaset$line.weights)) != 0
    positions = lws_lsq_positions(enaset$line.weights[non_zero_rows,], enaset$points.rotated[non_zero_rows,], ncol(enaset$points.rotated));
    mean_centroids = colMeans(positions$centroids);
    centroids = enaset$points.rotated;

    non_zero_row_centroids = rowSums(as.matrix(centroids))!=0;
    centroids[non_zero_row_centroids,] = t(t(positions$centroids) - mean_centroids)
    positions$centroids = centroids;
    positions$nodes = t(t(positions$nodes)-mean_centroids)
  }
  else {
    positions = lws_lsq_positions(enaset$line.weights, enaset$points.rotated, ncol(enaset$points.rotated));
  }

  node.positions = positions$nodes;
  rownames(node.positions) = enaset$enadata$codes;

  return(list("node.positions" = node.positions, "centroids" = positions$centroids))

}

CLASS_NAMES <- list(
  data = "qe.data",
  meta = "qe.metadata",
  code = "qe.code",
  unit = "qe.unit",
  horizon = "qe.horizon"
)

WARNINGS <- list(
  data_from_vector = "Cannot transform vectors to `qe.data`",
  null_metadata = "`metadata` must be supplied as a vector of column names. No metadata classified.",
  null_codes = "`codes` must be supplied as a vector of column names. No codes classified.",
  null_units = "`units` must be supplied as a vector of column names. No units classified.",
  null_horizon = "`horizon` must be supplied as a vector of column names. No horizon classified."
)

#' Convert an object to 'qe.data' class
#'
#' This function converts an object to the 'qe.data' class. If the object is not a data.frame or matrix, it is first converted to a data.table.
#'
#' @param x An object. The object to be converted to 'qe.data' class.
#'
#' @return The modified object with the 'qe.data' class.
#' @examples
#' library(data.table)
#'
#' dt <- data.table(
#'   ID = 1:5,
#'   Name = c("Alice", "Bob", "Charlie", "David", "Eve"),
#'   Age = c(25, 30, 35, 40, 45),
#'   Score = c(85, 90, 95, 80, 75)
#' )
#' dt <- as.qe.data(dt);
#' class(dt) # Should show 'qe.data' along with other classes
#'
#' @export
as.qe.data <- function(x) {
  if(!is.qe.data(x)) {
    if(is.vector(x)) {
      warning(WARNINGS$data_from_vector);
    }
    else {
      if(
         is.matrix(x) ||
        (is.data.frame(x) && !data.table::is.data.table(x))
      ) {
        x <- data.table::as.data.table(x);
      }
      class(x) <- c(CLASS_NAMES$data, class(x));
    }
  }

  # return(data.table::copy(x));
  return(x);
}

#' Convert a vector to 'qe.code' class
#'
#' This function converts a vector to the 'qe.code' class. If the vector is a factor, it is first converted to a character vector.
#'
#' @param x A vector. The vector to be converted to 'qe.code' class.
#'
#' @return The modified vector with the 'qe.code' class.
#' @examples
#' vec <- factor(c("A", "B", "C"))
#' vec <- as.qe.code(vec)
#' class(vec) # Should show 'qe.code' along with other classes
#' @export
as.qe.code <- function(x) {
  if(is.qe.code(x)) return(x);

  if(is.factor(x)) {
    x <- as.character(x);
  }
  class(x) <- c(CLASS_NAMES$code, class(x));

  return(x);
}

#' Convert a vector to 'qe.metadata' class
#'
#' This function converts a vector to the 'qe.metadata' class. If the vector is a factor, it is first converted to a character vector.
#'
#' @param x A vector. The vector to be converted to 'qe.metadata' class.
#'
#' @return The modified vector with the 'qe.metadata' class.
#' @examples
#' vec <- factor(c("A", "B", "C"))
#' vec <- as.qe.metadata(vec)
#' class(vec) # Should show 'qe.metadata' along with other classes
#' @export
as.qe.metadata <- function(x) {
  if(is.qe.metadata(x)) return(x);

  if(is.factor(x)) {
    x <- as.character(x);
  }
  class(x) <- c(CLASS_NAMES$meta, class(x));

  return(x);
}

#' Convert a vector to 'qe.unit' class
#'
#' This function converts a vector to the 'qe.unit' class. If the vector is a factor, it is first converted to a character vector.
#'
#' @param x A vector. The vector to be converted to 'qe.unit' class.
#'
#' @return The modified vector with the 'qe.unit' class.
#' @examples
#' vec <- factor(c("A", "B", "C"))
#' vec <- as.qe.unit(vec)
#' class(vec) # Should show 'qe.unit' along with other classes
#' @export
as.qe.unit <- function(x) {
  if(is.qe.unit(x)) return(x);

  if(is.factor(x)) {
    x <- as.character(x);
  }
  class(x) <- c(CLASS_NAMES$unit, class(x));

  return(x);
}

#' Convert a vector to 'qe.horizon' class
#'
#' This function converts a vector to the 'qe.horizon' class. If the vector is a factor, it is first converted to a character vector.
#'
#' @param x A vector. The vector to be converted to 'qe.horizon' class.
#'
#' @return The modified vector with the 'qe.horizon' class.
#' @examples
#' vec <- factor(c("A", "B", "C"))
#' vec <- as.qe.horizon(vec)
#' class(vec) # Should show 'qe.horizon' along with other classes
#' @export
as.qe.horizon <- function(x) {
  if(is.qe.horizon(x)) return(x);

  if(is.factor(x)) {
    x <- as.character(x);
  }
  class(x) <- c(CLASS_NAMES$horizon, class(x));

  return(x);
}

#' Check if an object is of class 'qe.data'
#'
#' This function checks if an object is of class 'qe.data'.
#'
#' @param x An object. The object to be checked.
#'
#' @return A logical value. TRUE if the object is of class 'qe.data', otherwise FALSE.
#' @examples
#' library(data.table)
#'
#' dt <- data.table(ID = 1:5)
#' class(dt) <- c("qe.data", class(dt))
#' is.qe.data(dt) # Should return TRUE
#' @export
is.qe.data <- function(x) {
  return(CLASS_NAMES$data %in% class(x));
}

#' Check if an object is of class 'qe.code'
#'
#' This function checks if an object is of class 'qe.code'.
#'
#' @param x An object. The object to be checked.
#'
#' @return A logical value. TRUE if the object is of class 'qe.code', otherwise FALSE.
#' @examples
#' dt <- 1:5
#' class(dt) <- c("qe.code", class(dt))
#' is.qe.code(dt) # Should return TRUE
#' @export
is.qe.code <- function(x) {
  return(CLASS_NAMES$code %in% class(x));
}

#' Check if an object is of class 'qe.metadata'
#'
#' This function checks if an object is of class 'qe.metadata'.
#'
#' @param x An object. The object to be checked.
#'
#' @return A logical value. TRUE if the object is of class 'qe.metadata', otherwise FALSE.
#' @examples
#' dt <- 1:5
#' class(dt) <- c("qe.metadata", class(dt))
#' is.qe.metadata(dt) # Should return TRUE
#' @export
is.qe.metadata <- function(x) {
  return(CLASS_NAMES$meta %in% class(x));
}


#' Check if an object is of class 'qe.unit'
#'
#' This function checks if an object is of class 'qe.unit'.
#'
#' @param x An object. The object to be checked.
#'
#' @return A logical value. TRUE if the object is of class 'qe.unit', otherwise FALSE.
#' @examples
#' dt <- 1:5
#' class(dt) <- c("qe.unit", class(dt))
#' is.qe.unit(dt) # Should return TRUE
#' @export
is.qe.unit <- function(x) {
  return(CLASS_NAMES$unit %in% class(x));
}

#' Check if an object is of class 'qe.horizon'
#'
#' This function checks if an object is of class 'qe.horizon'.
#'
#' @param x An object. The object to be checked.
#'
#' @return A logical value. TRUE if the object is of class 'qe.horizon', otherwise FALSE.
#' @examples
#' dt <- 1:5
#' class(dt) <- c("qe.horizon", class(dt))
#' is.qe.horizon(dt) # Should return TRUE
#' @export
is.qe.horizon <- function(x) {
  return(CLASS_NAMES$horizon %in% class(x));
}

####
#' @title ENAset R6class
#'
#' @docType class
#' @importFrom R6 R6Class
#' @import data.table
#' @export

#' @field enadata An \code{\link{ENAdata}} object originally used to create the set
#' @field points.raw A data frame containing accumulated adjacency (co-occurrence) vectors per unit
#' @field points.normed.centered A data frame of centered normed accumulated adjacency (co-occurrence) vectors for each unit
#' @field points.rotated A data frame of point positions for number of dimensions specified in ena.make.set (i.e., the centered, normed, and rotated data)
#' @field line.weights A data frame of connections strengths per unit (Data frame of normed accumu- lated adjacency (co-occurrence) vectors for each unit)
#' @field node.positions - A data frame of positions for each code
#' @field codes - A vector of code names
#' @field rotation.set - An \code{\link{ENARotationSet}} object
#' @field variance - A vector of variance accounted for by each dimension specified
#' @field centroids - A matrix of the calculated centroid positions
#' @field function.call - The string representation of function called
#' @field function.params - A list of all parameters sent to function call
#' @field rotation_dists TBD
#' @field points.rotated.scaled TBD
#' @field points.rotated.non.zero TBD
#' @field line.weights.unrotated TBD
#' @field line.weights.non.zero TBD
#' @field correlations A data frame of spearman and pearson correlations for each dimension specified
#' @field center.align.to.origin - align point and centroid centers to origin
####
ENAset = R6::R6Class("ENAset",
  public = list(


  ## Public Functions ----
    #' Create ENAset
    #'
    #' @param enadata TBD
    #' @param dimensions TBD
    #' @param norm.by TBD
    #' @param rotation.by TBD
    #' @param rotation.params TBD
    #' @param rotation.set TBD
    #' @param node.position.method TBD
    #' @param endpoints.only TBD
    #' @param center.align.to.origin TBD
    #' @param ... TBD
    #'
    #' @return ENAset
    initialize = function(
        enadata,
        dimensions = 2,

        norm.by = fun_sphere_norm,

        rotation.by = ena.svd.R6,
        rotation.params = NULL,
        rotation.set = NULL,

        #center.data = center_data_c,    ### made local to run
        node.position.method = lws.positions.sq.R6,
        endpoints.only = TRUE,
        center.align.to.origin = TRUE,
        ...
    ) {
       self$enadata <- enadata;

       private$dimensions <- dimensions;

       self$codes <- enadata$codes;

       self$function.call <- sys.call(-1);

       self$function.params$norm.by <- norm.by;    #was sphere_norm
       #self$function.params$center.data <- center.data;
       self$function.params$node.position.method <- node.position.method;    #was position.method
       self$function.params$rotation.by <- rotation.by;
       self$function.params$rotation.params <- rotation.params;
       self$function.params$rotation.set <- rotation.set;
       self$function.params$endpoints.only <- endpoints.only;
       self$function.params$center.align.to.origin <- center.align.to.origin;
       private$args <- list(...);
     },


    #' Process ENAset
    #'
    #' @return ENASet
    process = function() {
      return(private$run())
    },

    #' Get property from object
    #'
    #' @param x character key to retrieve from object
    #' @return value from object at x
    get = function(x = "enadata") {
      return(private[[x]])
    },

  ## Public Properties ----
    rotation_dists = NULL,  #leave for now - to be removed for a temp variable
    enadata = NULL,
    points.raw = NULL,    #was data$raw
    points.normed.centered = NULL,    #was data$centered$normed
    points.rotated = NULL,    #was data$centered$rotated
    points.rotated.scaled = NULL,
    points.rotated.non.zero = NULL,
    line.weights = NULL,   #was data$normed
    line.weights.non.zero = NULL,
    line.weights.unrotated = NULL,
    node.positions = NULL,  #was nodes$positions$scaled
    codes = NULL,
    rotation.set = NULL,   ## new - ENARotation object
    correlations = NULL,   #not formerly listed, comes from optimized node positions in egr.positions
    variance = NULL,     #was self$data$centered$latent
    centroids = NULL,
    center.align.to.origin = TRUE,
    function.call = NULL,     #new - string reping function call
    function.params = list(   #list containing parameters function was called with
      norm.by = NULL,
      node.position.method = NULL,
      rotation.by = NULL,
      rotation.params = NULL,
      endpoints.only = NULL,
      center.align.to.origin = TRUE
    )
  ),

  private = list(

     ## Private Properties ----
     args = NULL,
     data.original = NULL,
     optim = NULL,

     #moved from public
     dimensions = 2,

     ## Private Functions ----
     run = function() {
       df = self$enadata$adjacency.vectors;

       # Backup of ENA data, this is not touched again.
       #private$data.original = df[,grep("adjacency.code", colnames(df)), with=F];
       private$data.original = df;

       # carry this out for node positioning
       self$function.params$center.align.to.origin = self$center.align.to.origin;

       # Copy of the original data, this is used for all
       # further operations. Unlike, `data.original`, this
       # is likely to be overwritten.
       self$points.raw = data.table::copy(private$data.original);

       ###
       # Normalize the raw data using self$function.params$norm.by,
       # which defaults to calling rENA::.sphere_norm
       ###
       self$line.weights = self$function.params$norm.by(self$points.raw);

       ###
       # Convert the string vector of code names to their corresponding
       # co-occurence names and set as colnames for the self$line.weights
       ##
       codeNames_tri = svector_to_ut(self$enadata$codes);

       colnames(self$line.weights) = codeNames_tri;
       # set the rownames to that of the original ENAdata file object
       rownames(self$line.weights) = rownames(df);

       attr(self$line.weights, opts$UNIT_NAMES) = attr(df, opts$UNIT_NAMES) #df[, .SD, with=T, .SDcols=self$enadata$get("unitsBy")];
       ###


       ###
       # Center the normed data
       # FIX - store as $data$centered
       ###
       #### ISSUE
       if (self$center.align.to.origin) {
         # only centers non-zero networks
         self$points.normed.centered = self$line.weights;

         non_zero_rows <- rowSums(as.matrix(self$line.weights)) != 0;
         self$points.normed.centered[non_zero_rows,] = center_data_c(self$line.weights[non_zero_rows,]);
       }
       else {
        self$points.normed.centered = center_data_c(self$line.weights);
       }
       colnames(self$points.normed.centered) = codeNames_tri;
       rownames(self$points.normed.centered) = rownames(df);
       attr(self$points.normed.centered, opts$UNIT_NAMES) = attr(self$enadata$adjacency.vectors.raw, opts$UNIT_NAMES)

       ###

       ###
       # Generate and Assign the rotation set
       ###
        if(is.function(self$function.params$rotation.by) && is.null(self$function.params$rotation.set)) {
          self$rotation.set = do.call(self$function.params$rotation.by, list(self, self$function.params$rotation.params));
        }
        else if (!is.null(self$function.params$rotation.set)) {
          if(is(self$function.params$rotation.set, "ENARotationSet")) {
            self$rotation.set = self$function.params$rotation.set;
          } else {
            stop("Supplied rotation.set is not an instance of ENARotationSet")
          }
        }
        else {
          stop("Unable to find or create a rotation set")
        }
       ###

       ###
       # Generated the rotated points
       ###
        self$points.rotated = self$points.normed.centered %*% self$rotation.set$rotation;
        private$dimensions = min(private$dimensions, ncol(self$points.rotated))
        attr(self$points.rotated, opts$UNIT_NAMES) = attr(self$points.normed.centered, opts$UNIT_NAMES);
       ###

       ###
       # Calculate node positions
       #  - The supplied methoed is responsible is expected to return a list
       #    with two keys, "node.positions" and "centroids"
       ###
        if(!is.null(self$rotation.set) && is.null(self$function.params$rotation.set)) {
          positions = self$function.params$node.position.method(self);
          if(all(names(positions) %in% c("node.positions","centroids"))) {
            self$node.positions = positions$node.positions
            self$centroids = positions$centroids

            self$rotation.set$node.positions = positions$node.positions
          }
          else {
            stop(paste(
                "The node position method didn't return back the expected objects:",
                "\tExpected: c('node.positions','centroids')",
                paste("\tReceived: ", names(positions), sep=""),
                sep = "\n"
            ));
          }
        }
        else {
          if (!is.null(self$function.params$rotation.set) && !is.null(self$function.params$rotation.set$node.positions)) {
            self$node.positions = self$function.params$rotation.set$node.positions
          }
          else {
            stop("Unable to determine the node positions either by calculating
                  them using `node.position.method` or using a supplied
                  `rotation.set`");
          }
        }
       ###

       ###
       # Variance
       ###
       variance.of.rotated.data = var(self$points.rotated)
       diagonal.of.variance.of.rotated.data = as.vector(diag(variance.of.rotated.data))
       self$variance = diagonal.of.variance.of.rotated.data/sum(diagonal.of.variance.of.rotated.data)

       return(self);
     }
   )
)

#####
#'
#' @title Wrapper to generate an ENA model
#'
#' @description Generates an ENA model by constructing a dimensional reduction
#' of adjacency (co-occurrence) vectors as defined by the supplied
#' conversations, units, and codes.
#'
#' @details This function generates an ena.set object given a data.frame, units,
#' conversations, and codes. After accumulating the adjacency (co-occurrence)
#' vectors, computes a dimensional reduction (projection), and calculates node
#' positions in the projected ENA space. Returns location of the units in the
#' projected space, as well as locations for node positions, and normalized
#' adjacency (co-occurrence) vectors to construct network graphs. Includes options
#' for returning statistical tests between groups of units.
#'
#' @param data data.frame with containing metadata and coded columns
#' @param codes vector, numeric or character, of columns with codes
#' @param units vector, numeric or character, of columns representing units
#' @param conversation  vector, numeric or character, of columns to segment conversations by
#' @param metadata  vector, numeric or character, of columns with additional meta information for units
#' @param model character, the ENA model to construct: \code{EndPoint} (default) produces a single adjacency vector per unit summing co-occurrences across all lines; \code{AccumulatedTrajectory} produces one adjacency vector per unit per conversation, where each successive conversation accumulates prior ones; \code{SeparateTrajectory} produces one adjacency vector per unit per conversation, each modeled independently
#' @param weight.by "binary" is default, can supply a function to call (e.g. sum)
#' @param window MovingStanzaWindow (default) or Conversation
#' @param window.size.back integer, number of lines back from each line to include in the stanza window (default: 1)
#' @param window.size.forward integer, number of lines forward from each line to include in the stanza window (default: 0). Set to model bidirectional co-occurrence within a window.
#' @param include.meta logical, if TRUE (default) unit metadata is attached to the resulting ENAdata object and accessible via the set; set to FALSE to omit metadata from the model output
#' @param groupVar vector, character, of column name containing group identifiers.
#' If column contains at least two unique values, will generate model using a means rotation (a dimensional reduction maximizing the variance between the means of the two groups)
#' @param groups vector, character, of values of groupVar column used for means rotation or statistical tests
#' @param runTest logical, TRUE will run a Student's t-Test and a Wilcoxon test for groups defined by the groups argument
#' @param ... Additional parameters passed to model generation, including \code{mask} (an optional binary matrix of size ncol(codes) x ncol(codes) where 0 suppresses co-occurrence modeling between a pair of codes; see \code{\link{ena.accumulate.data}})
#'
#'
#' @return ena.set object
#####
ena.set.creator = function(
  data,
  codes,
  units,
  conversation,
  metadata = NULL,
  model = c("EndPoint", "AccumulatedTrajectory", "SeparateTrajectory"),
  weight.by = "binary",
  window = c("MovingStanzaWindow", "Conversation"),
  window.size.back = 1,
  window.size.forward = 0,
  include.meta = TRUE,
  groupVar = NULL,
  groups = NULL,
  runTest = FALSE,
  ...
) {
  data <- data.table::data.table(data)

  model = match.arg(model)
  window = match.arg(window)
  accum = ena.accumulate.data(
    units = data[, ..units, drop = FALSE],
    conversation = data[, ..conversation, drop = FALSE],
    metadata = data[, ..metadata, drop = FALSE],
    codes = data[, ..codes, drop = FALSE],
    window = window,
    window.size.back = window.size.back,
    window.size.forward = window.size.forward,
    weight.by = weight.by,
    model = model,
    include.meta = include.meta,
    ...
  );

  accum$model$raw.input <- as.data.table(data);
  accum$model$raw.input$ENA_UNIT <- merge_columns_c(accum$model$raw.input, units)
  group1 = NULL
  group2 = NULL
  group1.rows = NULL
  group2.rows = NULL

  set_params = list(...)
  set_params$enadata = accum

  ### make set if no group column is specified
  if(is.null(groupVar)) {
    if(runTest == TRUE) {
      warning("Group variable and groups not specified. Unable to run test")
    }
  }

  ### make set if group column is specified, but groups are not
  else if(is.null(groups) == TRUE) {
    unique.groups = unique(as.character(data[[groupVar]]))

    if(length(unique.groups) == 1) {
      warning("Group variable only contains one unique value. ENAset has been created without means rotation")

      if(runTest == TRUE) {
        warning("Multiple groups not specified. Unable to run test")
      }
    }

    else{
      group1 = unique.groups[1]
      group2 = unique.groups[2]

      message(paste0("No groups specified. Defaulting to means rotation using first two unique group values of group variable: ",group1," and ",group2))

      set_params$rotation.by = ena.rotate.by.mean
      set_params$rotation.params = list(accum$meta.data[[groupVar]] == group1, accum$meta.data[[groupVar]] == group2)

      if(runTest == TRUE) {
        warning(paste0("No groups specified. Running test on the first two unique group values of the group variable: ",group1," and ",group2))
      }
    }
  }
  else if(length(groups) == 1) {
    message("Only one group value specified. ENAset has been created without means rotation")

    if(runTest == TRUE) {
      warning("Multiple groups not specified. Unable to run test")
    }
  }
  else {
    group1 = groups[1]
    group2 = groups[2]

    if(length(groups) > 2) {
      warning(paste0("Only two groups are allowed for means rotation. ENAset has been created using a means rotation on the first two groups given: ",group1," and ",group2))
    }

    groups.missing = groups[which(!groups %in% data[[groupVar]])]
    if(length(groups.missing) > 0) {
      stop(paste("Group column does not contain supplied group value(s): ", groups.missing))
    }

    if(runTest == TRUE) {
      if(length(groups) > 2) {
        warning(paste0("More than two groups specified. Running test on the first two groups: ",group1," and ",group2))
      }
    }
  }

  if(!any(is.null(c(group1, group2)))) {
    set_params$rotation.by = ena.rotate.by.mean
    set_params$rotation.params = list(accum$meta.data[[groupVar]] == group1, accum$meta.data[[groupVar]] == group2)

    group1.rows = accum$meta.data[[groupVar]] == group1
    group2.rows = accum$meta.data[[groupVar]] == group2
  }

  set = do.call(ena.make.set, set_params)

  if(
    runTest == TRUE &&
    !any(is.null(c(group1.rows, group2.rows)))
  ) {
    group1.dim1 = as.matrix(set$points)[group1.rows,1]
    group2.dim1 = as.matrix(set$points)[group2.rows,1]
    group1.dim2 = as.matrix(set$points)[group1.rows,2]
    group2.dim2 = as.matrix(set$points)[group2.rows,2]

    set$tests = list(
      wilcox.test = list(
        test.dim1 = wilcox.test(x = group1.dim1, y = group2.dim1),
        test.dim2 = wilcox.test(x = group1.dim2, y = group2.dim2)
      ),
      t.test = list(
        test.dim1 = t.test(x = group1.dim1, y = group2.dim1),
        test.dim2 = t.test(x = group1.dim2, y = group2.dim2)
      )
    )
  } else {
    set$tests = NULL
  }

  return(set)
}

### plot subtraction ###

ena.plot.subtraction = function(
  set,
  groupVar = NULL,
  group1 = NULL,
  group2 = NULL,
  points = FALSE,
  mean = FALSE,
  network = TRUE,
  networkMultiplier = 1,
  subtractionMultiplier = 1,
  group1.color = "blue",
  group2.color = "red",
  confidence.interval = "box",
  backend = getOption("rENA.plot.backend", "plotly"),
  ...
) {
  backend <- match.arg(backend, c("plotly", "qeviz"))
  # qeviz: weights unscaled; the multipliers become magnify. When either is
  # set, the side plots are labelled too (at networkMultiplier), as webENA
  # labels its side plots "(scaled 1.0x)".
  any.mult <- networkMultiplier != 1 || subtractionMultiplier != 1
  wm <- .qe_weight_mult(backend, networkMultiplier)
  sm <- .qe_weight_mult(backend, subtractionMultiplier)
  side.mag <- .qe_magnify(backend, networkMultiplier, any.mult)
  sub.mag  <- .qe_magnify(backend, networkMultiplier * subtractionMultiplier, any.mult)
  group1.rows = set$points[[groupVar]] == group1
  group2.rows = set$points[[groupVar]] == group2

  g1.plot = ena.plot(enaset = set, title = group1, backend = backend, magnify = side.mag)
  g2.plot = ena.plot(enaset = set, title = group2, backend = backend, magnify = side.mag)
  sub.plot = ena.plot(enaset = set, title = paste0("Network Subtraction -- ",group1," vs ",group2),
                      backend = backend, magnify = sub.mag)

  if(network == TRUE) {
    g1.lw = as.matrix(set$line.weights)[group1.rows,,drop=FALSE]
    g1.mean.lw = colMeans(g1.lw) * wm

    g2.lw = as.matrix(set$line.weights)[group2.rows,,drop=FALSE]
    g2.mean.lw = colMeans(g2.lw) * wm

    sub = (g1.mean.lw - g2.mean.lw) * sm

    g1.plot = ena.plot.network(g1.plot, network = g1.mean.lw, colors = group1.color)
    g2.plot = ena.plot.network(g2.plot, network = g2.mean.lw, colors = group2.color)
    sub.plot = ena.plot.network(sub.plot, network = sub)
  }

  if(points == TRUE) {
    g1.points.for.plot = as.matrix(set$points)[group1.rows,,drop=FALSE]
    g2.points.for.plot = as.matrix(set$points)[group2.rows,,drop=FALSE]

    g1.plot = ena.plot.points(enaplot = g1.plot, points = g1.points.for.plot, colors = group1.color)
    g2.plot = ena.plot.points(enaplot = g2.plot, points = g2.points.for.plot, colors = group2.color)
    sub.plot = ena.plot.points(enaplot = sub.plot, points = g1.points.for.plot, colors = group1.color)
    sub.plot = ena.plot.points(enaplot = sub.plot, points = g2.points.for.plot, colors = group2.color)
  }

  if(mean == TRUE) {
    g1.points.for.plot = as.matrix(set$points)[group1.rows,,drop=FALSE]
    g2.points.for.plot = as.matrix(set$points)[group2.rows,,drop=FALSE]

    g1.plot = ena.plot.group(g1.plot, g1.points.for.plot, colors = group1.color, labels = group1, confidence.interval = confidence.interval)
    g2.plot = ena.plot.group(g2.plot, g2.points.for.plot, colors = group2.color, labels = group2, confidence.interval = confidence.interval)
    sub.plot = ena.plot.group(sub.plot, g1.points.for.plot, colors = group1.color, labels = group1, confidence.interval = confidence.interval)
    sub.plot = ena.plot.group(sub.plot, g2.points.for.plot, colors = group2.color, labels = group2, confidence.interval = confidence.interval)
  }

  else if(TRUE %in% c(network,points, mean) == FALSE) {
    stop("You must set at least one of points, mean, or network to TRUE to obtain a plot.")
  }

  set$plots[[group1]] = g1.plot
  set$plots[[group2]] = g2.plot
  set$plots[[paste0(group1,"-",group2)]] = sub.plot

  return(set)
}

#####
#' @title Wrapper to generate, and optionally plot, an ENA model
#'
#' @description Convenience entry point for constructing an ENA model from a
#' coded data frame. Handles accumulation, dimensional reduction, and optional
#' plot generation in a single call, returning an \code{ena.set} object that
#' contains unit positions, network weights, node positions, and plots.
#'
#' @details
#' \code{ena()} runs three phases internally:
#'
#' \strong{1. Accumulation} — co-occurrence counts are computed for each unit
#' across stanza windows defined by \code{window}, \code{window.size.back}, and
#' \code{window.size.forward}.
#'
#' \strong{2. Dimensional reduction} — accumulated vectors are normed, centered,
#' and rotated into a low-dimensional ENA space. When \code{groupVar} and two
#' \code{groups} are supplied the rotation maximises separation between the group
#' means (means rotation); otherwise SVD is used.
#'
#' \strong{3. Plotting} — plots are built and stored on the returned set in
#' \code{set$plots}. Pass \code{include.plots = FALSE} to skip this phase
#' entirely, which is useful for programmatic use (simulations, parameter
#' sweeps) where plot objects are not needed.
#'
#' \strong{Plot defaults:} \code{network = TRUE} but \code{points = FALSE} and
#' \code{mean = FALSE}. For a two-group comparison you almost always want
#' \code{mean = TRUE} as well, to show group centroids and confidence intervals
#' alongside the network.
#'
#' \strong{Accessing results:} the returned \code{ena.set} object contains:
#' \describe{
#'   \item{\code{$points}}{unit positions in the rotated ENA space (rows = units)}
#'   \item{\code{$line.weights}}{normed co-occurrence weights per unit (rows = units, cols = code pairs)}
#'   \item{\code{$node.positions}}{positions of each code node in the ENA space}
#'   \item{\code{$plots}}{named list of \code{ENAplot} objects; two-group models
#'     produce three plots keyed by \code{group1}, \code{group2}, and
#'     \code{"group1-group2"}}
#'   \item{\code{$tests}}{list of Wilcoxon and t-test results on dimensions 1
#'     and 2, populated when \code{runTest = TRUE}}
#'   \item{\code{$variance}}{proportion of variance explained by each dimension}
#' }
#'
#' @param data data.frame containing metadata and coded columns
#' @param codes vector, numeric or character, of column names or indices containing the codes to model
#' @param units vector, numeric or character, of column names that together uniquely identify each unit of analysis
#' @param conversation vector, numeric or character, of column names used to segment the data into conversations (stanza boundaries reset at each new conversation)
#' @param metadata vector, numeric or character, of column names to carry through as unit-level metadata (default: NULL)
#' @param model character, the ENA model to construct: \code{EndPoint} (default) produces a single adjacency vector per unit summing co-occurrences across all lines; \code{AccumulatedTrajectory} produces one adjacency vector per unit per conversation, where each successive conversation accumulates prior ones; \code{SeparateTrajectory} produces one adjacency vector per unit per conversation, each modeled independently
#' @param weight.by how to weight co-occurrences: \code{"binary"} (default) counts each co-occurrence once per stanza window; supply a function (e.g. \code{sum}) to use raw counts
#' @param window stanza window type: \code{"MovingStanzaWindow"} (default) or \code{"Conversation"} (all lines in a conversation form one window)
#' @param window.size.back integer, number of lines back from each line to include in the stanza window (default: 1)
#' @param window.size.forward integer, number of lines forward from each line to include in the stanza window (default: 0). Set to model bidirectional co-occurrence within a window.
#' @param include.meta logical, if TRUE (default) unit metadata is attached to the resulting ENAdata object and accessible via the set; set to FALSE to omit metadata from the model output
#' @param groupVar character, name of the column containing group labels. When supplied with two \code{groups}, the model uses a means rotation that maximises variance between group means.
#' @param groups vector, character, of exactly the group values from \code{groupVar} to use for means rotation, plotting, and statistical tests. If omitted, the first two unique values of \code{groupVar} are used with a warning.
#' @param runTest logical, if TRUE runs a Wilcoxon rank-sum test and a Student's t-test comparing the two groups on dimensions 1 and 2; results stored in \code{set$tests} (default: FALSE)
#' @param points logical, TRUE will plot individual unit points (default: FALSE)
#' @param mean logical, TRUE will plot group mean positions with confidence intervals — recommended whenever \code{groupVar} is supplied (default: FALSE)
#' @param network logical, TRUE will plot mean networks (default: TRUE)
#' @param networkMultiplier numeric, scaling factor applied to edge weights in non-subtracted network plots (default: 1)
#' @param subtractionMultiplier numeric, scaling factor applied to edge weights in the subtracted network plot (default: 1)
#' @param unit character, name of a single unit to plot in isolation; when supplied, all group plotting is skipped
#' @param colors vector, character, of colors for groups or points. For two-group models, supply two values (group1, group2); for single-group or no-group models, supply one value. Defaults to "blue"/"red" for two groups and "black" otherwise.
#' @param confidence.interval character, style of confidence interval shown on mean points: "box" (default), "crosshairs", or "none"
#' @param include.plots logical, if TRUE (default) generates and attaches plot objects to the returned set; set to FALSE to skip all plotting for faster programmatic use
#' @param print.plots logical, if TRUE renders plots in the Viewer as they are created (default: FALSE)
#' @param ... Additional parameters passed to set creation and plotting functions, including \code{mask} (an optional binary matrix of size ncol(codes) x ncol(codes) where 0 suppresses co-occurrence modeling between a pair of codes; see \code{\link{ena.accumulate.data}})
#'
#' @examples
#' data(RS.data)
#'
#' codes = c('Data',
#'           'Technical.Constraints',
#'           'Performance.Parameters',
#'           'Client.and.Consultant.Requests',
#'           'Design.Reasoning',
#'           'Collaboration')
#'
#' # Minimal call: fit a model with no group comparison
#' rs = ena(
#'   data = RS.data,
#'   units = c("UserName", "Condition", "GroupName"),
#'   conversation = c("Condition", "GroupName"),
#'   codes = codes,
#'   window.size.back = 4
#' )
#'
#' # Two-group comparison with means rotation, centroids, and statistical tests
#' rs = ena(
#'   data = RS.data,
#'   units = c("UserName", "Condition", "GroupName"),
#'   conversation = c("Condition", "GroupName"),
#'   codes = codes,
#'   window.size.back = 4,
#'   groupVar = "Condition",
#'   groups = c("FirstGame", "SecondGame"),
#'   mean = TRUE,
#'   runTest = TRUE,
#'   print.plots = FALSE
#' )
#'
#' # Model fitting only, no plots (faster for programmatic use)
#' rs = ena(
#'   data = RS.data,
#'   units = c("UserName", "Condition", "GroupName"),
#'   conversation = c("Condition", "GroupName"),
#'   codes = codes,
#'   window.size.back = 4,
#'   include.plots = FALSE
#' )
#'
#' @return An \code{ena.set} object. See the Details section for a description
#'   of the key fields (\code{$points}, \code{$line.weights}, \code{$plots},
#'   \code{$tests}, etc.).
#' @export
#####
ena <- function(
  data,
  codes,
  units,
  conversation,
  metadata = NULL,
  model = c("EndPoint", "AccumulatedTrajectory", "SeparateTrajectory"),
  weight.by = "binary",
  window = c("MovingStanzaWindow", "Conversation"),
  window.size.back = 1,
  window.size.forward = 0,
  include.meta = TRUE,
  groupVar = NULL,
  groups = NULL,
  runTest = FALSE,
  points = FALSE,
  mean = FALSE,
  network = TRUE,
  networkMultiplier = 1,
  subtractionMultiplier = 1,
  unit = NULL,
  colors = NULL,
  confidence.interval = "box",
  include.plots = T,
  print.plots = F,
  ...
) {
  set <- ena.set.creator(
    data = data,
    codes = codes,
    units = units,
    conversation = conversation,
    metadata = metadata,
    model = model,
    weight.by = weight.by,
    window = window,
    window.size.back = window.size.back,
    window.size.forward = window.size.forward,
    include.meta = include.meta,
    groupVar = groupVar,
    groups = groups,
    runTest = runTest,
    ...
  )

  if (include.plots) {
    set <- ena.plotter(
      set = set,
      groupVar = groupVar,
      groups = groups,
      points = points,
      mean = mean,
      network = network,
      networkMultiplier = networkMultiplier,
      subtractionMultiplier = subtractionMultiplier,
      unit = unit,
      colors = colors,
      confidence.interval = confidence.interval,
      print.plots = print.plots,
      ...
    )
  }

  return(set)
}

#' Calculate the Peak Ground Diversity Window
#'
#' This function acts as a wrapper to identify the sliding window size that yields
#' the highest (peak) ground diversity/entropy for a given dataset.
#'
#' @param data A data.frame or data.table containing the conversation data.
#' @param codeNames A character vector of column names representing the binary codes.
#' @param conversation_cols A character vector of column names that define unique conversations.
#' @param max_window An integer specifying the maximum window size to evaluate. Default is 20.
#'
#' @return An integer representing the window size that maximizes ground entropy.
#' @export
#'
#' @examples
#' \dontrun{
#' peak_w <- ena.gd.window(data = my_data,
#'                         codeNames = c("CodeA", "CodeB"),
#'                         conversation_cols = "ConversationID",
#'                         max_window = 15)
#' }
ena.gd.window <- function(data, codeNames, conversation_cols, max_window = 20) {
  gd <- ena.ground.diversity(data, codeNames, conversation_cols, max_window)
  return(gd$peaks$peak_window)
}

#' Calculate Ground Diversity (Entropy) Curves and Peaks
#'
#' Evaluates the diversity of "ground types" (combinations of active codes)
#' across a series of sliding window sizes. It returns both the curves and the
#' peak window values.
#'
#' @param data A data.frame or data.table containing the conversation data.
#' @param codeNames A character vector of column names representing the binary codes.
#' @param conversation_cols A character vector of column names that define unique conversations.
#' @param max_window An integer specifying the maximum window size to evaluate. Default is 20.
#'
#' @return A list containing three elements:
#' \describe{
#'   \item{curves}{A data.table containing aggregated entropy curves across windows.}
#'   \item{peaks}{A data.table highlighting the window size(s) where entropy peaked.}
#'   \item{conversation_curves}{A data.table showing calculated entropy per individual conversation per window.}
#' }
#' @export
#'
#' @examples
#' \dontrun{
#' gd_results <- ena.ground.diversity(data = my_data,
#'                                    codeNames = c("CodeA", "CodeB"),
#'                                    conversation_cols = "ConversationID")
#' }
ena.ground.diversity <- function(data, codeNames, conversation_cols, max_window = 20) {
  num_codes <- length(codeNames)

  counts <- ground.type.counts(
    data = data,
    codeNames = codeNames,
    conversation_cols = conversation_cols,
    max_window = max_window
  )

  ground.entropy.curves(
    counts = counts,
    conversation_cols = conversation_cols,
    num_codes = num_codes,
    methods = "mean",
    normalize = TRUE
  )
}

#' Calculate Entropy Curves from Ground Type Counts
#'
#' Internal helper function that takes ground type frequencies and computes Shannon entropy
#' across different aggregation methods (mean, weighted, or pooled) and window sizes.
#'
#' @param counts A data.table generated by \code{\link{ground.type.counts}}.
#' @param conversation_cols A character vector of column names defining unique conversations.
#' @param num_codes An integer representing the total number of unique codes (used for normalization base \eqn{2^C}).
#' @param group_cols A character vector of columns to group by (e.g., experimental conditions). Default is NULL.
#' @param methods A character vector specifying which aggregation methods to calculate. Options include "mean", "weighted", and "pooled". Default is all three.
#' @param normalize Logical; if TRUE (default), entropy is normalized to a \eqn{[0, 1]} scale.
#'
#' @return A list containing:
#' \describe{
#'   \item{curves}{Aggregated entropy metrics across windows and methods.}
#'   \item{peaks}{The optimal window size that maximized entropy for each method.}
#'   \item{conversation_curves}{Entropy calculations mapped back to individual conversations.}
#' }
#' @keywords internal
ground.entropy.curves <- function(
    counts,
    conversation_cols,
    num_codes,
    group_cols = NULL,
    methods = c("mean", "weighted", "pooled"),
    normalize = TRUE
) {
  dt <- as.data.table(counts)

  if (is.null(group_cols)) {
    dt[, .group := "all"]
    group_cols <- ".group"
  }

  log_base <- if (normalize) log(2^num_codes) else 1

  conv_entropy <- dt[
    ,
    {
      p <- count / sum(count)
      .(
        entropy = -sum(p * log(p)) / log_base,
        n_unique = .N,
        n_obs = unique(n_obs)
      )
    },
    by = c(conversation_cols, group_cols, "window")
  ]

  results <- list()

  # --- Mean ---
  if ("mean" %in% methods) {
    tmp <- conv_entropy[
      ,
      .(
        entropy = mean(entropy),
        n_unique = mean(n_unique),
        n_conversations = .N
      ),
      by = c(group_cols, "window")
    ]
    tmp[, method := "mean"]
    results[[length(results) + 1]] <- tmp
  }

  # --- Weighted ---
  if ("weighted" %in% methods) {
    tmp <- conv_entropy[
      ,
      .(
        entropy = weighted.mean(entropy, n_obs),
        n_unique = weighted.mean(n_unique, n_obs),
        n_conversations = .N
      ),
      by = c(group_cols, "window")
    ]
    tmp[, method := "weighted"]
    results[[length(results) + 1]] <- tmp
  }

  # --- Pooled ---
  if ("pooled" %in% methods) {
    tmp <- dt[
      ,
      .(count = sum(count)),
      by = c(group_cols, "window", "ground_type")
    ][
      ,
      {
        p <- count / sum(count)
        .(
          entropy = -sum(p * log(p)) / log_base,
          n_unique = .N
        )
      },
      by = c(group_cols, "window")
    ]
    tmp[, method := "pooled"]
    results[[length(results) + 1]] <- tmp
  }

  curves <- rbindlist(results, fill = TRUE)

  peaks <- curves[
    ,
    .SD[which.max(entropy)][1],
    by = c(group_cols, "method")
  ][
    ,
    .(
      peak_window = window,
      peak_entropy = entropy,
      method = method
    ),
    by = group_cols
  ]

  list(
    curves = curves,
    peaks = peaks,
    conversation_curves = conv_entropy
  )
}

#' Generate Binary-Encoded Ground Type Counts
#'
#' Compiles the frequencies of unique co-occurrence patterns ("ground types")
#' across multiple sliding window sizes, using fast column-wise rolling maximum operations.
#'
#' @param data A data.frame or data.table.
#' @param codeNames A character vector of column names representing the binary codes.
#' @param conversation_cols A character vector of column names that define unique conversations.
#' @param max_window An integer specifying the maximum window size to evaluate. Default is 20.
#'
#' @return A data.table containing the counts of ground types per conversation per window size.
#' @keywords internal
ground.type.counts <- function(
    data,
    codeNames,
    conversation_cols,
    max_window = 20
) {
  stopifnot(all(codeNames %in% names(data)))
  stopifnot(all(conversation_cols %in% names(data)))

  dt <- data.table::as.data.table(data)

  # Ground-type encoding assumes each code is a binary presence/absence flag;
  # non-binary values would corrupt the bit-weighted `ground_type` id.
  code_vals <- unique(as.vector(as.matrix(dt[, ..codeNames])))
  if (!all(code_vals %in% c(0, 1))) {
    stop("All codeNames columns must be binary (0/1); found non-binary values.")
  }
  bit_weights <- 2^(seq_along(codeNames) - 1)

  out <- list()

  for (w in seq_len(max_window)) {
    temp_dt <- dt[, c(..conversation_cols, ..codeNames)]

    # The rolling max of a binary code column is simply "is any code active in
    # the window", i.e. frollsum(col, w) > 0. frollsum runs in C, whereas
    # frollapply(col, w, max) invokes an R closure at every window position, so
    # this is ~2 orders of magnitude faster for the same result.
    temp_dt[, (codeNames) := lapply(.SD, function(col) {
      rolled <- as.numeric(data.table::frollsum(col, w, align = "right") > 0)
      na_indices <- which(is.na(rolled))
      if (length(na_indices) > 0) {
        rolled[na_indices] <- cummax(col[na_indices])
      }
      return(rolled)
    }), by = conversation_cols, .SDcols = codeNames]

    g_matrix <- as.matrix(temp_dt[, ..codeNames])
    temp_dt[, ground_type := as.vector(g_matrix %*% bit_weights)]

    counts <- temp_dt[
      ,
      .(count = .N),
      by = c(conversation_cols, "ground_type")
    ]

    counts[, window := w]
    counts[, n_obs := sum(count), by = conversation_cols]

    out[[w]] <- counts
  }

  data.table::rbindlist(out, use.names = TRUE)
}

##
# @title Accumulate Data from csv
#
# @description This function accumulates rows of data.
#
# @details [TBD]
#
#@export
#
# @param file The csv file location or data.frame for the function
# @param units.used Delimits columns based on the units (which specific units to use)
# @param units.by unit columns to accumulate by
# @param conversations.by Columns used in the conversation
# @param codes Columns used based on codes
# @param window.size.back Number of lines back to include window in stanza
# @param window.size.forward Number of lines forward in stanza window
# @param binary [TBD]
# @param model [TBD]
# @param window [TBD]
# @param weight.by [TBD]
# @param binary.stanzas [TBD]
# @param mask [TBD]
# @param ... additional parameters addressed in inner function
#
#
# @seealso \code{\link{ena.make.set}}
#
# @examples
# \dontrun{
# codeNames = c(
#   "E.data","S.data","E.design","S.design","S.professional","E.client",
#   "V.client","E.consultant","V.consultant","S.collaboration","I.engineer",
#   "I.intern","K.actuator","K.rom","K.materials","K.power"
# )
#
# df.file <- system.file("extdata", "rs.data.csv", package="rENA")
#
# # Given a csv file location
# ena.accumulate.data(
#   df.file, units.by = c("UserName","Condition"),
#   conversations.by = c("ActivityNumber","GroupName"),
#   codes = codeNames
# )
# }
# @return \code{\link{ENAdata}} class object with accumulated data
#
##
ena.accumulate.data.file <- function(
  file,
  units.used = NULL,
  conversations.used = NULL,
  units.by,
  conversations.by,
  codes = NULL,
  model = c("EndPoint",
            "AccumulatedTrajectory",
            "SeparateTrajectory"),
  window = c("Moving Stanza", "Conversation"),
  window.size.back = 1,
  window.size.forward = 0,
  weight.by = "binary",
  binary.stanzas = F,
  mask = NULL,
  include.meta = T,
  as.list = T,
  ...
) {
  if(is.null(file) ||
     is.null(units.by) ||
     is.null(conversations.by) || is.null(codes)
  ) {
    stop("Accumulation: file, units.by, conversations.by, and codes")
  }
  if (is.data.frame(file) && is.character(codes) && all(codes %in% colnames(file))) {
    check_code_values(as.data.frame(file)[, codes, drop = FALSE])
  }

  units <- NULL;
  model <- match.arg(model);
  window <- match.arg(window);

  if (identical(window, "Conversation")) {
    conversations.by = c(conversations.by, units.by);
    window.size.back = window;
  }
  data = ENAdata$new(
    file = file,
    units = units,
    units.used = units.used,
    units.by = units.by,
    conversations.by = conversations.by,
    codes = codes,
    window.size.back = window.size.back,
    window.size.forward = window.size.forward,
    weight.by = weight.by,
    model = model,
    mask = mask,
    include.meta = include.meta,
    ...
  );
  data$process();

  data$function.call = sys.call();
  # output = match.arg(output);
  # if(output == "json") {
  #   output.class = get(class(data))
  #
  #   if(is.null(output.fields)) {
  #     output.fields = names(output.class$public_fields)
  #   }
  #
  #   r6.to.json(data, o.class = output.class, o.fields = output.fields)
  # }
  #else

  if(as.list) {
    data = ena.set(data);
  } else {
    warning("Usage of R6 data objects is deprecated and may be removed entirely in a future version. Consider upgrading to the new data object.")
  }
  data
}

#' @title ENA Rotate by SVD (Principal Components)
#'
#' @description Performs a standard SVD (principal components) rotation on the
#'   ENA points. This is the rotation method used by default in Ordered Network
#'   Analysis (ONA). Unlike the generalized means rotation, no group labels are
#'   required.
#'
#' @param enaset An \code{\link{ENAset}} or compatible list with a
#'   \code{model$points.for.projection} matrix.
#' @param params A list of additional parameters (currently unused; kept for
#'   interface compatibility with other rotation functions).
#'
#' @return A list with:
#'   \describe{
#'     \item{rotation}{Rotation matrix (connection columns × dimensions),
#'       with columns named \code{SVD1}, \code{SVD2}, …}
#'     \item{codes}{Character vector of code names}
#'     \item{eigenvalues}{Variance explained per component}
#'     \item{node.positions}{NULL (not computed here)}
#'   }
#'
#' @export
ena.rotate.by.svd <- function(enaset, params = list()) {
  pts <- as.matrix(enaset$model$points.for.projection)

  pca <- prcomp(pts, retx = FALSE, scale. = FALSE, center = FALSE, tol = 0)

  colnames(pca$rotation) <- paste0("SVD", seq_len(ncol(pca$rotation)))

  list(
    rotation       = pca$rotation,
    codes          = enaset$rotation$codes,
    eigenvalues    = pca$sdev ^ 2,
    node.positions = NULL
  )
}

###
#' @title ENA Rotate by generalized means rotation (GMR)
#'
#' @description Computes a dimensional reduction from a matrix of ENA points
#'   such that the first dimension best represents the contribution of a target
#'   variable after controlling for covariates via Lasso. An optional second
#'   GMR axis can be computed for \code{y_var}; remaining dimensions are filled
#'   by SVD of the doubly-deflated space. Computed in C++ by libena's
#'   \code{generalized_means_rotation}.
#'
#' @param enaset An \code{\link{ENAset}} or compatible list with
#'   \code{model$points.for.projection} (or \code{points.normed.centered}),
#'   \code{line.weights}, and \code{rotation$codes}.
#' @param params A list with the following named elements:
#'   \describe{
#'     \item{\code{x_var}}{Required. A \code{data.frame} (or character vector of
#'       column names in \code{enaset$meta.data}) whose first column is the
#'       target variable. Additional columns are treated as covariates and
#'       penalized via Lasso.}
#'     \item{\code{y_var}}{Optional. Same format as \code{x_var}. When provided
#'       a second GMR axis is computed.}
#'     \item{\code{select_2_groups}}{Optional length-2 list/vector of group
#'       labels. When given, the GMR fit for the x axis uses only rows whose
#'       target value is in these two groups. The group mean difference for x1
#'       (the secondary axis that keeps group means on the x-axis) is always
#'       computed from the full data.}
#'     \item{\code{interactions}}{Logical; if \code{TRUE} (default) pairwise
#'       interaction terms are added to the model matrix when covariates are
#'       present. Set \code{FALSE} for main-effects-only Lasso.}
#'   }
#'
#' @importFrom stats model.matrix as.formula
#' @export
#' @return A list with \code{rotation} (q x q matrix, column names GMR1,
#'   GMR2|SVD2, SVD3, …), \code{codes}, \code{eigenvalues}, and
#'   \code{node.positions = NULL}, suitable for use inside \code{rotate()}.
###
ena.rotate.by.generalized <- function(enaset, params) {

  ## ── Input validation ────────────────────────────────────────────────────────
  if (!is.list(params) || is.null(params$x_var)) {
    stop("params must be provided as a list() and provide `x_var`")
  }

  ## ── Resolve x_var → data.frame ──────────────────────────────────────────────
  if (!is.data.frame(params$x_var)) {
    if (all(params$x_var %in% colnames(enaset$meta.data))) {
      x <- enaset$meta.data[, params$x_var, with = FALSE]
    } else {
      stop(paste("x_var incorrect:", paste(params$x_var, collapse = ", ")))
    }
  } else {
    x <- params$x_var
  }

  ## ── ENA point matrix ────────────────────────────────────────────────────────
  V <- if (!is.null(enaset$points.normed.centered))
         as.matrix(enaset$points.normed.centered)
       else
         as.matrix(enaset$model$points.for.projection)

  ## ── Target variable & encoding ──────────────────────────────────────────────
  ## For categorical targets, encode as 0-based integer codes.
  ## When select_2_groups is provided, the two selected groups are encoded as
  ## 0 and 1 (required by the C++ x1 computation, which uses labels == 0/1).
  target_full   <- as.vector(x[[1]])
  x_categorical <- !is.numeric(target_full)

  if (x_categorical) {
    grp <- params$select_2_groups
    if (!is.null(grp) && length(grp) == 2) {
      all_levels <- c(grp[[1]], grp[[2]],
                      setdiff(unique(target_full), c(grp[[1]], grp[[2]])))
    } else {
      all_levels <- unique(target_full)
    }
    x_target_enc <- as.numeric(factor(target_full, levels = all_levels)) - 1.0
    x_n_groups   <- as.integer(length(all_levels))
  } else {
    x_target_enc <- as.numeric(target_full)
    x_n_groups   <- 0L
  }

  ## ── Row subset (select_2_groups → 0-based integer indices) ──────────────────
  if (!is.null(params$select_2_groups) && length(params$select_2_groups) == 2) {
    subset_rows <- which(target_full %in% params$select_2_groups)
    if (length(subset_rows) < 2L) {
      warning("select_2_groups produced < 2 matching rows; using all rows")
      x_subset <- integer(0)
    } else {
      x_subset <- as.integer(subset_rows - 1L)
    }
  } else {
    x_subset <- integer(0)
  }

  ## ── Model matrix for x ──────────────────────────────────────────────────────
  ## Interaction terms are included by default when covariates are present.
  interactions <- isTRUE(if (!is.null(params$interactions)) params$interactions else TRUE)
  fstr_x <- if (ncol(x) > 1L && interactions) "~ .^2" else "~ ."
  mm_x   <- model.matrix(as.formula(fstr_x), data = x)[, -1L, drop = FALSE]

  ## x1_cols (0-based): columns in mm_x that belong to the target variable
  ## (main-effect columns only; interaction columns stay penalized)
  x1_name  <- colnames(x)[1L]
  safe_x1  <- gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", x1_name)
  x1_regex <- paste0("^", safe_x1, "[^:]*$")
  x1_cols  <- as.integer(grep(x1_regex, colnames(mm_x)) - 1L)
  if (length(x1_cols) == 0L) x1_cols <- 0L  # guard: treat first col as target

  ## ── Y axis ──────────────────────────────────────────────────────────────────
  has_y <- !is.null(params$y_var)

  if (has_y) {
    if (!is.data.frame(params$y_var)) {
      if (all(params$y_var %in% colnames(enaset$meta.data))) {
        y <- enaset$meta.data[, params$y_var, with = FALSE]
      } else {
        stop("y_var must be a data.frame or a column name in enaset$meta.data")
      }
    } else {
      y <- params$y_var
    }
    y_target_raw  <- as.vector(y[[1]])
    y_categorical <- !is.numeric(y_target_raw)
    if (y_categorical) {
      y_levels     <- unique(y_target_raw)
      y_target_enc <- as.numeric(factor(y_target_raw, levels = y_levels)) - 1.0
      y_n_groups   <- as.integer(length(y_levels))
    } else {
      y_target_enc <- as.numeric(y_target_raw)
      y_n_groups   <- 0L
    }
    fstr_y  <- if (ncol(y) > 1L && interactions) "~ .^2" else "~ ."
    mm_y    <- model.matrix(as.formula(fstr_y), data = y)[, -1L, drop = FALSE]
    y1_name  <- colnames(y)[1L]
    safe_y1  <- gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", y1_name)
    y1_regex <- paste0("^", safe_y1, "[^:]*$")
    y1_cols  <- as.integer(grep(y1_regex, colnames(mm_y)) - 1L)
    if (length(y1_cols) == 0L) y1_cols <- 0L
  } else {
    ## Dummy y params — passed but ignored by the C++ when has_y = FALSE
    mm_y          <- matrix(0.0, nrow(V), 1L)
    y_target_enc  <- numeric(nrow(V))
    y1_cols       <- 0L
    y_categorical <- FALSE
    y_n_groups    <- 0L
  }

  ## ── Delegate to libena ──────────────────────────────────────────────────────
  result <- generalized_means_rotation(
    V              = V,
    x_model_matrix = mm_x,
    x_target       = x_target_enc,
    x1_cols        = x1_cols,
    x_categorical  = x_categorical,
    x_n_groups     = x_n_groups,
    x_subset       = x_subset,
    has_y          = has_y,
    y_model_matrix = mm_y,
    y_target       = y_target_enc,
    y1_cols        = y1_cols,
    y_categorical  = y_categorical,
    y_n_groups     = y_n_groups
  )

  ## ── Assemble rotation matrix ─────────────────────────────────────────────────
  rotation <- result$rotation
  colnames(rotation) <- result$column_names
  rownames(rotation) <- colnames(as.matrix(enaset$line.weights))

  list(
    node.positions = NULL,
    rotation       = rotation,
    codes          = enaset$rotation$codes,
    eigenvalues    = result$eigenvalues
  )
}

##
#' Cohen's d calculation
#'
#' @title Cohen's d
#'
#' @description Calculate Conhen's d
#'
#' @details [TBD]
#'
#' @param x [TBD]
#' @param y [TBD]
#'
#' @export
#' @return numeric Cohen's d calculation
fun_cohens.d <- function(x, y) {
  lx <- length(x)- 1
  ly <- length(y)- 1
  md  <- abs(mean(x) - mean(y))        ## mean difference (numerator)
  csd <- lx * var(x) + ly * var(y)
  csd <- csd/(lx + ly)
  csd <- sqrt(csd)                     ## common sd computation

  cd  <- md/csd
  return(cd)## cohen's d
}

###
#' Calculate the correlations
#'
#' @description Calculate both Spearman and Pearson correlations for the
#' provided ENAset
#'
#' @param enaset ENAset to view methods of
#' @param tool c("rENA","webENA")
#' @param tool.version as.character(packageVersion(tool))
#' @param comparison character string representing the comparison used, c(NULL, "parametric", "non-parametric"). Default NULL
#' @param comparison.groups Groups that were used for the comparison
#' @param sig.dig Integer for the number of digits to round to
#' @param output_dir Where to save the output file when \code{type = "file"}.
#'   Default \code{tempdir()}; pass a directory to keep the report.
#' @param type c("file","stream") File will save to a file in output_dir, Stream returns the contents directly
#' @param theory Logical indicating whether to include theory in the writeup
#' @param methods Logical indicating whether to include methods in the writeup
#' @param params additional parameters for rmarkdown::render
#' @param output_file character
#' @param output_format character
#'
#' @export
#'
#' @return For \code{type = "file"}, the path of the rendered file; for
#'   \code{type = "stream"}, a string with the methods text.
ena.writeup <- function(
  enaset,
  tool = "rENA", tool.version = as.character(packageVersion(tool)),
  comparison = NULL, comparison.groups = NULL, sig.dig = 2,
  output_dir = tempdir(), type = c("file","stream"), theory = T, methods = T,
  params = NULL, output_file = NULL, output_format = NULL
) {
  require_writeup_packages()

  if(is.null(enaset$`_function.params`$weight.by))
    enaset$`_function.params`$weight.by <- enaset$`_function.params`$args$weight.by

  type = match.arg(type, choices = c("file","stream"), several.ok = FALSE)

  if(type == "file") {
    output_format = "word_document"
  }

  # knitr runs and writes its intermediates in a scratch directory, never in
  # the working directory; a streamed report is rendered there too.
  work_dir <- tempfile("ena_writeup")
  dir.create(work_dir)
  on.exit(unlink(work_dir, recursive = TRUE), add = TRUE)
  if (type == "stream") output_dir <- work_dir

  file = rmarkdown::render(system.file("rmd","methods.rmd", package="rENA"), output_dir = output_dir,
                    knit_root_dir = work_dir, intermediates_dir = work_dir, quiet = TRUE,
                    params = params, output_file = output_file
                    ,output_format = output_format
                  )

  if(type == "file")
    file
  else if (type == "stream" && endsWith(file, ".plain"))
    readChar(file, file.info(file)$size)
}

require_writeup_packages <- function() {
  missing <- c("rmarkdown", "knitr")[!vapply(c("rmarkdown", "knitr"), requireNamespace,
                                             logical(1), quietly = TRUE)]
  if (length(missing) > 0)
    stop("ENA writeups need the ", paste(missing, collapse = " and "), " package(s): ",
         "install.packages(c(", paste0('"', missing, '"', collapse = ", "), "))", call. = FALSE)
}

#' @title methods_report
#' @description Methods report for rmarkdwon
#' @param toc [TBD]
#' @param toc_depth [TBD]
#' @param fig_width [TBD]
#' @param fig_height [TBD]
#' @param keep_md [TBD]
#' @param md_extensions [TBD]
#' @param pandoc_args [TBD]
#'
#' @export
methods_report <- function(toc = FALSE,
                          toc_depth = 3,
                          fig_width = 5,
                          fig_height = 4,
                          keep_md = FALSE,
                          md_extensions = NULL,
                          pandoc_args = NULL) {
  require_writeup_packages()

  # knitr options and hooks
  knitr <- rmarkdown::knitr_options(
    opts_chunk = list(dev = 'png',
                      dpi = 96,
                      fig.width = fig_width,
                      fig.height = fig_height)
  )

  # build pandoc args
  args <- c("--standalone")

  # table of contents
  args <- c(args, rmarkdown::pandoc_toc_args(toc, toc_depth))

  # pandoc args
  args <- c(args, pandoc_args)

  preserved_chunks <- character()

  # pre_processor <- function(metadata, input_file, runtime, knit_meta,
  #                           files_dir, output_dir) {
  #   preserved_chunks <<- extract_preserve_chunks(input_file, knitr::extract_raw_output)
  #   NULL
  # }

  # post_processor <- function(metadata, input_file, output_file, clean, verbose) {
  #   output_str <- readLines(output_file, encoding = 'UTF-8')
  #   output_res <- knitr::restore_raw_output(output_str, preserved_chunks)
  #   if (!identical(output_str, output_res))
  #     writeLines(enc2utf8(output_res), output_file, useBytes = TRUE)
  #   output_file
  # }

  # return output format
  rmarkdown::output_format(
    knitr = knitr,
    pandoc = rmarkdown::pandoc_options(to = "docx",
                            from = rmarkdown::from_rmarkdown(extensions = md_extensions),
                            args = args),
    keep_md = keep_md
    # ,pre_processor = pre_processor,
    # post_processor = post_processor
  )
}

#' @title methods_report_stream
#' @description Methods report for rmarkdwon
#' @param toc [TBD]
#' @param toc_depth [TBD]
#' @param fig_width [TBD]
#' @param fig_height [TBD]
#' @param keep_md [TBD]
#' @param md_extensions [TBD]
#' @param pandoc_args [TBD]
#'
#' @export
methods_report_stream <- function(toc = FALSE,
                          toc_depth = 3,
                          fig_width = 5,
                          fig_height = 4,
                          keep_md = FALSE,
                          md_extensions = NULL,
                          pandoc_args = NULL) {
  require_writeup_packages()

  # knitr options and hooks
  knitr <- rmarkdown::knitr_options(
    opts_chunk = list(dev = 'png',
                      dpi = 96,
                      fig.width = fig_width,
                      fig.height = fig_height)
  )

  # build pandoc args
  args <- c("--standalone")

  # table of contents
  args <- c(args, rmarkdown::pandoc_toc_args(toc, toc_depth))

  # pandoc args
  args <- c(args, pandoc_args)

  preserved_chunks <- character()

  # return output format
  rmarkdown::output_format(
    knitr = knitr,
    pandoc = rmarkdown::pandoc_options(to = "plain",
                            from = rmarkdown::from_rmarkdown(extensions = md_extensions),
                            args = args),
    keep_md = keep_md
  )
}

###
#' @title ENA Rotate by mean
#'
#' @description Computes a dimensional reduction from a matrix of points such
#'   that the first dimension of the projected space passes through the means of
#'   two groups in the original space. Subsequent dimensions are computed using
#'   SVD on the deflated data. Computed in C++ by libena's \code{means_rotation}.
#'
#' @param enaset An \code{\link{ENAset}} or compatible list with
#'   \code{model$points.for.projection}, \code{connection.counts$ENA_UNIT},
#'   \code{line.weights}, and \code{rotation$codes}.
#' @param groups A list containing one or more pairs; each pair is a length-2
#'   list \code{list(a, b)} where \code{a} and \code{b} are either logical
#'   vectors (length = number of units) or character vectors of unit IDs.
#' @param params Alias for \code{groups}; used when called from the pipe API.
#'
#' @export
#' @return A list with \code{rotation}, \code{codes}, \code{eigenvalues}, and
#'   \code{node.positions = NULL}, suitable for use inside \code{rotate()}.
###
ena.rotate.by.mean <- function(enaset, groups = NULL, params = groups) {
  if (is.null(groups) && !is.null(params)) {
    groups <- params
  } else {
    groups <- list(groups)[[1]]
    if (length(groups) < 1) stop("Unable to rotate without 2 groups.")
  }
  if (!is(groups[[1]], "list")) groups <- list(groups)

  # Extract the data matrix (as.matrix strips metadata columns for ena.matrix)
  data <- if (!is.null(enaset$points.normed.centered)) {
    as.matrix(enaset$points.normed.centered)
  } else {
    as.matrix(enaset$model$points.for.projection)
  }

  # Convert groups (logical or character) to 0-based integer index pairs
  # required by means_rotation (libena)
  ena_unit <- enaset$connection.counts$ENA_UNIT
  group_pairs <- lapply(groups, function(pair) {
    a <- pair[[1]]
    b <- pair[[2]]
    if (!is.logical(a)) a <- ena_unit %in% a
    if (!is.logical(b)) b <- ena_unit %in% b
    list(as.integer(which(a) - 1L), as.integer(which(b) - 1L))
  })

  result <- means_rotation(data, group_pairs)

  rotation <- result$rotation
  colnames(rotation) <- result$column_names
  rownames(rotation) <- colnames(as.matrix(enaset$line.weights))

  list(
    node.positions = NULL,
    rotation       = rotation,
    codes          = enaset$rotation$codes,
    eigenvalues    = result$eigenvalues
  )
}

##
#' @title Accumulate data from a data frame into a set of adjacency (co-occurrence) vectors
#'
#' @description This function initializes an ENAdata object, processing conversations from coded data to generate adjacency (co-occurrence) vectors
#'
#' @details ENAData objects are created using this function. This accumulation receives
#' separate data frames for units, codes, conversation, and optionally, metadata. It
#' iterates through the data to create an adjacency (co-occurrence) vector corresponding
#' to each unit - or in a trajectory model multiple adjacency (co-occurrence) vectors for
#' each unit.
#'
#' In the default MovingStanzaWindow model, co-occurrences between codes are
#' calculated for each line k in the data between line k and the window.size.back-1 previous
#' lines and window.size.forward-1 subsequent lines in the same conversation as line k.
#'
#' In the Conversation model, co-occurrences between codes are calculated across all lines in
#' each conversation. Adjacency (co-occurrence) vectors are constructed for each unit u by
#' summing the co-occurrences for the lines that correspond to u.
#'
#' Options for how the data is accumulated are endpoint, which produces one adjacency (co-occurrence)
#' vector for each until summing the co-occurrences for all lines, and two trajectory models:
#' AccumulatedTrajectory and SeparateTrajectory. Trajectory models produce an adjacency
#' (co-occurrence) model for each conversation for each unit. In a SeparateTrajectory model,
#' each conversation is modeled as a separate network. In an AccumulatedTrajectory model, the
#' adjacency (co-occurrence) vector for the current conversation includes the co-occurrences
#' from all previous conversations in the data.
#'
#' @export
#'
#' @param units A data frame where the columns are the properties by which units will be identified
#' @param conversation A data frame where the columns are the properties by which conversations will be identified
#' @param codes A data frame where the columns are the codes used to create adjacency (co-occurrence) vectors
#' @param metadata (optional) A data frame with additional columns of metadata to be associated with each unit in the data
#' @param model A character, choices: EndPoint (or E), AccumulatedTrajectory (or A), or SeparateTrajectory (or S); default: EndPoint. Determines the ENA model to be constructed
#' @param weight.by (optional) A function to apply to values after accumulation
#' @param mask (optional) A binary matrix of size ncol(codes) x ncol(codes). 0s in the mask matrix row i column j indicates that co-occurrence will not be modeled between code i and code j
#' @param window A character, choices are Conversation (or C), MovingStanzaWindow (MSW, MS); default MovingStanzaWindow. Determines how stanzas are constructed, which defines how co-occurrences are modeled
#' @param window.size.back A positive integer, Inf, or character (INF or Infinite), default: 1. Determines, for each line in the data frame, the number of previous lines in a conversation to include in the stanza window, which defines how co-occurrences are modeled
#' @param window.size.forward (optional) A positive integer, Inf, or character (INF or Infinite), default: 0. Determines, for each line in the data frame, the number of subsequent lines in a conversation to include in the stanza window, which defines how co-occurrences are modeled
#' @param ... additional parameters addressed in inner function
#' @param include.meta Locigal indicating if unit metadata should be attached to the resulting ENAdata object, default is TRUE
#' @param as.list R6 objects will be deprecated, but if this is TRUE, the original R6 object will be returned, otherwise a list with class `ena.set`
#'
#' @seealso \code{\link{ENAdata}}, \code{\link{ena.make.set}}
#'
#' @return \code{\link{ENAdata}} object with data [adjacency (co-occurrence) vectors] accumulated from the provided data frames.
#'
##
ena.accumulate.data <- function(
  units = NULL,
  conversation = NULL,
  codes = NULL,
  metadata = NULL,
  model = c("EndPoint", "AccumulatedTrajectory", "SeparateTrajectory"),
  weight.by = "binary",
  window = c("MovingStanzaWindow", "Conversation"),
  window.size.back = 1,
  window.size.forward = 0,
  mask = NULL,
  include.meta = T,
  as.list = T,
  ...
) {
  if (is.null(units) || is.null(conversation) || is.null(codes)) {
    stop("Accumulation requires: units, conversation, and codes");
  }
  if (nrow(units) != nrow(conversation) || nrow(conversation) != nrow(codes)) {
    stop("Data Frames do not have the same number of rows");
  }
  check_code_values(codes)

  df <- cbind(units, conversation);
  df <- cbind(df, codes);

  # A metadata table whose rows don't line up with the data used to be dropped
  # without a word.
  if (!is.null(metadata) && NROW(metadata) > 0) {
    if (NROW(metadata) != nrow(df))
      stop("metadata has ", NROW(metadata), " rows but the data has ", nrow(df))
  }
  metadata <- data.table::as.data.table(metadata)
  if (nrow(metadata) == nrow(df)) {
    df <- cbind(df, metadata);
  }

  model <- match.arg(model)
  window <- match.arg(window)

  units.by <- colnames(units);
  conversations.by <- colnames(conversation);
  if (identical(window, "Conversation")) {
    conversations.by <- c(conversations.by, units.by);
    window.size.back <- window;
  }
  else if (identical(window, "MovingStanzaWindow")) {
    if( grepl(pattern = "inf", x = window.size.back, ignore.case = T)) {
      window.size.back <- Inf
    }
    if( grepl(pattern = "inf", x = window.size.forward, ignore.case = T)) {
      window.size.forward <- Inf
    }
  }

  data <- ENAdata$new(
    file = df,
    units = units,
    units.by = units.by,
    conversations.by = conversations.by,
    codes = codes,
    window.size.back = window.size.back,
    window.size.forward = window.size.forward,
    weight.by = weight.by,
    model = model,
    mask = mask,
    include.meta = include.meta,
    ...
  );
  data$process()

  data$function.call <- sys.call()

  if(as.list) {
    data <- ena.set(data)
  } else {
    warning(paste0("Usage of R6 data objects is deprecated and may be removed ",
      "entirely in a future version. Consider upgrading to the new data ",
      "object."))
  }

  data
}

# Code columns must be complete and numeric (or logical). An NA in a code made
# the unit's whole connection count NA, which then became an all-zero network
# at the origin -- dropping the unit's valid connections without a warning.
check_code_values <- function(codes) {
  codes <- as.data.frame(codes)
  bad_type <- names(codes)[!vapply(codes, function(x) is.numeric(x) || is.logical(x), logical(1))]
  if (length(bad_type))
    stop("Code columns must be numeric or logical: ", paste(bad_type, collapse = ", "))
  has_na <- names(codes)[vapply(codes, anyNA, logical(1))]
  if (length(has_na))
    stop("Code columns contain missing values (NA): ", paste(has_na, collapse = ", "),
         ". Recode them (e.g. to 0) before accumulating.")
  invisible(TRUE)
}

#' Apply metadata and code transformations to a data.table
#'
#' This function applies metadata and code transformations to a data.table if provided.
#' It checks if the metadata and codes are supplied as vectors of column names.
#'
#' @param x A data.table. The data.table to be transformed.
#' @param metadata_cols A vector of column names or NULL. A vector specifying the columns for metadata transformations.
#' @param codes_cols A vector of column names or NULL. A vector specifying the columns for code transformations.
#' @param horizon_cols A vector of column names or NULL. A vector specifying the columns for horizon transformations.
#' @param units_cols A vector of column names or NULL. A vector specifying the columns for unit transformations.
#'
#' @return The modified data.table after applying the metadata and code transformations.
#' @examples
#' library(data.table)
#' dt <- data.table(a = 1:5, b = 6:10)
#' dt <- define(dt, metadata = c("a"), codes = c("b"))
#' @export
define <- function(
  x,
  metadata_cols = find_meta_cols(x),
  codes_cols = find_binary_cols(x),
  horizon_cols = NULL,
  units_cols = NULL
) {
  x <- as.qe.data(x);

  do_call <- function(y, wh) {
    args <- list(x = x);
    for(u in y) args[[length(args) + 1]] <- u
    x <<- do.call(wh, args);

    return(x);
  }

  if(!is.null(metadata_cols)) {
    if(
      (is.numeric(metadata_cols) || is.character(metadata_cols)) &&
      length(metadata_cols) > 0
    ) {
      x <- do_call(metadata_cols, metadata);
    }
    else {
      warning(WARNINGS$null_metadata);
    }
  }

  if(!is.null(codes_cols)) {
    if(
      (is.numeric(codes_cols) || is.character(codes_cols)) &&
      length(codes_cols) > 0
    ) {
      x <- do_call(codes_cols, codes);
    }
    else {
      warning(WARNINGS$null_codes);
    }
  }

  if(!is.null(units_cols)) {
    if(
      (is.numeric(units_cols) || is.character(units_cols)) &&
      length(units_cols) > 0
    ) {
      x <- do_call(units_cols, units);
    }
    else {
      warning(WARNINGS$null_units);
    }
  }

  if(!is.null(horizon_cols)) {
    if(
      (is.numeric(horizon_cols) || is.character(horizon_cols)) &&
      length(horizon_cols) > 0
    ) {
      x <- do_call(horizon_cols, horizon);
    }
    else {
      warning(WARNINGS$null_horizon);
    }
  }

  invisible(x);
}

#' Reclassify specified columns as codes or list codes columns in a data.table
#'
#' This function reclassifies specified columns of a data.table to the 'qe.code' format if column names are provided.
#' If no column names are provided, it returns the names of columns that are already classified as 'qe.code'.
#'
#' @param x A data.table. The data.table containing the columns to be reclassified or checked.
#' @param ... Additional arguments specifying the names of the columns to be reclassified.
#'
#' @return The modified data.table with specified columns reclassified as 'qe.code', or a character vector of column names already classified as 'qe.unit'.
#' @examples
#' library(data.table)
#' dt <- data.table(a = 1:5, b = 6:10)
#' # Reclassify columns 'a' and 'b' as 'qe.code'
#' dt <- codes(dt, "a", "b")
#' # List columns classified as 'qe.code'
#' code_columns <- codes(dt)
#' @export
codes <- function(x, ...) {
  x <- as.qe.data(x);

  if(...length() > 0) {
    dot_args <- list(...);

    # x <- reclassify(x, dot_args, as.qe.code);
    dot_args$x <- x;
    dot_args$v <- as.qe.code;
    x <- do.call(reclassify, dot_args);

    return(x);
  }
  else {
    return(colnames(x)[sapply(x, is.qe.code)]);
  }
}

#' Reclassify specified columns as metadata or list metadata columns in a data.table
#'
#' This function reclassifies specified columns of a data.table to the 'qe.metadata' format if column names are provided.
#' If no column names are provided, it returns the names of columns that are already classified as 'qe.metadata'.
#'
#' @param x A data.table. The data.table containing the columns to be reclassified or checked.
#' @param ... Additional arguments specifying the names of the columns to be reclassified.
#'
#' @return The modified data.table with specified columns reclassified as 'qe.metadata', or a character vector of column names already classified as 'qe.metadata'.
#' @examples
#' library(data.table)
#' dt <- data.table(a = 1:5, b = 6:10)
#' # Reclassify columns 'a' and 'b' as 'qe.metadata'
#' dt <- metadata(dt, "a", "b")
#' # List columns classified as 'qe.metadata'
#' metadata_columns <- metadata(dt)
#' @export
metadata <- function(x, ...) {
  x <- as.qe.data(x);

  if(...length() > 0) {
    dot_args <- list(...);

    dot_args$x <- x;
    dot_args$v <- as.qe.metadata;
    x <- do.call(reclassify, dot_args);

    return(x);
  }
  else {
    return(colnames(x)[sapply(x, is.qe.metadata)]);
  }
}

#' Reclassify specified columns as units or list unit columns in a data.table
#'
#' This function reclassifies specified columns of a data.table to the 'qe.unit' format if column names are provided.
#' If no column names are provided, it returns the names of columns that are already classified as 'qe.unit'.
#'
#' @param x A data.table. The data.table containing the columns to be reclassified or checked.
#' @param ... Additional arguments specifying the names of the columns to be reclassified.
#'
#' @return The modified data.table with specified columns reclassified as 'qe.unit', or a character vector of column names already classified as 'qe.unit'.
#' @examples
#' library(data.table)
#' dt <- data.table(a = 1:5, b = 6:10)
#' # Reclassify columns 'a' and 'b' as 'qe.unit'
#' dt <- units(dt, "a", "b")
#' # List columns classified as 'qe.unit'
#' unit_columns <- units(dt)
#' @export
units <- function(x, ...) {
  x <- as.qe.data(x);

  if(...length() > 0) {
    dot_args <- list(...);

    dot_args$x <- x;
    dot_args$v <- as.qe.unit;
    x <- do.call(reclassify, dot_args);
    return(x);
  }
  else {
    return(colnames(x)[sapply(x, is.qe.unit)]);
  }
}

#' Reclassify specified columns as horizon or list horizon columns in a data.table
#'
#' This function reclassifies specified columns of a data.table to the 'qe.horizon' format if column names are provided.
#' If no column names are provided, it returns the names of columns that are already classified as 'qe.horizon'.
#'
#' @param x A data.table. The data.table containing the columns to be reclassified or checked.
#' @param ... Additional arguments specifying the names of the columns to be reclassified.
#'
#' @return The modified data.table with specified columns reclassified as 'qe.horizon', or a character vector of column names already classified as 'qe.horizon'.
#' @examples
#' library(data.table)
#' dt <- data.table(a = 1:5, b = 6:10)
#' # Reclassify columns 'a' and 'b' as 'qe.horizon'
#' dt <- horizon(dt, "a", "b")
#' # List columns classified as 'qe.horizon'
#' horizon_columns <- horizon(dt)
#' @export
horizon <- function(x, ...) {
  x <- as.qe.data(x);

  if(...length() > 0) {
    dot_args <- list(...);

    dot_args$x <- x;
    dot_args$v <- as.qe.horizon;
    x <- do.call(reclassify, dot_args);

    return(x);
  }
  else {
    return(colnames(x)[sapply(x, is.qe.horizon)]);
  }
}

#' @export
'@.horizon' <- horizon

#' Reclassify specified columns in a data.table
#'
#' This function reclassifies specified columns of a data.table using a provided function.
#'
#' @param x A data.table. The data.table containing the columns to be reclassified.
#' @param ... Additional arguments specifying the names of the columns to be reclassified.
#' @param v A function. The function to apply to each specified column for reclassification.
#'
#' @return The modified data.table with specified columns reclassified.
#' @examples
#' library(data.table)
#' dt <- data.table(a = 1:5, b = 6:10)
#' dt <- reclassify(dt, as.qe.code, "a", "b")
#' @export
reclassify <- function(x, v, ...) {
  wh <- list(...);
  for (i in wh) {
    data.table::set(x, j = i, value = v(x[[i]]))
  }

  return(x);
}

##
#' @title Generate a plot of an ENAset
#'
#' @description Generates an a plot from a given ENA set object
#'
#' @details This function defines the axes and other features of a plot for displaying an ENAset; generates an ENAplot object that can used to plot points, network graphs, and other information from an ENAset
#'
#' @export
#'
#' @param enaset The \code{\link{ENAset}} that will be used to generate a plot
#' @param title A character used for the title of the plot, default: ENA Plot
#' @param dimension.labels A character vector containing labels for the axes, default: c(X, Y)
#' @param font.size An integer determining the font size for graph labels, default: 10
#' @param font.color A character determining the color of label font, default: black
#' @param font.family A character determining the font type, choices: Arial, Courier New, Times New Roman, default: Arial
#' @param scale.to "network" (default), "points", or a list with x and y ranges. Network and points both scale to the c(-max, max) of the corresponding data.frame
#' @param backend \code{"plotly"} (default) or \code{"qeviz"}. Default:
#'   \code{getOption("rENA.plot.backend", "plotly")}. With \code{"qeviz"} the
#'   plot is drawn by the qeviz package (>= 0.5.0) and \code{$plot} is a qeviz
#'   htmlwidget; \code{scale.to} must be \code{"network"}, \code{"points"} or
#'   a number.
#' @param ... additional parameters addressed in inner function
#'
#'
#' @seealso \code{\link{ena.make.set}}, \code{\link{ena.plot.points}},
#'   \link{rENA-plot-backends}
#'
#' @examples
#' data(RS.data)
#'
#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
#'   'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
#'
#' accum = ena.accumulate.data(
#'   units = RS.data[,c("UserName","Condition")],
#'   conversation = RS.data[,c("Condition","GroupName")],
#'   metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post")],
#'   codes = RS.data[,codeNames],
#'   window.size.back = 4
#' )
#'
#' set = ena.make.set(
#'   enadata = accum
#' )
#'
#' plot = ena.plot(set)
#'
#' group1.points = set$points.rotated[set$enadata$units$Condition == "FirstGame",]
#' plot = ena.plot.points(plot, points = group1.points);
#' print(plot);
#'
#' @return \code{\link{ENAplot}} used for plotting an ENAset

##
ena.plot <- function(
  enaset,

  title = "ENA Plot",

  dimension.labels = c("",""),

  font.size = 10,
  font.color = "#000000",
  font.family = c("Arial", "Courier New", "Times New Roman"),
  scale.to = "network", #, "points"),
  backend = getOption("rENA.plot.backend", "plotly"),
  ...
) {
  if (is(enaset, "ENAset")) {
    warning(paste0("Usage of ENAset objects will be deprecated ",
      "and potentially removed altogether in future versions."))

    enaset <- ena.set(enaset);
  }

  font.family = match.arg(font.family);

  plot = ENAplot$new(enaset,
                     title,
                     dimension.labels,
                     font.size,
                     font.color,
                     font.family,
                     scale.to = scale.to,
                     backend = backend,
                     ...
                   );

  return(plot);
}

### centering for projection

center.projection = function(lws, rotation) {
  if(is.null(rotation) || is.null(rotation$center.vec)) {
    stop("Supplied value for `rotation` does not have a center vector");
  }
  mean_ <- rotation$center.vec;

  centered.lws <- t(lws) - mean_;

  return( t(centered.lws) );
}

# og_lws = as.matrix(set.new$line.weights)
# set.new$rotation$center.vec = colMeans(og_lws)
#
#
#
# test = center.projection(lws = og_lws,set.new)
# centered_og = rENA:::center_data_c(as.matrix(set.new$line.weights))
# #
# View(test == centered_og)   ### DIFFERENCE IN ROUNDING
# View(round(test,3) == round(centered_og,3))

##
#' @title Names to Adjacency Key
#'
#' @description Convert a vector of strings, representing names of a square matrix, to an adjacency
#'
#' @details Returns a matrix of 2 rows by choose(length(vector), 2) columns,
#' or by \code{n * (n + 1) / 2} columns when \code{diagonal} is \code{TRUE}
#' (the self-connection layout: upper triangle with the diagonal, column-major,
#' e.g. A & A, A & B, B & B, A & C, B & C, C & C).
#'
#' @param vector Vector representing the names of a square matrix
#' @param upper_triangle Not Implemented
#' @param diagonal Logical, include the diagonal (self-connections). Default FALSE
#'
#' @export
##
namesToAdjacencyKey <- function(vector, upper_triangle = TRUE, diagonal = FALSE) {
  if (isTRUE(diagonal)) {
    n <- length(vector)
    j <- rep(seq_len(n), seq_len(n))
    i <- sequence(seq_len(n))
    return(matrix(vector[rbind(i, j)], nrow = 2))
  }
  upperTriIndices = triIndices(length(vector)) + 1;
  matrix(vector[upperTriIndices], nrow=2)
}

###
#' Calculate the correlations
#'
#' @description Calculate both Spearman and Pearson correlations for the
#' provided ENAset
#'
#' @param enaset ENAset to run correlations on
#' @param dims The dimensions to calculate the correlations for. Default: c(1,2)
#'
#' @return Matrix of 2 columns, one for each correlation method, with the corresponding
#' correlations per dimension as the rows.
#'
#' @export
###
ena.correlations <- function(enaset, dims = c(1:2)) {
  pComb = combn(nrow(enaset$points),2)
  point1 = pComb[1,]
  point2 = pComb[2,]

  points = as.matrix(enaset$points)
  centroids = as.matrix(enaset$model$centroids)
  svdDiff = matrix(points[point1, dims] - points[point2, dims], ncol=length(dims), nrow=length(point1))
  optDiff = matrix(centroids[point1, dims] - centroids[point2, dims], ncol=length(dims), nrow=length(point1))

  # svdDiff/optDiff were built with one column per requested dimension, so they
  # are indexed by position, not by the caller's dimension number. Indexing by
  # `dims` only happens to work for the default c(1,2); any other pair (e.g.
  # c(1,3)) reads past the end and errors with "subscript out of bounds".
  correlations = as.data.frame(mapply(function(method) {
    lapply(seq_along(dims), function(dim) {
      cor(as.numeric(svdDiff[,dim]), as.numeric(optDiff[,dim]), method=method)
    });
  }, c("pearson","spearman")))

  return(correlations);
}


#' Connection counts as square matrix
#'
#' @param x ena.set or ena.connections (i.e. set$connection.counts)
#'
#' @return matrix
#' @export
connection.matrix <- function(x) {
  if(is(x, "ena.set")) {
    connections <- x$connection.counts
  } else {
    connections <- x
  }
  if(!is(connections, "ena.connections")) {
    stop("Unable to find connections. `x` must be connections from an ena.set or an ena.set")
  }

  simplify <-  (nrow(connections) == 1)
  cm <- as.matrix(connections, square = T, simplify = simplify)
  if(simplify == FALSE && is.list(cm))
    names(cm) <- connections$ENA_UNIT

  return(cm);
}

.fit_etm_poly_curve <- function(
  points,
  degree = NULL,
  max_degree = 3L,
  criterion = c("loocv", "aic")
) {
  criterion <- match.arg(criterion)
  pts <- as.data.frame(points)

  if (ncol(pts) < 2L) {
    stop("ETM polynomial trajectory fitting requires at least two coordinate columns.")
  }

  tma::tma_fit_poly_curve(
    pts = data.frame(
      x = as.numeric(pts[[1L]]),
      y = as.numeric(pts[[2L]])
    ),
    x_col = "x",
    y_col = "y",
    degree = degree,
    max_degree = as.integer(max_degree),
    criterion = criterion,
    fit_curve_with_zero_pts = TRUE
  )
}

.eval_etm_poly_curve <- function(curve, n_eval) {
  t_eval <- seq(0, 1, length.out = as.integer(n_eval))
  data.frame(
    x = curve$pred_x(t_eval),
    y = curve$pred_y(t_eval)
  )
}

/** @file ccd.hpp
 *  @brief Cross-Covariance Decay (CCD) window-size estimation.
 *
 *  Estimates the ENA moving-window size from the "discourse coherence length":
 *  the half-life decay lag of the noise-corrected Frobenius norm of pooled
 *  conversation cross-covariance matrices.
 *
 *  Reference: Shaffer, D. W. & Cai, Z. (2026). Discourse Coherence Length:
 *  Noise-Corrected Covariance Estimation of Window-Size in Epistemic Network
 *  Analysis. International Conference on Quantitative Ethnography (ICQE26).
 *
 *  This kernel is pure-numeric: it consumes conversation subsets that have
 *  already been extracted from the raw data (one code matrix per conversation,
 *  rows in sequence).  Column selection and conversation splitting belong in
 *  each language wrapper (cf. accumulation.hpp), so that the C++ core never
 *  touches data-frame semantics.
 */
#ifndef LIBQE_CCD_HPP
#define LIBQE_CCD_HPP

#include <armadillo>
#include <cmath>
#include <vector>

namespace qe {

/** @brief Result of a CCD window-size estimation.
 *
 *  The `*` vectors are all length `max_window + 1`, indexed by lag `0..max_window`.
 *  Entries for lags with no contributing conversation are NaN (weight 0).
 */
struct CCDResult {
    int       window_size;            ///< Estimated half-life lag window size (>= 1).
    int       peak_lag;               ///< Lag of the peak corrected cross-covariance norm.
    arma::vec lag;                    ///< Evaluated lags, 0..max_window.
    arma::vec frob;                   ///< Uncorrected pooled Frobenius norm per lag.
    arma::vec frob_sq_unbiased;       ///< Noise-corrected squared Frobenius norm per lag.
    arma::vec frob_unbiased_signed;   ///< sign * sqrt(|corrected sq|) per lag.
    arma::vec total_weight;           ///< Pooled overlap weight per lag.
};

/** @brief Estimate the ENA moving-window size via cross-covariance decay.
 *
 *  For each lag @c l in @c 0..max_window, pools window-matched cross-covariance
 *  matrices across all conversation subsets, subtracts a trace-variance noise
 *  floor, and locates the first lag strictly after the peak where the corrected
 *  norm falls to half of its peak value.
 *
 *  @param[in] conversations One code matrix per conversation (N_k rows × C codes,
 *                           rows in sequence).  All matrices must share the same
 *                           number of columns.
 *  @param[in] max_window    Maximum lag to evaluate.  Default 20.
 *  @param[in] min_overlap   Minimum overlapping rows (N_k - l) required for a
 *                           conversation to contribute at lag l.  Default 10.
 *
 *  @returns A @ref CCDResult.  When no conversation contributes at any positive
 *           lag (all-NaN or non-positive corrected covariance), the window size
 *           defaults to 1 and @c peak_lag to 0.
 */
inline CCDResult ccd_window(
    const std::vector<arma::mat>& conversations,
    int max_window = 20,
    int min_overlap = 10
) {
    if (max_window < 0) max_window = 0;
    const int n_lags = max_window + 1;

    CCDResult out;
    out.lag                  = arma::regspace<arma::vec>(0, max_window);
    out.frob                 = arma::vec(n_lags).fill(arma::datum::nan);
    out.frob_sq_unbiased     = arma::vec(n_lags).fill(arma::datum::nan);
    out.frob_unbiased_signed = arma::vec(n_lags).fill(arma::datum::nan);
    out.total_weight         = arma::zeros<arma::vec>(n_lags);
    out.window_size          = 1;
    out.peak_lag             = 0;

    // Determine code count from the first non-empty conversation.
    arma::uword C = 0;
    for (const arma::mat& X : conversations) {
        if (X.n_cols > 0) { C = X.n_cols; break; }
    }
    if (C == 0) return out;  // nothing to work with -> window 1

    // 1. Cross-covariance curves & noise floor across lags.
    for (int i = 0; i < n_lags; ++i) {
        const int l = i;
        arma::mat Cov_sum = arma::zeros<arma::mat>(C, C);
        double total_weight = 0.0;
        double noise_floor_sq_weighted_sum = 0.0;

        for (const arma::mat& X_k : conversations) {
            const int N_k = static_cast<int>(X_k.n_rows);
            const int weight = N_k - l;
            if (weight < min_overlap) continue;

            // A = rows [l, N_k-1], B = rows [0, N_k-1-l]; both have `weight` rows.
            const arma::mat A = X_k.rows(l, N_k - 1);
            const arma::mat B = X_k.rows(0, N_k - 1 - l);

            const arma::rowvec p_A = arma::mean(A, 0);
            const arma::rowvec p_B = arma::mean(B, 0);

            // Window-matched cross-covariance: crossprod(B, A)/w - outer(p_B, p_A).
            const arma::mat Cov_k = (B.t() * A) / weight - p_B.t() * p_A;

            // Trace-variance noise floor (n-1 denominator, matching R's var()).
            const double tr_var_A =
                arma::accu(arma::square(A.each_row() - p_A)) / (weight - 1);
            const double tr_var_B =
                arma::accu(arma::square(B.each_row() - p_B)) / (weight - 1);
            const double var_k_sq = tr_var_A * tr_var_B;

            Cov_sum += weight * Cov_k;
            total_weight += weight;
            noise_floor_sq_weighted_sum += weight * var_k_sq;
        }

        if (total_weight > 0.0) {
            const arma::mat Cov_pooled = Cov_sum / total_weight;
            const double frob_sq_pooled = arma::accu(arma::square(Cov_pooled));
            const double noise_floor_sq_pooled =
                noise_floor_sq_weighted_sum / (total_weight * total_weight);
            const double frob_sq_unbiased_pooled =
                frob_sq_pooled - noise_floor_sq_pooled;

            const double sgn = (frob_sq_unbiased_pooled > 0.0) ? 1.0
                             : (frob_sq_unbiased_pooled < 0.0) ? -1.0 : 0.0;

            out.frob[i]                 = std::sqrt(frob_sq_pooled);
            out.frob_sq_unbiased[i]     = frob_sq_unbiased_pooled;
            out.frob_unbiased_signed[i] = sgn * std::sqrt(std::abs(frob_sq_unbiased_pooled));
            out.total_weight[i]         = total_weight;
        }
    }

    // 2. Half-life decay lag detection over the signed corrected norm.
    const arma::vec& f = out.frob_unbiased_signed;

    // Peak among lags > 0 with finite, positive corrected norm.
    int    peak_lag = -1;
    double max_f    = -arma::datum::inf;
    for (int i = 1; i < n_lags; ++i) {
        if (std::isfinite(f[i]) && f[i] > 0.0 && f[i] > max_f) {
            max_f    = f[i];
            peak_lag = i;   // lag == index
        }
    }

    if (peak_lag < 0) {
        // No positive corrected covariance anywhere -> default window 1.
        out.window_size = 1;
        out.peak_lag    = 0;
        return out;
    }
    out.peak_lag = peak_lag;

    // First lag at or after the peak whose corrected norm has decayed to <= 50%.
    // NaN comparisons are false, so NaN lags are skipped (matching R's which()).
    int decay_lag = -1;
    for (int i = peak_lag; i < n_lags; ++i) {
        if (f[i] / max_f <= 0.5) { decay_lag = i; break; }
    }

    if (decay_lag >= 0) {
        out.window_size = decay_lag;
    } else {
        // No decay below half-life within max_window: fall back to the last lag
        // (at or after the peak) with a finite corrected norm.
        int last_valid = -1;
        for (int i = peak_lag; i < n_lags; ++i) {
            if (std::isfinite(f[i])) last_valid = i;
        }
        out.window_size = (last_valid >= 0) ? last_valid : 1;
    }

    return out;
}

} // namespace qe

#endif // LIBQE_CCD_HPP

/**
 * @file generalized_rotation.hpp
 * @brief Generalized Means Rotation (GMR) with Lasso-based covariate adjustment.
 *
 * @details
 * Mirrors rENA's `ena.rotate.by.generalized()` + `gmr()` + `get_x1_main_effect()`.
 * Authoritative reference: commit 46776a1981a90b3a3b2861ed1010e9dbb7acf901
 * ("Fixed bugs in rotation functions") by Zhiqiang Cai.
 *
 * **Algorithm overview**
 *
 *  1. Compute x_vector: the rotation axis that best represents the target
 *     variable's contribution to the ENA point space, after controlling for
 *     covariates via Lasso (`lasso_x1_contribution`).
 *  2. Deflate V by x_vector → defA = V - V*x*x'.
 *  3. Optionally compute secondary axis x1: the normalised group-mean
 *     difference in the *original* V space (not defA) for groups 0 vs 1.
 *     x1 stays empty when the target is not categorical or there are not
 *     exactly 2 groups — there is no SVD fallback.
 *  4. Compute y_vector from a GMR call on defA, or from SVD of defA.
 *     Explicitly orthogonalise y_vector against x_vector, and against x1
 *     when x1 is available.
 *  5. Double-deflate V by x_vector and y_vector, then call `complete_rotation()`
 *     to fill remaining dimensions from the SVD of the doubly-deflated space.
 *
 * **Caller responsibilities**
 *
 *  - Build the model matrix (`X_raw`) from the data frame, including dummy
 *    variables for categorical predictors and any desired interaction terms.
 *    No formula parsing is done here.
 *  - Identify `x1_cols`: the 0-based column indices in `X_raw` that correspond to
 *    the target variable (these are unpenalized in the Lasso).
 *  - Encode categorical targets as 0-based integer codes in `x_target`.
 *  - Set `x_n_groups` to the number of distinct groups when `x_categorical=true`.
 *
 * The R wrapper (`rENA::ena.rotate.by.generalized`) handles these steps and
 * calls `libqe::generalized_means_rotation()` with the prepared matrices.
 */

#ifndef LIBQE_GENERALIZED_ROTATION_HPP
#define LIBQE_GENERALIZED_ROTATION_HPP

#include <libqe/linalg_fallback.hpp>  // qe::linalg::eig_sym (works w/o LAPACK)
#include <libqe/lasso.hpp>            // lasso_x1_contribution
#include "rotation.hpp"               // ena_svd, complete_rotation, RotationResult

#include <armadillo>
#include <stdexcept>
#include <string>
#include <vector>

namespace qe {

/// @name Between-group scatter
/// @{

/**
 * @brief Compute the between-group scatter matrix S_B.
 *
 * @details
 * Computes S_B = Σ_g  n_g * (μ_g − μ)(μ_g − μ)'  where μ is the grand mean.
 *
 * @note Mirrors rENA's `compute_SB()` (commit 46776a1981a90b3a3b2861ed1010e9dbb7acf901).
 *
 * @param[in] V        n×p matrix of ENA points (or covariate-adjusted contribution).
 * @param[in] labels   n×1 0-based integer group labels.
 * @param[in] n_groups Number of distinct groups.
 *
 * @returns p×p symmetric between-group scatter matrix.
 */
inline arma::mat between_group_scatter(
    const arma::mat&  V,
    const arma::uvec& labels,
    arma::uword       n_groups
) {
    const arma::uword p = V.n_cols;
    arma::rowvec mu = arma::mean(V, 0);
    arma::mat SB(p, p, arma::fill::zeros);

    for (arma::uword g = 0; g < n_groups; ++g) {
        arma::uvec idx = arma::find(labels == g);
        if (idx.is_empty()) continue;
        arma::vec diff = (arma::mean(V.rows(idx), 0) - mu).t();
        SB += static_cast<double>(idx.n_elem) * diff * diff.t();
    }
    return SB;
}

/// @}

/// @name Rotation direction
/// @{

/**
 * @brief Compute the unit rotation direction from a covariate-adjusted contribution matrix.
 *
 * @details
 * **Numeric target:**
 * Centres the target, then computes β = (t_c' t_c)^{-1} t_c' Vx (OLS slope from
 * lm(Vx ~ target)). Mirrors R: `model = lm(Vx ~ target); beta = coefficients[2,]`.
 *
 * **Categorical target:**
 * Computes the between-group scatter matrix S_B and returns its leading
 * eigenvector (the direction of maximum between-group variance).
 * Mirrors R: `sb = compute_SB(Vx, target); r = svd(sb)$v[,1]`.
 *
 * @note Mirrors rENA's `gmr()` direction computation
 *       (commit 46776a1981a90b3a3b2861ed1010e9dbb7acf901).
 *
 * @param[in] Vx          n×q covariate-adjusted contribution matrix.
 * @param[in] target      n×1 target variable (numeric float, or 0-based integer codes).
 * @param[in] categorical `true` if the target is categorical (uses between-group scatter);
 *                        `false` for a numeric target (uses OLS slope).
 * @param[in] n_groups    Number of distinct groups; only used when `categorical` is `true`.
 *
 * @returns Unit vector (p×1) representing the rotation direction.
 *
 * @throws std::runtime_error If `categorical` is `true` and `n_groups < 2`.
 * @throws std::runtime_error If the numeric target has zero variance after centering.
 * @warning Throws `std::runtime_error` if the resulting direction has zero norm,
 *          which can occur when the Lasso-adjusted contribution collapses to zero.
 */
inline arma::vec gmr_direction(
    const arma::mat& Vx,         // n×q covariate-adjusted contribution
    const arma::vec& target,     // n×1 (numeric float, or 0-based int codes)
    bool             categorical,
    arma::uword      n_groups = 0
) {
    arma::vec r;

    if (categorical) {
        if (n_groups < 2)
            throw std::runtime_error(
                "gmr_direction: x_n_groups must be >= 2 for categorical target");
        arma::uvec labels = arma::conv_to<arma::uvec>::from(target);
        arma::mat  SB     = between_group_scatter(Vx, labels, n_groups);

        arma::vec eigval; arma::mat eigvec;
        qe::linalg::eig_sym(eigval, eigvec, SB);  // ascending order
        r = eigvec.col(eigvec.n_cols - 1);         // largest eigenvalue → last col
    } else {
        // Centre target to get the OLS slope (mirrors R's lm() intercept handling)
        arma::vec tc   = target - arma::mean(target);
        double    tTt  = arma::dot(tc, tc);
        if (tTt < 1e-12)
            throw std::runtime_error(
                "gmr_direction: target has zero variance after centering");
        arma::rowvec beta = (tc.t() * Vx) / tTt;  // 1×q slope vector
        r = beta.t();
    }

    double norm = arma::norm(r);
    if (norm < 1e-12)
        throw std::runtime_error("gmr_direction: resulting direction has zero norm");
    return r / norm;
}

/// @}

/**
 * @brief Result of one GMR axis step.
 */
struct GMRStepResult {
    arma::vec direction;   ///< Unit vector in connection space (p×1).
};

/// @name GMR axis step
/// @{

/**
 * @brief Compute the rotation direction for one axis of the Generalized Means Rotation.
 *
 * @details
 * Applies optional row subsetting, performs Lasso-based covariate adjustment
 * (or a simple OLS projection when all columns are target columns), then
 * delegates to `gmr_direction()` to produce a unit direction vector.
 *
 * When `x1_cols.n_elem >= p` (all columns are target columns and there are no
 * penalized covariates), the function falls back to a simple OLS projection:
 * Vx = fitted values from lm(V ~ t).
 *
 * @note Mirrors rENA's `gmr()` step logic
 *       (commit 46776a1981a90b3a3b2861ed1010e9dbb7acf901).
 *
 * @param[in] V          n×q matrix of ENA points (full data; subset applied internally).
 * @param[in] X_model    n×p model matrix (caller-built; target cols + covariate cols).
 * @param[in] target     n×1 target variable (raw float or 0-based integer codes).
 * @param[in] x1_cols    0-based indices of target columns in `X_model` (unpenalized in Lasso).
 * @param[in] categorical `true` if the target is categorical.
 * @param[in] n_groups   Number of distinct groups (only used when `categorical` is `true`).
 * @param[in] subset     Optional 0-based row indices to use; empty means use all rows.
 * @param[in] n_lambda   Length of the Lasso lambda path (forwarded to `lasso_x1_contribution`).
 * @param[in] k_folds    Number of cross-validation folds (forwarded to `lasso_x1_contribution`).
 * @param[in] lasso_eps  lambda_min = lasso_eps * lambda_max (forwarded to `lasso_x1_contribution`).
 *
 * @returns `GMRStepResult` containing the unit direction vector.
 *
 * @throws std::runtime_error Propagated from `gmr_direction()` if the direction
 *         is degenerate or the target has zero variance.
 */
inline GMRStepResult gmr_step(
    const arma::mat&  V,
    const arma::mat&  X_model,
    const arma::vec&  target,
    const arma::uvec& x1_cols,
    bool              categorical,
    arma::uword       n_groups,
    const arma::uvec& subset,
    int               n_lambda  = 50,
    int               k_folds   = 5,
    double            lasso_eps = 0.01
) {
    const arma::uword n = V.n_rows;
    const arma::uword p = X_model.n_cols;

    // ── Select rows ──────────────────────────────────────────────────────────
    arma::uvec rows = subset.is_empty()
                    ? arma::regspace<arma::uvec>(0, n - 1)
                    : subset;

    const arma::mat V_sub  = V.rows(rows);
    const arma::mat X_sub  = X_model.rows(rows);
    const arma::vec t_sub  = target.rows(rows);

    // ── Lasso-adjusted contribution Vx ───────────────────────────────────────
    arma::mat Vx_sub;
    if (x1_cols.n_elem >= p) {
        // All columns are target columns (no penalized covariates):
        // fall back to simple OLS projection (Vx = fitted values from lm(V~t))
        arma::vec tc  = t_sub - arma::mean(t_sub);
        double    tTt = arma::dot(tc, tc);
        if (tTt > 1e-12) {
            arma::rowvec b1 = (tc.t() * V_sub) / tTt;
            Vx_sub = tc * b1;
        } else {
            Vx_sub.zeros(V_sub.n_rows, V_sub.n_cols);
        }
    } else {
        arma::vec pf(p, arma::fill::ones);
        for (arma::uword j : x1_cols) pf(j) = 0.0;

        Vx_sub = lasso_x1_contribution(
            X_sub, V_sub, x1_cols, pf, n_lambda, k_folds, lasso_eps);
    }

    // ── Rotation direction ───────────────────────────────────────────────────
    arma::vec direction = gmr_direction(Vx_sub, t_sub, categorical, n_groups);

    return {direction};
}

/// @}

/**
 * @brief Parameters for `generalized_means_rotation()`.
 *
 * @details
 * Groups all inputs needed to specify both the X and Y rotation axes, along
 * with Lasso tuning knobs. The Y axis is optional: when `has_y` is `false`
 * the second axis is taken from the leading SVD of the x-deflated space.
 */
struct GeneralizedRotationParams {
    /// @name X axis (required)
    /// @{
    arma::mat   x_model_matrix;           ///< n×p model matrix for the X axis.
    arma::vec   x_target;                 ///< n×1 target variable (raw float or 0-based integer codes).
    arma::uvec  x1_cols;                  ///< 0-based target column indices in `x_model_matrix`.
    bool        x_categorical = false;    ///< `true` if the X target is categorical.
    arma::uword x_n_groups    = 0;        ///< Number of distinct groups (used when `x_categorical` is `true`).
    arma::uvec  x_subset;                 ///< Optional row subset (0-based); empty means use all rows.
    /// @}

    /// @name Y axis (optional)
    /// @{
    /// When `has_y` is `false`, the Y axis is taken from the leading SVD of the x-deflated space.
    bool        has_y          = false;   ///< `true` if a Y-axis GMR target is provided.
    arma::mat   y_model_matrix;           ///< n×p model matrix for the Y axis.
    arma::vec   y_target;                 ///< n×1 target variable for the Y axis.
    arma::uvec  y1_cols;                  ///< 0-based target column indices in `y_model_matrix`.
    bool        y_categorical  = false;   ///< `true` if the Y target is categorical.
    arma::uword y_n_groups     = 0;       ///< Number of distinct groups for the Y axis.
    /// The Y axis always uses all rows (no subset parameter).
    /// @}

    /// @name Lasso tuning
    /// @{
    int    n_lambda  = 50;    ///< Length of the lambda path.
    int    k_folds   = 5;     ///< Number of cross-validation folds.
    double lasso_eps = 0.01;  ///< lambda_min = lasso_eps * lambda_max.
    /// @}
};

/// @name Generalized Means Rotation
/// @{

/**
 * @brief Full Generalized Means Rotation (GMR) producing a complete q×q rotation matrix.
 *
 * @details
 * C++/Armadillo implementation of `ena.rotate.by.generalized()`, matching the
 * authoritative R implementation in commit 46776a1981a90b3a3b2861ed1010e9dbb7acf901
 * by Zhiqiang Cai.
 *
 * **Steps performed:**
 *
 *  1. **X axis via GMR** — calls `gmr_step()` on V with the X-axis parameters.
 *  2. **Deflate V** — computes defA = V − V·x·x' for subsequent Y-axis work.
 *  3. **Secondary axis x1** — when the X target is categorical with ≥ 2 groups,
 *     computes x1 = normalize(mean(V[group0]) − mean(V[group1])) using the
 *     *original* V (not defA) and the full-length target (all n rows).
 *     x1 is used only to orthogonalise y_vector; it does not deflate defA.
 *     There is no SVD fallback: x1 stays empty if the condition is not met.
 *  4. **Y axis** — either GMR on defA (when `params.has_y` is `true`) or the
 *     leading SVD direction of defA.
 *  5. **Orthogonalise y_vector** — mirrors R:
 *     `y_vector <- y_vector - (t(y_vector) %*% x_vector) * x_vector`
 *     and, when x1 is available,
 *     `y_vector <- y_vector - (t(y_vector) %*% x1) * x1`,
 *     followed by safe normalisation.
 *  6. **Complete with SVD** — double-deflates V by both x_vector and y_vector,
 *     then calls `complete_rotation()` to fill remaining dimensions.
 *
 * @note Mirrors rENA's `ena.rotate.by.generalized()`
 *       (commit 46776a1981a90b3a3b2861ed1010e9dbb7acf901).
 *
 * @param[in] V       n×q matrix of ENA points (line weights; caller normalises/
 *                    centres upstream).
 * @param[in] params  Fully populated `GeneralizedRotationParams` struct.
 *
 * @returns `RotationResult` with:
 *   - `rotation`     q×q full rotation matrix (column j = axis j).
 *   - `eigenvalues`  q×1 variance per SVD-filled axis (named axes carry 0).
 *   - `column_names` "GMR1", "GMR2" or "SVD2", "SVD3", …, "SVD{q}".
 *
 * @throws std::runtime_error If `gmr_direction()` produces a degenerate direction
 *         for the X or Y axis.
 * @throws std::runtime_error If y_vector has zero norm after orthogonalisation
 *         (can happen when defA is rank-deficient or perfectly aligned with x_vector).
 */
inline RotationResult generalized_means_rotation(
    const arma::mat&                  V,
    const GeneralizedRotationParams&  params
) {
    // ── Step 1: X axis via GMR ────────────────────────────────────────────
    GMRStepResult x_gmr = gmr_step(
        V,
        params.x_model_matrix,
        params.x_target,
        params.x1_cols,
        params.x_categorical,
        params.x_n_groups,
        params.x_subset,
        params.n_lambda,
        params.k_folds,
        params.lasso_eps);

    const arma::vec x_vector = x_gmr.direction;

    // ── Step 2: Deflate V by x_vector ─────────────────────────────────────
    // defA is used only for y_vector computation; x1 uses original V.
    const arma::mat defA = V - V * x_vector * x_vector.t();

    // ── Step 3: Secondary axis x1 ─────────────────────────────────────────
    // Mirrors R: x1 = normalize(mean(V[group0]) - mean(V[group1])).
    //
    // Key points matching the authoritative R:
    //   - Uses original V (not defA)
    //   - Uses the full-length target (all n rows), not just the subset
    //   - Groups are always 0 (first) and 1 (second) in 0-based encoding
    //   - NO fallback: x1 stays empty when categorical/2-group condition fails
    //   - x1 does NOT deflate defA; it is only used to orthogonalise y_vector
    arma::vec x1;

    if (params.x_categorical && params.x_n_groups >= 2) {
        arma::uvec labels = arma::conv_to<arma::uvec>::from(params.x_target);
        arma::uvec g0 = arma::find(labels == 0);
        arma::uvec g1 = arma::find(labels == 1);

        if (!g0.is_empty() && !g1.is_empty()) {
            arma::rowvec m0 = arma::mean(V.rows(g0), 0);   // original V, not defA
            arma::rowvec m1 = arma::mean(V.rows(g1), 0);
            arma::vec diff  = (m0 - m1).t();
            double   dlen   = arma::norm(diff);
            if (dlen > 1e-10) x1 = diff / dlen;
        }
    }

    // ── Step 4: Y axis ────────────────────────────────────────────────────
    // GMR on defA (deflated by x_vector only), or SVD of defA.
    arma::vec y_vector;
    std::string y_name = "SVD2";

    if (params.has_y) {
        GMRStepResult y_gmr = gmr_step(
            defA,
            params.y_model_matrix,
            params.y_target,
            params.y1_cols,
            params.y_categorical,
            params.y_n_groups,
            {},          // no row subset for y axis
            params.n_lambda,
            params.k_folds,
            params.lasso_eps);
        y_vector = y_gmr.direction;
        y_name   = "GMR2";
    } else {
        RotationResult svd_r = ena_svd(defA);
        y_vector = svd_r.rotation.col(0);
    }

    // ── Step 5: Orthogonalise y_vector ────────────────────────────────────
    // Mirrors R (authoritative commit):
    //   y_vector <- y_vector - (t(y_vector) %*% x_vector) * x_vector
    //   if (!is.null(x1)) y_vector <- y_vector - (t(y_vector) %*% x1) * x1
    //   y_vector <- safe_normalize(y_vector)
    y_vector -= arma::dot(y_vector, x_vector) * x_vector;
    if (!x1.is_empty())
        y_vector -= arma::dot(y_vector, x1) * x1;

    double yn = arma::norm(y_vector);
    if (yn < 1e-12)
        throw std::runtime_error(
            "generalized_means_rotation: y_vector has zero norm after orthogonalization");
    y_vector /= yn;

    // ── Step 6: Combine and complete with SVD ─────────────────────────────
    // Double-deflate the original data (mirrors R):
    //   defA <- A - A %*% x %*% t(x) - A %*% y %*% t(y)
    // then pass to prcomp (equivalent: SVD of defA_final).
    arma::mat defA_final = V
        - V * x_vector * x_vector.t()
        - V * y_vector * y_vector.t();

    arma::mat named_axes = arma::join_rows(x_vector, y_vector);
    return complete_rotation(defA_final, named_axes, {"GMR1", y_name});
}

/// @}

}  // namespace qe
#endif  // LIBQE_GENERALIZED_ROTATION_HPP

/**
 * @file positions.hpp
 * @brief ENA node-position solvers for undirected and directed networks, the
 *        points-to-centroids correlation (ena_correlation), and the post-fit
 *        unit-circle node move with its centroid recomputation.
 *
 * Split out of the former libqe/modeling.hpp.
 */
#ifndef LIBENA_POSITIONS_HPP
#define LIBENA_POSITIONS_HPP

#include <armadillo>
#include <algorithm>
#include <cmath>
#include <stdexcept>
#include <string>
#include <vector>
#include <libqe/adjacency.hpp>        // qe::connection_indices (keys)
#include <libqe/linalg_fallback.hpp>  // qe::linalg::solve_spd
#include <libqe/stats.hpp>            // normal_quantile

namespace qe {

// ---------------------------------------------------------------------------
/// @name Return types
/// @{
// ---------------------------------------------------------------------------

/**
 * @brief Aggregated result returned by every node-position solver.
 *
 * All matrices share the same dimensional conventions:
 * rows index units (or nodes), columns index rotated dimensions.
 */
struct NodePositions {
    arma::mat nodes;      ///< Solved node locations, n_codes × n_dims.
    arma::mat centroids;  ///< Per-unit centroids projected onto the node space, n_units × n_dims.
    arma::mat weights;    ///< Normalised half-edge weight per unit per node, n_units × n_codes.
    arma::mat points;     ///< Input rotated points echoed back unchanged, n_units × n_dims.
};

/**
 * @brief Result of @ref move_nodes_to_unit_circle.
 *
 * Unit points are not part of it: the move never changes them.
 */
struct MovedNodes {
    arma::mat nodes;      ///< Moved node locations, n_codes × n_dims.
    arma::mat centroids;  ///< Centroids recomputed from the moved nodes, n_units × n_dims.
};

/// @}

// ---------------------------------------------------------------------------
/// @name Correlation
/// @{
// ---------------------------------------------------------------------------

/**
 * @brief Pearson correlation with Fisher-z confidence interval between ENA
 *        unit points and their centroids.
 *
 * All unique pairs of units are formed; for each pair the per-dimension
 * difference vectors are computed, then Pearson r is obtained between the
 * @p points differences and the @p centroids differences.  The confidence
 * interval is derived via Fisher's z-transform using the pure-C++
 * `normal_quantile` function so the function works outside R without
 * `Rcpp::qnorm`.
 *
 * @param[in] points      Rotated ENA unit points, n_units × n_dims.
 * @param[in] centroids   Corresponding centroid coordinates, n_units × n_dims.
 * @param[in] conf_level  Confidence level for the interval (default 0.95).
 * @returns An n_dims × 3 matrix whose columns are [r, ci_lower, ci_upper].
 *
 * @note Equivalent to `ena_correlation()` in rENA/ena.cpp.
 */
inline arma::mat ena_correlation(arma::mat points, arma::mat centroids,
                                  double conf_level = 0.95) {
    int n = points.n_rows;
    int n_pairs = (n * (n - 1)) / 2;

    arma::umat idx1(1, n_pairs), idx2(1, n_pairs);
    int col = 0;
    for (int i = 0; i < n; i++)
        for (int j = i + 1; j < n; j++) { idx1[col] = i; idx2[col] = j; col++; }

    arma::mat pts_diff = points.rows(idx1.row(0))    - points.rows(idx2.row(0));
    arma::mat cts_diff = centroids.rows(idx1.row(0)) - centroids.rows(idx2.row(0));
    arma::mat cr       = arma::cor(pts_diff, cts_diff);

    double qq = normal_quantile((1.0 + conf_level) / 2.0);
    arma::mat out(points.n_cols, 3);
    for (arma::uword i = 0; i < points.n_cols; i++) {
        double r     = cr(i, i);
        double z     = std::atanh(r);
        double sigma = 1.0 / std::sqrt(static_cast<double>(n_pairs) - 3.0);
        out(i, 0) = r;
        out(i, 1) = std::tanh(z - sigma * qq);
        out(i, 2) = std::tanh(z + sigma * qq);
    }
    return out;
}

/// @}

// ---------------------------------------------------------------------------
/// @name Node weights
/// @{
// ---------------------------------------------------------------------------

/**
 * @brief Per-unit node weights for undirected ENA.
 *
 * Half of each line weight goes to each of its two codes; each row is then
 * L1-normalised (a row whose L1 norm is below 0.0001 is divided by 0.0001, so
 * an all-zero row stays zero).  This is the weighting @ref node_positions
 * solves with, and the weighting its centroids use.
 *
 * @param[in] line_weights  Upper-triangular adjacency vectors stacked
 *                          row-wise (column order A & B, A & C, B & C, ...),
 *                          n_units × choose(n_codes, 2).
 * @returns n_units × n_codes weights.
 */
inline arma::mat node_weights(const arma::mat& line_weights) {
    int tri_size  = line_weights.n_cols;
    int num_nodes = static_cast<int>(
        std::pow(std::ceil(std::sqrt(static_cast<double>(2 * tri_size))), 2.0)
    ) - (2 * tri_size);
    int row_count = line_weights.n_rows;

    arma::mat weights(row_count, num_nodes, arma::fill::zeros);
    for (int k = 0; k < row_count; k++) {
        arma::rowvec curr = line_weights.row(k);
        int z = 0;
        for (int x = 0; x < num_nodes - 1; x++) {
            for (int y = 0; y <= x; y++) {
                weights(k, x + 1) += 0.5 * curr[z];
                weights(k, y)     += 0.5 * curr[z];
                z++;
            }
        }
    }
    for (int k = 0; k < row_count; k++) {
        double len = arma::accu(arma::abs(weights.row(k)));
        if (len < 0.0001) len = 0.0001;
        weights.row(k) /= len;
    }
    return weights;
}

/// Default @p self_weight of the directed node weights: a node's weight is
/// the sum of its column plus the sum of its row of the unit's adjacency
/// matrix (in + out), so a self-connection, in both, counts twice
/// (directedENA, Zhiqiang Cai, 2021-10-29).
constexpr double DIRECTED_SELF_WEIGHT = 2.0;

/**
 * @brief Per-unit node weights for directed (ordered) ENA.
 *
 * A node's weight is the sum of its column plus the sum of its row of the
 * unit's adjacency matrix: every directed connection's weight goes in full to
 * both of its codes, and a self-connection (the diagonal, ground i × response
 * i) goes to its code @p self_weight times -- twice by default, as it is in
 * both the node's row and its column.  Each row is then L1-normalised as in
 * @ref node_weights.  This is the weighting @ref directed_node_positions
 * solves with, and the weighting its centroids use.
 *
 * @param[in] line_weights  Directed adjacency vectors, n_units × (n_codes²).
 * @param[in] self_weight   Multiplier for a self-connection's contribution to
 *                          its code: 2 (default, row + column sum) or e.g. 1
 *                          (counted once). Must be finite and >= 0.
 * @returns n_units × n_codes weights.
 */
inline arma::mat directed_node_weights(const arma::mat& line_weights,
                                       double self_weight = DIRECTED_SELF_WEIGHT) {
    if (!std::isfinite(self_weight) || self_weight < 0)
        throw std::invalid_argument("directed_node_weights: self_weight must be finite and >= 0");
    int num_nodes = static_cast<int>(
        std::ceil(std::sqrt(static_cast<double>(line_weights.n_cols)))
    );
    int row_count = line_weights.n_rows;

    arma::mat nw(row_count, num_nodes, arma::fill::zeros);
    for (int k = 0; k < row_count; k++) {
        arma::mat curr = line_weights.row(k);
        int z = 0;
        for (int x = 0; x < num_nodes; x++)
            for (int y = 0; y < num_nodes; y++) {
                if (x != y) {
                    nw(k, x) += curr[z];
                    nw(k, y) += curr[z];
                } else {
                    nw(k, x) += self_weight * curr[z];
                }
                z++;
            }
    }
    for (int k = 0; k < row_count; k++) {
        double len = arma::accu(arma::abs(nw.row(k)));
        if (len < 0.0001) len = 0.0001;
        nw.row(k) /= len;
    }
    return nw;
}

/**
 * @brief Which two codes each connection column connects: the column map the
 *        layout-agnostic (@c _by_key) node weighting works from.
 *
 * Column @c k connects codes @c from[k] and @c to[k] (0-based).  A
 * self-connection has @c from[k] == to[k].  Direction is not used by the node
 * weights (every connection counts toward both of its codes), so any column
 * layout -- undirected, undirected with the diagonal, ordered -- is described
 * by its key alone.
 */
struct ConnectionKey {
    arma::uvec from;  ///< First code of each column (0-based).
    arma::uvec to;    ///< Second code of each column (0-based).
};

/**
 * @brief Key of the undirected layout: the column-major upper triangle (libqe
 *        @c connection_indices), with the diagonal (A & A, A & B, B & B, ...)
 *        when @p diagonal.
 */
inline ConnectionKey undirected_connection_key(int n_codes, bool diagonal = false) {
    arma::umat idx = connection_indices(n_codes, -1, diagonal);
    return ConnectionKey{ arma::uvec(idx.row(0).t()), arma::uvec(idx.row(1).t()) };
}

/**
 * @brief Key of the ordered (directed) layout: column @c j*n+i is ground i ->
 *        response j, so @c from = i and @c to = j.
 */
inline ConnectionKey directed_connection_key(int n_codes) {
    const arma::uword n = static_cast<arma::uword>(n_codes);
    ConnectionKey key{ arma::uvec(n * n), arma::uvec(n * n) };
    for (arma::uword j = 0; j < n; ++j)
        for (arma::uword i = 0; i < n; ++i) {
            key.from[j * n + i] = i;
            key.to[j * n + i]   = j;
        }
    return key;
}

/**
 * @brief Layout-agnostic node weights: every column counts toward each code it
 *        connects; a self-connection (from == to) toward its code
 *        @p self_weight times.  Each row is then L1-normalised (as
 *        @ref node_weights).
 *
 * One rule for every layout.  With the undirected key it equals
 * @ref node_weights; with the directed key, @ref directed_node_weights at the
 * same @p self_weight; with the undirected-with-diagonal key, the undirected
 * weighting plus self-connections that count as they do in ordered models.
 *
 * @param[in] line_weights  n_units × n_columns.
 * @param[in] key           Column map, @c n_columns long (see @ref ConnectionKey).
 * @param[in] n_codes       Number of codes (nodes).
 * @param[in] self_weight   Self-connection multiplier; default 2 (a node's row
 *                          plus column sum, as @ref directed_node_weights).
 * @returns n_units × n_codes weights.
 * @throws std::invalid_argument if the key's length does not match the
 *         columns, an index is out of range, or @p self_weight is negative or
 *         not finite.
 */
inline arma::mat node_weights_by_key(const arma::mat& line_weights,
                                     const ConnectionKey& key, int n_codes,
                                     double self_weight = DIRECTED_SELF_WEIGHT) {
    if (key.from.n_elem != line_weights.n_cols || key.to.n_elem != line_weights.n_cols)
        throw std::invalid_argument(
            "node_weights_by_key: the key has " + std::to_string(key.from.n_elem) +
            " columns; line_weights has " + std::to_string(line_weights.n_cols));
    if (n_codes < 1 || (key.from.n_elem && (key.from.max() >= static_cast<arma::uword>(n_codes) ||
                                            key.to.max()   >= static_cast<arma::uword>(n_codes))))
        throw std::invalid_argument("node_weights_by_key: key index out of range for n_codes");
    if (!std::isfinite(self_weight) || self_weight < 0)
        throw std::invalid_argument("node_weights_by_key: self_weight must be finite and >= 0");

    arma::mat w(line_weights.n_rows, n_codes, arma::fill::zeros);
    for (arma::uword k = 0; k < line_weights.n_cols; ++k) {
        const arma::uword a = key.from[k], b = key.to[k];
        if (a != b) {
            w.col(a) += line_weights.col(k);
            w.col(b) += line_weights.col(k);
        } else {
            w.col(a) += self_weight * line_weights.col(k);
        }
    }
    for (arma::uword u = 0; u < w.n_rows; ++u) {
        double len = arma::accu(arma::abs(w.row(u)));
        if (len < 0.0001) len = 0.0001;
        w.row(u) /= len;
    }
    return w;
}

/// @}

// ---------------------------------------------------------------------------
/// @name Node-position solvers
/// @{
// ---------------------------------------------------------------------------

/**
 * @brief Multiobjective least-squares node positions for undirected ENA.
 *
 * Half of each adjacency-vector entry (line weight) is distributed to each of
 * its two endpoint nodes, building a per-unit weight matrix
 * (@ref node_weights).  Each row is then L1-normalised.  An overdetermined
 * system is solved per dimension:
 * @code
 *   (W^T W) X = W^T T
 * @endcode
 * where W is the normalised weight matrix and T contains the rotated unit
 * points.
 *
 * @param[in] adj_mats  Upper-triangular adjacency vectors stacked row-wise,
 *                      n_units × tri_size.
 * @param[in] t         Rotated unit points, n_units × n_dims.
 * @param[in] num_dims  Number of dimensions to solve for.
 * @returns A @ref NodePositions struct containing `nodes`, `centroids`,
 *          `weights`, and `points`.
 *
 * @note Equivalent to `lws_lsq_positions()` in rENA/ena.cpp.
 */
inline NodePositions node_positions(arma::mat adj_mats, arma::mat t,
                                        int num_dims) {
    if (!adj_mats.is_finite() || !t.is_finite())
        throw std::invalid_argument("node_positions: input matrices must not contain NaN or Inf");
    arma::mat weights = node_weights(adj_mats);
    int num_nodes = weights.n_cols;

    arma::mat ssX(num_dims, num_nodes, arma::fill::zeros);
    arma::mat ssA = weights.t() * weights;
    for (int i = 0; i < num_dims; i++) {
        arma::mat ssb = weights.t() * t.col(i);
        ssX.row(i) = qe::linalg::solve_spd(ssA, ssb).t();
    }

    NodePositions r;
    r.nodes     = ssX.t();
    r.centroids = (ssX * weights.t()).t();
    r.weights   = weights;
    r.points    = t;
    return r;
}

/**
 * @brief Least-squares node positions for directed (ordered) ENA.
 *
 * Each row of @p line_weights is an n_nodes × n_nodes directed weight matrix
 * stored in row-major order.  The per-unit node weight for node x accumulates
 * the full row weight plus all column weights directed at x from other nodes.
 * Each row is L1-normalised before solving (@ref directed_node_weights).
 *
 * When @p combine_pairs is `false` (the standard directed case) the system:
 * @code
 *   (W^T W) X = W^T P
 * @endcode
 * is solved directly with W = normalised weight matrix and P = @p points.
 *
 * When @p combine_pairs is `true`, adjacent row pairs (ground row k and
 * response row k+1) are summed before solving:
 * @code
 *   W_combined[k/2] = W[k] + W[k+1]
 *   P_combined[k/2] = P[k] + P[k+1]
 * @endcode
 * The system is then solved on the combined matrices, but centroids are
 * projected back using the original (un-combined) weight matrix so that
 * every unit retains its own centroid.
 *
 * @param[in] line_weights  Directed adjacency vectors, n_units × (n_nodes²).
 * @param[in] points        Rotated unit points, n_units × n_dims.
 * @param[in] num_dims      Number of dimensions to solve for.
 * @param[in] combine_pairs If `true`, sum adjacent row pairs before solving
 *                          (ground + response model).  Default `false`.
 * @param[in] self_weight   Self-connection multiplier (see
 *                          @ref directed_node_weights).  Default 2.
 * @returns A @ref NodePositions struct containing `nodes`, `centroids`,
 *          `weights`, and `points`.
 *
 * @note Equivalent to `directed_node_positions()` in rENA/ena.cpp when
 *       @p combine_pairs is `false`.
 * @note Equivalent to `directed_node_positions_with_ground_response_added()`
 *       in rENA/ena.cpp when @p combine_pairs is `true`.
 *
 * @warning When @p combine_pairs is `true`, @p line_weights must have an even
 *          number of rows (row_count must be even); odd row counts result in
 *          an out-of-bounds access when forming the combined matrices.
 */
inline NodePositions directed_node_positions(arma::mat line_weights,
                                              arma::mat points, int num_dims,
                                              bool combine_pairs = false,
                                              double self_weight = DIRECTED_SELF_WEIGHT) {
    if (!line_weights.is_finite() || !points.is_finite())
        throw std::invalid_argument("directed_node_positions: input matrices must not contain NaN or Inf");
    arma::mat nw = directed_node_weights(line_weights, self_weight);
    int num_nodes = nw.n_cols;
    int row_count = line_weights.n_rows;

    if (combine_pairs) {
        // Combine paired rows (ground at k, response at k+1)
        arma::mat nw_added(row_count / 2, num_nodes, arma::fill::zeros);
        arma::mat pts_added(row_count / 2, num_dims, arma::fill::zeros);
        for (int k = 0; k < row_count; k += 2) {
            nw_added.row(k / 2)  = nw.row(k)     + nw.row(k + 1);
            pts_added.row(k / 2) = points.row(k) + points.row(k + 1);
        }

        arma::mat ssX(num_dims, num_nodes, arma::fill::zeros);
        arma::mat ssA = nw_added.t() * nw_added;
        for (int i = 0; i < num_dims; i++) {
            arma::mat ssb = nw_added.t() * pts_added.col(i);
            ssX.row(i) = qe::linalg::solve_spd(ssA, ssb).t();
        }

        NodePositions r;
        r.nodes     = ssX.t();
        r.centroids = (ssX * nw.t()).t();
        r.weights   = nw;
        r.points    = points;
        return r;
    }

    arma::mat ssX(num_dims, num_nodes, arma::fill::zeros);
    arma::mat ssA = nw.t() * nw;
    for (int i = 0; i < num_dims; i++) {
        arma::mat ssb = nw.t() * points.col(i);
        ssX.row(i) = qe::linalg::solve_spd(ssA, ssb).t();
    }

    NodePositions r;
    r.nodes     = ssX.t();
    r.centroids = (ssX * nw.t()).t();
    r.weights   = nw;
    r.points    = points;
    return r;
}

/**
 * @brief Layout-agnostic least-squares node positions: the solve of
 *        @ref node_positions / @ref directed_node_positions with
 *        @ref node_weights_by_key.
 *
 * @param[in] line_weights  n_units × n_columns, any layout.
 * @param[in] points        Rotated unit points, n_units × n_dims.
 * @param[in] num_dims      Number of dimensions to solve for.
 * @param[in] key           Column map (see @ref ConnectionKey).
 * @param[in] n_codes       Number of codes (nodes).
 * @param[in] self_weight   Self-connection multiplier.  Default 2.
 * @returns A @ref NodePositions struct.
 */
inline NodePositions node_positions_by_key(const arma::mat& line_weights,
                                           const arma::mat& points, int num_dims,
                                           const ConnectionKey& key, int n_codes,
                                           double self_weight = DIRECTED_SELF_WEIGHT) {
    if (!line_weights.is_finite() || !points.is_finite())
        throw std::invalid_argument("node_positions_by_key: input matrices must not contain NaN or Inf");
    arma::mat w = node_weights_by_key(line_weights, key, n_codes, self_weight);

    arma::mat ssX(num_dims, n_codes, arma::fill::zeros);
    arma::mat ssA = w.t() * w;
    for (int i = 0; i < num_dims; i++) {
        arma::mat ssb = w.t() * points.col(i);
        ssX.row(i) = qe::linalg::solve_spd(ssA, ssb).t();
    }

    NodePositions r;
    r.nodes     = ssX.t();
    r.centroids = (ssX * w.t()).t();
    r.weights   = w;
    r.points    = points;
    return r;
}

/// @}

// ---------------------------------------------------------------------------
/// @name Post-fit node moves
/// @{
// ---------------------------------------------------------------------------

/**
 * @brief How @ref unit_circle_nodes places the nodes on the circle.
 */
enum class UnitCircleMode {
    Equal,   ///< Equally spaced, 2π/n apart, the longest node fixed.
    Radial   ///< Each node pushed out along its own ray.
};

/**
 * @brief Parse a mode name for the bindings: "equal" or "radial".
 *
 * @throws std::invalid_argument for any other name.
 */
inline UnitCircleMode unit_circle_mode(const std::string& name) {
    if (name == "equal")  return UnitCircleMode::Equal;
    if (name == "radial") return UnitCircleMode::Radial;
    throw std::invalid_argument(
        "unit_circle_mode: mode must be \"equal\" or \"radial\", got \"" + name + "\"");
}

/**
 * @brief Move nodes onto a circle in the plane of two dimensions.
 *
 * The circle's radius is the length of the longest node in that plane.
 * Nodes of length zero there are left where they are, and every other
 * dimension is unchanged.
 *
 * - @ref UnitCircleMode::Radial: each node moves out along its own ray.
 * - @ref UnitCircleMode::Equal: the nodes keep their order around the
 *   origin and are spaced 2π/n apart, counter-clockwise, starting from the
 *   longest node, which stays where it is (the first one when lengths tie).
 *   The order is that of rENA's original R implementation: nodes with
 *   y >= 0 by decreasing x, then nodes with y < 0 by increasing x, ties in
 *   their original order.
 *
 * A post-fit transform for display; it does not refit anything.  Use
 * @ref node_centroids to recompute the centroids for the moved nodes.
 *
 * @param[in] nodes  Node positions, n_codes × n_dims.
 * @param[in] dim_x  0-based column of the plane's x axis.
 * @param[in] dim_y  0-based column of the plane's y axis.
 * @param[in] mode   Equal (default) or Radial.
 * @returns A copy of @p nodes with columns @p dim_x and @p dim_y moved.
 *
 * @throws std::invalid_argument if a dimension is out of range, the two are
 *         the same, or @p nodes contains NaN or Inf.
 *
 * @note Equivalent to rENA's move_nodes_to_unit_circle() (Radial) and
 *       move_nodes_to_unit_circle_with_equal_space() (Equal), up to their
 *       centroid step.
 */
inline arma::mat unit_circle_nodes(const arma::mat& nodes, arma::uword dim_x,
                                   arma::uword dim_y,
                                   UnitCircleMode mode = UnitCircleMode::Equal) {
    if (dim_x >= nodes.n_cols || dim_y >= nodes.n_cols)
        throw std::invalid_argument(
            "unit_circle_nodes: dimension index out of range (nodes have " +
            std::to_string(nodes.n_cols) + " columns)");
    if (dim_x == dim_y)
        throw std::invalid_argument("unit_circle_nodes: the two dimensions must differ");
    if (!nodes.is_finite())
        throw std::invalid_argument("unit_circle_nodes: nodes must not contain NaN or Inf");

    arma::mat out = nodes;
    const arma::uword n = nodes.n_rows;
    arma::vec x = nodes.col(dim_x);
    arma::vec y = nodes.col(dim_y);

    std::vector<double> len(n);
    std::vector<arma::uword> non_zero;
    double max_len = 0.0;
    for (arma::uword k = 0; k < n; ++k) {
        len[k] = std::sqrt(x[k] * x[k] + y[k] * y[k]);
        if (len[k] > max_len) max_len = len[k];
        if (len[k] != 0.0) non_zero.push_back(k);
    }
    if (non_zero.empty()) return out;

    if (mode == UnitCircleMode::Radial) {
        for (arma::uword k : non_zero) {
            double scale = max_len / len[k];
            out(k, dim_x) = x[k] * scale;
            out(k, dim_y) = y[k] * scale;
        }
        return out;
    }

    // Order around the origin: upper half-plane (y >= 0) by decreasing x,
    // then lower half-plane by increasing x; stable, as R's order().
    // Deliberate: this is the old R code's order, kept for parity (the
    // user's decision, 2026-10-16), not true angular order. The two differ
    // only when nodes of different lengths cross between x order and angle.
    std::vector<arma::uword> upper, lower;
    for (arma::uword k : non_zero) (y[k] >= 0.0 ? upper : lower).push_back(k);
    std::stable_sort(upper.begin(), upper.end(),
                     [&](arma::uword a, arma::uword b) { return x[a] > x[b]; });
    std::stable_sort(lower.begin(), lower.end(),
                     [&](arma::uword a, arma::uword b) { return x[a] < x[b]; });
    std::vector<arma::uword> sorted(upper);
    sorted.insert(sorted.end(), lower.begin(), lower.end());

    // The longest node (first in node order on a tie) stays put; the others
    // follow it around the circle.
    arma::uword fixed = non_zero.front();
    for (arma::uword k : non_zero)
        if (len[k] == max_len) { fixed = k; break; }
    const std::size_t m = sorted.size();
    const std::size_t first =
        std::find(sorted.begin(), sorted.end(), fixed) - sorted.begin();

    const double x1 = x[fixed], y1 = y[fixed];
    const double step = 2.0 * arma::datum::pi / static_cast<double>(m);
    for (std::size_t i = 0; i < m; ++i) {
        const arma::uword k = sorted[(first + i) % m];
        const double angle = static_cast<double>(i) * step;
        out(k, dim_x) = x1 * std::cos(angle) - y1 * std::sin(angle);
        out(k, dim_y) = x1 * std::sin(angle) + y1 * std::cos(angle);
    }
    return out;
}

/**
 * @brief Unit centroids for a set of node positions.
 *
 * The model's node weights (@ref node_weights, or @ref directed_node_weights
 * when @p directed) times @p nodes: the centroids @ref node_positions and
 * @ref directed_node_positions return, for any nodes.  Given a fit's own
 * nodes it reproduces the fit's centroids; given moved nodes, it gives the
 * centroids that match them.
 *
 * Line weights rather than raw connection counts: the two give the same
 * weights for the default (binary) weight model, since each unit's line
 * weights are its counts scaled, and the line weights are what the fit used
 * for any weight model.
 *
 * @param[in] line_weights  The model's line weights, n_units ×
 *                          choose(n_codes, 2), or n_units × n_codes² when
 *                          @p directed.
 * @param[in] nodes         Node positions, n_codes × n_dims.
 * @param[in] directed      Ordered (directed) networks.  Default `false`.
 * @param[in] self_weight   Directed self-connection multiplier (see
 *                          @ref directed_node_weights); use the fit's.  Default 2.
 * @returns n_units × n_dims centroids.
 *
 * @throws std::invalid_argument if the line weights' column count does not
 *         match the number of nodes, or either input contains NaN or Inf.
 */
inline arma::mat node_centroids(const arma::mat& line_weights,
                                const arma::mat& nodes, bool directed = false,
                                double self_weight = DIRECTED_SELF_WEIGHT) {
    const arma::uword n = nodes.n_rows;
    if (!directed && n < 2)
        throw std::invalid_argument("node_centroids: undirected networks need at least 2 codes");
    const arma::uword expected = directed ? n * n : n * (n - 1) / 2;
    if (line_weights.n_cols != expected)
        throw std::invalid_argument(
            "node_centroids: line_weights has " + std::to_string(line_weights.n_cols) +
            " columns; " + std::to_string(n) + " nodes need " + std::to_string(expected) +
            (directed ? " (n_codes², directed)" : " (choose(n_codes, 2), undirected)"));
    if (!line_weights.is_finite() || !nodes.is_finite())
        throw std::invalid_argument("node_centroids: input matrices must not contain NaN or Inf");

    const arma::mat weights = directed ? directed_node_weights(line_weights, self_weight)
                                       : node_weights(line_weights);
    return weights * nodes;
}

/**
 * @brief The post-fit unit-circle move of a model: moved nodes and their
 *        centroids.
 *
 * @ref unit_circle_nodes on the model's nodes, then @ref node_centroids for
 * the moved nodes.  Unit points are never changed, so a model keeps its
 * points and takes the returned nodes and centroids.
 *
 * @param[in] line_weights  The model's line weights (see @ref node_centroids).
 * @param[in] nodes         The model's node positions, n_codes × n_dims.
 * @param[in] dim_x         0-based column of the plane's x axis.
 * @param[in] dim_y         0-based column of the plane's y axis.
 * @param[in] mode          Equal (default) or Radial.
 * @param[in] directed      Ordered (directed) networks.  Default `false`.
 * @param[in] self_weight   Directed self-connection multiplier, the fit's.  Default 2.
 * @returns A @ref MovedNodes with the moved nodes and recomputed centroids.
 *
 * @throws std::invalid_argument as @ref unit_circle_nodes and
 *         @ref node_centroids.
 */
inline MovedNodes move_nodes_to_unit_circle(const arma::mat& line_weights,
                                            const arma::mat& nodes,
                                            arma::uword dim_x, arma::uword dim_y,
                                            UnitCircleMode mode = UnitCircleMode::Equal,
                                            bool directed = false,
                                            double self_weight = DIRECTED_SELF_WEIGHT) {
    MovedNodes r;
    r.nodes     = unit_circle_nodes(nodes, dim_x, dim_y, mode);
    r.centroids = node_centroids(line_weights, r.nodes, directed, self_weight);
    return r;
}

/**
 * @brief Layout-agnostic unit centroids: @ref node_weights_by_key times
 *        @p nodes (as @ref node_centroids).
 */
inline arma::mat node_centroids_by_key(const arma::mat& line_weights, const arma::mat& nodes,
                                       const ConnectionKey& key,
                                       double self_weight = DIRECTED_SELF_WEIGHT) {
    if (!line_weights.is_finite() || !nodes.is_finite())
        throw std::invalid_argument("node_centroids_by_key: input matrices must not contain NaN or Inf");
    return node_weights_by_key(line_weights, key, static_cast<int>(nodes.n_rows), self_weight) * nodes;
}

/**
 * @brief Layout-agnostic post-fit unit-circle move (as
 *        @ref move_nodes_to_unit_circle), centroids from
 *        @ref node_centroids_by_key.
 */
inline MovedNodes move_nodes_to_unit_circle_by_key(const arma::mat& line_weights,
                                                   const arma::mat& nodes,
                                                   arma::uword dim_x, arma::uword dim_y,
                                                   UnitCircleMode mode,
                                                   const ConnectionKey& key,
                                                   double self_weight = DIRECTED_SELF_WEIGHT) {
    MovedNodes r;
    r.nodes     = unit_circle_nodes(nodes, dim_x, dim_y, mode);
    r.centroids = node_centroids_by_key(line_weights, r.nodes, key, self_weight);
    return r;
}

/// @}

} // namespace qe

#endif // LIBENA_POSITIONS_HPP

/**
 * @file rotation.hpp
 * @brief Rotation routines for Epistemic Network Analysis (ENA):
 *        SVD, deflation, orthogonal-SVD, complete (generalized), and
 *        means rotation.  All routines are designed to match the
 *        numerical output of the reference R implementation in rENA.
 */

#ifndef LIBQE_ROTATION_HPP
#define LIBQE_ROTATION_HPP

#include <libqe/linalg_fallback.hpp>
#include <armadillo>
#include <stdexcept>
#include <string>
#include <utility>
#include <vector>

namespace qe {

/// @name Return types
/// @{

/**
 * @brief Aggregated result returned by every rotation routine.
 *
 * The layout mirrors the output of R's `prcomp()`: `rotation` holds the
 * right-singular vectors (principal axes), `eigenvalues` holds the
 * explained-variance values (sdev^2 in R parlance), and `column_names`
 * carries the human-readable axis labels used downstream for network plots
 * and loadings tables.
 */
struct RotationResult {
    arma::mat                rotation;      ///< p x p orthogonal matrix; column j is rotation axis j.
    arma::vec                eigenvalues;   ///< Length-p vector of sdev^2 values, matching rENA's convention.
    std::vector<std::string> column_names;  ///< Axis labels, e.g. "MR1", "SVD2", "GMR1".
};

/**
 * @brief A pair of 0-based row-index vectors identifying two groups within a
 *        points matrix.
 *
 * Used by means_rotation() to specify which rows belong to group A and which
 * belong to group B for each successive mean-difference axis.
 */
struct GroupPair {
    arma::uvec a;  ///< Row indices of group A (0-based).
    arma::uvec b;  ///< Row indices of group B (0-based).
};

/// @}

/// @name SVD rotation
/// @{

/**
 * @brief Compute a full SVD rotation of a (pre-centered) points matrix.
 *
 * Produces the right-singular vectors V as the rotation matrix and scales
 * each singular value to an eigenvalue (sdev^2) compatible with rENA's
 * `prcomp()` output.
 *
 * @param points  n x p data matrix.  The caller is responsible for
 *                centering upstream; this function applies no centering.
 *
 * @returns A RotationResult where:
 *   - `rotation`    = V  (p x p full SVD; trailing columns span the null
 *                         space when the matrix is rank-deficient).
 *   - `eigenvalues[j]` = s[j]^2 / max(1, n - 1)  (== sdev^2 in R).
 *   - `column_names`   = {"SVD1", "SVD2", ..., "SVDp"}.
 *
 * @note Equivalent to `prcomp(points, retx=FALSE, scale=FALSE,
 *       center=FALSE, tol=0)` in rENA/R.
 *
 * @note Sign convention: none.  Signs follow the underlying LAPACK SVD,
 *       matching rENA's long-standing behavior.  A deterministic sign rule
 *       (e.g. svd_flip) may be added later as an opt-in flag.
 */
inline RotationResult ena_svd(const arma::mat& points) {
    if (!points.is_finite())
        throw std::invalid_argument("ena_svd: input matrix must not contain NaN or Inf");
    arma::mat U, V;
    arma::vec s;
    qe::linalg::svd(U, s, V, points);

    const arma::uword p     = points.n_cols;
    const double      denom = points.n_rows > 1
                                  ? static_cast<double>(points.n_rows - 1)
                                  : 1.0;

    arma::vec eigenvalues(p, arma::fill::zeros);
    const arma::uword k = std::min<arma::uword>(s.n_elem, p);
    for (arma::uword j = 0; j < k; ++j) {
        eigenvalues(j) = (s(j) * s(j)) / denom;
    }

    std::vector<std::string> labels(p);
    for (arma::uword j = 0; j < p; ++j) {
        labels[j] = "SVD" + std::to_string(j + 1);
    }
    return {V, eigenvalues, std::move(labels)};
}

/// @}

/// @name Deflation
/// @{

/**
 * @brief Project a data matrix onto the hyperplane orthogonal to a given axis.
 *
 * Computes `data - (data * axis) * axis^T`, effectively removing the
 * component of every row of `data` that lies along `axis`.
 *
 * @param data  n x p data matrix.
 * @param axis  Unit-norm column vector of length p.  The caller is
 *              responsible for normalizing `axis` before calling this
 *              function; no normalization is performed internally.
 *
 * @returns n x p matrix with the projection onto `axis` subtracted out.
 */
inline arma::mat deflate(const arma::mat& data, const arma::vec& axis) {
    return data - (data * axis) * axis.t();
}

/// @}

/// @name Orthogonal SVD rotation
/// @{

/**
 * @brief Orthonormalize named axes via QR, then complete the rotation with
 *        an SVD of the data projected onto the orthogonal complement.
 *
 * The named axes in `weights` are orthonormalized via a full QR
 * decomposition.  The first k columns of the resulting Q become the
 * "fixed" part of the rotation; the remaining p - k columns define a
 * complementary subspace onto which `data` is projected, and a further SVD
 * fills those trailing rotation columns.
 *
 * @param data          n x p data matrix (caller-centered if required).
 * @param weights       p x k matrix of named axis directions.  Column norms
 *                      need not be 1; QR handles normalization internally.
 * @param named_labels  Length-k vector of labels for the first k rotation
 *                      axes.  Trailing axes receive labels "SVD{k+1}" ..
 *                      "SVDp".
 *
 * @returns A RotationResult containing the combined p x p rotation,
 *          eigenvalues for the SVD-filled trailing axes (indices k..p-1;
 *          the first k eigenvalues are zero), and axis labels.
 *
 * @note Equivalent to `orthogonal_svd()` in rENA/R/ena.rotate.by.mean.R:
 * @code
 *   Q     = qr.Q(qr(weights), complete = TRUE)   # p x p
 *   X_bar = data %*% Q[, (k+1):p]                # n x (p - k)
 *   V     = prcomp(X_bar)$rotation
 *   out   = cbind(Q[, 1:k], Q[, (k+1):p] %*% V)
 * @endcode
 *
 * @note The named axes in the OUTPUT are the orthonormalized Q columns, NOT
 *       the original `weights` columns.  Use complete_rotation() if you need
 *       to preserve input axes verbatim.
 *
 * @throws std::runtime_error if `data.n_cols != weights.n_rows` or
 *         `named_labels.size() != weights.n_cols`.
 */
inline RotationResult orthogonal_svd(
    const arma::mat&                data,
    const arma::mat&                weights,
    const std::vector<std::string>& named_labels) {
    const arma::uword p = weights.n_rows;
    const arma::uword k = weights.n_cols;
    if (data.n_cols != p) {
        throw std::runtime_error(
            "orthogonal_svd: data.n_cols must equal weights.n_rows");
    }
    if (named_labels.size() != k) {
        throw std::runtime_error(
            "orthogonal_svd: named_labels.size() must equal weights.n_cols");
    }
    if (k == 0) {
        return ena_svd(data);
    }

    arma::mat Q, R;
    qe::linalg::qr_full(Q, R, weights);                 // Q is p x p

    arma::mat rotation(p, p);
    arma::vec eigenvalues(p, arma::fill::zeros);
    rotation.cols(0, k - 1) = Q.cols(0, k - 1);

    if (k < p) {
        arma::mat Q_comp = Q.cols(k, p - 1);            // p x (p - k)
        arma::mat X_bar  = data * Q_comp;               // n x (p - k)
        RotationResult inner = ena_svd(X_bar);
        rotation.cols(k, p - 1) = Q_comp * inner.rotation;
        for (arma::uword j = 0; j < (p - k); ++j) {
            eigenvalues(k + j) = inner.eigenvalues(j);
        }
    }

    std::vector<std::string> labels(p);
    for (arma::uword j = 0; j < k; ++j) labels[j] = named_labels[j];
    for (arma::uword j = k; j < p; ++j) {
        labels[j] = "SVD" + std::to_string(j + 1);
    }
    return {rotation, eigenvalues, std::move(labels)};
}

/// @}

/// @name Complete (generalized) rotation
/// @{

/**
 * @brief Keep named axes verbatim and fill remaining axes from an SVD of the
 *        data after parallel deflation by all named axes.
 *
 * Unlike orthogonal_svd(), this routine preserves the caller-supplied
 * `named_axes` exactly (no QR re-orthonormalization).  The complementary
 * axes are obtained by deflating `data` simultaneously by all named axes and
 * then running ena_svd() on the result.
 *
 * The deflation is **parallel**: every projection is subtracted from the
 * original `data`, not from a progressively deflated copy:
 * @code
 *   defA = data - data * (named_axes * named_axes^T)
 * @endcode
 * This matches `defA <- A - A %*% v1 %*% t(v1) - A %*% v2 %*% t(v2)` in
 * rENA line-for-line.  For mutually orthogonal axes the result is identical
 * to sequential deflation; for non-orthogonal axes it differs.
 *
 * @param data          n x p data matrix.
 * @param named_axes    p x k matrix of named rotation axes.  Each column
 *                      must be unit-norm; orthonormality between columns is
 *                      NOT required.
 * @param named_labels  Length-k vector of labels for the first k axes.
 *                      Trailing axes receive labels "SVD{k+1}" .. "SVDp".
 *                      Conventional labels for generalized rotation are
 *                      "GMR1", "GMR2", then "SVD{k+1}" onward, but labels
 *                      are entirely caller-supplied.
 *
 * @returns A RotationResult where columns 0..k-1 of `rotation` equal
 *          `named_axes` verbatim and columns k..p-1 come from the SVD of
 *          the deflated data. Columns from the deflated data's null space
 *          (rank-deficient data) are orthogonalised against the named axes
 *          and each other, so the result is orthonormal whenever the named
 *          axes are.
 *
 * @note Equivalent to the tail of `ena.rotate.by.generalized` in rENA
 *       (canonical version: commit 2c079126 on rENA `origin/main`).
 *
 * @throws std::runtime_error if `data.n_cols != named_axes.n_rows` or
 *         `named_labels.size() != named_axes.n_cols`.
 */
inline RotationResult complete_rotation(
    const arma::mat&                data,
    const arma::mat&                named_axes,
    const std::vector<std::string>& named_labels) {
    const arma::uword p = named_axes.n_rows;
    const arma::uword k = named_axes.n_cols;
    if (data.n_cols != p) {
        throw std::runtime_error(
            "complete_rotation: data.n_cols must equal named_axes.n_rows");
    }
    if (named_labels.size() != k) {
        throw std::runtime_error(
            "complete_rotation: named_labels.size() must equal named_axes.n_cols");
    }
    if (k == 0) {
        return ena_svd(data);
    }

    arma::mat defA = data - data * named_axes * named_axes.t();
    RotationResult inner = ena_svd(defA);

    arma::mat rotation(p, p);
    arma::vec eigenvalues(p, arma::fill::zeros);
    rotation.cols(0, k - 1) = named_axes;
    if (k < p) {
        // The SVD columns with non-zero singular values are taken as they are
        // (rENA's pattern; with orthonormal named axes they lie in defA's row
        // space, orthogonal to the axes). When the data are rank-deficient --
        // e.g. an all-zero connection column from a code mask, or fewer units
        // than connections -- the trailing columns come from defA's null
        // space, which contains the named axes themselves, so the SVD can
        // return one that nearly duplicates a named axis (|cos| ~ 0.99): the
        // rotation is no longer orthonormal and that axis's variance is
        // counted twice. Null-space columns are therefore orthogonalised
        // against the named axes and the axes already chosen (Gram-Schmidt),
        // skipping any with nothing left. Full-rank data are unaffected.
        arma::mat basis(p, p, arma::fill::zeros);   // orthonormal span so far
        arma::uword nb = 0;
        auto add_to_basis = [&](arma::vec v) {
            for (int pass = 0; pass < 2; ++pass)
                if (nb > 0) v -= basis.cols(0, nb - 1) * (basis.cols(0, nb - 1).t() * v);
            const double len = arma::norm(v);
            if (len > 1e-10 && nb < p) basis.col(nb++) = v / len;
        };
        for (arma::uword j = 0; j < k; ++j) add_to_basis(named_axes.col(j));

        // A singular value below 1e-7 of the largest is numerically zero.
        const double max_eig  = inner.eigenvalues.is_empty() ? 0.0 : inner.eigenvalues.max();
        const double null_eig = 1e-14 * max_eig;
        arma::uword filled = 0;
        auto take = [&](arma::vec v, double eigenvalue, bool in_null_space) {
            if (filled >= p - k) return;
            if (in_null_space) {
                for (int pass = 0; pass < 2; ++pass)
                    if (nb > 0) v -= basis.cols(0, nb - 1) * (basis.cols(0, nb - 1).t() * v);
                const double len = arma::norm(v);
                if (len < 1e-8) return;        // nothing left: skip the candidate
                v /= len;
            }
            rotation.col(k + filled) = v;
            eigenvalues(k + filled) = eigenvalue;
            ++filled;
            add_to_basis(v);
        };
        for (arma::uword j = 0; j < inner.rotation.n_cols && filled < p - k; ++j)
            take(inner.rotation.col(j), inner.eigenvalues(j), inner.eigenvalues(j) <= null_eig);
        // The SVD columns span R^p, so this only runs on degenerate input.
        for (arma::uword i = 0; i < p && filled < p - k; ++i) {
            arma::vec e(p, arma::fill::zeros);
            e(i) = 1.0;
            take(e, 0.0, true);
        }
    }

    std::vector<std::string> labels(p);
    for (arma::uword j = 0; j < k; ++j) labels[j] = named_labels[j];
    for (arma::uword j = k; j < p; ++j) {
        labels[j] = "SVD" + std::to_string(j + 1);
    }
    return {rotation, eigenvalues, std::move(labels)};
}

/// @}

/// @name Means rotation
/// @{

/**
 * @brief Compute a means rotation from one or more group pairs.
 *
 * For each GroupPair, computes the normalized mean-difference vector on the
 * progressively deflated data and stacks the resulting unit-norm axes into a
 * weights matrix.  The final rotation is completed by orthogonal_svd().
 * The input `points` is mean-centered before any axes are computed, matching
 * rENA's `scale(data, scale=FALSE, center=TRUE)`.
 *
 * @param points  n x p matrix of network positions (raw, not pre-centered).
 * @param pairs   Ordered list of GroupPair objects.  Each pair contributes
 *                one "MR" axis in sequence.  Must be non-empty.
 *
 * @returns A RotationResult with `column_names` = {"MR1", ..., "MRm",
 *          "SVD{m+1}", ..., "SVDp"} where m = pairs.size().
 *
 * @note Equivalent to `ena.rotate.by.mean()` in rENA/R/ena.rotate.by.mean.R.
 *       The progressive deflation (each axis is computed on the data after
 *       removing all previous axes) is the key numerical step.
 *
 * @warning There is NO guard against a zero-norm mean-difference vector.
 *          If the two group means are identical on the current deflated data,
 *          the axis will contain NaN values (division by zero).  This mirrors
 *          a latent bug in rENA and is preserved verbatim for numerical
 *          fidelity; a safe opt-in guard will be added in a future release.
 *
 * @throws std::runtime_error if `pairs` is empty.
 */
inline RotationResult means_rotation(const arma::mat&              points,
                                      const std::vector<GroupPair>& pairs) {
    if (pairs.empty()) {
        throw std::runtime_error("Unable to rotate without 2 groups.");
    }

    arma::mat data     = points.each_row() - arma::mean(points, 0);
    arma::mat deflated = data;
    arma::mat weights(data.n_cols, pairs.size(), arma::fill::zeros);
    std::vector<std::string> labels;
    labels.reserve(pairs.size());

    for (std::size_t i = 0; i < pairs.size(); ++i) {
        const arma::rowvec mean_a = arma::mean(deflated.rows(pairs[i].a), 0);
        const arma::rowvec mean_b = arma::mean(deflated.rows(pairs[i].b), 0);
        const arma::vec    diff   = (mean_a - mean_b).t();
        const double       norm   = std::sqrt(arma::accu(diff % diff));
        const arma::vec    axis   = diff / norm;        // no zero-norm guard

        deflated        = deflate(deflated, axis);
        weights.col(i)  = axis;
        labels.push_back("MR" + std::to_string(i + 1));
    }

    return orthogonal_svd(deflated, weights, labels);
}

/// @}

}  // namespace qe

#endif  // LIBQE_ROTATION_HPP

// [[Rcpp::depends(RcppArmadillo)]]
// Rcpp wrappers for libena, the ENA layer of the libqe C++ libraries. The
// headers live in inst/include/libena/ (moved from libqe); they build on
// libqe's generic numerics, which come from LinkingTo: libqe.
//
// These functions are internal: rENA's R code calls them, and its exported
// R functions are the API. ena_correlation_c and directed_node_positions_c
// are suffixed because rENA exports R functions with the plain names.
#include <RcppArmadillo.h>
#include <libena/rotation.hpp>
#include <libena/generalized_rotation.hpp>
#include <libena/positions.hpp>
#include <libena/ccd.hpp>

using namespace Rcpp;

// =============================================================================
// Node positions and correlation
// =============================================================================

// Pearson correlation with CI between ENA points and centroids
// @param points  Numeric matrix (units x dims)
// @param centroids Numeric matrix (units x dims)
// @param conf_level Confidence level (default 0.95)
// [[Rcpp::export]]
arma::mat ena_correlation_c(arma::mat points, arma::mat centroids,
                              double conf_level = 0.95) {
    return qe::ena_correlation(points, centroids, conf_level);
}

// Least-squares node positions for undirected ENA
// @param adj_mats Numeric matrix of line weights (units x connections)
// @param t        Numeric matrix of rotated points (units x dims)
// @param num_dims Number of dimensions
// @return List with nodes, centroids, weights, points
// [[Rcpp::export]]
List node_positions(arma::mat adj_mats, arma::mat t, int num_dims) {
    if (!adj_mats.is_finite() || !t.is_finite())
        stop("node_positions: input matrices must not contain NaN or Inf - "
             "filter or impute rows with non-finite values before calling");
    qe::NodePositions r = qe::node_positions(adj_mats, t, num_dims);
    return List::create(
        _("nodes")     = r.nodes,
        _("centroids") = r.centroids,
        _("weights")   = r.weights,
        _("points")    = r.points
    );
}

// Least-squares node positions for directed ENA
// @param line_weights Numeric matrix (units x connections)
// @param points       Numeric matrix of rotated points (units x dims)
// @param num_dims     Number of dimensions
// @param self_weight  Self-connection multiplier in the node weights
//                     (2 = row + column sum, the default; 1 = once)
// @return List with nodes, centroids, weights, points
// [[Rcpp::export]]
List directed_node_positions_c(arma::mat line_weights, arma::mat points,
                                 int num_dims, double self_weight = 2.0) {
    if (!line_weights.is_finite() || !points.is_finite())
        stop("directed_node_positions: input matrices must not contain NaN or Inf - "
             "filter or impute rows with non-finite values before calling");
    qe::NodePositions r = qe::directed_node_positions(line_weights, points, num_dims,
                                                      false, self_weight);
    return List::create(
        _("nodes")     = r.nodes,
        _("centroids") = r.centroids,
        _("weights")   = r.weights,
        _("points")    = r.points
    );
}

// Directed node positions with paired ground+response rows combined
// @param line_weights Numeric matrix (units x connections)
// @param points       Numeric matrix of rotated points (units x dims)
// @param num_dims     Number of dimensions
// @param self_weight  Self-connection multiplier (see directed_node_positions_c)
// @return List with nodes, centroids, weights, points
// [[Rcpp::export]]
List directed_node_positions_combine_pairs(arma::mat line_weights,
                                               arma::mat points,
                                               int num_dims,
                                               double self_weight = 2.0) {
    if (!line_weights.is_finite() || !points.is_finite())
        stop("directed_node_positions_combine_pairs: input matrices must not contain NaN or Inf - "
             "filter or impute rows with non-finite values before calling");
    qe::NodePositions r = qe::directed_node_positions(
        line_weights, points, num_dims, true, self_weight);
    return List::create(
        _("nodes")     = r.nodes,
        _("centroids") = r.centroids,
        _("weights")   = r.weights,
        _("points")    = r.points
    );
}

// Layout-agnostic node optimization: column k connects codes from[k] and
// to[k] (0-based; equal for a self-connection). See libena's ConnectionKey.
static qe::ConnectionKey key_of(const IntegerVector& from, const IntegerVector& to) {
    if (from.size() != to.size()) stop("from and to must have the same length");
    qe::ConnectionKey key{ arma::uvec(from.size()), arma::uvec(to.size()) };
    for (R_xlen_t k = 0; k < from.size(); ++k) {
        if (from[k] < 0 || to[k] < 0) stop("key indices must be >= 0");
        key.from[k] = from[k]; key.to[k] = to[k];
    }
    return key;
}

// [[Rcpp::export]]
arma::mat node_weights_by_key_c(arma::mat line_weights, IntegerVector from, IntegerVector to,
                                int n_codes, double self_weight = 2.0) {
    return qe::node_weights_by_key(line_weights, key_of(from, to), n_codes, self_weight);
}

// [[Rcpp::export]]
List node_positions_by_key_c(arma::mat line_weights, arma::mat points, int num_dims,
                             IntegerVector from, IntegerVector to, int n_codes,
                             double self_weight = 2.0) {
    qe::NodePositions r = qe::node_positions_by_key(
        line_weights, points, num_dims, key_of(from, to), n_codes, self_weight);
    return List::create(_("nodes") = r.nodes, _("centroids") = r.centroids,
                        _("weights") = r.weights, _("points") = r.points);
}

// [[Rcpp::export]]
arma::mat node_centroids_by_key_c(arma::mat line_weights, arma::mat nodes,
                                  IntegerVector from, IntegerVector to, double self_weight = 2.0) {
    return qe::node_centroids_by_key(line_weights, nodes, key_of(from, to), self_weight);
}

// [[Rcpp::export]]
List move_nodes_to_unit_circle_by_key_c(arma::mat line_weights, arma::mat nodes,
                                        int dim_x, int dim_y, std::string mode,
                                        IntegerVector from, IntegerVector to,
                                        double self_weight = 2.0) {
    if (dim_x < 0 || dim_y < 0)
        stop("move_nodes_to_unit_circle: dimension indices must be >= 0");
    qe::MovedNodes r = qe::move_nodes_to_unit_circle_by_key(
        line_weights, nodes, dim_x, dim_y, qe::unit_circle_mode(mode), key_of(from, to), self_weight);
    return List::create(_("nodes") = r.nodes, _("centroids") = r.centroids);
}

// Post-fit unit-circle node move, for move_nodes_to_unit_circle() and
// move_nodes_to_unit_circle_with_equal_space() (R/move_nodes.R)
// @param line_weights Numeric matrix (units x connections)
// @param nodes        Numeric matrix (codes x dims)
// @param dim_x        0-based column of the plane's x axis
// @param dim_y        0-based column of the plane's y axis
// @param mode         "equal" or "radial"
// @param directed     Ordered (directed) networks
// @param self_weight  Directed self-connection multiplier, the fit's
// @return List with nodes (all dims; only dim_x, dim_y moved) and centroids
// [[Rcpp::export]]
List move_nodes_to_unit_circle_c(arma::mat line_weights, arma::mat nodes,
                                 int dim_x, int dim_y, std::string mode,
                                 bool directed, double self_weight = 2.0) {
    if (dim_x < 0 || dim_y < 0)
        stop("move_nodes_to_unit_circle: dimension indices must be >= 0");
    qe::MovedNodes r = qe::move_nodes_to_unit_circle(
        line_weights, nodes, dim_x, dim_y, qe::unit_circle_mode(mode), directed, self_weight);
    return List::create(
        _("nodes")     = r.nodes,
        _("centroids") = r.centroids
    );
}

// =============================================================================
// Rotation
// =============================================================================

// Pack a RotationResult into the list shape that matches rENA's ENARotationSet
// payload (rotation + eigenvalues + column names). Column names are attached
// to the rotation matrix as dimnames so downstream R code can index by them.
// Eigenvalues are returned as a plain numeric vector (not an Nx1 matrix) to
// match what rENA's `pcaResults$sdev^2` produces.
static List pack_rotation_result(const qe::RotationResult& r) {
    NumericMatrix rotation = wrap(r.rotation);
    CharacterVector col_names(r.column_names.begin(), r.column_names.end());
    rotation.attr("dimnames") = List::create(R_NilValue, col_names);
    NumericVector eigenvalues(r.eigenvalues.begin(), r.eigenvalues.end());
    return List::create(
        _("rotation")     = rotation,
        _("eigenvalues")  = eigenvalues,
        _("column_names") = col_names
    );
}

// SVD rotation (matches prcomp(retx=F, scale=F, center=F, tol=0))
//
// Caller is responsible for centering upstream. Eigenvalues are stored as
// \code{sdev^2} (variance) to match rENA's \code{ena.svd}.
//
// @param points Numeric matrix (n_units x n_dims)
// @return List with \code{rotation} (n_dims x n_dims), \code{eigenvalues}
//   (length n_dims, = sdev^2), and \code{column_names} ("SVD1", "SVD2", ...)
// [[Rcpp::export]]
List ena_svd(arma::mat points) {
    if (!points.is_finite())
        stop("ena_svd: input matrix must not contain NaN or Inf - "
             "filter or impute rows with non-finite values before calling");
    return pack_rotation_result(qe::ena_svd(points));
}

// Project a matrix onto the hyperplane orthogonal to a unit-norm axis
//
// Computes \code{data - (data \%*\% axis) \%*\% t(axis)}. The caller is
// responsible for ensuring \code{axis} is unit-norm.
//
// @param data Numeric matrix (n_units x n_dims)
// @param axis Numeric vector of length n_dims, unit-norm
// @return Numeric matrix of the same shape as \code{data}
// [[Rcpp::export]]
arma::mat deflate(arma::mat data, arma::vec axis) {
    return qe::deflate(data, axis);
}

// Orthogonal SVD — orthonormalize named axes via QR, fill the rest from SVD
//
// Mirrors rENA's \code{orthogonal_svd()} in \code{ena.rotate.by.mean.R}:
// the named axes in the output are the orthonormalized Q columns, not the
// original \code{weights} columns. Use \code{complete_rotation} to keep
// the named axes verbatim.
//
// @param data         Numeric matrix (n_units x n_dims)
// @param weights      Numeric matrix (n_dims x k); columns are the named axes
// @param named_labels Character vector of length k
// @return List with \code{rotation}, \code{eigenvalues}, \code{column_names}
// [[Rcpp::export]]
List orthogonal_svd(arma::mat data,
                        arma::mat weights,
                        std::vector<std::string> named_labels) {
    return pack_rotation_result(qe::orthogonal_svd(data, weights, named_labels));
}

// Complete a rotation — keep named axes verbatim, fill remainder from SVD
//
// Mirrors the tail of \code{ena.rotate.by.generalized}: the named axes
// appear in the output exactly as provided, and the trailing columns come
// from an SVD of the data deflated by all named axes.
// On rank-deficient data (e.g. an all-zero connection column) the trailing
// axes that come from the deflated data's null space are orthogonalised
// against the named axes, so the rotation is orthonormal whenever the named
// axes are.
//
// @param data         Numeric matrix (n_units x n_dims)
// @param named_axes   Numeric matrix (n_dims x k); columns must be unit-norm
// @param named_labels Character vector of length k
// @return List with \code{rotation}, \code{eigenvalues}, \code{column_names}
// [[Rcpp::export]]
List complete_rotation(arma::mat data,
                           arma::mat named_axes,
                           std::vector<std::string> named_labels) {
    return pack_rotation_result(qe::complete_rotation(data, named_axes, named_labels));
}

// Means rotation
//
// For each group pair, computes a normalized mean-difference axis on the
// progressively-deflated data and finishes with \code{orthogonal_svd}.
// The input is column-centered first, matching rENA's
// \code{scale(data, scale=F, center=T)} at the top of \code{ena.rotate.by.mean}.
//
// Each element of \code{group_pairs} is a length-2 list \code{list(a, b)}
// of 0-based row indices into \code{points}.
//
// @param points      Numeric matrix (n_units x n_dims)
// @param group_pairs List of length k; each element is \code{list(a, b)}
//   where \code{a} and \code{b} are 0-based integer index vectors
// @return List with \code{rotation}, \code{eigenvalues}, \code{column_names}
// [[Rcpp::export]]
List means_rotation(arma::mat points, List group_pairs) {
    std::vector<qe::GroupPair> pairs;
    pairs.reserve(group_pairs.size());
    for (R_xlen_t i = 0; i < group_pairs.size(); ++i) {
        List pair = group_pairs[i];
        if (pair.size() != 2) {
            stop("group_pairs[[%d]] must be a length-2 list(a, b)",
                 static_cast<int>(i + 1));
        }
        IntegerVector ra = pair[0];
        IntegerVector rb = pair[1];
        arma::uvec a(ra.size());
        arma::uvec b(rb.size());
        for (R_xlen_t j = 0; j < ra.size(); ++j) {
            a(j) = static_cast<arma::uword>(ra[j]);
        }
        for (R_xlen_t j = 0; j < rb.size(); ++j) {
            b(j) = static_cast<arma::uword>(rb[j]);
        }
        pairs.push_back({a, b});
    }
    return pack_rotation_result(qe::means_rotation(points, pairs));
}

// =============================================================================
// Generalized Means Rotation (GMR)
// =============================================================================

// Generalized Means Rotation
//
// Computes a rotation axis that best represents a target variable's
// contribution to the ENA point space, after controlling for covariates via
// Lasso (coordinate-descent, k-fold CV).  Mirrors
// \code{rENA::ena.rotate.by.generalized()}.
//
// The caller is responsible for building \code{x_model_matrix} (e.g. via
// \code{model.matrix()}) and identifying \code{x1_cols} (0-based indices of
// the target variable's columns, which receive \code{penalty_factor = 0}).
// Categorical targets should be encoded as 0-based integers.
//
// @param V              Numeric matrix (n_units x n_connections) — ENA points.
// @param x_model_matrix Numeric matrix (n_units x p) — model matrix for x axis.
// @param x_target       Numeric vector length n — target variable (raw float
//   for numeric; 0-based integer codes for categorical).
// @param x1_cols        Integer vector of 0-based column indices in
//   \code{x_model_matrix} that belong to the target variable (unpenalized).
// @param x_categorical  Logical — TRUE if target is categorical.
// @param x_n_groups     Integer — number of distinct groups (categorical only).
// @param x_subset       Integer vector of 0-based row indices to subset for
//   the x-axis GMR step (pass \code{integer(0)} to use all rows).
// @param has_y          Logical — TRUE to compute a second GMR axis.
// @param y_model_matrix Numeric matrix (n_units x p) — model matrix for y axis
//   (ignored when \code{has_y = FALSE}).
// @param y_target       Numeric vector — y-axis target (ignored when
//   \code{has_y = FALSE}).
// @param y1_cols        0-based column indices for y target (ignored when
//   \code{has_y = FALSE}).
// @param y_categorical  Logical (ignored when \code{has_y = FALSE}).
// @param y_n_groups     Integer (ignored when \code{has_y = FALSE}).
// @param n_lambda       Length of the Lasso lambda path (default 50).
// @param k_folds        Cross-validation folds for lambda selection (default 5).
// @param lasso_eps      \code{lambda_min = lasso_eps * lambda_max} (default 0.01).
// @return List with \code{rotation}, \code{eigenvalues}, \code{column_names}.
// [[Rcpp::export]]
List generalized_means_rotation(
    arma::mat V,
    arma::mat x_model_matrix,
    arma::vec x_target,
    IntegerVector x1_cols,
    bool x_categorical,
    int  x_n_groups,
    IntegerVector x_subset,
    bool has_y,
    arma::mat y_model_matrix,
    arma::vec y_target,
    IntegerVector y1_cols,
    bool y_categorical,
    int  y_n_groups,
    int  n_lambda  = 50,
    int  k_folds   = 5,
    double lasso_eps = 0.01
) {
    // ── Unpack x1_cols ───────────────────────────────────────────────────────
    arma::uvec x1(x1_cols.size());
    for (R_xlen_t i = 0; i < x1_cols.size(); ++i)
        x1(i) = static_cast<arma::uword>(x1_cols[i]);

    // ── Unpack x_subset (empty IntegerVector → use all rows) ─────────────────
    arma::uvec x_sub;
    if (x_subset.size() > 0) {
        x_sub.set_size(x_subset.size());
        for (R_xlen_t i = 0; i < x_subset.size(); ++i)
            x_sub(i) = static_cast<arma::uword>(x_subset[i]);
    }

    // ── Unpack y1_cols ───────────────────────────────────────────────────────
    arma::uvec y1(y1_cols.size());
    for (R_xlen_t i = 0; i < y1_cols.size(); ++i)
        y1(i) = static_cast<arma::uword>(y1_cols[i]);

    // ── Build params ─────────────────────────────────────────────────────────
    qe::GeneralizedRotationParams p;
    p.x_model_matrix = x_model_matrix;
    p.x_target       = x_target;
    p.x1_cols        = x1;
    p.x_categorical  = x_categorical;
    p.x_n_groups     = static_cast<arma::uword>(x_n_groups);
    p.x_subset       = x_sub;
    p.has_y          = has_y;
    p.y_model_matrix = y_model_matrix;
    p.y_target       = y_target;
    p.y1_cols        = y1;
    p.y_categorical  = y_categorical;
    p.y_n_groups     = static_cast<arma::uword>(y_n_groups);
    p.n_lambda       = n_lambda;
    p.k_folds        = k_folds;
    p.lasso_eps      = lasso_eps;

    return pack_rotation_result(qe::generalized_means_rotation(V, p));
}

// =============================================================================
// CCD window estimation
// =============================================================================

// Cross-covariance decay (CCD) window-size estimation
//
// Estimates the ENA moving-window size from the half-life decay lag of the
// noise-corrected Frobenius norm of pooled conversation cross-covariance
// matrices.
//
// @param conversations A list of numeric code matrices, one per conversation
//   (rows in sequence; all matrices share the same number of columns).
// @param max_window Maximum lag to evaluate (default 20).
// @param min_overlap Minimum overlapping rows (N - lag) required for a
//   conversation to contribute at a given lag (default 10).
//
// @return A list with \code{window_size}, \code{peak_lag}, and the per-lag
//   curves \code{lag}, \code{frob}, \code{frob_sq_unbiased},
//   \code{frob_unbiased_signed}, and \code{total_weight}.
// [[Rcpp::export]]
Rcpp::List ccd_window(
    Rcpp::List conversations,
    int max_window = 20,
    int min_overlap = 10
) {
    std::vector<arma::mat> convos;
    convos.reserve(conversations.size());
    for (R_xlen_t i = 0; i < conversations.size(); ++i) {
        convos.push_back(Rcpp::as<arma::mat>(conversations[i]));
    }

    qe::CCDResult res = qe::ccd_window(convos, max_window, min_overlap);

    return Rcpp::List::create(
        Named("window_size")          = res.window_size,
        Named("peak_lag")             = res.peak_lag,
        Named("lag")                  = res.lag,
        Named("frob")                 = res.frob,
        Named("frob_sq_unbiased")     = res.frob_sq_unbiased,
        Named("frob_unbiased_signed") = res.frob_unbiased_signed,
        Named("total_weight")         = res.total_weight
    );
}

1		ena.set <- function(x) {
2	130x	newset = list()
3	130x	class(newset) <- c("ena.set", class(newset))
4	130x	x.is.set <- T
5	130x	if("ENAdata" %in% class(x)) {
6	127x	x <- list(enadata = x);
7	127x	x.is.set <- F
8		}
9	130x	code.columns <- apply(x$enadata$adjacency.matrix, 2, paste, collapse = " & ")
10
11	130x	newset$connection.counts <- x$enadata$adjacency.vectors;
12	130x	colnames(newset$connection.counts) <- code.columns
13	130x	for (i in seq(ncol(newset$connection.counts))) {
14	1613x	set(newset$connection.counts, j = i, value = as.ena.co.occurrence(newset$connection.counts[[i]]))
15		}
16
17	130x	if (grepl(x = x$enadata$model, pattern = "Traj", ignore.case = T)) {
18	10x	newset$meta.data <- data.table::copy(x$enadata$trajectories$units)
19	10x	newset$meta.data[, ENA_UNIT := apply(x$enadata$trajectories$units, 1, paste, collapse = "::")]
20
21	10x	newset$trajectories <- cbind(newset$meta.data, x$enadata$trajectories$step)
22	10x	for (i in seq(ncol(newset$trajectories))) {
23	44x	set(newset$trajectories, j = i, value = as.ena.metadata(newset$trajectories[[i]]))
24		}
25		}
26		else {
27	120x	newset$meta.data <- x$enadata$metadata
28		}
29
30	130x	if (!is.null(newset$meta.data) && ncol(newset$meta.data) > 0) {
31	130x	for (i in seq(ncol(newset$meta.data))) {
32	527x	set(newset$meta.data, j = i,
33	527x	value = as.ena.metadata(newset$meta.data[[i]]))
34		}
35		}
36	130x	newset$meta.data <- as.ena.matrix(newset$meta.data);
37
38	130x	if (x.is.set) {
39	3x	newset$line.weights <- as.data.table(cbind(x$enadata$metadata, x$line.weights))
40	3x	to_cols <- names(which(!find_meta_cols(newset$line.weights)))
41	3x	for(col in to_cols) {
42	40x	set(x = newset$line.weights, j = col, value = as.ena.co.occurrence(newset$line.weights[[col]]))
43		}
44	3x	class(newset$line.weights) <- c("ena.line.weights", class(newset$line.weights))
45
46	3x	newset$points <- cbind(x$enadata$metadata, x$points.rotated)
47	3x	to_cols <- names(which(!find_meta_cols(newset$points)))
48	3x	for(col in to_cols) {
49	40x	set(x = newset$points, j = col, value = as.ena.dimension(newset$points[[col]]))
50		}
51	3x	newset$points <- as.ena.matrix(newset$points, "ena.points")
52
53	3x	newset$rotation.matrix <- x$rotation.set$rotation
54		}
55
56	130x	newset$connection.counts <- cbind(newset$meta.data, newset$connection.counts)
57	130x	class(newset$connection.counts) <- c("ena.connections",
58	130x	class(newset$connection.counts))
59
60	130x	newset$model <- list(
61	130x	model.type = x$enadata$model,
62	130x	raw.input = x$enadata$raw,
63	130x	row.connection.counts = x$enadata$accumulated.adjacency.vectors[,
64	130x	unique(names(x$enadata$accumulated.adjacency.vectors)), with = F],
65	130x	unit.labels = x$enadata$unit.names
66		)
67
68		#####
69		# if(quote(x$enadata$function.params$weight.by) != "binary") {
70		# newset$model$unweighted.connection.counts <- x$enadata$adjacency.vectors.raw
71		# class(newset$model$unweighted.connection.counts) <- c("ena.connections",
72		# class(newset$model$unweighted.connection.counts))
73		# are.codes <- find_code_cols(newset$model$unweighted.connection.counts)
74		# for (i in seq(are.codes)) {
75		# if (are.codes[i]) {
76		# set(newset$model$unweighted.connection.counts, j = i,
77		# value = as.ena.co.occurrence(
78		# newset$model$unweighted.connection.counts[[i]]
79		# )
80		# )
81		# } else {
82		# set(newset$model$unweighted.connection.counts, j = i,
83		# value = as.ena.metadata(
84		# newset$model$unweighted.connection.counts[[i]]
85		# )
86		# )
87		# }
88		# }
89		# }
90		#####
91
92	130x	cols <- grep("adjacency.code", colnames(newset$model$row.connection.counts))
93	130x	colnames(newset$model$row.connection.counts)[cols] <- code.columns
94	130x	for(i in cols) {
95	1613x	set(newset$model$row.connection.counts, j = i,
96	1613x	value = as.ena.co.occurrence(newset$model$row.connection.counts[[i]]))
97		}
98	130x	for (i in which(colnames(newset$model$row.connection.counts)
99	130x	%in% colnames(newset$meta.data))
100		) {
101	404x	set(newset$model$row.connection.counts, j = i,
102	404x	value = as.ena.metadata(newset$model$row.connection.counts[[i]]))
103		}
104	130x	for (i in which(colnames(newset$model$row.connection.counts) %in%
105	130x	x$enadata$codes)
106		) {
107	697x	set(newset$model$row.connection.counts, j = i,
108	697x	value = as.ena.code(newset$model$row.connection.counts[[i]]))
109		}
110	130x	class(newset$model$row.connection.counts) <- c("row.connections",
111	130x	class(newset$model$row.connection.counts))
112
113	130x	if (x.is.set) {
114	3x	newset$model$centroids <- x$centroids
115	3x	newset$model$correlations <- x$correlations
116	3x	newset$model$function.call <- x$function.call
117	3x	newset$model$function.params <- x$function.params
118	3x	newset$model$points.for.projection <- cbind(x$enadata$metadata,
119	3x	x$points.normed.centered)
120	3x	newset$model$variance <- x$variance
121	3x	names(newset$model$variance) <- colnames(newset$rotation.matrix)
122		}
123
124	130x	newset$rotation <- list(
125	130x	adjacency.key = as.data.table(x$enadata$adjacency.matrix),
126	130x	codes = x$enadata$codes
127		)
128	130x	class(newset$rotation) <- c("ena.rotation.set", class(newset$rotation))
129
130	130x	for (i in seq(ncol(newset$rotation$adjacency.key))) {
131	1613x	set(newset$rotation$adjacency.key, j = i,
132	1613x	value = as.ena.codes(newset$rotation$adjacency.key[[i]]))
133		}
134
135	130x	if(x.is.set) {
136	3x	newset$rotation$eigenvalues = x$rotation.set$eigenvalues
137	3x	newset$rotation$nodes = x$node.positions
138	3x	newset$rotation$rotation.matrix = x$rotation.set$rotation
139		}
140
141	130x	newset$`_function.call` <- sys.calls()[[1]]
142	130x	back.frame <- sapply(sys.frames(), function(f) {
143	130x	"window.size.back" %in% ls(envir = f) })
144	130x	if (any(back.frame)) {
145	126x	call.frame <- sys.frame(which(back.frame))
146	126x	newset$`_function.params` <- mget(ls(envir = call.frame),
147	126x	envir = call.frame)
148		} else {
149	4x	newset$`_function.params` <- list()
150		}
151
152	130x	return(newset);
153		}

1		#' ENARotationSet R6class
2		#
3		#' @docType class
4		#' @importFrom R6 R6Class
5		#' @import data.table
6		#' @export
7		#
8		#' @field rotation TBD
9		#' @field node.positions TBD
10		#' @field codes TBD
11		#' @field eigenvalues TBD
12		ENARotationSet = R6::R6Class("ENARotationSet",
13		public = list(
14
15		## Public Functions ----
16		#' Create ENARotationSet
17		#'
18		#' @param rotation TBD
19		#' @param codes TBD
20		#' @param node.positions TBD
21		#' @param eigenvalues TBD
22		#'
23		#' @return ENARotationsSet
24		initialize = function(
25		rotation,
26		codes,
27		node.positions,
28		eigenvalues = NULL
29		) {
30	8x	self$node.positions = node.positions;
31	8x	self$rotation = rotation;
32	8x	self$codes = codes;
33	8x	if(!is.null(codes) && !is.null(self$node.positions)) {
34	1x	rownames(self$node.positions) = codes;
35		}
36	8x	self$eigenvalues = eigenvalues;
37		},
38
39		## Public Properties ----
40		rotation = NULL,
41		node.positions = NULL,
42		codes = NULL,
43		eigenvalues = NULL
44		),
45		private = list(
46		#####
47		## Private Properties
48		#####
49		args = NULL
50		#####
51		## END: Private Properties
52		#####
53		)
54		)

1		#' @title hENA rotation for ENA
2		#'
3		#' @description hENA rotation function.
4		#'
5		#' @param enaset ena set
6		#' @param params list of parameters
7		#'
8		#' @return ena set
9		#' @export
10		ena.rotation.h <- function(
11		enaset,
12		params
13		) {
14		# check arguments
15	!	if ( !is.list(params) \|\| is.null(params$x_var) ) {
16	!	stop("params must be provided as a list() and provide `x_var`")
17		}
18	!	x_var = params$x_var;
19	!	y_var = params$y_var;
20	!	control_vars = params$control_vars;
21	!	centering = ifelse(!is.null(params$centering), params$centering, TRUE);
22	!	include_xy = ifelse(!is.null(params$include_xy), params$include_xy, FALSE);
23	!	formula = params$formula;
24
25		# get centered data
26	!	if (!is.null(enaset$model$points.for.projection)) {
27	!	data = data.table::copy(enaset$model$points.for.projection)
28		}
29		else {
30	!	data = data.table::copy(enaset$points.normed.centered)
31		}
32
33		# Prep
34	!	value_vars = colnames(as.matrix(data))
35	!	data.table::set(x = data, j = value_vars, value = data[, lapply(.SD, function(x) x - mean(x)), .SDcols = value_vars])
36
37		# dummy code x_var
38	!	if (!is.numeric(data[[x_var]])) {
39	!	x_var_f = paste0(x_var,"_f")
40	!	data[[x_var_f]] = data.table::rleidv(x = data, cols = x_var) - 1
41	!	x_var = x_var_f;
42		}
43
44		# dummy code y_var
45	!	if (!is.null(y_var) && !is.numeric(data[[y_var]])) {
46	!	y_var_f = paste0(y_var,"_f")
47	!	data[[y_var_f]] = data.table::rleidv(x = data, cols = y_var) - 1
48	!	y_var = y_var_f;
49		}
50	!	both_vars = c(x_var, y_var)
51
52		# centering x_var and y_var
53	!	if ( centering ) {
54	!	data[, c(both_vars) := lapply(.SD, function(x) x - mean(x)), .SDcols = c(both_vars)]
55		}
56
57		# prepare regression formula
58	!	f = paste(c(both_vars, control_vars), collapse = " + ")
59
60	!	if ( include_xy ) {
61	!	xy_var = paste(both_vars, collapse = "_");
62	!	data[[xy_var]] = data[[x_var]] * data[[y_var]];
63	!	f = paste(c(f, xy_var), collapse = " + ");
64		}
65
66	!	if (!is.null(formula)) {
67	!	f = formula;
68		}
69
70		# run regression models and get slope variables
71	!	v = matrix(sapply(value_vars, function(v) {
72	!	formula = as.formula(paste0("data$`", v, "` ~ ", f));
73	!	lm(formula, data = data)$coefficients[seq_along(both_vars) + 1];
74	!	}), ncol = length(both_vars), byrow = TRUE)
75
76		# Prep deflation
77	!	R = NULL;
78	!	'..value_vars' = NULL;
79	!	A = as.matrix(data[, ..value_vars]);
80
81		# Normalize x rotation vector
82	!	v1 = v[, 1, drop = FALSE];
83	!	norm_v1 = sqrt(sum( v1 * v1 ));
84	!	if (norm_v1 != 0) {
85	!	v1 = v1 / norm_v1;
86	!	R = v1;
87		}
88	!	defA = as.matrix(A) - as.matrix(A) %% v1 %% t(v1);
89
90		# Normalize y rotation vector, if applicable
91	!	v2 = NULL;
92	!	if (!is.null(y_var)) {
93	!	v2 = v[, 2]
94	!	v2 = as.numeric(v2) - as.numeric(t(v2) %% v1) v1;
95	!	norm_v2 = sqrt(sum( v2 * v2 ));
96
97	!	if (norm_v2 != 0) {
98	!	v2 = v2 / norm_v2;
99	!	if( is.null(R) ) {
100	!	R = matrix(c(v2), ncol = 1)
101		}
102		else {
103	!	R = matrix(c(R, v2), ncol = 2)
104		}
105		}
106
107	!	defA = defA - defA %% v2 %% t(v2);
108		}
109
110		# get svd for deflated points
111		# svd_result = svd(defA)
112		# svd_v = svd_result$v;
113	!	svd_result = prcomp(defA, retx=FALSE, scale=FALSE, center=FALSE, tol=0)
114	!	svd_v = svd_result$rotation
115
116		# Merge rotation vectors
117	!	vcount = ncol(R);
118	!	combined = cbind(R, svd_v[, 1:(ncol(svd_v) - vcount)]);
119
120	!	colnames(combined) = c(
121	!	paste(c("x","y")[seq_len(vcount)], both_vars[seq_len(vcount)], sep = "_"),
122	!	paste0("SVD", ((vcount + 1):ncol(combined)))
123		);
124
125		# put into ENARotationSet
126		# browser()
127	!	rotation_set <- ENARotationSet$new(
128	!	node.positions = NULL,
129	!	rotation = combined,
130	!	codes = enaset$rotation$codes,
131	!	eigenvalues = svd_result$sdev ^ 2
132		)
133
134		# Done
135	!	return(rotation_set)
136		}

1		#' @title ENAplot Class
2		#'
3		#' @description
4		#' The ENAplot R6 class provides a structure for visualizing ENAset objects using plotly.
5		#' It encapsulates the ENAset data, the plotly visualization, and related plotting parameters.
6		#'
7		#' @section Fields:
8		#' \describe{
9		#' \item{enaset}{The \code{\link{ENAset}} object from which the ENAplot was constructed.}
10		#' \item{plot}{The plot as an htmlwidget: a plotly object, or a qeviz widget
11		#' when the plot was created with \code{backend = "qeviz"}.}
12		#' \item{qe}{With \code{backend = "qeviz"}, the \code{qeviz::qe_plot()} the
13		#' layer functions build on; \code{NULL} for plotly.}
14		#' \item{axes}{Axes information for the plot (TBD).}
15		#' \item{point}{Point information for the plot (TBD).}
16		#' \item{palette}{Color palette used for plotting (TBD).}
17		#' \item{plotted}{Indicates whether the plot has been rendered (TBD).}
18		#' }
19		#'
20		#' @examples
21		#' # Example usage:
22		#' # enaplot <- ENAplot$new(enaset = myENAset)
23		#'
24		#' @docType class
25		#' @importFrom R6 R6Class
26		#' @import data.table
27		#' @export
28		#'
29		#' @field enaset - The \code{\link{ENAset}} object from which the ENAplot was constructed
30		#' @field plot - The plot as an htmlwidget (plotly, or qeviz with \code{backend = "qeviz"})
31		#' @field qe - The \code{qeviz::qe_plot()} behind a qeviz-backend plot, else \code{NULL}
32		#' @field axes A list or object specifying the axes configuration for the ENA plot, such as axis labels, limits, or scaling.
33		#' @field point A structure representing the data points to be plotted, including coordinates and visual properties.
34		#' @field palette A set of colors or a function defining the color scheme used for plotting elements in the ENA plot.
35		#' @field plotted A logical or status indicator showing whether the plot has been rendered or updated.
36		#' @field title Character. The title of the plot.
37		#' @field showticklabels Logical. Indicates whether to show tick labels on the axes.
38		#' @field autosize Logical. Indicates whether the plot should automatically resize.
39		#' @field automargin Logical. Indicates whether the plot should automatically adjust margins.
40		#' @field axispadding Numeric. Padding factor for the axes.
41		ENAplot = R6::R6Class("ENAplot",
42
43		public = list(
44
45		## Public Functions ----
46		#' Create ENApolot
47		#'
48		#' @param enaset An ENA set object containing the data to be plotted.
49		#' @param title The title of the plot.
50		#' @param dimension.labels Labels for the dimensions shown in the plot.
51		#' @param font.size Numeric value specifying the font size for plot text.
52		#' @param font.color Color value for the plot text.
53		#' @param font.family Font family to use for plot text.
54		#' @param scale.to Numeric value to scale the plot axes.
55		#' @param showticklabels Logical; whether to display axis tick labels.
56		#' @param autosize Logical; whether the plot should automatically size itself.
57		#' @param automargin Logical; whether the plot should automatically adjust margins.
58		#' @param axispadding Numeric value specifying padding around axes.
59		#' @param backend \code{"plotly"} or \code{"qeviz"}; see \link{rENA-plot-backends}.
60		#' @param ... Additional arguments passed to the plotting function. #'
61		#'
62		#' @return ENAplot
63		initialize = function(
64		enaset = NULL,
65
66		title = "ENA Plot",
67
68		dimension.labels = c("",""),
69
70		font.size = 14,
71		font.color = "#000000",
72		font.family = "Arial",
73		scale.to = "network",
74		backend = c("plotly", "qeviz"),
75		...
76		) {
77	88x	backend <- match.arg(backend)
78	87x	if (is(enaset, "ENAset")) {
79	1x	warning(paste0("Usage of ENAset objects will be deprecated ",
80	1x	"and potentially removed altogether in future versions."))
81
82	1x	enaset <- ena.set(enaset);
83		}
84
85	87x	code.cols = !colnames(enaset$line.weights) %in% colnames(enaset$meta.data)
86
87	87x	args = list(...);
88	87x	if(!is.null(args$multiplier)) {
89	2x	private$multiplier = args$multiplier
90		}
91		# qeviz backend: an explicit edge magnification (ena.plotter's
92		# multipliers), labelled "(scaled Nx)" on the plot.
93	87x	if(!is.null(args$magnify)) {
94	3x	private$magnify = args$magnify
95		}
96	87x	if(!is.null(args$point.size)) {
97	1x	self$point$size = args$point.size
98		}
99	87x	if(!is.null(args$showticklabels)) {
100	!	self$showticklabels = args$showticklabels
101		}
102	87x	if(!is.null(args$axispadding)) {
103	!	self$axispadding = args$axispadding
104		}
105	87x	if(!is.null(args$autosize)) {
106	!	self$autosize = args$autosize
107		}
108	87x	if(!is.null(args$automargin)) {
109	!	self$automargin = args$automargin
110		}
111	87x	self$enaset <- list(
112	87x	connection.counts = data.table::copy(enaset$connection.counts),
113	87x	meta.data = data.table::copy(enaset$meta.data),
114	87x	model = list(
115	87x	model.type = enaset$model$model.type,
116	87x	raw.input = data.table::copy(enaset$model$raw.input),
117	87x	row.connection.counts = data.table::copy(enaset$model$row.connection.counts),
118	87x	unit.labels = enaset$model$unit.labels,
119	87x	points.for.projection = data.table::copy(enaset$model$points.for.projection),
120	87x	centroids = data.table::copy(enaset$model$centroids),
121	87x	variance = enaset$model$variance
122		),
123	87x	points = data.table::copy(enaset$points),
124	87x	line.weights = data.table::copy(enaset$line.weights),
125	87x	rotation = list(
126	87x	adjacency.key = data.table::copy(enaset$rotation$adjacency.key),
127	87x	codes = enaset$rotation$codes,
128	87x	rotation.matrix = data.table::copy(enaset$rotation$rotation.matrix),
129	87x	center.vec = enaset$rotation$center.vec,
130	87x	nodes = data.table::copy(enaset$rotation$nodes)
131		),
132	87x	plots = list()
133		);
134	87x	self$title <- title;
135
136	87x	private$dimension.labels <- dimension.labels;
137	87x	private$font.size <- font.size;
138	87x	private$font.color <- font.color;
139	87x	private$font.family <- font.family;
140	87x	private$font = list (
141	87x	size = private$font.size,
142	87x	color = private$font.color,
143	87x	family = private$font.family
144		);
145	87x	private$backend <- backend
146	87x	if (backend == "qeviz") {
147	38x	.require_qeviz()
148	38x	self$palette <- qeviz::qe_palette()
149	38x	self$qe <- .qe_base_plot(enaset, title, dimension.labels, scale.to,
150	38x	font.size, font.color, font.family)
151	37x	return(invisible(self))
152		}
153
154	49x	self$plot <- plotly::plot_ly(
155	49x	mode = "markers",
156	49x	type ="scatter"
157		);
158
159	49x	self$plot <- plotly::config(p = self$plot, displayModeBar = args$displayModeBar);
160
161	49x	if (is.list(scale.to)) {
162	3x	max.axis = max(abs(as.matrix(enaset$points)))*self$axispadding
163	3x	if(is.null(scale.to$x)) {
164	1x	axis.range.x = c(-max.axis, max.axis)
165		}
166		else {
167	2x	axis.range.x = scale.to$x
168		}
169	3x	if(is.null(scale.to$y)) {
170	1x	axis.range.y = c(-max.axis, max.axis)
171		}
172		else {
173	2x	axis.range.y = scale.to$y
174		}
175		}
176		else {
177	46x	if(is.character(scale.to) && scale.to == "points") {
178	1x	max.axis = max(abs(as.matrix(enaset$points)))*self$axispadding
179		}
180	45x	else if (is.numeric(scale.to)) {
181	1x	max.axis = tail(scale.to, 1)
182		}
183		else {
184	44x	max.axis = max(abs(as.matrix(enaset$rotation$nodes)))*self$axispadding;
185		}
186	46x	axis.range.x = axis.range.y = c(-max.axis, max.axis)
187		}
188
189	49x	graph.axis <- list(
190	49x	titlefont = private$font,
191	49x	showgrid = F,
192	49x	zeroline = T,
193	49x	showticklabels = self$showticklabels,
194	49x	showgrid = T
195		# range=c(-max.axis,max.axis)
196		);
197	49x	if(!is.null(args$ticks)) {
198	1x	graph.axis$showticklabels = T;
199	1x	graph.axis$ticks = args$ticks$location;
200	1x	graph.axis$tickcolor = args$ticks$color;
201	1x	graph.axis$tickangle = args$ticks$angle;
202		}
203	49x	self$axes$x = graph.axis
204	49x	self$axes$x$title = dimension.labels[1];
205	49x	self$axes$x$range = axis.range.x
206	49x	self$axes$y = graph.axis
207	49x	self$axes$y$title = dimension.labels[2];
208	49x	self$axes$y$range = axis.range.y
209
210	49x	self$plot = plotly::layout(
211	49x	self$plot,
212	49x	title = title,
213	49x	xaxis = self$axes$x,
214	49x	yaxis = self$axes$y,
215	49x	autosize = self$autosize,
216	49x	font = list (
217	49x	size = 12,
218	49x	color = private$font.color,
219	49x	family = private$font.family
220		)
221		);
222		},
223
224		#' Print ENA plot
225		#'
226		#' @return
227		print = function() {
228	!	print(self$plot);
229		},
230
231		#' Get property from object
232		#'
233		#' @param x character key to retrieve from object
234		#' @return value from object at x
235		get = function(x) {
236	705x	return(private[[x]])
237		},
238
239		## Public Properties ----
240		enaset = NULL,
241		title = "ENA Plot",
242		qe = NULL,
243		axes = list(
244		x = NULL, y = NULL
245		),
246		point = list(
247		size = 5
248		),
249		showticklabels = F,
250		autosize = F,
251		automargin = T,
252		axispadding = 1.2,
253		palette = c("#386CB0", "#F0027F", "#7FC97F", "#BEAED4",
254		"#FDC086","#FFFF99", "#BF5B17"),
255		plotted = list(
256		points = list(), networks = list(),
257		trajectories = list(), means = list()
258		)
259		),
260
261		active = list(
262		# plotly: the stored plotly object. qeviz: a widget built from self$qe on
263		# each read, so it always reflects the layers added so far.
264		plot = function(value) {
265	1657x	if (missing(value)) {
266	23x	if (identical(private$backend, "qeviz")) return(qeviz::qe_widget(self$qe))
267	810x	return(private$.plot)
268		}
269	824x	if (identical(private$backend, "qeviz"))
270	1x	stop("$plot of a qeviz-backend ENAplot is read-only; add layers with ",
271	1x	"ena.plot.network() / ena.plot.points() / ena.plot.group().", call. = FALSE)
272	823x	private$.plot <- value
273		}
274		),
275
276		private = list(
277		####
278		## Private Properties
279		####
280		backend = "plotly",
281		.plot = NULL,
282		magnify = NULL,
283
284		dimension.labels = c("X","Y"),
285
286		font = list(),
287		font.size = 14,
288		font.color = "#000000",
289		font.family = "Arial",
290		#plot.color = I("black"),
291
292		multiplier = 5
293		####
294		## END: Private Properties
295		####
296		)
297		)
298
299
300		# The empty qeviz plot an ENAplot starts from (backend = "qeviz"). The full
301		# set is extracted so colour ramps and widths use model-wide scales; nothing
302		# is drawn until the layer functions add networks, points or means.
303		.qe_base_plot <- function(enaset, title, dimension.labels, scale.to,
304		font.size, font.color, font.family) {
305	38x	if (is.list(scale.to))
306	1x	stop("scale.to = list(x =, y =) is not supported on the qeviz backend: ",
307	1x	"qeviz ranges are symmetric. Use \"network\", \"points\" or a number.",
308	1x	call. = FALSE)
309	37x	range <- if (is.numeric(scale.to)) utils::tail(scale.to, 1)
310	37x	else if (identical(scale.to, "points")) "points"
311	37x	else "network"
312	37x	lbl <- function(i) {
313	74x	v <- if (length(dimension.labels) >= i) dimension.labels[i] else ""
314	4x	if (is.null(v) \|\| is.na(v) \|\| !nzchar(v)) FALSE else v
315		}
316	37x	p <- qeviz::qe_plot(enaset, title = if (!is.null(title) && nzchar(title)) title,
317	37x	group_col = NULL, range = range, scale_points = FALSE)
318	37x	p <- qeviz::qe_group(p, show = FALSE)
319	37x	p <- qeviz::qe_axes(p, x = lbl(1), y = lbl(2))
320	37x	qeviz::qe_labels(p, font_size = font.size, font_family = font.family,
321	37x	font_color = font.color)
322		}

1		#' @title with.ena.matrix
2		#' @description This function sets up a context using the provided data (typically an ENA matrix),
3		#' allowing the evaluation of an expression (`expr`) with access to both the matrix and
4		#' its metadata. Optionally, a custom matrix `V` and other arguments can be supplied.
5		#'
6		#' @param data An ENA matrix or data frame containing the data to be used.
7		#' @param expr An R expression to be evaluated within the context of the ENA matrix.
8		#' @param ... Additional arguments, including an optional custom matrix `V` and other parameters.
9		#'
10		#' @details
11		#' - If a custom matrix `V` is provided in `...`, it will be used; otherwise, `data` is converted to a matrix.
12		#' - Metadata columns are coerced to numeric if they are character vectors.
13		#' - The expression is evaluated with access to both the matrix (`V`) and metadata.
14		#'
15		#' @return The result of evaluating `expr` in the constructed context.
16		#'
17		#' @export
18		with.ena.matrix <- function(data, expr, ...) {
19	!	dot_args <- list(...);
20
21		# Points
22	!	V <- NULL;
23	!	if(length(dot_args) > 0 && !is.null(dot_args$V)) {
24	!	V <- dot_args$V;
25		}
26		else {
27	!	V <- as.matrix(data);
28		}
29
30		# Meta data
31	!	x <- unclass(data);
32	!	l <- lapply(x, function(i_val) {
33		# i_val <- get(i);
34	!	if(is.character(i_val)) {
35	!	i_val <- as.numeric(as.factor(i_val));
36		}
37	!	return(i_val);
38		});
39
40		# frm <- dot_args$frm;
41		# if(!is(frm, "formula")) {
42		# frm <- formula(frm);
43		# }
44
45	!	l$V <- V;
46		# with(l, {
47		# lm(formula = frm)
48		# })
49
50	!	ll <- c(l, dot_args);
51	!	eval(substitute(expr), ll, enclos = parent.frame());
52		# lm(formula = frm, data = l)
53		}
54
55		###
56		#' @title ENA Rotate by regression (second way)
57		#'
58		#' @description This function allows user to provide a regression formula for rotation on x and optionally on y.
59		#' If regression formula for y is not provide, svd is applied to the residual data deflated by x to get y coordinates.
60		#' The regression formula should use ENA points as major predictors and a binary or numerical variable as dependent variable.
61		#' Control and interaction variables are allowed to be included as predictors in the formula.
62		#'
63		#' @param enaset An \code{\link{ENAset}}
64		#' @param params list of parameters, may include:
65		#' x_var: Regression formula for x direction, such as "lm(formula= Condition ~ V + GameHalf + Condition : GameHalf)",
66		#' where V always stands for the ENA points.
67		#' y_var: Regression formula, similar to x_var for y direction (optional).
68		#'
69		#' @export
70		#' @return \code{\link{ENARotationSet}}
71		ena.rotate.by.hena.regression_2 = function( enaset, params ) {
72
73		# check arguments
74	!	if ( !is.list(params) \|\| is.null(params$x_var) ) {
75	!	stop("params must be provided as a list() and provide `x_var`")
76		}
77
78	!	x <- formula(params$x_var);
79
80	!	if (is.null(enaset$points.normed.centered)) {
81	!	p <- as.matrix(enaset$model$points.for.projection);
82		}
83		else {
84	!	p <- as.matrix(enaset$points.normed.centered);
85		}
86
87		#get variables
88	!	V <- as.matrix(p);
89	!	n <- ncol(V);
90
91		#regress to get v1 using x regression formula
92		# attach(enaset$meta.data,warn.conflicts = F)
93		# v1 <- eval(parse(text = x))$coefficients;
94		# v1_res <- with(enaset$model$points.for.projection, NULL, formula = x);
95	!	v1_res <- with.ena.matrix(enaset$model$points.for.projection, {
96	!	prm_var <- params$x_var;
97	!	prm <- if(is.character(prm_var))
98	!	prm_var
99		else
100	!	enquote(prm_var)
101		;
102	!	vars <- all.vars(formula(prm));
103	!	all_exists <- sapply(vars, function(x) x == "V" \|\| exists(x))
104	!	if(!all(all_exists)) {
105	!	stop(paste0("The following columns in the formula are not found in the unique metadata for the units: ", paste0(vars[!all_exists], collapse = ", ")))
106		}
107	!	lm(formula(prm));
108		});
109	!	v1 <- v1_res$coefficients;
110
111		# remove intercept
112	!	if(is.null(dim(v1))) {
113	!	v1 <- v1[2:(n+1)];
114		}
115		else {
116	!	v1 <- v1[2,];
117		}
118
119		# make v1 a unit vector
120	!	norm_v1 <- sqrt(sum(v1 * v1));
121	!	if (norm_v1 != 0) {
122	!	v1 <- v1 / norm_v1;
123		}
124
125		# name v1 vector
126	!	if(is.na(all.vars(x)[2])) {
127	!	xName <- names(v1)[1];
128		}
129		else {
130	!	xName <- all.vars(x)[2];
131		}
132
133		# Save v1
134	!	R <- matrix(c(v1), ncol = 1);
135	!	colnames(R) <- c(paste0(xName,"_reg"));
136
137		#deflate matrix by x dimension
138	!	A <- as.matrix(p);
139	!	defA <- as.matrix(A) - as.matrix(A) %% v1 %% t(v1);
140
141		#if y formula is given, regress by y formula
142	!	if (!is.null(params$y_var)) {
143	!	y <- formula(params$y_var);
144
145		# regress to get v2 vector using formula y
146	!	V <- defA;
147
148	!	v2_res <- with.ena.matrix(enaset$model$points.for.projection, {
149	!	prm_var <- params$y_var;
150	!	prm <- if(is.character(prm_var))
151	!	prm_var
152		else
153	!	enquote(prm_var)
154		;
155	!	vars <- all.vars(formula(prm));
156	!	all_exists <- sapply(vars, function(x) x == "V" \|\| exists(x))
157	!	if(!all(all_exists)) {
158	!	stop(paste0("The following columns in the formula are not found in the unique metadata for the units: ", paste0(vars[!all_exists], collapse = ", ")))
159		}
160	!	lm(formula(prm));
161		});
162	!	v2 <- v2_res$coefficients;
163	!	v2 <- v2[2:length(v2)];
164
165		#make v2 a unit vector
166	!	norm_v2 <- sqrt(sum(v2 * v2));
167
168	!	if (norm_v2 != 0) {
169	!	v2 <- v2 / norm_v2;
170		}
171
172		#name v2 vector
173	!	if(is.na(all.vars(y)[2])) {
174	!	yName <- names(v2)[1];
175		}
176		else {
177	!	yName <- all.vars(y)[2];
178		}
179
180		# save both v1 and v2
181	!	R <- cbind(v1, v2);
182	!	colnames(R) <- c(paste0(xName,"_reg"), paste0(yName,"_reg"));
183
184		#deflat by v2
185	!	defA <- as.matrix(defA) - as.matrix(defA) %% v2 %% t(v2);
186		}
187
188		# get svd for deflated points
189	!	svd_result <- prcomp(defA, retx=FALSE, scale=FALSE, center=FALSE, tol=0);
190	!	svd_v <- svd_result$rotation;
191
192		# Merge rotation vectors
193	!	vcount <- ncol(R);
194	!	colNamesR <- colnames(R);
195	!	combined <- cbind(R, svd_v[, 1:(ncol(svd_v) - vcount)]);
196	!	colnames(combined) <- c(
197	!	colNamesR,
198	!	paste0("SVD", ((vcount + 1):ncol(combined)))
199		);
200
201		#create rotation set
202	!	rotation_set <- ENARotationSet$new(
203	!	node.positions = NULL,
204	!	rotation = combined,
205	!	codes = enaset$rotation$codes,
206	!	eigenvalues = NULL
207		)
208
209	!	return(rotation_set);
210		}
211

1		.onLoad <- function(libname, pkgname) {
2	!	globalVariables(c(
3	!	".","ENA_ROW_IDX","ENA_UNIT","V1","V2","V3",
4	!	"ci.x","ci.y","e","handle","name","unit.groups",
5	!	"V","graph_from_data_frame","\|>","X1","X2",
6	!	"dfDT.points","points.raw","lines","KEYCOL","ENA_CONV",
7	!	"..groupCol","..units","..metadata", "..codes", "..conversation","ENA_GROUP_NAME",
8	!	"label.font.color","label.font.family","label.font.size",
9	!	"label.offset","legend.include.edges","legend.name",
10	!	"network.edges.shapes","nodes","rows.to.keep","show.legend",
11	!	"..connection_name", "..dimension_names", "..first_meta",
12	!	"..codeNames", "..conversation_cols",
13	!	"count","window","entropy","ground_type","n_obs","n_unique",
14	!	"method","n_conversations",".group"
15		))
16		# op <- options()
17		# op.rENA <- list(
18		# UNIT_NAMES = "ena.unit.names",
19		# TRAJ_TYPES = c("accumulated","non-accumulated")
20		# );
21		#
22		# toset <- !("rENA" %in% names(op))
23		# print(paste("ToSet:", toset));
24		#
25		# if(toset) {
26		# options(rENA = op.rENA)
27		# }
28		#
29		# invisible()
30		}
31
32		.onAttach <- function(libname, pkgname) {
33	2x	packageStartupMessage("For the latest features and updates, install from https://cran.qe-libs.org");
34	2x	invisible();
35		}

1		## ── qeviz backend for the ena.plot.* layer functions ─────────────────────────
2		##
3		## With ena.plot(backend = "qeviz"), ena.plot.network() / ena.plot.points() /
4		## ena.plot.group() hand off to the functions here, which add layers to the
5		## ENAplot's qeviz::qe_plot() ($qe) instead of plotly traces. The mapping is
6		## documented in qeviz's docs/rena-qeviz-backend.md.
7		##
8		## Arguments qeviz cannot honour warn once per session when they change the
9		## picture (see .qe_ignored()); plotly-only layout options are ignored quietly.
10		## ─────────────────────────────────────────────────────────────────────────────
11
12		.qe_backend <- function(enaplot) {
13	89x	!is.null(enaplot) && is(enaplot, "ENAplot") && identical(enaplot$get("backend"), "qeviz")
14		}
15
16		.qe_warned <- new.env(parent = emptyenv())
17
18		# Warn once per session for each supplied argument qeviz ignores.
19		.qe_ignored <- function(fn, supplied, args, why) {
20	56x	for (a in intersect(args, supplied)) {
21	3x	key <- paste(fn, a, sep = "::")
22	1x	if (isTRUE(.qe_warned[[key]])) next
23	2x	assign(key, TRUE, envir = .qe_warned)
24	2x	warning(sprintf("%s(): '%s' is ignored on the qeviz backend (%s).", fn, a, why),
25	2x	call. = FALSE)
26		}
27		}
28
29		# Colours as hex (qeviz derives complements from hex; rENA passes names / I()).
30		.qe_hex <- function(colors) {
31	!	if (is.null(colors)) return(NULL)
32	26x	cols <- as.character(unclass(colors))
33	26x	m <- grDevices::col2rgb(cols, alpha = FALSE)
34	26x	stats::setNames(grDevices::rgb(m[1, ], m[2, ], m[3, ], maxColorValue = 255), names(colors))
35		}
36
37		# Plot-wide label fonts, applied only when a layer call supplied them.
38		.qe_fonts <- function(qe, supplied, size, family, color) {
39	29x	args <- list(qe)
40	!	if ("label.font.size" %in% supplied) args$font_size <- size
41	!	if ("label.font.family" %in% supplied) args$font_family <- family
42	!	if ("label.font.color" %in% supplied) args$font_color <- color
43	!	if (length(args) > 1) do.call(qeviz::qe_labels, args) else qe
44		}
45
46		# Points in rENA's accepted forms (ena.points, data.frame / matrix, a numeric
47		# vector for one point) -> id + the first two dimension columns, named as the
48		# model's axes so qeviz reads them.
49		.qe_point_df <- function(points, enaplot, ids = NULL) {
50	10x	m <- enaplot$qe$model
51	1x	if (is.numeric(points) && is.null(dim(points))) points <- matrix(points, nrow = 1)
52	10x	unit <- if (!is.null(ids)) as.character(ids)
53	10x	else if (is.data.frame(points) && "ENA_UNIT" %in% names(points)) as.character(points$ENA_UNIT)
54	10x	else if (!is.null(rownames(points))) rownames(points)
55	10x	else NULL
56	10x	dims <- as.data.frame(if (is(points, "ena.points") \|\| is.data.table(points)) remove_meta_data(points)
57	10x	else points, check.names = FALSE)
58	10x	dims <- dims[, vapply(dims, is.numeric, logical(1)), drop = FALSE]
59	!	if (ncol(dims) < 2) stop("points need at least two dimension columns.", call. = FALSE)
60	10x	out <- data.frame(id = if (is.null(unit)) as.character(seq_len(nrow(dims))) else unit,
61	10x	stringsAsFactors = FALSE)
62	10x	names(out) <- m$id_col
63	10x	out[[m$x_col]] <- as.numeric(dims[[1]])
64	10x	out[[m$y_col]] <- as.numeric(dims[[2]])
65	10x	out
66		}
67
68		# ── ena.plot.network ─────────────────────────────────────────────────────────
69		.qe_plot_network <- function(enaplot, supplied, network, node.positions, adjacency.key,
70		colors, edge_type, show.all.nodes, threshold,
71		thin.lines.in.front, layers, labels,
72		label.font.size, label.font.color, label.font.family,
73		legend.name, dots) {
74	21x	fn <- "ena.plot.network"
75	21x	.qe_ignored(fn, supplied,
76	21x	c("thickness", "opacity", "saturation", "scale.range", "node.size", "scale.weights"),
77	21x	"qeviz's model-wide width and colour scaling replaces them")
78	21x	.qe_ignored(fn, supplied, c("label.offset", "legend.include.edges"), "not supported")
79	21x	if ("edge_type" %in% supplied && !identical(edge_type, "line"))
80	1x	.qe_ignored(fn, "edge_type", "edge_type", "edges are always solid lines")
81	21x	if ("thin.lines.in.front" %in% supplied && isFALSE(thin.lines.in.front))
82	!	.qe_ignored(fn, "thin.lines.in.front", "thin.lines.in.front", "thin lines are always drawn on top")
83
84	21x	qe <- enaplot$qe
85	21x	if (is.data.frame(network) \|\| is.matrix(network)) {
86	!	nw <- as.data.frame(network, check.names = FALSE)
87	!	network <- colMeans(as.matrix(nw[, vapply(nw, is.numeric, logical(1)), drop = FALSE]))
88		}
89	21x	network <- stats::setNames(as.numeric(unclass(network)), names(network))
90		# Same length rule as the plotly path: one weight per pair of nodes, or per
91		# pair plus each node's self-connection (upper triangle with the diagonal).
92	21x	n_nodes <- NROW(node.positions)
93	21x	n_self <- n_nodes * (n_nodes + 1) / 2
94	21x	if (!length(network) %in% c(choose(n_nodes, 2), n_self))
95	2x	stop(paste0("Network vector needs to be of length ", choose(n_nodes, 2),
96	2x	" (or ", n_self, " with self-connections)"), call. = FALSE)
97		# Unnamed weights follow the adjacency key, exactly as the plotly path reads
98		# them: the key given, else the one implied by node.positions' codes.
99	19x	if (!is.null(adjacency.key) \|\| is.null(names(network))) {
100	2x	codes <- if (is(node.positions, "ena.nodes")) as.character(node.positions$code)
101	2x	else rownames(node.positions)
102	2x	key <- as.matrix(if (!is.null(adjacency.key)) adjacency.key
103	2x	else namesToAdjacencyKey(codes, diagonal = length(network) == n_self &&
104	2x	n_self != choose(n_nodes, 2)))
105	2x	names(network) <- paste(key[1, ], key[2, ], sep = " & ")
106		}
107
108	19x	if ("node.positions" %in% supplied)
109	!	qe <- qeviz::qe_nodes(qe, positions = node.positions)
110	19x	if ("labels" %in% supplied && !is.null(labels)) {
111	1x	codes <- if (is(node.positions, "ena.nodes")) as.character(node.positions$code)
112	1x	else rownames(node.positions)
113	1x	qe <- qeviz::qe_nodes(qe, labels = stats::setNames(as.character(labels), codes))
114		}
115	19x	show <- if (!"edges" %in% layers) "always" else if (!"nodes" %in% layers) "never" else "auto"
116	19x	qe <- qeviz::qe_nodes(qe, show = show, unconnected = if (isFALSE(show.all.nodes)) "hide" else "dot")
117	1x	if (isTRUE(dots$labels.hide)) qe <- qeviz::qe_labels(qe, nodes = "off")
118
119	19x	thr <- threshold[is.finite(threshold)]
120	18x	if (!length(thr) \|\| (length(thr) == 1 && thr[1] <= 0)) thr <- NULL
121		# Magnification: a layer's own (add_network(edge.multiplier)), else the
122		# plot's (ena.plotter multipliers), else ena.plot(multiplier) relative to
123		# rENA's default of 5.
124	19x	mult <- enaplot$get("multiplier")
125	19x	magnify <- if (!is.null(dots$magnify)) dots$magnify
126	19x	else if (!is.null(enaplot$get("magnify"))) enaplot$get("magnify")
127	19x	else if (!is.null(mult) && mult != 5) mult / 5
128	19x	if ("edges" %in% layers)
129	16x	qe <- qeviz::qe_edges(qe, weights = network, colors = unname(.qe_hex(colors)),
130	16x	threshold = thr, name = legend.name, magnify = magnify)
131	19x	enaplot$qe <- .qe_fonts(qe, supplied, label.font.size, label.font.family, label.font.color)
132	19x	enaplot
133		}
134
135		# ── ena.plot.points ──────────────────────────────────────────────────────────
136		.qe_plot_points <- function(enaplot, supplied, points, point.size, labels, shape, colors,
137		label.font.size, label.font.color, label.font.family, texts,
138		legend.name) {
139	3x	fn <- "ena.plot.points"
140	3x	.qe_ignored(fn, supplied, c("confidence.interval.values", "outlier.interval.values",
141	3x	"confidence.interval", "outlier.interval"),
142	3x	"per-point intervals are not supported; use ena.plot.group() for means")
143	3x	.qe_ignored(fn, supplied, c("label.offset", "label.group", "show.legend"), "not supported")
144	!	if (is.null(points)) points <- enaplot$enaset$points
145	3x	df <- .qe_point_df(points, enaplot,
146	3x	ids = if (!is.null(labels) && length(labels) == NROW(points) &&
147	3x	!(is.numeric(points) && is.null(dim(points)))) labels)
148	3x	qe <- qeviz::qe_points(enaplot$qe, points = df,
149	3x	color = unname(.qe_hex(colors)),
150	3x	shape = if ("shape" %in% supplied) shape,
151	3x	labels = if (!is.null(texts)) as.character(texts),
152	3x	size = if ("point.size" %in% supplied) point.size / 2,
153		# legend.name names the point set (add_points() passes
154		# one per group); calls with the same name replace it.
155	3x	name = if ("legend.name" %in% supplied) legend.name)
156	3x	enaplot$qe <- .qe_fonts(qe, supplied, label.font.size, label.font.family, label.font.color)
157	3x	enaplot
158		}
159
160		# ── ena.plot.group ───────────────────────────────────────────────────────────
161		.qe_plot_group <- function(enaplot, supplied, points, method, labels, colors, shape,
162		confidence.interval, outlier.interval,
163		label.font.size, label.font.color, label.font.family) {
164	8x	fn <- "ena.plot.group"
165	8x	if (!is.null(method) && !identical(method, "mean"))
166	1x	stop("ena.plot.group(): only method = \"mean\" is supported on the qeviz backend.",
167	1x	call. = FALSE)
168	!	if (is.null(points)) stop("Points must be provided.")
169	7x	.qe_ignored(fn, supplied, c("label.offset", "show.legend", "legend.name"), "not supported")
170	7x	if (identical(outlier.interval, "crosshairs"))
171	!	.qe_ignored(fn, "outlier.interval", "outlier.interval",
172	!	"crosshairs are not available for the outlier interval; it is drawn as a box")
173
174	7x	df <- .qe_point_df(points, enaplot)
175	7x	cols <- if ("colors" %in% supplied) .qe_hex(colors)
176		# rENA draws one mean per distinct colour when colors is given per point.
177	7x	split <- if (length(cols) == nrow(df) && length(unique(cols)) > 1) unique(cols) else NULL
178	7x	groups <- if (is.null(split)) list(list(rows = seq_len(nrow(df)), color = cols[1], label = labels[1]))
179	7x	else lapply(seq_along(split), function(k)
180	7x	list(rows = which(cols == split[k]), color = split[k],
181	7x	label = if (length(labels) >= k) labels[k]))
182	7x	qe <- enaplot$qe
183	7x	for (g in groups) {
184	8x	sub <- df[g$rows, , drop = FALSE]
185	8x	qe <- qeviz::qe_group(qe, points = sub, label = g$label, color = unname(g$color),
186	8x	shape = shape,
187	8x	intervals = if (nrow(sub) < 2) "none" else confidence.interval,
188	8x	outlier = nrow(sub) >= 2 && outlier.interval != "none")
189		}
190	7x	enaplot$qe <- .qe_fonts(qe, supplied, label.font.size, label.font.family, label.font.color)
191	7x	enaplot
192		}
193
194		# ── Multipliers (ena.plotter, ena.plot.subtraction, add_network) ─────────────
195		# The plotly path multiplies the weights. On qeviz the weights stay as they are
196		# (so they sit correctly on the model-wide colour scale) and the multiplier
197		# becomes the plot's magnification instead.
198	24x	.qe_weight_mult <- function(backend, k) if (identical(backend, "qeviz")) 1 else k
199		.qe_magnify <- function(backend, k, labelled = k != 1) {
200	3x	if (identical(backend, "qeviz") && isTRUE(labelled)) k else NULL
201		}
202
203		# ── check_range on qeviz ─────────────────────────────────────────────────────
204		# Same rule as the plotly path: grow the symmetric range to 1.2x the largest
205		# plotted point / mean when they exceed it, shrink when they use under half.
206		.qe_check_range <- function(x) {
207	1x	numbers <- as.numeric(sapply(x$plotted$points, function(p) max(abs(as.matrix(remove_meta_data(p$data[[1]]))))))
208	1x	means <- as.numeric(sapply(x$plotted$means, function(p) max(abs(as.numeric(p$data)))))
209	!	if (!length(numbers) && !length(means)) return(x)
210	1x	curr_max <- max(c(numbers, means))
211	1x	m <- x$qe$model
212	1x	current <- x$qe$graph_opts[["range"]]
213	1x	current <- if (is.numeric(current)) current else {
214	1x	nodes <- do.call(rbind, lapply(m$nodes$data, function(r) c(r[[m$x_col]], r[[m$y_col]])))
215	1x	max(abs(nodes)) * 1.2
216		}
217	1x	if (curr_max * 1.2 > current \|\| curr_max < current * 0.5)
218	1x	x$qe <- qeviz::qe_range(x$qe, curr_max * 1.2)
219	1x	x
220		}
221
222		# ── Trajectories / movies: plotly only ───────────────────────────────────────
223		# Not drawn on the qeviz backend (qeviz has no trajectories yet). The call is a
224		# no-op with a warning; the plotly path is unchanged.
225		.qe_no_trajectories <- function(fn) {
226	4x	warning(structure(class = c("rENA_qeviz_unsupported", "warning", "condition"), list(
227	4x	message = sprintf(paste0("%s() is not drawn on the qeviz backend; the plot is returned ",
228	4x	"unchanged. Use ena.plot(..., backend = \"plotly\") for trajectories."), fn),
229	4x	call = NULL)))
230		}

1		accumulate.data <- function(enadata) {
2	147x	dfDT <- enadata$raw;
3
4	147x	units.used <- enadata$get("units.used")
5	147x	units.by <- enadata$get("units.by")
6	147x	trajectory.by <- enadata$get("trajectory.by")
7	147x	codes <- enadata$codes
8
9	147x	if (is.data.frame(codes)) {
10	1x	codes <- colnames(codes);
11		}
12
13	147x	conversations.by <- enadata$get("conversations.by")
14	147x	window <- enadata$get("window.size")
15		# binaryStanzas <- F
16	147x	units.exclude <- enadata$get("units.exclude")
17
18	147x	if(is.null(trajectory.by)) {
19	147x	trajectory.by = conversations.by
20		}
21
22		### should work to determine if binary is desired
23	147x	binary <- T;
24	147x	if (!identical(enadata$get("weight.by"), "binary")) {
25	14x	binary <- F
26		}
27		else {
28	133x	binary <- T
29		}
30
31		### We need data
32	147x	if (is.null(dfDT) \|\| nrow(dfDT) < 1) {
33	1x	stop("The provided data is NULL")
34		}
35
36		###
37		# We need a data.table, it's worth it.
38		###
39	146x	if(!data.table::is.data.table(dfDT)) {
40	1x	dfDT <- data.table::as.data.table(dfDT)
41		}
42
43		###
44		# Make a copy of the data for safe usage
45		###
46	146x	dfDT_codes <- data.table::copy(dfDT)
47
48		###
49		# Create a column representing the ENA_UNIT as defined
50		# by the the `units.by` parameter
51		###
52	146x	if(!"ENA_UNIT" %in% colnames(dfDT_codes)) {
53	1x	dfDT_codes$ENA_UNIT <- enadata$raw$ENA_UNIT <- merge_columns_c(
54	1x	dfDT_codes,
55	1x	cols = units.by, sep = "::"
56		)
57		}
58
59		##
60		# String vector of codesnames representing the names of the co-occurrences
61		##
62	146x	vL <- length(codes);
63	146x	adjacency.length <- ( (vL * (vL + 1)) / 2) - vL ;
64	146x	codedTriNames <- paste("adjacency.code",rep(1:adjacency.length), sep=".");
65
66	146x	initial_cols <- c(units.by, codes)
67	146x	just_codes <- c(codes)
68
69		##
70		# Accumulated windows appended to the end of each row
71		#
72		# FIXME: Don't append on the results to the initial data.table,
73		# keep a separate to lookup the results for the co-occurred
74		# values later on.
75		##
76	146x	if (window$back == 1 && window$forward == 0) {
77	49x	dfDT.co.occurrences <- dfDT_codes[,{
78	49x	ocs <- data.table::as.data.table(
79	49x	rows_to_co_occurrences(
80	49x	.SD[,.SD,.SDcols=codes, with=T],
81	49x	binary = binary
82		)
83		);
84
85		# Return value from data.table back to dfDT.co.occurrences
86	49x	data.table::data.table(.SD, ocs)
87		},
88	49x	.SDcols = c(codes, conversations.by, trajectory.by),
89	49x	with = T
90		]
91
92		### Generate the ENA_UNIT column
93	49x	dfDT.co.occurrences$ENA_UNIT <- dfDT_codes$ENA_UNIT
94
95		### Keep original columns used for units
96	49x	dfDT.co.occurrences[, (units.by) := dfDT_codes[, .SD, .SDcols = units.by]]
97		}
98	97x	else if (window$back == "Conversation") {
99		###
100		# First sum all lines by conversation and unit to get vectors of codes
101		# occurring in the whole conversation for each unit
102		###
103	2x	dfDT.conv.sum <- dfDT_codes[,
104	2x	lapply(.SD, sum), by = c(unique(conversations.by)),
105	2x	.SDcols = c(codes),
106	2x	with = T
107		]
108
109		###
110		# Convert each units converstation sums into adjacency vectors
111		###
112		# browser()
113	2x	dfDT.co.occurrences <- dfDT.conv.sum[,{
114	2x	ocs = data.table::as.data.table(rows_to_co_occurrences(.SD[,.SD,.SDcols=codes, with=T], binary = binary));
115	2x	data.table::data.table(.SD,ocs, ENA_UNIT=merge_columns_c(.SD, cols = units.by, sep="::"))
116		},
117	2x	.SDcols=unique(c(codes, conversations.by, trajectory.by, units.by)),
118	2x	with=T
119		];
120		}
121		else {
122		## parallell: https://stackoverflow.com/questions/14759905/data-table-and-parallel-computing
123		### Calculate occurrences of code within the provided window
124
125		# if(enadata$function.params$in.par == T) {
126		# grainSize = ifelse(!is.null(enadata$function.params$grainSize), enadata$function.params$grainSize, 10);
127		# dfDT.co.occurrences = dfDT_codes[,
128		# (codedTriNames) := try_one(
129		# .SD[,.SD, .SDcols=just_codes],
130		# window=window$back,
131		# binary = binary,
132		# grainSize = grainSize
133		# ),
134		# by=conversations.by,
135		# .SDcols=initial_cols,
136		# with=T
137		# ];
138		#
139		# } else {
140		# ,binaryStanzas = binaryStanzas
141	95x	dfDT.co.occurrences <- dfDT_codes[,
142	95x	(codedTriNames) := ref_window_df(
143	95x	.SD[, .SD, .SDcols = just_codes],
144	95x	windowSize = window$back,
145	95x	windowForward = window$forward,
146	95x	binary = binary
147		),
148	95x	by = conversations.by,
149	95x	.SDcols = initial_cols,
150	95x	with = T
151		];
152		# }
153		}
154		# browser()
155
156	146x	if( is.function(enadata$get("weight.by")) ) {
157	10x	cols <- colnames(dfDT.co.occurrences)[
158	10x	grep("adjacency.code", colnames(dfDT.co.occurrences))
159		]
160	10x	dfDT.co.occurrences <- dfDT.co.occurrences[,
161	10x	(cols) := lapply(
162	10x	.SD,
163	10x	enadata$get("weight.by")
164		),
165	10x	.SDcols = cols,
166	10x	by = 1:nrow(dfDT.co.occurrences)
167		]
168		}
169
170
171		###
172		# Convert the generic `V` names to corresponding `adjacency.vector` names
173		###
174	146x	vCols <- grep("V\\d+", colnames(dfDT.co.occurrences))
175	146x	if(length(vCols) == length(codedTriNames)) {
176	51x	colnames(dfDT.co.occurrences)[vCols] <- codedTriNames
177		}
178
179		##
180		# If units aren't supplied, use all available
181		##
182	146x	if (is.null(units.used)) {
183	146x	units.used <- dfDT_codes$ENA_UNIT
184		}
185
186
187		###
188		# Trajectory Checks
189		###
190
191		## Not a Trajectory
192	146x	if (enadata$model == "EndPoint") {
193		###
194		# Sum each unit found in dfDT.co.occurrences
195		###
196	134x	dfDT.summed.units <- dfDT.co.occurrences[ENA_UNIT %in% units.used,lapply(.SD,sum),by=units.by,.SDcols=codedTriNames]
197	134x	dfDT.summed.units$ENA_UNIT <- merge_columns_c(dfDT.summed.units, units.by, sep="::");
198
199	134x	enadata$unit.names <- dfDT.summed.units$ENA_UNIT;
200		}
201		## Trajectory
202		else {
203		## First sum all units within each Trajectory Group (trajectory.by)
204	12x	dfDT.summed.traj.by <- dfDT.co.occurrences[
205	12x	ENA_UNIT %in% units.used,
206		{
207	2128x	sums <- lapply(.SD, sum)
208	2128x	data.frame(ENA_ROW_IDX = .GRP, sums); # Return value
209		},
210	12x	by = c(units.by, trajectory.by),
211	12x	.SDcols = (codedTriNames)
212		];
213	12x	dfDT.summed.traj.by$ENA_UNIT <- merge_columns_c(
214	12x	dfDT.summed.traj.by, units.by, sep = "::"
215		)
216	12x	dfDT.summed.traj.by$TRAJ_UNIT <- merge_columns_c(
217	12x	dfDT.summed.traj.by, trajectory.by, sep = "::"
218		);
219
220	12x	enadata$trajectories$step <- dfDT.summed.traj.by$TRAJ_UNIT;
221
222		# Accumulated
223	12x	if (enadata$model == opts$TRAJ_TYPES[1]) {
224	7x	dfDT.summed.units <- dfDT.summed.traj.by[
225	7x	ENA_UNIT %in% unique(units.used), {
226	198x	cols <- colnames(.SD)
227	198x	ENA_UNIT <- paste(as.character(.BY), collapse = "::")
228	198x	TRAJ_UNIT <- .SD[, c(trajectory.by), with = F]
229	198x	inc_cols <- cols[! cols %in% c(trajectory.by, "ENA_ROW_IDX")]
230	198x	lag <- ref_window_lag(.SD[, .SD, .SDcols = inc_cols], .N)
231
232	198x	data.table::data.table(
233	198x	ENA_ROW_IDX,
234	198x	TRAJ_UNIT, lag, ENA_UNIT = ENA_UNIT
235		)
236		},
237	7x	by = c(units.by),
238	7x	.SDcols = c(codedTriNames, trajectory.by, "ENA_ROW_IDX")
239		]
240	7x	dfDT.summed.units$TRAJ_UNIT <- merge_columns_c(
241	7x	dfDT.summed.units, trajectory.by, sep = "::"
242		)
243		}
244		# Non-accumulated
245	5x	else if (enadata$model == opts$TRAJ_TYPES[2]) {
246	3x	dfDT.summed.units <- dfDT.summed.traj.by;
247		}
248		else {
249	2x	stop("Unsupported Model type.");
250		}
251
252	10x	dfDT.summed.units$ENA_UNIT <- merge_columns_c(
253	10x	dfDT.summed.units, units.by, sep = "::"
254		)
255		}
256		###
257		# END: Trajectory Checks
258		###
259
260		###
261		# Name the rows and columns accordingly
262		###
263	144x	colnames(dfDT.summed.units)[
264	144x	grep("V\\d+", colnames(dfDT.summed.units))
265	144x	] <- codedTriNames
266
267		###
268		# Set attributes
269		#
270		# TODO Most of this should be moved to a more prominent spot on ENAdata
271		###
272	144x	adjRows <- triIndices(length(codes)) + 1
273	144x	codedRow1 <- codes[adjRows[1, ]]
274	144x	codedRow2 <- codes[adjRows[2, ]]
275	144x	attr(dfDT.summed.units, "adjacency.matrix") <- rbind(codedRow1, codedRow2)
276	144x	attr(dfDT.summed.units, "adjacency.codes") <- codedTriNames
277	144x	attr(dfDT.summed.units, opts$UNIT_NAMES) <- dfDT.summed.units[,
278	144x	.SD, with = T, .SDcols = units.by]
279
280	144x	enadata$adjacency.matrix <- rbind(codedRow1, codedRow2)
281	144x	enadata$accumulated.adjacency.vectors <- dfDT.co.occurrences
282	144x	enadata$adjacency.vectors <- dfDT.summed.units
283		###
284		# END: Set attributes
285		###
286
287	144x	return(enadata);
288		}

1		##
2		#' @title Plot of ENA set groups
3		#'
4		#' @description Plot a point based on a summary statistic computed from a given method (typically, mean) for a set of points in a projected ENA space
5		#'
6		#' @details Plots a point based on a summary statistic for a group (typically, mean)
7		#'
8		#' @export
9		#'
10		#' @param enaplot \code{\link{ENAplot}} object to use for plotting
11		#' @param points A matrix or data.frame where columns contain coordinates of points in a projected ENA space
12		#' @param method A function for computing a summary statistic for each column of points
13		#' @param labels A character which will be the label for the group's point
14		#' @param colors A character, determines color of the group's point, default: enaplot$color
15		#' @param shape A character, determines shape of the group's point, choices: square, triangle, diamond, circle, default: square
16		#' @param confidence.interval A character that determines how the confidence interval is displayed, choices: none, box, crosshair, default: none
17		#' @param outlier.interval A character that determines how outlier interval is displayed, choices: none, box, crosshair, default: none
18		#' @param label.offset character: top left (default), top center, top right, middle left, middle center, middle right, bottom left, bottom center, bottom right
19		#' @param label.font.size An integer which determines the font size for label, default: enaplot$font.size
20		#' @param label.font.color A character which determines the color of label, default: enaplot$font.color
21		#' @param label.font.family A character which determines font type, choices: Arial, Courier New, Times New Roman, default: enaplot$font.family
22		#' @param show.legend Logical indicating whether to show the point labels in the in legend
23		#' @param legend.name Character indicating the name to show above the plot legend
24		#' @param ... Additional parameters
25		#'
26		#' @seealso \code{\link{ena.plot}}, \code{ena.plot.points}
27		#'
28		#' @examples
29		#' data(RS.data)
30		#'
31		#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
32		#' 'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
33		#'
34		#' accum = ena.accumulate.data(
35		#' units = RS.data[,c("UserName","Condition")],
36		#' conversation = RS.data[,c("Condition","GroupName")],
37		#' metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post")],
38		#' codes = RS.data[,codeNames],
39		#' window.size.back = 4
40		#' )
41		#'
42		#' set = ena.make.set(
43		#' enadata = accum,
44		#' rotation.by = ena.rotate.by.mean,
45		#' rotation.params = list(
46		#' accum$meta.data$Condition=="FirstGame",
47		#' accum$meta.data$Condition=="SecondGame"
48		#' )
49		#' )
50		#'
51		#' plot = ena.plot(set)
52		#'
53		#' unitNames = set$enadata$units
54		#'
55		#' ### Plot Condition 1 Group Mean
56		#' plot = ena.plot.group(plot, as.matrix(set$points$Condition$FirstGame), labels = "FirstGame",
57		#' colors = "red", confidence.interval = "box")
58		#'
59		#' ### plot Condition 2 Group Mean
60		#' plot = ena.plot.group(plot, as.matrix(set$points$Condition$SecondGame), labels = "SecondGame",
61		#' colors = "blue", confidence.interval = "box")
62		#'
63		#' print(plot);
64		#'
65		#' @return The \code{\link{ENAplot}} provided to the function, with its plot updated to include the new group point.
66		##
67		ena.plot.group <- function(
68		enaplot,
69		points = NULL,
70		method = "mean",
71		labels = NULL,
72		colors = default.colors[1],
73		shape = c("square", "triangle-up", "diamond", "circle"),
74		confidence.interval = c("none", "crosshairs", "box"),
75		outlier.interval = c("none", "crosshairs", "box"),
76		label.offset = "bottom right",
77		label.font.size = NULL,
78		label.font.color = NULL,
79		label.font.family = NULL,
80		show.legend = T,
81		legend.name = NULL,
82		...
83		) {
84	11x	shape = match.arg(shape);
85	11x	confidence.interval = match.arg(confidence.interval);
86	11x	outlier.interval = match.arg(outlier.interval);
87
88	11x	if (.qe_backend(enaplot))
89	8x	return(.qe_plot_group(enaplot, supplied = names(match.call())[-1],
90	8x	points = points, method = method, labels = labels, colors = colors, shape = shape,
91	8x	confidence.interval = confidence.interval, outlier.interval = outlier.interval,
92	8x	label.font.size = label.font.size, label.font.color = label.font.color,
93	8x	label.font.family = label.font.family))
94
95	3x	if(is.null(points)) {
96	1x	stop("Points must be provided.");
97		}
98	2x	else if(is(points, "ena.points")) {
99	2x	points = remove_meta_data(points)
100		}
101
102		### problem if outlier and confidence intervals selected for crosshair
103	2x	if(confidence.interval == "crosshairs" && outlier.interval == "crosshairs") {
104	1x	message("Confidence Interval and Outlier Interval cannot both be crosshair. Plotting Outlier Interval as box");
105	1x	outlier.interval = "box";
106		}
107
108		### if group more than one row, combine to mean
109	2x	confidence.interval.values = NULL;
110	2x	outlier.interval.values = NULL;
111		if(
112	2x	(is(points, "data.frame") \|\| is(points, "matrix")) &&
113	2x	nrow(points) > 1
114		) {
115	2x	if(is.null(method) \|\| method == "mean") {
116	2x	if(confidence.interval != "none") {
117	1x	confidence.interval.values = matrix(
118	1x	c(as.vector(t.test(points[,1], conf.level = 0.95)$conf.int), as.vector(t.test(points[,2], conf.level = 0.95)$conf.int)),
119	1x	ncol=2
120		);
121		}
122	2x	if(outlier.interval != "none") {
123	1x	outlier.interval.values = c(IQR(points[,1]), IQR(points[,2])) * 1.5;
124	1x	outlier.interval.values = matrix(rep(outlier.interval.values, 2), ncol = 2, byrow = T) * c(-1, 1)
125		}
126
127	2x	if(length(unique(colors)) > 1) {
128	1x	points = t(sapply(unique(colors), function(color) colMeans(points[color == colors,]), simplify = T))
129	1x	colors = unique(colors)
130	1x	attr(enaplot, "means") <- length(attr(enaplot, "means")) + length(colors)
131		} else {
132	1x	points = colMeans(points);
133	1x	attr(enaplot, "means") <- length(attr(enaplot, "means")) + 1
134		}
135		}
136		else {
137	!	if(confidence.interval != "none") warning("Confidence Intervals can only be used when method=`mean`")
138	!	if(outlier.interval != "none") warning("Outlier Intervals can only be used when method=`mean`")
139
140	!	points = apply(points, 2, function(x) do.call(method, list(x)) )
141	!	attr(enaplot, "means") <- length(attr(enaplot, "means")) + 1
142		}
143		}
144
145	2x	enaplot <- ena.plot.points(
146	2x	enaplot,
147	2x	points = points,
148	2x	labels = labels,
149	2x	colors = colors,
150	2x	shape = shape,
151	2x	confidence.interval = confidence.interval,
152	2x	confidence.interval.values = confidence.interval.values,
153	2x	outlier.interval = outlier.interval,
154	2x	outlier.interval.values = outlier.interval.values,
155	2x	label.offset = label.offset,
156	2x	label.font.size = label.font.size,
157	2x	label.font.color = label.font.color,
158	2x	label.font.family = label.font.family,
159	2x	show.legend = show.legend,
160	2x	legend.name = legend.name,
161		...
162		)
163	2x	return(enaplot)
164
165		#
166		# group.layout = data.frame(dfDT.points);
167		#
168		# ### INTERVAL CALCULATIONS
169		# error = NULL;
170		# lines = list();
171		#
172		# if(confidence.interval == "crosshair") {
173		# ci.x = t.test(points.raw, conf.level = .95)$conf.int[1];
174		# ci.y = t.test(points.raw, conf.level = .95)$conf.int[2];
175		# error = list(
176		# x = list(type = "data", array = ci.x),
177		# y = list(type = "data", array = ci.y)
178		# )
179		# } else if(outlier.interval == "crosshair") {
180		# oi.x = IQR(points.raw$V1) * 1.5;
181		# oi.y = IQR(points.raw$V2) * 1.5;
182		# error = list(
183		# x = list(type = "data", array = oi.x),
184		# y = list(type = "data", array = oi.y)
185		# )
186		# }
187		#
188		# if(confidence.interval == "box") {
189		#
190		# conf.ints = t.test(points.raw, conf.level = .95)$conf.int;
191		# dfDT.points[,c("ci.x", "ci.y") := .(conf.ints[1], conf.ints[2])]
192		#
193		# #add cols for coordinates of CI lines
194		# dfDT.points[, c("ci.x1", "ci.x2", "ci.y1", "ci.y2") := .(V1 - ci.x, V1 + ci.x, V2 - ci.y, V2 + ci.y)]
195		#
196		# lines.CI = apply(dfDT.points,1,function(x) {
197		# list(
198		# "type" = "square",
199		# "line" = list(
200		# width = 1,
201		# color = color,
202		# dash="dash"
203		# ),
204		# "xref" = "x",
205		# "yref" = "y",
206		# "x0" = x[['ci.x1']],
207		# "x1" = x[['ci.x2']],
208		# "y0" = x[['ci.y1']],
209		# "y1" = x[['ci.y2']]
210		# );
211		# });
212		# lines = lines.CI;
213		# }
214		# if(outlier.interval == "box") {
215		#
216		# oi.x = IQR(points.raw$V1) * 1.5;
217		# oi.y = IQR(points.raw$V2) * 1.5;
218		#
219		# dfDT.points[,c("oi.x", "oi.y") := .(oi.x, oi.y)]
220		#
221		# #add cols for coordinates of CI lines
222		# dfDT.points[, c("oi.x1", "oi.x2", "oi.y1", "oi.y2") := .(V1 - oi.x, V1 + oi.x, V2 - oi.y, V2 + oi.y)]
223		#
224		# lines.OI = apply(dfDT.points,1,function(x) {
225		# list(
226		# "type" = "square",
227		# "line" = list(
228		# width = 1,
229		# color = color,
230		# dash="dash"
231		# ),
232		# "xref" = "x",
233		# "yref" = "y",
234		# "x0" = x[['oi.x1']],
235		# "x1" = x[['oi.x2']],
236		# "y0" = x[['oi.y1']],
237		# "y1" = x[['oi.y2']]
238		# );
239		# });
240		#
241		# lines = c(lines, lines.OI);
242		# }
243		#
244		#
245		# if(!is.null(error)) {
246		# #plot group w/ crosshair error bars
247		# enaplot$plot = plotly::add_trace(
248		# enaplot$plot,
249		# data = group.layout,
250		# type="scatter",
251		# x = ~V1, y = ~V2,
252		# mode="markers",
253		# marker = list(
254		# symbol = shape,
255		# color = color,
256		# size = size
257		# ),
258		# error_x = error$x,
259		# error_y = error$y,
260		# showlegend = F,
261		# text = label,
262		# hoverinfo = "text+x+y"
263		# )
264		# } else {
265		# #plot group w/o crosshair error bars
266		# enaplot$plot = plotly::add_trace(
267		# enaplot$plot,
268		# data = group.layout,
269		# type="scatter",
270		# x = ~V1, y = ~V2,
271		# mode="markers",
272		# marker = list(
273		# symbol = shape, #c(rep("circle",nrow(data)),rep("square", ifelse(!is.null(dfDT.groups), nrow(dfDT.groups), 0))),
274		# color = color,
275		# #size = c(rep(unit.size * unit.size.multiplier, nrow(data)), rep(group.size, ifelse(!is.null(dfDT.groups),nrow(dfDT.groups), 0)))
276		# size = size
277		# ),
278		# showlegend = F,
279		# text = label,
280		# hoverinfo = "text+x+y"
281		# )
282		# }
283		#
284		# ##### WEIGHTING OFFSET
285		# if(is.null(label.offset)) { label.offset = c(.05,.05) }
286		# else label.offset = c(label.offset[1] * 0.1, label.offset[2] * 0.1)
287		#
288		# enaplot$plot = plotly::add_annotations(
289		# enaplot$plot,
290		# x = group.layout$V1[1] + label.offset[1],
291		# y = group.layout$V2[1] + label.offset[2],
292		# text = label,
293		# font = text.info,
294		# xref = "x",
295		# yref = "y",
296		# ax = label.offset[1],
297		# ay = label.offset[2],
298		# #xanchor = "left",
299		# showarrow = F
300		# );
301		#
302		# enaplot$plot = plotly::layout(
303		# enaplot$plot,
304		# shapes = lines
305		# #annotations = label.info
306		# )
307		#
308		# return(enaplot);
309		}

1		#####
2		#' @title Plot of ENA trajectories
3		#'
4		#' @description Function used to plot trajectories
5		#'
6		#' @export
7		#'
8		#' @param enaplot \code{\link{ENAplot}} object to use for plotting
9		#' @param points dataframe of matrix - first two column are X and Y coordinates, each row is a point in a trajectory
10		#' @param by vector used to subset points into individual trajectories, length nrow(points)
11		#' @param names character vector - labels for each trajectory of points, length length(unique(by))
12		#' @param labels character vector - point labels, length nrow(points)
13		#' @param labels.show A character choice: Always, Hover, Both. Default: Both
14		#' @param colors A character vector, that determines marker color, default NULL results in
15		#' alternating random colors. If single color is supplied, it will be used for all
16		#' trajectories, otherwise the length of the supplied color vector should be equal
17		#' to the length of the supplied names (i.e a color for each trajectory being plotted)
18		#' @param shape A character which determines the shape of markers, choices: square, triangle, diamond, circle, default: circle
19		#' @param label.offset A numeric vector of an x and y value to offset labels from the coordinates of the points
20		#' @param label.font.size An integer which determines the font size for labels, default: enaplot$font.size
21		#' @param label.font.color A character which determines the color of label font, default: enaplot$font.color
22		#' @param label.font.family A character which determines font type, choices: Arial, Courier New, Times New Roman, default: enaplot$font.family
23		#' @param default.hidden A logical indicating if the trajectories should start hidden (click on the legend to show them) Default: FALSE
24		#' @param smooth Character choice: "none" (connect discrete points) or "poly" (fit orthogonal polynomial curve with LOOCV-2D). Default: "none"
25		#' @param poly.degree Fixed integer polynomial degree (default NULL = auto-select via LOOCV-2D / AIC)
26		#' @param poly.max.degree Maximum polynomial degree to search when auto-selecting (default: 3)
27		#' @param poly.criterion Criterion for polynomial degree selection: "loocv" or "aic"
28		#' @param poly.n.eval Number of evaluation points along the curve (default: 200)
29		#' @param show.points Logical: whether to display original discrete points when smooth = "poly" (default: TRUE)
30		#' @param show.curve Logical: whether to display smooth polynomial curve when smooth = "poly" (default: TRUE)
31		#'
32		#' @seealso \code{\link{ena.plot}}
33		#'
34		#' @examples
35		#' data(RS.data)
36		#'
37		#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
38		#' 'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
39		#'
40		#' accum = ena.accumulate.data(
41		#' units = RS.data[,c("UserName","Condition")],
42		#' conversation = RS.data[,c("GroupName","ActivityNumber")],
43		#' metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post","C.Change")],
44		#' codes = RS.data[,codeNames],
45		#' window.size.back = 4,
46		#' model = "A"
47		#' );
48		#'
49		#' set = ena.make.set(accum);
50		#'
51		#' ### get mean network plots
52		#' first.game.lineweights = as.matrix(set$line.weights$Condition$FirstGame)
53		#' first.game.mean = colMeans(first.game.lineweights)
54		#'
55		#' second.game.lineweights = as.matrix(set$line.weights$Condition$SecondGame)
56		#' second.game.mean = colMeans(second.game.lineweights)
57		#'
58		#' subtracted.network = first.game.mean - second.game.mean
59		#'
60		#' # Plot dimension 1 against ActivityNumber metadata
61		#' dim.by.activity = cbind(
62		#' as.matrix(set$points)[,1],
63		#' set$trajectories$ActivityNumber * .8/14-.4 #scale down to dimension 1
64		#' )
65		#'
66		#' plot = ena.plot(set)
67		#' plot = ena.plot.network(plot, network = subtracted.network, legend.name="Network")
68		#' plot = ena.plot.trajectory(
69		#' plot,
70		#' points = dim.by.activity,
71		#' names = unique(set$model$unit.label),
72		#' by = set$trajectories$ENA_UNIT
73		#' );
74		#' print(plot)
75		#'
76		#' @return The \code{\link{ENAplot}} provided to the function, with its plot updated to include the trajectories
77		#' #####
78		ena.plot.trajectory = function(
79		enaplot,
80		points,
81		by = NULL,
82		labels = NULL,
83		labels.show = c("Always","Hover","Both"),
84		names = NULL,
85		label.offset = NULL,
86		label.font.size = enaplot$get("font.size"),
87		label.font.color = enaplot$get("font.color"),
88		label.font.family = c("Arial", "Courier New", "Times New Roman"),
89		shape = c("circle", "square", "triangle-up", "diamond"),
90		colors = NULL,
91		default.hidden = FALSE,
92		smooth = c("none", "poly"),
93		poly.degree = NULL,
94		poly.max.degree = 3L,
95		poly.criterion = c("loocv", "aic"),
96		poly.n.eval = 200L,
97		show.points = TRUE,
98		show.curve = TRUE
99		) {
100	3x	if (.qe_backend(enaplot)) {
101	1x	.qe_no_trajectories("ena.plot.trajectory")
102	1x	return(enaplot)
103		}
104
105	2x	if(!is.character(label.font.family)) {
106	!	label.font.size = enaplot$get("font.family");
107		}
108	2x	labels.show <- match.arg(labels.show);
109	2x	shape <- match.arg(shape);
110	2x	smooth <- match.arg(smooth);
111	2x	poly.criterion <- match.arg(poly.criterion);
112
113	2x	if(is.null(by)) {
114	!	by <- list(all = rep(TRUE, nrow(points)));
115		}
116	2x	if (is.character(by) && length(by) == 1L && by %in% names(points)) {
117	!	by <- points[[by]]
118		}
119
120	2x	if (is(points, "ena.matrix") \|\| any(find_meta_cols(points))) {
121	!	clean_points <- remove_meta_data(points)
122		} else {
123	2x	clean_points <- points
124		}
125
126	2x	if(length(colors) == 1 && !is.null(names))
127	!	colors <- rep(colors, length(names))
128
129	2x	mode <- "lines+markers+text";
130	2x	hoverinfo <- "x+y";
131	2x	tbl <- data.table::as.data.table(clean_points);
132	2x	if (!is.null(labels)) {
133	!	if (labels.show %in% c("Always","Both"))
134	!	mode <- paste0(mode,"+text");
135	!	if (labels.show %in% c("Hover","Both"))
136	!	hoverinfo <- paste0(hoverinfo,"+text");
137
138	!	tbl[, labels := labels]
139		}
140
141	2x	if(!is.null(by)) {
142	2x	if(is.character(by) && length(by) == nrow(tbl))
143	2x	by <- as.factor(by)
144
145	2x	dfdt_trajs <- tbl[,{ data.table::data.table(lines = list(.SD)) }, by = by]
146		} else {
147	!	dfdt_trajs <- tbl[,{ data.table::data.table(lines = list(.SD)) }]
148		}
149
150	2x	valid_label_offsets = c("top left","top center","top right","middle left",
151	2x	"middle center","middle right","bottom left","bottom center",
152	2x	"bottom right")
153	2x	if(!all(label.offset %in% valid_label_offsets))
154	!	stop(sprintf( "Unrecognized label.offsets: %s",
155	!	paste(unique(label.offset[!(label.offset %in% valid_label_offsets)]),
156	!	collapse = ", ") ))
157
158	2x	if(length(label.offset) == 1)
159	!	label.offset = rep(label.offset, nrow(dfdt_trajs))
160
161	2x	if (!is.null(colors) &&
162	2x	length(colors) > 1 && !is.null(names) && length(colors) != length(names)
163		) {
164	!	stop("Length of the colors must be 1 or the same length as by")
165		}
166
167	2x	for (x in 1:nrow(dfdt_trajs)) {
168	4x	d <- as.data.frame(dfdt_trajs[x,]$lines[[1]])
169	4x	d.names <- colnames(d)
170	4x	traj_name <- if (!is.null(names) && length(names) >= x) names[x] else paste0("Trajectory ", x)
171	4x	traj_color <- if(!is.null(colors) && length(colors) >= x) colors[x] else NULL
172
173	4x	if (smooth == "poly" && nrow(d) >= 2L && ncol(d) >= 2L) {
174	2x	curve_fit <- .fit_etm_poly_curve(
175	2x	points = d[, 1:2, drop = FALSE],
176	2x	degree = poly.degree,
177	2x	max_degree = poly.max.degree,
178	2x	criterion = poly.criterion
179		)
180
181		# Smooth curve evaluation
182	2x	if (isTRUE(show.curve)) {
183	2x	curve_df <- .eval_etm_poly_curve(curve_fit, poly.n.eval)
184
185	2x	enaplot$plot = plotly::add_trace(
186	2x	enaplot$plot,
187	2x	data = curve_df,
188	2x	x = ~x,
189	2x	y = ~y,
190	2x	name = paste0(traj_name, " (fit deg ", curve_fit$degree, ")"),
191	2x	mode = "lines",
192	2x	hoverinfo = "none",
193	2x	showlegend = !isTRUE(show.points),
194	2x	line = list (
195	2x	color = traj_color,
196	2x	width = 2.5
197		),
198	2x	visible = ifelse(default.hidden, "legendonly", TRUE)
199		)
200		}
201
202		# Original discrete points
203	2x	if (isTRUE(show.points)) {
204	2x	pts_mode <- if (!is.null(labels) && labels.show %in% c("Always", "Both")) "markers+text" else "markers"
205	2x	enaplot$plot = plotly::add_trace(
206	2x	enaplot$plot,
207	2x	data = d,
208	2x	x = as.formula(paste0("~", d.names[1])),
209	2x	y = as.formula(paste0("~", d.names[2])),
210	2x	name = traj_name,
211	2x	mode = pts_mode,
212	2x	text = dfdt_trajs[x,]$lines[[1]]$labels,
213	2x	textposition = label.offset[x],
214	2x	hoverinfo = hoverinfo,
215	2x	showlegend = TRUE,
216	2x	marker = list (
217	2x	symbol = shape,
218	2x	color = traj_color,
219	2x	size = 6
220		),
221	2x	textfont = list (
222	2x	family = label.font.family,
223	2x	size = label.font.size,
224	2x	color = label.font.color
225		),
226	2x	visible = ifelse(default.hidden, "legendonly", TRUE)
227		)
228		}
229		} else {
230		# Standard piecewise linear trajectory
231	2x	enaplot$plot = plotly::add_trace(
232	2x	enaplot$plot,
233	2x	data = d,
234	2x	x = as.formula(paste0("~", d.names[1])),
235	2x	y = as.formula(paste0("~", d.names[2])),
236	2x	name = traj_name,
237	2x	mode = mode,
238	2x	text = dfdt_trajs[x,]$lines[[1]]$labels,
239	2x	textposition = label.offset[x],
240	2x	hoverinfo = hoverinfo,
241	2x	showlegend = TRUE,
242	2x	line = list (
243	2x	color = traj_color
244		),
245	2x	marker = list (
246	2x	symbol = shape,
247	2x	color = traj_color
248		),
249	2x	textfont = list (
250	2x	family = label.font.family,
251	2x	size = label.font.size,
252	2x	color = label.font.color
253		),
254	2x	visible = ifelse(default.hidden, "legendonly", TRUE)
255		);
256		}
257		}
258
259	2x	enaplot$plotted$trajectories[[
260	2x	length(enaplot$plotted$trajectories) + 1
261	2x	]] <- dfdt_trajs
262
263	2x	return(enaplot);
264		}

1		#' Compute Between-Group Scatter Matrix
2		#'
3		#' This function calculates the between-group scatter matrix (\code{SB}) for a given numeric matrix and grouping variable.
4		#'
5		#' @param A A numeric matrix of dimensions \code{m x n}, where rows represent observations and columns represent features.
6		#' @param g A grouping variable of length \code{m}, either a factor or a character vector, indicating group membership for each observation.
7		#'
8		#' @return A numeric matrix representing the between-group scatter matrix (\code{SB}).
9		#'
10		#' @details
11		#' The function computes the total mean of the matrix \code{A} and the mean for each group defined by \code{g}.
12		#' It then calculates the between-group scatter matrix by summing the outer product of the mean differences, weighted by the group sizes.
13		#'
14		#' @examples
15		#' # Example usage:
16		#' A <- matrix(rnorm(20), nrow = 5, ncol = 4)
17		#' g <- factor(c("A", "B", "A", "B", "A"))
18		#' SB <- rENA:::compute_SB(A, g)
19		compute_SB <- function(A, g) {
20	!	if (!is.matrix(A)) stop("A must be a numeric matrix.")
21	!	if (length(g) != nrow(A)) stop("g must have the same length as number of rows in A.")
22
23	2x	g <- as.factor(g);
24	2x	groups <- levels(g);
25	2x	n_features <- ncol(A);
26	2x	m <- nrow(A);
27
28		# Total mean
29	2x	mu_total <- colMeans(A);
30
31		# Initialize matrices
32	2x	SB <- matrix(0, n_features, n_features);
33
34	2x	for (grp in groups) {
35	4x	idx <- which(g == grp);
36	4x	A_grp <- A[idx, , drop = FALSE];
37	4x	n_g <- nrow(A_grp);
38	4x	mu_g <- colMeans(A_grp);
39
40		# Between-group component
41	4x	mean_diff <- matrix(mu_g - mu_total, ncol = 1);
42	4x	SB <- SB + n_g * (mean_diff %*% t(mean_diff));
43		}
44
45	2x	return(SB);
46		}
47
48
49		#' Generalized Means Rotation (GMR) with optional subsetting and interaction control
50		#'
51		#' Computes a rotation (direction) `r` representing the contribution of the
52		#' first column of `X` to the multivariate ENA matrix `V`. Supports optional
53		#' subsetting by `groups`, optional inclusion of interaction terms when
54		#' computing adjusted contributions.
55		#'
56		#' @param V Numeric ENA matrix (units x connections) ready for rotation.
57		#' @param X Data frame or matrix of predictors; the first column is the target.
58		#' @param groups Optional vector specifying target groups to subset. If `NULL`
59		#' (default), all rows are used.
60		#' @param alpha Elastic-net mixing parameter forwarded to `get_x1_main_effect`
61		#' (default `1` - Lasso).
62		#' @param lambda Lambda selection for `cv.glmnet` forwarded to
63		#' `get_x1_main_effect` (default `"lambda.min"`).
64		#' @param interactions Logical; if `TRUE` (default) interactions are included when computing the adjusted contribution.
65		#' @param verbose Logical; if `TRUE` (default) the function emits messages about
66		#' fails or successes.
67		#'
68		#' @return A numeric vector `r` (length = ncol(V)) giving the normalized
69		#' rotation direction. Attributes attached:
70		#' \describe{
71		#' \item{`target`}{The full-length target vector (un-subsetted).}
72		#' \item{`Vx1`}{The unadjusted fitted values (`lm(V ~ target)`) embedded in
73		#' a full-length matrix (rows outside subset filled with zeros).}
74		#' }
75		#' If no valid direction can be found (including SVD failure), returns `NULL`
76		#' and issues a warning.
77		#'
78		#' @examples
79		#' \dontrun{
80		#' set.seed(1)
81		#' V <- matrix(rnorm(200), nrow = 40)
82		#' X <- data.frame(group = rep(letters[1:4], each = 10),
83		#' x2 = rnorm(40), x3 = rnorm(40))
84		#' r_all <- gmr2(V, X)
85		#' r_subset <- gmr2(V, X, groups = c("a", "b"), interactions = TRUE)
86		#' }
87		#'
88		#' @seealso [get_x1_main_effect()]
89		#' @importFrom stats lm model.matrix
90		#' @importFrom glmnet cv.glmnet
91		#' @export
92
93		gmr <- function(V, X, groups = NULL, alpha = 1, lambda = "lambda.min",
94		interactions = TRUE, verbose = TRUE) {
95		# prepare a function for almost zero check
96	2x	is_zero <- function(x, tol = 1e-12) all(abs(x) < tol)
97		# get full target variable, namely, the first variable in X
98	2x	target_full <- X[[1]]
99	!	if (is.list(target_full)) target_full <- unlist(target_full, recursive = FALSE)
100	2x	target_full <- as.vector(target_full)
101
102		# --- Fail if target is constant ---
103	2x	unique_targets <- unique(target_full)
104	2x	if (length(unique_targets) == 1) {
105	!	warning("Target variable is constant; returning NULL.")
106	!	return(NULL)
107		}
108
109		# --- Subset by groups if selected groups are provided ---
110	2x	if (!is.null(groups)) {
111	!	valid_groups <- intersect(groups, unique(target_full))
112	!	if (length(valid_groups) > 1) {
113	!	subset_idx <- which(target_full %in% valid_groups)
114	!	V_sub <- V[subset_idx, , drop = FALSE]
115	!	X_sub <- X[subset_idx, , drop = FALSE]
116	!	target_sub <- target_full[subset_idx]
117		} else {
118	!	warning("Less than 2 valid groups selected; returning NULL.")
119	!	return(NULL)
120		}
121		} else { # use full data if no groups are selected
122	2x	V_sub <- V
123	2x	X_sub <- X
124	2x	target_sub <- target_full
125	2x	subset_idx <- NULL
126		}
127
128		# --- Base regression model ---
129	2x	model <- lm(V_sub ~ target_sub)
130	2x	Vx1_sub <- model$fitted.values
131
132		# --- Compute contributions via Lasso (if covariates exist) ---
133	2x	Vx_sub <- NULL
134	2x	if (ncol(X_sub) == 1) { # no corariates, use base model
135	!	Vx_sub <- Vx1_sub
136		} else { # covariates exist, use Lasso model
137	2x	Vx_sub <- get_x1_main_effect(V_sub, X_sub, alpha = alpha,
138	2x	lambda = lambda, include_interactions = interactions)
139		}
140	2x	if (is_zero(Vx_sub)) {
141	!	warning("Regression resulted in zeor contribution; returning NULL.")
142	!	return(NULL)
143		}
144		# --- Compute rotation direction r ---
145	2x	r <- NULL
146	2x	if (is.numeric(target_sub)) {
147	1x	if (verbose) message("Computing direction for numeric target...")
148	1x	model = model <- lm(Vx_sub ~ target_sub)
149	1x	beta <- model$coefficients[2,]
150	1x	if (is_zero(beta)) {
151	!	warning("Numerical target with zero beta; returning NULL.")
152	!	return(NULL)
153		} else {
154	1x	r <- beta
155		}
156		} else {
157	1x	if (verbose) message("Computing direction for categorical target...")
158	1x	sb <- compute_SB(Vx_sub, target_sub)
159	1x	r <- tryCatch(svd(sb)$v[, 1], error = function(e) NULL)
160		}
161
162		# --- Final SVD fallback if r is NULL or zero ---
163	2x	if (is.null(r) \|\| all(r == 0)) {
164	!	warning("Uable to compute any valid direction; returning NULL.")
165	!	return(NULL)
166		}
167
168		# --- Normalize ---
169	2x	r <- r / sqrt(sum(r^2))
170
171		# --- Build full-length Vx1 ---
172	2x	Vx1_full <- matrix(0, nrow = nrow(V), ncol = ncol(V))
173	2x	Vx1_full[subset_idx %\|\|% seq_len(nrow(V)), ] <- Vx_sub
174	2x	colnames(Vx1_full) <- colnames(V)
175
176		# --- Attach metadata ---
177	2x	attr(r, "target") <- target_full
178	2x	attr(r, "Vx1") <- Vx1_full
179		#attr(r, "fallback_stage") <- fallback_stage
180
181	2x	if (verbose) message(" gmr completed successfully ")
182	2x	return(r)
183		}
184
185		#' Extract the Main Effect of X on V with Optional Interactions
186		#'
187		#' Computes the main-effect contribution of the first column of `X` (the
188		#' "target") to the multivariate ENA matrix `V`. The function fits penalized
189		#' regression models (via glmnet) and can optionally include interactions
190		#' between the target and other covariates. It returns the fitted contribution
191		#' matrix (units x connections).
192		#'
193		#' The function can compute contributions using either only main-effect columns
194		#' (no interactions) or main-effect plus all interaction columns that start
195		#' with the target name. If no matching columns are found or all fitted
196		#' coefficients are zero, the function returns a zero matrix and emits a
197		#' warning.
198		#'
199		#' @param V A numeric matrix (units x connections) of dependent variables.
200		#' @param X A data frame or matrix of predictors / covariates. The first
201		#' column is treated as the target variable whose contribution will be extracted.
202		#' @param alpha Elastic-net mixing parameter passed to `cv.glmnet`. `alpha = 1`
203		#' (default) is Lasso; `alpha = 0` is ridge.
204		#' @param lambda Character or numeric. Which lambda from the `cv.glmnet` fit to
205		#' use; e.g. `"lambda.min"` (default) or `"lambda.1se"`, or a numeric value.
206		#' @param include_interactions Logical; if `TRUE`, include main-effect columns
207		#' and all interaction columns that begin with the target name (default:
208		#' `FALSE`, only main-effect columns).
209		#'
210		#' @return A numeric matrix with the same dimensions as `V` containing the
211		#' estimated contribution of `X[,1]` to each response. If no columns are
212		#' matched or all coefficients are zero, a zero matrix is returned and a
213		#' warning is issued.
214		#'
215		#' @details
216		#' Internally this function builds `model.matrix(~ .^2, data = X)` to obtain
217		#' main effects and pairwise interactions. It sets a `penalty.factor` that
218		#' leaves the target-related columns unpenalized (0) and fits a multivariate
219		#' `glmnet` (`family = "mgaussian"`). The returned matrix is dense (numeric).
220		#'
221		#' @examples
222		#' \dontrun{
223		#' set.seed(1)
224		#' V <- matrix(rnorm(50), ncol = 5)
225		#' X <- data.frame(CONFIDENCE = rnorm(10), Condition = factor(rep(1:2, 5)))
226		#' # main effects only
227		#' Vx_main <- get_x1_main_effect(V, X, include_interactions = FALSE)
228		#' # include interactions
229		#' Vx_full <- get_x1_main_effect(V, X, include_interactions = TRUE, alpha = 0) # ridge
230		#' }
231		#'
232		#' @seealso [gmr2()] for the rotation routine that uses this function.
233		#' @importFrom stats lm model.matrix
234		#' @importFrom glmnet cv.glmnet
235		#' @export
236
237		get_x1_main_effect <- function(V, X, alpha = 1, lambda = "lambda.min", include_interactions = FALSE) {
238	3x	x1_name <- colnames(X)[1]
239
240		# 1. Formula & Model Matrix
241	3x	formula_str <- if (include_interactions) "~ .^2" else "~ ."
242	3x	mm <- model.matrix(as.formula(formula_str), data = X)[, -1, drop = FALSE]
243
244		# 2. Identify Main Effect Columns for x1
245	3x	safe_x1 <- gsub("([.\|()\\^{}+$*?]\|\\[\|\\])", "\\\\\\1", x1_name)
246	3x	x1_main_regex <- paste0("^", safe_x1, "[^:]*$")
247	3x	x1_cols <- grep(x1_main_regex, colnames(mm))
248
249	3x	if (length(x1_cols) == 0) {
250	!	warning("No main effect columns found for X[,1]; returning zeros.")
251	!	return(matrix(0, nrow = nrow(V), ncol = ncol(V), dimnames = list(NULL, colnames(V))))
252		}
253
254		# 3. Penalty Factors
255	3x	p <- ncol(mm)
256	3x	penalty_factors <- rep(1, p)
257	3x	penalty_factors[x1_cols] <- 0
258
259		# 4. Fitting Logic
260	3x	x1_contribution <- matrix(0, nrow = nrow(V), ncol = ncol(V), dimnames = list(NULL, colnames(V)))
261	3x	use_ols <- (p <= (nrow(X) - 10)) # Heuristic: Use OLS only if we have enough degrees of freedom
262
263	3x	if (!use_ols) {
264	!	fit <- tryCatch(
265		# We add lower.limits/upper.limits or tiny penalty to ensure x1 is NEVER zero if it has signal
266	!	glmnet::cv.glmnet(x = mm, y = V, family = "mgaussian",
267	!	alpha = alpha, penalty.factor = penalty_factors),
268	!	error = function(e) NULL
269		)
270
271	!	if (!is.null(fit)) {
272	!	coefs_list <- coef(fit, s = lambda)
273		# coefs_list is a list of sparse matrices (one per response)
274	!	for (i in seq_along(coefs_list)) {
275		# Extract coefs, skipping intercept ([1,])
276		# Force to numeric to avoid sparse matrix indexing issues
277	!	beta_all <- as.matrix(coefs_list[[i]])[-1, , drop = FALSE]
278	!	beta_x1 <- beta_all[x1_cols, , drop = FALSE]
279	!	x1_contribution[, i] <- mm[, x1_cols, drop = FALSE] %*% beta_x1
280		}
281	!	return(x1_contribution)
282		}
283	!	use_ols <- TRUE
284		}
285
286	3x	if (use_ols) {
287	3x	fit_ols <- lm(V ~ mm)
288		# as.matrix handles the 'incorrect number of dimensions' for single response
289	3x	beta_ols <- as.matrix(coef(fit_ols))[-1, , drop = FALSE]
290	3x	beta_x1_ols <- beta_ols[x1_cols, , drop = FALSE]
291
292		# Handle NAs that OLS produces for rank-deficient matrices
293	3x	beta_x1_ols[is.na(beta_x1_ols)] <- 0
294	3x	x1_contribution <- mm[, x1_cols, drop = FALSE] %*% beta_x1_ols
295		}
296
297	3x	return(x1_contribution)
298		}
299

1		## ── qeviz interactive plot integration ───────────────────────────────────────
2		##
3		## Public API (thin wrappers over the qeviz package)
4		## ena.plot.interactive() — create an interactive qeviz htmlwidget
5		## ena.export.html() — write a self-contained HTML file
6		## enaInteractiveOutput() — Shiny output binding
7		## renderEnaInteractive() — Shiny render function
8		##
9		## The widget, its JavaScript bundle and the ena.set -> ModelData conversion
10		## live in qeviz (qe_plot(), qe_widget(), qeOutput(), renderQe()).
11		## ─────────────────────────────────────────────────────────────────────────────
12
13
14		.require_qeviz <- function() {
15	45x	if (!requireNamespace("qeviz", quietly = TRUE) \|\| utils::packageVersion("qeviz") < "0.5.0") {
16	!	stop("The 'qeviz' package (>= 0.5.0) is required for interactive plots. Install with:\n",
17	!	" install.packages(\"qeviz\", repos = c(\"https://cran.qe-libs.org\", getOption(\"repos\")))",
18	!	call. = FALSE)
19		}
20		}
21
22		#' Interactive ENA plot using qeviz
23		#'
24		#' Renders an interactive ENA plot inside RStudio, R Markdown / Quarto, and
25		#' Shiny using the qeviz visualization library. This is a shortcut for a
26		#' \code{qeviz::qe_plot()} chain; use qeviz directly for full control.
27		#'
28		#' @param set An \code{\link{ena.make.set}} result.
29		#' @param group_col Character. Name of the grouping column in \code{set$points}
30		#' (e.g. \code{"Condition"}). Controls point colours and group
31		#' mean networks.
32		#' @param group Character. Which group's mean network to display. Defaults
33		#' to the first group.
34		#' @param unit Character. A specific unit ID to display its individual
35		#' network instead of a group mean.
36		#' @param compare Character. Second group or unit for a subtraction view
37		#' (\code{group} minus \code{compare}).
38		#' @param also Character. Second group for an overlay view (both networks
39		#' drawn simultaneously).
40		#' @param dim_cols Character vector of two dimension names to plot.
41		#' Default \code{c("SVD1", "SVD2")}.
42		#' @param label_nodes \code{"on"} \| \code{"off"} \| \code{"auto"} \| \code{"click"}.
43		#' Visibility of code-node labels. Default \code{"on"}.
44		#' @param label_means Visibility of group-mean labels. Default \code{"on"}.
45		#' @param label_points Visibility of unit-point labels. Default \code{"off"}.
46		#' @param confidence Logical. Draw the confidence interval box around each
47		#' shown group mean. Default \code{TRUE}.
48		#' @param outlier Logical. Also draw the outlier interval (Q1 - 1.5 IQR to
49		#' Q3 + 1.5 IQR). Default \code{FALSE}.
50		#' @param scale_points Logical. Rescale unit points to match the node coordinate
51		#' space. Default \code{TRUE}.
52		#' @param conf_level Numeric. Confidence level for CI boxes. Default \code{0.95}.
53		#' @param iqr_factor Deprecated; the outlier interval always uses 1.5 IQR.
54		#' @param width,height Widget size in pixels or CSS units. \code{NULL} uses
55		#' the qeviz defaults (100\% x 440).
56		#'
57		#' @return An \code{htmlwidget} object that renders in RStudio Viewer, R Markdown,
58		#' Quarto, and Shiny.
59		#'
60		#' @examples
61		#' \dontrun{
62		#' data(RS.data)
63		#' codeNames <- c("Data", "Technical.Constraints", "Performance.Parameters",
64		#' "Client.and.Consultant.Requests", "Design.Reasoning", "Collaboration")
65		#' accum <- ena.accumulate.data(
66		#' units = RS.data[, c("UserName", "Condition")],
67		#' conversation = RS.data[, c("Condition", "GroupName")],
68		#' codes = RS.data[, codeNames],
69		#' window.size.back = 4
70		#' )
71		#' set <- ena.make.set(enadata = accum)
72		#'
73		#' # Basic plot coloured by Condition
74		#' ena.plot.interactive(set, group_col = "Condition")
75		#'
76		#' # Show only FirstGame mean network
77		#' ena.plot.interactive(set, group_col = "Condition", group = "FirstGame")
78		#'
79		#' # Subtraction: FirstGame minus SecondGame
80		#' ena.plot.interactive(set, group_col = "Condition",
81		#' group = "FirstGame", compare = "SecondGame")
82		#' }
83		#'
84		#' @export
85		ena.plot.interactive <- function(
86		set,
87		group_col = NULL,
88		group = NULL,
89		unit = NULL,
90		compare = NULL,
91		also = NULL,
92		dim_cols = c("SVD1", "SVD2"),
93		label_nodes = "on",
94		label_means = "on",
95		label_points = "off",
96		confidence = TRUE,
97		outlier = FALSE,
98		scale_points = TRUE,
99		conf_level = 0.95,
100		iqr_factor = 1.5,
101		width = NULL,
102		height = NULL
103		) {
104	7x	.require_qeviz()
105	7x	if (!missing(iqr_factor) && !identical(iqr_factor, 1.5))
106	1x	warning("ena.plot.interactive(): iqr_factor is deprecated and ignored; ",
107	1x	"the outlier interval uses 1.5 IQR.", call. = FALSE)
108
109	7x	p <- qeviz::qe_plot(set, dims = dim_cols, scale_points = scale_points,
110	7x	group_col = group_col,
111	7x	width = if (is.null(width)) "100%" else width,
112	7x	height = if (is.null(height)) 440 else height)
113
114		# A group mean network: the requested group, else the first group (as
115		# before). A unit network is drawn instead when `unit` is given.
116	7x	groups <- if (is.null(group_col)) character(0)
117	7x	else unique(as.character(as.data.frame(set$points)[[group_col]]))
118	4x	if (is.null(group) && is.null(unit) && length(groups)) group <- groups[1L]
119	7x	if (!is.null(group) \|\| !is.null(unit))
120	6x	p <- qeviz::qe_edges(p, group = group, unit = unit, compare = compare, also = also)
121
122		# Means (with CI) for the groups whose networks are shown.
123		# Means (with CI) for the groups whose networks are shown; none otherwise.
124	7x	shown <- intersect(c(group, compare, also), groups)
125	7x	p <- if (length(shown))
126	7x	do.call(qeviz::qe_group, c(list(p), as.list(shown), list(
127	7x	intervals = if (isTRUE(confidence)) "box" else "none",
128	7x	conf_level = conf_level,
129	7x	outlier = isTRUE(outlier))))
130	7x	else qeviz::qe_group(p, show = FALSE)
131
132	7x	p <- qeviz::qe_axes(p)
133	7x	p <- qeviz::qe_labels(p, nodes = label_nodes, means = label_means, points = label_points)
134	7x	qeviz::qe_widget(p)
135		}
136
137		#' Export a self-contained interactive ENA plot as HTML
138		#'
139		#' Writes a single \code{.html} file containing the qeviz bundle and embedded
140		#' model data. No R, no Python, and no server are required to open the file —
141		#' share it with collaborators, attach it to a paper submission, or archive it
142		#' as supplementary material.
143		#'
144		#' @param set An \code{\link{ena.make.set}} result.
145		#' @param file Output file path, e.g. \code{"ena_plot.html"}.
146		#' @param group_col Character. Grouping column in \code{set$points}.
147		#' @param ... Additional arguments passed to \code{\link{ena.plot.interactive}}
148		#' (e.g. \code{group}, \code{compare}, \code{label_nodes}).
149		#' @param width,height Plot dimensions in pixels. Default 700 × 600.
150		#' @param selfcontained Logical. Inline the qeviz bundle in the HTML file.
151		#' Default \code{TRUE}. Set to \code{FALSE} to reference the
152		#' bundle via a relative path (smaller file, not portable).
153		#'
154		#' @return The resolved absolute path of the written file (invisibly).
155		#'
156		#' @examples
157		#' \dontrun{
158		#' set <- ena.make.set(enadata = accum)
159		#' ena.export.html(set, "model.html", group_col = "Condition")
160		#' }
161		#'
162		#' @export
163		ena.export.html <- function(
164		set,
165		file,
166		group_col = NULL,
167		...,
168		width = 700L,
169		height = 600L,
170		selfcontained = TRUE
171		) {
172	1x	widget <- ena.plot.interactive(
173	1x	set,
174	1x	group_col = group_col,
175	1x	width = width,
176	1x	height = height,
177		...
178		)
179	1x	abs_file <- normalizePath(file, mustWork = FALSE)
180	1x	htmlwidgets::saveWidget(widget, abs_file, selfcontained = selfcontained)
181	1x	message("Written: ", abs_file)
182	1x	invisible(abs_file)
183		}
184
185		#' Shiny output binding for interactive ENA plots
186		#'
187		#' Equivalent to \code{qeviz::qeOutput()}.
188		#'
189		#' @param outputId Shiny output ID.
190		#' @param width,height CSS dimensions. Defaults: \code{"100\%"}, \code{"600px"}.
191		#' @export
192		enaInteractiveOutput <- function(outputId, width = "100%", height = "600px") {
193	!	.require_qeviz()
194	!	qeviz::qeOutput(outputId, width = width, height = height)
195		}
196
197		#' Shiny render function for interactive ENA plots
198		#'
199		#' Equivalent to \code{qeviz::renderQe()}; \code{expr} may return an
200		#' \code{\link{ena.plot.interactive}} widget or a \code{qeviz::qe_plot()}.
201		#'
202		#' @param expr Expression that returns an \code{\link{ena.plot.interactive}} widget.
203		#' @param env Environment for \code{expr}. Default: \code{parent.frame()}.
204		#' @param quoted Logical. Is \code{expr} already quoted? Default \code{FALSE}.
205		#' @export
206		renderEnaInteractive <- function(expr, env = parent.frame(), quoted = FALSE) {
207	!	.require_qeviz()
208	!	if (!quoted) expr <- substitute(expr)
209	!	qeviz::renderQe(expr, env = env, quoted = TRUE)
210		}

1		#' @title ENA SVD
2		#' @description Computes a dimensional reduction of points in an ENA set using Singular Value Decomposition (SVD).
3		#' @param enaset An \code{ENAset} object containing the points to be reduced.
4		#' @param params A list of parameters. Use \code{params$as_object = TRUE} to return an ENARotationSet object, or \code{FALSE} (default) to return a list.
5		#' @details This function computes the SVD of the points in the ENA set and returns either an ENARotationSet object or a list with the rotation matrix, codes, node positions, and eigenvalues, depending on \code{params$as_object}.
6		#' @return An ENARotationSet object or a list containing:
7		#' \item{rotation}{The rotation matrix from SVD}
8		#' \item{codes}{The code names used for the matrix}
9		#' \item{node.positions}{(Currently NULL) Node positions}
10		#' \item{eigenvalues}{The eigenvalues (squared singular values) from SVD}
11		#' @examples
12		#' data(RS.data)
13		#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
14		#' "Client.and.Consultant.Requests", "Design.Reasoning",
15		#' "Collaboration")
16		#' units <- c("Condition", "UserName")
17		#' horizon <- c("Condition", "GroupName")
18		#' enaset <- RS.data \|>
19		#' accumulate(units, codes, horizon) \|>
20		#' model()
21		#' # SVD as list:
22		#' svd_result <- ena.svd(enaset, list(as_object = FALSE))
23		#' # SVD as ENARotationSet object:
24		#' svd_obj <- ena.svd(enaset, list(as_object = TRUE))
25		#' @export
26		ena.svd <- function(enaset, params) {
27		# to.norm = data.table::data.table(
28		# enaset$points.normed.centered,
29		# enaset$enadata$unit.names
30		# )
31		# to.norm = as.matrix(to.norm[,tail(.SD,n=1),.SDcols=colnames(to.norm)[which(colnames(to.norm) != "V2")],by=c("V2")][,2:ncol(to.norm)]);
32		# pcaResults = pca_c(to.norm, dims = enaset$get("dimensions"));
33		# pcaResults = pca_c(enaset$points.normed.centered, dims = enaset$get("dimensions"));
34	72x	as_object = FALSE;
35	72x	if(!is.null(params$as_object)) {
36	!	as_object = params$as_object
37		}
38
39		# pts = enaset$model$points.for.projection[,!colnames(enaset$model$points.for.projection) %in% colnames(enaset$meta.data), with=F]
40	72x	pts = as.matrix(enaset$model$points.for.projection)
41	72x	pcaResults = prcomp(pts, retx=FALSE, scale=FALSE, center=FALSE, tol=0)
42
43		### used to be enaset$data$centered$pca
44		#enaset$rotation.set = pcaResults$pca;
45
46
47	72x	colnames(pcaResults$rotation) = c(
48	72x	paste('SVD',as.character(1:ncol(pcaResults$rotation)), sep='')
49		);
50
51		# rotationSet = ENARotationSet$new(rotation = pcaResults$pca, codes = enaset$codes, node.positions = NULL, eigenvalues = pcaResults$latent)
52	72x	if(isTRUE(as_object)) {
53	!	rotationSet = ENARotationSet$new(
54	!	rotation = pcaResults$rotation,
55	!	codes = enaset$rotation$codes,
56	!	node.positions = NULL,
57	!	eigenvalues = pcaResults$sdev^2
58		)
59		}
60		else {
61	72x	rotationSet <- list(
62	72x	rotation = pcaResults$rotation,
63	72x	codes = enaset$rotation$codes,
64	72x	node.positions = NULL,
65	72x	eigenvalues = pcaResults$sdev^2
66		)
67		}
68	72x	return(rotationSet)
69		}
70
71		ena.svd.R6 <- function(enaset, ...) {
72	7x	pcaResults = prcomp(enaset$points.normed.centered, retx=FALSE,scale=FALSE,center=FALSE, tol=0)
73
74	7x	colnames(pcaResults$rotation) = c(
75	7x	paste('SVD',as.character(1:ncol(pcaResults$rotation)), sep='')
76		);
77
78	7x	rotationSet = ENARotationSet$new(
79	7x	rotation = pcaResults$rotation, codes = enaset$codes,
80	7x	node.positions = NULL, eigenvalues = pcaResults$sdev^2
81		)
82	7x	return(rotationSet)
83		}

1		##
2		#' @title Generate ENA Set
3		#'
4		#' @description Generates an ENA model by constructing a dimensional reduction of adjacency (co-occurrence) vectors in an ENA data object
5		#'
6		#' @details This function generates an ENAset object from an ENAdata object. Takes
7		#' the adjacency (co-occurrence) vectors from enadata, computes a dimensional
8		#' reduction (projection), and calculates node positions in the projected ENA
9		#' space. Returns location of the units in the projected space, as well as
10		#' locations for node positions, and normalized adjacency (co-occurrence) vectors
11		#' to construct network graphs
12		#'
13		#' @export
14		#'
15		#' @param enadata \code{\link{ENAdata}} that will be used to generate an ENA model
16		#' @param dimensions The number of dimensions to include in the dimensional reduction
17		#' @param norm.by A function to be used to normalize adjacency (co-occurrence) vectors before computing the dimensional reduction, default: sphere_norm_c()
18		#' @param rotation.by A function to be used to compute the dimensional reduction, default: ena.svd()
19		#' @param rotation.params (optional) A character vector containing additional parameters for the function in rotation.by, if needed
20		#' @param rotation.set A previously-constructed ENARotationSet object to use for the dimensional reduction
21		#' @param endpoints.only A logical variable which determines whether to only show endpoints for trajectory models
22		#' @param center.align.to.origin A logical variable when TRUE (default) determines aligns both point center and centroid center to the origin
23		#' @param node.position.method A function to be used to determine node positions based on the dimensional reduction, default: lws.position.es()
24		#' @param as.list R6 objects will be deprecated, but if this is TRUE, the original R6 object will be returned, otherwise a list with class `ena.set`
25		#' @param ... additional parameters addressed in inner function
26		#'
27		#' @examples
28		#' data(RS.data)
29		#'
30		#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
31		#' 'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
32		#'
33		#' accum = ena.accumulate.data(
34		#' units = RS.data[,c("UserName","Condition")],
35		#' conversation = RS.data[,c("Condition","GroupName")],
36		#' metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post")],
37		#' codes = RS.data[,codeNames],
38		#' window.size.back = 4
39		#' )
40		#'
41		#' set = ena.make.set(
42		#' enadata = accum
43		#' )
44		#'
45		#' set.means.rotated = ena.make.set(
46		#' enadata = accum,
47		#' rotation.by = ena.rotate.by.mean,
48		#' rotation.params = list(
49		#' accum$meta.data$Condition=="FirstGame",
50		#' accum$meta.data$Condition=="SecondGame"
51		#' )
52		#' )
53		#'
54		#' @seealso \code{\link{ena.accumulate.data}}, \code{\link{ENAset}}
55		#'
56		#' @return \code{\link{ENAset}} class object that can be further processed for analysis or plotting
57		##
58		ena.make.set <- function(
59		enadata,
60		dimensions = 2,
61		norm.by = fun_sphere_norm,
62		rotation.by = ena.svd,
63		rotation.params = NULL,
64		rotation.set = NULL,
65		endpoints.only = TRUE,
66		center.align.to.origin = TRUE,
67		node.position.method = lws.positions.sq,
68		as.list = TRUE,
69		...
70		) {
71	102x	if (as.list == F) {
72	14x	warning(paste0("Usage of ENAdata and ENAset objects will be deprecated ",
73	14x	"and potentially removed altogether in future versions."))
74
75	14x	if (!is(enadata, "ENAdata")) {
76	1x	stop(paste0("Use of ena.make.set with as.list=FALSE requires `enadata` ",
77	1x	"be an ENAdata object. Re-run the accumulation with as.list=FALSE"))
78		}
79
80	13x	set <- ENAset$new(
81	13x	enadata = enadata,
82	13x	dimensions = dimensions,
83	13x	rotation.by = ifelse(
84	13x	!is.null(rotation.by) && identical(rotation.by, ena.svd),
85	13x	ena.svd.R6,
86	13x	rotation.by
87		),
88	13x	rotation.params = rotation.params,
89	13x	rotation.set = rotation.set,
90	13x	norm.by = norm.by,
91	13x	node.position.method = ifelse(
92	13x	identical(node.position.method, lws.positions.sq),
93	13x	lws.positions.sq.R6,
94	13x	node.position.method
95		),
96	13x	endpoints.only = endpoints.only,
97	13x	center.align.to.origin = center.align.to.origin,
98		...
99		)
100	13x	return(set$process());
101		}
102		else {
103	88x	if ("ENAdata" %in% class(enadata)) {
104	1x	warning(paste0("Usage of ENAdata objects will be deprecated and ",
105	1x	"potentially removed altogether in future versions. See ",
106	1x	"ena.accumulate.data() or ena.set()."))
107
108	1x	enadata <- ena.set(enadata)
109		}
110
111	88x	enadata$`_function.params`$center.align.to.origin <- center.align.to.origin;
112	88x	enadata$`_function.params`$rotation.by <- rotation.by;
113	88x	enadata$`_function.params`$rotation.params <- rotation.params;
114
115		###
116		# Convert the string vector of code names to their corresponding
117		# co-occurence names
118		#####
119	88x	code_columns <- svector_to_ut(enadata$rotation$codes)
120
121		###
122		# Normalize the raw data using self$function.params$norm.by,
123		# which defaults to calling rENA::dont_sphere_norm_c
124		#####
125	88x	line.weights <- norm.by(as.matrix(enadata$connection.counts))
126	88x	colnames(line.weights) <- code_columns
127
128	88x	line.weights.dt <- data.table::as.data.table(line.weights)
129	88x	for (i in seq(ncol(line.weights.dt)))
130	1305x	set(line.weights.dt, j = i,
131	1305x	value = as.ena.co.occurrence(line.weights.dt[[i]]))
132
133	88x	enadata$line.weights <- cbind(enadata$meta.data, line.weights.dt)
134	88x	class(enadata$line.weights) <- c("ena.line.weights", "ena.matrix",
135	88x	class(enadata$line.weights))
136		#####
137
138		###
139		# Center the normed data
140		#####
141		# if ( inherits(rotation.set, "ena.rotation.set") ) {
142
143		# if ( !is.null(rotation.by) && is.null(rotation.set) ) {
144		# points.for.projection <- center_data_c(line.weights)
145		# }
146	88x	if ( !is.null(rotation.set) ) {
147	5x	if( inherits(rotation.set, "ena.rotation.set") ) {
148	4x	if(center.align.to.origin) {
149	4x	points.for.projection <- line.weights
150
151	4x	non_zero_rows <- rowSums(as.matrix(line.weights)) != 0;
152	4x	if(sum(non_zero_rows) > 0) {
153	4x	points.for.projection[rowSums(as.matrix(line.weights))!=0,] <- center.projection(lws = line.weights[rowSums(as.matrix(line.weights))!=0,], rotation = rotation.set);
154		}
155		else {
156	!	stop("There were no co-occurrences of codes for any of the units within the model as defined.");
157		}
158		}
159		else {
160	!	points.for.projection <- center.projection(lws = line.weights, rotation = rotation.set);
161		}
162		}
163		else {
164	1x	stop("Supplied rotation.set is not an instance of ENARotationSet");
165		}
166		}
167		else {
168	83x	if(center.align.to.origin) {
169	81x	points.for.projection <- line.weights
170
171	81x	non_zero_rows <- rowSums(as.matrix(line.weights))!=0;
172	81x	if(sum(non_zero_rows) > 0) {
173	81x	points.for.projection[rowSums(as.matrix(line.weights))!=0,] <- center_data_c(line.weights[rowSums(as.matrix(line.weights))!=0,])
174		}
175		else {
176	!	stop("There were no co-occurrences of codes for any of the units within the model as defined.");
177		}
178		}
179		else {
180	2x	points.for.projection <- center_data_c(line.weights)
181		}
182		}
183
184	86x	colnames(points.for.projection) <- code_columns;
185	86x	enadata$model$points.for.projection = data.table::as.data.table(points.for.projection)
186	86x	for (i in seq(ncol(enadata$model$points.for.projection))) {
187	1275x	set(
188	1275x	enadata$model$points.for.projection,
189	1275x	j = i,
190	1275x	value = as.ena.co.occurrence(enadata$model$points.for.projection[[i]])
191		)
192		}
193	86x	enadata$model$points.for.projection <- as.ena.matrix(cbind(
194	86x	enadata$meta.data,
195	86x	enadata$model$points.for.projection
196	86x	), "ena.points")
197		#####
198
199		###
200
201		###
202		# Generate and Assign the rotation set
203		#####
204	86x	if (!is.null(rotation.by) && is.null(rotation.set)) {
205	82x	rotation <- do.call(rotation.by, list(enadata, rotation.params))
206		# added by Carl, 2026.1.6
207	81x	if(is.null(rotation))
208		{
209	!	stop("Unable to create a rotation set")
210		}
211		#
212	81x	enadata$rotation.matrix <- as.data.table(rotation$rotation, keep.rownames = "codes")
213	81x	for (i in seq(ncol(enadata$rotation.matrix))) {
214	1281x	if(i == 1) {
215	81x	set(enadata$rotation.matrix,
216	81x	j = i, value = as.ena.metadata(enadata$rotation.matrix[[i]])
217		)
218		}
219		else {
220	1200x	set(enadata$rotation.matrix,
221	1200x	j = i, value = as.ena.dimension(enadata$rotation.matrix[[i]])
222		)
223		}
224		}
225	81x	class(enadata$rotation.matrix) <- c("ena.rotation.matrix", class(enadata$rotation.matrix))
226
227	81x	enadata$rotation$rotation.matrix <- enadata$rotation.matrix
228	81x	enadata$rotation$eigenvalues <- rotation$eigenvalues;
229	81x	if(center.align.to.origin) {
230	79x	enadata$rotation$center.vec = colMeans(line.weights[rowSums(as.matrix(line.weights))!=0,]) # ADD CENTERING VEC HERE
231		}
232		else {
233	2x	enadata$rotation$center.vec = colMeans(line.weights) # ADD CENTERING VEC HERE
234		}
235		}
236	4x	else if (!is.null(rotation.set)) {
237	3x	if (is(rotation.set, "ena.rotation.set")) {
238	3x	enadata$rotation.matrix <- rotation.set$rotation.matrix
239	3x	enadata$rotation$rotation.matrix <- rotation.set$rotation.matrix
240	3x	enadata$rotation$nodes <- rotation.set$nodes;
241	3x	enadata$rotation$eigenvalues <- rotation.set$eigenvalues
242	3x	enadata$rotation$center.vec = rotation.set$center.vec # ADD CENTERING VEC HERE
243		}
244		else {
245	!	stop("Supplied rotation.set is not an instance of ENARotationSet")
246		}
247		}
248		else {
249	1x	stop("Unable to find or create a rotation set")
250		}
251		#####
252
253		###
254		# Generate the rotated points
255		#####
256	84x	if (!is.null(enadata$rotation.matrix)) {
257	83x	points <- points.for.projection %*% as.matrix(enadata$rotation.matrix)
258	83x	points.dt <- as.data.table(points)
259	83x	for (i in seq(ncol(points.dt))) {
260	1230x	set(points.dt, j = i, value = as.ena.dimension(points.dt[[i]]))
261		}
262	83x	if(grepl(x = enadata$model$model.type, pattern = "Trajectory")) {
263	4x	enadata$points <- cbind(enadata$trajectories, points.dt)
264		}
265		else {
266	79x	enadata$points <- cbind(enadata$meta.data, points.dt)
267		}
268	83x	enadata$points <- as.ena.matrix(enadata$points, "ena.points")
269		}
270		else {
271	1x	stop(paste0("There is no rotation matrix, if you supplied a custom ",
272	1x	"rotation.set, be sure it contains a rotation.matrix"))
273		}
274		#####
275
276		###
277		# Calculate node positions
278		# - The supplied methoed is responsible is expected to return a list
279		# with two keys, "node.positions" and "centroids"
280		#####
281	83x	if (exists("rotation") && !is.null(rotation) && is.null(rotation.set)) {
282	81x	positions <- node.position.method(enadata)
283
284	81x	if (all(names(positions) %in% c("node.positions", "centroids"))) {
285	80x	enadata$rotation$nodes <- as.data.table(positions$node.positions)
286	80x	colnames(enadata$rotation$nodes) <- colnames(points)
287	80x	rownames(enadata$rotation$nodes) <- enadata$rotation$codes
288
289	80x	for (i in seq(ncol(enadata$rotation$nodes))) {
290	1185x	set(enadata$rotation$nodes, j = i,
291	1185x	value = as.ena.dimension(enadata$rotation$nodes[[i]]))
292		}
293	80x	enadata$rotation$nodes <- data.table(
294	80x	code = structure(enadata$rotation$codes,
295	80x	class = c("code", class(enadata$rotation$codes))),
296	80x	enadata$rotation$nodes
297		)
298	80x	class(enadata$rotation$nodes) = c("ena.nodes",
299	80x	class(enadata$rotation$nodes))
300
301	80x	enadata$model$centroids <- as.data.table(positions$centroids)
302	80x	for (i in seq(ncol(enadata$model$centroids))) {
303	1185x	set(enadata$model$centroids, j = i,
304	1185x	value = as.ena.dimension(enadata$model$centroids[[i]])
305		)
306		}
307	80x	colnames(enadata$model$centroids) <- colnames(as.matrix(enadata$rotation.matrix))
308	80x	enadata$model$centroids = cbind(
309	80x	data.table(unit = enadata$model$unit.labels),
310	80x	enadata$model$centroids
311		)
312	80x	set(enadata$model$centroids, j = 1L,
313	80x	value = as.ena.metadata(enadata$model$centroids[[1L]])
314		)
315	80x	enadata$model$centroids <- as.ena.matrix(enadata$model$centroids)
316		}
317		else {
318	1x	stop(paste0("The node position method didn't return back the ",
319	1x	"expected objects:\n",
320	1x	"\tExpected: c('node.positions','centroids')\n",
321	1x	"\tReceived: ", names(positions), sep = ""))
322		}
323	2x	} else if (!is.null(rotation.set)) {
324	2x	enadata$rotation$nodes <- rotation.set$nodes
325		}
326
327	82x	if (is.null(enadata$rotation$nodes)) {
328	1x	stop("Unable to determine the node positions either by calculating
329	1x	them using `node.position.method` or using a supplied
330	1x	`rotation.set`")
331		}
332		#####
333
334		###
335		# Variance
336		#####
337	81x	var_rot_data <- var(points)
338	81x	diagonal_variance <- as.vector(diag(var_rot_data))
339	81x	enadata$model$variance <- diagonal_variance / sum(diagonal_variance)
340	81x	names(enadata$model$variance) <- colnames(enadata$rotation$rotation.matrix)[-1]
341		#####
342
343	81x	enadata$plots <- list() #default = ena.plot(enadata, ...))
344		# class(enadata$model$plot) <- c("ena.plot", class(enadata$model$plot))
345
346	81x	enadata$`_function.params`$norm.by <- norm.by
347	81x	return(enadata)
348		}
349		}

1		plot_nodes <- function(...) {
2	29x	enaplot$plot <- plotly::add_trace(
3	29x	enaplot$plot,
4	29x	type = "scatter",
5	29x	data = nodes,
6	29x	x = ~X1,
7	29x	y = ~X2,
8	29x	mode = mode,
9	29x	textposition = label.offset[rows.to.keep],
10	29x	marker = list(
11	29x	color = "#000000",
12	29x	size = abs(nodes$weight),
13	29x	line = list(
14	29x	width = 0
15		)
16		#,name = labels[i] #rownames(nodes)[i]
17		),
18	29x	textfont = list (
19	29x	family = label.font.family,
20	29x	size = label.font.size,
21	29x	color = label.font.color
22		),
23	29x	text = labels[rows.to.keep], #rownames(nodes),
24	29x	legendgroup = legend.name,
25	29x	name = legend.name,
26	29x	showlegend = show.legend,
27	29x	hoverinfo = 'none'
28		);
29
30	29x	return(enaplot$plot);
31		}
32
33		plot_edges <- function(...) {
34	29x	if (length(network.edges.shapes) > 0 ) {
35	29x	enaplot$plotted$networks[[length(enaplot$plotted$networks) + 1]] <- network.edges.shapes
36
37	29x	for (n in 1:length(network.edges.shapes)) {
38	429x	e = network.edges.shapes[[n]];
39
40	429x	name = NULL;
41	429x	show.legend = F;
42	429x	this.name = paste(e$nodes[1],e$nodes[2], sep=".")
43	429x	if(legend.include.edges) {
44	!	name = this.name;
45	!	show.legend = T;
46		}
47
48	429x	if (isTRUE(e$self)) {
49	18x	if (e$line$width > 0) {
50	13x	enaplot$plot = plotly::add_trace(
51	13x	enaplot$plot,
52	13x	type = "scatter",
53	13x	mode = "markers",
54	13x	data = data.frame(X1 = e$x0, X2 = e$y0),
55	13x	x = ~X1, y = ~X2,
56	13x	marker = list(color = e$line$color, size = e$line$width, line = list(width = 0)),
57	13x	opacity = e$opacity,
58	13x	legendgroup = if(legend.include.edges == T) this.name else legend.name,
59	13x	showlegend = show.legend,
60	13x	name = name,
61	13x	hoverinfo = 'none'
62		)
63		}
64	18x	next
65		}
66
67	411x	enaplot$plot = plotly::add_trace(
68	411x	enaplot$plot,
69	411x	type = "scatter",
70	411x	mode = "lines",
71	411x	data = data.frame(X1=c(e$x0,e$x1), X2=c(e$y0,e$y1)),
72	411x	x = ~X1, y = ~X2,
73	411x	line = e$line,
74	411x	opacity = e$opacity,
75	411x	legendgroup = if(legend.include.edges == T) this.name else legend.name,
76	411x	showlegend = show.legend,
77	411x	name = name
78		)
79		}
80		}
81
82	29x	return(enaplot$plot);
83		}
84
85		##
86		#' @title Plot an ENA network
87		#'
88		#' @description Plot an ENA network: nodes and edges
89		#'
90		#' @details lots a network graph, including nodes (taken from codes in the ENAplot) and the edges (provided in network)
91		#'
92		#' @export
93		#'
94		#' @param enaplot \code{\link{ENAplot}} object to use for plotting
95		#' @param network dataframe or matrix containing the edge weights for the network graph; typically comes from ENAset$line.weights
96		#' @param node.positions matrix containing the positiions of the nodes. Defaults to enaplot$enaset$node.positions
97		#' @param adjacency.key matrix containing the adjacency key for looking up the names and positions
98		#' @param colors A String or vector of colors for positive and negative line weights. E.g. red or c(pos= red, neg = blue), default: c(pos= red, neg = blue)
99		#' @param edge_type A String representing the type of line to draw, either "line", "dash", or "dot"
100		#' @param show.all.nodes A Logical variable, default: true
101		#' @param threshold A vector of numeric min/max values, default: c(0,Inf) plotting . Edge weights below the min value will not be displayed; edge weights above the max value will be shown at the max value.
102		#' @param thin.lines.in.front A logical, default: true
103		#' @param layers ordering of layers, default: c("nodes", "edges")
104		#' @param thickness A vector of numeric min/max values for thickness, default: c(min(abs(network)), max(abs(network)))
105		#' @param opacity A vector of numeric min/max values for opacity, default: thickness
106		#' @param saturation A vector of numeric min/max values for saturation, default: thickness
107		#' @param scale.range A vector of numeric min/max to scale from, default: c(0.1,1) or if min(network) is 0, c(0,1)
108		#' @param node.size A lower and upper bound used for scaling the size of the nodes, default c(0, 20)
109		#' @param labels A character vector of node labels, default: code names
110		#' @param label.offset A character vector of representing the positional offset relative to the respective node. Defaults to "middle right" for all nodes. If a single values is provided, it is used for all positions, else the length of the
111		#' @param label.font.size An integer which determines the font size for graph labels, default: enaplot$font.size
112		#' @param label.font.color A character which determines the color of label font, default: enaplot$font.color
113		#' @param label.font.family A character which determines font type, choices: Arial, Courier New, Times New Roman, default: enaplot$font.family
114		#' @param legend.name A character name used in the plot legend. Not included in legend when NULL (Default), if legend.include.edges is TRUE will always be "Nodes"
115		#' @param legend.include.edges Logical value indicating if the edge names should be included in the plot legend. Forces legend.name to be "Nodes"
116		#' @param scale.weights Logical indicating to scale the supplied network
117		#' @param ... Additional parameters
118		#'
119		#' @seealso \code{\link{ena.plot}}, \code{\link{ena.plot.points}}
120		#' @importFrom scales rescale
121
122		#' @examples
123		#' data(RS.data)
124		#'
125		#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
126		#' 'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
127		#'
128		#' accum = ena.accumulate.data(
129		#' units = RS.data[,c("UserName","Condition")],
130		#' conversation = RS.data[,c("Condition","GroupName")],
131		#' metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post")],
132		#' codes = RS.data[,codeNames],
133		#' window.size.back = 4
134		#' )
135		#'
136		#' set = ena.make.set(
137		#' enadata = accum,
138		#' rotation.by = ena.rotate.by.mean,
139		#' rotation.params = list(
140		#' accum$meta.data$Condition=="FirstGame",
141		#' accum$meta.data$Condition=="SecondGame"
142		#' )
143		#' )
144		#'
145		#' plot = ena.plot(set)
146		#'
147		#' ### Subset rotated points and plot Condition 1 Group Mean
148		#' as.matrix(set$points$Condition$FirstGame)
149		#'
150		#' first.game.points = as.matrix(set$points$Condition$FirstGame)
151		#' plot = ena.plot.group(plot, first.game.points, labels = "FirstGame",
152		#' colors = "red", confidence.interval = "box")
153		#'
154		#' ### Subset rotated points and plot Condition 2 Group Mean
155		#' second.game.points = as.matrix(set$points$Condition$SecondGame)
156		#' plot = ena.plot.group(plot, second.game.points, labels = "SecondGame",
157		#' colors = "blue", confidence.interval = "box")
158		#'
159		#' ### get mean network plots
160		#' first.game.lineweights = as.matrix(set$line.weights$Condition$FirstGame)
161		#' first.game.mean = colMeans(first.game.lineweights)
162		#'
163		#' second.game.lineweights = as.matrix(set$line.weights$Condition$SecondGame)
164		#' second.game.mean = colMeans(second.game.lineweights)
165		#'
166		#' subtracted.network = first.game.mean - second.game.mean
167		#' plot = ena.plot.network(plot, network = subtracted.network)
168		#' print(plot)
169		#'
170		#' @return The \code{\link{ENAplot}} provided to the function, with its plot updated to include the nodes and provided connecting lines.
171		##
172		ena.plot.network = function(
173		enaplot = NULL,
174		network = NULL,
175		node.positions = enaplot$enaset$rotation$nodes,
176		adjacency.key = NULL, #enaplot$enaset$enadata$adjacency.matrix,
177		colors = c(pos=enaplot$palette[1], enaplot$palette[2]),
178		edge_type = "line", #c("line", "dash", "dot"),
179		show.all.nodes = T,
180		threshold = c(0),
181		thin.lines.in.front = T,
182		layers = c("nodes", "edges"),
183
184		thickness = c(min(abs(network)), max(abs(network))),
185		opacity = thickness,
186		saturation = thickness,
187		scale.range = c(ifelse(min(network)==0, 0, 0.1), 1),
188
189		node.size = c(3,10),
190
191		labels = NULL,
192		label.offset = "middle right",
193		label.font.size = enaplot$get("font.size"),
194		label.font.color = enaplot$get("font.color"),
195		label.font.family = enaplot$get("font.family"),
196		legend.name = NULL,
197		legend.include.edges = F,
198		scale.weights = F,
199		...
200		) {
201	51x	if (.qe_backend(enaplot))
202	21x	return(.qe_plot_network(enaplot, supplied = names(match.call())[-1],
203	21x	network = network, node.positions = node.positions, adjacency.key = adjacency.key,
204	21x	colors = colors, edge_type = edge_type, show.all.nodes = show.all.nodes,
205	21x	threshold = threshold, thin.lines.in.front = thin.lines.in.front, layers = layers,
206	21x	labels = labels, label.font.size = label.font.size, label.font.color = label.font.color,
207	21x	label.font.family = label.font.family, legend.name = legend.name, dots = list(...)))
208
209		# One weight per pair of nodes, or per pair plus each node's self-connection
210		# (upper triangle with the diagonal, as accumulate(self_connections = TRUE)).
211	30x	n.nodes <- nrow(node.positions)
212	30x	expected_codes <- c(choose(n.nodes, 2), n.nodes * (n.nodes + 1) / 2)
213	30x	if(!length(network) %in% expected_codes) {
214	1x	if(is.data.frame(network) && ncol(as.matrix(network)) %in% expected_codes) {
215	!	network = as.vector(as.matrix(network))
216		}
217		else {
218	1x	stop(paste0("Network vector needs to be of length ", choose(n.nodes, 2),
219	1x	" (or ", n.nodes * (n.nodes + 1) / 2, " with self-connections)"))
220		}
221		}
222	29x	diagonal <- length(network) == expected_codes[2] && expected_codes[2] != expected_codes[1]
223	29x	node.rows <- NULL
224	29x	if(is(node.positions, "ena.nodes")) {
225	27x	if(is.null(adjacency.key)) {
226	27x	adjacency.key <- namesToAdjacencyKey(node.positions$code, diagonal = diagonal)
227		}
228	27x	node.rows <- node.positions$code
229
230	27x	if(is.null(labels)) {
231	27x	labels <- node.positions$code
232		}
233		}
234		else {
235	2x	if(is.matrix(node.positions)) {
236	2x	node.positions <- as.data.frame(node.positions)
237		}
238	2x	adjacency.key <- namesToAdjacencyKey(rownames(node.positions), diagonal = diagonal)
239	2x	node.rows <- rownames(node.positions)
240	2x	if(is.null(labels)) {
241	2x	labels <- rownames(node.positions)
242		}
243		}
244	29x	args = list(...);
245	29x	network.edges.shapes = list();
246	29x	edge_type = match.arg(arg = edge_type, choices = c("line", "dash", "dot"));
247
248	29x	nodes = data.frame(as.matrix(node.positions));
249	29x	colnames(nodes) = paste0("X", seq(colnames(nodes)))
250	29x	nodes$weight = rep(0, nrow(nodes))
251	29x	nodes$color = "black";
252
253		# Handle label parameters
254	29x	if(length(label.offset) == 1) {
255	29x	label.offset = rep(label.offset[1], length(labels))
256		}
257	29x	if(length(label.offset) != length(labels)) {
258	!	stop("length(label.offset) must be equal to 1 or length(labels)")
259		}
260
261		# Handle legend parameters
262	29x	if(legend.include.edges == T && !is.null(legend.name)) {
263	!	legend.name = "Nodes"
264		}
265
266	29x	network.scaled = network;
267	29x	if(!is.null(threshold)) {
268	29x	multiplier.mask = ((network.scaled >= 0) * 1) - ((network.scaled < 0) * 1)
269	29x	if(length(threshold) == 1) {
270	29x	threshold[2] = Inf;
271		}
272	!	else if(threshold[2] < threshold[1]) {
273	!	stop("Minimum threshold value must be less than the maximum value.");
274		}
275
276	29x	if(threshold[1] > 0) {
277		# network.scaled = network.scaled[sizes > threshold[1]]
278	!	network.scaled[abs(network.scaled) < threshold[1]] = 0
279		}
280	29x	if(threshold[2] < Inf && any(abs(network.scaled) > threshold[2])) {
281	!	to.threshold = abs(network.scaled) > threshold[2]
282	!	network.scaled[to.threshold] = threshold[2]
283	!	network.scaled[to.threshold] = network.scaled[to.threshold] * multiplier.mask[to.threshold]
284		}
285		}
286	29x	network.thickness = abs(network.scaled);
287	29x	network.saturation = abs(network.scaled);
288	29x	network.opacity = abs(network.scaled);
289
290	29x	network.to.keep = (network != 0) * 1
291	29x	if(scale.weights == T && any(network != 0)) {
292	3x	weight.multiplier = 1 / max(abs(network));
293	3x	network.scaled = network * weight.multiplier;
294		# thickness/saturation/opacity ranges are given in unscaled units; bring
295		# them onto the same scale as network.scaled so the rescales stay in range.
296		# Force the saturation/opacity defaults (= thickness) before thickness changes.
297	3x	force(saturation); force(opacity);
298	3x	thickness = thickness * weight.multiplier;
299	3x	saturation = saturation * weight.multiplier;
300	3x	opacity = opacity * weight.multiplier;
301	3x	network.thickness = scales::rescale(x = abs(network.scaled), to = scale.range, from = thickness);
302		}
303	29x	network.scaled = network.scaled * network.to.keep
304	29x	network.thickness = network.thickness * network.to.keep
305
306		# hsv() and the edge opacity both require values in [0, 1]
307	29x	network.saturation = scales::squish(scales::rescale(x = abs(network.scaled), to = scale.range, from = saturation), c(0, 1));
308	29x	network.opacity = scales::squish(scales::rescale(x = abs(network.scaled), to = scale.range, from = opacity), c(0, 1));
309
310	29x	pos.inds = as.numeric(which(network.scaled >=0));
311	29x	neg.inds = as.numeric(which(network.scaled < 0));
312
313	29x	colors.hsv = rgb2hsv(col2rgb(colors))
314
315	29x	if(ncol(colors.hsv) == 1) {
316	16x	colors.hsv[[4]] = colors.hsv[1] + 0.5;
317	16x	if(colors.hsv[4] > 1) {
318	2x	colors.hsv[4] = colors.hsv[4] - 1;
319		}
320
321	16x	colors.hsv[[5]] = colors.hsv[2];
322	16x	colors.hsv[[6]] = colors.hsv[3];
323	16x	dim(colors.hsv) = c(3,2);
324		}
325
326	29x	mat = as.matrix(adjacency.key);
327	29x	for (i in 1:length(network)) {
328	429x	v0 <- nodes[node.rows==mat[1,i], ];
329	429x	v1 <- nodes[node.rows==mat[2,i], ];
330	429x	is.self <- mat[1,i] == mat[2,i]
331		# A self-connection counts once toward its node's size, so the node
332		# stays larger than the circle drawn on it.
333	429x	nodes[node.rows==mat[1,i],]$weight = nodes[node.rows==mat[1,i],]$weight + abs(network.thickness[i]);
334	429x	if(!is.self) {
335	411x	nodes[node.rows==mat[2,i],]$weight = nodes[node.rows==mat[2,i],]$weight + abs(network.thickness[i]);
336		}
337
338	429x	color = NULL
339	429x	if(i %in% pos.inds) {
340	405x	color = colors.hsv[,1];
341		} else {
342	24x	color = colors.hsv[,2];
343		}
344	429x	color[2] = network.saturation[i];
345
346	429x	edge_shape = list(
347	429x	type = "line",
348	429x	opacity = network.opacity[i],
349	429x	nodes = c(mat[,i]),
350	429x	line = list(
351	429x	name = "test",
352	429x	color= hsv(color[1],color[2],color[3]),
353	429x	width= abs(network.thickness[i]) * enaplot$get("multiplier"),
354	429x	dash = edge_type
355		),
356	429x	x0 = as.numeric(v0[1]),
357	429x	y0 = as.numeric(v0[2]),
358	429x	x1 = as.numeric(v1[1]),
359	429x	y1 = as.numeric(v1[2]),
360	429x	layer = "below",
361	429x	size = as.numeric(abs(network.scaled[i])),
362	429x	self = is.self
363		);
364	429x	network.edges.shapes[[i]] = edge_shape
365		};
366
367	29x	if(thin.lines.in.front) {
368	29x	network.edges.shapes = network.edges.shapes[rev(order(sapply(network.edges.shapes, "[[", "size")))]
369		}
370		else {
371	!	network.edges.shapes = network.edges.shapes[order(sapply(network.edges.shapes, "[[", "size"))]
372		}
373
374	29x	rows.to.keep = rep(T, nrow(nodes))
375	29x	if(show.all.nodes == F) {
376	1x	rows.to.keep = nodes$weight != 0
377		# nodes = nodes[rownames(nodes) %in% unique(as.character(sapply(network.edges.shapes, "[[", "nodes"))), ]
378		}
379	29x	nodes = nodes[rows.to.keep,];
380	29x	mode = "markers+text"
381	29x	if(!is.null(args$labels.hide) && args$labels.hide == T) {
382	!	mode="markers"
383		}
384	29x	if( any(nodes$weight > 0)) {
385	29x	nodes$weight = scales::rescale((nodes$weight * (1 / max(abs(nodes$weight)))), node.size) # * enaplot$get("multiplier"));
386		}
387		else {
388	!	nodes$weight = node.size[2]
389		}
390		# Self-connections are circles on their node, as wide as an edge of the same
391		# weight (the edges' scale); a node is never drawn smaller than its circle.
392	29x	for (e in network.edges.shapes) {
393	429x	if (isTRUE(e$self)) {
394	18x	on.node <- node.rows[rows.to.keep] == e$nodes[1]
395	18x	nodes$weight[on.node] = pmax(nodes$weight[on.node], e$line$width)
396		}
397		}
398
399	29x	show.legend = !is.null(legend.name);
400	29x	if(legend.include.edges) {
401	!	if(is.null(legend.name)) {
402	!	legend.name = "Nodes"
403		}
404	!	show.legend = T;
405		}
406
407		# browser()
408	29x	environment(plot_nodes) <- environment()
409	29x	environment(plot_edges) <- environment()
410
411	29x	for(layer in layers) {
412	58x	enaplot$plot <- do.call(what = paste0("plot_", layer), args = list())
413		}
414
415	29x	enaplot
416		}

1		# R wrappers that preserve rENA's long-standing function names. The math
2		# lives in C++: ENA model code in libena (inst/include/libena, wrapped in
3		# src/libena_rcpp.cpp), accumulation in tma (libtma) and generic numerics in
4		# libqe.
5		#
6		# Public API functions (exported) are marked @export.
7		# Internal functions (not exported) have no @export tag.
8
9		# ── public API ────────────────────────────────────────────────────────────────
10
11		#' Merge data frame columns
12		#'
13		#' Paste together multiple columns of a data frame or data.table with a
14		#' separator, used internally to construct unit-ID strings.
15		#'
16		#' @param df A data.frame or data.table
17		#' @param cols Character vector of column names to paste together
18		#' @param sep Separator string (default "::")
19		#' @return A character vector of length \code{nrow(df)}
20		#' @export
21		merge_columns_c <- function(df, cols, sep = "::") {
22	351x	do.call(paste, c(lapply(cols, function(col) df[[col]]), list(sep = sep)))
23		}
24
25		#' Row-wise L2 (Sphere) Normalization
26		#'
27		#' Normalizes each row of a numeric data frame or matrix to unit L2 norm.
28		#'
29		#' @param dfM A data.frame or matrix
30		#' @return A numeric matrix with each row normalized to unit L2 length
31		#' @export
32		fun_sphere_norm <- function(dfM) {
33	165x	libqe::normalize_networks(as.matrix(dfM))
34		}
35
36		#' Row-wise Max-Norm Scaling
37		#'
38		#' Scales all rows of a numeric data frame by dividing by the largest row
39		#' L2 norm.
40		#'
41		#' @param dfM A data.frame or matrix
42		#' @return A numeric matrix scaled by the largest row L2 norm
43		#' @export
44		fun_skip_sphere_norm <- function(dfM) {
45	7x	libqe::scale_networks(as.matrix(dfM))
46		}
47
48		#' Upper Triangle from Vector (numeric)
49		#'
50		#' Compute pairwise products v[j] * v[i] for all j < i.
51		#'
52		#' @param v Numeric vector or single-row matrix
53		#' @return Numeric row vector of pairwise products
54		#' @export
55		vector_to_ut <- function(v) {
56	!	libqe::code_connections(as.matrix(v))
57		}
58
59		#' Directed ENA node positions
60		#'
61		#' Least-squares node positions for directed ENA.
62		#'
63		#' @param line_weights Numeric matrix (units x connections)
64		#' @param points Numeric matrix of rotated points (units x dims)
65		#' @param numDims Number of dimensions
66		#' @param self_weight Weight of a self-connection (the diagonal: ground i -> response i) in its code's node weight: 2 (default) counts it in both the node's row and column sums (Zhiqiang Cai's 2021 in + out rule); 1 counts it once.
67		#' @return List with nodes, centroids, weights, points
68		#' @export
69		directed_node_positions <- function(line_weights, points, numDims, self_weight = 2) {
70	19x	directed_node_positions_c(line_weights, points, numDims, self_weight)
71		}
72
73		#' Directed node positions with ground+response combined
74		#'
75		#' Directed node positions with paired ground+response rows combined.
76		#'
77		#' @param line_weights Numeric matrix (units x connections)
78		#' @param points Numeric matrix of rotated points (units x dims)
79		#' @param numDims Number of dimensions
80		#' @param self_weight Weight of a self-connection (the diagonal: ground i -> response i) in its code's node weight: 2 (default) counts it in both the node's row and column sums (Zhiqiang Cai's 2021 in + out rule); 1 counts it once.
81		#' @return List with nodes, centroids, weights, points
82		#' @export
83		directed_node_positions_with_ground_response_added <- function(line_weights,
84		points,
85		numDims,
86		self_weight = 2) {
87	!	directed_node_positions_combine_pairs(line_weights, points, numDims, self_weight)
88		}
89
90		#' Layout-agnostic node positions from an adjacency key
91		#'
92		#' Node optimization for any connection layout -- undirected, undirected with
93		#' self-connections, or ordered: every connection counts toward each code it
94		#' connects, a self-connection (a column whose two codes are the same) toward
95		#' its code \code{self_weight} times; each unit's weights are then
96		#' L1-normalised and the nodes solved by least squares against the points.
97		#' With an undirected key it matches \code{lws_lsq_positions()}; with an
98		#' ordered key, \code{directed_node_positions()} at the same \code{self_weight}.
99		#'
100		#' @param line_weights Numeric matrix (units x connections)
101		#' @param points Numeric matrix of rotated points (units x dims)
102		#' @param numDims Number of dimensions
103		#' @param key Adjacency key: a 2 x n_connections matrix of code names,
104		#' one column per connection (e.g. \code{set$rotation$adjacency.key})
105		#' @param codes Character vector of codes; node order
106		#' @param self_weight Weight of a self-connection in its code's node weight
107		#' (2 = row + column sum, as ordered models; 1 = once)
108		#' @return List with nodes, centroids, weights, points
109		#' @export
110		node_positions_by_key <- function(line_weights, points, numDims, key, codes, self_weight = 2) {
111	51x	ft <- key_indices(key, codes)
112	50x	node_positions_by_key_c(as.matrix(line_weights), as.matrix(points), numDims,
113	50x	ft$from, ft$to, length(codes), self_weight)
114		}
115
116		#' Layout-agnostic node centroids from an adjacency key
117		#'
118		#' The weighting of \code{node_positions_by_key()} times \code{nodes}.
119		#'
120		#' @inheritParams node_positions_by_key
121		#' @param nodes Numeric matrix of node positions (codes x dims), in \code{codes} order
122		#' @return Numeric matrix of centroids (units x dims)
123		#' @export
124		node_centroids_by_key <- function(line_weights, nodes, key, codes, self_weight = 2) {
125	1x	ft <- key_indices(key, codes)
126	1x	node_centroids_by_key_c(as.matrix(line_weights), as.matrix(nodes), ft$from, ft$to, self_weight)
127		}
128
129		# The codes as the key names them: the key is built from the connection
130		# column names, which may be make.names() of the codes.
131		key_codes <- function(key, codes) {
132	78x	named <- unique(as.character(as.matrix(key)))
133	!	if (all(named %in% codes)) codes else make.names(codes)
134		}
135
136		# 0-based code indices of each key column.
137		key_indices <- function(key, codes) {
138	86x	key <- as.matrix(key)
139	!	if (nrow(key) != 2) stop("key must have 2 rows (one column per connection)")
140	86x	from <- match(as.character(key[1, ]), codes)
141	86x	to <- match(as.character(key[2, ]), codes)
142	86x	if (anyNA(c(from, to))) {
143	1x	stop("key names codes not in `codes`: ",
144	1x	paste(unique(c(key[1, is.na(from)], key[2, is.na(to)])), collapse = ", "))
145		}
146	85x	list(from = from - 1L, to = to - 1L)
147		}
148
149		#' Calculate ENA correlations
150		#'
151		#' Pearson correlation with confidence interval between ENA points and
152		#' centroids.
153		#'
154		#' @param points Numeric matrix (units x dims)
155		#' @param centroids Numeric matrix (units x dims)
156		#' @param conf_level Confidence level (default 0.95)
157		#' @return Numeric matrix with columns: r, lower CI, upper CI
158		#' @export
159		ena_correlation <- function(points, centroids, conf_level = 0.95) {
160	!	ena_correlation_c(points, centroids, conf_level)
161		}
162
163		#' Confidence intervals around group mean positions
164		#'
165		#' Per-dimension t-based confidence intervals around the column means of a
166		#' numeric matrix of ENA points.
167		#'
168		#' @param points Numeric matrix (units x dims)
169		#' @param conf_level Confidence level (default 0.95)
170		#' @return Numeric matrix (dims x 3): mean, lower CI, upper CI
171		#' @export
172		ena_mean_ci <- function(points, conf_level = 0.95) {
173	7x	libqe::mean_ci(as.matrix(points), conf_level)
174		}
175
176		#' Outlier (Tukey-fence) intervals for group positions
177		#'
178		#' Per-dimension Tukey-fence intervals: Q1 - kIQR to Q3 + kIQR.
179		#'
180		#' @param points Numeric matrix (units x dims)
181		#' @param iqr_factor IQR multiplier (default 1.5)
182		#' @return Numeric matrix (dims x 2): lower fence, upper fence
183		#' @export
184		ena_outlier_ci <- function(points, iqr_factor = 1.5) {
185	6x	libqe::outlier_ci(as.matrix(points), iqr_factor)
186		}
187
188		#' Two-group comparison statistics for ENA points
189		#'
190		#' Per-dimension parametric (Welch t-test, Cohen's d) and non-parametric
191		#' (Wilcoxon rank-sum, rank-biserial r) statistics comparing two groups.
192		#'
193		#' @param g1 Numeric matrix of group 1 points (units x dims)
194		#' @param g2 Numeric matrix of group 2 points (units x dims)
195		#' @return List with: n1, n2, t, df, pvalue_t, cohens_d, means, sds,
196		#' U, pvalue_u, effect_r, medians — each a vector/matrix of length dims
197		#' @export
198		ena_group_stats <- function(g1, g2) {
199	8x	libqe::group_stats(as.matrix(g1), as.matrix(g2))
200		}
201
202		# ── internal (not exported) ───────────────────────────────────────────────────
203
204		# Per-row upper-triangle co-occurrence.
205		# @param df A data.frame or matrix of code columns
206		# @param binary If TRUE, binarise non-zero products
207		rows_to_co_occurrences <- function(df, binary = TRUE) {
208	51x	tma::row_connections(as.matrix(df), binary)
209		}
210
211		# Stanza-window co-occurrence accumulation.
212		# @param df A data.frame or matrix of code columns
213		# @param windowSize Rows to look back (default 1; Inf = whole conversation)
214		# @param windowForward Rows to look forward (default 0)
215		# @param binary Binarise co-occurrence counts (default TRUE)
216		ref_window_df <- function(df, windowSize = 1, windowForward = 0,
217		binary = TRUE) {
218	2434x	INT_MAX <- .Machine$integer.max
219	2434x	wb <- if (is.infinite(windowSize) \|\| windowSize >= INT_MAX) INT_MAX
220	2434x	else as.integer(windowSize)
221	2434x	wf <- if (is.infinite(windowForward) \|\| windowForward >= INT_MAX) INT_MAX
222	2434x	else as.integer(windowForward)
223	2434x	data.table::as.data.table(tma::accumulate_stanza(as.matrix(df), wb, wf, binary))
224		}
225
226		# Rolling backward window sum of code columns.
227		# @param df A data.frame or matrix of code columns
228		# @param windowSize Number of rows to look back (default 0, treated as 1)
229		# @param binary Unused; kept for API compatibility
230		ref_window_lag <- function(df, windowSize = 0, binary = TRUE) {
231	198x	tma::rolling_window_sum(as.matrix(df), windowSize)
232		}
233
234		# Upper-triangle index pairs (0-based, +1 before use as R indices).
235		# @param len Side length of square code matrix
236		# @param row -1 = both rows, 0 = row indices, 1 = col indices
237		triIndices <- function(len, row = -1L) {
238	176x	libqe::connection_indices(len, row)
239		}
240
241		# Least-squares node positions (undirected ENA).
242		# @param adjMats Numeric matrix of line weights (units x connections)
243		# @param t Numeric matrix of rotated points (units x dims)
244		# @param numDims Number of dimensions
245		lws_lsq_positions <- function(adjMats, t, numDims) {
246	89x	node_positions(adjMats, t, numDims)
247		}
248
249		# String upper-triangle pairs: "A" "B" "C" -> "A & B" "A & C" "B & C".
250		# @param v Character vector of code names
251		svector_to_ut <- function(v) {
252	102x	libqe::connection_names(v)
253		}
254
255		# Center data by subtracting column means.
256		# @param values Numeric matrix or data.frame
257		center_data_c <- function(values) {
258	163x	libqe::center_points(as.matrix(values))
259		}

1		####
2		#' ENAdata R6class
3		#'
4		#' @docType class
5		#' @importFrom R6 R6Class
6		#' @import data.table
7		#' @export
8		#'
9		#' @field raw A data frame constructed from the unit, convo, code, and metadata parameters of ena.accumulate.data
10		#' @field adjacency.vectors A data frame of adjacency (co-occurrence) vectors by row
11		#' @field accumulated.adjacency.vectors A data frame of adjacency (co-occurrence) vectors accumulated per unit
12		#' @field model The type of ENA model: EndPoint, Accumulated Trajectory, or Separate Trajectory
13		#' @field units A data frame of columns that were combined to make the unique units. Includes column for trajectory selections. (unique)
14		#' @field unit.names A vector of unique unit values
15		#' @field metadata A data frame of unique metadata for each unit
16		#' @field trajectories A list: units - data frame, for a given row tells which trajectory it's a part; step - data frame, where along the trajectory a row sits
17		#'
18		#' @field adjacency.matrix TBD
19		#' @field adjacency.vectors.raw TBD
20		#' @field codes A vector of code names
21		#' @field function.call The string representation of function called and parameters provided
22		#' @field function.params A list of all parameters sent to function call
23		####
24		ENAdata <- R6::R6Class("ENAdata", public = list(
25
26		#' Construct ENAdata
27		#'
28		#' @param file TBD
29		#' @param units TBD
30		#' @param units.used TBD
31		#' @param units.by TBD
32		#' @param conversations.by TBD
33		#' @param codes TBD
34		#' @param model TBD
35		#' @param weight.by TBD
36		#' @param window.size.back TBD
37		#' @param window.size.forward TBD
38		#' @param mask TBD
39		#' @param include.meta logical, if TRUE (default) unit metadata is attached to the resulting ENAdata object and accessible via the set; set to FALSE to omit metadata from the model output
40		#' @param ... TBD
41		#'
42		#' @return
43		initialize = function(
44		file,
45		units = NULL,
46		units.used = NULL,
47		units.by = NULL,
48		conversations.by = NULL,
49		codes = NULL,
50		model = NULL,
51		weight.by = "binary",
52		window.size.back = 1,
53		window.size.forward = 0,
54		mask = NULL,
55		include.meta = T,
56		...
57		) {
58	141x	args <- list(...);
59	141x	self$function.call <- sys.call(-1);
60	141x	self$function.params <- list();
61
62	141x	private$file <- file;
63	141x	self$units <- units;
64	141x	private$units.used <- units.used;
65	141x	private$units.by <- units.by
66	141x	private$conversations.by <- conversations.by;
67	141x	self$codes <- codes;
68
69	141x	if (is.data.frame(self$codes)) {
70	94x	self$codes <- colnames(self$codes);
71		}
72
73	141x	private$weight.by <- weight.by;
74	141x	private$window.size <- list(
75	141x	"back" = window.size.back,
76	141x	"forward" = window.size.forward
77		);
78
79	141x	for (p in c("units", "units.used", "units.by",
80	141x	"conversations.by", "codes", "model", "weight.by",
81	141x	"window.size.back", "window.size.forward", "mask",
82	141x	"in.par", "grainSize", "include.meta")
83		) {
84	1833x	if (exists(p, inherits = FALSE)) {
85	1551x	self$function.params[[p]] <- get(p, inherits = FALSE)
86		}
87	282x	else if (!is.null(args[[p]])) {
88	1x	self$function.params[[p]] <- args[[p]]
89		}
90		}
91
92	141x	self$model <- model
93
94	141x	private$mask <- mask
95
96	141x	return(self)
97		},
98
99		## Public Properties ----
100		model = NULL,
101		raw = NULL,
102		adjacency.vectors = NULL,
103		adjacency.matrix = NULL,
104		accumulated.adjacency.vectors = NULL,
105		adjacency.vectors.raw = NULL,
106		units = NULL,
107		unit.names = NULL,
108		metadata = NULL,
109		trajectories = list(
110		units = NULL,
111		step = NULL
112		),
113		codes = NULL,
114		function.call = NULL,
115		function.params = NULL,
116
117		## Public Functions ----
118
119		#' Process accumulation
120		#'
121		#' @return ENAdata
122		process = function() {
123	141x	private$loadFile();
124		},
125
126		#' Get property from object
127		#'
128		#' @param x character key to retrieve from object
129		#' @return value from object at x
130		get = function(x = "data") {
131	116183x	return(private[[x]])
132		},
133
134		#' Add metadata
135		#'
136		#' @param merge logical (default: FALSE)
137		#'
138		#' @return data.frame
139		add.metadata = function(merge = F) {
140	139x	meta_avail <- colnames(self$raw)[
141	139x	-which(colnames(self$raw) %in%
142	139x	c(self$codes, private$units.by, private$conversations.by))]
143		# c(self$codes, private$units.by))] # private$conversations.by))]
144
145	139x	meta_avail <- meta_avail[which(meta_avail != "ENA_UNIT")]
146	139x	meta_cols_to_use <- meta_avail[apply(self$raw[, lapply(.SD, uniqueN),
147	139x	by = c(private$units.by),
148	139x	.SDcols = meta_avail
149	139x	][, c(meta_avail), with = F]
150	139x	, 2, function(x) all(x == 1))
151		]
152	139x	raw.meta <- self$raw[!duplicated(ENA_UNIT)][
153	139x	ENA_UNIT %in% unique(
154	139x	self$accumulated.adjacency.vectors$ENA_UNIT
155		),
156	139x	c("ENA_UNIT", private$units.by, meta_cols_to_use),
157	139x	with = F
158		]
159
160	139x	df_to_return <- raw.meta[ENA_UNIT %in% self$unit.names,];
161
162	139x	return(df_to_return)
163		}
164
165		),
166
167		### Private ----
168		private = list(
169
170		## Private Properties ----
171		file = NULL,
172		window.size = NULL,
173		units.used = NULL,
174		units.by = NULL,
175		conversations.by = NULL,
176		weight.by = NULL,
177		trajectory.by = NULL,
178		mask = NULL,
179
180		## Private Functions ----
181		loadFile = function() {
182	141x	if(any(class(private$file) == "data.table")) {
183	30x	df_DT <- private$file
184		} else {
185	111x	if(any(class(private$file) == "data.frame")) {
186	111x	df <- private$file
187		} else {
188	!	df <- read.csv(private$file)
189		}
190	111x	df_DT <- data.table::as.data.table(df)
191		}
192
193	141x	self$raw <- data.table::copy(df_DT)
194	141x	self$raw$ENA_UNIT <- merge_columns_c(self$raw, private$units.by, "::")
195
196	141x	self <- accumulate.data(self)
197	140x	self$units <- self$adjacency.vectors[, private$units.by, with = F]
198
199	140x	if (!self$model %in% c("AccumulatedTrajectory", "SeparateTrajectory")) {
200	130x	self$unit.names <- self$adjacency.vectors$ENA_UNIT
201		}
202		else {
203	10x	self$trajectories$units <- self$units
204	10x	conversation <- self$adjacency.vectors[, private$conversations.by, with = F];
205
206	10x	self$trajectories$step <- conversation
207	10x	self$units <- cbind(self$units, conversation)
208	10x	self$unit.names <- paste(
209	10x	self$adjacency.vectors$ENA_UNIT,
210	10x	self$adjacency.vectors$TRAJ_UNIT,
211	10x	sep = "::"
212		)
213		}
214
215	140x	self$adjacency.vectors.raw <- self$adjacency.vectors
216
217	140x	adjCols <- colnames(self$adjacency.vectors)[
218	140x	grep("adjacency.code", colnames(self$adjacency.vectors))
219		];
220
221	140x	if (is.null(private$mask)) {
222	139x	private$mask <- matrix(1,
223	139x	nrow = length(self$codes),
224	139x	ncol = length(self$codes),
225	139x	dimnames = list(self$codes, self$codes))
226		}
227
228	140x	self$adjacency.vectors[, c(adjCols)] <-
229	140x	self$adjacency.vectors[, c(adjCols), with = F] *
230	140x	rep(
231	140x	private$mask[upper.tri(private$mask)],
232	140x	rep(nrow(self$adjacency.vectors), length(adjCols))
233		)
234
235		# if( is.function(private$weight.by) ) {
236		# cols <- colnames(self$adjacency.vectors)[
237		# grep("adjacency.code", colnames(self$adjacency.vectors))
238		# ]
239		# self$adjacency.vectors <- self$adjacency.vectors[,
240		# lapply(
241		# .SD,
242		# private$weight.by
243		# ),
244		# .SDcols = cols,
245		# by = 1:nrow(self$adjacency.vectors)
246		# ]
247		# }
248
249	140x	if( self$function.params$include.meta == T) {
250	139x	self$metadata <- self$add.metadata(merge = F);
251		} else {
252	1x	self$metadata <- data.frame();
253		}
254
255	140x	self$adjacency.vectors <- self$adjacency.vectors[,
256	140x	grep("adjacency.code",
257	140x	colnames(self$adjacency.vectors)),
258	140x	with = F
259		]
260
261	140x	return(self);
262		}
263		)
264		)

1		#' ENA line weights as matrix
2		#'
3		#' @param x ena.line.weights data.table to covert to matrix
4		#' @param ... additional arguments to be passed to or from methods
5		#' @param square [TBD]
6		#'
7		#' @return matrix
8		#' @export
9		as.matrix.ena.line.weights <- function(x, ..., square = FALSE) {
10	468x	args = list(...)
11
12		# if(!is.null(args$square))
13		# square = args$square
14
15		# class(x) = class(x)[-1]
16	468x	x.unclass <- data.table::as.data.table(unclass(x))
17	468x	rows = x.unclass[, !find_meta_cols(x.unclass), with = F]
18
19	468x	if(square) {
20	1x	upperTriSize = ncol(rows)
21	1x	number = ( (ceiling(sqrt(2upperTriSize)) ^ 2) ) - (2upperTriSize)
22	1x	codes = unique(unlist(sapply(colnames(rows), strsplit, split = " & ")))
23	1x	cm = sapply(seq(nrow(rows)), function(unit) {
24	1x	m = matrix(NA, number, number, dimnames = list(codes, codes))
25	1x	m[upper.tri(m)] = as.numeric(rows[unit,])
26	1x	m
27	1x	}, simplify = F);
28	1x	return(cm)
29		}
30		else {
31	467x	as.matrix(remove_meta_data(rows), ...)
32		}
33		}
34
35		#' ENA rotations as matrix
36		#'
37		#' @param x ena.rotation.matrix to conver to matrix
38		#' @param ... additional arguments to be passed to or from methods
39		#'
40		#' @return matrix
41		#' @export
42		as.matrix.ena.rotation.matrix <- function(x, ...) {
43	244x	class(x) = class(x)[-1]
44	244x	x = remove_meta_data(x)
45	244x	as.matrix(x, ...)
46		}
47
48		#' ENA points as matrix
49		#'
50		#' @param x ena.points to convert to a matrix
51		#' @param ... additional arguments to be passed to or from methods
52		#'
53		#' @return matrix
54		#' @export
55		as.matrix.ena.points <- function(x, ...) {
56	580x	class(x) = class(x)[-1]
57	580x	x = remove_meta_data(x)
58	580x	as.matrix(x, ...)
59		}
60
61		#' Matrix without metadata
62		#'
63		#' @param x Object to convert to a matrix
64		#' @param ... additional arguments to be passed to or from methods
65		#'
66		#' @return matrix
67		#' @export
68		as.matrix.ena.matrix <- function(x, ...) {
69	78x	class(x) = class(x)[-1]
70	78x	x = remove_meta_data(x)
71	78x	as.matrix(x, ...)
72		}
73
74		#' ENA nodes as matrix
75		#'
76		#' @param x ena.nodes to convert to matrix
77		#' @param ... additional arguments to be passed to or from methods
78		#'
79		#' @return matrix
80		#' @export
81		as.matrix.ena.nodes <- function(x, ...) {
82	371x	class(x) = class(x)[-1]
83	371x	as.matrix(x[,-c("code")], ...)
84		}
85
86		#' ENA row connections as matrix
87		#'
88		#' @param x ena.row.connections to conver to a matrix
89		#' @param ... additional arguments to be passed to or from methods
90		#'
91		#' @return matrix
92		#' @export
93		as.matrix.row.connections <- function(x, ...) {
94	20x	class(x) = class(x)[-1]
95	20x	as.matrix(x[, sapply(x, is, class2="ena.co.occurrence"), with = F], ...)
96		}
97
98
99		#' ENA Connections as a matrix
100		#'
101		#' @param x ena.connections object
102		#' @param ... additional arguments to be passed to or from methods
103		# @param square Logical. If TRUE, each row is converted to a square matrix
104		# @param simplify Logical. If TRUE, returns back a single result as vector
105		# @param names Ignored
106		#'
107		#' @return If square is FALSE (default), a matrix with all metadata columns removed, otherwise a list with square matrices
108		#' @export
109		as.matrix.ena.connections <- function(x, ...) {
110	276x	class(x) = class(x)[-1]
111	276x	xx = remove_meta_data(x)
112	276x	rows = as.data.frame(x)[, !find_meta_cols(x), drop = F]
113
114	276x	args = list(...)
115	276x	if(is.null(args$square))
116	271x	square = F
117		else
118	5x	square = args$square
119
120	276x	names = args$names
121
122	276x	if(is.null(args$simplify))
123	272x	simplify = ifelse(nrow(x) > 1, F, T)
124		else
125	4x	simplify = args$simplify
126
127	276x	if(square) {
128	5x	upperTriSize = ncol(rows)
129	5x	number = ( (ceiling(sqrt(2upperTriSize)) ^ 2) ) - (2upperTriSize)
130	5x	codes = unique(unlist(sapply(colnames(rows), strsplit, split = " & ")))
131	5x	cm = sapply(seq(nrow(rows)), function(unit) {
132	99x	m = matrix(NA, number, number, dimnames = list(codes, codes))
133	99x	m[upper.tri(m)] = as.numeric(rows[unit,])
134	99x	m
135	5x	}, simplify = F)
136
137	5x	if(simplify) {
138	2x	cm = cm[[1]]
139		} else {
140	3x	names(cm) = names
141		}
142		} else {
143	271x	cm = as.matrix(rows)
144	271x	rownames(cm) = names
145		}
146
147	276x	cm
148		}

1		#' Tune Window Size for ENA Accumulation
2		#'
3		#' Estimates the optimal moving window size for discourse accumulation and returns a new
4		#' accumulation object constructed with the tuned window size. By default, uses Cross-Covariance
5		#' Decay (CCD; \code{method = "ccd"}) to estimate the discourse coherence length.
6		#' Alternatively, the legacy SVD projection stability heuristic (\code{method = "stability"})
7		#' can be used.
8		#'
9		#' @param accum_object An \code{ENAAccumulation}/\code{ENAdata}/\code{ena.set} object.
10		#' @param min_size Integer. The minimum window size (default=1) to test.
11		#' @param max_size Integer. The maximum window size (default=20) to test.
12		#' @param method Character. Window estimation method: \code{"ccd"} (default, Cross-Covariance Decay)
13		#' or \code{"stability"} (legacy SVD stability plateau).
14		#' @param cutoff Numeric. The threshold (default 0.95) of the maximum correlation used when
15		#' \code{method = "stability"}.
16		#' @param min_overlap Integer. Minimum required overlapping rows per conversation when
17		#' \code{method = "ccd"} (default=10).
18		#' @param ... Additional arguments passed to the underlying window estimation function.
19		#'
20		#' @details
21		#' When \code{method = "ccd"} (default), the function uses \code{\link{ena.ccd.window}} to calculate
22		#' the discourse coherence half-life decay lag directly from the conversation stream.
23		#'
24		#' When \code{method = "stability"}, the function iteratively rebuilds accumulation objects across
25		#' candidate window sizes, generates ENA sets, and computes distance-space correlations
26		#' between adjacent window sizes until reaching \code{cutoff * max_correlation}.
27		#'
28		#' @return A new \code{ENAdata}/\code{ena.set} object accumulated with the \code{best_window_size}.
29		#'
30		#' @export
31		#' @importFrom rENA ena.make.set ena_space_dist_corr ena.ccd.window
32		#'
33		#' @examples
34		#' \dontrun{
35		#' data(RS.data)
36		#' codeNames <- c("Data", "Technical.Constraints", "Performance.Parameters",
37		#' "Client.and.Consultant.Requests", "Design.Reasoning", "Collaboration")
38		#' accum <- ena.accumulate.data(
39		#' units = RS.data[, c("UserName", "Condition")],
40		#' conversation = RS.data[, c("Condition", "GroupName")],
41		#' codes = RS.data[, codeNames],
42		#' window.size.back = 4
43		#' )
44		#' tuned_accum <- ena.tune.window.size(accum, method = "ccd")
45		#' }
46		ena.tune.window.size <- function(
47		accum_object,
48		min_size = 1,
49		max_size = 20,
50		method = c("ccd", "stability"),
51		cutoff = 0.95,
52		min_overlap = 10,
53		...
54		) {
55	3x	method <- match.arg(method)
56
57	3x	if (method == "ccd") {
58	2x	best_window_size <- ena.ccd.window(
59	2x	x = accum_object,
60	2x	max_window = max_size,
61	2x	min_overlap = min_overlap
62		)
63		} else {
64		# Legacy stability plateau method
65	1x	window_range <- min_size:max_size
66	1x	all_points <- list()
67
68	1x	for (i in seq_along(window_range)) {
69	4x	window_size <- window_range[i]
70	4x	new_accum <- rebuild_accumulation(accum_object, window_size)
71	4x	if (is.null(new_accum))
72	!	stop("method = \"stability\" needs an accumulation made by ena.accumulate.data().")
73	4x	curr_set <- rENA::ena.make.set(new_accum)
74	4x	points <- as.matrix(curr_set$points)
75	4x	all_points[[i]] <- points
76		}
77
78	1x	n_steps <- length(window_range) - 1
79	1x	adj_correlations <- numeric(n_steps)
80
81	1x	for (i in 1:n_steps) {
82	3x	adj_correlations[i] <- rENA::ena_space_dist_corr(all_points[[i]], all_points[[i + 1]])
83		}
84
85	1x	max_corr <- max(adj_correlations, na.rm = TRUE)
86	1x	threshold <- cutoff * max_corr
87	1x	best_idx <- which(adj_correlations >= threshold)[1]
88	1x	best_window_size <- window_range[best_idx]
89		}
90
91		# Rebuild accumulation at best_window_size
92		# Method 1: re-run ena.accumulate.data() with the original arguments
93	3x	res <- rebuild_accumulation(accum_object, best_window_size)
94	3x	if (!is.null(res)) return(res)
95
96		# Method 2: Robust fallback - rebuild directly from object fields
97	!	raw_df <- if (!is.null(accum_object$model$raw.input)) {
98	!	as.data.frame(accum_object$model$raw.input)
99	!	} else if (!is.null(accum_object$raw)) {
100	!	as.data.frame(accum_object$raw)
101	!	} else if (!is.null(accum_object$data)) {
102	!	as.data.frame(accum_object$data)
103	!	} else if (!is.null(accum_object$`_function.params`$data)) {
104	!	as.data.frame(accum_object$`_function.params`$data)
105		} else {
106	!	NULL
107		}
108
109	!	if (!is.null(raw_df) && any(duplicated(colnames(raw_df)))) {
110	!	raw_df <- raw_df[, !duplicated(colnames(raw_df)), drop = FALSE]
111		}
112
113	!	units_by <- if (!is.null(accum_object$units.by)) {
114	!	accum_object$units.by
115	!	} else if (!is.null(accum_object$model$units.by)) {
116	!	accum_object$model$units.by
117	!	} else if (!is.null(accum_object$`_function.params`$units.by)) {
118	!	accum_object$`_function.params`$units.by
119	!	} else if (!is.null(accum_object$unit.names)) {
120	!	accum_object$unit.names
121		} else {
122	!	NULL
123		}
124
125	!	convo_by <- if (!is.null(accum_object$conversations.by)) {
126	!	accum_object$conversations.by
127	!	} else if (!is.null(accum_object$model$conversations.by)) {
128	!	accum_object$model$conversations.by
129	!	} else if (!is.null(accum_object$`_function.params`$conversations.by)) {
130	!	accum_object$`_function.params`$conversations.by
131		} else {
132	!	NULL
133		}
134
135	!	codes_by <- if (!is.null(accum_object$model$codes)) {
136	!	accum_object$model$codes
137	!	} else if (!is.null(accum_object$codes)) {
138	!	if (is.data.frame(accum_object$codes) \|\| is.matrix(accum_object$codes)) {
139	!	colnames(accum_object$codes)
140		} else {
141	!	as.character(accum_object$codes)
142		}
143	!	} else if (!is.null(accum_object$`_function.params`$codes)) {
144	!	if (is.data.frame(accum_object$`_function.params`$codes) \|\| is.matrix(accum_object$`_function.params`$codes)) {
145	!	colnames(accum_object$`_function.params`$codes)
146		} else {
147	!	as.character(accum_object$`_function.params`$codes)
148		}
149		} else {
150	!	NULL
151		}
152
153	!	if (!is.null(raw_df) && !is.null(units_by) && !is.null(convo_by) && !is.null(codes_by)) {
154	!	return(ena.accumulate.data(
155	!	units = raw_df[, units_by, drop = FALSE],
156	!	conversation = raw_df[, convo_by, drop = FALSE],
157	!	codes = raw_df[, codes_by, drop = FALSE],
158	!	window.size.back = best_window_size
159		))
160		}
161
162	!	return(best_window_size)
163		}
164
165		# Re-run ena.accumulate.data() with the arguments `accum_object` was made with
166		# (its `_function.params`), changing only window.size.back. Returns NULL when
167		# those arguments aren't available (e.g. an accumulation from a file).
168		#
169		# The stored `_function.call` is never evaluated: it is the outermost call on
170		# the stack when the set was made (a user's wrapper function, test_that(), a
171		# Shiny observer, ...), so evaluating it re-runs arbitrary code, and for an
172		# accumulation loaded from a file it is whatever call that file contains.
173		#
174		# The window argument is deliberately not called window.size.back: ena.set()
175		# records the parameters of the first frame on the stack that has a variable
176		# of that name, which must be ena.accumulate.data()'s, not this function's.
177		rebuild_accumulation <- function(accum_object, window_size) {
178	7x	params <- accum_object$`_function.params`
179	7x	arg_names <- setdiff(names(formals(ena.accumulate.data)), "...")
180	7x	args <- params[intersect(names(params), arg_names)]
181	!	if (!all(c("units", "conversation", "codes") %in% names(args))) return(NULL)
182	7x	args[["window.size.back"]] <- window_size
183	7x	do.call(ena.accumulate.data, args)
184		}

1		#' Re-class matrix as ena.matrix
2		#'
3		#' @param x data.frame, data.table, or matrix to extend
4		#' @param new.class Additional class to extend the matrix with, default: NULL
5		#'
6		#' @return Object of same st
7		#' @export
8		as.ena.matrix <- function(x, new.class = NULL) {
9	397x	class(x) = c(new.class, "ena.matrix", class(x))
10	397x	x
11		}
12
13		#' Re-class matrix as ena.metadata
14		#'
15		#' @param x data.frame, data.table, or matrix to extend
16		#'
17		#' @return Object of same st
18		#' @export
19		as.ena.metadata <- function(x) {
20	1392x	if(is.factor(x)) {
21	!	x = as.character(x)
22		}
23	1392x	class(x) = c("ena.metadata", "character") # This fails in the $.ena.metadata if is extending character, class(x))
24	1392x	x
25		}
26		as.ena.code <- function(x) {
27	698x	if(is.factor(x)) {
28	1x	x = as.character(x)
29		}
30	698x	class(x) = c("ena.code", class(x))
31	698x	x
32		}
33		as.ena.codes <- function(x) {
34	1614x	if(is.factor(x)) {
35	1x	x = as.character(x)
36		}
37	1614x	class(x) = c("ena.codes", class(x))
38	1614x	x
39		}
40		#' Re-class vector as ena.co.occurrence
41		#'
42		#' @param x Vector to re-class
43		#'
44		#' @return re-classed vector
45		#' @export
46		as.ena.co.occurrence <- function(x) {
47	9751x	if(is.factor(x)) {
48	1x	x = as.character(x)
49		}
50	9751x	class(x) = c("ena.co.occurrence", class(x))
51	9751x	x
52		}
53		#' Re-class vector as ena.dimension
54		#'
55		#' @param x Vector to re-class
56		#'
57		#' @return re-classed vector
58		#' @export
59		as.ena.dimension <- function(x) {
60	9827x	if(is.factor(x)) {
61	1x	x = as.character(x)
62		}
63	9827x	class(x) = c("ena.dimension", class(x))
64	9827x	x
65		}

1		##
2		#' @title Compute summary statistic for groupings of units using given method (typically, mean)
3		#'
4		#' @description Computes summary statistics for groupings (given as vector) of units in ena data using given method (typically, mean); computes summary statistic for point locations and edge weights for each grouping
5		#'
6		#' @export
7		#'
8		#' @param enaset An \code{\link{ENAset}} or a vector of values to group.
9		#' @param by A vector of values the same length as units. Uses rotated points for group positions and normed data to get the group edge weights
10		#' @param method A function that is used on grouped points. Default: mean(). If `enaset` is an ENAset, enaset$points.rotated will be groups using `mean` regardless of `method` provided
11		#' @param names A vector of names to use for the results. Default: unique(by)
12		#'
13		#' @examples
14		#' data(RS.data)
15		#'
16		#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
17		#' 'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
18		#'
19		#' accum = ena.accumulate.data(
20		#' units = RS.data[,c("UserName","Condition")],
21		#' conversation = RS.data[,c("Condition","GroupName")],
22		#' metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post")],
23		#' codes = RS.data[,codeNames],
24		#' window.size.back = 4
25		#' )
26		#'
27		#' set = ena.make.set(
28		#' enadata = accum
29		#' )
30		#'
31		#' means = ena.group(set, "Condition")
32		#'
33		#'
34		#' @return A list containing names, points, and edge weights for each of the unique groups formed by the function
35		##
36		ena.group <- function(
37		enaset = NULL,
38		by = NULL,
39		method = mean,
40		names = as.vector(unique(by))
41		) {
42	7x	run.method = function(pts, m = method) {
43	12x	to_matrix <- class(pts)[1];
44	12x	points.dt = pts;
45
46	12x	if(is.logical(by)) {
47	2x	points.dt.means = points.dt[by, { lapply(.SD, m) }, .SDcols = find_dimension_cols(points.dt) \| find_code_cols(points.dt)];
48	2x	if(length(names) == 1) {
49	2x	points.dt.means[['ENA_GROUP_NAME']] <- as.ena.metadata(names)
50		}
51		}
52	10x	else if(all(by %in% colnames(pts))) {
53	2x	points.dt.means <- points.dt[,
54	4x	{lapply(.SD, function(x) {
55	60x	get(paste0("as.", class(x)[1]))(m(x))
56		})},
57	2x	by = by,
58	2x	.SDcols = find_dimension_cols(points.dt) \| find_code_cols(points.dt)
59		];
60	2x	points.dt.means[, ENA_GROUP_NAME := do.call(paste, c(.SD, sep = ".")) , .SDcols = c(by)]
61	2x	points.dt.means <- points.dt.means[, !find_meta_cols(points.dt.means), with = F]
62	2x	set(points.dt.means, j = "ENA_GROUP_NAME", value = as.ena.metadata(points.dt.means[["ENA_GROUP_NAME"]]))
63		}
64		else {
65	8x	to_what <- get(paste0("as.", class(pts[[which(!find_meta_cols(pts))[1]]])[1]))
66	8x	to_cols <- names(which(!find_meta_cols(pts)))
67
68	8x	points.dt.means = as.data.frame(aggregate(as.matrix(points.dt), by = list(by), FUN = m)) #"mean"))
69	8x	set(points.dt.means, j = "Group.1", value = as.ena.metadata(points.dt.means$Group.1))
70	8x	colnames(points.dt.means)[colnames(points.dt.means) == "Group.1"] <- "ENA_GROUP_NAME"
71	8x	set(x = points.dt.means, j = to_cols, value = lapply(points.dt.means[, to_cols], to_what))
72	8x	points.dt.means <- as.data.table(points.dt.means)
73
74		# agg.df[as.vector(unique(group.by)),]u
75		# return (points.dt.means[as.vector(unique(by)),]);
76	8x	return(as.ena.matrix(points.dt.means[which(points.dt.means$ENA_GROUP_NAME %in% unique(by)),], to_matrix))
77		}
78
79	4x	return(as.ena.matrix(points.dt.means, to_matrix));
80		}
81
82	7x	if(is.character(method)) {
83	1x	method = get(method)
84		}
85
86	7x	if(is(enaset, "ENAset")) {
87	1x	enaset <- ena.set(enaset);
88		}
89
90	7x	if (is(enaset, "ena.set")) {
91	5x	pts <- run.method(enaset$points)
92	5x	return(list(
93	5x	"names" = pts$ENA_GROUP_NAME,
94	5x	"points" = pts,
95	5x	"line.weights" = run.method(enaset$line.weights)
96		));
97		}
98		else {
99	2x	return(run.method(enaset))
100		}
101		}

1		#' Calculate ENA Moving Window Size via Cross-Covariance Decay (CCD)
2		#'
3		#' Calculates the recommended moving window size for Epistemic Network Analysis (ENA)
4		#' by estimating the half-life decay lag of the noise-corrected Frobenius norm across
5		#' pooled conversation cross-covariance matrices.
6		#'
7		#' @param x A \code{data.frame}, \code{data.table}, or an \code{ENAdata}/\code{ena.set} accumulation object.
8		#' @param codeNames A \code{character} vector of column names representing binary codes (optional if \code{x} is an ENA object).
9		#' @param conversation_cols A \code{character} vector of column names defining discrete conversations (optional if \code{x} is an ENA object).
10		#' @param max_window A \code{numeric} value indicating the maximum lag window size to evaluate. Default is \code{20}.
11		#' @param min_overlap A \code{numeric} value specifying the minimum required overlapping rows (\eqn{N - lag}) per conversation subset. Default is \code{10}.
12		#'
13		#' @details
14		#' The function computes pooled cross-covariance curves over lags \code{0:max_window}. It normalizes
15		#' the noise-corrected Frobenius norm relative to its peak value and identifies the first lag step strictly
16		#' after the peak where the normalized norm falls below 0.5 (half-life threshold).
17		#'
18		#' @references
19		#' Shaffer, D. W. & Cai, Z. (2026). Discourse Coherence Length:
20		#' Noise-Corrected Covariance Estimation of Window-Size in Epistemic Network Analysis.
21		#' International Conference on Quantitative Ethnography (ICQE26).
22		#'
23		#' @return An integer scalar representing the estimated half-life lag window size.
24		#'
25		#' @export
26		#'
27		#' @examples
28		#' data(RS.data)
29		#' codeNames <- c("Data", "Technical.Constraints", "Performance.Parameters",
30		#' "Client.and.Consultant.Requests", "Design.Reasoning", "Collaboration")
31		#' w <- ena.ccd.window(RS.data, codeNames = codeNames,
32		#' conversation_cols = c("Condition", "GroupName"))
33		#' print(w)
34		ena.ccd.window <- function(
35		x,
36		codeNames = NULL,
37		conversation_cols = NULL,
38		max_window = 20,
39		min_overlap = 10
40		) {
41	11x	res <- ena.ccd(
42	11x	x = x,
43	11x	codeNames = codeNames,
44	11x	conversation_cols = conversation_cols,
45	11x	max_window = max_window,
46	11x	min_overlap = min_overlap
47		)
48	8x	return(res$window_size)
49		}
50
51		#' Compute Cross-Covariance Decay Curves and Noise Floor
52		#'
53		#' Evaluates window-matched cross-covariance matrices and noise-floor corrected
54		#' Frobenius norms across multiple conversation subsets over a range of lag steps.
55		#'
56		#' @param x A \code{data.frame}, \code{data.table}, or an \code{ENAdata}/\code{ena.set} accumulation object.
57		#' @param codeNames A \code{character} vector of column names corresponding to ENA codes.
58		#' @param conversation_cols A \code{character} vector of column names defining discrete conversations.
59		#' @param max_window An \code{integer} specifying the maximum lag to evaluate. Default is \code{20}.
60		#' @param min_overlap An \code{integer} specifying the minimum effective row overlap required per conversation at lag \eqn{l}. Default is \code{10}.
61		#'
62		#' @return An S3 object of class \code{ena.ccd} containing:
63		#' \describe{
64		#' \item{window_size}{The estimated optimal window size (integer).}
65		#' \item{peak_lag}{The lag corresponding to the peak cross-covariance norm.}
66		#' \item{curves}{A \code{data.frame} of pooled cross-covariance metrics by lag.}
67		#' \item{codeNames}{The evaluated code names.}
68		#' \item{conversation_cols}{The conversation column names.}
69		#' }
70		#'
71		#' @export
72		#'
73		#' @examples
74		#' data(RS.data)
75		#' codeNames <- c("Data", "Technical.Constraints", "Performance.Parameters",
76		#' "Client.and.Consultant.Requests", "Design.Reasoning", "Collaboration")
77		#' ccd_res <- ena.ccd(RS.data, codeNames = codeNames,
78		#' conversation_cols = c("Condition", "GroupName"))
79		#' print(ccd_res)
80		#' plot(ccd_res)
81		ena.ccd <- function(
82		x,
83		codeNames = NULL,
84		conversation_cols = NULL,
85		max_window = 20,
86		min_overlap = 10
87		) {
88		# 1. Extract from ENAdata / ena.set if provided
89	14x	if (inherits(x, c("ENAdata", "ena.set", "ENAset", "rENA.data", "rENA.set"))) {
90	4x	if (is.null(codeNames)) {
91	4x	if (!is.null(x$model$codes)) {
92	!	codeNames <- x$model$codes
93	4x	} else if (!is.null(x$codes)) {
94	!	codeNames <- if (is.data.frame(x$codes) \|\| is.matrix(x$codes)) colnames(x$codes) else as.character(x$codes)
95	4x	} else if (!is.null(x$`_function.params`$codes)) {
96	4x	codeNames <- if (is.data.frame(x$`_function.params`$codes) \|\| is.matrix(x$`_function.params`$codes)) {
97	4x	colnames(x$`_function.params`$codes)
98		} else {
99	!	as.character(x$`_function.params`$codes)
100		}
101		}
102		}
103	4x	if (is.null(conversation_cols)) {
104	4x	if (!is.null(x$conversations.by)) {
105	!	conversation_cols <- x$conversations.by
106	4x	} else if (!is.null(x$model$conversations.by)) {
107	!	conversation_cols <- x$model$conversations.by
108	4x	} else if (!is.null(x$`_function.params`$conversations.by)) {
109	4x	conversation_cols <- x$`_function.params`$conversations.by
110		}
111		}
112	4x	raw_df <- if (!is.null(x$model$raw.input)) {
113	4x	as.data.frame(x$model$raw.input)
114	4x	} else if (!is.null(x$raw)) {
115	!	as.data.frame(x$raw)
116	4x	} else if (!is.null(x$data)) {
117	!	as.data.frame(x$data)
118	4x	} else if (!is.null(x$`_function.params`$data)) {
119	!	as.data.frame(x$`_function.params`$data)
120		} else {
121	!	NULL
122		}
123	10x	} else if (is.data.frame(x)) {
124	10x	raw_df <- as.data.frame(x)
125		} else {
126	!	stop("'x' must be a data.frame or an ENA accumulation/set object.")
127		}
128
129	14x	if (is.null(raw_df)) {
130	!	stop("Could not extract raw data from the provided ENA object.")
131		}
132
133		# Deduplicate columns in raw_df if present (e.g. from intersecting units/convo specifications)
134	14x	if (any(duplicated(colnames(raw_df)))) {
135	4x	raw_df <- raw_df[, !duplicated(colnames(raw_df)), drop = FALSE]
136		}
137
138	14x	if (is.null(codeNames) \|\| length(codeNames) == 0) {
139	!	stop("'codeNames' must be specified.")
140		}
141	14x	if (is.null(conversation_cols) \|\| length(conversation_cols) == 0) {
142	!	stop("'conversation_cols' must be specified.")
143		}
144
145		# 2. Validate columns existence
146	14x	missing_cols <- setdiff(c(conversation_cols, codeNames), colnames(raw_df))
147	14x	if (length(missing_cols) > 0) {
148	2x	stop("The following columns were not found in 'x': ", paste(missing_cols, collapse = ", "))
149		}
150
151		# 3. Numeric matrix conversion & conversation splitting
152		# Factors and characters are converted by their labels ("0"/"1" -> 0/1);
153		# data.matrix() would use factor level positions (1/2) instead. Missing or
154		# non-numeric values are an error rather than a silent 0.
155	12x	code_mat <- vapply(raw_df[, codeNames, drop = FALSE], function(col) {
156	2x	if (is.factor(col)) col <- as.character(col)
157	68x	suppressWarnings(as.numeric(col))
158	12x	}, numeric(nrow(raw_df)))
159	12x	code_mat <- matrix(code_mat, nrow = nrow(raw_df), dimnames = list(NULL, codeNames))
160	12x	bad <- codeNames[colSums(is.na(code_mat)) > 0]
161	12x	if (length(bad)) {
162	1x	stop("Code columns have missing or non-numeric values: ", paste(bad, collapse = ", "))
163		}
164
165	11x	conv_factor <- interaction(raw_df[conversation_cols], drop = TRUE, lex.order = FALSE)
166	11x	x_subsets <- split.data.frame(code_mat, conv_factor)
167
168	11x	lags <- 0:max_window
169
170		# Pre-filter conversation subsets by length
171	11x	sub_lens <- vapply(x_subsets, nrow, integer(1))
172	11x	valid_idx <- which(sub_lens >= min_overlap)
173
174	11x	if (length(valid_idx) == 0) {
175	1x	warning(paste0("No conversation subsets had length >= min_overlap (", min_overlap, "). Returning window size = 1."))
176	1x	out_curves <- data.frame(
177	1x	lag = lags,
178	1x	frob = NA_real_,
179	1x	frob_sq_unbiased = NA_real_,
180	1x	frob_unbiased_signed = NA_real_,
181	1x	total_weight = 0,
182	1x	stringsAsFactors = FALSE
183		)
184	1x	res <- list(
185	1x	window_size = 1L,
186	1x	peak_lag = 0L,
187	1x	curves = out_curves,
188	1x	codeNames = codeNames,
189	1x	conversation_cols = conversation_cols
190		)
191	1x	class(res) <- "ena.ccd"
192	1x	return(res)
193		}
194
195	10x	x_subsets <- x_subsets[valid_idx]
196
197		# 4. Delegate the cross-covariance decay computation to the shared libena
198		# kernel (qe::ccd_window, src/libena_rcpp.cpp). The numeric core lives in C++ so that R, the
199		# WASM build, and the Python package (ena) all share a single implementation; only the
200		# data.frame wrangling and S3 assembly stay here.
201	10x	kern <- ccd_window(
202	10x	lapply(x_subsets, function(s) matrix(as.numeric(s), nrow = nrow(s))),
203	10x	max_window = max_window,
204	10x	min_overlap = min_overlap
205		)
206
207	10x	pooled_out <- data.frame(
208	10x	lag = kern$lag,
209	10x	frob = kern$frob,
210	10x	frob_sq_unbiased = kern$frob_sq_unbiased,
211	10x	frob_unbiased_signed = kern$frob_unbiased_signed,
212	10x	total_weight = kern$total_weight,
213	10x	stringsAsFactors = FALSE
214		)
215
216	10x	best_window <- as.integer(kern$window_size)
217	10x	peak_lag <- as.integer(kern$peak_lag)
218
219		# 5. Preserve the informational warnings the pure-R implementation emitted.
220		# (The window size / peak lag themselves are decided inside the kernel.)
221	10x	f <- pooled_out$frob_unbiased_signed
222	10x	if (peak_lag == 0L) {
223	!	warning("Corrected Cross Covariance is non-positive or all NA across evaluated lags. Defaulting to window size = 1.")
224		} else {
225	10x	max_f <- f[pooled_out$lag == peak_lag]
226	10x	after <- pooled_out$lag >= peak_lag
227	10x	if (!any((f[after] / max_f) <= 0.5, na.rm = TRUE)) {
228	1x	warning(paste0("Cross-covariance did not decay below half-life (50%) within max_window = ", max_window, "."))
229		}
230		}
231
232	10x	res <- list(
233	10x	window_size = best_window,
234	10x	peak_lag = peak_lag,
235	10x	curves = pooled_out,
236	10x	codeNames = codeNames,
237	10x	conversation_cols = conversation_cols
238		)
239	10x	class(res) <- "ena.ccd"
240	10x	return(res)
241		}
242
243		#' @export
244		print.ena.ccd <- function(x, ...) {
245	1x	cat("ENA Cross-Covariance Decay (CCD) Window Size Estimation\n")
246	1x	cat("------------------------------------------------------\n")
247	1x	cat("Estimated Window Size :", x$window_size, "\n")
248	1x	cat("Peak Lag :", x$peak_lag, "\n")
249	1x	cat("Codes Evaluated :", paste(x$codeNames, collapse = ", "), "\n")
250	1x	cat("Conversations By :", paste(x$conversation_cols, collapse = ", "), "\n")
251	1x	invisible(x)
252		}
253
254		#' Plot Cross-Covariance Decay Curve
255		#'
256		#' Plots the noise-corrected Frobenius norm across lags with the half-life threshold marker.
257		#'
258		#' @param x An object of class \code{ena.ccd}.
259		#' @param ... Additional arguments passed to \code{plot}.
260		#'
261		#' @return The \code{ena.ccd} object invisibly.
262		#' @export
263		plot.ena.ccd <- function(x, ...) {
264	1x	df <- x$curves
265	1x	valid <- !is.na(df$frob_unbiased_signed)
266	1x	df_sub <- df[valid, ]
267
268	1x	if (nrow(df_sub) == 0) {
269	!	message("No valid cross-covariance curve points to plot.")
270	!	return(invisible(x))
271		}
272
273	1x	ylim <- range(c(0, df_sub$frob_unbiased_signed, df_sub$frob), na.rm = TRUE)
274	1x	graphics::plot(
275	1x	df_sub$lag, df_sub$frob_unbiased_signed,
276	1x	type = "b", pch = 19, col = "royalblue",
277	1x	xlab = "Lag (Window Size)",
278	1x	ylab = "Frobenius Norm",
279	1x	main = paste0("Cross-Covariance Decay (Estimated Window = ", x$window_size, ")"),
280	1x	ylim = ylim,
281		...
282		)
283	1x	graphics::lines(df_sub$lag, df_sub$frob, type = "l", lty = 2, col = "gray50")
284	1x	graphics::abline(v = x$window_size, col = "firebrick", lty = 2, lwd = 2)
285	1x	graphics::legend(
286	1x	"topright",
287	1x	legend = c("Corrected Norm", "Uncorrected Norm", paste0("Chosen Window (", x$window_size, ")")),
288	1x	col = c("royalblue", "gray50", "firebrick"),
289	1x	lty = c(1, 2, 2), pch = c(19, NA, NA), lwd = c(1, 1, 2),
290	1x	bty = "n"
291		)
292	1x	invisible(x)
293		}

1		#' Find metadata columns
2		#'
3		#' @param x data.table (or frame) to search for columns of class ena.metadata
4		#'
5		#' @return logical vector
6		#' @export
7		find_meta_cols <- function(x) {
8	2496x	sapply(x, is, class2 = "ena.metadata")
9		}
10
11		#' Find code columns
12		#'
13		#' @param x data.table (or frame) to search for columns of class ena.co.occurrence
14		#'
15		#' @return logical vector
16		#' @export
17		find_code_cols <- function(x) {
18	5x	grepl("adjacency.code", x = names(x)) \| sapply(x, function(col) {
19	90x	is(col, class2 = "ena.co.occurrence")
20		})
21		}
22
23		#' Find Binary Columns
24		#'
25		#' Identifies columns in a data.frame or data.table that are binary (i.e., contain only two unique values), optionally including logical columns.
26		#'
27		#' @param x A data.frame or data.table to search for binary columns.
28		#' @param include_logical Logical. If TRUE, logical columns are also considered binary. Default is FALSE.
29		#'
30		#' @return A character vector of column names that are binary, or NULL if none are found.
31		#' @export
32		#'
33		#' @examples
34		#' df <- data.frame(a = c(0, 1, 1), b = c(TRUE, FALSE, TRUE), c = c(1, 2, 3))
35		#' find_binary_cols(df)
36		#' find_binary_cols(df, include_logical = TRUE)
37		find_binary_cols <- function(x, include_logical = FALSE) {
38	!	nm <- colnames(x)[sapply(x, is_binary_col, include_logical)];
39	!	if(length(nm) > 0) nm else NULL;
40		}
41
42		#' Find dimension columns
43		#'
44		#' @param x data.table (or frame) to search for columns of class ena.dimension
45		#'
46		#' @return logical vector
47		#' @export
48		find_dimension_cols <- function(x) {
49	6x	sapply(x, is, class2 = "ena.dimension")
50		}
51
52		#' Remove meta columns from data.table
53		#'
54		#' @param x [TBD]
55		#'
56		#' @return data.table withe columns of class ena.meta.data removed
57		#' @export
58		remove_meta_data <- function(x) {
59	1669x	as.data.frame(x)[, !find_meta_cols(x), drop = F]
60		}
61
62		#' Extract metadata easily
63		#'
64		#' @param x [TBD]
65		#' @param i [TBD]
66		#'
67		#' @return [TBD]
68		#' @export
69		"$.ena.metadata" <- function(x, i) {
70		#browser()
71	22x	parts <- unlist(strsplit(
72	22x	x = as.character(sys.call())[2], split = "\\$"
73	22x	))[1:2]
74
75	22x	set <- get(parts[1], envir = parent.frame())
76	22x	m <- set[[parts[2]]][x == i, ]
77	22x	m
78		}
79
80		#' Extract line.weignts easily
81		#'
82		#' @param x [TBD]
83		#' @param i [TBD]
84		#'
85		#' @return [TBD]
86		#' @export
87		"$.line.weights" <- function (x, i) {
88	1x	vals <- x[[which(colnames(x) == i)]]
89
90	1x	vals
91		}
92
93		#' Extract points easily
94		#'
95		#' @param x [TBD]
96		#' @param i [TBD]
97		#'
98		#' @return [TBD]
99		#' @export
100		"$.ena.points" <- function (x, i) {
101		# Match base `$`: an absent column is NULL, not an error. Without this,
102		# which() returns integer(0) and x[[integer(0)]] raises "attempt to select
103		# less than one element in get1index", so callers cannot test for an
104		# optional column (e.g. ENA_DIRECTION) the ordinary way. Duplicate column
105		# names take the first match rather than recursively indexing on a vector.
106	109x	idx <- which(colnames(x) == i)
107	109x	if (length(idx) == 0) {
108	!	return(NULL)
109		}
110	109x	vals <- x[[idx[1]]]
111
112	109x	vals
113		}
114
115		#' Extract from ena.matrix easily using metadata
116		#'
117		#' @param x [TBD]
118		#' @param i [TBD]
119		#'
120		#' @return [TBD]
121		#' @export
122		"$.ena.matrix" <- function (x, i) {
123		# See `$.ena.points` above: absent column is NULL, duplicates take the first.
124	42x	idx <- which(colnames(x) == i)
125	42x	if (length(idx) == 0) {
126	!	return(NULL)
127		}
128	42x	vals <- x[[idx[1]]]
129
130	42x	vals
131		}
132
133		#' Multiply ena.matrix objects
134		#' Element-wise multiplication of dimension columns in an ena.matrix by another ena.matrix or numeric matrix.
135		#' If e2 is an ena.matrix, it is converted to a standard matrix before multiplication.
136		#' The multiplication is applied only to the dimension columns of e1, while other columns remain
137		#' unchanged.
138		#'
139		#' @param e1 An ena.matrix object whose dimension columns will be multiplied.
140		#' @param e2 An ena.matrix or numeric matrix to multiply with the dimension columns of
141		#' e1.
142		#'
143		#' @return An ena.matrix object with the dimension columns of e1 multiplied by e2.
144		#' @exportS3Method "*" ena.matrix
145		"*.ena.matrix" <- function (e1, e2) {
146	!	e2m <- e2
147	!	if(is(e2, "ena.matrix")) {
148	!	e2m <- as.matrix(e2)
149		}
150
151	!	dim_cols <- colnames(e1)[find_dimension_cols(e1)]
152	!	e1[, (dim_cols) := Map(function(col, mult) col * mult, .SD, as.data.frame(e2m)), .SDcols = dim_cols]
153		}
154
155		# "$.ena.plot" <- function(x, i) {
156		# browser()
157		# }
158		# "[[.ena.plot" <- function(x, i) {
159		# browser()
160		# }
161		#' @export
162		.DollarNames.ena.metadata <- function(x, pattern = "") {
163	1x	unique(x)
164		}
165
166		# "[.ena.matrix" = function(x, ...)
167		# {
168		# browser()
169		# original.class = class(x)[1]
170		# class(x) = class(x)[-1]
171		# x = x[...]
172		#
173		# # y = as.data.frame(x)
174		# }
175
176		#' @export
177		summary.ena.set <- function(object, ...) {
178	1x	x <- object
179	1x	print_dims <- function(n = 2) {
180	2x	cat("\t", paste("Dimension", 1:n, collapse = "\t"), "\n")
181		}
182	1x	cat("Units: ", nrow(x$points), "\t\t")
183	1x	cat("Codes: ", length(x$rotation$codes), "\n")
184
185	1x	cat("Variance: \n")
186	1x	print_dims()
187	1x	cat("\t", paste(round(x$model$variance[1:2], 3), collapse = "\t\t"), "\n\n")
188
189	1x	cat("Eigenvalues: \n")
190	1x	print_dims()
191	1x	cat("\t", paste(round(
192	1x	x$rotation$eigenvalues[1:2], 3), collapse = "\t\t"), "\n\n")
193
194	1x	cat("Correlations: \n")
195	1x	cors <- ena.correlations(x)
196	1x	rownames(cors) <- paste("Dimension", 1:2)
197	1x	print(cors)
198		}
199		# as.data.frame.ena.connections <- function(x) {
200		# class(x) = class(x)[-1]
201		# y = as.data.frame(x)
202		# y
203		# }
204		# format.co.occurrence = format.metadata = function(x, justify = "none") {
205		# y = as.character(x)
206		# format(y, justify = justify)
207		# }
208
209		#' Title
210		#'
211		#' @param x [TBD]
212		#' @param ... [TBD]
213		#' @param plot [TBD]
214		#' @param set [TBD]
215		#'
216		#' @return [TBD]
217		#' @export
218		print.ena.set <- function(x, ..., plot = FALSE, set = TRUE) {
219	1x	x.unclass <- unclass(x)
220
221		if(
222	1x	!is.null(x.unclass$`_plot_op`) &&
223	1x	x.unclass$`_plot_op` == T
224		) {
225	!	base::print(x.unclass$plots)
226		}
227		else {
228	1x	if(plot == FALSE) {
229	1x	x.unclass$plots <- NULL
230		}
231	1x	base::print(x.unclass)
232		}
233
234	1x	invisible(x);
235		}
236
237		#' Title
238		#'
239		#' @param x [TBD]
240		#' @param by [TBD]
241		#' @param model [TBD]
242		#' @param ... [TBD]
243		#'
244		#' @return [TBD]
245		#' @export
246		as_trajectory <- function(x,
247		by = x$`_function.params`$conversation[1],
248		model = c("AccumulatedTrajectory", "SeperateTrajectory"),
249		...
250		) {
251	2x	model = match.arg(model)
252	2x	orig_args = x$`_function.params`
253	2x	orig_args$model = model
254
255	2x	more_args <- list(...)
256	2x	for(arg in names(more_args)) {
257	1x	orig_args[[arg]] <- more_args[[arg]]
258		}
259		#c(mean, more.args[!names(more.args) %in% names(mean)])
260
261	2x	do.call(ena, orig_args)
262		}
263
264		#' Title
265		#'
266		#' @param x [TBD]
267		#' @param by [TBD]
268		#' @param ... [TBD]
269		#'
270		#' @return [TBD]
271		#' @export
272		project_in <- function(x, by = NULL, ...) {
273	5x	if(is.null(by)) {
274	1x	stop("A second parameter (ena.set or rotation.set) is required")
275		}
276
277	4x	rotation.set <- NULL
278	4x	if(is(by, "ena.set")) {
279	2x	rotation.set <- by$rotation
280	2x	} else if(is(by, "ena.rotation.set")) {
281	2x	rotation.set <- by
282		}
283
284	4x	if(!identical(x$rotation$adjacency.key, rotation.set$adjacency.key)) {
285	1x	stop("Rotation sets must have identical adjacency keys")
286		}
287
288	3x	x$rotation.matrix <- rotation.set$rotation.matrix
289	3x	x$rotation$rotation.matrix <- rotation.set$rotation.matrix
290	3x	x$rotation$nodes <- rotation.set$nodes;
291	3x	x$rotation$eigenvalues <- rotation.set$eigenvalues
292
293	3x	points <- as.matrix(x$model$points.for.projection) %*% as.matrix(x$rotation.matrix)
294	3x	points.dt <- as.data.table(points)
295	3x	for (i in seq(ncol(points.dt))) {
296	45x	set(points.dt, j = i, value = as.ena.dimension(points.dt[[i]]))
297		}
298	3x	if(grepl(x = x$model$model.type, pattern = "Trajectory")) {
299	1x	x$points <- cbind(x$trajectories, points.dt)
300		} else {
301	2x	x$points <- cbind(x$meta.data, points.dt)
302		}
303	3x	x$points <- as.ena.matrix(x$points, "ena.points")
304
305	3x	.return(x, invisible = T)
306		}
307
308		#' Title
309		#'
310		#' @param x [TBD]
311		#' @param on [TBD]
312		#'
313		#' @return [TBD]
314		#' @export
315		means_rotate <- function(x, on = NULL) {
316	3x	groupVar = NULL
317	3x	groups = NULL
318	3x	if(is.null(on)) {
319	1x	col_counts = as.numeric(x$model$raw.input[, lapply(.SD, function(s) {
320	2x	length(unique(s))
321		}),
322	1x	.SDcols = c(x$`_function.params`$units)
323		])
324	1x	groupVar = x$`_function.params`$units[order(col_counts) == 1]
325	1x	group_vars = unique(x$model$raw.input[[groupVar]])
326	1x	if(!is.null(levels(group_vars))) {
327	!	groups = levels(group_vars)[1:2]
328		}
329		else {
330	1x	groups = group_vars[1:2]
331		}
332		# on_grps = list()
333		# on_grps[[on]] = sapply(on_vals, function(v) {
334		# x$meta.data[[on]] == v
335		# }, simplify = F)
336	2x	} else if(!is.null(names(on))) {
337	1x	groupVar = names(on)
338	1x	groups = on[[groupVar]]
339		}
340
341	3x	if(is.null(groupVar) \|\| is.null(groups)) {
342	1x	stop("Unable to determine groups for rotation.")
343		}
344
345	2x	orig_args <- x$`_function.params`
346	2x	orig_args$groupVar = groupVar
347	2x	orig_args$groups = groups
348	2x	new_set <- do.call(ena, orig_args)
349	2x	new_set$plots <- x$plots
350	2x	invisible(new_set)
351		}
352
353		.return <- function(x, invisible = T, from_plot = F) {
354	3x	x$`_plot_op` = from_plot
355	3x	if(isTRUE(from_plot)) {
356
357		}
358
359	3x	if(invisible == T) {
360	3x	invisible(x)
361		}
362		else {
363	!	return(x)
364		}
365		}
366
367		is_logical_col <- function(col) {
368	!	n_cols = col == TRUE \| col == FALSE;
369	!	is_col <- is.logical(col) & all(n_cols);
370
371	!	return(is_col);
372		}
373
374		is_binary_col <- function(col, include_logical = TRUE) {
375	!	n_cols = col == 1 \| col == 0;
376	!	is_col <- is.numeric(col) && all(is.wholenumber(col) & all(n_cols));
377
378	!	if(isTRUE(include_logical)) {
379	!	is_col <- is_col \| is_logical_col(col);
380		}
381
382	!	return(is_col);
383		}
384
385	!	is.wholenumber <- function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol
386
387
388		#' Extract points easily
389		#'
390		# @param x [TBD]
391		# @param i [TBD]
392		# @param j [TBD]
393		# @param ... Passed to `[.data.table`
394		# @param with.meta logical, currently defaults to TRUE, which includes the metadata columns.
395		#
396		# @return [TBD]
397		# @export
398		# "[.ena.matrix" <- function (x, i, j, by, keyby, ..., with.meta = TRUE) {
399		# orig.class <- class(x)
400		# x.unclass <- data.table::as.data.table(unclass(x))
401		#
402		# if(with.meta == FALSE) {
403		# x.nometa <- x.unclass[, !find_meta_cols(x.unclass), with = F]
404		# x_ <- x.nometa[i, ..j, ...]
405		# }
406		# else {
407		# x_ <- x.unclass[i, j, by = by, keyby = keyby, ...]
408		# # if (!is.null(j)) {
409		# # x_ <- x_[, ..j]
410		# # }
411		# }
412		# class(x_) <- orig.class
413		# x_
414		# }
415

1		#' Correlation between distances in two ENA spaces
2		#'
3		#' @description
4		#' Calculates the Pearson correlation between the pairwise Euclidean distances
5		#' of points in two ENA spaces (\code{A} and \code{B}). For smaller datasets,
6		#' it computes the exact correlation. For larger datasets, it estimates the
7		#' correlation using a sampled subset of pairs.
8		#'
9		#' @param A A matrix or data frame representing the first ENA space (rows as points).
10		#' @param B A matrix or data frame representing the second ENA space (must have the same number of rows as A).
11		#' @param max_sample_size Numeric. The maximum number of pairwise distances to compute.
12		#' If the total possible pairs exceeds this value, sampling is used. Default is 100,000.
13		#'
14		#' @return A numeric value representing the Pearson correlation.
15		#' @importFrom stats dist cor
16		#' @export
17		ena_space_dist_corr <- function(A, B, max_sample_size = 100000) {
18	3x	m <- nrow(A)
19
20	3x	if (is.null(m) \|\| m == 0 \|\| nrow(B) != m) {
21	!	stop("The spaces must have the same non-zero number of rows.")
22		}
23
24		# Calculate total unique pairs m(m-1)/2
25	3x	total_possible_pairs <- choose(m, 2)
26
27		# Use Exact if total pairs is less than limit
28	3x	if (total_possible_pairs <= max_sample_size) {
29		# CASE 1: Small m - Exact calculation
30	3x	d_A <- as.vector(dist(A))
31	3x	d_B <- as.vector(dist(B))
32	3x	return(cor(d_A, d_B, method = "pearson"))
33
34		} else {
35		# CASE 2: Large m - Simple Sample & Filter
36		# Sample indices with replacement
37	!	idx1 <- sample.int(m, max_sample_size, replace = TRUE)
38	!	idx2 <- sample.int(m, max_sample_size, replace = TRUE)
39
40		# Filter out identity pairs (per user instruction for large m)
41	!	keep <- idx1 != idx2
42	!	idx1 <- idx1[keep]
43	!	idx2 <- idx2[keep]
44
45		# Vectorized Euclidean Distance: sqrt(sum((x-y)^2))
46	!	dist_A <- sqrt(rowSums((A[idx1, , drop = FALSE] - A[idx2, , drop = FALSE])^2))
47	!	dist_B <- sqrt(rowSums((B[idx1, , drop = FALSE] - B[idx2, , drop = FALSE])^2))
48
49	!	return(cor(dist_A, dist_B, method = "pearson"))
50		}
51		}

1		#####
2		#' @title Wrapper to generate plots of units, groups, and networks
3		#'
4		#' @description Plots individual units, all units, groups of units, networks, and network subtractions
5		#'
6		#' @details This function includes options to plots individual units, all units,
7		#' groups of units, networks, and network subtractions, given an ena.set objects. Plots are stored
8		#' on the supplied ena.set object.
9		#'
10		#'
11		#' @param set an ena.set object
12		#' @param groupVar vector, character, of column name containing group identifiers.
13		#' @param groups vector, character, of values of groupVar column you wish to plot. Maxium of two groups allowed.
14		#' @param points logical, TRUE will plot points (default: FALSE)
15		#' @param mean logical, TRUE will plot the mean position of the groups defined in the groups argument (default: FALSE)
16		#' @param network logical, TRUE will plot networks (default: TRUE)
17		#' @param networkMultiplier numeric, scaling factor for non-subtracted networks (default: 1)
18		#' @param subtractionMultiplier numeric, scaling factor for subtracted networks (default: 1)
19		#' @param unit vector, character, name of a single unit to plot
20		#' @param colors vector, character, of colors for groups or points. For two-group models supply two values (group1, group2); for single-group or no-group models supply one value. Defaults to "blue"/"red" for two groups and "black" otherwise.
21		#' @param confidence.interval character, style of confidence interval shown on mean points: "box" (default), "crosshairs", or "none"
22		#' @param print.plots logical, TRUE will show plots in the Viewer (default: FALSE)
23		#' @param backend \code{"plotly"} (default) or \code{"qeviz"}; default
24		#' \code{getOption("rENA.plot.backend", "plotly")}. On qeviz the weights are
25		#' not multiplied: the multipliers become each plot's magnification
26		#' (labelled "(scaled Nx)"). See \link{rENA-plot-backends}.
27		#' @param ... Additional parameters passed to set creation and plotting functions
28		#' @export
29		#' @return ena.set object
30		#####
31		ena.plotter = function(
32		set,
33		groupVar = NULL,
34		groups = NULL,
35		points = FALSE,
36		mean = FALSE,
37		network = TRUE,
38		networkMultiplier = 1,
39		subtractionMultiplier = 1,
40		unit = NULL,
41		colors = NULL,
42		confidence.interval = "box",
43		print.plots = F,
44		backend = getOption("rENA.plot.backend", "plotly"),
45		...
46		) {
47	17x	backend <- match.arg(backend, c("plotly", "qeviz"))
48		# qeviz: weights unscaled, networkMultiplier -> magnify (see .qe_magnify()).
49	17x	wm <- .qe_weight_mult(backend, networkMultiplier)
50	17x	mag <- .qe_magnify(backend, networkMultiplier)
51	17x	data = set$connection.counts;
52
53		# set$plots[[length(set$plots)]] <- plot
54		# plot <- set$plots[[length(set$plots)]]
55	17x	if(is.null(unit) == FALSE) {
56	1x	plot = ena.plot(enaset = set, title = unit, backend = backend, magnify = mag)
57
58	1x	if(any(set$points$ENA_UNIT == unit) == FALSE){
59	!	stop("Unit does not exist!")
60		}
61
62	1x	point.row = set$points$ENA_UNIT == unit
63	1x	point = as.matrix(set$points)[point.row,]
64	1x	point.lw = as.matrix(set$line.weights)[point.row,]* wm
65
66	1x	unit.color = if (!is.null(colors)) colors[1] else "black"
67	1x	plot = ena.plot.points(enaplot = plot,points = point, colors = unit.color)
68	1x	plot = ena.plot.network(enaplot = plot, network = point.lw, colors = unit.color)
69
70	1x	set$plots[[length(set$plots) + 1]] <- plot
71
72	1x	if(print.plots == TRUE) {
73	!	print(set$plots[[length(set$plots)]])
74		}
75
76	1x	return(set)
77		}
78
79	16x	if(is.null(groupVar) == TRUE) {
80	11x	plot = ena.plot(enaset = set, title = "All Units", backend = backend, magnify = mag)
81	11x	base.color = if (!is.null(colors)) colors[1] else "black"
82
83	11x	if(network == TRUE) {
84	11x	lineweights = as.matrix(set$line.weights)
85	11x	mean.lineweights = colMeans(lineweights) * wm
86
87	11x	plot = ena.plot.network(plot, network = mean.lineweights, colors = base.color)
88		}
89
90	11x	if(points == TRUE) {
91	!	points.for.plot = as.matrix(set$points)
92
93	!	plot = ena.plot.points(enaplot = plot,points = points.for.plot,colors = base.color)
94		}
95
96	11x	if(mean == TRUE) {
97	!	points.for.plot = as.matrix(set$points)
98
99	!	plot = ena.plot.group(plot, points.for.plot, colors = base.color, labels = "Mean", confidence.interval = confidence.interval)
100		}
101
102	11x	else if(TRUE %in% c(network,points, mean) == FALSE) {
103	!	stop("You must set at least one of points, mean, or network to TRUE to obtain a plot.")
104		}
105
106	11x	set$plots[[length(set$plots) + 1]] <- plot
107
108	11x	if(print.plots == TRUE) {
109	!	print(set$plots)
110		}
111
112	11x	return(set)
113		}
114	5x	else if(is.null(groups) == TRUE) {
115	!	unique.groups = unique(data[[groupVar]])
116
117	!	if(length(unique.groups) == 1){
118	!	warning("No groups specified and group variable only contains one unique value. Generating plot for one group.")
119
120	!	group = unique.groups
121
122	!	group.rows = set$points[[groupVar]] == group
123	!	g.plot = ena.plot(enaset = set, title = group, backend = backend, magnify = mag)
124	!	base.color = if (!is.null(colors)) colors[1] else "black"
125
126	!	if(network == TRUE) {
127	!	g.lw = as.matrix(set$line.weights)[group.rows, , drop = FALSE]
128	!	g.mean.lw = colMeans(g.lw) * wm
129	!	g.plot = ena.plot.network(g.plot, network = g.mean.lw, colors = base.color)
130		}
131
132	!	if(points == TRUE) {
133	!	g.points.for.plot = as.matrix(set$points)[group.rows, , drop = FALSE]
134	!	g.plot = ena.plot.points(enaplot = g.plot,points = g.points.for.plot,colors = base.color)
135		}
136
137	!	if(mean == TRUE) {
138	!	g.points.for.plot = as.matrix(set$points)[group.rows, , drop = FALSE]
139	!	g.plot = ena.plot.group(g.plot, g.points.for.plot, colors = base.color, labels = group, confidence.interval = confidence.interval)
140		}
141
142	!	else if(TRUE %in% c(network,points, mean) == FALSE) {
143	!	stop("You must set at least one of points, mean, or network to TRUE to obtain a plot.")
144		}
145	!	set$plots[[length(set$plots) + 1]] <- g.plot
146
147	!	if(print.plots == TRUE) {
148	!	print(set$plots)
149		}
150
151	!	return(set)
152		}
153		else {
154	!	group1 = unique.groups[1]
155	!	group2 = unique.groups[2]
156
157	!	warning(paste0("No groups specified. Generating plots of first two unique values of group variable: ",group1," and ",group2))
158
159	!	set = ena.plot.subtraction(set = set,
160	!	groupVar = groupVar,
161	!	group1 = group1,
162	!	group2 = group2,
163	!	points = points,
164	!	mean = mean,
165	!	network = network,
166	!	networkMultiplier = networkMultiplier,
167	!	subtractionMultiplier = subtractionMultiplier,
168	!	group1.color = if (!is.null(colors)) colors[1] else "blue",
169	!	group2.color = if (!is.null(colors)) colors[2] else "red",
170	!	confidence.interval = confidence.interval, backend = backend)
171
172
173	!	if(print.plots == TRUE) {
174	!	print(set$plots)
175		}
176
177	!	return(set)
178		}
179		}
180	5x	else if(length(groups) == 1) {
181	2x	group = groups
182
183	2x	if(any(data[[groupVar]] == group) == FALSE){
184	!	stop("Group column does not contain group1 value!")
185		}
186
187	2x	group.rows = set$points[[groupVar]] == group
188	2x	g.plot = ena.plot(enaset = set, title = group, backend = backend, magnify = mag)
189	2x	base.color = if (!is.null(colors)) colors[1] else "black"
190
191	2x	if(network == TRUE) {
192	2x	g.lw = as.matrix(set$line.weights)[group.rows, , drop = FALSE]
193	2x	g.mean.lw = colMeans(g.lw) * wm
194
195	2x	g.plot = ena.plot.network(g.plot, network = g.mean.lw, colors = base.color)
196		}
197
198	2x	if(points == TRUE) {
199	!	g.points.for.plot = as.matrix(set$points)[group.rows, , drop = FALSE]
200	!	g.plot = ena.plot.points(enaplot = g.plot,points = g.points.for.plot,colors = base.color)
201		}
202
203	2x	if(mean == TRUE) {
204	!	g.points.for.plot = as.matrix(set$points)[group.rows, , drop = FALSE]
205	!	g.plot = ena.plot.group(g.plot, g.points.for.plot, colors = base.color, labels = group, confidence.interval = confidence.interval)
206		}
207
208	2x	else if(TRUE %in% c(network,points, mean) == FALSE) {
209	!	stop("You must set at least one of points, mean, or network to TRUE to obtain a plot.")
210		}
211	2x	set$plots[[length(set$plots) + 1]] <- g.plot
212
213	2x	if(print.plots == TRUE) {
214	!	print(set$plots)
215		}
216
217	2x	return(set)
218		}
219	3x	else if (length(groups) >= 2) {
220	3x	if (length(groups) > 2) {
221	!	warning(paste0("More than two groups specified. Plotting the first two groups: ", groups))
222		}
223
224	3x	groups.missing = groups[which(!groups %in% data[[groupVar]])]
225	3x	if(length(groups.missing) > 0) {
226	!	stop(paste0("Group column does not contain group value(s): ", groups.missing))
227		}
228
229	3x	set = ena.plot.subtraction(
230	3x	set = set,
231	3x	groupVar = groupVar,
232	3x	group1 = groups[1],
233	3x	group2 = groups[2],
234	3x	points = points,
235	3x	mean = mean,
236	3x	network = network,
237	3x	networkMultiplier = networkMultiplier,
238	3x	subtractionMultiplier = subtractionMultiplier,
239	3x	group1.color = if (!is.null(colors)) colors[1] else "blue",
240	3x	group2.color = if (!is.null(colors)) colors[2] else "red",
241	3x	confidence.interval = confidence.interval, backend = backend,
242		...
243		)
244
245	3x	if(print.plots == TRUE) {
246	!	print(set$plots)
247		}
248
249	3x	return(set)
250		}
251		}
252

1		##
2		#' @title Find conversations by unit
3		#'
4		#' @description Find rows of conversations by unit
5		#'
6		#' @details [TBD]
7		#'
8		#' @param set [TBD]
9		#' @param units [TBD]
10		#' @param units.by [TBD]
11		#' @param codes [TBD]
12		#' @param conversation.by [TBD]
13		#' @param window [TBD]
14		#' @param conversation.exclude [TBD]
15		#'
16		#' @examples
17		#' data(RS.data)
18		#'
19		#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
20		#' 'Client.and.Consultant.Requests','Design.Reasoning',
21		#' 'Collaboration');
22		#'
23		#' accum = ena.accumulate.data(
24		#' units = RS.data[,c("Condition","UserName")],
25		#' conversation = RS.data[,c("Condition","GroupName")],
26		#' metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre",
27		#' "CONFIDENCE.Post","C.Change")],
28		#' codes = RS.data[,codeNames],
29		#' model = "EndPoint",
30		#' window.size.back = 4
31		#' );
32		#' set = ena.make.set(
33		#' enadata = accum,
34		#' rotation.by = ena.rotate.by.mean,
35		#' rotation.params = list(accum$meta.data$Condition=="FirstGame",
36		#' accum$meta.data$Condition=="SecondGame")
37		#' );
38		#' ena.conversations(set = RS.data,
39		#' units = c("FirstGame.steven z"), units.by=c("Condition","UserName"),
40		#' conversation.by = c("Condition","GroupName"),
41		#' codes=codeNames, window = 4
42		#' )
43		#'
44		#' @export
45		#' @return list containing row indices representing conversations
46		##
47		ena.conversations = function(set, units, units.by=NULL, codes=NULL, conversation.by = NULL, window = 4, conversation.exclude = c()) {
48		# rawData = data.table::copy(set$enadata$raw);
49	4x	if(is.null(units.by)) {
50	2x	if(!is(set, "ena.set")) {
51	1x	stop("If units.by is NULL, set must be an ena.set object")
52		}
53	1x	units.by = set$`_function.params`$units.by;
54		}
55		# conversation.by = set$enadata$function.params$conversations.by;
56		# window = set$enadata$function.params$window.size.back;
57		# rawAcc = data.table::copy(set$enadata$accumulated.adjacency.vectors);
58	3x	if(is(set, "ena.set")) {
59	2x	rawAcc2 = set$model$raw.input
60		} else {
61	1x	rawAcc2 = data.table::data.table(set) #$enadata$raw);
62		}
63
64		# rawAcc$KEYCOL = merge_columns_c(rawAcc, conversation.by)
65	3x	rawAcc2$KEYCOL = merge_columns_c(rawAcc2, conversation.by, sep = "::")
66
67		# conversationsTable = rawAcc[, paste(.I, collapse = ","), by = c(conversation.by)]
68	3x	conversationsTable2 = rawAcc2[, paste(.I, collapse = ","), by = c(conversation.by)]
69
70		# rows = sapply(conversationsTable$V1, function(x) as.numeric(unlist(strsplit(x, split=","))),USE.NAMES = T)
71	3x	rows2 = lapply(conversationsTable2$V1, function(x) as.numeric(unlist(strsplit(x, split=","))))
72		# browser()
73		# names(rows) = merge_columns_c(conversationsTable,conversation.by); #unique(rawAcc[,KEYCOL])
74	3x	names(rows2) = merge_columns_c(conversationsTable2,conversation.by, sep = "::"); #unique(rawAcc[,KEYCOL])
75
76		# unitRows = merge_columns_c(rawAcc[,c(units.by),with=F], units.by)
77	3x	unitRows2 = merge_columns_c(rawAcc2[,c(units.by),with=F], units.by, sep = "::")
78
79		# adjCol = set$enadata$adjacency.matrix[1,] %in% codes[1] & set$enadata$adjacency.matrix[2,] %in% codes[2]
80		# adjColName = paste("adjacency.code.", which(adjCol), sep = "")
81		# codedUnitRows = which(unitRows %in% units & rawAcc[[adjColName]] == 1)
82
83	3x	codedRows = rawAcc2[, rowSums(.SD), .SDcols = codes] > 0
84	3x	codedUnitRows2 = which(unitRows2 %in% units & codedRows)
85	3x	codedUnitRows2 = codedUnitRows2[!(codedUnitRows2 %in% as.vector(unlist(rows2[conversation.exclude])))]
86		# codedUnitRowConvs = rawAcc[codedUnitRows,KEYCOL];
87	3x	codedUnitRowConvs2 = rawAcc2[codedUnitRows2,KEYCOL];
88
89	3x	codedUnitRowConvsAll = NULL;
90	3x	codedUnitRowConvsAll2 = NULL;
91	3x	unitRowsNotCooccurred = c()
92	3x	if(length(codedUnitRows2) > 0) {
93	3x	codedUnitRowConvsAll = unique(unlist(sapply(X = 1:length(codedUnitRows2), simplify = F, FUN = function(x) {
94	279x	thisConvRows = rows2[[codedUnitRowConvs2[x]]]
95	279x	thisRowInConv = which(thisConvRows == codedUnitRows2[x])
96	279x	winUse = ifelse(is.infinite(window), thisRowInConv, window)
97	279x	thisRowAndWindow = rep(thisRowInConv,winUse) - (winUse-1):0
98	279x	coOccursFound = all(rawAcc2[thisConvRows[thisRowAndWindow[thisRowAndWindow > 0]], lapply(.SD, sum), .SDcols=codes] > 0)
99	279x	if(coOccursFound) {
100	132x	thisConvRows[thisRowAndWindow[thisRowAndWindow > 0]]
101		} else {
102	147x	unitRowsNotCooccurred <<- c(unitRowsNotCooccurred, thisConvRows[thisRowInConv])
103		# coOccursFound
104	147x	NULL
105		}
106		})))
107		}
108	3x	return(list(
109	3x	conversations = as.list(rows2),
110	3x	unitConvs = unique(rawAcc2[codedUnitRows2,KEYCOL]),
111	3x	allRows = codedUnitRowConvsAll,
112	3x	unitRows = codedUnitRows2,
113	3x	toRemove = unitRowsNotCooccurred
114		));
115		}

1		###
2		#' @title ENA Rotate by regression
3		#'
4		#' @description This function allows user to provide a regression formula for rotation on x and optionally on y.
5		#' If regression formula for y is not provide, svd is applied to the residual data deflated by x to get y coordinates.
6		#' The regression formula uses ENA dimensions are dependent variables.
7		#' The first predictor has to be two-group categorical, binary, or numerical.
8		#'
9		#' @param enaset An \code{\link{ENAset}}
10		#' @param params list of parameters, may include:
11		#' x_var: Regression formula for x direction, such as "lm(formula=V ~ Condition + GameHalf + Condition : GameHalf)",
12		#' where V always stands for the ENA points.
13		#' y_var: Regression formula, similar to x_var, for y direction (optional).
14		#'
15		#' @export
16		#' @return \code{\link{ENARotationSet}}
17		ena.rotate.by.hena.regression = function(enaset, params) {
18		# check arguments
19	!	if ( !is.list(params) \|\| is.null(params$x_var) ) {
20	!	stop("params must be provided as a list() and provide `x_var`")
21		}
22
23	!	x <- params$x_var;
24	!	y <- params$y_var;
25	!	points <- params$points;
26	!	fullNames <- params$fullNames;
27
28	!	if(is.null(fullNames)) {
29	!	fullNames = F;
30		}
31
32		#get points
33	!	if(!is.null(points)) {
34	!	p <- points
35		}
36	!	else if (is.null(enaset$points.normed.centered)) {
37	!	p <- as.matrix(enaset$model$points.for.projection);
38		}
39		else {
40	!	p <- as.matrix(enaset$points.normed.centered);
41		}
42
43		#regress to get v1 using x
44	!	V <- p;
45
46		# only works using attach()
47		# attach(enaset$meta.data,warn.conflicts = F)
48		# v1 = eval(parse(text = x))$coefficients[2,]
49
50		# v1 <- with(enaset$meta.data, {
51		# eval(parse(text = x))$coefficients[2,]
52		# });
53		# v1 <- with(enaset$model$points.for.projection, NULL, formula = x);
54	!	v1_res <- with.ena.matrix(enaset$model$points.for.projection, {
55	!	lm(formula(params$x_var));
56		});
57	!	v1 <- v1_res$coefficients[2,]
58
59		# make v1 a unit vector
60	!	norm_v1 <- sqrt(sum(v1 * v1));
61	!	if (norm_v1 != 0) {
62	!	v1 <- v1 / norm_v1;
63		}
64
65		# name v1 vector
66	!	if(is.na(all.vars(x)[2])) {
67	!	xName <- names(v1)[1];
68		}
69		else {
70	!	if(fullNames) {
71	!	warning("FullName param is likely wrong.")
72	!	xName <- parse(text = x)[[1]][["formula"]][[3]];
73		}
74		else {
75	!	xName <- all.vars(x)[2];
76		}
77		}
78
79		# Save v1
80	!	R <- matrix(c(v1), ncol = 1);
81	!	colnames(R) <- c(paste0(xName,"_reg"));
82
83		#deflate matrix by x dimension
84	!	A <- as.matrix(p)
85	!	defA <- as.matrix(A) - as.matrix(A) %% v1 %% t(v1)
86
87		#if y formula is given, regress by y formula
88	!	if (!is.null(y)) {
89
90		# regress to get v2 vector using formula y
91	!	V <- defA;
92
93		# Removed attach abvove
94		# v2 = eval(parse(text = y))$coefficients[2,]
95		# v2 <- with(enaset$meta.data, {
96		# eval(parse(text = y))$coefficients[2,]
97		# });
98		# v2 <- with(enaset$model$points.for.projection, NULL, formula = y, V = V);
99	!	v2_res <- with.ena.matrix(enaset$model$points.for.projection, {
100	!	lm(formula(params$y_var));
101		});
102	!	v2 <- v2_res$coefficients[2,]
103
104		#make v2 a unit vector
105
106	!	norm_v2 <- sqrt(sum(v2 * v2));
107	!	if (norm_v2 != 0) {
108	!	v2 <- v2 / norm_v2;
109		}
110
111		#name v2 vector
112	!	if(is.na(all.vars(y)[2])) {
113	!	yName <- names(v2)[1]
114		}
115		else {
116	!	if(fullNames) {
117	!	warning("FullName param is likely wrong.")
118	!	yName <- parse(text = y)[[1]][["formula"]][[3]];
119		}
120		else {
121	!	yName <- all.vars(y)[2]
122		}
123		}
124
125		# save both v1 and v2
126	!	R <- cbind(v1, v2);
127	!	colnames(R) <- c(paste0(xName,"_reg"), paste0(yName,"_reg"));
128
129		#deflat by v2
130	!	defA <- as.matrix(defA) - as.matrix(defA) %% v2 %% t(v2);
131		}
132
133		# get svd for deflated points
134	!	svd_result <- prcomp(defA, retx=FALSE, scale=FALSE, center=FALSE, tol=0);
135	!	svd_v <- svd_result$rotation;
136
137		# Merge rotation vectors
138	!	vcount <- ncol(R);
139	!	colNamesR <- colnames(R);
140	!	combined <- cbind(R, svd_v[, 1:(ncol(svd_v) - vcount)]);
141	!	colnames(combined) <- c(
142	!	colNamesR,
143	!	paste0("SVD", ((vcount + 1):ncol(combined)))
144		);
145
146		#create rotation set
147	!	rotation_set <- ENARotationSet$new(
148	!	node.positions = NULL,
149	!	rotation = combined,
150	!	codes = enaset$rotation$codes,
151	!	eigenvalues = NULL
152		)
153
154	!	return(rotation_set);
155		}

1		##
2		#' @title Plot points on an ENAplot
3		#'
4		#' @description Plot all or a subset of the points of an ENAplot using the plotly plotting library
5		#'
6		#' @export
7		#'
8		#' @param enaplot \code{\link{ENAplot}} object to use for plotting
9		#' @param points A dataframe of matrix where the first two column are X and Y coordinates
10		#' @param point.size A data.frame or matrix where the first two column are X and Y coordinates of points to plot in a projected ENA space defined in ENAplot
11		#' @param labels A character vector of point labels, length nrow(points); default: NULL
12		#' @param confidence.interval A character determining markings to use for confidence intervals, choices: none, box, crosshair, default: none
13		#' @param outlier.interval A character determining markings to use for outlier interval, choices: none, box, crosshair, default: none
14		#' @param confidence.interval.values A matrix/dataframe where columns are CI x and y values for each point
15		#' @param outlier.interval.values A matrix/dataframe where columns are OI x and y values for each point
16		#' @param shape A character which determines the shape of point markers, choices: square, triangle, diamond, circle, default: circle
17		#' @param colors A character vector of the point marker colors; if one given it is used for all, otherwise must be same length as points; default: black
18		#' @param label.offset character: top left (default), top center, top right, middle left, middle center, middle right, bottom left, bottom center, bottom right
19		#' @param label.group A string used to group the labels in the legend. Items plotted with the same label.group will show/hide together when clicked within the legend.
20		#' @param label.font.size An integer which determines the font size for point labels, default: enaplot$font.size
21		#' @param label.font.color A character which determines the color of label font, default: enaplot$font.color
22		#' @param label.font.family A character which determines label font type, choices: Arial, Courier New, Times New Roman, default: enaplot$font.family
23		#' @param show.legend Logical indicating whether to show the point labels in the in legend
24		#' @param legend.name Character indicating the name to show above the plot legend
25		#' @param texts [TBD]
26		#' @param ... additional parameters addressed in inner function
27		#'
28		#'
29		#' @seealso \code{\link{ena.plot}}, \code{\link{ENAplot}}, \code{\link{ena.plot.group}}
30		#'
31		#' @examples
32		#' data(RS.data)
33		#'
34		#' codeNames = c('Data','Technical.Constraints','Performance.Parameters',
35		#' 'Client.and.Consultant.Requests','Design.Reasoning','Collaboration');
36		#'
37		#' accum = ena.accumulate.data(
38		#' units = RS.data[,c("UserName","Condition")],
39		#' conversation = RS.data[,c("Condition","GroupName")],
40		#' metadata = RS.data[,c("CONFIDENCE.Change","CONFIDENCE.Pre","CONFIDENCE.Post")],
41		#' codes = RS.data[,codeNames],
42		#' window.size.back = 4
43		#' )
44		#'
45		#' set = ena.make.set(
46		#' enadata = accum,
47		#' rotation.by = ena.rotate.by.mean,
48		#' rotation.params = list(
49		#' accum$meta.data$Condition=="FirstGame",
50		#' accum$meta.data$Condition=="SecondGame"
51		#' )
52		#' )
53		#'
54		#' plot = ena.plot(set)
55		#'
56		#' group1.points = set$points[set$meta.data$Condition == "FirstGame",]
57		#' group2.points = set$points[set$meta.data$Condition == "SecondGame",]
58		#' plot = ena.plot.points(plot, points = group1.points);
59		#' plot = ena.plot.points(plot, points = group2.points);
60		#' print(plot);
61		#'
62		#' @return \code{\link{ENAplot}} The ENAplot provided to the function, with its plot updated to include the new points.
63		##
64		ena.plot.points = function(
65		enaplot,
66
67		points = NULL, #vector of unit names or row indices
68		point.size = enaplot$point$size,
69		labels = NULL, #unique(enaplot$enaset$enadata$unit.names),
70		label.offset = "top left",
71		label.group = NULL,
72
73		label.font.size = NULL, #enaplot$get("font.size"),
74		label.font.color = NULL, #enaplot$get("font.color"),
75		label.font.family = NULL, #enaplot$get("font.family"),
76
77		shape = "circle",
78		colors = NULL, # c("blue"), #rep(I("black"), nrow(points)),
79
80		confidence.interval.values = NULL,
81		confidence.interval = c("none", "crosshairs", "box"),
82
83		outlier.interval.values = NULL,
84		outlier.interval = c("none", "crosshairs", "box"),
85		show.legend = T,
86		legend.name = "Points",
87		texts = NULL,
88		...
89		) {
90		###
91		# Parameter Checking and Cleaning
92		###
93	18x	if (.qe_backend(enaplot))
94	3x	return(.qe_plot_points(enaplot, supplied = names(match.call())[-1],
95	3x	points = points, point.size = point.size, labels = labels, shape = shape,
96	3x	colors = colors, label.font.size = label.font.size, label.font.color = label.font.color,
97	3x	label.font.family = label.font.family, texts = texts, legend.name = legend.name))
98
99	15x	env = environment();
100	15x	for(n in c("font.size", "font.color", "font.family")) {
101	45x	if(is.null(get(paste0("label.",n))))
102	43x	env[[paste0("label.",n)]] = enaplot$get(n);
103		}
104
105	15x	if(is.null(points)) {
106		# stop("Must provide points to plot.")
107	5x	points = enaplot$enaset$points
108		}
109
110	15x	if(is(points, "numeric")){
111	1x	points = matrix(points);
112	1x	dim(points) = c(1,nrow(points))
113	1x	points.layout = data.table::data.table(points);
114		}
115	14x	else if (is.data.table(points)) {
116		# points.layout = remove_meta_data(points)
117	12x	points.layout = data.table::copy(points)
118		}
119		else {
120	2x	points.layout = data.table::data.table(points);
121		}
122
123	15x	if(!is.character(label.font.family)) {
124	1x	label.font.family = enaplot$get("font.family");
125		}
126
127	15x	confidence.interval = match.arg(confidence.interval);
128	15x	outlier.interval = match.arg(outlier.interval);
129
130		# shape = match.arg(shape);
131	15x	valid.shapes = c("circle", "square", "triangle-up", "diamond");
132	15x	if(!all(shape %in% valid.shapes))
133	1x	stop(sprintf( "Unrecognized shapes: %s", paste(unique(shape[!(shape %in% valid.shapes)]), collapse = ", ") ))
134	14x	if(length(shape) == 1)
135	14x	shape = rep(shape, nrow(points.layout))
136
137	14x	valid.label.offsets = c("top left","top center","top right","middle left","middle center","middle right","bottom left","bottom center","bottom right");
138	14x	if(!all(label.offset %in% valid.label.offsets))
139	1x	stop(sprintf( "Unrecognized label.offsets: %s", paste(unique(label.offset[!(label.offset %in% valid.label.offsets)]), collapse = ", ") ))
140	13x	if(length(label.offset) == 1)
141	13x	label.offset = rep(label.offset, nrow(points.layout))
142
143	13x	if(grepl("^c", confidence.interval) && grepl("^c", outlier.interval)) {
144	1x	message("Confidence Interval and Outlier Interval cannot both be crosshair");
145	1x	message("Plotting Outlier Interval as box");
146	1x	outlier.interval = "box";
147		}
148
149	13x	if(length(colors) == 1) {
150	1x	colors = rep(colors, nrow(points.layout))
151		}
152	13x	if(length(point.size) == 1)
153	13x	point.size = rep(point.size, nrow(points.layout))
154	13x	if(is.null(labels))
155	13x	show.legend = F
156		###
157		# END: Parameter Checking and Cleaning
158		###
159
160		###
161		# Set error value for CI\|OI crosshair on plot
162		###
163	13x	error = list(x = list(visible=T, type="data"), y = list(visible=T, type="data"));
164	13x	int.values = NULL;
165	13x	if(grepl("^c", confidence.interval) && !is.null(confidence.interval.values)) {
166	2x	int.values = confidence.interval.values;
167		}
168	11x	else if(grepl("^c", outlier.interval) && !is.null(outlier.interval.values)) {
169	1x	int.values = outlier.interval.values;
170		}
171	13x	error$x$array = int.values[, 1];
172	13x	error$y$array = int.values[, 2];
173		###
174		# END: Set error value for crosshair on plot
175		###
176
177		###
178		# Set box value for CI\|OI box on plot
179		#####
180	13x	box.values = NULL;
181	13x	if(grepl("^b", confidence.interval) && !is.null(confidence.interval.values)) {
182	1x	box.values = confidence.interval.values;
183	1x	box.label = "Conf. Int.";
184		}
185	13x	if(grepl("^b", outlier.interval) && !is.null(outlier.interval.values)) {
186	2x	box.values = outlier.interval.values;
187	2x	box.label = "Outlier Int.";
188		}
189		######
190		# END: Set box value for CI\|OI box on plot
191		###
192
193		###
194		# Plot
195		#####
196	13x	points.matrix = remove_meta_data(points.layout)
197	13x	colnames(points.matrix) = paste0("X", rep(1:ncol(points.matrix)));
198	13x	this.max = max(points.matrix);
199	13x	for(m in 1:nrow(points.matrix)) {
200	155x	enaplot$plot = plotly::add_trace(
201	155x	p = enaplot$plot,
202	155x	data = points.matrix[m,],
203	155x	type ="scatter",
204	155x	x = ~X1, y = ~X2,
205	155x	mode = "markers+text",
206	155x	marker = list(
207	155x	symbol = shape[m],
208	155x	color = colors[m],
209	155x	size = point.size[m]
210		),
211	155x	error_x = error$x, error_y = error$y,
212	155x	showlegend = show.legend,
213		# legendgroup = label.group,
214		# legendgroup = ifelse(!is.null(box.label), labels[1], NULL),
215	155x	name = labels[m],
216	155x	text = texts[m], #labels[m],
217	155x	textfont = list(
218	155x	family = label.font.family,
219	155x	size = label.font.size,
220	155x	color = label.font.color
221		),
222	155x	legendgroup = legend.name,
223	155x	textposition = label.offset[m],
224	155x	hoverinfo = "x+y+name"
225		)
226		}
227
228	13x	if(!is.null(box.values)) {
229	3x	boxv = data.frame(
230	3x	X1 = c(box.values[1,1], box.values[2,1], box.values[2,1], box.values[1,1] ,box.values[1,1]),
231	3x	X2 = c(box.values[1,2], box.values[1,2], box.values[2,2], box.values[2,2], box.values[1,2])
232		)
233	3x	this.max = max(boxv, this.max)
234	3x	enaplot$plot = plotly::add_trace(
235	3x	p = enaplot$plot,
236	3x	data = boxv,
237	3x	type = "scatter",
238	3x	x = ~X1, y = ~X2,
239	3x	mode = "lines",
240	3x	line = list(
241	3x	width = 1,
242	3x	color = colors[1],
243	3x	dash = "dash"
244		),
245		# "legendgroup" = labels[1],
246	3x	showlegend = show.legend,
247	3x	name = box.label
248		)
249		}
250
251	13x	if(this.max*1.2 > max(enaplot$axes$y$range)) {
252	1x	this.max = this.max * 1.2
253	1x	enaplot$axes$x$range = c(-this.max, this.max)
254	1x	enaplot$axes$y$range = c(-this.max, this.max)
255	1x	enaplot$plot = plotly::layout(
256	1x	enaplot$plot,
257	1x	xaxis = enaplot$axes$x,
258	1x	yaxis = enaplot$axes$y
259		);
260		}
261		#####
262		# END: Plot
263		###
264
265	13x	return(enaplot);
266		}
267

1		# Post-fit node moves for display. The math is libena's
2		# (inst/include/libena/positions.hpp: unit_circle_nodes, node_centroids),
3		# shared with qe-ena, rena-wasm and ENA.jl.
4
5		#' Move nodes onto a circle along their own rays
6		#'
7		#' A post-fit display transform: in the plane of two dimensions, pushes every
8		#' node out along its own ray to the length of the longest node there, then
9		#' recomputes the centroids for the moved nodes. Nothing is refit.
10		#'
11		#' Nodes of length zero in the plane are left where they are, as are the
12		#' nodes' other dimensions. Unit points never change. The centroids, all
13		#' dimensions of them, are the model's node weights times the moved nodes:
14		#' each unit's line weights split between the codes they connect (half to
15		#' each code for unordered networks; for ordered ones, as the fit weights
16		#' them) and normalised to sum to 1, the weighting the fit's own centroids
17		#' use. So the goodness of fit (\code{\link{ena.correlations}}) reflects the
18		#' moved nodes.
19		#'
20		#' Works for unordered and ordered (\code{accumulate(ordered = TRUE)}) sets.
21		#'
22		#' @param set An \code{ena.set}, e.g. from \code{\link{model}} or
23		#' \code{\link{ena.make.set}}.
24		#' @param dimension_name_1 Name of the plane's x dimension (a column of
25		#' \code{set$rotation$nodes}). Defaults to the first dimension.
26		#' @param dimension_name_2 Name of the plane's y dimension. Defaults to the
27		#' second dimension.
28		#'
29		#' @return \code{set}, with \code{set$rotation$nodes} moved on the two
30		#' dimensions and \code{set$model$centroids} recomputed.
31		#'
32		#' @seealso \code{\link{move_nodes_to_unit_circle_with_equal_space}}, which
33		#' also spaces the nodes equally around the circle.
34		#' @examples
35		#' data(RS.data)
36		#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
37		#' "Client.and.Consultant.Requests", "Design.Reasoning",
38		#' "Collaboration")
39		#' set <- RS.data \|>
40		#' accumulate(c("Condition", "UserName"), codes, c("Condition", "GroupName")) \|>
41		#' model()
42		#' circled <- move_nodes_to_unit_circle(set)
43		#' circled$rotation$nodes
44		#' @export
45		move_nodes_to_unit_circle <- function(
46		set,
47		dimension_name_1 = colnames(as.matrix(set$rotation$nodes))[1],
48		dimension_name_2 = colnames(as.matrix(set$rotation$nodes))[2]
49		) {
50	16x	move_nodes_on_circle(set, dimension_name_1, dimension_name_2, "radial")
51		}
52
53		#' Move nodes onto a circle, equally spaced
54		#'
55		#' A post-fit display transform: in the plane of two dimensions, places the
56		#' nodes on a circle with the radius of the longest node there, keeping
57		#' their order around the origin and spacing them \eqn{2\pi/n} apart,
58		#' starting from the longest node, which stays where it is. Then recomputes
59		#' the centroids for the moved nodes. Nothing is refit.
60		#'
61		#' The order around the origin is: nodes with a non-negative y coordinate by
62		#' decreasing x, then nodes with a negative y coordinate by increasing x
63		#' (ties keep the codes' order). When two nodes are equally long, the first
64		#' stays fixed. Nodes of length zero in the plane are left where they are and
65		#' do not count towards \eqn{n}. The rest is as for
66		#' \code{\link{move_nodes_to_unit_circle}}.
67		#'
68		#' @inheritParams move_nodes_to_unit_circle
69		#' @inherit move_nodes_to_unit_circle return
70		#'
71		#' @seealso \code{\link{move_nodes_to_unit_circle}}, which moves each node
72		#' along its own ray instead.
73		#' @examples
74		#' data(RS.data)
75		#' codes <- c("Data", "Technical.Constraints", "Performance.Parameters",
76		#' "Client.and.Consultant.Requests", "Design.Reasoning",
77		#' "Collaboration")
78		#' set <- RS.data \|>
79		#' accumulate(c("Condition", "UserName"), codes, c("Condition", "GroupName")) \|>
80		#' model()
81		#' spaced <- move_nodes_to_unit_circle_with_equal_space(set)
82		#' spaced$rotation$nodes
83		#'
84		#' # Another plane, e.g. the second and third dimensions
85		#' dims <- colnames(as.matrix(set$rotation$nodes))
86		#' move_nodes_to_unit_circle_with_equal_space(set, dims[2], dims[3])
87		#' @export
88		move_nodes_to_unit_circle_with_equal_space <- function(
89		set,
90		dimension_name_1 = colnames(as.matrix(set$rotation$nodes))[1],
91		dimension_name_2 = colnames(as.matrix(set$rotation$nodes))[2]
92		) {
93	26x	move_nodes_on_circle(set, dimension_name_1, dimension_name_2, "equal")
94		}
95
96		# Shared body: libena moves the nodes (mode "radial" or "equal") and
97		# recomputes the centroids; the set gets them back with its column classes.
98		move_nodes_on_circle <- function(set, dimension_name_1, dimension_name_2, mode) {
99	42x	nodes <- as.matrix(set$rotation$nodes)
100	42x	dimension_names <- c(dimension_name_1, dimension_name_2)
101	42x	idx <- match(dimension_names, colnames(nodes))
102	42x	if (anyNA(idx)) {
103	1x	stop("Unknown dimension(s): ",
104	1x	paste(dimension_names[is.na(idx)], collapse = ", "),
105	1x	". Use columns of set$rotation$nodes: ",
106	1x	paste(colnames(nodes), collapse = ", "))
107		}
108
109		# Ordered sets: recompute centroids with the self-connection weight the
110		# nodes were fit with. Sets fit before it was recorded used 1 (libena
111		# counted self-connections once from 2026-05 until rENA 0.4.16).
112	41x	self_weight <- if (is.null(set$rotation$self.weight)) 1 else set$rotation$self.weight
113	41x	lw <- as.matrix(set$line.weights)
114	41x	key <- set$rotation$adjacency.key
115	41x	moved <- if (!is(set, "ena.ordered.set") && !is.null(key) && ncol(as.matrix(key)) == ncol(lw)) {
116		# Unordered: centroids from the same key-driven weighting the fit used
117		# (self-connection columns included).
118	34x	ft <- key_indices(key, key_codes(key, set$rotation$codes))
119	34x	move_nodes_to_unit_circle_by_key_c(lw, nodes, idx[1] - 1L, idx[2] - 1L, mode,
120	34x	ft$from, ft$to, self_weight)
121		} else {
122	7x	move_nodes_to_unit_circle_c(lw, nodes, idx[1] - 1L, idx[2] - 1L, mode,
123	7x	is(set, "ena.ordered.set"), self_weight)
124		}
125
126	40x	set$rotation$nodes <- replace_dimension_columns(
127	40x	set$rotation$nodes, moved$nodes[, idx, drop = FALSE], dimension_names
128		)
129	40x	set$model$centroids <- replace_dimension_columns(
130	40x	set$model$centroids, moved$centroids, colnames(nodes)
131		)
132	40x	set
133		}
134
135		# A copy of the data.table x (nodes or centroids) with columns `cols` replaced
136		# by the columns of the matrix `values`, each keeping its attributes (class).
137		replace_dimension_columns <- function(x, values, cols) {
138	80x	x <- data.table::copy(x)
139	80x	for (k in seq_along(cols)) {
140	833x	value <- as.numeric(values[, k])
141	833x	attributes(value) <- attributes(x[[cols[k]]])
142	833x	data.table::set(x, j = cols[k], value = value)
143		}
144	80x	x
145		}

1		#####
2		#' @title Animated movie of growing ENA trajectories
3		#'
4		#' @description Creates an animated Plotly visualization of trajectories growing
5		#' across shared calendar time / conversation turns.
6		#'
7		#' @export
8		#'
9		#' @param enaplot \code{\link{ENAplot}} object to use for plotting base canvas
10		#' @param points Data frame or matrix of points with 2 coordinate dimensions
11		#' @param by Vector identifying trajectory groupings (e.g. speaker/unit)
12		#' @param time Monotonic time/turn index vector corresponding to points
13		#' @param names Character vector of labels for each trajectory
14		#' @param colors Character vector of colors for each trajectory
15		#' @param smooth Character indicating smoothing method: "none" (default, point-to-point) or "poly" (LOOCV-2D polynomial curve)
16		#' @param poly.degree Optional integer degree for polynomial fit. If NULL, selected automatically via LOOCV-2D
17		#' @param poly.max.degree Maximum polynomial degree to test in LOOCV-2D (default 3)
18		#' @param poly.eval.points Number of points along smooth curve (default 100)
19		#' @param show.points Logical; whether to show discrete point markers along the trajectory (default TRUE)
20		#' @param frame_ms Milliseconds per animation frame (default 250)
21		#' @param show_tips Logical; whether to show glowing tip markers at current time position
22		#' @param title Optional title string
23		#' @return Plotly widget with play/pause controls and slider
24		#' #####
25		ena.plot.movie = function(
26		enaplot,
27		points,
28		by,
29		time,
30		names = NULL,
31		colors = NULL,
32		smooth = c("none", "poly"),
33		poly.degree = NULL,
34		poly.max.degree = 3L,
35		poly.eval.points = 100L,
36		show.points = TRUE,
37		frame_ms = 250,
38		show_tips = TRUE,
39		title = NULL
40		) {
41	2x	if (.qe_backend(enaplot)) {
42	1x	.qe_no_trajectories("ena.plot.movie")
43	1x	return(enaplot$plot)
44		}
45
46	1x	if (!requireNamespace("plotly", quietly = TRUE)) {
47	!	stop("plotly is required for animated trajectory movies")
48		}
49
50	1x	if (is(points, "ena.matrix") \|\| any(find_meta_cols(points))) {
51	!	pts_clean <- remove_meta_data(points)
52	!	pts_df <- data.frame(
53	!	X1 = as.numeric(pts_clean[[1L]]),
54	!	X2 = as.numeric(pts_clean[[2L]])
55		)
56	1x	} else if (is.matrix(points)) {
57	1x	pts_df <- data.frame(
58	1x	X1 = as.numeric(points[, 1L]),
59	1x	X2 = as.numeric(points[, 2L])
60		)
61		} else {
62	!	pts_raw <- as.data.frame(points)
63	!	num_cols <- vapply(pts_raw, is.numeric, logical(1))
64	!	if (sum(num_cols) >= 2L) {
65	!	num_df <- pts_raw[, num_cols, drop = FALSE]
66	!	pts_df <- data.frame(
67	!	X1 = as.numeric(num_df[[1L]]),
68	!	X2 = as.numeric(num_df[[2L]])
69		)
70		} else {
71	!	stop("`points` must contain at least 2 numeric coordinate columns (X and Y).")
72		}
73		}
74	1x	dim_cols <- c("X1", "X2")
75
76	1x	by_vec <- as.character(by)
77	1x	time_vec <- as.numeric(time)
78
79	1x	unique_by <- unique(by_vec)
80	1x	n_by <- length(unique_by)
81
82	1x	if (is.null(names)) {
83	1x	names <- unique_by
84		}
85	1x	if (is.null(colors)) {
86	1x	palette <- c("#1650FF", "#CD0BBC", "#00A86B", "#FF8C00", "#9932CC", "#008080")
87	1x	colors <- palette[((seq_len(n_by) - 1L) %% length(palette)) + 1L]
88		}
89
90	1x	smooth <- match.arg(smooth)
91
92		# Precompute polynomial curves if smooth == "poly"
93	1x	poly_curves <- list()
94	1x	if (smooth == "poly") {
95	!	for (b_idx in seq_along(unique_by)) {
96	!	u <- unique_by[b_idx]
97	!	u_pts <- pts_df[by_vec == u, , drop = FALSE]
98	!	if (nrow(u_pts) >= 2L) {
99	!	curve_fit <- .fit_etm_poly_curve(
100	!	points = u_pts[, dim_cols, drop = FALSE],
101	!	degree = poly.degree,
102	!	max_degree = poly.max.degree,
103	!	criterion = "loocv"
104		)
105	!	poly_curves[[u]] <- as.matrix(.eval_etm_poly_curve(curve_fit, poly.eval.points))
106		}
107		}
108		}
109
110		# All unique time steps in chronological order
111	1x	all_times <- sort(unique(time_vec))
112	1x	if (length(all_times) == 0L) {
113	!	stop("No valid time points provided for movie.")
114		}
115
116		# Build cumulative frame data
117	1x	frame_list <- vector("list", length(all_times) * n_by * 3L)
118	1x	fi <- 0L
119
120	1x	for (t_idx in seq_along(all_times)) {
121	30x	cur_t <- all_times[t_idx]
122	30x	for (b_idx in seq_along(unique_by)) {
123	90x	u <- unique_by[b_idx]
124	90x	u_all_mask <- (by_vec == u)
125	90x	u_mask <- u_all_mask & (time_vec <= cur_t)
126	30x	if (!any(u_mask)) next
127
128	60x	sub_pts <- pts_df[u_mask, , drop = FALSE]
129	60x	tip_pt <- sub_pts[nrow(sub_pts), , drop = FALSE]
130
131		# Determine line coordinates: either smooth poly curve or discrete points
132	60x	if (smooth == "poly" && !is.null(poly_curves[[u]])) {
133	!	total_n <- sum(u_all_mask)
134	!	cur_n <- nrow(sub_pts)
135	!	frac <- if (total_n > 1L) (cur_n - 1L) / (total_n - 1L) else 1.0
136	!	n_eval <- max(2L, as.integer(ceiling(frac * nrow(poly_curves[[u]]))))
137	!	curve_sub <- poly_curves[[u]][seq_len(min(n_eval, nrow(poly_curves[[u]]))), , drop = FALSE]
138	!	line_x <- curve_sub[, 1L]
139	!	line_y <- curve_sub[, 2L]
140		} else {
141	60x	line_x <- sub_pts[[dim_cols[1L]]]
142	60x	line_y <- sub_pts[[dim_cols[2L]]]
143		}
144
145	60x	fi <- fi + 1L
146	60x	frame_list[[fi]] <- data.frame(
147	60x	x = line_x,
148	60x	y = line_y,
149	60x	unit = u,
150	60x	unit_name = names[b_idx],
151	60x	color = colors[b_idx],
152	60x	time_frame = cur_t,
153	60x	trace_type = "line",
154	60x	stringsAsFactors = FALSE
155		)
156
157	60x	if (isTRUE(show.points) && smooth == "poly") {
158	!	fi <- fi + 1L
159	!	frame_list[[fi]] <- data.frame(
160	!	x = sub_pts[[dim_cols[1L]]],
161	!	y = sub_pts[[dim_cols[2L]]],
162	!	unit = u,
163	!	unit_name = names[b_idx],
164	!	color = colors[b_idx],
165	!	time_frame = cur_t,
166	!	trace_type = "points",
167	!	stringsAsFactors = FALSE
168		)
169		}
170
171	60x	if (isTRUE(show_tips)) {
172	60x	fi <- fi + 1L
173	60x	frame_list[[fi]] <- data.frame(
174	60x	x = tip_pt[[dim_cols[1L]]],
175	60x	y = tip_pt[[dim_cols[2L]]],
176	60x	unit = u,
177	60x	unit_name = names[b_idx],
178	60x	color = colors[b_idx],
179	60x	time_frame = cur_t,
180	60x	trace_type = "tip",
181	60x	stringsAsFactors = FALSE
182		)
183		}
184		}
185		}
186
187	1x	movie_df <- do.call(rbind, frame_list[seq_len(fi)])
188
189		# Add traces onto base enaplot
190	1x	p <- enaplot$plot
191
192	1x	for (b_idx in seq_along(unique_by)) {
193	3x	u <- unique_by[b_idx]
194	3x	u_line <- movie_df[movie_df$unit == u & movie_df$trace_type == "line", , drop = FALSE]
195
196	3x	p <- plotly::add_trace(
197	3x	p,
198	3x	data = u_line,
199	3x	x = ~x,
200	3x	y = ~y,
201	3x	frame = ~time_frame,
202	3x	name = names[b_idx],
203	3x	type = "scatter",
204	3x	mode = if (smooth == "poly") "lines" else (if (isTRUE(show.points)) "lines+markers" else "lines"),
205	3x	line = list(color = colors[b_idx], width = 2.5),
206	3x	marker = if (smooth != "poly" && isTRUE(show.points)) list(color = colors[b_idx], size = 5) else NULL,
207	3x	showlegend = TRUE
208		)
209
210	3x	if (smooth == "poly" && isTRUE(show.points)) {
211	!	u_pts <- movie_df[movie_df$unit == u & movie_df$trace_type == "points", , drop = FALSE]
212	!	p <- plotly::add_trace(
213	!	p,
214	!	data = u_pts,
215	!	x = ~x,
216	!	y = ~y,
217	!	frame = ~time_frame,
218	!	name = paste0(names[b_idx], " (points)"),
219	!	type = "scatter",
220	!	mode = "markers",
221	!	marker = list(color = colors[b_idx], size = 5, opacity = 0.7),
222	!	showlegend = FALSE
223		)
224		}
225
226	3x	if (isTRUE(show_tips)) {
227	3x	u_tips <- movie_df[movie_df$unit == u & movie_df$trace_type == "tip", , drop = FALSE]
228	3x	p <- plotly::add_trace(
229	3x	p,
230	3x	data = u_tips,
231	3x	x = ~x,
232	3x	y = ~y,
233	3x	frame = ~time_frame,
234	3x	name = paste0(names[b_idx], " (head)"),
235	3x	type = "scatter",
236	3x	mode = "markers",
237	3x	marker = list(color = colors[b_idx], size = 12, symbol = "diamond"),
238	3x	showlegend = FALSE
239		)
240		}
241		}
242
243	1x	p <- plotly::animation_opts(
244	1x	p,
245	1x	frame = frame_ms,
246	1x	transition = 0,
247	1x	redraw = TRUE
248		)
249
250	1x	p <- plotly::animation_slider(
251	1x	p,
252	1x	currentvalue = list(prefix = "Time / Turn: ", font = list(color = "#333333"))
253		)
254
255	1x	if (!is.null(title)) {
256	!	p <- plotly::layout(p, title = list(text = title))
257		}
258
259	1x	p
260		}

1		# Ellipsoidal scaling version
2		lws.positions.sq <- function(enaset) {
3	80x	points = as.matrix(enaset$points)
4	80x	weights = as.matrix(enaset$line.weights)
5	80x	positions = lws_lsq_positions(weights, points, ncol(points));
6
7	80x	node.positions = positions$nodes;
8	80x	rownames(node.positions) = enaset$rotation$codes
9	80x	colnames(node.positions) = colnames(points)
10
11	80x	return(list("node.positions" = node.positions, "centroids" = positions$centroids))
12		}
13
14		lws.positions.sq.R6 <- function(enaset) {
15	7x	if( enaset$function.params$center.align.to.origin ) {
16	7x	non_zero_rows <- rowSums(as.matrix(enaset$line.weights)) != 0
17	7x	positions = lws_lsq_positions(enaset$line.weights[non_zero_rows,], enaset$points.rotated[non_zero_rows,], ncol(enaset$points.rotated));
18	7x	mean_centroids = colMeans(positions$centroids);
19	7x	centroids = enaset$points.rotated;
20
21	7x	non_zero_row_centroids = rowSums(as.matrix(centroids))!=0;
22	7x	centroids[non_zero_row_centroids,] = t(t(positions$centroids) - mean_centroids)
23	7x	positions$centroids = centroids;
24	7x	positions$nodes = t(t(positions$nodes)-mean_centroids)
25		}
26		else {
27	!	positions = lws_lsq_positions(enaset$line.weights, enaset$points.rotated, ncol(enaset$points.rotated));
28		}
29
30	7x	node.positions = positions$nodes;
31	7x	rownames(node.positions) = enaset$enadata$codes;
32
33	7x	return(list("node.positions" = node.positions, "centroids" = positions$centroids))
34
35		}