custom_classes.R
In fmesher: Triangle Meshes and Related Geometry Tools

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
set.seed(12345L)

## ----setup--------------------------------------------------------------------
library(fmesher)

## -----------------------------------------------------------------------------
# Custom class for harmonic functions up to order `n`
create_custom <- function(n) {
  stopifnot(n >= 0)
  structure(
    list(n = n),
    class = "custom"
  )
}
fm_dof.custom <- function(x) {
  # Return the number of degrees of freedom
  1L + 2L * x[["n"]]
}
fm_basis.custom <- function(x, loc, ..., full = FALSE) {
  # Return the evaluated basis functions
  A <- Matrix::Matrix(0.0, NROW(loc), fm_dof(x))
  ok <- !is.na(loc)
  A[ok, 1L] <- 1.0
  for (k in seq_len(x[["n"]])) {
    A[ok, 2 * k] <- cos(2 * pi * k * loc[ok])
    A[ok, 2 * k + 1L] <- sin(2 * pi * k * loc[ok])
  }
  result <- structure(
    list(
      A = A,
      ok = ok, # Required prior to version 0.2.0.9003
      loc = loc
    ),
    class = "fm_basis"
  )

  # Use the fm_basis method to extract the A matrix if full is FALSE:
  fm_basis(result, full = full)
}

## ----eval=FALSE---------------------------------------------------------------
#  # 'matrix' and 'Matrix' methods:
#  fm_basis(
#    A = A,
#    ok = ok, # If missing or NULL, inferred to be all TRUE
#    loc = loc, # Optional additional content
#    full = full
#  )
#  # 'list' method:
#  fm_basis(
#    list(
#      A = A,
#      ok = ok, # If missing or NULL, inferred to be all TRUE
#      loc = loc
#    ),
#    full = full
#  )

## -----------------------------------------------------------------------------
.S3method("fm_dof", "custom", "fm_dof.custom")
.S3method("fm_basis", "custom", "fm_basis.custom")

## -----------------------------------------------------------------------------
#' @rawNamespace S3method(fmesher::fm_dof, custom)
#' @rawNamespace S3method(fmesher::fm_basis, custom)

## ----eval = FALSE-------------------------------------------------------------
#  #' @title Degrees of freedom for custom mesh
#  #' @description the number of degrees of freedom
#  #' # The rest of the documentation goes here
#  #' @exportS3method fmesher::fm_dof
#  fm_dof.custom <- function(x) {
#    1L + 2L * x[["n"]]
#  }

## -----------------------------------------------------------------------------
m <- create_custom(2)

# How many latent variables are needed?
fm_dof(m)

# Evaluate the basis functions at some locations:
fm_basis(m, seq(0, 1, length.out = 6))
fm_basis(m, seq(0, 1, length.out = 6), full = TRUE)

# Check if missing values are handled correctly:
fm_basis(m, c(0.1, NA, 0.2))
fm_basis(m, c(0.1, NA, 0.2), full = TRUE)

## ----echo=FALSE---------------------------------------------------------------
out <- data.frame(
  x = c(
    seq(0, 0.3, by = 0.1),
    seq(0.3, 0.5, by = 0.1),
    seq(0.5, 1, by = 0.1)
  ),
  weight = rep(
    c(0.05, 0.1, 0.05, 0.05, 0.1, 0.05, 0.05, 0.1, 0.05),
    c(1, 2, 1, 1, 1, 1, 1, 4, 1)
  ),
  .block = rep(c(1, 2, 3), c(4, 3, 6))
)
out

## ----eval=TRUE----------------------------------------------------------------
values <- fm_evaluate(
  m,
  field = c(1, 1, 0, 0, 0),
  loc = out[["x"]]
)

# Blockwise aggregation:
fm_block_eval(
  block = out$.block,
  weights = out$weight,
  values = values
)

# Exact integrals:
c(0.3, 0.2, 0.5) +
  c(
    sin(2 * pi * 0.3),
    sin(2 * pi * 0.5) - sin(2 * pi * 0.3),
    sin(2 * pi) - sin(2 * pi * 0.5)
  ) / (2 * pi)