#' Read in new ISCN5 contributions
#'
#' Read in the two ISCN5 contributions
#'
#' @param dataDir string identifying the data directory
#' @param orginalFormat boolean flag whether or not to translate to keep in orginal data table.
#'
#' @import data.table
#'
#' @return a list of data tables
#' @export
#'
ISCN5 <- function(dataDir, orginalFormat = TRUE, newDataOnly=TRUE, verbose = FALSE){
CUFS2018 <- readCanandaUplandForest2018(dataDir=dataDir, verbose=verbose)
CPEAT2018 <- readCPEAT(dataDir=dataDir, verbose=verbose)
CPEAT2018$sample <- unique(CPEAT2018$sample)
ISRaD2019 <- readISRaD(dataDir=dataDir, verbose=verbose)
#plyr::ldply(CPEAT2018, function(xx){data.frame(header=names(xx))})
#write.csv(plyr::ldply(CPEAT2018, function(xx){data.frame(header=names(xx))}), file='data-raw/key_CPEAT2018.csv', row.names = FALSE)
key.ls <- makeKeys()
if(orginalFormat){
return(list(CUFS2018 = CUFS2018,
CPEAT2018 = CPEAT2018,
ISRaD2019 = ISRaD2019))
}else{
###Harmonize Canadian Upland Forest Soils#######
#Convert to depth from top units
CUFS2018$PROFILES[, layer_top := as.character(as.numeric(UPPER_HZN_LIMIT)-min(as.numeric(UPPER_HZN_LIMIT))), by=LOCATION_ID][,
layer_bottom := as.character(as.numeric(layer_top) + as.numeric(HZN_THICKNESS)), by=LOCATION_ID]
key.ls$CUFS2018 <- data.table::rbindlist(list(key.ls$CUFS2018,
data.table::data.table(table = 'PROFILES', header = c('layer_bottom', NA), variable = 'layer_bottom', type= c('value', 'unit'), entry = c(NA, 'cm')),
data.table::data.table(table = 'PROFILES', header = c('layer_top', NA), variable = 'layer_top', type= c('value', 'unit'), entry = c(NA, 'cm'))), fill = TRUE)
#Convert ISRaD to depth from top
ISRaD2019$layer[, lyr_bot:= as.character(as.numeric(lyr_bot)-min(as.numeric(lyr_top))),
by=pro_name][,
lyr_top := as.character(as.numeric(lyr_top)-min(as.numeric(lyr_top))),
by=pro_name]
#Reformat
ans1 <- formatLongTable(CUFS2018[c('PROFILES', 'REFERENCES', 'SITES')],
sourceKey = key.ls$CUFS2018, targetKey = key.ls$ISCN, verbose=verbose)
ans1$collection <- data.table::data.table(collection_name_id = 'Canadian Upland Forest Soils 2018',
variable = c('license', 'collection_citation'),
type = 'value',
entry = c(CUFS2018$licenseFull, CUFS2018$citation))
hardKeys <- key.ls$CUFS2018[!is.na(entry) & !is.na(variable), c('variable', 'type', 'entry')]
hardKeys[,collection_name_id := ans1$collection$collection_name_id[1]]
ans1$collection <- data.table::rbindlist(list(ans1$collection, hardKeys), fill = TRUE)
ans1$study$collection_name_id <- ans1$collection$collection_name_id[1]
ans1$profile$collection_name_id <- ans1$collection$collection_name_id[1]
ans1$layer$collection_name_id <- ans1$collection$collection_name_id[1]
######Harmonize CPEAT########
#Convert the units for the depth from m to cm and add a top to the layers
CPEAT2018$sample[,layer_bottom := as.character(as.numeric(`Depth [m]`)*100)][,layer_top := as.character(c(0, layer_bottom[-length(layer_bottom)])), by=Site_core]
#...update the key
key.ls$CPEAT <- data.table::rbindlist(list(key.ls$CPEAT[variable != 'layer_bottom', ],
data.table::data.table(table = 'sample', header = c('layer_bottom', NA), variable = 'layer_bottom', type= c('value', 'unit'), entry = c(NA, 'cm')),
data.table::data.table(table = 'sample', header = c('layer_top', NA), variable = 'layer_top', type= c('value', 'unit'), entry = c(NA, 'cm'))), fill = TRUE)
#Reformat to long
ans2 <- formatLongTable(CPEAT2018[c('site', 'sample', 'files')],
sourceKey = key.ls$CPEAT, targetKey = key.ls$ISCN, verbose=verbose)
ans2$collection <- data.table::data.table(collection_name_id = 'CPEAT 2018',
variable = c('license'),
type = 'value',
entry = 'Creative Commons Attribution 3.0 Unported (CC-BY-3.0)')
hardKeys <- key.ls$CPEAT[!is.na(entry) & !is.na(variable), c('variable', 'type', 'entry')]
hardKeys[,collection_name_id := ans2$collection$collection_name_id[1]]
ans2$collection <- data.table::rbindlist(list(ans2$collection, hardKeys), fill = TRUE)
ans2$study$collection_name_id <- ans2$collection$collection_name_id[1]
ans2$profile$collection_name_id <- ans2$collection$collection_name_id[1]
ans2$layer$collection_name_id <- ans2$collection$collection_name_id[1]
#####Harmonize ISRaD######
ans3 <- formatLongTable(data.ls = ISRaD2019, sourceKey = key.ls$ISRaD, targetKey = key.ls$ISCN,
verbose = verbose)
ans3$collection <- data.table::data.table(collection_name_id = 'ISRaD 2019',
variable = c('license'),
type = 'value',
entry = 'Creative Commons Attribution 3.0 Unported (CC-BY-3.0)')
hardKeys <- key.ls$ISRaD[!is.na(entry) & !is.na(variable), c('variable', 'type', 'entry')]
hardKeys[,collection_name_id := ans3$collection$collection_name_id[1]]
ans3$collection <- data.table::rbindlist(list(ans3$collection, hardKeys), fill = TRUE)
ans3$study$collection_name_id <- ans3$collection$collection_name_id[1]
ans3$profile$collection_name_id <- ans3$collection$collection_name_id[1]
ans3$layer$collection_name_id <- ans3$collection$collection_name_id[1]
#######Put everything together#####
ans <- list(collection = data.table::rbindlist(list(ans1$collection, ans2$collection, ans3$collection), fill=TRUE),
study = data.table::rbindlist(list(ans1$study, ans2$study, ans3$study), fill=TRUE),
profile = data.table::rbindlist(list(ans1$profile, ans2$profile, ans3$profile), fill=TRUE),
layer = data.table::rbindlist(list(ans1$layer, ans2$layer, ans3$layer), fill=TRUE))
if(newDataOnly){
return(ans)
}else{
ISCN <- ISCN4(dataDir = dataDir, onlyNewData = FALSE, verbose=verbose)
return(list(collection=data.table::rbindlist(list(ans$collection, ISCN$collection), fill=TRUE),
study = data.table::rbindlist(list(ans$study, ISCN$study), fill=TRUE),
profile = data.table::rbindlist(list(ans$profile, ISCN$profile), fill=TRUE),
layer = data.table::rbindlist(list(ans$layer, ISCN$layer), fill=TRUE),
key = key.ls))
}
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.