R/zzz.R

In iglm: Regression under Interference in Connected Populations

#' @useDynLib iglm, .registration=TRUE

.onUnload <- function(libpath) {
  library.dynam.unload("iglm", libpath)
}
# Small helper functions
rowMins <- function(x) {
  apply(x, 1, min)
}
rowMaxs <- function(x) {
  apply(x, 1, max)
}
colMins <- function(x) {
  apply(x, 2, min)
}
colMaxs <- function(x) {
  apply(x, 2, max)
}
add_alpha <- function(color_code, alpha_level) {
  if (alpha_level < 0 || alpha_level > 1) {
    stop("Alpha level must be between 0 and 1.")
  }
  alpha_int <- round(alpha_level * 255)
  rgb_matrix <- col2rgb(color_code)
  new_color <- rgb(
    red = rgb_matrix[1, ],
    green = rgb_matrix[2, ],
    blue = rgb_matrix[3, ],
    alpha = alpha_int,
    maxColorValue = 255
  )

  return(new_color)
}

#'
#' @title Generate the Skeleton for an R Package to Implement Additional iglm Terms
#'
#' @description
#' This function generates the directory structure and source files for a new R package
#' named \code{iglm.userterms} (or whatever name is provided in the parameter \code{pkg_name}).
#' This auxiliary package serves as a template for extending the
#' \code{iglm} framework to user-defined sufficient statistics.
#' By compiling this package, users can link custom C++ implementations of change statistics
#' directly with the \code{iglm} package, enabling seamless integration of new model terms.
#'
#' @param path A character string specifying the path where the package directory
#'   should be created. Defaults to the current working directory (\code{"."}).
#' @param pkg_name A character string specifying the name of the package to be created.
#'
#' @details
#' The function creates a directory with the name specified in \code{pkg_name}
#' at the specified location.
#' As an example for a possible statistic, the statistic counting mutual
#' connections in the network is implemented.
#' After defining all possible change-statistics in the c++ function (this has to include a change for
#' \code{z_ij} (network), \code{x_i} (attribute x), and \code{y_i} (attribute y) all toggling from 0 to 1),
#' the function has to be registered using the \code{EFFECT_REGISTER} macro.
#' After compiling the package,
#' users have to load the package using \code{library(pkg_name)} before using it in \code{iglm}.
#'
#' @export
create_userterms_skeleton <- function(path = ".", pkg_name = "iglm.userterms") {
  pkg_path <- file.path(path, pkg_name)

  if (dir.exists(pkg_path)) {
    stop(paste(
      "Directory", pkg_path,
      "already exists. Please remove it or choose a different location."
    ))
  }

  # 2. Create Directory Structure
  dir.create(pkg_path, recursive = TRUE)
  dir.create(file.path(pkg_path, "R"))
  dir.create(file.path(pkg_path, "src"))

  # 3. Define File Contents based on your upload

  # --- DESCRIPTION  ---
  desc_content <- c(
    paste("Package: ", pkg_name),
    "Type: Package",
    "Title: Userterms for Regression under Network Interference",
    "Version: 1.0",
    "Date: 2025-11-09",
    "Authors@R: c(person(given = \"Your\", family = \"Name\", role = c(\"aut\", \"cre\"), email = \"corneliusfritz2010@gmail.com\"))",
    "Description: Userterms for generalized linear models (GLMs) for studying relationships among attributes in connected populations.",
    "License: GPL-3",
    "Encoding: UTF-8",
    "Imports: iglm, Rcpp",
    "LinkingTo: Rcpp, RcppArmadillo, iglm",
    "NeedsCompilation: yes",
    "RoxygenNote: 7.3.3"
  )

  # --- NAMESPACE ---
  ns_content <- c(
    "# Generated by roxygen2: do not edit by hand",
    "",
    "import(iglm)",
    "importFrom(Rcpp,evalCpp)",
    paste0("useDynLib(", pkg_name, ", .registration=TRUE)"),
    "exportPattern(\"^InitIglmTerm.\")"
  )

  zzz_content <- c(
    paste("#' @useDynLib", pkg_name, ", .registration=TRUE"),
    "#' @import iglm",
    "#' @importFrom Rcpp evalCpp",
    "NULL",
    "",
    "#' @export",
    "InitIglmTerm.my_mutual <- function(data_object, arglist, ...) {",
    "  arglist <- iglm:::check.IglmTerm(data_object, arglist,",
    "                                  directed = TRUE,",
    "                                  expected = list(mode = \"local\"),",
    "                                  defaults = list(mode = \"local\"))",
    "  list(",
    "    term_name = 'my_mutual',",
    "    coef_name = arglist$label",
    "  )",
    "}",
    "",
    "#' @export",
    "InitIglmTerm.my_spillover <- function(data_object, arglist, ...) {",
    "  arglist <- iglm:::check.IglmTerm(data_object, arglist,",
    "                                   directed = FALSE,",
    "                                   expected = list(mode = \"local\"),",
    "                                   defaults = list(mode = \"local\"))",
    "  list(",
    "    term_name = \"my_spillover\",",
    "    coef_name = arglist$label",
    "  )}"
  )


  # --- src/Makevars  ---
  makevars_content <- c(
    "PKG_CPPFLAGS = -DARMA_64BIT_WORD",
    "IGLM_LIB_PATH = $(shell \"${R_HOME}/bin/Rscript\" -e \"cat(file.path(system.file(package='iglm'), 'libs'))\")",
    "IGLM_SO_PATH = $(shell \"${R_HOME}/bin/Rscript\" -e \"cat(file.path(system.file(package = 'iglm'), 'libs',paste0('iglm.so')))\")",
    "PKG_LIBS = $(IGLM_SO_PATH) -Wl,-rpath,$(IGLM_LIB_PATH) -lR $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)"
  )

  cpp_content <- c(
    "#include <RcppArmadillo.h>",
    "#include \"iglm/extension_api.hpp\"",
    "#include \"iglm/xyz_class.h\"",
    "",
    "double xyz_stat_my_mutual(const XYZ_class &object,",
    "                          const int &actor_i,",
    "                          const int &actor_j,",
    "                          const arma::mat &data,",
    "                          const double &type,",
    "                          const std::string &mode,",
    "                          const bool &is_full_neighborhood){",
    "  if(mode == \"z\"){",
    "    return(object.z_network.get_val(actor_j, actor_i));",
    "  }",
    "  return(0);",
    "};",
    "",
    "double xyz_stat_my_spillover(const XYZ_class &object,",
    "                             const int &unit_i,",
    "                             const int &unit_j,",
    "                             const arma::mat &data,",
    "                             const double &type,",
    "                             const std::string &mode,",
    "                             const bool &is_full_neighborhood)",
    "{",
    "  double res = 0.0;",
    "  if (mode == \"x\") {",
    "    const auto& connections_of_i = object.adj_list_nb.at(unit_i);",
    "    for (const int &k : connections_of_i) {",
    "      if (k != unit_i) {",
    "        res += object.y_attribute.get_val(k);",
    "      }",
    "    }",
    "  } else if (mode == \"y\") {",
    "    const auto& connections_of_i = object.adj_list_nb.at(unit_i);",
    "    for (const int &k : connections_of_i) {",
    "      if (k != unit_i) {",
    "        res += object.x_attribute.get_val(k);  ",
    "      }",
    "    }",
    "  } else {",
    "    if (object.get_val_overlap(unit_i, unit_j)) {",
    "      res = (object.x_attribute.get_val(unit_i) * object.y_attribute.get_val(unit_j)) +",
    "            (object.x_attribute.get_val(unit_j) * object.y_attribute.get_val(unit_i));",
    "    }",
    "  }",
    "  return res;",
    "}",
    "",
    "EFFECT_REGISTER(\"my_mutual\", ::xyz_stat_my_mutual, \"my_mutual\", 0);",
    "EFFECT_REGISTER(\"my_spillover\", ::xyz_stat_my_spillover, \"my_spillover\", 0);"
  )

  # 4. Write Files
  writeLines(desc_content, file.path(pkg_path, "DESCRIPTION"))
  writeLines(ns_content, file.path(pkg_path, "NAMESPACE"))
  writeLines(zzz_content, file.path(pkg_path, "R", "zzz.R"))
  writeLines(makevars_content, file.path(pkg_path, "src", "Makevars"))
  writeLines(cpp_content, file.path(pkg_path, "src", "additional_cc.cpp"))

  message(paste0("Package skeleton ", pkg_name, " created at:", normalizePath(pkg_path)))
}