R/setIndicatorValues.R

In NINAnor/NIcalc: Functions to Calculate a Nature Index

#' Set indicator values in IndicatorData object
#'
#' This function fills info into an \code{indicatorData} object which can later be uploaded to the database.
#' Usually, this object is first retrieved from the database through the function \code{getIndicatorData}.
#' This object will list all data that a user is privileged to alter for a particular indicator.
#' Data is accepted either in the form of an estimate together with an lower and upper quartile of uncertainty,
#' or as a distribution object generated by \code{\link{makeDistribution}}.
#'
#' @name setIndicatorValues
#' @encoding UTF-8
#' @author  Jens Åström
#'
#' @import distr
#' @importFrom uuid UUIDgenerate
#'
#' @param indicatorData Object of class `indicatorData` created by \code{getIndicatorValues}.
#' @param areaId Numeric. Identifier of the indicator value to be altered.
#' @param years Numeric. Which year to set values for.
#' @param est Numeric. Point estimate for the indicator value. Optional.
#' @param lower Numeric. Lower quartile of estimate. Required when supplying point estimate.
#' @param upper Numeric. Upper quartile of estimate. Required when supplying point estimate.
#' @param distribution distribution object generated by \code{makeDistribution}
#' See examples therein.
#' @param datatype Type of observation. Remember to update this when the type changes.
#' Allowed values: NA, 1 = Ekspertvurdering, 2 = Overvåkingsdata, 3 = Beregnet fra modeller. Defaults to NA.
#' @param unitOfMeasurement Text of maximum length 100. Defaults to "Enhetsløs".
#'
#' @return Object of class `indicatorData`.
#'
#' @export
#' @examples
#' myData <- indicatorData
#' class(myData)
#' myData <- setIndicatorValues(myData, areaId = 7040, years = 1950,
#'                              est = 0.9, lower = 0.7, upper = 1,
#'                              datatype = 1)
#'
#' myDist <- makeDistribution(input = "logNormal",distParams = list("mean" = 40, "sd" = 2))
#' myData <- setIndicatorValues(myData, areaId = 7041, years = 1950,
#'                              distribution = myDist,
#'                              datatype = 2)
#'
#' myCodasamples <- rnorm(n = 1000, mean = 15)
#' myData <- setIndicatorValues(myData, areaId = 7042, years = 1950,
#'                              distribution = makeDistribution(myCodasamples),
#'                              datatype = 3, unitOfMeasurement = "antall/m2")
#'
#'
#' @seealso \code{\link{makeDistribution}}, and \code{\link{getIndicatorValues}}.
#' The vignette \code{Distributions} gives detailed descriptions of the use of
#' \code{setIndicatorValues} when revising and updating values for an indicator.

setIndicatorValues <- function(indicatorData = NULL,
                               areaId = NULL,
                               years = NULL,
                               est = NA,
                               lower = NA,
                               upper = NA,
                               distribution = NULL,
                               datatype = NA,
                               unitOfMeasurement = "Enhetsl\uf8s"){

  if(!("indicatorData" %in% class(indicatorData))) stop("indicatorData needs to be of class \"indicatorData\". Use function \"getIndicatorData\" to retreive or create such an object")

  if(nchar(unitOfMeasurement) > 100) stop("unitOfMeasurement can only be 100 characters long.")

  if(!(datatype %in% c(NA,1:3))) stop("Datatype needs to be 1, 2, 3, or NA.")

  if(is.na(datatype)) {
    datatypeName <- NA
  } else {
    datatypeName <- c("Ekspervurdering", "Overv\ue5kingsdata", "Beregnet fra modeller")[datatype]
  }

  rows <- 1:nrow(indicatorData$indicatorValues)
  if(!is.null(areaId)){
    rows <- rows[indicatorData$indicatorValues$areaId[rows] %in% areaId]
  }

  if(!is.null(years)){
    rows <- rows[indicatorData$indicatorValues$yearName[rows] %in% years]
  }


  if(!is.null(distribution)){
    if(attr(class(distribution), "package") != "distr") stop("Distribution needs to be a distribution object made from the 'makeDistribution' function")
    distID <- uuid::UUIDgenerate()
    dist <- distribution
    indicatorData$indicatorValues[rows, c("distParam1", "distParam2")] <- c(NA, NA)

    if(class(dist) == "Lnorm"){
      est <- logNormal2normal(distr::meanlog(dist), distr::sdlog(dist))[[1]]
      indicatorData$indicatorValues[rows, c("distParam1", "distParam2")] <- c(distr::meanlog(dist), distr::sdlog(dist))
    } else if(class(dist) == "Pois"){
      est <- distr::lambda(dist)

    } else  est <- mean(sampleDistribution(dist, 1e5))


    indicatorData$indicatorValues[rows, "verdi"] <- est
    indicatorData$indicatorValues[rows, "customDistributionUUID"] <- distID
    indicatorData$customDistributions[[distID]] <- dist

    indicatorData$indicatorValues[rows, "nedre_Kvartil"] <- NA
    indicatorData$indicatorValues[rows, "ovre_Kvartil"] <- NA
    indicatorData$indicatorValues[rows, "distributionName"] <- NA
    indicatorData$indicatorValues[rows, "distributionId"] <- NA

    indicatorData$indicatorValues[rows, "datatypeId"] <- datatype
    indicatorData$indicatorValues[rows, "datatypeName"] <- datatypeName
    indicatorData$indicatorValues[rows, "unitOfMeasurement"] <- unitOfMeasurement

    indicatorData$indicatorValues[rows, "distParam1"] <- NA
    indicatorData$indicatorValues[rows, "distParam2"] <- NA


  } else {

    if(is.na(est) & !is.na(datatype)) stop("Datatype needs to be NA if estimate is NA")

    indicatorData$indicatorValues[rows, "verdi"] <- est
    indicatorData$indicatorValues[rows, "nedre_Kvartil"] <- lower
    indicatorData$indicatorValues[rows, "ovre_Kvartil"] <- upper

    indicatorData$indicatorValues[rows, "datatypeId"] <- datatype
    indicatorData$indicatorValues[rows, "datatypeName"] <- datatypeName
    indicatorData$indicatorValues[rows, "unitOfMeasurement"] <- unitOfMeasurement
    indicatorData$indicatorValues[rows, "distributionName"] <- NA
    indicatorData$indicatorValues[rows, "distributionId"] <- NA
    indicatorData$indicatorValues[rows, "customDistributionUUID"] <- NA
    indicatorData$indicatorValues[rows, "distParam1"] <- NA
    indicatorData$indicatorValues[rows, "distParam2"] <- NA



  }

  ##Remove custom distributions not referenced in table
  presentIDs <- indicatorData$indicatorValues[, "customDistributionUUID"]
  indicatorData$customDistributions <- indicatorData$customDistributions[names(indicatorData$customDistributions) %in% presentIDs]

  return(indicatorData)

}