implement factory pattern

R/graphon_distribution.R

@@ -95,7 +95,7 @@ pgraphon_analytical_1d <- function(y, a, fX, Fv,
 #'
 #' @export
 pgraphon <- function(
-    y,           # scalar
+    y,           # scalar or vector
     a,           # vector (coefficient vector, can be one-dimensional)
     Fv,          # CDF function of the v's (e.g., pnorm, pexp, etc.)
     X_matrix     # n x p matrix: each row is X_i
@@ -117,23 +117,112 @@ pgraphon <- function(
     stop("'Fv' must be a function (a CDF)")
   }
   ## 1.2 Compute the expected value ============================================
-  
+
   # Compute a^T X_i as in the paper. Here we switched to the R convention that each
   # observation is a row. The paper assumes that each observation is a vector
   inner_products <- as.vector(X_matrix %*% a)  # vector of length n
-  
+
   # outer(y, inner_prod, "-") creates an |y| × n matrix where element (j,i)
   # equals y[j] - inner_prod[i].
   dev_mat <- outer(y, inner_products, "-")
-  
+
   # Apply CDF Fv to each deviation
   cdf_vals <- Fv(dev_mat)
-  
+
   # Row means give the empirical expectation for each y_j
   out <- rowMeans(cdf_vals)
   out
 }
 
+#' Empirical CDF of a linear predictor plus a constant
+#'
+#' This helper computes the empirical cumulative distribution function (ECDF)
+#' of the quantity \eqn{z = a^\top X + v} and evaluates it at one or more
+#' points `y`.  It adds a few safety checks, supports vectorised `y`,
+#' and optionally returns the underlying ECDF function for later use.
+#'
+#' @param y Numeric vector of values at which the ECDF should be evaluated.
+#' @param a Numeric vector of coefficients (length must equal \code{ncol(X_matrix)}).
+#' @param v Either a numeric scalar or a numeric vector of length \code{nrow(X_matrix)}.
+#'          It is added to the linear predictor.
+#' @param X_matrix Numeric matrix (or something coercible to a matrix) that
+#'          contains the covariates. Rows correspond to observations.
+#' @param return_ecdf Logical (default \code{FALSE}).  If \code{TRUE} the
+#'          function returns a list with two components:
+#'          \itemize{
+#'            \item \code{prob} – the ECDF values at `y`.
+#'            \item \code$ecdf – the step‑function object returned by \code{ecdf()}.
+#'          }
+#'          If \code{FALSE} only the vector of probabilities is returned.
+#' @return Either a numeric vector of ECDF values (default) or a list
+#'         containing that vector and the ECDF function (if \code{return_ecdf=TRUE}).
+#' @examples
+#' ## Simple illustration with the built‑in mtcars data
+#' X <- as.matrix(mtcars[, c("wt", "hp")])
+#' a <- c(-0.5, 0.02)          # coefficients
+#' v <- 0.1                    # constant shift
+#' y_vals <- seq(-5, 5, length.out = 11)
+#' pgraphon_ecdf(y = y_vals, a = a, v = v, X_matrix = X)
+#'
+#' ## Get the ECDF function for later use
+#' out <- pgraphon_ecdf(y = y_vals, a = a, v = v, X_matrix = X,
+#'                      return_ecdf = TRUE)
+#' out$ecdf(0)   # probability that z <= 0
+#' @export
+pgraphon_ecdf <- function(y,
+                          a,
+                          v,
+                          X_matrix,
+                          return_ecdf = FALSE) {
+  ## ---- Input validation -------------------------------------------------
+  # y -------------------------------------------------
+  if (!is.numeric(y)) {
+    stop("`y` must be a numeric vector.")
+  }
+  
+  # X_matrix -------------------------------------------------
+  X_mat <- as.matrix(X_matrix)
+  if (ncol(X_mat) == 0L || nrow(X_mat) == 0L) {
+    stop("`X_matrix` must have at least one row and one column.")
+  }
+  
+  # a -------------------------------------------------
+  if (!is.numeric(a) || length(a) != ncol(X_mat)) {
+    stop("`a` must be a numeric vector with length equal to ncol(X_matrix).")
+  }
+  
+  # v -------------------------------------------------
+  if (!is.numeric(v)) {
+    stop("`v` must be numeric (scalar or vector).")
+  }
+  if (length(v) == 1L) {
+    v_vec <- rep(v, nrow(X_mat))
+  } else if (length(v) == nrow(X_mat)) {
+    v_vec <- v
+  } else {
+    stop("`v` must be either a scalar or a vector of length nrow(X_matrix).")
+  }
+  
+  ## ---- Compute linear predictor -----------------------------------------
+  # z = X %*% a + v
+  # Using as.numeric to coerce the 1‑column matrix result to a plain vector
+  z <- as.numeric(X_mat %*% a) + v_vec
+  
+  ## ---- Build ECDF -------------------------------------------------------
+  # ecdf() returns a step function that can be evaluated at any numeric vector
+  emp_cdf <- stats::ecdf(z)
+  
+  ## ---- Evaluate at y ----------------------------------------------------
+  prob <- emp_cdf(y)   # vectorised automatically
+  
+  ## ---- Return -----------------------------------------------------------
+  if (return_ecdf) {
+    list(prob = prob, ecdf = emp_cdf)
+  } else {
+    prob
+  }
+}
+
 # 2. Density Function ----------------------------------------------------------
 
 #' Empirical Graphon Density Estimate