sandbox/imputeSeed.R

In SWS-Methodology/faoswsSeed: Package to perform the imputation of seed usage for the FAO seed domain

##' Function to impute the seed.
##' 
##' First, an estimate for the seed value at time t is generated by multiplying
##' the area sown at time t-1 by the seed rate (divided by 1,000) at time t.
##' Then, the estimate is inserted into the seed data.table if the seed value
##' at time t is currently missing.  The observation flag is updated by
##' aggregating the flags of the seed rate and area sown, and the method flag
##' is updated with the value of imputedFlag (passed as an argument).  Lastly,
##' the seedRateValue and seedRateFlag columns are deleted from the data.table.
##' 
##' @param data The data.table object containing the seed data, typically as
##' created by getAreaData.
##' @param seedValue The column name of data which contains the value of the
##' seed variable.
##' @param seedMethodFlag The column name of data which contains the method
##' flag of the seed variable.
##' @param seedObsFlag The column name of data which contains the
##' observation flag of the seed variable.
##' @param areaSownValue The column name of data which contains the value of
##' the area sown variable.
##' @param areaSownObsFlag The column name of data which contains the
##' observation flag of the area sown variable.
##' @param seedRateValue The column name of data which contains the seed rate
##' variable.
##' @param seedRateFlag The column name of data which contains the seed rate
##' flag.
##' @param imputedFlag When the seed value is imputed, what character value
##' should be assigned to the seedMethodFlag?
##' @param byKey A character vector of the column name(s) of data which should
##' be treated as keys for performing the imputation.
##' 
##' @return No value is returned, instead data is modified by filling in
##' missing values with imputed estimates.
##' 
##' @export
##' 
##' @import faoswsFlag
##' @import data.table
##' 

imputeSeed = function(data,
                      seedValue = "Value_measuredElement_5525",
                      seedMethodFlag = "flagMethod_measuredElement_5525",
                      seedObsFlag = "flagObservationStatus_measuredElement_5525",
                      areaSownValue = "Value_measuredElement_5025",
                      areaSownObsFlag = "flagObservationStatus_measuredElement_5025",
                      seedRateValue = "Value_areaSownRatio",
                      seedRateFlag = "flagObservationStatus_areaSownRatio",
                      imputedFlag = "i", byKey = key(data)){

    ## Data Quality Checks
    stopifnot(is(data, "data.table"))
    columnNames = c(seedValue, seedMethodFlag, seedObsFlag,
                    areaSownValue, areaSownObsFlag, seedRateValue,
                    seedRateFlag, byKey)
    stopifnot(is(columnNames, "character"))
    stopifnot(columnNames %in% colnames(data))
    stopifnot(faoswsUtil::checkMethodFlag(imputedFlag))
    
    each = function(seedValue = seedValue, seedMethodFlag = seedMethodFlag,
                    seedObsFlag = seedObsFlag, areaSownValue = areaSownValue,
                    areaSownObsFlag, seedRateValue = seedRateValue,
                    seedRateFlag = seedRateFlag, imputedFlag = imputedFlag){
        ## Multiply area sown at time t with seedRate Value at time t-1
        newSeedValue = c(c(areaSownValue, NA) * c(NA, seedRateValue)/1000)[-1]
        replaceIndex = is.na(seedValue) & !is.na(newSeedValue)
        seedValue[replaceIndex] = newSeedValue[replaceIndex]
        seedMethodFlag[replaceIndex] = imputedFlag
        seedObsFlag[replaceIndex] =
            faoswsFlag::aggregateObservationFlag(areaSownObsFlag, seedRateFlag)[replaceIndex]
        list(seedValue, seedMethodFlag, seedObsFlag)
    }
    data[, `:=`(c(seedValue, seedMethodFlag, seedObsFlag),
                each(seedValue = get(seedValue),
                     seedMethodFlag = get(seedMethodFlag),
                     seedObsFlag = get(seedObsFlag),
                     areaSownValue = get(areaSownValue),
                     areaSownObsFlag = get(areaSownObsFlag),
                     seedRateValue = get(seedRateValue),
                     seedRateFlag = get(seedRateFlag),
                     imputedFlag = imputedFlag)), by = byKey]
    data[, `:=`(c(seedRateValue, seedRateFlag), NULL)]
}