
#' Harvest component of operating model
#'
#' A function used by openMSE to specify the fishing effort during the projections.
#' salmonMSE updates the arguments of this function from the salmon operating model.
#'
#' @param x Simulation number
#' @param DataList A nested list of [MSEtool::Data-class] objects by stock then fleet, generated by [MSEtool::multiMSE()]
#' @param reps The number of stochastic replicates to be returned by the function
#' @param u_terminal Numeric vector by population (s). Harvest rate of retained catch in the terminal fishery
#' @param u_preterminal Single numeric. Harvest rate of retained catch in the pre-terminal fishery
#' @param K_PT Single numeric. Total retained catch in the pre-terminal fishery
#' @param K_T Numeric vector by population (s). Total retained catch in the terminal fishery
#' @param type_PT Single character, containing either "catch" or "u". Indicates whether to manage by harvest rate or total catch numbers for preterminal fisheries
#' @param type_T Character vector by population (s), containing either "catch" or "u". indicates whether to manage by harvest rate or total catch numbers for terminal fisheries
#' @param MSF_PT Single logical, whether to implement mark-selective fishing for the preterminal fishery
#' @param MSF_T Logical vector by population (s), whether to implement mark-selective fishing for the terminal fishery
#' @param m Numeric vector by population (s). Mark rate of hatchery origin fish, as a proxy for fishery retention. Only used to calculate the fishing effort.
#' Retention in the operating model is specified in the [MSEtool::MOM-class] object
#' @param release_mort Matrix `[2, s]`. Release mortality of discarded fish in the pre-terminal (1st row) and terminal (2nd row) fishery. Only used
#' if `MSF_PT = TRUE` or `MSF_T[s] = TRUE`. Only used to calculate the fishing effort.
#' Release mortality in the operating model is specified in the [MSEtool::MOM-class] object
#' @param p_terminal Numeric vector. Population index (p) for the recruitment that experiences the terminal fishing mortality
#' @param p_preterminal Numeric vector. Population index (p) for immature fish that experience the pre-terminal fishing mortality
#' @param p_natural Numeric vector. Population index (p) for natural origin fish
#' @param p_hatchery Numeric vector. Population index (p) for hatchery origin fish
#' @param pkey Data frame that assigns openMSE population by life stage and origin (p) to salmonMSE population (s)
#'
#' @param ... Not used
#'
#' @return A nested list of [MSEtool::Rec-class] objects, same dimension as `DataList`
#'
#' @keywords internal
Harvest_MMP <- function(x = 1, DataList, reps = 1,
                        u_terminal, u_preterminal, K_PT, K_T,
                        type_PT = "u", type_T = "u", MSF_PT = FALSE, MSF_T = FALSE, m, release_mort,
                        p_terminal = c(2, 5), p_preterminal = c(1, 4), pkey = data.frame(p = 1:6, s = 1),
                        p_natural = 1:3, p_hatchery = 4:6, ...) {

  type_PT <- match.arg(type_PT, choices = c("u", "catch"), several.ok = TRUE)
  type_T <- match.arg(type_T, choices = c("u", "catch"), several.ok = TRUE)

  np <- length(DataList)
  nf <- length(DataList[[1]])

  y <- max(DataList[[1]][[1]]@Year) - DataList[[1]][[1]]@LHYear + 1
  nyears <- length(DataList[[1]][[1]]@Misc$FleetPars$Find[x, ])

  odd_time_step <- as.logical(y %% 2)

  multiRec <- lapply(1:np, function(p) {

    Effort <- 0 # Stays at zero unless otherwise

    Nage_p <- rowSums(DataList[[p]][[1]]@Misc$StockPars$N_P[x, , y, ], na.rm = TRUE)

    if (sum(Nage_p)) {

      #### Preterminal is mixed stock fishery ----
      if (odd_time_step && p %in% p_preterminal) {

        if (MSF_PT) {
          # MSF, solve for effort based on kept catch of all HO juveniles
          p_HOS_PT <- intersect(p_preterminal, p_hatchery) # Identify HO juveniles in openMSE (p)
          s_PT <- pkey$s[match(p_HOS_PT, pkey$p)] # Identify salmonMSE population (s) corresponding to p

          # Abundance and vulnerability
          Nage_PT <- sapply(p_HOS_PT, function(pp) rowSums(DataList[[pp]][[1]]@Misc$StockPars$N_P[x, , y, ]))
          V_PT <- sapply(p_HOS_PT, function(pp) DataList[[pp]][[1]]@Misc$FleetPars$V[x, , nyears + y])

          # Mark rate (as retention) and release mortality
          m_s <- matrix(m[s_PT], nrow(Nage_PT), ncol(Nage_PT), byrow = TRUE)
          relmort_s <- matrix(release_mort[1, s_PT], nrow(Nage_PT), ncol(Nage_PT), byrow = TRUE)
        } else {
          # No MSF, solve for effort based on kept catch of all juveniles (NO + HO)
          Nage_PT <- sapply(p_preterminal, function(pp) rowSums(DataList[[pp]][[1]]@Misc$StockPars$N_P[x, , y, ]))
          V_PT <- sapply(p_preterminal, function(pp) DataList[[pp]][[1]]@Misc$FleetPars$V[x, , nyears + y])

          m_s <- 1
          relmort_s <- 0
        }

        Effort <- get_F(
          u = u_preterminal, K = K_PT, type = type_PT,
          M = array(0, dim(Nage_PT)), N = Nage_PT,
          vul = V_PT, ret = m_s, release_mort = relmort_s
        )

      } else if (!odd_time_step && p %in% p_terminal) {

        #### Terminal fishery is a single stock fishery ----
        # Identify salmonMSE population s corresponding openMSE population p
        s_T <- pkey$s[match(p, pkey$p)]
        if (length(s_T) > 1) stop("length(s_T) > 1")

        if (MSF_T[s_T]) {
          # MSF, solve for effort based on kept catch of HO return corresponding to s
          p_HOS_T_all <- intersect(p_terminal, p_hatchery)
          p_HOS_T <- intersect(p_HOS_T_all, pkey$p[pkey$s == s_T])

          # Abundance and vulnerability
          Nage_T <- sapply(p_HOS_T, function(pp) rowSums(DataList[[pp]][[1]]@Misc$StockPars$N_P[x, , y, ]))
          V_T <- sapply(p_HOS_T, function(pp) DataList[[pp]][[1]]@Misc$FleetPars$V[x, , nyears + y])

          # Mark rate (as retention) and release mortality
          m_s <- matrix(m[s_T], nrow(Nage_T), ncol(Nage_T))
          relmort_s <- matrix(release_mort[2, s_T], nrow(Nage_T), ncol(Nage_T))

        } else {
          # No MSF, solve for effort based on kept catch of all return (NO + HO) corresponding to s
          p_T <- intersect(p_terminal, pkey$p[pkey$s == s_T])

          Nage_T <- sapply(p_T, function(pp) rowSums(DataList[[pp]][[1]]@Misc$StockPars$N_P[x, , y, ]))
          V_T <- sapply(p_T, function(pp) DataList[[pp]][[1]]@Misc$FleetPars$V[x, , nyears + y])

          m_s <- 1
          relmort_s <- 0
        }

        Effort <- get_F(
          u = u_terminal[s_T], K = K_T[s_T], type = type_T[s_T],
          M = array(0, dim(Nage_T)), N = Nage_T,
          vul = V_T, ret = m_s, release_mort = relmort_s
        )
      }
    }

    lapply(1:nf, function(f) {
      Rec <- new("Rec")
      if (p %in% c(p_terminal, p_preterminal)) {
        HistE <- DataList[[p]][[f]]@OM$FinF[x] # Last historical fishing effort
        Rec@Effort <- rep(Effort/HistE, reps)
      } else {
        Rec@Effort <- rep(0, reps)
      }
      return(Rec)
    })
  })

  return(multiRec)
}

#' @rdname salmonMSE-int
#' @return
#' `make_Harvest_MMP`: Function of class "MMP" by updating the formal arguments for [Harvest_MMP()]
#' @export
make_Harvest_MMP <- function(SOM, check = TRUE) {

  if (check) SOM <- check_SOM(SOM)

  pindex <- make_stock_index(SOM)

  f <- Harvest_MMP

  # Terminal fishery, specific to population
  formals(f)$type_T <- vapply(SOM@Harvest, slot, character(1), "type_T")
  formals(f)$u_terminal <- vapply(SOM@Harvest, slot, numeric(1), "u_terminal")
  formals(f)$K_T <- vapply(SOM@Harvest, slot, numeric(1), "K_T")
  formals(f)$MSF_T <- vapply(SOM@Harvest, slot, logical(1), "MSF_T")

  formals(f)$m <- vapply(SOM@Hatchery, slot, numeric(1), "m")
  formals(f)$release_mort <- vapply(SOM@Harvest, slot, numeric(2), "release_mort")

  # Pre-terminal fishery, shared for all populations
  formals(f)$type_PT <- SOM@Harvest[[1]]@type_PT
  formals(f)$u_preterminal <- SOM@Harvest[[1]]@u_preterminal
  formals(f)$K_PT <- SOM@Harvest[[1]]@K_PT
  formals(f)$MSF_PT <- SOM@Harvest[[1]]@MSF_PT

  formals(f)$p_preterminal <- pindex$p[pindex$stage == "juvenile"]
  formals(f)$p_terminal <- pindex$p[pindex$stage == "recruitment"]
  formals(f)$p_natural <- pindex$p[pindex$origin == "natural"]
  formals(f)$p_hatchery <- pindex$p[pindex$origin == "hatchery"]
  formals(f)$pkey <- pindex[, c("s", "p")]

  if (formals(f)$MSF_PT && !length(formals(f)$p_hatchery)) {
    stop("Mark-selective fishing is TRUE for preterminal fishery but there are no hatchery populations")
  }
  if (any(formals(f)$MSF_T)) {
    ns <- length(SOM@Bio)

    for (s in 1:ns) {
      MSF_s <- formals(f)$MSF_T[s]
      p_hatchery <- pindex[pindex$s == s & pindex$origin == "hatchery", ]

      if (MSF_s && !nrow(p_hatchery)) {
        stop("Mark-selective fishing is TRUE for terminal fishery but there is no hatchery for population ", s)
      }
    }
  }

  class(f) <- "MMP"
  return(f)
}

#' Calculate F from harvest rate
#'
#' Solves for apical instantaneous fishing mortality rate (F), proportional to fishing effort, from harvest rate (total retained catch over total abundance).
#' The apical F can be greater than the realized F, if retention < 1.
#'
#' @param u Harvest rate, between 0-1
#' @param K Catch, between 0-Inf
#' @param type Character, either `"catch"`, or `"u"`, whether to solve for catch or harvest rate, respectively
#' @param M Instantaneous natural mortality rate
#' @param N Abundance
#' @param vul Vulnerability
#' @param ret Retention rate
#' @param release_mort Release mortality as a proportion, between 0-1. Only relevant if `ret < 1`.
#' @param Fmax Maximum allowable value of F
#' @return Numeric for the apical F
#'
#' @keywords internal
get_F <- function(u = 0, K = 0, type = c("u", "catch"), M, N = 1, vul = 1, ret = 1, release_mort = 0, Fmax = 20) {
  type <- unique(type)

  type <- match.arg(type)
  Fout <- 0

  solve_u <- type == "u" && u > 0
  solve_K <- type == "catch" && K > 0

  if (solve_u || solve_K) {
    .F <- try(
      uniroot(F_solver, interval = c(0, Fmax), M = M, N = N, vul = vul, ret = ret, release_mort = release_mort, u = u, K = K, type),
      silent = TRUE
    )

    if (is.character(.F)) {
      Fout <- Fmax
    } else {
      Fout <- .F$root
    }
  }

  return(Fout)
}

F_solver <- function(.F, M, N = 1, vul = 1, ret = 1, release_mort = 0, u = 0, K = 0, type = c("u", "catch")) {
  type <- match.arg(type)

  F_ret <- vul * ret * .F
  F_rel <- vul * (1 - ret) * release_mort * .F
  Z <- F_ret + F_rel + M
  catch_ret <- F_ret/Z * (1 - exp(-Z)) * N
  catch_ret[is.na(catch_ret)] <- 0

  if (type == "u") {
    fn <- (1 - exp(-max(F_ret))) - u
  } else {
    fn <- sum(catch_ret)/K - 1
  }
  return(fn)

}

