R/subsetAupus.R

In SWS-Methodology/faoswsAupus: Package to perform the AUPUS calculation.

##' Subset AUPUS Data
##' 
##' This function takes as input the list of data.table data as generated by
##' getAupusDataset and subsets it based on specific item (commodity) codes.
##' This can be useful for analyzing smaller datasets and understanding what
##' the algorithm is doing.  Note that if the particular item code(s) have
##' any children, those values (and their children, and so on)
##' will also be included.
##' 
##' @param aupusData The AUPUS dataset, typically as generated by
##' getAupusDataset.  This contains a list of 8 data.tables with the data of
##' interest.
##' @param parentKeys A numeric vector containing the item code(s) to filter on.
##' @param aupusParam A list of running parameters to be used in pulling the data.
##' Typically, this is generated from getAupusParameter (see that function for
##' a description of the required elements).
##' 
##' @return An object of the same structure as aupusData, but with each
##' individual data.table filtered according to the set of keys provided.
##' 
##' @export
##' 

subsetAupus = function(aupusData, parentKeys, aupusParam){
    
    ## Data Quality Checks
    if(!exists("aupusParameterEnsured") || !aupusParameterEnsured)
        ensureAupusParameter(aupusParam)
    stopifnot(is(aupusData, "list"))
    stopifnot(names(aupusData) == c("aupusData", "inputData", "ratioData",
                                    "shareData", "balanceElementData",
                                    "itemInfoData", "populationData",
                                    "extractionRateData"))
    
    parentName = aupusParam$keyNames$itemParentName
    childName = aupusParam$keyNames$itemChildName
    itemName = aupusParam$keyNames$itemName
    
    ## Get all the keys which are connected with the provided keys
    newKeys = parentKeys
    while(length(newKeys) > 0){
        newKeys = aupusData$inputData[get(parentName) %in% parentKeys,
                                      unique(c(get(parentName),
                                               get(childName)))]
        newKeys = newKeys[!newKeys %in% parentKeys]
        parentKeys = c(parentKeys, newKeys)
    }
    
    aupusData$aupusData = aupusData$aupusData[get(itemName) %in% parentKeys, ]
    aupusData$inputData =
        aupusData$inputData[get(parentName) %in% parentKeys &
                            get(childName) %in% parentKeys, ]
    aupusData$ratioData = aupusData$ratioData[get(itemName) %in% parentKeys, ]
    aupusData$shareData =
        aupusData$shareData[get(parentName) %in% parentKeys &
                            get(childName) %in% parentKeys, ]
    aupusData$balanceElementData =
        aupusData$balanceElementData[get(itemName) %in% parentKeys, ]
    aupusData$itemInfoData =
        aupusData$itemInfoData[get(itemName) %in% parentKeys, ]
    aupusData$extractionRateData =
        aupusData$extractionRateData[get(childName) %in% parentKeys, ]
    
    return(aupusData)
}