#' @rdname cgeneric-class
#' @description
#' A GMRF is defined from model parameters \eqn{\theta} that
#' would parametrize a (sparse) precision matrix.
#'
#' The elements of a GMR are:
#'  *  `graph` to define the non-zero precision matrix pattern.
#'  only the upper triangle including the diagonal is needed.
#'  * `Q` vector where the
#'     * first element (N) is the size of the matrix,
#'     * second element (M) is the number of non-zero
#'     elements in the upper part (including) diagonal
#'     * the remaining (M) elements are the actual
#'     precision (upper triangle plus diagonal) elements
#'     whose order shall follow the graph definition.
#'  * `mu` the mean vector,
#'  * `initial` vector with
#'    * first element as the number of the parameters in the model
#'    * remaining elements should be the initials for the model parameters.
#'  * `log.norm.const` log of the normalizing constant.
#'  * `log.prior` log of the prior for the model parameters.
#' @param model object class for what a `cgeneric` method exists.
#' if it is a character, a specific function will be called,
#' for example cgeneric("iid", ...") calls cgeneric_iid(...).
#' @param ... additional arguments passed on to methods
#' It should include
#' `n` and `debug`. For `cgenericBuild` and
#'  `model` as a character string with the name of the
#'  C function and `shlib` as the path to the
#'  shared object containing such function.
#'  If `shlib` is not provided it can be built
#'  using `cgeneric_shlib_path` for the
#'  `package` (character with the R package containing it),
#'  in which `useINLAprecomp` (logical) indicates if it is to
#'  use the one contained within `INLA` or in the package.
#'  When using the inlabru package,
#'  one can also provide a `mapper` which will be evaluated by
#'  the bru_get_mapper inlabru's function.
#' @note
#' The `graph` and `Q` non-zero pattern should match,
#' its elements should be ordered by row,
#'and only its upper part stored.
#' @returns a method to build a `cgeneric` should return
#' a named list of `cgeneric` class that contains a
#'  named list `f` that contains (at least):
#'  * `model` a character always equal to `cgeneric`,
#'  * `n` an integer greater than 0, and
#'  * `cgeneric` as a named list that contains the
#'  data needed to define the model. Each element on
#'  ...$f$cgeneric is also a named list containing
#'  `ints`, `doubles`, `characters`, `matrices`
#'  and `smatrices`.
#'  * (possible) `extraconstr` as a named list with: `A` as a
#'   `n` times `k` matrix and `e` as a length `k` vector.
#'
#'  The `cgeneric_shlib_path` function returns a `character`
#'  with the path to the shared lib.
#' @export
#' @examples
#' cg <- cgeneric("iid", n = 10, param = c(1, 0.05))
#' cg
cgeneric <- function(model, ...) {
  UseMethod("cgeneric")
}

#' @describeIn cgeneric-class
#' Call a function named as `cgeneric_[model]` to build a `cgeneric`.
#' @export
cgeneric.character <- function(
    model,
    ...) {

  dotArgs <- list(...)

  ## some "convention" here:
  if(length(grep("cgeneric_", model))==0) {
    model <- paste0("cgeneric_", model)
  }
  if(any(model %in%
         paste0("cgeneric_",
                c("iid", "generic0", "shlib")))) {
    if(!is.null(dotArgs$debug) && dotArgs$debug) {
      cat("call", model, "\n")
    }
    return(do.call(
      what = model,
      args = dotArgs
      )
    )
  } else {

    out <- try(do.call(
      what = model,
      args = dotArgs
    ), silent = TRUE)

    if((inherits(out, "cgeneric")) |
       (inherits(out, "inla.cgeneric"))) {
      return(out)
    } else {

      fn <- findGetFunction(
        fName = model
      )
      if(is.function(fn)) {
        return(cgeneric(model = fn, ...))
      }
    }
  }
}

#' @describeIn cgeneric-class
#' The `cgeneric` method for function.
#' @export
cgeneric.function <- function(
    model,
    ...) {
  out <- do.call(
    what = model,
    args = list(...)
    )
  return(out)
}

#' @describeIn cgeneric-class
#' Check, append `cgeneric` class, returns model unchanged.
#' @export
cgeneric.cgeneric <- function(model, ...) {
  return(model)
}

#' @describeIn cgeneric
#' Check and converts a regular `inla.cgeneric` object to `cgeneric`.
#' @export
cgeneric.inla.cgeneric <- function(model, ...) {
  stopifnot(!c("f") %in% names(model))
  stopifnot(!all(c("model", "n", "cgeneric") %in% names(model$f)))
  stopifnot(!c("data") %in% names(model$f$cgeneric))
  stopifnot(!all(c("ints", "characters") %in% names(model$f$cgeneric)))
  stopifnot(!all(c("n") %in% names(model$f$cgeneric$data$ints)))
  stopifnot(!all(c("shlib") %in% names(model$f$cgeneric$data$characters)))
  class(model) <- c("cgeneric", class(model))
  return(model)
}


#' @describeIn cgeneric
#' Build a `cgeneric` from a list of arguments.
#' @export
cgenericBuilder <- function(
    ...) {

  ## do what INLA::inla.cgeneric.define() does

  dotArgs <- list(...)
  nargs <- names(dotArgs)
  if(any(nargs == ""))
    stop("Please name the arguments!")
  if(!any(nargs == "n"))
    stop("Please provid 'n'!")
  if(!any(nargs == "debug"))
    dotArgs$debug <- FALSE
  if(!any(nargs == "shlib"))
    stop("Please provid 'shlib'!")
  if(!any(nargs == "model"))
    stop("Please provid 'model'!")
  stopifnot(dotArgs$n>=1)
  ind <- pmatch(c("n", "debug"),
                names(dotArgs))
  dotArgs <- c(list(
    n = as.integer(dotArgs$n),
    debug = dotArgs$debug),
    dotArgs[setdiff(1:length(dotArgs),ind)]
  )
  n <- dotArgs$n
  dotArgs$debug <- as.integer(dotArgs$debug)
  dotArgs$model <- as.character(dotArgs$model)
  dotArgs$shlib <- as.character(dotArgs$shlib)

  nM <- length(iM <- which(
    sapply(dotArgs, function(x)
      is(x, "Matrix"))))
  nm <- length(im <- which(
    sapply(dotArgs, is.matrix)))
  ni <- length(ii <- setdiff(
    which(sapply(dotArgs, is.integer)), im))
  nd <- length(id <- setdiff(
    which(sapply(dotArgs, is.double)), im))
  nc <- length(ic <- which(
    sapply(dotArgs, is.character)))
  stopifnot(ni>1)
  stopifnot(ni>1)

  if(dotArgs$debug) {
    cat("The cgeneric model data contains:\n",
        ni, "ints",
        nc, "characters",
        nd, "doubles",
        nm, "matrices, and",
        nM, "smatrices\n")
  }

  cmodel <- dotArgs[c("model", "shlib", "n", "debug")]
  cmodel$data <- vector("list", 5L)
  names(cmodel$data) <- c(
    "ints", "doubles", "characters",
    "matrices", "smatrices")
  cmodel$data$ints <- dotArgs[ii]
  if(nd>0) cmodel$data$doubles <- dotArgs[id]
  cmodel$data$characters <- dotArgs[ic]
  if(nm>0) {
    cmodel$data$matrices <- dotArgs[im]
    for(i in 1:nm) {
      cmodel$data$matrices[[i]] <-
        c(dim(cmodel$data$matrices[[i]]),
          t(cmodel$data$matrices[[i]])) ## columnwise...
    }
  }
  if(nM>0) {
	  cmodel$data$smatrices <- dotArgs[iM]
	  for(i in 1:nM) {
	    smi <- upperPadding(cmodel$data$smatrices[[i]])
	    cmodel$data$smatrices[[i]] <- c(
	      dim(smi), length(smi@x),
	      smi@i, smi@j, smi@x
	    )
	  }
  }
  class(cmodel) <- c("inla.cgeneric.f", ## this is needed in INLA::f() from August 2025
                     "inla.cgeneric") ##  this is needed for older INLA

  cmodel_wrapper <- structure(
    list(
      f = list(
        model = "cgeneric",
        n = n,
        cgeneric = cmodel
      )
    ),
    class = c("cgeneric", "inla.cgeneric")
  )
  if(is.null(dotArgs$mapper)) {
    mapper <- list(n = n)
    class(mapper) <- c("bm_index", "bru_mapper")
    cmodel_wrapper$mapper <- mapper
  } else {
    cmodel_wrapper$mapper <- dotArgs$mapper
  }
  return(cmodel_wrapper)
}

#' @describeIn cgeneric
#'  A default mapper for a cgeneric/rgeneric model
mapper1 <- function(model) {
  vs <- "2.13.0.9005"
  inlabruCheck <- packageCheck(
    name = "inlabru",
    minimum_version = vs) >= vs
  if(is.null(model$mapper) || is.na(inlabruCheck)) {
    mapper <- list(n = model$n)
    class(mapper) <- c("bm_index", "bru_mapper")
  } else {
    bgm <- findGetFunction(
      fName = "bru_get_mapper",
      package = "inlabru")
    mapper <- bgm(model = model)
  }
  return(mapper)
}

#' @describeIn cgeneric
#' Make the lib path for the shared lib of a package.
#' @param package character giving the name of the package
#' that contains the `cgeneric` model.
#' @param useINLAprecomp logical, indicating if it is to use
#' the shared object previously copied and compiled by INLA.
#' @param debug integer, used as verbose in debug.
#' @export
cgeneric_shlib_path <- function(
    package,
    useINLAprecomp,
    debug) {

  if(missing(package) || is.null(package)) {
    stop("please provide package!")
  }
  if(missing(debug)) {
    debug <- FALSE
  }
  if(missing(useINLAprecomp)) {
    useINLAprecomp <- TRUE
  } else {
      if(is.null(useINLAprecomp)) {
          useINLAprecomp <- TRUE
      }
  }

  nbit <- as.integer(8 * (.Machine$sizeof.pointer))
  if(useINLAprecomp) {
    shlib <- paste0(
      find.package("INLA"), "/bin/", apINLAbin(),
      "external/", package, "/lib", package, ".so")
    if(debug) {
      cat("INLA compiled shared lib at:\n", shlib, "\n")
    }
  } else {
    shlib <- paste0(find.package(package = package),
                    "/libs/")
    if (Sys.info()["sysname"] == "Windows") {
      shlib <- file.path(
        shlib,
        paste0("x", nbit, "/", package, ".dll"))
    } else {
      shlib <- file.path(shlib,
                         paste0(package, ".so"))
    }
    if(debug) {
      cat(package, "compiled shared lib at:\n",
          shlib, "\n")
    }
  }
  return(normalizePath(shlib))
}
#' @describeIn cgeneric
#' Print the cgeneric object
#' @param x a cgeneric object
#' @export
print.cgeneric <- function(x, ...) {
  cat("cgeneric: ", x$f$cgeneric$model, ", n = ",
      x$f$cgeneric$n, ", shlib:\n", sep = "")
  cat(x$f$cgeneric$data$characters$shlib, "\n")
  d0 <- c(2L, 0L, 2L, 0, 0)
  dn <- sapply(x$f$cgeneric$data, length)
  dn0 <- dn-d0
  ii <- which(dn0>0)
  if(length(ii)>0) {
    nd <- names(dn)
    for(i in ii){
      d <- x$f$cgeneric$data[[i]]
      ndi <- names(d)
      jj <- (d0[i]+1):dn[i]
      cat(nd[i], " (", dn[i], ") : ", sep = "")
      if(i %in% c(1,2,3)) {
        cat(paste(ndi[jj], "(", sapply(d[jj], length),
                  ") ", sep = ""), "\n")
      } else {
        if(i==4) {
          dj <- sapply(d[jj], function(x) x[1:2])
          cat(paste(ndi[jj], "(", dj[1,], ",", dj[2, ],
                    ") ", sep = ""), "\n")
        }
        if(i==5) {
          dj <- sapply(d[jj], function(x) x[1:3])
          cat(paste(ndi[jj], "(", dj[1,], ",",
                    dj[2, ], ",", dj[3,],
                    ") ", sep = ""), "\n")
        }
      }
    }
  }
}
#' @describeIn cgeneric
#' A summary for a cgeneric object
#' @param object a cgeneric object
#' @export
summary.cgeneric <- function(object, ...) {
  g <- cgeneric_get(object, "graph")
  cat("n = ", object$f$cgeneric$n, ", graph with",
      length(g@x), "non-zeros\n", sep = "")
}
#' @describeIn cgeneric
#' A plot for a cgeneric object
#' @param y not used
#' @export
plot.cgeneric <- function(x, y, ...) {
  g <- cgeneric_get(x, "graph")
  image(g)
}
