R/convert.R

In COINr: Composite Indicator Construction and Analysis

#' Convert a COIN to a coin
#'
#' Converts an older COIN class to the newer coin class. Note that there are some limitations to this. First,
#' the function arguments used to create the COIN will not be passed to the coin, since the function arguments
#' are different. This means that any data sets beyond "Raw" cannot be regenerated. The second limitation is
#' that anything from the `.$Analysis` folder will not be passed on.
#'
#' This function works by building the `iData` and `iMeta` arguments to `new_coin()`, using information from
#' the COIN. It then uses these to build a coin if `out2 = "coin"` or else outputs both data frames in a list.
#'
#' If `recover_dsets = TRUE`, any data sets found in `COIN$Data` (except "Raw") will also be put in `coin$Data`,
#' in the correct format. These can be used to inspect the data but not to regenerate.
#'
#' Note that if you want to exclude any indicators, you will have to set `out2 = "list"` and build the coin
#' in a separate step with `exclude` specified. Any exclusions/inclusions from the COIN are not passed on
#' automatically.
#'
#' @param COIN A COIN class object, generated by COINr version <= 0.6.1, OR a list containing IndData, IndMeta and
#' AggMeta entries.
#' @param recover_dsets Logical: if `TRUE`, will recover data sets other than "Raw" which are found in the
#' `.$Data` list.
#' @param out2 If `"coin"` (default) outputs a coin, else if `"list"`, outputs a list with
#' `iData` and `iMeta` entries. This may be useful if you want to make further edits before building the coin.
#'
#' @return A coin class object if `out2 = "coin"`, else a list of data frames if `out2 = "list"`.
#' @export
#'
#' @examples
#' # see vignette("other_functions")
#'
COIN_to_coin <- function(COIN, recover_dsets = FALSE, out2 = "coin"){


  # Get dfs -----------------------------------------------------------------

  if(!inherits(COIN, "COIN")){

    intype <- "list"

    if(!is.list(COIN)){
      stop("input must be either a COIN (i.e. generated from COINr version <= 0.6.1.) or a list.")
    }
    if(is.null(COIN$IndData) | is.null(COIN$IndMeta) | is.null(COIN$AggMeta)){
      stop("One or more of IndData, IndMeta and AggMeta not found in input list.")
    }

    # input data
    IndData <- COIN$IndData
    # get indicator metadata
    IndMeta <- COIN$IndMeta
    # aggmeta
    AggMeta <- COIN$AggMeta

  } else {

    intype <- "COIN"

    # input data
    IndData <- COIN$Input$Original$IndData
    # get indicator metadata
    IndMeta <- COIN$Input$Original$IndMeta
    # aggmeta
    AggMeta <- COIN$Input$Original$AggMeta

  }
  stopifnot(is.data.frame(IndData),
            is.data.frame(IndMeta),
            is.data.frame(AggMeta))


  # iData -------------------------------------------------------------------

  # make a copy
  IndData2 <- IndData

  # rename special columns
  names(IndData2)[names(IndData2) == "UnitName"] <- "uName"
  names(IndData2)[names(IndData2) == "UnitCode"] <- "uCode"
  names(IndData2)[names(IndData2) == "Year"] <- "Time"

  iData <- IndData2

  if(recover_dsets & intype == "COIN"){

    # get names of dsets
    dsets <- names(COIN$Data)
    # exclude "Raw"
    dsets <- setdiff(dsets, "Raw")

    if(length(dsets) > 0){
      recovered_dsets <- lapply(dsets, function(dset){
        x <- COIN$Data[[dset]]
        x <- x[c("UnitCode", COIN$Input$IndMeta$IndCode)]
        names(x)[1] <- "uCode"
        as.data.frame(x)
      })
      names(recovered_dsets) <- dsets
    } else {
      message("No data sets other than Raw were found.")
    }

  }



  # iMeta -------------------------------------------------------------------

  if(any(IndMeta$IndCode %nin% colnames(IndData))){
    stop("One or more IndCodes from IndMeta not found in original IndData.")
  }

  # rename special columns
  names(IndMeta)[names(IndMeta) == "IndName"] <- "iName"
  names(IndMeta)[names(IndMeta) == "IndCode"] <- "iCode"
  names(IndMeta)[names(IndMeta) == "IndWeight"] <- "Weight"
  names(IndMeta)[names(IndMeta) == "IndUnit"] <- "Unit"

  # get aggregation cols
  lineage <- IndMeta[c("iCode", colnames(IndMeta)[ startsWith(colnames(IndMeta), "Agg") ])]
  # remove aggregation cols
  IndMeta <- IndMeta[ colnames(IndMeta)[!startsWith(colnames(IndMeta), "Agg")] ]

  # add parent for indicators
  IndMeta$Parent <- lineage[[2]]
  # add level for indicators
  IndMeta$Level <- 1
  # add type
  IndMeta$Type <- "Indicator"

  # now we have to add higher aggregation levels...

  # rename special columns
  names(AggMeta)[names(AggMeta) == "AgLevel"] <- "Level"
  names(AggMeta)[names(AggMeta) == "Code"] <- "iCode"
  names(AggMeta)[names(AggMeta) == "Name"] <- "iName"

  # add type
  AggMeta$Type <- "Aggregate"
  # add direction
  AggMeta$Direction <- 1

  # add Parent
  AggMeta$Parent <- sapply(AggMeta$iCode, function(Code){
    # col index of current level
    icol <- AggMeta$Level[AggMeta$iCode == Code]
    # codes at current level
    l1 <- lineage[[icol]]
    if(icol == ncol(lineage)){
      NA
    } else {
      # codes at parent level
      lp <- lineage[[icol + 1]]
      unique(lp[l1 == Code])
    }
  })

  # Now join to IndMeta
  iMeta <- rbind_fill(IndMeta, AggMeta)

  # Add any other cols from IndData

  # groups
  groupcols <- colnames(IndData)[startsWith(colnames(IndData), "Group_")]
  if(length(groupcols) > 0){
    iMeta <- rbind_fill(iMeta,
                        data.frame(iCode = groupcols,
                                   iName = groupcols,
                                   Type = "Group"))
  }

  # denominators
  dencols <- colnames(IndData)[startsWith(colnames(IndData), "Den_")]
  if(length(groupcols) > 0){
    iMeta <- rbind_fill(iMeta,
                        data.frame(iCode = dencols,
                                   iName = dencols,
                                   Type = "Denominator"))
  }
  # others
  othercols <- colnames(IndData)[startsWith(colnames(IndData), "x_")]
  if(length(othercols) > 0){
    iMeta <- rbind_fill(iMeta,
                        data.frame(iCode = othercols,
                                   iName = othercols,
                                   Type = "Other"))
  }

  # OUTPUT ------------------------------------------------------------------

  if(out2 == "coin"){
    coin <- new_coin(iData, iMeta)
    if(exists("recovered_dsets")){
      coin$Data <- c(coin$Data, recovered_dsets)
      coin$Log$can_regen <- FALSE
      coin$Log$message <- "This coin contains data sets recovered from a COIN. Regeneration has been disabled."
    }
    coin
  } else if (out2 == "list"){
    list(iData = iData, iMeta = iMeta)
  }

}