# This file contains many functions to reshape output from get_output()

# To remove the NOTE `no visible binding for global variable`

utils::globalVariables(c(

  "data", "data_id", "data_ids", "data_type",

  "delete_me",

  "density_component",

  "derived_quantities", "dimensionality",

  "fleet",

  "join_by", "json",

  "input_type",

  "label", "label_splits", "likelihood", "log_sd_values",

  "module_name", "module_id", "module_type",

  "observed_data_id", "observed_values",

  "parameter_min", "parameter_max",

  "parameters",

  "population"

))

#' Reshape JSON estimates

#'

#' @description

#' This function processes the finalized FIMS JSON output and reshapes the

#' parameter estimates into a structured tibble for easier analysis and

#' manipulation.

#'

#' @param model_output A JSON object containing the finalized FIMS output as

#'   returned from `get_output()`, which is an internal function to each model

#'   family.

#' @return A tibble containing the reshaped parameter estimates.

reshape_json_estimates <- function(model_output) {

    )],

  )

  # Process the module parameters

        )

    ],

      )

    )

  ) |>

  # Process the fleet-level information

      )

    ) |>

    ) |>

        ) |>

    ) |>

    ) |>

    ) |>

    # Remove column ids that are not currently needed

      )

    ) |>

    ) |>

  # Process the data components

  # TODO: Data component needs actual uncertainty instead of 0

    ) |>

  # Process the density components

  # This is done above for fleet information but we will need to do it for

  # parameter-level information once we have a link to the parameter id

    ) |>

  # Process the population data

    ) |>

    # TODO: Think about these ids when we have more than one population

      )

    ) |>

  # TODO: Bring in TMB estimates

  # TODO: Change some column names

  # Bring everything together

    # density_information,

  ) |>

    )

}

#' Reshape TMB estimates

#'

#' @description

#' This function processes the TMB std and reshapes them into a structured

#' tibble for easier analysis and manipulation.

#'

#' @param obj An object returned from [TMB::MakeADFun()].

#' @param sdreport An object of the `sdreport` class as returned from

#'   [TMB::sdreport()].

#' @param opt An object returned from an optimizer, typically from

#'   [stats::nlminb()], used to fit a TMB model.

#' @param parameter_names A character vector of parameter names. This is used to

#'   identify the parameters in the `std` object.

#' @return A tibble containing the reshaped estimates (i.e., parameters and

#' derived quantities).

reshape_tmb_estimates <- function(obj,

                                  sdreport = NULL,

                                  opt = NULL,

                                  parameter_names) {

  # Outline for the estimates table

    # The FIMS Rcpp module

    # The unique ID of the module

    # The name of the parameter or derived quantity

    # The unique ID of the parameter

    # The initial value use to start the optimization procedure

    # The estimated parameter value, which would be the MLE estimate or the value

    # used for a given MCMC iteration

    # Estimated uncertainty, reported as a standard deviation

    # The pointwise log-likelihood used for the test or holdout data

    # The gradient component for that parameter, NA for derived quantities

  )

    # Number of rows for derived quantities: based on the difference

    # between the total number of rows in std and the length of parameter_names.

    # Create a tibble with the data from the std, and then apply transformations.

        # Use obj[["env"]][["parameters"]][["p"]] as this will return both initial

        # fixed and random effects while obj[["par"]] only returns initial fixed

        # effects

        ),

        )

      )

  } else {

      )

  }

    # Split labels and extract module, id, label, and parameter id

    # TODO: the code could be simplified using tidyr::separate_wider_*().

    # However, doing so would require avoiding pre-specification of these columns

    # in the estimates_outline tibble. Consider updating the code if we decide

    # not to create the `estimates_outline` tibble in advance.

    ) |>

}

#' Converts a dimension-folder section into a tibble

#'

#' This is an internal helper function that processes a complex list

#' structure read in from a json file containing dimensionality information, a

#' name, and either explicit values with a type or estimated values with

#' uncertainty.

#'

#' @param section A section of the json file represented as a list.

#' @return

#' A tibble containing the json output in a formatted structure listing the

#' dimensionality as columns rather than just row and column lengths.

#' @noRd

#'

#' @examples

#' # A simple example for a value with uncertainty:

#' section_derived <- list(

#'   name = "derived_quantity_name",

#'   dimensionality = list(

#'     unit = "m", symbol = "L", scale = 1.0, type = "length"

#'   ),

#'   value = 10.5,

#'   uncertainty = 0.5

#' )

#' dimension_folded_to_tibble(section_derived)

dimension_folded_to_tibble <- function(section) {

  }

  }

        # TODO: Need to rename

      ) |>

      ) |>

  } else {

      )

  }

}

#' Covert the dimension information from a FIMS json output into a tibble

#'

#' Dimensions in the json output are stored as a list of length two, with the

#' header information containing the name of the dimension and the dimensions

#' containing integers specifying the length for each dimension. The result

#' helps interpret how the FIMS output is structured given it is dimension

#' folded into a single vector in the json output.

#'

#' @details

#' The dimension index is returned not the actual year of the model. For

#' example, if the model starts in year 1900, then year_i of 1, which is what

#' is returned from this function will need to map to 1900 and that will need

#' to be done externally.

#' This function will accommodate dimensions of year-1 and year+1 where the

#' indexing of the former will start at 2 instead of 1.

#' @param data A list containing the header and dimensions information from a

#'   FIMS json output object.

#' @return

#' A tibble containing ordered rows for each combination of the dimensions.

#' @noRd

#' @examples

#' dummy_dimensions <- list(

#'   header = list("n_years", "n_ages"),

#'   dimensions = list(30L, 12L)

#' )

#' dimensions_to_tibble(dummy_dimensions)

#' # Example with n_years+1

#' dummy_dimensions <- list(

#'   header = list("n_years+1", "n_ages"),

#'   dimensions = list(31L, 12L)

#' )

#' dimensions_to_tibble(dummy_dimensions)

dimensions_to_tibble <- function(data) {

  #' Replace headers like "n_years" with "year_i".

  #' Example: "n_ages+1" with "age_i"

  #' This matches names starting with 'n' (with or without an underscore)

  #' and shortens them to a simple indexed form.

    # When the header is NULL

  }

    # When the dimensions are na because there is no associated indexing

  }

  # Accommodate any -1 by creating a different start value

  # Create the returned tibble by first sequencing from 1:n for each dimension

}

#' Convert the density component information into a tibble

#'

#' @description

#' The log probability density function (lpdf) information is information in

#' the json that pertains to a distribution, which is often associated with a

#' data stream. For example, the lognormal distribution can be associated with

#' landings for a given fleet because those landings might be uncertain.

#'

#' @details

#' The raw information, i.e., `data` is a list of unknown dimensions, where the

#' first element of the list, i.e., `lpdf_value`, is a single numeric value and

#' the remaining list elements are lists themselves. This function converts the

#' list to a tibble and then extracts only columns that have some derivative of

#' "value" in their name, e.g., `lpdf_value`, `expected_values`, etc., using

#' regular expression matching. Thus, when `data` does not have an entry for

#' `log_sd_values` the function does not fail but will return a smaller tibble

#' than normal.

#'

#' It is imperative that each list element of `data` be of length one or the

#' exact same length as the other elements. There is an internal check in the

#' function for this consistency.

#'

#' The code that writes this json information is stored in `inst/include/interface/rcpp/rcpp_objects/rcpp_distribution.hpp`.

#' @param data A list of `density_components` from the json output that is a

#'   list of lists. The first element of the list will be `lpdf_value`, a

#'   single entry that stores the log probability density function value. The

#'   remaining list elements have "value" in their name and are formatted as

#'   lists themselves.

#' @return

#' A tibble is returned with the `lpdf_value` first and then other columns with

#' value in their name following. The columns will be in the same order they

#' are reported in the json output.

#' @noRd

#'

#' @examples

#' dummy_density <- list(

#'   name = "lpdf_vec",

#'   lpdf_value = -102.079,

#'   values = list(

#'     -1.39915, -2.44735, -2.93024, -3.21848, -2.95698, -3.51745

#'   ),

#'   expected_values = list(

#'     5.0854, 6.13354, 6.61636, 6.90467, 6.64311, 7.20302

#'   ),

#'   observed_values = list(

#'     161.646, 461.089, 747.29, 996.971, 767.548, 1343.86

#'   )

#' )

#' density_to_tibble(dummy_density)

#' @noRd

density_to_tibble <- function(data) {

  # Check that each list element is of length-one or the same length otherwise

  # the resulting tibble will not be the correct dimensions

  } else {

  }

    )

  }

  # Return the tibble

}

# To remove the WARNING

# no visible binding for global variable

utils::globalVariables(c(

  "distribution_link", "distribution_type",

  "fleet_name",

  "type", "name", "value", "unit", "uncertainty",

  "timing", "age", "length", "year",

  "temp_name",

  "valid_n"

))

#' Initialize a generic module

#'

#' @description

#' Initializes a generic module by setting up its fields based on the provided

#' `module_name`.

#' @param parameters A tibble. Contains parameters and modules required for

#'   initialization.

#' @param data An S4 object. FIMS input data.

#' @param module_name A character. Name of the module to initialize (e.g.,

#'   "Population" or "Fleet").

#' @param fleet_name A character. Name of the fleet to initialize. If not

#'   specified, the module will be initialized without fleet-specific data.

#' @return

#' The initialized module as an object.

#' @noRd

initialize_module <- function(parameters, data, module_name, fleet_name = NA_character_) {

    # Using !! to unquote the variables

  }

    # Combine module_type and module_name into a single string

        # Replace NAs with ""

      )

    ) |>

    ))

  }

    # Remove certain fields for the Fleet module

    ))

      # Assign each value to the corresponding position in the parameter vector

      )

      # Set the estimation information for the entire parameter vector

    } else {

        # Right now we can also remove n_lengths because the default is 0

      ))

    }

    ))

  }

  # Populate fields based on common and specific settings

  # TODO:

  # - Population interface

  #   - Update the Population interface to consistently use n_ages and n_years,

  #     as done in the S4 data1 object.

  #     Update as needed.

  #   - Add n_fleets to data1. Should n_fleets include both

  #     fishing and survey fleets? Currently, data1@fleets equals 1.

  # - Fleet

  #   - Reconsider exposing `log_expected_index` and

  #     `agecomp_proportion` to users. Their IDs are linked with

  #     index and agecomp distributions. No input values are required.

  )

  )

  )

          # Or we can use get_n_fleets(data),

        )

      )

      )

      })

    } else {

      )

    }

  }

}

# TODO: Determine the relationship between distributions and the

# recruitment module, and implement the appropriate logic to retrieve

# distribution information.

#' Initialize a distribution module

#'

#' @description

#' Initializes a distribution module by setting up its fields based on the

#' distribution name and type. Supports both "data" and "process" types.

#' @param module_input A list. Contains parameters for initializing the

#'   distribution.

#' @param distribution_name A character. Name of the distribution to initialize.

#' @param distribution_type A character. Type of distribution, either "data" or

#'   "process".

#' @param linked_ids A vector. Named vector of linked IDs required for the

#'   distribution, such as data_link and fleet_link for setting up index

#'   distribution.

#' @rdname initialize_module

#' @return

#' The initialized distribution module as an object.

#' @noRd

initialize_distribution <- function(

  module_input,

  distribution_name,

  distribution_type = c("data", "process"),

  linked_ids

) {

  # Input checks

  # Check if distribution_name is provided

  }

  # Validate module_input

  }

  # Validate distribution_type as "data" or "process"

  # Validate linked_ids as a named vector with required elements for "data" type

  ) {

    )

  }

  # Get distribution value and initialize the module

    )

  }

  )

    )

  }

    "data" = {

      # Data distribution initialization

      )

    },

    "process" = {

      # Process distribution initialization

    }

  )

  # Final message to confirm success

  ))

}

#' Initialize a recruitment module

#'

#' @description

#' Initializes a recruitment module by setting up fields. This function uses

#' the `initialize_module` function to handle specific requirements for

#' recruitment initialization.

#' @inheritParams initialize_module

#' @return

#' The initialized recruitment module as an object.

#' @noRd

initialize_recruitment <- function(parameters, data) {

  )

}

#' Initialize a growth module

#'

#' @description

#' Initializes a growth module by setting up fields. This function uses

#' the `initialize_module` function to handle specific requirements for

#' growth initialization.

#' @inheritParams initialize_module

#' @return

#' The initialized growth module as an object.

#' @noRd

initialize_growth <- function(parameters, data) {

  )

}

#' Initialize a maturity module

#'

#' @description

#' Initializes a maturity module by setting up fields. This function uses

#' the `initialize_module` function to handle specific requirements for

#' maturity initialization.

#' @inheritParams initialize_module

#' @return

#' The initialized maturity module as an object.

#' @noRd

initialize_maturity <- function(parameters, data) {

  )

}

#' Initialize a population module.

#'

#' @description

#' Initializes a population module by setting up fields. This function uses

#' the `initialize_module` function to handle specific requirements for

#' population initialization.

#' @inheritParams initialize_module

#' @param linked_ids A vector. Named vector of linked IDs required for the

#'   population, including IDs for "growth", "maturity", and "recruitment".

#' @return

#' The initialized population module as an object.

#' @noRd

initialize_population <- function(parameters, data, linked_ids) {

    ))

  }

  )

  # Link up the recruitment, growth, and maturity modules with

  # this population module

  # Link fleets to module

  }

}

#' Initialize a selectivity module.

#'

#' @description

#' Initializes a selectivity module by setting up fields. This function uses

#' the `initialize_module` function to handle specific requirements for

#' population initialization.

#'

#' For logistic selectivity, the curve can be either ascending or descending

#' based on the sign of the slope parameter. A positive slope creates an

#' ascending logistic curve where selectivity increases from 0 to 1 with

#' increasing values of the independent variable (e.g., age or size). A

#' negative slope creates a descending logistic curve where selectivity

#' decreases from 1 to 0.

#'

#' @inheritParams initialize_module

#' @param fleet_name A character. Name of the fleet to initialize.

#' @return

#' The initialized selectivity module as an object.

#' @noRd

initialize_selectivity <- function(parameters, data, fleet_name) {

  )

}

# TODO: Do we want to put initialize_selectivity(), initialize_index(), and

# initial_age_comp() inside of initialize_fleet()?

#' Initialize a fleet module

#'

#' @description

#' Initializes a fleet module by setting up its fields. It links selectivity,

#' index, and age-composition modules.

#' @inheritParams initialize_module

#' @param fleet_name A character. Name of the fleet to initialize.

#' @param linked_ids A vector. Named vector of linked IDs required for the

#'  fleet, including IDs for "selectivity", "landings", "index", "age_comp", and "length_comp".

#' @return

#' The initialized fleet module as an object.

#' @noRd

initialize_fleet <- function(parameters, data, fleet_name, linked_ids) {

  )

  # Link the observed landings data to the fleet module using its associated ID

  # if the data type includes "landings" and if "Landings" exists in the data distribution

  # specification

  }

  # Link the observed index data to the fleet module using its associated ID

  # if the data type includes "index" and if "Index" exists in the data distribution

  # specification

  }

  # Link the observed age composition data to the fleet module using its associated ID

  # if the data type includes "age_comp" and if "AgeComp" exists in the data distribution

  # specification

  }

  # Link the observed length composition data to the fleet module using its associated ID

  # if the data type includes "length_comp" and if "LengthComp" exists in the data

  # distribution specification

  }

}

#' Initialize a landings module

#'

#' @description

#' Initializes a landings module based on the provided data and fleet name.

#' @inheritParams initialize_module

#' @param fleet_name A character. Name of the fleet for which the landings module

#'   is initialized.

#' @return

#' The initialized landings module as an object.

#' @noRd

initialize_landings <- function(data, fleet_name) {

  # Check if the specified fleet exists in the data

  }

  ) |>

    )

  } else {

  }

}

#' Initialize an index module

#'

#' @description

#' Initializes an index module based on the provided data and fleet name.

#' @inheritParams initialize_module

#' @param fleet_name A character. Name of the fleet for which the index module

#'   is initialized.

#' @return

#' The initialized index module as an object.

#' @noRd

initialize_index <- function(data, fleet_name) {

  # Check if the specified fleet exists in the data

  }

  ) |>

    )

  } else {

  }

}

#' Initialize a composition module

#'

#' Several types of composition modules exist and this function acts as a

#' generic interface to initialize any type, for example assigning

#' age-composition data to a given fleet would be an example of initializing

#' a composition module.

#'

#' @inheritParams initialize_module

#' @param fleet_name A character specifying the name of the fleet for which

#'   composition data is initialized.

#' @param type A character specifying the composition type, where the default

#'   is `"AgeComp"`. At the moment, one can initialize `"AgeComp"` or

#'   `"LengthComp"` modules.

#' @return

#' The initialized composition module as an object.

#' @noRd

initialize_comp <- function(data,

                            fleet_name,

                            type = c("AgeComp", "LengthComp")) {

  # Edit this list if a new type is added

  # Set up the specifics for the given type.

    ),

    )

  )

  # Ensures the user input matches the options provided,

  #   if not, then match.arg() throws an error

  # Select the row in comp_types that matches the user's type selection

  # Check if the specified fleet exists in the data

  }

  )

  # Validate that the fleet's composition data is available

    ))

  }

      ) |>

      ) |>

      ) |>

    ))

  }

  )

}

#' Initialize C++ modules via Rcpp for a FIMS model

#'

#' @description

#' This function uses information from a parameter data frame that stores the

#' model specifications and a`FIMSFrame` object that stores the data to

#' instantiate, i.e., create an instance of a class, the required C++ modules.

#' Several C++ modules are needed to run a FIMS model and the required modules

#' will be different for each model type. For example, for a catch-at-age

#' model one needs to instantiate recruitment, growth, and maturity modules and

#' at least one fleet and population module.

#'

#' @param parameters A tibble returned from [create_default_parameters()]. The

#'   tibble can be nested, i.e., contain a data column, or unnested, i.e.,

#'   `tidyr::unnest(create_default_parameters(), cols = "data")`. Regardless, it

#'   is the primary source of information for what is initialized. That is, if a

#'   fleet exists in the data but parameter information for how to specify

#'   selectivity for that fleet is not provided, then selectivity will not be

#'   initialized for that fleet.

#' @param data An S4 object with the `FIMSFrame` class, which is returned from

#'   [FIMSFrame()]. Passing the data is required because initialization of the

#'   modules requires passing the data and information regarding the uncertainty

#'   of that data, i.e., input sample sizes for the multinomial distribution.

#' @return

#' A list is returned with two elements, `parameters` and `model`. The list can

#' be passed to the `input` argument of [fit_fims()] to fit the model. The first

#' element of the list can also be passed to the `parameters` argument of

#' [TMB::MakeADFun()] if you wish to have more control over the model-fitting

#' process.

#' The model element of the returned list stores the instantiated C++ model

#' module, e.g., the results of `methods::new(CatchAtAge)` for a catch-at-age

#' model.

#' It is important that you only have one FIMS model initialized in your R

#' workspace at a time. Thus, after you initialize and fit the model, you should

#' run [clear()].

#' @export

#' @seealso

#' * [create_default_configurations()]

#' * [create_default_parameters()]

#' * [FIMSFrame()]

#' * [fit_fims()]

#' * [clear()]

#' @examples

#' \dontrun{

#' # Prepare data for FIMS model

#' data("data1", package = "FIMS")

#' data_4_model <- FIMSFrame(data1)

#' # Instantiate modules

#' parameters_list <- data_4_model |>

#'   create_default_configurations() |>

#'   create_default_parameters(data = data_4_model) |>

#'   initialize_fims(data = data_4_model)

#' clear()

#' }

initialize_fims <- function(parameters, data) {

  # Validate parameters input

  }

  # Check if parameters is a nested tibble. If so, unnest parameters

  }

  # Check if estimation_type is within "constant", "fixed_effect", "random_effect"

  # Validates supported estimation types to avoid errors later when

  #

    ))

  }

  # Clear any previous FIMS settings

    ))

  }

  # Initialize lists to store fleet-related objects

    )

    )

    # Initialize landings module if the data type includes "landings" and

    # if "Landings" exists in the data distribution specification

      # Initialize landings module for the current fleet

      )

      # Add the module ID for the initialized landings to the list of fleet module IDs

      )

    }

    # Initialize index module if the data type includes "index" and

    # if "Index" exists in the data distribution specification

      # Initialize index module for the current fleet

      )

      # Add the module ID for the initialized index to the list of fleet module IDs

      )

    }

    # Initialize age composition module if the data type includes "age_comp" and

    # if "AgeComp" exists in the data distribution specification

      # Initialize age composition module for the current fleet

      )

      # Add the module ID for the initialized age composition to the list of fleet module IDs

      )

    }

    # Initialize length composition module if the data type includes "length_comp" and

    # if "LengthComp" exists in the data distribution specification

      # Initialize length composition module for the current fleet

      )

      # Add the module ID for the initialized length composition to the list of fleet module IDs

      )

    }

      # TODO: need to remove linked_ids from the function and add module_id to the

      # parameters tibble

    )

      )

      ))

    }

        # TODO: need to update family and match options from the distribution

        # column from the parameters tibble

      )

    }

        # TODO: need to update family and match options from the distribution

        # column from the parameters tibble

      )

    }

        # TODO: need to update family and match options from the distribution

        # column from the parameters tibble

      )

    }

        # TODO: need to update family and match options from the distribution

        # column from the parameters tibble

      )

    }

  }

  # Recruitment

  # create new module in the recruitment class (specifically Beverton--Holt,

  # when there are other options, this would be where the option would be

  # chosen)

  )

    # TODO: need to revisit initialize_process_structure and add R tests

    )

  } else {

    # Initialize_process_distribution for each par

        # TODO: need to update family and match options from the distribution

        # column from the parameters tibble

        # TODO: need to remove is_random_effect and match options from the

        # estimation_type from the parameters tibble

      )

      )

    })

  }

  # Growth

  )

  # Maturity

  )

  )

  # Population

    # TODO: need to remove linked_ids from the function and add module_id to the

    # parameters tibble

  )

  # Set-up TMB

  # Hard code to be a catch-at-age model

  # Create parameter list from Rcpp modules

    ),

  )

}

#' Set parameter vector values based on module input

#'

#' @description

#' This function sets the parameter vector values in a module based on the

#' provided module input, including both initial values and estimation

#' information.

#' @param field A character string specifying the field name of the parameter

#'   vector to be updated.

#' @param module A module object in which the parameter vector is to be set.

#' @param module_input A list containing input parameters for the module,

#'   including value and estimation information for the parameter vector.

#' @return

#' Modified module object.

#' @noRd

set_param_vector <- function(field, module, module_input) {

  # Check if field_name is a non-empty character string

    ))

  }

  # Check if module is a reference class

    ))

  }

  # Check if module_input is a list

  }

  # Extract the value of the parameter vector