library(faosws)
library(faoswsUtil)
library(faoswsProcessing)
library(data.table)
library(sendmailR)
library(zoo)
# -- Token QA ----
if(CheckDebug()){
library(faoswsModules)
SETTINGS = ReadSettings("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(baseUrl = SETTINGS[["server"]],
token = 'b1193433-3a61-4ee1-9f26-a54a8a6b447b')
}
# options(error = function(){
# dump.frames()
# from = "sws@fao.org"
# to = swsContext.userEmail
# subject = "fi_SUA-FBS plug-in has correctly run"
# body = paste("The plug-in has saved the data in your sessions.
# The plugin returned the following messages:",
# last.dump)
# sendmailR::sendmail(from = from, to = to, subject = subject, msg = body)
#
# })
flagMethodAss <- function(fos){
if(is.na(fos)){
fm <- '-'
} else {
fos <- as.character(fos)
if(fos == 'E'){
fm <- 'f'
} else if(fos == 'I'){
fm <- 'i'
} else {
fm <- '-'
}
}
return(as.character(fm))
}
# -- Parameters ----
message("fi_SUA-FBS: Getting parameters")
# Paramenters from session
sessionKey_fbsFias = swsContext.datasets[[1]]
sessionKey_suaUnb = swsContext.datasets[[2]]
sessionKey_suabal = swsContext.datasets[[3]]
sessionKey_fbsFaostat = swsContext.datasets[[4]]
# Countries either from session or from parameters
countryPar <- swsContext.computationParams$countries
print(countryPar)
if(!is.null(countryPar) & length(countryPar) > 0){
countryPar <- swsContext.computationParams$countries
sessionCountry <- strsplit(countryPar, ', ')[[1]]
} else {
sessionCountry <- swsContext.datasets[[1]]@dimensions$geographicAreaM49_fi@keys
countries <- GetCodeList("FisheriesCommodities", "fi_fbs_fias", "geographicAreaM49_fi")[ type == 'country']$code
# Make sure only countries not areas
sessionCountry <- sessionCountry[sessionCountry %in% countries]
}
message(paste("fi_SUA-FBS: countries selected ", paste0(sessionCountry, collapse = ', '), '.', sep = ''))
# Mandatory year values
maxyear <- as.numeric(swsContext.computationParams$maxyear)
minyear <- as.numeric(swsContext.computationParams$minyear)
yearVals <- as.character(minyear:maxyear)
year <- max(as.numeric(yearVals))
# -- Needed datasets ----
## Get global production (from Production environment)
message("fi_SUA-FBS: Pulling data from Global production")
KeyGlobal <- DatasetKey(domain = "Fisheries", dataset = "fi_fbs_global_production", dimensions = list(
geographicAreaM49_fi = Dimension(name = "geographicAreaM49_fi", keys = sessionCountry),
fisheriesAsfis = Dimension(name = "fisheriesAsfis", keys = GetCodeList("Fisheries", "fi_fbs_global_production","fisheriesAsfis" )[,code]),
fisheriesCatchArea = Dimension(name = "fisheriesCatchArea", keys = GetCodeList("Fisheries", "fi_fbs_global_production","fisheriesCatchArea" )[,code]),
measuredElement = Dimension(name = "measuredElement", keys = c("FI_001")),
timePointYears = Dimension(name = "timePointYears", keys = yearVals )))
globalProduction <- GetData(KeyGlobal)
# Add Channel Is and Isle of Man to UK
globalProduction[geographicAreaM49_fi %in% c('830','833'), geographicAreaM49_fi := '826']
# Aggregate by fisheriesCatchArea
# Convert flags into ordinal factor so that simple aggregation is possible
# The function aggregateObservationFlag is too slow so flag are transformed into factors
globalProduction$flagObservationStatus <- factor(globalProduction$flagObservationStatus,
levels = c('M', 'O', 'N', '', 'X', 'T', 'E', 'I'),
ordered = TRUE)
if(nrow(globalProduction)){
globalProduction <- globalProduction[ , list(ValueAggr = sum(Value, na.rm = TRUE),
flagObservationStatusAggr = max(flagObservationStatus),
flagMethodAggr = flagMethodAss(max(flagObservationStatus))),
by=c("geographicAreaM49_fi",
"fisheriesAsfis",
"measuredElement",
"timePointYears")]
}
setnames(globalProduction, names(globalProduction), c("geographicAreaM49_fi", "fisheriesAsfis",
"measuredElement", "timePointYears",
"Value", "flagObservationStatus",
"flagMethod"))
# Hard code change from FI_001 to 5510, both are Production in tonnes.
globalProduction$measuredElement <- ifelse(globalProduction$measuredElement == "FI_001", "5510", globalProduction$measuredElement)
if(any(globalProduction$measuredElement != "5510") ){
message("Not all the elements in Global production dataset are FI_001")
}
## Get Commodities data (from QA environment)
message("fi_SUA-FBS: Pulling data from Commodites dataset")
commodityDB0 <- data.table()
for(i in 1:length(sessionCountry)){
KeyComm <- DatasetKey(domain = "Fisheries Commodities", dataset = "commodities_total", dimensions = list(
geographicAreaM49_fi = Dimension(name = "geographicAreaM49_fi", keys = sessionCountry[i]),
measuredItemISSCFC = Dimension(name = "measuredItemISSCFC", keys = GetCodeList("FisheriesCommodities", "commodities_total","measuredItemISSCFC" )[,code]),
measuredElement = Dimension(name = "measuredElement", keys = GetCodeList("FisheriesCommodities", "commodities_total","measuredElement" )[,code]),
timePointYears = Dimension(name = "timePointYears", keys = yearVals )))
commodityDBchunk <- GetData(KeyComm)
commodityDB0 <- rbind(commodityDB0, commodityDBchunk)
print(i)
}
# Add Channel Is and Isle of Man to UK
commodityDB0[geographicAreaM49_fi %in% c('830','833'), geographicAreaM49_fi := '826']
commodityDB0$flagObservationStatus <- factor(commodityDB0$flagObservationStatus,
levels = c('M', 'O', 'N', '', 'X', 'T', 'E', 'I'),
ordered = TRUE)
# Re-export in Export (quantity and values)
commodityDB0[measuredElement == '5912', measuredElement := '5910'] # quantity
commodityDB0[measuredElement == '5923', measuredElement := '5922'] # Value in 1000$
commodityDB0[measuredElement == '5931', measuredElement := '5930'] # Unit value $/t
# # Transform fish in units in fish in tonnes
# ### THIS HAS TO BE CHECKED BETTER AS UNIT != TONNES!!!!!!!!!!!!
# commodityDB0[measuredElement == '5907', measuredElement := '5910']
# commodityDB0[measuredElement == '5937', measuredElement := '5930']
#
# commodityDB0[measuredElement == '5607', measuredElement := '5610']
# commodityDB0[measuredElement == '5637', measuredElement := '5630']
#
# commodityDB0[measuredElement == '5906', measuredElement := '5910']
# commodityDB0[measuredElement == '5940', measuredElement := '5930']
commodityDB0 <- commodityDB0[!measuredElement %in% c('5907', '5937',
'5607', '5637',
'5906', '5940')]
# Other import
# commodityDB0 <- commodityDB0[measuredElement == "5607", measuredElement := '5610']
# Isolate prices (not entering all the processing)
ValueElements <- c('5930', '5630') # c('5922', '5930', '5622', '5630')
# commodityDBValue <- commodityDB0[measuredElement %in% ValueElements]
commodityDB <- commodityDB0 #[!measuredElement %in% ValueElements]
if(nrow(commodityDB) > 0){
# Aggregate re-export to export
commodityDB <- commodityDB[ , c("Value",
"flagObservationStatus",
"flagMethod") := list(sum(Value, na.rm = TRUE),
max(flagObservationStatus),
flagMethodAss(max(flagObservationStatus))),
by = c('geographicAreaM49_fi',
'timePointYears',
'measuredItemISSCFC',
'measuredElement')]
}
# Get datatables that correspond to the EBX code
map_isscfc <- ReadDatatable('map_isscfc')
setnames(map_isscfc, "measured_item_isscfc", "measuredItemISSCFC")
map_asfis <- ReadDatatable('map_asfis')
setnames(map_asfis, "asfis", "fisheriesAsfis")
# -- Start processing global production ----
message('fi_SUA-FBS: Start processing Global Production')
# Map to ICS
globalProductionMapping <- merge(globalProduction, map_asfis, by = c("fisheriesAsfis"), all.x = TRUE)
if(any(is.na(globalProductionMapping$ics))){
notMappedSpecies <- unique(globalProductionMapping[is.na(ics)]$fisheriesAsfis)
message(paste("These species are not mapped to any ICS group:",
paste(notMappedSpecies, collapse = ", ")))
msg2email1 <- paste("These species are not mapped to any ICS group:",
paste(notMappedSpecies, collapse = ", "))
}
msg2email1 <- ifelse(any(is.na(globalProductionMapping$ics)), msg2email1, "")
message('Species - ICS mapping table for exceptions.')
# Load table of deviated species
new_map_asfis <- data.table()
for(i in seq(sessionCountry)){
new_country <- ReadDatatable('gp_mapping', where = paste("country = '", sessionCountry[i], "'", sep = ''))
new_map_asfis <- rbind(new_map_asfis, new_country)
}
# Deviate species
if(nrow(new_map_asfis) > 0){ # if there is any change from default YBKlang mapping
new_map_asfis[ end_year == 'LAST', end_year := as.character(year)]
newMapping <- merge(globalProductionMapping, new_map_asfis,
by.x = c('geographicAreaM49_fi', 'fisheriesAsfis'),
by.y = c('country', 'asfis'), all = TRUE, allow.cartesian = TRUE)
unchanged <- newMapping[is.na(from_code)]
unchanged <- rbind(unchanged, newMapping[!is.na(from_code) & timePointYears > end_year | timePointYears < start_year])
tochange <- newMapping[!is.na(from_code)]
tochange <- tochange[ , c('timePointYears', 'end_year', 'start_year') := list(as.numeric(timePointYears), as.numeric(end_year), as.numeric(start_year))]
tochange1 <- tochange[ timePointYears <= end_year & timePointYears >= start_year & ratio == 1]
tochange1 <- tochange1[, ics := to_code]
duplicate <- tochange[ timePointYears <= end_year & timePointYears >= start_year & ratio < 1]
# Allow for splitting
if(nrow(duplicate) > 0){
duplicate[ timePointYears <= end_year & timePointYears >= start_year & ratio != 1, c('ics', 'Value') := list(to_code, Value * as.numeric(ratio))]
duplicate[ , total := sum(as.numeric(ratio)), by = c('geographicAreaM49_fi', 'fisheriesAsfis', 'measuredElement', 'timePointYears','from_code', 'start_year', 'end_year')]
if(nrow(duplicate[total < 1]) > 0){
duplicate[ , diff := (1-total)]
addMissingQuantities <- duplicate[diff != 0, ]
addMissingQuantities[ , c('Value', 'ratio') := list(sum(Value), diff),
by = c('geographicAreaM49_fi', 'fisheriesAsfis', 'measuredElement',
'timePointYears', 'from_code', 'start_year', 'end_year')]
addMissingQuantities[ , c('Value', 'to_code', 'ics') := list((Value/total)*as.numeric(ratio), from_code, from_code)]
setkey(addMissingQuantities)
addMissingQuantities <- unique(addMissingQuantities)
duplicate <- rbind(duplicate, addMissingQuantities)
duplicate[ , diff := NULL]
}
duplicate[ , total := NULL]
}
changed <- rbind(tochange1, duplicate)
gpMap_new <- rbind(unchanged, changed)
gpMap_new[ , c('from_code', 'to_code', 'start_year', 'end_year', 'ratio'):= NULL]
} else { # if no change from default YBKlang mapping
gpMap_new <- globalProductionMapping
}
globalProductionAggr <- gpMap_new[, list(Value = sum(Value, na.rm = TRUE),
flagObservationStatus = max(flagObservationStatus),
flagMethod = flagMethodAss(max(flagObservationStatus))),
by = list(geographicAreaM49_fi,
timePointYears,
measuredElement,
ics)]
# Remove ISSCAAP/ASFIS not mapped to any ICS (Sponges, Corals, Pearls):
globalProductionAggr <- globalProductionAggr[!is.na(ics), ]
# -- Start processing commodity DB ----
message('fi_SUA-FBS: Start processing commodity DB')
# Map to ICS
commodityDBIcs <- merge(commodityDB, map_isscfc, by = "measuredItemISSCFC")
commodityDBIcs$measuredItemISSCFC <- as.character(commodityDBIcs$measuredItemISSCFC)
# Check if all commodities are mapped
if(any(is.na(commodityDBIcs$ics))){
notMappedCommodity <- unique(commodityDBIcs[is.na(ics)]$measuredItemISSCFC)
message(paste("These species are not mapped to any ICS group:",
paste(notMappedCommodity, collapse = ", ")))
msg2email1CDB <- paste("These species are not mapped to any ICS group:",
paste(notMappedCommodity, collapse = ", "))
}
msg2email1CDB <- ifelse(any(is.na(commodityDBIcs$ics)), msg2email1CDB, "")
message('Commodity - ICS mapping table for exceptions.')
# Account for commodity deviation as for GP
new_map_isscfc <- data.table()
for(i in seq(sessionCountry)){
new_country_isscfc <- ReadDatatable('cdb_mapping', where = paste("country = '", sessionCountry[i], "'", sep = ''))
new_map_isscfc <- rbind(new_map_isscfc, new_country_isscfc)
}
if(nrow(new_map_isscfc) > 0){
new_map_isscfc[ end_year == 'LAST', end_year := as.character(year)]
newMappingCDB <- merge(commodityDBIcs, new_map_isscfc,
by.x = c('geographicAreaM49_fi', 'measuredElement','measuredItemISSCFC'),
by.y = c('country', 'element','isscfc'), all = TRUE, allow.cartesian = TRUE)
unchangedCDB <- newMappingCDB[is.na(from_code)]
unchangedCDB <- rbind(unchangedCDB, newMappingCDB[!is.na(from_code) & timePointYears > end_year | timePointYears < start_year])
tochangeCDB <- newMappingCDB[!is.na(from_code)]
tochangeCDB <- tochangeCDB[ , c('timePointYears', 'end_year', 'start_year') := list(as.numeric(timePointYears), as.numeric(end_year), as.numeric(start_year))]
tochangeCDB1 <- tochangeCDB[ timePointYears <= end_year & timePointYears >= start_year & ratio == 1]
tochangeCDB1 <- tochangeCDB1[, ics := to_code]
duplicateCDB <- tochangeCDB[ timePointYears <= end_year & timePointYears >= start_year & ratio < 1]
# Allow for splitting
if(nrow(duplicateCDB) > 0){
duplicateCDB[ timePointYears <= end_year & timePointYears >= start_year & ratio != 1, c('ics', 'Value') := list(to_code, Value * as.numeric(ratio))]
duplicateCDB[ , total := sum(ratio), by = c('geographicAreaM49_fi', 'measuredItemISSCFC', 'measuredElement', 'timePointYears','from_code', 'start_year', 'end_year')]
if(nrow(duplicateCDB[total < 1]) > 0){
duplicateCDB[ , diff := (1-total)]
addMissingQuantitiesCDB <- duplicateCDB[diff != 0, ]
addMissingQuantitiesCDB[ , c('Value', 'ratio') := list(sum(Value), diff),
by = c('geographicAreaM49_fi', 'measuredItemISSCFC', 'measuredElement',
'timePointYears', 'from_code', 'start_year', 'end_year')]
addMissingQuantitiesCDB[ , c('Value', 'to_code', 'ics') := list((Value/total)*as.numeric(ratio), from_code, from_code)]
setkey(addMissingQuantitiesCDB)
addMissingQuantitiesCDB <- unique(addMissingQuantitiesCDB)
duplicateCDB <- rbind(duplicateCDB, addMissingQuantitiesCDB)
duplicateCDB[ , diff := NULL]
}
duplicateCDB[ , total := NULL]
}
changedCDB <- rbind(tochangeCDB1, duplicateCDB)
cdbMap_new <- rbind(unchangedCDB, changedCDB)
cdbMap_new <- rbind(unchangedCDB, changedCDB[ics != '9999']) # 9999 is a code when the production of the commodity does not have to be considered
cdbMap_new[ , c('from_code', 'to_code', 'start_year', 'end_year', 'ratio'):= NULL]
# Sum by ICS, no commodities anymore
} else {
cdbMap_new <- commodityDBIcs
}
#-- Link table ----
message('fi_SUA-FBS: Link table and other uses deviations')
# Link table for special period ICS group changes (regularly updated)
link_table <- ReadDatatable("link_table")
link_table <- link_table[geographic_area_m49 %in% sessionCountry]
## Checks on link table
# quantity different from 100% allocated
link_table[ , check := sum(percentage), by=c("geographic_area_m49","flow","start_year","end_year","from_code")]
if(any(link_table$check!=1)){
message(paste0("Not 100% of the original quantity is allocated for link:" ,
paste0(link_table[link_table$check!=1,], collapse = " ")))
msg2email2 <- paste0("Not 100% of the original quantity is allocated for link:" ,
paste0(link_table[link_table$check!=1,], collapse = " "))
}
msg2email2 <- ifelse(any(link_table$check!=1), msg2email2, "")
# Link table expressed in terms of "PRD", "TRD", "EXP", "IMP", "ALL"
# they translate into standard measuredElement through linkCorrespondence datatable 'link_table_elements'
linkCorrespondence <- ReadDatatable('link_table_elements')
setnames(linkCorrespondence, old = 'measuredelement', new = 'measuredElement')
message('From flow to code')
link_table2 <- merge(link_table, linkCorrespondence, by = "flow", allow.cartesian = TRUE)
link_table2$end_year <- ifelse(link_table2$end_year == "LAST", max(as.numeric(cdbMap_new$timePointYears)),
link_table2$end_year)
link_table2 <- link_table2[end_year >= as.character(minyear)]
years <- expand.grid(as.character(1:nrow(link_table2)), 1948:year)
years <- as.data.table(years)
setnames(years, c('Var1','Var2'), c('idx', 'timePointYears'))
link_table2[ , idx := row.names(link_table2) ]
link_table3 <- merge(link_table2,
years, by = 'idx')
link_table3 <- link_table3[timePointYears >= start_year & timePointYears <= end_year]
link_table3[ , idx := NULL]
link_table3[ ,timePointYears := as.character(timePointYears)]
# Change ICS codes
message('From table to CDB')
commodityDBLink <- merge(cdbMap_new, link_table3,
by.x = c("geographicAreaM49_fi", "measuredElement", "timePointYears", "ics"),
by.y = c("geographic_area_m49", "measuredElement", "timePointYears","from_code"),
all.x = TRUE, allow.cartesian = TRUE)
setkey(commodityDBLink)
commodityDBLink <- unique(commodityDBLink)
# Avoid NAs for periods
commodityDBLink$start_year <- ifelse(is.na(commodityDBLink$start_year), "1900", commodityDBLink$start_year)
commodityDBLink$end_year <- ifelse(is.na(commodityDBLink$end_year), "9999", commodityDBLink$end_year)
# commodityDBLink <- commodityDBLink[timePointYears >= start_year, ]
# commodityDBLink <- commodityDBLink[timePointYears <= end_year]
# Change ICS for defined periods
commodityDBLink[!is.na(to_code) &
as.numeric(timePointYears) >= as.numeric(start_year) &
as.numeric(timePointYears) <= as.numeric(end_year), ics := to_code]
commodityDBLink[!is.na(percentage) , Value := Value*percentage]
# remove unnecessary dimensions
commodityDBLink <- commodityDBLink[ , c("flow", "start_year", "end_year", "percentage", "to_code", "check") := NULL]
##-- Other uses introduction ----
# Some commodities are not imported for food purpouses (e.g. "ornamental fish").
# Those flow are deviated to "other utilizations"
otherUses <- ReadDatatable('other_uses')
message('Other uses merge')
commodityDBotherUses <- merge(commodityDBLink, otherUses,
by.x = c( "measuredItemISSCFC", "measuredElement", "ics"),
by.y = c("isscfc", "measured_element_orig", "ics"))
commodityDBotherUses$measuredElement <- ifelse(is.na(commodityDBotherUses$measured_element_dest),
commodityDBotherUses$measuredElement,
commodityDBotherUses$measured_element_dest)
commodityDBotherUses <- commodityDBotherUses[ , c("label", "measured_element_dest", "fias_code") := NULL]
commodityDBdeviated <- rbind(commodityDBLink, commodityDBotherUses)
# Sum by ICS, no commodities anymore
if(nrow(commodityDBdeviated)>0){
commodityDBAggr <- commodityDBdeviated[ , list(Value = sum(Value, na.rm = TRUE),
flagObservationStatus = max(flagObservationStatus),
flagMethod = flagMethodAss(max(flagObservationStatus))),
by = list(geographicAreaM49_fi,
timePointYears,
measuredElement,
ics)]
} else {
commodityDBAggr <- commodityDBdeviated[ , list(Value = sum(Value, na.rm = TRUE),
flagObservationStatus = flagObservationStatus,
flagMethod = flagMethod),
by = list(geographicAreaM49_fi,
timePointYears,
measuredElement,
ics)]
}
tradeQ <- commodityDBAggr[measuredElement %in% c('5910', '5610')]
tradeV <- commodityDBAggr[measuredElement %in% c('5922', '5622')]
tradeQ[measuredElement == '5910', flow := 'EXP']
tradeQ[measuredElement == '5610', flow := 'IMP']
tradeV[measuredElement == '5922', flow := 'EXP']
tradeV[measuredElement == '5622', flow := 'IMP']
if(nrow(tradeQ) > 0){
tradeUV <- merge(tradeQ, tradeV, by = c('geographicAreaM49_fi',
'timePointYears',
'flow',
'ics'), all = T,
suffixes = c('Q', 'V'))
tradeUV <- tradeUV[, c('Value', 'flagObservationStatus', 'flagMethod') :=
list(ValueV/ValueQ, flagObservationStatusV, "i")]
tradeUV[flow == 'IMP', measuredElement := '5630' ]
tradeUV[flow == 'EXP', measuredElement := '5930' ]
tradeUV[is.nan(Value), Value := 0]
tradeUV[ValueQ == 0, Value := ValueV]
commodityDBAggrTot <- rbind(commodityDBAggr[!measuredElement %in% c('5930', '5630')],
tradeUV[,.(geographicAreaM49_fi,
timePointYears,
measuredElement,
ics, Value,
flagObservationStatus,
flagMethod)])
} else {
commodityDBAggrTot <- commodityDBAggr
}
ValueElements <- c('5922', '5930', '5622', '5630')
# Aggregate commodity value data by ICS
# commodityDBValueIcs <- merge(commodityDBValue, map_isscfc, by = "measuredItemISSCFC")
# commodityDBValueIcs$measuredItemISSCFC <- as.character(commodityDBValueIcs$measuredItemISSCFC)
#
# commodityDBValueAggr <- commodityDBValueIcs[ , list(Value = mean(Value, na.rm = TRUE),
# flagObservationStatus = max(flagObservationStatus),
# flagMethod = "s"),
# by = list(geographicAreaM49_fi,
# timePointYears,
# measuredElement,
# ics)]
#
# commodityDBAggrTot <- rbind(commodityDBAggr, commodityDBValueAggr)
# -- SUA ----
SUA <- rbind(globalProductionAggr, commodityDBAggrTot)
setnames(SUA, "ics", "measuredItemFaostat_L2")
SUA <- SUA[ , list(Value = sum(Value, na.rm = TRUE),
flagObservationStatus = max(flagObservationStatus),
flagMethod = flagMethodAss(max(flagObservationStatus))),
by = list(geographicAreaM49_fi,
timePointYears,
measuredElement,
measuredItemFaostat_L2)]
setnames(SUA, 'measuredElement', 'measuredElementSuaFbs')
# ################
#
#
# # Carryforward: if data are missing for any year then a carry forward method is applied to fill the missing years
#
# SUA2impute <- expandYear(SUA, areaVar = "geographicAreaM49_fi",
# elementVar = "measuredElementSuaFbs", itemVar = "measuredItemFaostat_L2",
# yearVar = "timePointYears", valueVar = "Value",
# obsflagVar = "flagObservationStatus", methFlagVar = "flagMethod",
# newYears = year)
#
# # Remove expanded years different from the last one (no carry-forward for past years)
# not2impute <- SUA2impute[!timePointYears %in% c(year, as.character((as.numeric(year)-1)))]
#
# # Data useful for carry forward
# SUA2cf <- SUA2impute[timePointYears %in% c(year, as.character((as.numeric(year)-1)))]
#
# # If previous year no value than it stays as NA
# carryforward <- copy(SUA2cf)
#
# # If production and import are missing NA or 0 then carryforward
# truecarryforward <- carryforward[timePointYears ==year]
#
# ics2check <- unique(truecarryforward$measuredItemFaostat_L2)
# ics2impute <- c()
# for(i in 1:length(ics2check)){
# ics <- truecarryforward[measuredItemFaostat_L2 == ics2check[i] ]
# if(all(ics$Value == 0 | is.na(ics$Value)) ){
# ics2impute <- c(ics2impute, ics2check[i])
# }
# }
#
# truecarryforward <- truecarryforward[round(Value) == 0 | is.na(Value)]
#
#
# carryforwardImp <- copy(carryforward)
# carryforwardImp$flagObservationStatus <- as.character(carryforwardImp$flagObservationStatus)
# carryforwardImp[timePointYears == year & measuredItemFaostat_L2 %in% ics2impute
# flagObservationStatus %in% c('M', 'O') , c('Value',
# 'flagMethod') := list(NA, NA)]
#
# carryforwardImp[is.na(Value), flagObservationStatus := NA]
# carryforwardImp <- carryforwardImp[geographicAreaM49_fi %in% unique(truecarryforward$geographicAreaM49_fi) &
# measuredItemFaostat_L2 %in% unique(truecarryforward$measuredItemFaostat_L2),
# Value := zoo::na.locf(Value, na.rm = FALSE),
# by = c("geographicAreaM49_fi",
# "measuredItemFaostat_L2",
# "measuredElementSuaFbs")]
#
# # flags for carry forward/backward
# SUA2impute[is.na(Value), c("flagObservationStatus", "flagMethod") := list("E", "t")]
#
#
# SUA2save <- rbind(SUA2save[!timePointYears %in% c(year, as.character((as.numeric(year)-1)))],
# carryforward)
#
#
# ##############
SUA <- SUA[!is.na(Value)]
message("fi_SUA-FBS: Saving SUA unbalanced data")
CONFIG <- GetDatasetConfig(sessionKey_suaUnb@domain, sessionKey_suaUnb@dataset)
stats <- SaveData(domain = CONFIG$domain,
dataset = CONFIG$dataset,
data = SUA, waitTimeout = Inf)
msg2email3 <- paste0("Pull data to SUA_unbalanced process completed successfully! ",
stats$inserted, " observations written, ",
stats$ignored, " weren't updated, ",
stats$discarded, " had problems.")
# -- Filling SUA ----
# set aside price elements
SUAValues <- SUA[measuredElementSuaFbs %in% ValueElements, ]
SUA <- SUA[! measuredElementSuaFbs %in% ValueElements, ]
# Load datatable with element signs to calculate availability
# Equation: Prod + Imp + Stock - Exp - Feed - Seed - Loss - Processing - Food - Other util = 0
elementSignTable <- ReadDatatable('element_sign_table')
setnames(elementSignTable, 'measured_element', 'measuredElementSuaFbs')
# Now compute availability from SUA unbalanced as a first check
SUAexpanded <- merge(SUA, elementSignTable[ , .(measuredElementSuaFbs, sign)], by = "measuredElementSuaFbs", all.x = TRUE)
if(any(is.na(SUAexpanded$sign))){
stop('There is an element in the SUA not included in the availability calculation.')
}
message("fi_SUA-FBS: Calculating availability")
SUAexpanded[, availability := sum(Value * sign, na.rm = TRUE),
by = list(geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2)]
# Check no negative primary availability.
map_asfis <- ReadDatatable('map_asfis')
setnames(map_asfis, c("asfis", "ics"), c("fisheriesAsfis", "measuredItemFaostat_L2"))
setkey(map_asfis)
primary <- unique(map_asfis$measuredItemFaostat_L2)
primaryneg <- SUAexpanded[availability < 0 & measuredItemFaostat_L2 %in% primary]
if(nrow(primaryneg) > 0){
countriesneg <- unique(primaryneg[ , .(geographicAreaM49_fi, measuredItemFaostat_L2, timePointYears)])
msgg <- apply(countriesneg,1, paste0, collapse = ', ')
msg2email4 <- paste0('There are negative primary availabilities. Check (country code, product code, year): ',
paste0(msgg, collapse = " and "))
message(msg2email4)
}
msg2email4 <- ifelse(nrow(primaryneg) > 0, msg2email4, "")
# If primary imbalance then put imbalance to Statistical discrepancy (Residual other uses (rou) 5166)
rou <- copy(primaryneg)
rou[ , c('measuredElementSuaFbs',
'Value',
'flagObservationStatus',
'flagMethod', 'sign') := list('5166', availability,
'I', 'i', -1)]
setkey(rou)
rou <- unique(rou)
SUAexpanded <- rbind(SUAexpanded, rou)
message("fi_SUA-FBS: Start processing negative availability")
secondaryneg0 <- SUAexpanded[availability < 0 & !measuredItemFaostat_L2 %in% primary]
setkey(secondaryneg0)
secondaryneg0 <- unique(secondaryneg0)
# Delete old imbalances stored
imbalance_store <- ReadDatatable('imbalance_tab', readOnly = FALSE)
if(nrow(imbalance_store[ geographicaream49_fi %in% unique(secondaryneg0$geographicAreaM49_fi) & timepointyears %in% yearVals, ]) > 0){
changeset <- Changeset('imbalance_tab')
AddDeletions(changeset, imbalance_store[ geographicaream49_fi %in% unique(secondaryneg0$geographicAreaM49_fi) & timepointyears %in% yearVals, ])
Finalise(changeset)
}
# Add new imbalances
secondarynegCompliant <- copy(secondaryneg0)
secondarynegCompliant <- secondarynegCompliant[ , .(geographicAreaM49_fi, measuredItemFaostat_L2,
timePointYears, availability)]
setkey(secondarynegCompliant)
secondarynegCompliant <- unique(secondarynegCompliant)
setnames(secondarynegCompliant,
c('geographicAreaM49_fi', 'timePointYears',
'measuredItemFaostat_L2'),
c('geographicaream49_fi', 'timepointyears',
'measureditemfaostat_l2'))
changeset <- Changeset('imbalance_tab')
AddInsertions(changeset, secondarynegCompliant)
Finalise(changeset)
if(nrow(secondaryneg0) > 0){
countriessecneg <- unique(secondaryneg0[ , .(geographicAreaM49_fi, measuredItemFaostat_L2, timePointYears)])
msgg2 <- apply(countriessecneg,1, paste0, collapse = ', ')
msg2email5 <- paste0('There are negative secondary availabilities. Check (country code, product code, year): : ',
paste0(msgg2, collapse = " and "))
message(msg2email5)
}
msg2email5 <- ifelse(nrow(secondaryneg0) > 0, msg2email5, "")
# Get meals codes
mealCodes <- GetCodeList("FisheriesCommodities",
"fi_sua_balanced_validated",
"measuredItemFaostat_L2")[ grepl('meals', description)]$code
if(any(secondaryneg0$measuredItemFaostat_L2 %in% mealCodes)){
mealsUnbal <- secondaryneg0[measuredItemFaostat_L2 %in% mealCodes]
message('Unbalance for meal products!')
secondaryneg <- secondaryneg0[!measuredItemFaostat_L2 %in% mealCodes]
} else {
secondaryneg <- secondaryneg0
}
rouMeals <- copy(secondaryneg0[measuredItemFaostat_L2 %in% mealCodes])
rouMeals[ , c('measuredElementSuaFbs',
'Value',
'flagObservationStatus',
'flagMethod', 'sign') := list('5166', availability,
'I', 'i', -1)]
setkey(rouMeals)
rouMeals <- unique(rouMeals)
# secondaryneg is secondary imbalances without meals
if(nrow(secondaryneg) > 0){
# Make sure all production (5510) values have been imputed
icsneg <- unique(secondaryneg$measuredItemFaostat_L2)
setkey(secondaryneg, geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2, availability)
prod2add <- unique(secondaryneg[ , .(geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2, availability) ])
# add production element with NA values and flags then estimate as in Francesca code with estimation flags
prod2add[ , ':=' (measuredElementSuaFbs = '5510', Value = - availability,
flagObservationStatus = as.factor('I'), flagMethod = 'i', sign = 1)]
# SUA with all production values
SUAwithProdupd <- merge(secondaryneg, prod2add, by = c('geographicAreaM49_fi',
'timePointYears',
'measuredItemFaostat_L2',
'availability',
'measuredElementSuaFbs'),
suffixes = c('', '_added'), all = TRUE)
SUAwithProdupd$sign_added <- as.integer(SUAwithProdupd$sign_added)
# add production to delete negative availability
SUAwithProdupd[measuredElementSuaFbs == '5510' , c("Value", "sign",
"flagObservationStatus",
"flagMethod") := list(ifelse(is.na(Value), Value_added,
Value+Value_added),
sign_added,
flagObservationStatus_added,
flagMethod_added)]
SUAcomplement <- SUAexpanded[!secondaryneg, on = names(secondaryneg)]
SUAcomplement <- rbind(SUAcomplement, rouMeals)
# Putting together values with negative and positive availability which had been separated before
SUAwithProd <- rbind(SUAwithProdupd[ , .(geographicAreaM49_fi, timePointYears,
measuredItemFaostat_L2, availability,
measuredElementSuaFbs, Value,
flagObservationStatus, flagMethod, sign)],
SUAcomplement)
} else {
SUAwithProd <- SUAexpanded
# SUAwithProd[ , sign := NULL ]
}
# Recalculate availability after adjustments
SUAwithProd[, availability := sum(Value * sign, na.rm = TRUE),
by = list(geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2)]
SUAwithProd[ , sign := NULL]
# Add input value if present
KeySUAinput <- DatasetKey(domain = "Fisheries Commodities", dataset = "fi_sua_balanced_validated", # TO SUBSTITUTE WITH 'fi_sua_balanced_validated'
# and erase the /10000 line
dimensions = list(
geographicAreaM49_fi = Dimension(name = "geographicAreaM49_fi", keys = sessionCountry),
measuredItemFaostat_L2 = Dimension(name = "measuredItemFaostat_L2", keys = GetCodeList("FisheriesCommodities", "fi_sua_balanced_validated","measuredItemFaostat_L2" )[,code]),
measuredElementSuaFbs = Dimension(name = "measuredElementSuaFbs", keys = c('5510', '5141', '5423')), # GetCodeList("FisheriesCommodities", "fi_sua_balanced_validated","measuredElementSuaFbs" )[,code]),
timePointYears = Dimension(name = "timePointYears", keys = as.character((minyear -1):maxyear))))
SUAstored <- GetData(KeySUAinput)
SUAvalEr <- SUAstored[measuredElementSuaFbs == '5423' ]
# SUAvalEr <- SUAvalEr[ , Value := Value/10000] # To erase when substituting _validated with _validated
# SUAstoredInput <- SUAstored[measuredElementSuaFbs == '5302' & Value != 0]
# SUAstoredInput <- merge(SUAstoredInput, unique(SUAwithProd[ , .(geographicAreaM49_fi,
# timePointYears,
# measuredItemFaostat_L2,
# availability)]),
# by = c('geographicAreaM49_fi',
# 'timePointYears',
# 'measuredItemFaostat_L2'))
# setkey(SUAstoredInput)
# SUAstoredInput <- unique(SUAstoredInput)
SUAwithInput <- SUAwithProd #rbind(SUAwithProd, SUAstoredInput)
setkey(SUAwithInput)
SUAwithInput <- unique(SUAwithInput)
# Calculate ratio of food to assign to primary elements
SUAvalProd <- SUAstored[measuredItemFaostat_L2 %in% primary & measuredElementSuaFbs == '5510' & timePointYears == as.character(max(as.numeric(yearVals)) - 1)]
SUAvalFood <- SUAstored[measuredItemFaostat_L2 %in% primary & measuredElementSuaFbs == '5141' & timePointYears == as.character(max(as.numeric(yearVals)) - 1)]
foodShare <- merge(SUAvalProd, SUAvalFood, by = c('geographicAreaM49_fi',
'measuredItemFaostat_L2',
'timePointYears'),
suffixes = c('Prod', 'Food'), all = TRUE)
foodShare[ , perc := (ValueFood/ValueProd), by = c('geographicAreaM49_fi',
'measuredItemFaostat_L2',
'timePointYears')]
# At least 3% is dedicated to Food
foodShare[ , perc := ifelse(perc < 0.03 | is.na(perc), 0.03, perc)]
balancingElements <- ReadDatatable('balancing_elements')
setnames(balancingElements, names(balancingElements), c("geographicAreaM49_fi",
"measuredItemFaostat_L2",
"measuredElementSuaFbs",
"start_year", "end_year", "share"))
# Pull ICS whose balancing element is food for the country
onlyfood <- balancingElements[!measuredItemFaostat_L2 %in% primary & geographicAreaM49_fi %in% sessionCountry & measuredElementSuaFbs == '5141']
# For secondary groups at least 3% is dedicated to Food
onlyfood[ , perc := 0.03]
SUAvalFoodSec <- onlyfood[ , .(geographicAreaM49_fi, measuredItemFaostat_L2, perc)]
# Take primary food
foodShare2apply1 <- foodShare[!is.na(perc) & perc != Inf & perc <= 1 ]
foodShare2apply1 <- foodShare2apply1[ , .(geographicAreaM49_fi, measuredItemFaostat_L2, perc)]
# Put together primary and secondary food
foodShare2apply <- rbind(foodShare2apply1, SUAvalFoodSec)
# -- ER & input calc ----
message("fi_SUA-FBS: Calculating extraction rates")
tree <- ReadDatatable('fi_commodity_tree')
treePrim <- copy(tree)
treePrim <- treePrim[parent %in% primary ]
SUAwithEr <- eRcomputation(data = SUAwithInput, tree = treePrim,
years = yearVals, oldEr = SUAvalEr)
message("fi_SUA-FBS: Calculating input element")
# If input available then eR is calculated dividing prod/input => input = prod/eR
# so the result is the same, input are all calculated
SUAinput <- inputComputation(data = SUAwithEr)
newTree <- merge(tree, unique(SUAinput[ measuredElementSuaFbs == '5423' & !is.na(Value),
.(geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2, Value)]),
by.x = 'child', by.y = 'measuredItemFaostat_L2', all.x = TRUE, allow.cartesian = TRUE)
newTree[ , extraction_rate := Value ]
newTree[ , Value:= NULL]
#-- Recalculate availability using food imputation for primary products ----
food1 <- merge(SUAinput[availability > 0 & measuredElementSuaFbs == '5510'],
foodShare2apply,
by = c('geographicAreaM49_fi', 'measuredItemFaostat_L2'),
all.x = TRUE )
food1[ , c('measuredElementSuaFbs',
'flagObservationStatus',
'flagMethod'):= list('5141', 'E', 'b')]
food2 <- food1[!is.na(Value) & !is.na(perc), ValueFood := Value*perc]
food2 <- food2[ , c('Value','perc') := NULL]
food2 <- food2[!is.na(ValueFood)]
# If the required percentage is available it is assigned
# Otherwise the food processing calculation will assign it
# according to availability
food <- food2[ availability < ValueFood, ValueFood := availability]
food <- food[ , ValueFood := ValueFood * 0.95]
setnames(food, 'ValueFood', 'Value')
SUAFood <- rbind(SUAinput, food)
SUAFood <- merge(SUAFood,
elementSignTable[ , .(measuredElementSuaFbs, sign)],
by = "measuredElementSuaFbs",
all.x = TRUE)
SUAFood[, availability := sum(Value*sign, na.rm = TRUE),
by = list(geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2)]
SUAFood[ , sign := NULL ]
# --Food processing ----
message("fi_SUA-FBS: Calculating food processing")
FPdata_alltest <- foodProcessingComputation(SUAinput = SUAFood, treeNewER = newTree, primary = primary)
FPdatatest <- FPdata_alltest$result
FPdatatest <- FPdatatest[Value != 0]
FPproblemstest <- list(primary = data.table(),
secondaryTot = data.table(),
secondary = data.table(),
tertiary = data.table(),
quaternary = data.table(),
NotCovered = data.table())
FPproblemstest <- FPdata_alltest$problems
# Change of input to calculate FP for problematic data ----
# Get problematic groups
if(any(sapply(FPproblemstest, nrow)>0)){
# if(length(FPproblemstest) > 1 & nrow(FPproblemstest$NotCovered) > 0){
avoidProblems <- rbindlist(FPproblemstest, fill = TRUE)
avoidProblems <- unique(avoidProblems[ , .(geographicAreaM49_fi,
timePointYears,
parent_primary)])
# Parent-child tree
treeneeded0 <- data.table(parent = unique(avoidProblems$parent_primary),
child = unique(avoidProblems$parent_primary))
treeneeded <- unique(newTree[parent %in% unique(avoidProblems$parent_primary), .(parent, child) ])
treeneeded <- rbind(treeneeded, treeneeded0)
# Get complete structure of problematic groups
avoidProblems2 <- merge(avoidProblems, treeneeded,
by.x = 'parent_primary',
by.y = 'parent', all.x = TRUE,
allow.cartesian = TRUE)
setnames(avoidProblems2, 'child', 'measuredItemFaostat_L2')
# The problematic groups with food are recalculated without food
subst <- merge(SUAinput, avoidProblems2[ , .(geographicAreaM49_fi,
timePointYears,
measuredItemFaostat_L2)],
by = c("geographicAreaM49_fi",
"timePointYears",
"measuredItemFaostat_L2"))
# The part that was okay with food is recalculated without the problematic part
cancel <- merge(SUAFood, avoidProblems2[ , .(geographicAreaM49_fi,
timePointYears,
measuredItemFaostat_L2)],
by = c("geographicAreaM49_fi",
"timePointYears",
"measuredItemFaostat_L2"))
SUAFoodcan <- SUAFood[!cancel, on = names(SUAFood)]
if(nrow(SUAFoodcan) > 0){
FPdata_all1 <- foodProcessingComputation(SUAinput = SUAFoodcan, treeNewER = newTree, primary = primary)
FPdata1 <- FPdata_all1$result
FPdata1 <- FPdata1[Value != 0]
FPproblems1 <- list(primary = data.table(),
secondaryTot = data.table(),
secondary = data.table(),
tertiary = data.table(),
quaternary = data.table(),
NotCovered = data.table())
FPproblems1 <- FPdata_all1$problems
} else {
FPdata1 <- data.table()
FPproblems1 <- list(primary = data.table(),
secondaryTot = data.table(),
secondary = data.table(),
tertiary = data.table(),
quaternary = data.table(),
NotCovered = data.table())
}
# FP calculated for problematic elements
FPdata_all2 <- foodProcessingComputation(SUAinput = subst,
treeNewER = newTree,
primary = primary)
FPdata2 <- FPdata_all2$result
FPdata2 <- FPdata2[Value != 0]
FPproblems2 <- list(primary = data.table(),
secondaryTot = data.table(),
secondary = data.table(),
tertiary = data.table(),
quaternary = data.table(),
NotCovered = data.table())
FPproblems2 <- FPdata_all2$problems
# Put together results and dataset to consider
FPdata <- rbind(FPdata1, FPdata2)
FPproblems <- FPproblems2
SUAnoFP <- rbind(SUAFoodcan, subst)
} else {SUAnoFP <- SUAFood
FPdata <- FPdatatest
FPproblems <- list(primary = data.table(),
secondaryTot = data.table(),
secondary = data.table(),
tertiary = data.table(),
quaternary = data.table(),
NotCovered = data.table())}
message('Food re-processing okay')
############
FPdata <- FPdata[ , availability := NULL ]
FPdata[ , c("flagObservationStatus", "flagMethod") := list("E", "i")]
SUAnoFP[ , availability := NULL] # SUAFood[ , availability := NULL]
SUAunbal <- rbind(SUAnoFP[!is.na(Value), ], FPdata)
SUAunbal$flagObservationStatus <- as.character(SUAunbal$flagObservationStatus)
if(is.list(FPproblems$NotCovered) & nrow(FPproblems$NotCovered) > 0){
uncovered <- copy(FPproblems$NotCovered)
uncovered[ , measuredElementSuaFbs := '5023']
setnames(uncovered, c('parent_primary', 'UncoveredQuantity'),
c('measuredItemFaostat_L2', 'Value'))
rouUncovered <-copy(uncovered)
rouUncovered[ , measuredElementSuaFbs := '5166']
rouUncovered[ , Value := -Value]
uncoveredAdjusted <- rbind(uncovered, rouUncovered)
uncoveredAdjusted[ , c("flagObservationStatus", "flagMethod") := list("E", "i")]
uncoveredAdjusted[ measuredElementSuaFbs == '5166' , c("flagObservationStatus", "flagMethod") := list("I", "i")]
} else {
uncoveredAdjusted <- data.table()
}
SUAunbal <- rbind(SUAunbal, uncoveredAdjusted)
SUAunbal$flagObservationStatus <- factor(SUAunbal$flagObservationStatus, levels = c('M', 'O', 'N', '', 'X', 'T', 'E', 'I'), ordered = TRUE)
SUAunbal <- SUAunbal[ , list(Value = sum(Value, na.rm = TRUE),
flagObservationStatus = max(flagObservationStatus),
flagMethod = flagMethodAss(max(flagObservationStatus))),
by = c("geographicAreaM49_fi", "timePointYears",
"measuredItemFaostat_L2", "measuredElementSuaFbs")]
setkey(SUAunbal)
SUAunbal <- unique(SUAunbal)
# -- Balancing ----
SUAunbal <- merge(SUAunbal, elementSignTable[, .(measuredElementSuaFbs, sign)], by = "measuredElementSuaFbs", all.x = TRUE)
if(any(is.na(SUAunbal$sign))){
stop('There is an element in the SUA not included in the availability calculation.')
}
# Calculate imbalance
SUAunbal[ , availability := sum(Value * sign, na.rm = TRUE),
by = list(geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2)]
SUAunbal[ , availability := round(availability, 6)]
message('fi_SUA-FBS: Pulling balancing elements')
currentYear <- as.numeric(gsub("\\-[0-9]*", "", Sys.Date()))
balancingElements[ end_year == "LAST"]$end_year <- as.character(currentYear)
balancingValues <- unique(SUAunbal[ , .(geographicAreaM49_fi, timePointYears , measuredItemFaostat_L2, availability) ])
# assign imbalance to balancing elements
balancing <- merge(balancingElements,
balancingValues, by = c("geographicAreaM49_fi","measuredItemFaostat_L2"), # [availability != 0]
all.y = TRUE)
setnames(balancing, c("availability"), c("Value"))
# Controll all imbalances have a balancing element
if(any(is.na(balancing$measuredElementSuaFbs)) & any(balancing[is.na(measuredElementSuaFbs)]$availability != 0)){
message('Balancing elements missing!')
message(balancing[is.na(measuredElementSuaFbs) & availability != 0])
}
balancing2merge <- balancing[ as.numeric(timePointYears) >= as.numeric(start_year) & as.numeric(timePointYears) <= as.numeric(end_year), Value := Value*share]
balancing2merge[ , c('start_year', 'end_year', 'share') := NULL]
balancing2merge[ , c('flagObservationStatus', 'flagMethod') := list('E','b')]
# Balancing cannot be negative
balancingproblems <- balancing2merge[round(Value,6) < 0,]
# Store balancing problems
balancingproblems_store <- ReadDatatable('balancing_problems_tab', readOnly = FALSE)
if(nrow(balancingproblems_store[ geographicaream49_fi %in% sessionCountry & timepointyears %in% yearVals, ]) > 0){
changeset <- Changeset('balancing_problems_tab')
AddDeletions(changeset, balancingproblems_store[ geographicaream49_fi %in% sessionCountry & timepointyears %in% yearVals, ])
Finalise(changeset)
}
# Add new imbalances
if(is.list(FPproblems$NotCovered) & length(FPproblems$NotCovered) > 0){
toupload <- copy(FPproblems$NotCovered)
toupload[ , measuredElementSuaFbs := '5023']
setnames(toupload, c('parent_primary', 'UncoveredQuantity'),
c('measuredItemFaostat_L2', 'Value'))
balancingproblemsCompliant <- rbind(toupload, balancingproblems[ , .(geographicAreaM49_fi, measuredItemFaostat_L2,
timePointYears, measuredElementSuaFbs, Value)])
} else {
balancingproblemsCompliant <- rbind(balancingproblems[ , .(geographicAreaM49_fi, measuredItemFaostat_L2,
timePointYears, measuredElementSuaFbs, Value)])
}
if(nrow(balancingproblemsCompliant) > 0){
setkey(balancingproblemsCompliant)
balancingproblemsCompliant <- unique(balancingproblemsCompliant)
setnames(balancingproblemsCompliant,
c('geographicAreaM49_fi', 'timePointYears',
'measuredItemFaostat_L2', 'measuredElementSuaFbs', 'Value'),
c('geographicaream49_fi', 'timepointyears',
'measureditemfaostat_l2', 'measuredelementsuafbs', 'value'))
changeset <- Changeset('balancing_problems_tab')
AddInsertions(changeset, balancingproblemsCompliant)
Finalise(changeset)
}
# if negative balancing element then balance imbalance with 5166
balancingimb <- copy(balancing2merge[Value < 0])
balancingimb <- balancingimb[Value < 0, c('measuredElementSuaFbs',
'flagObservationStatus',
'flagMethod') := list('5166', 'I', 'i')]
balancingimb[ , Value := Value]
balancingTot <- rbind(balancing2merge[Value > 0], balancingimb)
SUAbal <- merge(SUAunbal[ , .(geographicAreaM49_fi, timePointYears ,
measuredItemFaostat_L2, measuredElementSuaFbs,
Value, flagObservationStatus, flagMethod)],
balancingTot,
by = c('geographicAreaM49_fi', 'timePointYears',
'measuredItemFaostat_L2', 'measuredElementSuaFbs'),
suffixes = c('','Bal'),
all = TRUE)
SUAbal[is.na(ValueBal), ValueBal := 0 ]
SUAbal[is.na(Value), Value := 0 ]
SUAbal[ , Value := Value + ValueBal ]
SUAbal$flagObservationStatus <- as.character(SUAbal$flagObservationStatus)
SUAbal[is.na(flagObservationStatus) , flagObservationStatus := 'E']
SUAbal[is.na(flagMethod) , flagMethod := 'b']
SUAbal <- SUAbal[ , c('ValueBal',
'flagObservationStatusBal',
'flagMethodBal') := NULL]
# Re-calculate availability
SUAbalAvail <- merge(SUAbal, elementSignTable[, .(measuredElementSuaFbs, sign)], by = "measuredElementSuaFbs", all.x = TRUE)
SUAbalAvail[, availability := sum(Value * sign, na.rm = TRUE),
by = list(geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2)]
if(any(round(SUAbalAvail$availability) < 0)){
message("fi_SUA-FBS: Negative availability for some products.")
msg2email7 <- paste0('Negative availability for products:',
paste0(unique(SUAbalAvail[round(availability) != 0, ]$measuredItemFaostat_L2), collapse = ", "),
'for country', paste0(unique(SUAbalAvail[round(availability) != 0, ]$geographicAreaM49_fi), collapse = ", "))
}
msg2email7 <- ifelse(any(round(SUAbalAvail$availability) < 0), msg2email7, "")
SUAbalAvail[, c("sign", "availability"):=NULL]
# -- SUA with nutrient ----
# Read NutrientFactors
nutrientFactors <- ReadDatatable("fishery_nutrient")
nutrientFactors$calories <- as.numeric(nutrientFactors$calories)
nutrientFactors$proteins <- as.numeric(nutrientFactors$proteins)
nutrientFactors$fats <- as.numeric(nutrientFactors$fats)
nutrientFactors[is.na(proteins), proteins := 0]
SUA_with_nutrient <- merge(SUAbalAvail, nutrientFactors, by.x = "measuredItemFaostat_L2", by.y = "ics", all.x = TRUE)
SUA_with_nutrient[measuredElementSuaFbs=="5141", calories:=Value*calories/100]
SUA_with_nutrient[measuredElementSuaFbs=="5141", proteins:=Value*proteins/100]
SUA_with_nutrient[measuredElementSuaFbs=="5141", fats:=Value*fats/100]
SUA_with_nutrient[measuredElementSuaFbs!="5141",`:=`(c("calories", "proteins", "fats"),list(0,0,0) )]
# Get "calories", "proteins" and "fats" and make them in the dataset format
SUAnutrients <- melt.data.table(SUA_with_nutrient[measuredElementSuaFbs=="5141", ],
id.vars = c('geographicAreaM49_fi', 'measuredItemFaostat_L2', 'timePointYears'),
measure.vars = c('calories', 'proteins','fats'),
variable.name = 'measuredElementSuaFbs', value.name = 'Value')
SUAnutrients$measuredElementSuaFbs <- as.character(SUAnutrients$measuredElementSuaFbs)
SUAnutrients$measuredElementSuaFbs <- ifelse(SUAnutrients$measuredElementSuaFbs == 'calories', '261',
ifelse(SUAnutrients$measuredElementSuaFbs == 'proteins', '271',
ifelse(SUAnutrients$measuredElementSuaFbs == 'fats', '281', SUAnutrients$measuredElementSuaFbs)))
SUAnutrients[ , c('flagObservationStatus', 'flagMethod') := list('E','i')]
SUAnutrients <- unique(SUAnutrients)
foodOnly <- SUA_with_nutrient[measuredElementSuaFbs=="5141", .(measuredItemFaostat_L2, measuredElementSuaFbs,
geographicAreaM49_fi, timePointYears, Value,
flagObservationStatus, flagMethod)]
SUAnutrients <- rbind(SUAnutrients, foodOnly)
# Get population data
elemKeys <- "511"
keyPop <- DatasetKey(domain = "population", dataset = "population_unpd", dimensions = list(
geographicAreaM49 = Dimension(name = "geographicAreaM49", keys = sessionCountry),
measuredElement = Dimension(name = "measuredElement", keys = elemKeys),
timePointYears = Dimension(name = "timePointYears", keys = yearVals)
))
popSWS <- GetData(keyPop)
setnames(popSWS,c("geographicAreaM49", "measuredElement"),c("geographicAreaM49_fi", "measuredElementSuaFbs"))
sourceMetaData0 <- GetMetadata(keyPop)
sourceMetaData <- sourceMetaData0[grepl("WPP", Metadata_Value),]
sourceMetaData <- sourceMetaData[Metadata == 'GENERAL', ]
setnames(sourceMetaData, c("geographicAreaM49", "measuredElement"),c("geographicAreaM49_fi", "measuredElementSuaFbs"))
# Calculate per capita elements
SUAnutrientCapita <- merge(SUAnutrients, popSWS, by=c("geographicAreaM49_fi","timePointYears"), suffixes = c("","_pop"))
SUAnutrientCapita[measuredElementSuaFbs !="5141" , Value := (Value*1000)/(Value_pop*365)]
SUAnutrientCapita[measuredElementSuaFbs =="5141" , Value := Value/Value_pop]
SUAnutrientCapita <- SUAnutrientCapita[ , .(geographicAreaM49_fi,
timePointYears,
measuredItemFaostat_L2,
measuredElementSuaFbs,
Value, flagObservationStatus,
flagMethod)]
SUAnutrientCapita[measuredElementSuaFbs=="261",measuredElementSuaFbs:="264"]
SUAnutrientCapita[measuredElementSuaFbs=="281",measuredElementSuaFbs:="284"]
SUAnutrientCapita[measuredElementSuaFbs=="271",measuredElementSuaFbs:="274"]
SUAnutrientCapita[measuredElementSuaFbs=="5141",measuredElementSuaFbs:="645"]
SUA_with_nutrient[ , c('calories', 'proteins','fats') := NULL]
# bind SUA with "calories", "proteins" and "fats" elements
SUAallNutr <- rbind(SUAnutrients[measuredElementSuaFbs!="5141"], SUAnutrientCapita)
SUANoPop <- rbind(SUA_with_nutrient, SUAallNutr)
Pop2include <- merge(unique(SUANoPop[ , .(measuredItemFaostat_L2,
geographicAreaM49_fi,
timePointYears)]), popSWS, by = c('geographicAreaM49_fi',
'timePointYears'))
# Metadata
Metadata2include <- merge(unique(SUANoPop[ , .(measuredItemFaostat_L2,
geographicAreaM49_fi,
timePointYears)]), sourceMetaData, by = c('geographicAreaM49_fi',
'timePointYears'),
allow.cartesian = TRUE)
# add population
SUAwithPop <- rbind(SUANoPop, Pop2include)
# add values
SUAwithValues <- rbind(SUAwithPop, SUAValues)
SUA2save <- SUAwithValues[!is.na(Value)]
# -- Saving SUA balanced ----
message("fi_SUA-FBS: Saving SUA balanced data")
CONFIG2 <- GetDatasetConfig(sessionKey_suabal@domain, sessionKey_suabal@dataset)
stats2 <- SaveData(domain = CONFIG2$domain,
dataset = CONFIG2$dataset,
data = SUA2save[measuredElementSuaFbs!= "645" ],
metadata = Metadata2include, waitTimeout = Inf)
msg2email8 <- paste0("SUA food processing, balancing and nutrient inclusion processes completed successfully! ",
stats2$inserted, " observations written, ",
stats2$ignored, " weren't updated, ",
stats2$discarded, " had problems.")
# -- Standardisation & FBS ----
# get all conversion factors (or extration rates) from commodity tree
message('Get commodity tree')
tree <- ReadDatatable('fi_commodity_tree')
extrRates <- unique(SUA2save[ measuredElementSuaFbs == '5423', .(measuredItemFaostat_L2, geographicAreaM49_fi, timePointYears, Value)])
compareEr <- merge(unique(tree[parent %in% primary , .(child, extraction_rate)]), extrRates, by.x = 'child', by.y = 'measuredItemFaostat_L2', all.y = TRUE)
compareEr[is.na(Value), Value := extraction_rate]
updatedEr <- compareEr[ , .(child, Value, geographicAreaM49_fi, timePointYears)]
updatedtree <- merge(unique(tree[parent %in% primary , .(parent, child, weight)]), updatedEr, by= 'child', all.y = TRUE, allow.cartesian = TRUE)
setkey(updatedtree)
convFact <- unique(updatedtree[weight == TRUE & !is.na(Value) , .(geographicAreaM49_fi, timePointYears, parent, child, Value)])
# For primary product add conversion factor equal 1
primaryTree1 <- data.table(geographicAreaM49_fi = rep(unique(SUA2save$geographicAreaM49_fi), each = length(unique(SUA2save$timePointYears))),
timePointYears = rep(unique(SUA2save$timePointYears), length(unique(SUA2save$geographicAreaM49_fi))) )
primaryTree2 <- data.table(geographicAreaM49_fi = rep(unique(SUA2save$geographicAreaM49_fi), each = length(unique(primary))), parent = primary)
primaryTree <- merge(primaryTree1, primaryTree2, by = 'geographicAreaM49_fi', allow.cartesian = TRUE)
primaryTree[ , `:=` (child = parent, Value = 1)]
convFact <- rbind(convFact, primaryTree)
setnames(convFact, new = 'extraction_rate', old = 'Value')
# SUA with standardized element, no zero weight elements
SUA2save <- SUA2save[!measuredElementSuaFbs %in% ValueElements]
SUAstand_prep <- merge(SUA2save, convFact, by.x = c('geographicAreaM49_fi', 'timePointYears', 'measuredItemFaostat_L2'),
by.y = c('geographicAreaM49_fi', 'timePointYears', 'child'))
SUAstand_prep <- SUAstand_prep[!is.na(Value)]
setkey(SUAstand_prep)
SUAstand_prep <- unique(SUAstand_prep)
# Standardised value is Value/eR except from input values which are already in primary equivalent
SUAstand_prep[! measuredElementSuaFbs %in% c('5302', '261', '264', '271', '274', '281', '284', '511'), Value_stand := Value/extraction_rate]
SUAstand_prep[measuredElementSuaFbs %in% c('5302', '261', '264', '271', '274', '281', '284', '511'), Value_stand := Value]
# take only all primary elements and for secondary exclude production and input
SUAstand <- rbind(SUAstand_prep[measuredItemFaostat_L2 %in% primary, ],
SUAstand_prep[!measuredElementSuaFbs %in% c('5510', '5302') & !measuredItemFaostat_L2 %in% primary, ])
# -- FAOSTAT standardization ----
# Aggregate SUA by parent meals included for FAOSTAT
SUAstandAggr0 <- SUAstand[ , .(measuredElementSuaFbs, geographicAreaM49_fi, timePointYears,
flagObservationStatus, flagMethod, parent, Value_stand)]
# SUAstandAggr0$flagObservationStatus <- factor(SUAstandAggr0$flagObservationStatus, levels = c('M', 'O', 'N', '', 'X', 'T', 'E', 'I'), ordered = TRUE)
SUAstandAggr1 <- SUAstandAggr0[measuredElementSuaFbs != '511' , list(Value = sum(Value_stand, na.rm = TRUE),
flagObservationStatusAggr = 'I',
flagMethodAggr = 's'),
by = c("measuredElementSuaFbs", "geographicAreaM49_fi", "timePointYears", "parent")]
setnames(SUAstandAggr1, c('parent', 'flagObservationStatusAggr', 'flagMethodAggr'),
c('measuredItemFaostat_L2', 'flagObservationStatus', 'flagMethod'))
Pop2SUAaggr <- SUAstandAggr0[measuredElementSuaFbs == '511']
setkey(Pop2SUAaggr)
Pop2SUAaggr <- unique(Pop2SUAaggr)
setnames(Pop2SUAaggr, c('Value_stand', 'parent'), c('Value', 'measuredItemFaostat_L2'))
SUAstandAggr <- rbind(SUAstandAggr1, Pop2SUAaggr)
IcsGroups <- unique(SUAstandAggr[ , .(geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2)])
faostat_pop2merge <- merge(IcsGroups, popSWS, by=c("geographicAreaM49_fi","timePointYears"), all = TRUE)
faostatfbsPOP <- rbind(SUAstandAggr, faostat_pop2merge)
# map for FBS groups
sua_fbs_mapping <- ReadDatatable('faostatl2_to_faostatl1')
setnames(sua_fbs_mapping, 'measureditemfaostat_l2', 'measuredItemFaostat_L2' )
sua_fbs_mapping[ , label := NULL]
fbsFaostatL1faostat <- merge(faostatfbsPOP, sua_fbs_mapping, by = "measuredItemFaostat_L2")
fbsFaostatL1faostat[ , measuredItemFaostat_L2 := NULL]
setnames(fbsFaostatL1faostat, "fbs", "measuredItemFaostat_L2")
#-- FAOSTAT FBS standardization ----
message("Starting Faostat standardization")
faostatGroups <- ReadDatatable('fi_faostat_standardization_element')
setnames(faostatGroups, c('measuredelementsuafbs', 'measuredelementfaostat'), c('measuredElementSuaFbs', 'measuredElementFaostat'))
FBSfaostat0 <- merge(fbsFaostatL1faostat[!measuredElementSuaFbs %in% c('261', '271', '281')], # c('261', '271', '281') elements not in FBS
faostatGroups, by = "measuredElementSuaFbs")
FBSfaostat1 <- FBSfaostat0[measuredElementFaostat != '511' , list(Value = sum(Value, na.rm = TRUE),
flagObservationStatus = 'I',
flagMethod = 's'), by = c("geographicAreaM49_fi",
"timePointYears", "measuredItemFaostat_L2",
"faostat", "measuredElementFaostat")]
FBSfaostat <- rbind(FBSfaostat1, FBSfaostat0[measuredElementFaostat == '511', -'measuredElementSuaFbs', with = FALSE])
setnames(FBSfaostat, c("faostat", "measuredElementFaostat"), c("element_description", "measuredElementSuaFbs"))
faostatFBS2save <- FBSfaostat[ , .(geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2,
measuredElementSuaFbs, Value, flagObservationStatus, flagMethod)]
faostatFBS2save <- faostatFBS2save[!is.na(Value)]
message("fi_SUA-FBS: Saving FAOSTAT standardized data")
CONFIG4 <- GetDatasetConfig(sessionKey_fbsFaostat@domain, sessionKey_fbsFaostat@dataset)
statsFaostat <- SaveData(domain = CONFIG4$domain,
dataset = CONFIG4$dataset,
data = faostatFBS2save, waitTimeout = Inf)
msg2email10 <- paste0("Standardization process completed successfully! ",
statsFaostat$inserted, " observations written, ",
statsFaostat$ignored, " weren't updated, ",
statsFaostat$discarded, " had problems.")
# -- FIAS ----
# Aggregate SUA by parent code take away meals
# SUA with elements and groups to aggregates
SUAstandAggrFias0 <- SUAstand[ !measuredItemFaostat_L2 %in% mealCodes , .(measuredElementSuaFbs, geographicAreaM49_fi, timePointYears,
flagObservationStatus, flagMethod, parent, Value_stand)]
# take only input element 5302 for meal products
mealsInput0 <- SUA2save[measuredElementSuaFbs == '5302' & measuredItemFaostat_L2 %in% mealCodes , .(measuredElementSuaFbs, geographicAreaM49_fi, timePointYears,
flagObservationStatus, flagMethod,
measuredItemFaostat_L2, Value)]
mealsInput <- merge(mealsInput0, unique(tree[parent %in% primary, .(parent, child)]),
by.x = 'measuredItemFaostat_L2', by.y = 'child', all.x = TRUE)
mealsInput[ , measuredItemFaostat_L2 := NULL]
setnames(mealsInput, c("parent"), c("measuredItemFaostat_L2"))
# SUAstandAggrFias0$flagObservationStatus <- factor(SUAstandAggrFias0$flagObservationStatus, levels = c('M', 'O', 'N', '', 'X', 'T', 'E', 'I'), ordered = TRUE)
SUAstandAggrFias1 <- SUAstandAggrFias0[measuredElementSuaFbs != '511' , list(Value = sum(Value_stand, na.rm = TRUE),
flagObservationStatusAggr = 'I',
flagMethodAggr = 's'), by = c("measuredElementSuaFbs", "geographicAreaM49_fi",
"timePointYears", "parent")]
setnames(SUAstandAggrFias1, c('parent', 'flagObservationStatusAggr', 'flagMethodAggr'),
c('measuredItemFaostat_L2', 'flagObservationStatus', 'flagMethod'))
Pop2SUAaggFias <- SUAstandAggrFias0[measuredElementSuaFbs == '511']
setnames(Pop2SUAaggFias,c('Value_stand', 'parent'), c('Value', 'measuredItemFaostat_L2'))
SUAstandAggrFias <- rbind(SUAstandAggrFias1, Pop2SUAaggFias)
fiasFbsTot <- rbind(SUAstandAggrFias, mealsInput)
IcsGroups <- unique(fiasFbsTot[ , .(geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2)])
# Introduce population data
pop2merge <- merge(popSWS, IcsGroups, by = c("geographicAreaM49_fi", "timePointYears"), all = TRUE)
fiasfbsPOP <- rbind(fiasFbsTot, pop2merge)
# map for FBS groups
sua_fbs_mapping <- ReadDatatable('faostatl2_to_faostatl1')
setnames(sua_fbs_mapping, 'measureditemfaostat_l2', 'measuredItemFaostat_L2' )
sua_fbs_mapping[ , label := NULL]
fbsFaostatL1 <- merge(fiasfbsPOP, sua_fbs_mapping, by = "measuredItemFaostat_L2")
fbsFaostatL1[ , measuredItemFaostat_L2 := NULL]
setnames(fbsFaostatL1, "fbs", "measuredItemFaostat_L2")
#-- FIAS FBS standardization ----
message("fi_SUA-FBS: Starting Fias standardization")
fiasGroups <- ReadDatatable('fi_fias_standardization_element')
setnames(fiasGroups, c('measuredelementsuafbs', 'measuredelementfias'), c('measuredElementSuaFbs', 'measuredElementFias'))
FBSfias0 <- merge(fbsFaostatL1[!measuredElementSuaFbs %in% c('261', '271', '281')],
fiasGroups, by = "measuredElementSuaFbs")
FBSfias1 <- FBSfias0[measuredElementFias != '511' , list(Value = sum(Value, na.rm = TRUE),
flagObservationStatus = 'I',
flagMethod = 's'), by = c("geographicAreaM49_fi",
"timePointYears", "measuredItemFaostat_L2",
"fias", "measuredElementFias")]
fiasPop <- FBSfias0[measuredElementFias == '511', -'measuredElementSuaFbs', with = FALSE]
setkey(fiasPop)
fiasPop <- unique(fiasPop)
FBSfias <- rbind(FBSfias1, fiasPop)
fiasFBS2save <- FBSfias[, .(geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2,
measuredElementFias, Value, flagObservationStatus, flagMethod)]
setnames(fiasFBS2save, "measuredElementFias", "measuredElementSuaFbs")
metadataGroups <- unique(fiasFBS2save[ , .(geographicAreaM49_fi, timePointYears, measuredItemFaostat_L2)])
Metadata2includeFias <- merge(sourceMetaData, metadataGroups, by = c("geographicAreaM49_fi", "timePointYears"),
all = TRUE, allow.cartesian = TRUE)
message("fi_SUA-FBS: Saving FIAS standardized data")
CONFIG3 <- GetDatasetConfig(sessionKey_fbsFias@domain, sessionKey_fbsFias@dataset)
statsFias <- SaveData(domain = CONFIG3$domain,
dataset = CONFIG3$dataset,
data = fiasFBS2save,
metadata = Metadata2includeFias,
waitTimeout = Inf)
msg2email9 <- paste0("Standardization process completed successfully! ",
statsFias$inserted, " observations written, ",
statsFias$ignored, " weren't updated, ",
statsFias$discarded, " had problems.")
R_SWS_SHARE_PATH <- Sys.getenv("R_SWS_SHARE_PATH")
length(FPproblems)
primfp <- ReadDatatable('fi_fp_imb_primary', readOnly = F)
secfp <- ReadDatatable('fi_fp_imb_sec', readOnly = F)
tertfp <- ReadDatatable('fi_fp_imb_ter', readOnly = F)
quatfp <- ReadDatatable('fi_fp_imb_quat', readOnly = F)
sectot <- ReadDatatable('fi_fp_imb_sec_tot', readOnly = F)
ncfp <- ReadDatatable('fi_fp_not_covered', readOnly = F)
chn1 <- Changeset('fi_fp_imb_primary')
chn2<- Changeset('fi_fp_imb_sec')
chn3 <- Changeset('fi_fp_imb_ter')
chn4 <- Changeset('fi_fp_imb_quat')
chn5 <- Changeset('fi_fp_imb_sec_tot')
chn6 <- Changeset('fi_fp_not_covered')
AddDeletions(chn1, primfp[geographicaream49_fi %in% sessionCountry])
Finalize(chn1)
AddDeletions(chn2, secfp[geographicaream49_fi %in% sessionCountry])
Finalize(chn2)
AddDeletions(chn3, tertfp[geographicaream49_fi %in% sessionCountry])
Finalize(chn3)
AddDeletions(chn4, quatfp[geographicaream49_fi %in% sessionCountry])
Finalize(chn4)
AddDeletions(chn5, sectot[geographicaream49_fi %in% sessionCountry])
Finalize(chn5)
AddDeletions(chn6, ncfp[geographicaream49_fi %in% sessionCountry])
Finalize(chn6)
chn11 <- Changeset('fi_fp_imb_primary')
chn22 <- Changeset('fi_fp_imb_sec')
chn33 <- Changeset('fi_fp_imb_ter')
chn44 <- Changeset('fi_fp_imb_quat')
chn55 <- Changeset('fi_fp_imb_sec_tot')
chn66 <- Changeset('fi_fp_not_covered')
if(exists('primary', where = FPproblems)){
if(nrow(FPproblems$primary)>0){
names(FPproblems$primary) <- tolower(names(FPproblems$primary))
AddInsertions(chn11, FPproblems$primary[geographicaream49_fi %in% sessionCountry])
Finalize(chn11)
}
}
if(exists('secondary', where = FPproblems)){
if(nrow(FPproblems$secondary)>0){
names(FPproblems$secondary) <- tolower(names(FPproblems$secondary))
AddInsertions(chn22, FPproblems$secondary[geographicaream49_fi %in% sessionCountry])
Finalize(chn22)
}
}
if(exists('tertiary', where = FPproblems)){
if(nrow(FPproblems$tertiary)>0){
names(FPproblems$tertiary) <- tolower(names(FPproblems$tertiary))
AddInsertions(chn33, FPproblems$tertiary[geographicaream49_fi %in% sessionCountry])
Finalize(chn33)
}
}
if(exists('quaternary', where = FPproblems)){
if(nrow(FPproblems$quaternary)>0){
names(FPproblems$quaternary) <- tolower(names(FPproblems$quaternary))
AddInsertions(chn44, FPproblems$quaternary[geographicaream49_fi %in% sessionCountry])
Finalize(chn44)
}
}
if(exists('secondaryTot', where = FPproblems)){
if(nrow(FPproblems$secondaryTot)>0){
names(FPproblems$secondaryTot) <- tolower(names(FPproblems$secondaryTot))
AddInsertions(chn55, FPproblems$secondaryTot[geographicaream49_fi %in% sessionCountry])
Finalize(chn55)
}
}
if(exists('NotCovered', where = FPproblems)){
if(nrow(FPproblems$NotCovered)>0){
names(FPproblems$NotCovered) <- tolower(names(FPproblems$NotCovered))
AddInsertions(chn66, FPproblems$NotCovered[geographicaream49_fi %in% sessionCountry])
Finalize(chn66)
}
}
# for( j in 1:length(sessionCountry)){
# # Create a FP file for each country
# fp1 <- lapply(FPproblems, function(x){ if(nrow(x) > 0){
# x[geographicAreaM49_fi == sessionCountry[j]]}})
#
# filename <- paste("FoodProcessingFeedback_", sessionCountry[j],".rds", sep = '')
# dirname <- file.path(R_SWS_SHARE_PATH, 'FisherySUAFBS')
# dir.create(dirname, showWarnings = FALSE, recursive = TRUE)
#
# saveRDS(object = fp1,
# file = file.path(R_SWS_SHARE_PATH, "FisherySUAFBS", filename))
# }
##-- send Email with notification of correct execution ----
emailtext <- paste("The plug-in has saved the data in your sessions. The plugin returned the following messages:",
msg2email1,
msg2email1CDB,
msg2email2,
# msg2email4,
# msg2email5,
# msg2email6,
msg2email7,
msg2email8,
msg2email9,
msg2email10,
# FPproblems
collapse = '\n')
primaryUnb <- data.table()
if(nrow(primaryneg) > 0 ){
primaryUnb <- countriesneg
}
secondaryUnb <- data.table()
if(nrow(secondaryneg) > 0){
secondaryUnb <- countriessecneg
}
from = "sws@fao.org"
to = swsContext.userEmail
subject = "fi_SUA-FBS plug-in has correctly run"
body = list(emailtext, mime_part(primaryUnb), mime_part(secondaryUnb))
sendmailR::sendmail(from = from, to = to, subject = subject, msg = body)
paste0("Email sent to ", swsContext.userEmail)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.