modules/animal_stockFRANCESCA/Livestock_imputation_new_version.R

##' # Imputation and Synchronisation of Livestock Commodities
##'
##' **Author: Francesca Rosa**
##'
##' **Description:**
##'
##' The animals slaughtered for production of meat, offals, fats and hides must
##' be available before running the production imputation code. These numbers,
##' however, are not guaranteed to be available, and in the case of missing
##' data, an imputation method must be applied.
##'
##' The decision was to use the production figures of meat, if available, to
##' compute the missing animals slaughtered. If these figures are also missing,
##' they should be imputed using the production imputation methodology. Of
##' course, in the case of currently available data in the animal element, that
##' data should be transferred to the quantity of animals slaughtered for meat
##' and then the imputation ran. We also decided to save the imputations for
##' meat so as to retain consistency with the animal figures.
##'
##' Although the procedure is called transfer, however, the value is actually
##' calculated. To transfer value from animal (parent) to meat (child), we copy
##' the value, then multiplied by a `share`. The meaning of the variable is the
##' share of the slaughtered animal that is used as input for the children. In
##' most cases they are 100%, however, take cattle in India for example, they
##' can be less then 100 as not all cattle slaughtered are used to produce meat
##' due to the holy nature of the animal.
##'
##' **Inputs:**
##'
##' * Production domain
##' * Complete Key Table
##' * Livestock Element Mapping Table
##' * Identity Formula table
##' * Share table
##' * Elements code table
##' * Range Carcass Weight table
##'
##' **Steps:**
##'
##' 1. Impute Livestock Numbers
##'
##' 2. Impute Number of Slaughtered animal (assiciated to the animal item)
##'
##' 3. Transfer the animal slaughtered from animal commodity (parent) to the
##'    meat commodity (child)
##'
##' 4. Impute the meat triplet (production/animal slaughtered/carcass weight)
##'    based on the same logic as all other production imputation procedure.
##'
##' 5. Transfer the slaughtered animal from the meat back to the animal, as now
##'    certain slaughtered animal is imputed in step 3.
##'
##' 6. Transfer the slaughtered animal from the animal to all other child
##'    commodities. This includes items such as offals, fats and hides and
##'    impute missing values for non-meat commodities.
##'
##' **Flag assignment:**
##'
##' | Procedure | Observation Status Flag | Method Flag|
##' | --- | --- | --- |
##' | Tranasfer between animal and meat commodity | `<Same as origin>` | c |
##' | Balance by Production Identity | `<flag aggregation>` | i |
##' | Imputation | I | e |
##'
##' **NOTE (Michael): Currently the transfer has flag 'c' indicating it is
##' copied, however, they should be replaced with a new flag as it is calculated
##' by not by identity.**
##'
##' **Data scope**
##'
##' * GeographicAreaM49: All countries specified in the `Complete Key Table`.
##'
##' * measuredItemCPC: Depends on the session selection. If the selection is
##'   "session", then only items selected in the session will be imputed. If the
##'   selection is "all", then all the items listed in the `Livestock Element
##'   Mapping Table` will be imputed.
##'
##' * measuredElement: Depends on the measuredItemCPC, all cooresponding
##'   elements in the `Identity Formula Table` and also all elements listed in
##'   the `Livestock Element Mapping Table`.
##'
##' * timePointYears: All years specified in the `Complete Key Table`.
##'
##'
##' **Flow chart:**
##' ![livestock Flow](livestock_flow.jpg?raw=true "livestock Flow")
##' ---

##' ## Initialisation
##'

message("Step 0: Setup")

##' Load the libraries
suppressMessages({
    library(data.table)
    library(faosws)
    library(faoswsFlag)
    library(faoswsUtil)
    library(faoswsImputation)
    library(faoswsProduction)
    library(faoswsProcessing)
    library(faoswsEnsure)
    library(magrittr)
    library(dplyr)
    library(sendmailR)
})

# TODO: Should be moved to R/
rollavg <- function(x, order = 3) {
  # order should be > 2
  stopifnot(order >= 3)
  
  non_missing <- sum(!is.na(x))
  
  # For cases that have just two non-missing observations
  order <- ifelse(order > 2 & non_missing == 2, 2, order)
  
  if (non_missing == 1) {
    x[is.na(x)] <- na.omit(x)[1]
  } else if (non_missing >= order) {
    n <- 1
    while(any(is.na(x)) & n <= 10) { # 10 is max tries
      movav <- suppressWarnings(RcppRoll::roll_mean(x, order, fill = 'extend', align = 'right'))
      movav <- data.table::shift(movav)
      x[is.na(x)] <- movav[is.na(x)]
      n <- n + 1
    }
    
    x <- zoo::na.fill(x, 'extend')
  }
  
  return(x)
}

##' Get the shared path
R_SWS_SHARE_PATH <- Sys.getenv("R_SWS_SHARE_PATH")

if (CheckDebug()) {

    library(faoswsModules)

    SETTINGS <- ReadSettings("modules/animal_stockFRANCESCA/sws.yml")

    ## If you're not on the system, your settings will overwrite any others
    R_SWS_SHARE_PATH <- SETTINGS[["share"]]

    ## Define where your certificates are stored
    SetClientFiles(SETTINGS[["certdir"]])

    ## Get session information from SWS. Token must be obtained from web interface
    GetTestEnvironment(SETTINGS[["server"]], SETTINGS[["token"]])
}

dir_to_save <- file.path(R_SWS_SHARE_PATH, "Livestock", paste0("validation", gsub("/", "_",swsContext.username)))

if (!file.exists(dir_to_save)) {
    dir.create(dir_to_save, recursive = TRUE)
}

##' Load and check the computation parameters
imputationSelection <- swsContext.computationParams$imputation_selection
if (!imputationSelection %in% c("session", "all")) {
  stop("Incorrect imputation selection specified")
}

imputationTimeWindow <- swsContext.computationParams$imputation_timeWindow
if (!imputationTimeWindow %in% c("all", "lastThree", "lastFive")) {
  stop("Incorrect imputation selection specified")
}

##' Get data configuration and session
sessionKey <- swsContext.datasets[[1]]
datasetConfig <- GetDatasetConfig(domainCode = sessionKey@domain,
                                 datasetCode = sessionKey@dataset)

##' Build processing parameters
processingParameters <-
  productionProcessingParameters(datasetConfig = datasetConfig)

lastYear <- max(as.numeric(swsContext.computationParams$last_year))

##' Obtain the complete imputation key
completeImputationKey <- getCompleteImputationKey("production")

completeImputationKey@dimensions$timePointYears@keys <-
  as.character(min(completeImputationKey@dimensions$timePointYears@keys):lastYear)

FIX_OUTLIERS <- as.logical(swsContext.computationParams$fix_outliers)
THRESHOLD <- as.numeric(swsContext.computationParams$outliers_threshold)
AVG_YEARS <- 2009:2013

##' Extract the animal parent to child commodity mapping table
##'
##' This table contains the parent item/element code which maps to the child
##' item/element code. For example, the slaughtered animal element for cattle is
##' 5315, while the slaughtered animal for cattle meat is 5320.
##'
##  Ideally, the two elements should be merged and have a single
##  code in the classification. This will eliminate the change of
##  code in the transfer procedure.

animalMeatMappingTable <- ReadDatatable("animal_parent_child_mapping")

## When pulled from the SWS the datatable header cannot contain capital letters
animalMeatMappingTable <-
  animalMeatMappingTable[,
    .(
      measuredItemParentCPC = measured_item_parent_cpc,
      measuredElementParent = measured_element_parent,
      measuredItemChildCPC  = measured_item_child_cpc,
      measuredElementChild  = measured_element_child
    )
  ]

##' Here we expand the session to include all the parent and child items. That
##' is, we expand to the particular livestock tree.
##'
##' For example, if 02111 (Cattle) is in the session, then the session will be
##' expanded to also include 21111.01 (meat of cattle, freshor chilled), 21151
##' (edible offal of cattle, fresh, chilled or frozen), 21512 (cattle fat,
##' unrendered), and 02951.01 (raw hides and skins of cattle).
##'
##' The elements are also expanded to the required triplet.

livestockImputationItems <-
  expandMeatSessionSelection(
    oldKey = completeImputationKey,
    selectedMeatTable = animalMeatMappingTable
  ) %>%
  getQueryKey("measuredItemCPC", datasetkey = .) %>%
  selectMeatCodes(itemCodes = .)

sessionItems <-
  expandMeatSessionSelection(
    oldKey = sessionKey,
    selectedMeatTable = animalMeatMappingTable
  ) %>%
  getQueryKey("measuredItemCPC", datasetkey = .) %>%
  selectMeatCodes(itemCodes = .)

##' Select the range of items based on the computational parameter.
selectedMeatCode <-
  switch(
    imputationSelection,
    session = sessionItems,
    all     = livestockImputationItems
  )

# lastYear=max(as.numeric(completeImputationKey@dimensions$timePointYears@keys))

##' ---
##' ## Perform Synchronisation and Imputation

##' Here we iterate through the the meat item to perform the steps described in
##' the description. Essentially, we are looping over different livestock trees.
if (CheckDebug()) {
  logConsole1 <- file("log.txt",open = "w")
  sink(file = logConsole1, append = TRUE, type = "message")
}

# NOTE: this used to come from the faoswsFlag package.
# XXX: There are some discrepancies in the two tables (pkg and SWS)
flagValidTable <- ReadDatatable("valid_flags")
stopifnot(nrow(flagValidTable) > 0)

imputationResult <- data.table()

for (iter in seq(selectedMeatCode)) {

    imputationProcess <- try({

        message("Processing livestock tree (", iter, " out of ",
                length(selectedMeatCode), ")")

        set.seed(070416)

        ## Extact the current ANIMAL,MEAT and NON-MEATcodes with their relative formula and mapping table

        ##meat
        currentMeatItem <- selectedMeatCode[iter]

        currentMappingTable <-
          animalMeatMappingTable[measuredItemChildCPC == currentMeatItem, ]

        ##animal
        currentAnimalItem <- currentMappingTable[, measuredItemParentCPC]

        ##all derived
        currentAllDerivedProduct <-
          animalMeatMappingTable[measuredItemParentCPC == currentAnimalItem, measuredItemChildCPC]

        ##derived non meat
        currentNonMeatItem <-
          currentAllDerivedProduct[currentAllDerivedProduct != currentMeatItem]

        itemMap <- GetCodeList(domain = "agriculture", dataset = "aproduction", "measuredItemCPC")
        stopifnot(nrow(itemMap) > 0)

        # Remove offals, hides and skins as there is a dedicated plugin
        currentNonMeatItem <-
          setdiff(
            currentNonMeatItem,
            itemMap[
              type %in% c("HIDE", "PSKN", "OFF", "POFF") |
                (type == "DERA" & grepl("\\b(offal|skin|hide|fat)", description)),
              code
            ]
          )

        message("Extracting the shares tree")

        shareData <-
          getShareData(
            geographicAreaM49     = getQueryKey("geographicAreaM49", completeImputationKey),
            measuredItemChildCPC  = currentAllDerivedProduct,
            measuredItemParentCPC = currentAnimalItem,
            timePointYearsSP      = getQueryKey("timePointYears", completeImputationKey)
          ) %>%
          setnames(x = .,
                   old = c("Value", "timePointYearsSP"),
                   new = c("share", "timePointYears")) %>%
          mutate(timePointYears = as.numeric(timePointYears))

        shareData <- as.data.table(shareData)

        ## note: all the shares are equalt to 1

        ## ---------------------------------------------------------------------
        message("Extracting animal data ", currentAnimalItem, " (Animal)")

        ## Get the animal formula
        animalFormulaTable <-
          getProductionFormula(itemCode = currentAnimalItem) %>%
          removeIndigenousBiologicalMeat(formula = .)

        if (nrow(animalFormulaTable) > 1) {
          stop("Imputation should only use one formula")
        }

        ## Create the formula parameter list
        animalFormulaParameters <-
            with(animalFormulaTable,
                 productionFormulaParameters(datasetConfig = datasetConfig,
                                             productionCode = output,
                                             areaHarvestedCode = input,
                                             yieldCode = productivity,
                                             unitConversion = unitConversion))


        ## Get the animal key, we take the complete key and then modify the element
        ## and item dimension to extract the current meat item and it's
        ## corresponding elements.
        ## Francesca: it is not necessary to extract the triplet, but just Livestock and
        ## Slaughtered, the element that should play the role of the YIEL is, in this case
        ## the off-take  rate that is endogenously computed (eventually using trade) and then imputed.

        animalKey <- completeImputationKey

        animalKey@dimensions$measuredItemCPC@keys <- currentAnimalItem

        animalKey@dimensions$measuredElement@keys <-
          animalFormulaParameters$productionCode

        ## Get the animal data (NB: preProcessing: manage NA M and transform timePointYears)
        animalData <-
            animalKey %>%
            GetData(key = .) %>%
            preProcessing(data = .)

        ## This condition allow to use also the NON-protected data to build the imputations
        ## for last three years in case you have chosed to produce imputations only for last
        ## three years

        if (imputationTimeWindow == "all") {
          animalData <- removeNonProtectedFlag(animalData)
        } else if (imputationTimeWindow == "lastThree") {
          animalData <- removeNonProtectedFlag(animalData, keepDataUntil = (lastYear - 2))
        } else if (imputationTimeWindow == "lastFive") {
          animalData <- removeNonProtectedFlag(animalData, keepDataUntil = (lastYear - 4))
        }

        animalData <-
          expandYear(
            data       = animalData,
            areaVar    = processingParameters$areaVar,
            elementVar = processingParameters$elementVar,
            itemVar    = processingParameters$itemVar,
            valueVar   = processingParameters$valueVar,
            newYears   = lastYear
          )

        ## ---------------------------------------------------------------------
        ##  The idea is to include the TRADE domain into the livestock imputation process. The basic hypothesis
        ##  is that Countries import livestock just for slaughtering purposes.
        ##  We made several test including and excluding trade data which in many cases was the source of outliers
        ##  apparently non feasible fluctuations into the meat production.

        ##  Get new trade data

        itemMap <- itemMap[, .(measuredItemCPC = code,type)]

        data <- merge(animalData, itemMap, by = "measuredItemCPC")

        ## This two lines contains info on the trade elements to be pulled in case it will be decided in the future to
        ## use trade to compute the number of animal Slaughtered
        #itemCodeKey = ReadDatatable("element_codes")
        #tradeElements = itemCodeKey[itemtype== unique(data[,type]),c(imports, exports)]
        #factor= itemCodeKey[itemtype== unique(data[,type]),c(factor)] # this is a conversion factor to be used in computing one element of the triplet from the others as identity

        ## I prefer to get the conversion factor from the data table: item_type_yield_elements which is the same where also the
        ## fuction getProductionFormula takes it.

        getFactor <- ReadDatatable(table = "item_type_yield_elements")

        factor <- getFactor[item_type == unique(data[,type]), c(factor)]

        ##  Pull trade data for the current Animal Item
        ##  In case you decide to use the trade: build the key using the most updated dataset!!!!

        ##   tradeData <- GetData(key = key)
        ##
        ##   setnames(tradeData, c("measuredElementTrade", "measuredItemCPC"),
        ##            c("measuredElement", "measuredItemCPC"))
        ##
        ##   tradeData=preProcessing(tradeData)
        ##
        ##   stockTrade=rbind(tradeData, animalData)
        ## At the moment it has been decided to NOT use trade data
        ##    stockTrade=animalData
        ##    stockTrade=denormalise(stockTrade, denormaliseKey = "measuredElement", fillEmptyRecords=TRUE )

        animalData <- denormalise(animalData, denormaliseKey = "measuredElement", fillEmptyRecords = TRUE )

        ## ---------------------------------------------------------------------
        ## Imputation of animal Stock
        ## To impute livestock numbers we follow excatly the same approach (the ensemble approach)
        ## already developped. Here we are building the parameters
        animalStockImputationParameters <- defaultImputationParameters()

        ## I am modifing the animalStockImputationParameters in order to specify that the variable to be imputed
        ## is the livestock (5111 for big animals, 5112 for small animals)
        animalStockImputationParameters$imputationValueColumn <- animalFormulaParameters$productionValue
        animalStockImputationParameters$imputationFlagColumn <- animalFormulaParameters$productionObservationFlag
        animalStockImputationParameters$imputationMethodColumn <- animalFormulaParameters$productionMethodFlag
        animalStockImputationParameters$byKey <- c("geographicAreaM49", "measuredItemCPC")
        animalStockImputationParameters$estimateNoData <- TRUE

        ##This code is to see the charts of the emsemble approach
        ##animalStockImputationParameters$plotImputation="prompt"

        message("Step 1: Impute missing values for livestock: item ", currentAnimalItem,
                " (Animal)")

        stockImputed <- imputeVariable(animalData, imputationParameters = animalStockImputationParameters)

        if (FIX_OUTLIERS == TRUE) {

          orig_cols <- names(stockImputed)

          if (imputationTimeWindow == "all") {
            val_years <- completeImputationKey@dimensions$timePointYears@keys
          } else {
            val_years <-
              lastYear - 0:switch(imputationTimeWindow, "lastThree" = 2, "lastFive" = 4)
          }

          stockImputed <-
            flagValidTable[
              stockImputed,
              on = c("flagObservationStatus" = animalFormulaParameters$productionObservationFlag,
                     "flagMethod" = animalFormulaParameters$productionMethodFlag)
            ]

          setnames(
            stockImputed,
            c("flagObservationStatus", "flagMethod"),
            c(animalFormulaParameters$productionObservationFlag, animalFormulaParameters$productionMethodFlag)
          )

          stockImputed[,
            `:=`(
              mean_old =
                mean(
                  get(animalFormulaParameters$productionValue)[
                    get(animalStockImputationParameters$yearValue) %in% AVG_YEARS
                  ]
                ),
              mean_protected =
                mean(
                  get(animalFormulaParameters$productionValue)[
                    get(animalStockImputationParameters$yearValue) %in% (max(AVG_YEARS) + 1):max(val_years) &
                      sum(Protected[get(animalStockImputationParameters$yearValue) %in% (max(AVG_YEARS) + 1):max(val_years)]) >= 2 &
                      Protected == TRUE
                  ]
                )
            ),
            by = c(animalStockImputationParameters$byKey)
          ]

          stockImputed[is.nan(mean_old), mean_old := NA_real_]
          stockImputed[is.nan(mean_protected), mean_protected := NA_real_]

          # NOTE: some NA ratios are due to M- series
          stockImputed[,
            `:=`(
              ratio_old       = get(animalFormulaParameters$productionValue) / mean_old,
              ratio_protected = get(animalFormulaParameters$productionValue) / mean_protected
            )
          ]

          stockImputed[is.infinite(ratio_old), ratio_old := NA_real_]
          stockImputed[is.infinite(ratio_protected), ratio_protected := NA_real_]

          stockImputed[, ratio := ifelse(!is.na(ratio_protected), ratio_protected, ratio_old)]

          stockImputed[, outlier := FALSE]

          stockImputed[
            get(animalStockImputationParameters$yearValue) %in% val_years &
              Protected == FALSE,
            outlier := abs(ratio - 1) > THRESHOLD
          ]

          stockImputed[
            outlier == TRUE,
            (animalFormulaParameters$productionValue) := NA_real_
          ]

          stockImputed[,
            movav :=
              rollavg(
                get(animalFormulaParameters$productionValue),
                order = 3
              ),
              by = c(animalStockImputationParameters$byKey)
          ]

          stockImputed[
            outlier == TRUE & !is.na(movav),
            `:=`(
              c(animalFormulaParameters$productionValue,
              animalFormulaParameters$productionObservationFlag,
              animalFormulaParameters$productionMethodFlag),
              # Flags are Ee to differentiate them from Ie
              list(movav, "E", "e")
            )
          ]

          stockImputed <- stockImputed[, orig_cols, with = FALSE]
        }

        ##---------------------------------------------------------------------------------------------------------

        ##Pull slaughtered Animail (code referrig to ANIMAL)
        slaughterdKey <- animalKey

        slaughterdKey@dimensions$measuredElement@keys <-
          with(animalFormulaParameters,c(areaHarvestedCode))

        slaughteredAnimalData <-
            slaughterdKey %>%
            GetData(key = .) %>%
            preProcessing(data = .)

        if (imputationTimeWindow == "all") {
          slaughteredAnimalData <- removeNonProtectedFlag(slaughteredAnimalData)
        } else if (imputationTimeWindow == "lastThree") {
          slaughteredAnimalData <- removeNonProtectedFlag(slaughteredAnimalData, keepDataUntil = (lastYear - 2))
        } else if (imputationTimeWindow == "lastFive") {
          slaughteredAnimalData <- removeNonProtectedFlag(slaughteredAnimalData, keepDataUntil = (lastYear - 4))
        }

        slaughteredAnimalData <-
          removeNonProtectedFlag(slaughteredAnimalData) %>%
          expandYear(
            data = .,
            areaVar    = processingParameters$areaVar,
            elementVar = processingParameters$elementVar,
            itemVar    = processingParameters$itemVar,
            valueVar   = processingParameters$valueVar,
            newYears   = lastYear
          )

        slaughteredAnimalData <-
          denormalise(
            slaughteredAnimalData,
            denormaliseKey = "measuredElement",
            fillEmptyRecords = TRUE
          )

        ## Prepare the table to be used to compute TOT slaughtered Animal: this approach has been follow in order to
        ## use trade data. In theory for some countries it would have been necessary to compute the Total number of animal
        ## slaughterd including the trade flows. The alternative, would have been to use the usual triplet approach using
        ## functions as imputeProductionTriplet.

        ## For some countries we may have slaughtered AnimalData, but not stockImputed
        ## Be careful with this merge:

        stockSlaughtered <-
          merge(
            stockImputed,
            slaughteredAnimalData,
            by    = c("geographicAreaM49", "measuredItemCPC", "timePointYears"),
            all.x =  TRUE,
            all.y =  TRUE
          )

        ##---------------------------------------------------------------------------------------------------------

        message("Step 2: Impute Number of Slaughtered animal for ", currentAnimalItem, " (Animal)")

        ## The function computeTot
        # Imputations of offtake are here
        slaughteredParentData <-
          computeTotSlaughtered(
            data                  = stockSlaughtered,
            FormulaParameters     = animalFormulaParameters,
            FIX_OUTLIERS          = FIX_OUTLIERS,
            THRESHOLD             = THRESHOLD,
            AVG_YEARS             = AVG_YEARS,
            imputationTimeWindow  = imputationTimeWindow,
            completeImputationKey = completeImputationKey
          )

        # Before Saving this data in the shared folder I change the off-take method flag which is: "i". It is now "c"
        # because it was useful to protect it.
        slaughteredParentData[TakeOffRateFlagMethod == "c", TakeOffRateFlagMethod := "i"]

        if (!CheckDebug()) {
            write.csv(
              slaughteredParentData,
              file.path(dir_to_save, paste0("LivestockTriplet_", currentAnimalItem, ".csv")),
              row.names = FALSE
            )
        }

        slaughteredParentData <-
          slaughteredParentData[,
            c("geographicAreaM49", "measuredItemCPC", "timePointYears",
              animalFormulaParameters$areaHarvestedValue,
              animalFormulaParameters$areaHarvestedObservationFlag,
              animalFormulaParameters$areaHarvestedMethodFlag),
            with = FALSE
          ]

        slaughteredParentData <-
          normalise(
            slaughteredParentData,
            removeNonExistingRecords = FALSE
          )

        ##---------------------------------------------------------------------------------------------------------
        ## --------------------------------------------------------------------------------------------------------
        ## Check if all the slaughtered series have been imputed. If the animal stocks series is not present
        ## there would not be the series of animal slaughtered.

        ## This is the dataset containig the slaughted
        slaughteredAnimalData <- normalise(slaughteredAnimalData)

        sel_cols <- c("geographicAreaM49", "measuredItemCPC", "timePointYears", "measuredElement")

        imputed <- slaughteredParentData[, sel_cols, with = FALSE]

        orginalSlaughterd <- slaughteredAnimalData[, sel_cols, with = FALSE]

        diff <- setdiff(orginalSlaughterd,imputed)

        if (nrow(diff) > 0) {
            seriesToAdd <- slaughteredAnimalData[diff,,on = sel_cols]
            slaughteredParentData <- rbind(slaughteredParentData, seriesToAdd)
        }

        ##---------------------------------------------------------------------------------------------------------
        ## --------------------------------------------------------------------------------------------------------
        message("Extracting production triplet for item ", currentMeatItem,
                " (Meat)")

        ## Get the meat formula
        meatFormulaTable <-
            getProductionFormula(itemCode = currentMeatItem) %>%
            removeIndigenousBiologicalMeat(formula = .)

        ##Associated to each commodity we MUST have just ONE formula
        if (nrow(meatFormulaTable) > 1) {
          stop("Imputation should only use one formula")
        }

        ## Create the formula parameter list
        meatFormulaParameters <-
            with(meatFormulaTable,
                 productionFormulaParameters(datasetConfig = datasetConfig,
                                             productionCode = output,
                                             areaHarvestedCode = input,
                                             yieldCode = productivity,
                                             unitConversion = unitConversion)
            )

        ## Get the meat key, we take the complete key and then modify the element
        ## and item dimension to extract the current meat item and it's
        ## corresponding elements.
        ##
        ## We extract the triplet so that we can perform the check
        ## on whether the triplet are balanced already. Eventhough
        ## only the animal slaughtered element is transferred.
        meatKey <- completeImputationKey

        meatKey@dimensions$measuredItemCPC@keys <- currentMeatItem

        meatKey@dimensions$measuredElement@keys <-
            unique( with(meatFormulaParameters,
                         c(productionCode, areaHarvestedCode, yieldCode,
                           currentMappingTable$measuredElementChild)))

        ## Get the meat data
        meatData <- GetData(key = meatKey)
        meatData <- preProcessing(data = meatData)
        meatData <- removeInvalidFlag(meatData)

        if (imputationTimeWindow == "all") {
          meatData <- removeNonProtectedFlag(meatData)
        } else if (imputationTimeWindow == "lastThree") {
          meatData <- removeNonProtectedFlag(meatData, keepDataUntil = (lastYear - 2))
        } else if (imputationTimeWindow == "lastFive") {
          meatData <- removeNonProtectedFlag(meatData, keepDataUntil = (lastYear - 4))
        }

        meatData <-
          denormalise(
            normalisedData = meatData,
            denormaliseKey = "measuredElement"
          )

        ## We have to remove (M,-) from the carcass weight: since carcass weight is usually computed ad identity,
        ## it results inusual that the last available value is protected and different from NA. We risk that, when we perform
        ## the function expandYear, we erroneously block the whole time series. I replace all the (M,-) carcass weight with
        ## (M,-). The triplet will be sychronized by the imputeProductionTriplet function.

        meatData[
          get(meatFormulaParameters$yieldObservationFlag) == processingParameters$missingValueObservationFlag,
          ":="(
            c(meatFormulaParameters$yieldMethodFlag),
            list(processingParameters$missingValueMethodFlag)
          )
        ]

        meatData <- createTriplet(data = meatData, formula = meatFormulaTable)

        ## The slaughtered must be all synchronized from the animal
        meatData[,
          ":="(
            c(meatFormulaParameters$areaHarvestedValue,
              meatFormulaParameters$areaHarvestedObservationFlag,
              meatFormulaParameters$areaHarvestedMethodFlag),
            list(NA_real_,"M", "u"))
        ]

        ensureProductionInputs(
          data                 = meatData,
          processingParameters = processingParameters,
          formulaParameters    = meatFormulaParameters,
          normalised           = FALSE,
          returnData           = FALSE
        )

        meatData <- normalise(meatData)

        meatData <-
          expandYear(
            data       = meatData,
            areaVar    = processingParameters$areaVar,
            elementVar = processingParameters$elementVar,
            itemVar    = processingParameters$itemVar,
            valueVar   = processingParameters$valueVar,
            newYears   = lastYear
          )

        ## ---------------------------------------------------------------------
        message("Step 3: Transferring animal slaughtered from animal to meat commodity")

        animalMeatMappingShare <-
            merge(currentMappingTable, shareData, all.x = TRUE,
                  by = c("measuredItemParentCPC", "measuredItemChildCPC"))

        ## Transfer the animal slaughtered number from animal to the meat.
        slaughteredTransferedToMeatData <-
          transferParentToChild(
            parentData = slaughteredParentData,
            childData = meatData,
            mappingTable = animalMeatMappingShare,
            transferMethodFlag = "c",
            imputationObservationFlag = "I",
            parentToChild = TRUE
          )

        ensureCorrectTransfer(
          parentData   = slaughteredParentData,
          childData    = slaughteredTransferedToMeatData,
          mappingTable = animalMeatMappingShare,
          returnData   = FALSE
        )

        ## ---------------------------------------------------------------------

        message("Step 4: Perform Imputation on the Meat Triplet")

        ## Start the imputation
        ## Build imputation parameter
        imputationParameters <-
            with(meatFormulaParameters,
                 getImputationParameters(productionCode    = productionCode,
                                         areaHarvestedCode = areaHarvestedCode,
                                         yieldCode         = yieldCode)
            )

        message("Performing Imputation")

        meatImputed <- slaughteredTransferedToMeatData

        meatImputed <-
          denormalise(
            normalisedData  = meatImputed,
            denormaliseKey  = "measuredElement",
            fillEmptyRecord = TRUE
          )

        #meatImputed =processProductionDomain(data = meatImputed,
        #                                     processingParameters = processingParameters,
        #                                     formulaParameters = meatFormulaParameters)

        ## Since we have syncronized and protected "slaugtered animal"
        ## and we have protected some of the carcass weight copied from the old
        ## system in order to stabilize the imputation of this variable, it is possible that
        ## we have some all protected triplets and we have to check:
        ## 1. the three elements are balanced
        ## 2. if only slaughtered and production are balanced, the resulting
        ##    carcass weight is within the ranges

        ## I add to the already existing formula parameters the flagComb columns because I have to work
        ## with PROTECTED flag combinations

        ## Enlarge the meatFormulaParameters just to include Flag checks:
        meatFormParams <-
          c(meatFormulaParameters,
            list(
              areaHarvestedFlagComb = paste0("flagComb_", meatFormulaParameters$areaHarvestedCode),
              productionFlagComb    = paste0("flagComb_", meatFormulaParameters$productionCode),
              yieldFlagComb         = paste0("flagComb_", meatFormulaParameters$yieldCode)
            )
          )

        ##Obtain a vector containing all the protected flag combinations
        ProtectedFlag <- getProtectedFlag()

        ##I have to exclude (M,-) from the protected flag combinations. Doing the checks for the carcass weight to
        ##free, otherwise I risk to open closed series:
        ProtectedFlag <- ProtectedFlag[ProtectedFlag != "(M, -)"]

        ##Add the flag combination column for each element of the triplet
        meatImputed[,
          meatFormParams$areaHarvestedFlagComb :=
            combineFlag(
              meatImputed,
              meatFormParams$areaHarvestedObservationFlag,
              meatFormParams$areaHarvestedMethodFlag
            )
        ]

        meatImputed[,
          meatFormParams$productionFlagComb :=
            combineFlag(
              meatImputed,
              meatFormParams$productionObservationFlag,
              meatFormParams$productionMethodFlag
            )
        ]

        meatImputed[,
          meatFormParams$yieldFlagComb :=
            combineFlag(
              meatImputed,
              meatFormParams$yieldObservationFlag,
              meatFormParams$yieldMethodFlag
            )
        ]

        meatImputed[,
          yield := (get(meatFormParams$productionValue) / get(meatFormParams$areaHarvestedValue)) * factor
        ]

        ##If two elements of the triplet are all protected (Meat and Slaughtered) I have to compute again the resulting Carcass Weight

        meatANDSlaughteredProtectedEl <-
          meatImputed[,
            get(meatFormParams$productionFlagComb) %in% ProtectedFlag &
              get(meatFormParams$areaHarvestedFlagComb) %in% ProtectedFlag
          ]

        ##Overwrite the carcass weight with the just computed, and consequently update the Flags
        meatImputed[
          meatANDSlaughteredProtectedEl ,
          ":="(
            c(meatFormParams$yieldValue,
              meatFormParams$yieldObservationFlag,
              meatFormParams$yieldMethodFlag),
            list(NA_real_, "M", "u"))
        ]

        ##I remove the flagComb columns that  have created just to make these checks
        meatImputed[, meatFormParams$areaHarvestedFlagComb := NULL]
        meatImputed[, meatFormParams$yieldFlagComb := NULL]
        meatImputed[, meatFormParams$productionFlagComb := NULL]
        meatImputed[, yield := NULL]

        ## ---------------------------------------------------------------------
        ## Check if all the Carcass Weight are within feasible ranges
        rangeCarcassWeight <- ReadDatatable("range_carcass_weight")

        currentRange <- rangeCarcassWeight[meat_item_cpc == currentMeatItem,]

        meatImputed[
          get(meatFormParams$yieldValue) > currentRange[, carcass_weight_max] |
            get(meatFormParams$yieldValue) < currentRange[, carcass_weight_min],
          ":="(
            c(meatFormParams$areaHarvestedValue,
              meatFormParams$areaHarvestedObservationFlag,
              meatFormParams$areaHarvestedMethodFlag),
            list(NA_real_,"M","u"))
        ]

        ## ---------------------------------------------------------------------
        ## Perform imputation using the standard imputation function

        meatImputed <-
          imputeProductionTriplet(
            data                 = meatImputed,
            processingParameters = processingParameters,
            imputationParameters = imputationParameters,
            formulaParameters    = meatFormulaParameters,
            completeImputationKey = completeImputationKey,
            imputationTimeWindow  = imputationTimeWindow,
            flagValidTable        = flagValidTable,
            FIX_OUTLIERS          = FIX_OUTLIERS,
            THRESHOLD             = THRESHOLD,
            AVG_YEARS             = AVG_YEARS
          )

        ensureProductionOutputs(
          data                 = meatImputed,
          processingParameters = processingParameters,
          formulaParameters    = meatFormulaParameters,
          returnData           = FALSE,
          normalised           = FALSE
        )

        if (!imputationTimeWindow %in% c("lastThree", "lastFive")) {

            noBalanced <-
              ensureProductionBalanced(
                meatImputed,
                meatFormParams$areaHarvestedValue,
                meatFormParams$yieldValue,
                meatFormParams$productionValue,
                factor,
                normalised = FALSE,
                getInvalidData = TRUE
              )

            if (nrow(noBalanced) > 0) {
              message("Warning: the triplet is not balanced after imputeProductionTriplet!")

                if (!CheckDebug()) {

                    createErrorAttachmentObject <- function(testName,
                                                           testResult,
                                                           R_SWS_SHARE_PATH){
                        errorAttachmentName = paste0(testName, ".csv")
                        errorAttachmentPath =
                            paste0(R_SWS_SHARE_PATH, "/rosa/", errorAttachmentName)
                        write.csv(testResult, file = errorAttachmentPath,
                                  row.names = FALSE)
                        errorAttachmentObject = mime_part(x = errorAttachmentPath,
                                                          name = errorAttachmentName)
                        errorAttachmentObject
                    }

                    bodyWithAttachmentNoBalanced <-
                        createErrorAttachmentObject(paste0("Not_balanced_Triplet_", currentMeatItem),
                                                    noBalanced,
                                                    R_SWS_SHARE_PATH)

                    sendmail(from = "sws@fao.org",
                             to = swsContext.userEmail,
                             subject = "Some triplet are not balanced",
                             msg = bodyWithAttachmentNoBalanced)

                }
            }
        }

        #' Check if the resulting Carcass weights are within a feasible range!
        #' We are currently use the table range stored in the SWS

        ##Select the row corresponding to the current meat item from the range-table

        message("Check the Carcass weights")

        ##currentRange=rangeCarcassWeight[meat_item_cpc==currentMeatItem,]
        ## I am checking only those series where the Value is different from NA:
        ## it means that is cannot overwrite (M,-) figures in the carcass weigth series.

        ## Identify the rows out of range
        outOfRange <-
          meatImputed[
            get(imputationParameters$yieldParams$imputationValueColumn) >  currentRange[,carcass_weight_max] |
              get(imputationParameters$yieldParams$imputationValueColumn) <  currentRange[,carcass_weight_min]
          ]

        if (nrow(outOfRange) > 0) {

            message("Number out rows out of range: ", nrow(outOfRange))

            ## Replace the values of carcass weight outside from the range with the extremes of the range

            ## Impose the outOfRange values below the minimum equal to the
            ## lower extreme of the range and  the outOfRange Values up the max equal to upper extreme of the range

            meatImputed[
              get(imputationParameters$yieldParams$imputationValueColumn) >  currentRange[,carcass_weight_max] &
                get(imputationParameters$yieldParams$imputationFlagColumn) != "M",
              ":="(
                c(imputationParameters$yieldParams$imputationValueColumn,
                  imputationParameters$yieldParams$imputationFlagColumn,
                  imputationParameters$yieldParams$imputationMethodColumn),
                list(
                  currentRange[,carcass_weight_max],
                  "I",
                  "e"
                )
              )
            ]

            meatImputed[
              get(imputationParameters$yieldParams$imputationValueColumn) <  currentRange[,carcass_weight_min] &
                get(imputationParameters$yieldParams$imputationFlagColumn) != "M",
              ":="(
                c(imputationParameters$yieldParams$imputationValueColumn,
                  imputationParameters$yieldParams$imputationFlagColumn,
                  imputationParameters$yieldParams$imputationMethodColumn),
                list(
                  currentRange[,carcass_weight_min],
                  "I",
                  "e"
                )
              )
            ]

            ## We should free the number of animal slaughtered and recalculate this variable as identity

            meatImputed[,
              newS :=
                factor * computeRatio(
                  get(imputationParameters$productionParams$imputationValueColumn),
                  get(imputationParameters$yieldParams$imputationValueColumn)
                )
            ]

            #OverWrite the Slaughtered animal element if PRODUCTION had NOT been computed as identity

            meatImputed[
              get(imputationParameters$productionParams$imputationMethodColumn) != "i" &
                (newS > (get(imputationParameters$areaHarvestedParams$imputationValueColumn) + 1e-6) |
                 newS < (get(imputationParameters$areaHarvestedParams$imputationValueColumn) -  1e-6)),
              ":="(
                c(imputationParameters$areaHarvestedParams$imputationValueColumn,
                  imputationParameters$areaHarvestedParams$imputationFlagColumn,
                  imputationParameters$areaHarvestedParams$imputationMethodColumn),
                list(
                  newS,
                  aggregateObservationFlag(
                    get(imputationParameters$yieldParams$imputationFlagColumn),
                    get(imputationParameters$productionParams$imputationFlagColumn)
                  ),
                  "i"
                )
              )
            ]

            meatImputed[,
              newP := (get(imputationParameters$yieldParams$imputationValueColumn) * get(imputationParameters$areaHarvestedParams$imputationValueColumn)) / factor
            ]

            #OverWrite the Production animal element if SLAUGHTERED had NOT been computed as identity
            meatImputed[
              (newP > (get(imputationParameters$productionParams$imputationValueColumn) + 1e-6) |
               newP < (get(imputationParameters$productionParams$imputationValueColumn) -  1e-6) ) &
                get(imputationParameters$areaHarvestedParams$imputationMethodColumn) != "i",
              ":="(
                c(imputationParameters$productionParams$imputationValueColumn,
                  imputationParameters$productionParams$imputationFlagColumn,
                  imputationParameters$productionParams$imputationMethodColumn),
                list(
                  newP,
                  aggregateObservationFlag(
                    get(imputationParameters$yieldParams$imputationFlagColumn),
                    get(imputationParameters$productionParams$imputationFlagColumn)
                  ),
                  "i"
                )
              )
            ]

            meatImputed[, c("newS", "newP") := NULL]

            ## table(meatImputed[,.(flagMethod_measuredElement_5320,flagMethod_measuredElement_5417,flagMethod_measuredElement_5510)])
        }

        meatImputed <- normalise(meatImputed)

        ## ---------------------------------------------------------------------
        message("Step 3: Transfer animal slaughtered back from meat to animal commodity")

        ## Transfer the animal slaughtered from meat back to animal, this can be
        ## done by specifying parentToChild equal to FALSE.
        ##
        ## NOTE (Michael): We only subset the new calculated or imputed values to be
        ##                 transfer back to the animal (parent) commodity. See issue
        ##                 #180.
        ##
        ## NOTE (Michael): Since the animal element is not imputed nor balanced , we
        ##                 will not test whether it is imputed or the identity
        ##                 calculated.

        ## I am filtering meatImputed in order to avoid issue 180

        meatImputedFilterd <-
            meatImputed[flagMethod == "i" | (flagObservationStatus == "I" & flagMethod == "e") | (flagObservationStatus == "E" & flagMethod == "e"), ]

        slaughteredTransferedBackToAnimalData <-
          transferParentToChild(
            parentData                = slaughteredParentData,
            childData                 = meatImputedFilterd,
            mappingTable              = animalMeatMappingShare,
            transferMethodFlag        = "c",
            imputationObservationFlag = "I",
            parentToChild             = FALSE
          )

        ## Not all the tranfered figures have to be sent back to the SWS, bacause there are situation where
        ## only the flag is changed, and it would be better to keep the protected flag combination coming from the
        ## parent-data "slaughteredParentData"

        ensureProductionOutputs(
          data                 = meatImputed,
          processingParameters = processingParameters,
          formulaParameters    = meatFormulaParameters,
          testImputed          = FALSE,
          testCalculated       = FALSE,
          normalised           = TRUE,
          returnData           = FALSE
        )

        ## ---------------------------------------------------------------------

        ##message("Testing transfers are applied correctly")
        ## WARNING (Michael): We currently only check the synchronisation between
        ##                    animal and the meat as this processed is applied in
        ##                    the module. The animal slaughtered si transferred from
        ##                    animal to non-meat items, but not the reverse so we
        ##                    can not expect them to be synchronised. However, we
        ##                    need to also ensure the synchronisation happen between
        ##                    other the animal and non-meat child. How to do this
        ##                    specifically, I have no immediate idea. This is
        ##                    related to issue 178.(SOLVED)
        ##

        ##Slaughtered trasfered back from meat item to animal are those that should be
        ##checked.

        ##meatImputed
        #ensureCorrectTransfer(parentData = slaughteredTransferedBackToAnimalData,
        #                      childData = meatImputed,
        #                      mappingTable = animalMeatMappingShare,
        #                      returnData = FALSE)

        ## Here I am building the file to be sent as email attachement to be checked.
        ## The problem is that only re-computed figures with a different intial Value have to be sent back to the SWS

        ## I have to send back to the SWS the following elements:
        ## 1.Livestock numbers stockImputed
        ## 2.Slaughtered animal associated to ANIMAL (slaughteredTransferedBackToAnimalData)

        ## 3.4.5. The meat triplet contained in meatImputed
        livestockNumbers <- normalise(stockImputed)

        message("Saving the synchronised and imputed data back")

        syncedData <-
          rbind(
            meatImputed,
            livestockNumbers,
            slaughteredTransferedBackToAnimalData
          )

        ##Maybe it is better to send back also the (M,-) series otherwise it seems they are not updated!
        syncedData <- syncedData[(flagMethod!="u"),]

        ##write.csv(syncedData, paste0("C:/Users/Rosa/Desktop/LivestockFinalDebug/syncedData/",currentMeatItem,".csv"), row.names = FALSE)

        ## The transfer can over-write official and
        ## semi-official figures in the processed commodities as
        ## indicated by in the previous synchronise slaughtered
        ## module.
        ##

        if (imputationTimeWindow == "lastThree") {
          syncedData = syncedData[get(processingParameters$yearVar) %in% (lastYear - 0:2)]
        } else if (imputationTimeWindow == "lastFive") {
          syncedData = syncedData[get(processingParameters$yearVar) %in% (lastYear - 0:4)]
        }

        syncedData <- postProcessing(data = syncedData)

        syncedData <- removeInvalidDates(syncedData)

        ProtectedOverwritten <-
          ensureProtectedData(
            syncedData[
              (flagObservationStatus =="I" & flagMethod == "e") |
                flagMethod == "i" |
                flagMethod == "c",
            ],
            getInvalidData = TRUE
          )

        ProtectedOverwritten <- ProtectedOverwritten[measuredElement != imputationParameters$areaHarvestedParams$variable]

        ProtectedOverwritten <- ProtectedOverwritten[Value != i.Value]

        SaveData(domain = sessionKey@domain,
                 dataset = sessionKey@dataset,
                 data = syncedData)

        #---------------------------------------------------------------------

        if (!CheckDebug() & length(ProtectedOverwritten) > 0) {

            createErrorAttachmentObject <- function(testName,
                                                   testResult,
                                                   R_SWS_SHARE_PATH){

                errorAttachmentName = paste0(testName, ".csv")

                errorAttachmentPath =
                    paste0(R_SWS_SHARE_PATH, "/rosa/", errorAttachmentName)

                write.csv(testResult, file = errorAttachmentPath,
                          row.names = FALSE)

                errorAttachmentObject = mime_part(x = errorAttachmentPath,
                                                  name = errorAttachmentName)

                errorAttachmentObject
            }

            bodyWithAttachment <-
                createErrorAttachmentObject(paste0("ToBeChecked_", currentMeatItem),
                                            ProtectedOverwritten,
                                            R_SWS_SHARE_PATH)

            sendmail(from = "sws@fao.org",
                     to = swsContext.userEmail,
                     subject = "Some protected figures have been overwritten",
                     msg = bodyWithAttachment)
        }

        ## Now that we have computed and synchronized all the slaughtered we can proceed
        ##computig other derived items
        ## ---------------------------------------------------------------------
        if (length(currentNonMeatItem) > 0) {

            nonMeatImputedList <- list()

            message("Step 6: Transfer the slaughtered animal from the animal to all other child
                    commodities. This includes items such as offals, fats and hides and
                    impute missing values for non-meat commodities.")

            ## Different triplet for different non-meat items, we need to loop through the
            ## different non-meat items

            for (j in seq(currentNonMeatItem)) {
                currentNonMeatItemLoop = currentNonMeatItem[j]

                message("Extracting production triplet for item ",
                        paste0(currentNonMeatItemLoop, collapse = ", "),
                        " (Non-meat Child)")

                ## Get the non Meat formula
                currentNonMeatFormulaTable <-
                    getProductionFormula(itemCode = currentNonMeatItemLoop) %>%
                    removeIndigenousBiologicalMeat(formula = .)

                ## Build the non meat key
                currentNonMeatKey <- completeImputationKey
                currentNonMeatKey@dimensions$measuredItemCPC@keys = currentNonMeatItemLoop
                currentNonMeatKey@dimensions$measuredElement@keys =
                    with(currentNonMeatFormulaTable,
                         unique(c(input, output, productivity)))

                nonMeatMeatFormulaParameters <-
                    with(currentNonMeatFormulaTable,
                         productionFormulaParameters(datasetConfig = datasetConfig,
                                                     productionCode = output,
                                                     areaHarvestedCode = input,
                                                     yieldCode = productivity,
                                                     unitConversion = unitConversion)
                    )

                ## Get the non meat data

                nonMeatData <-
                    currentNonMeatKey %>%
                    GetData(key = .) %>%
                    preProcessing(data = .) %>%
                    denormalise(normalisedData = .,
                                denormaliseKey = "measuredElement") %>%
                    createTriplet(data = .,
                                  formula = currentNonMeatFormulaTable)

                ## We have to remove (M,-) from the carcass weight: since carcass weght is usually computed ad identity,
                ## it results inutial that it exists a last available protected value different from NA and when we perform
                ## the function expandYear we risk to block the whole time series. I replace all the (M,-) carcass wight with
                ## (M,-) the triplet will be sychronized by the imputeProductionTriplet function.

                nonMeatData[
                  get(nonMeatMeatFormulaParameters$yieldObservationFlag) == processingParameters$missingValueObservationFlag,
                  ":="(
                    c(nonMeatMeatFormulaParameters$yieldMethodFlag),
                    list(processingParameters$missingValueMethodFlag)
                  )
                ]

                nonMeatData <- normalise(denormalisedData = nonMeatData,
                                        removeNonExistingRecords = FALSE)

                nonMeatData <-
                  expandYear(
                    data       = nonMeatData,
                    areaVar    = processingParameters$areaVar,
                    elementVar = processingParameters$elementVar,
                    itemVar    = processingParameters$itemVar,
                    valueVar   = processingParameters$valueVar,
                    newYears   = lastYear
                  )

                message("Transfer Animal Slaughtered to All Child Commodities")

                nonMeatMappingTable <-
                    animalMeatMappingTable[measuredItemChildCPC %in% currentNonMeatItemLoop, ]

                animalNonMeatMappingShare <-
                    merge(nonMeatMappingTable, shareData, all.x = TRUE,
                          by = c("measuredItemParentCPC", "measuredItemChildCPC"))


                ## In this tipology of commodity, there are still present old FAOSTAT imputations flagged as (I,-).
                ## At the moment the best we can do is to keep those figures as protected.
                ## We delete the figures flagged ad (I,e) end computed ad identity figures (method="i") coming from previus run of themodule:

                modifiedFlagTable <- copy(flagValidTable)

                modifiedFlagTable[flagObservationStatus == "I" & flagMethod == "-" , Protected := TRUE]

                if (imputationTimeWindow == "all") {
                  nonMeatData = removeNonProtectedFlag(nonMeatData, flagValidTable = modifiedFlagTable)
                } else if (imputationTimeWindow == "lastThree") {
                  nonMeatData = removeNonProtectedFlag(nonMeatData, flagValidTable = modifiedFlagTable, keepDataUntil = (lastYear-2))
                } else if (imputationTimeWindow == "lastFive") {
                  nonMeatData = removeNonProtectedFlag(nonMeatData, flagValidTable = modifiedFlagTable, keepDataUntil = (lastYear-4))
                }

                nonMeatData[
                  measuredElement == nonMeatMeatFormulaParameters$areaHarvestedCode,
                  `:=`(
                    Value = NA_real_,
                    flagObservationStatus = "M",
                    flagMethod = "u"
                  )
                ]

                ## Syncronize  slaughteredTransferedBackToAnimalData to the slaughtered element associated to the
                ## non-meat item
                slaughteredTransferToNonMeatChildData <-
                    transferParentToChild(
                      parentData                = slaughteredTransferedBackToAnimalData,
                      childData                 = nonMeatData,
                      transferMethodFlag        = "c",
                      imputationObservationFlag = "I",
                      mappingTable              = animalNonMeatMappingShare,
                      parentToChild             = TRUE
                    )

                nonMeatImputationParameters <-
                    with(currentNonMeatFormulaTable,
                         getImputationParameters(productionCode = output,
                                                 areaHarvestedCode = input,
                                                 yieldCode = productivity)
                    )

                ## Imputation without removing all the non protected figures for Production and carcass weight!


                ## Some checks are requested because we cannot remove all the non protected values.
                ## 1. SLAUGHTERED: synchronized
                ## 2. YIELD: to stabilize imputations I have to keep non-protected figures
                ## 3. Non-MEAT PRODUCTION: remove non-protected figures, computed as IDENTITY (where possible), IMPUTED

                ##slaughteredTransferToNonMeatChildDataPROD=slaughteredTransferToNonMeatChildData[measuredElement==nonMeatMeatFormulaParameters$productionCode]
                ##slaughteredTransferToNonMeatChildDataNoPROD=slaughteredTransferToNonMeatChildData[(measuredElement!=nonMeatMeatFormulaParameters$productionCode)]
                ##Remove non protected flags just for PRODUCTION
                ##slaughteredTransferToNonMeatChildDataPROD =  removeNonProtectedFlag(slaughteredTransferToNonMeatChildDataPROD)
                ##slaughteredTransferToNonMeatChildData=rbind(slaughteredTransferToNonMeatChildDataNoPROD,slaughteredTransferToNonMeatChildDataPROD)

                slaughteredTransferToNonMeatChildData <-
                  denormalise(
                    slaughteredTransferToNonMeatChildData,
                    denormalise = "measuredElement",
                    fillEmptyRecords = TRUE
                  )

                ## In addition, since the number of animal slaugheterd might have changed, we delete also  the
                ## the figures previously calculated ad identity (flagMethod="i") if also production is available

                ##remove those yields where both PRODUCTION and SLAUGHTERED are not NA:

                noNAProd <- slaughteredTransferToNonMeatChildData[,!is.na(get(nonMeatMeatFormulaParameters$productionValue))]

                noNASlaughterd <- slaughteredTransferToNonMeatChildData[,!is.na(get(nonMeatMeatFormulaParameters$areaHarvestedValue))]

                myfilter <- noNAProd & noNASlaughterd

                slaughteredTransferToNonMeatChildData[
                  myfilter,
                  ":="(
                    c(nonMeatMeatFormulaParameters$yieldValue,
                      nonMeatMeatFormulaParameters$yieldObservationFlag,
                      nonMeatMeatFormulaParameters$yieldMethodFlag),
                    list(NA_real_,"M","u"))
                ]

                nonMeatImputed <-
                  imputeProductionTriplet(
                    data                 = slaughteredTransferToNonMeatChildData,
                    processingParameters = processingParameters,
                    imputationParameters = nonMeatImputationParameters,
                    formulaParameters    = nonMeatMeatFormulaParameters,
                    completeImputationKey = completeImputationKey,
                    imputationTimeWindow  = imputationTimeWindow,
                    flagValidTable        = flagValidTable,
                    FIX_OUTLIERS          = FIX_OUTLIERS,
                    THRESHOLD             = THRESHOLD,
                    AVG_YEARS             = AVG_YEARS
                  )

                nonMeatImputedList[[j]] <- normalise(nonMeatImputed)

                slaughteredTransferToNonMeatChildData <- rbindlist(nonMeatImputedList)

                slaughteredTransferToNonMeatChildData <- slaughteredTransferToNonMeatChildData[flagMethod!="u", ]

                if (imputationTimeWindow == "all") {
                  slaughteredTransferToNonMeatChildData <- postProcessing(data = slaughteredTransferToNonMeatChildData)
                } else if (imputationTimeWindow == "lastThree") {
                  slaughteredTransferToNonMeatChildData <- slaughteredTransferToNonMeatChildData[get(processingParameters$yearVar) %in% (lastYear - 0:2)]
                } else if (imputationTimeWindow == "lastFive") {
                  slaughteredTransferToNonMeatChildData <- slaughteredTransferToNonMeatChildData[get(processingParameters$yearVar) %in% (lastYear - 0:4)]
                }

                slaughteredTransferToNonMeatChildData <-
                  removeInvalidDates(data = slaughteredTransferToNonMeatChildData, context = sessionKey)

                slaughteredTransferToNonMeatChildData <-
                  postProcessing(data = slaughteredTransferToNonMeatChildData)

                SaveData(domain = sessionKey@domain,
                         dataset = sessionKey@dataset,
                         data = slaughteredTransferToNonMeatChildData)
            }
        }

        ## ---------------------------------------------------------------------

        message("\nSynchronisation and Imputation Completed for\n",
                "Animal Parent: ", currentAnimalItem, "\n",
                "Meat Child: ", currentMeatItem, "\n",
                "Non-meat Child: ", paste0(currentNonMeatItem, collapse = ", "), "\n",
                rep("-", 80), "\n")
    })

    ## Capture the items that failed
    if (inherits(imputationProcess, "try-error")) {
        imputationResult <-
          rbind(
            imputationResult,
            data.table(item = currentMeatItem, error = imputationProcess[iter])
          )
    }
}


## Initiate email
from <- "sws@fao.org"
to <- swsContext.userEmail
subject <- "Livestock module"
body <- paste0("Livestock production module successfully ran. You can browse results in the session: ", sessionKey@sessionId )
sendmail(from = from, to = to, subject = subject, msg = body)

##' ---
##' ## Return Message

if (nrow(imputationResult) > 0) {
    ## Initiate email
    from <- "sws@fao.org"
    to <- swsContext.userEmail
    subject <- "Imputation Result"
    body <- paste0("The following items failed, please inform the maintainer "
                  , "of the module")

    errorAttachmentName <- "non_livestock_imputation_result.csv"
    errorAttachmentPath <-
        paste0(R_SWS_SHARE_PATH, "/kao/", errorAttachmentName)

    write.csv(imputationResult, file = errorAttachmentPath,
              row.names = FALSE)

    errorAttachmentObject <- mime_part(x = errorAttachmentPath,
                                      name = errorAttachmentName)

    bodyWithAttachment <- list(body, errorAttachmentObject)

    sendmail(from = from, to = to, subject = subject, msg = bodyWithAttachment)

    stop("Production imputation incomplete, check following email to see where ",
         " it failed")
}


if (!CheckDebug()) {

  msg <- "Imputation Completed Successfully"
  message(msg)

  ## Initiate email
  from <- "sws@fao.org"
  to <- swsContext.userEmail
  subject <- "Crop-production imputation plugin has correctly run"
  body <- paste0("Livestock production module successfully ran. You can browse results in the session: ", sessionKey@sessionId)

  sendmail(from = from, to = to, subject = subject, msg = body)
}

print("Imputation Completed Successfully")
SWS-Methodology/faoswsProduction documentation built on March 21, 2023, 8:27 p.m.