R/io.R
In edvinf/prepRECA: Prepares data for running R-ECA
Defines functions
parseDE
parseSD
parseFO
parseOS
parseVD
parseLE
parseSL
parseSS
parseSA
parseBV
parseRDBESexchangeH13
parseRDBESexchangeH5
flattenRDBES
exportCsv
parseLSS
#' parse DE line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param DEid id this line
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
#' @import stats
#' @import data.table
parseDE <- function(linevec, datalist, DEid, verbose=F){
if (verbose){
print(paste("Reading DE", DEid))
}
linevec[linevec==""]<-NA
dt <- data.table(
DEid=as.integer(DEid),
DErecType=as.character(linevec[[1]]),
DEsampScheme=as.character(linevec[[2]]),
DEyear=as.integer(linevec[[3]]),
DEstratum=as.character(linevec[[4]]),
DEhierarchyCor=as.character(linevec[[5]]),
DEhierarchy=as.character(linevec[[6]])
)
datalist$DE <- rbind(datalist$DE, dt)
return(datalist)
}
#' parse SD line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param SDid id this line
#' @param DEid id of parent DE table
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseSD <- function(linevec, datalist, SDid, DEid, verbose=F){
if (verbose){
print(paste("Reading SD", SDid))
}
linevec[linevec==""]<-NA
dt <- data.table(
SDid=as.integer(SDid),
DEid=as.integer(DEid),
SDrecType=as.character(linevec[[1]]),
SDctry=as.character(linevec[[2]]),
SDinst=as.character(linevec[[3]])
)
datalist$SD <- rbind(datalist$SD, dt)
return(datalist)
}
#' parse FO line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param FOid id this line
#' @param FTid id of any parent FT table
#' @param SDid id of any parent SD table
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseFO <- function(linevec, datalist, FOid, FTid=NA, SDid=NA, verbose=F){
if (verbose){
print(paste("Reading FO", FOid))
}
linevec[linevec==""]<-NA
dt <- data.table(FOid=as.integer(FOid),
FTid=as.integer(FTid),
SDid=as.integer(SDid),
FOrecType=as.character(linevec[[1]]),
FOstratification=as.character(linevec[[2]]),
FOhaulNum=as.integer(linevec[[3]]),
FOstratum=as.character(linevec[[4]]),
FOclustering=as.character(linevec[[5]]),
FOclusterName=as.character(linevec[[6]]),
FOsampler=as.character(linevec[[7]]),
FOaggLev=as.character(linevec[[8]]),
FOval=as.character(linevec[[9]]),
FOcatReg=as.character(linevec[[10]]),
FOstartDate=as.POSIXct(linevec[[11]]),
FOstartTime=as.character(linevec[[12]]),
FOendDate=as.POSIXct(linevec[[13]]),
FOendTime=as.character(linevec[[14]]),
FOdur=as.integer(linevec[[15]]),
FOstartLat=as.numeric(linevec[[16]]),
FOstartLon=as.numeric(linevec[[17]]),
FOstopLat=as.numeric(linevec[[18]]),
FOstopLon=as.numeric(linevec[[19]]),
FOecoZone=as.character(linevec[[20]]),
FOarea=as.character(linevec[[21]]),
FOstatRect=as.character(linevec[[22]]),
FOsubRect=as.character(linevec[[23]]),
FOfu=as.character(linevec[[24]]),
FOdep=as.integer(linevec[[25]]),
FOwaterDep=as.integer(linevec[[26]]),
FOnatCat=as.character(linevec[[27]]),
FOmetier5=as.character(linevec[[28]]),
FOmetier6=as.character(linevec[[29]]),
FOgear=as.character(linevec[[30]]),
FOmeshSize=as.character(linevec[[31]]),
FOselDev=as.character(linevec[[33]]),
FOselDevMeshSize=as.character(linevec[[34]]),
FOtarget=as.character(linevec[[34]]),
FOobsCo=as.character(linevec[[35]]),
FOtotal=as.integer(linevec[[36]]),
FOsampled=as.integer(linevec[[37]]),
FOprob=as.numeric(linevec[[38]]),
FOselectMeth=as.character(linevec[[39]]),
FOselectMethCluster=as.character(linevec[[40]]),
FOtotalClusters=as.integer(linevec[[41]]),
FOsampledClusters=as.integer(linevec[[42]]),
FOprobCluster=as.integer(linevec[[43]]),
FOnoSampReason=as.character(linevec[[44]])
)
datalist$FO <- rbind(datalist$FO, dt)
return(datalist)
}
#' parse OS line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param OSid id for this line
#' @param SDid id of any parent SD table
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseOS <- function(linevec, datalist, OSid, SDid=NA, verbose=F){
if (verbose){
print(paste("Reading OS", OSid))
}
linevec[linevec==""]<-NA
dt <- data.table(OSid=as.integer(OSid),
SDid=as.integer(SDid),
OSrecType=as.character(linevec[[1]]),
OSnatName=as.character(linevec[[2]]),
OSstratification=as.character(linevec[[3]]),
OSloc=as.character(linevec[[4]]),
OSsamDate=as.POSIXct(linevec[[5]]),
OSsamTime=as.character(linevec[[6]]),
OSstratum=as.character(linevec[[7]]),
OSclustering=as.character(linevec[[8]]),
OSclusterName=as.character(linevec[[9]]),
OSsampler=as.character(linevec[[10]]),
OStimeUnit=as.POSIXct(linevec[[11]]),
OStimeValue=as.numeric(linevec[[12]]),
OStotal=as.integer(linevec[[13]]),
OSsampled=as.integer(linevec[[14]]),
OSprob=as.numeric(linevec[[15]]),
OSselectMeth=as.character(linevec[[16]]),
OSlocType=as.character(linevec[[17]]),
OSselectMethCluster=as.character(linevec[[18]]),
OStotalClusters=as.integer(linevec[[19]]),
OSsampledClusters=as.integer(linevec[[20]]),
OSprobCluster=as.numeric(linevec[[21]]),
OSnoSampReason=as.character(linevec[[22]])
)
datalist$OS <- rbind(datalist$OS, dt)
return(datalist)
}
#' parse VD line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param VDid id for this line
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseVD <- function(linevec, datalist, VDid, verbose=F){
if (verbose){
print(paste("Reading VD", VDid))
}
linevec[linevec==""]<-NA
dt <- data.table(VDid=as.integer(VDid),
VDrecType=as.character(linevec[[1]]),
VDencrCode=as.character(linevec[[2]]),
VDhomePort=as.character(linevec[[3]]),
VDflgCtry=as.character(linevec[[4]]),
VDlen=as.integer(linevec[[5]]),
VDlenCat=as.character(linevec[[6]]),
VDpwr=as.integer(linevec[[7]]),
VDsize=as.integer(linevec[[8]]),
VDsizeUnit=as.character(linevec[[9]]),
VDtype=as.integer(linevec[[10]])
)
datalist$VD <- rbind(datalist$VD, dt)
return(datalist)
}
#' parse LE line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param LEid id for this line
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseLE <- function(linevec, datalist, LEid, OSid=NA, FTid=NA, VSid=NA, VDid=NA, TEid=NA, SAid=NA, verbose=F){
if (verbose){
print(paste("Reading LE", LEid))
}
linevec[linevec==""]<-NA
dt <- data.table(LEid=as.integer(LEid),
OSid=as.integer(OSid),
FTid=as.integer(FTid),
VSid=as.integer(VSid),
VDid=as.integer(VDid),
TEid=as.integer(TEid),
SAid=as.integer(SAid),
LErecType=as.character(linevec[[1]]),
LEstratification=as.character(linevec[[2]]),
LEseqNum=as.integer(linevec[[3]]),
LEhaulNum=as.integer(linevec[[4]]),
LEstratum=as.character(linevec[[5]]),
LEclustering=as.character(linevec[[6]]),
LEclusterName=as.character(linevec[[7]]),
LEsampler=as.character(linevec[[8]]),
LEmixedTrip=as.character(linevec[[9]]),
LEcatReg=as.character(linevec[[10]]),
LEloc=as.character(linevec[[11]]),
LElocType=as.character(linevec[[12]]),
LEctry=as.character(linevec[[13]]),
LEdate=as.POSIXct(linevec[[14]]),
LEtime=as.character(linevec[[15]]),
LEecoZone=as.character(linevec[[16]]),
LEarea=as.character(linevec[[17]]),
LEstatRect=as.character(linevec[[18]]),
LEsubRect=as.character(linevec[[19]]),
LEfu=as.character(linevec[[20]]),
LEnatCat=as.character(linevec[[21]]),
LEmetier5=as.character(linevec[[22]]),
LEmetier6=as.character(linevec[[23]]),
LEgear=as.character(linevec[[24]]),
LEmeshSize=as.integer(linevec[[25]]),
LEselDev=as.character(linevec[[26]]),
LEselDevMeshSize=as.integer(linevec[[27]]),
LEtarget=as.integer(linevec[[28]]),
LEtotal=as.integer(linevec[[29]]),
LEsampled=as.integer(linevec[[30]]),
LEprob=as.numeric(linevec[[31]]),
LEselectMeth=as.character(linevec[[32]]),
LEselectMethCluster=as.character(linevec[[33]]),
LEtotalClusters=as.integer(linevec[[34]]),
LEsampledClusters=as.integer(linevec[[35]]),
LEprobCluster=as.numeric(linevec[[36]]),
LEnoSampReason=as.character(linevec[[37]]),
LEfullTripAva=as.character(linevec[[38]])
)
datalist$LE <- rbind(datalist$LE, dt)
return(datalist)
}
#' parse SL line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param SLid id this line
#' @param FOid id of any parent FO table
#' @param LEid id of any parent LE table
#' @param FTid id of any parent FT table
#' @param OSid id of any parent OS table
#' @param TEid id of any parent TE table
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseSL <- function(linevec, datalist, SLid, FOid=NA, LEid=NA, FTid=NA, OSid=NA, TEid=NA, verbose=F){
if (verbose){
print(paste("Reading SL", SLid))
}
linevec[linevec==""]<-NA
dt <- data.table(SLid=as.integer(SLid),
FOid=as.integer(FOid),
LEid=as.integer(LEid),
FTid=as.integer(FTid),
OSid=as.integer(OSid),
TEid=as.integer(TEid),
SLrecType=as.character(linevec[[1]]),
SLlistName=as.character(linevec[[2]]),
Slyear=as.integer(linevec[[3]]),
SLsppCode=as.character(linevec[[4]]),
SLcommSpp=as.character(linevec[[5]]),
SLCatchFrac=as.character(linevec[[6]]))
datalist$SL <- rbind(datalist$SL, dt)
return(datalist)
}
#' parse SS line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param SSid id this line
#' @param SLid id for parent species selection table
#' @param LEid id for any parent LE table
#' @param FOid id for any parent FO table
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseSS <- function(linevec, datalist, SSid, SLid, LEid=NA, FOid=NA, verbose=F){
if (verbose){
print(paste("Reading SS", SSid))
}
linevec[linevec==""]<-NA
dt <- data.table(SSid=as.integer(SSid),
SLid=as.integer(SLid),
LEid=as.integer(LEid),
FOid=as.integer(FOid),
SSrecType=as.character(linevec[[1]]),
SSstratification=as.character(linevec[[2]]),
SSobsActTyp=as.character(linevec[[3]]),
SScatchCat=as.character(linevec[[4]]),
SSobsTyp=as.character(linevec[[5]]),
SSstratum=as.character(linevec[[6]]),
SSclustering=as.character(linevec[[7]]),
SSclusterName=as.character(linevec[[8]]),
SSsampler=as.character(linevec[[9]]),
SSsppListName=as.character(linevec[[10]]),
SStotal=as.integer(linevec[[11]]),
SSsampled=as.integer(linevec[[12]]),
SSselectMeth=as.character(linevec[[13]]),
SSselectMethCluster=as.character(linevec[[14]]),
SStotalClusters=as.integer(linevec[[15]]),
SSsampledClusters=as.integer(linevec[[16]]),
SSprobCluster=as.numeric(linevec[[17]]),
SSnoSampReason=as.character(linevec[[18]])
)
datalist$SS <- rbind(datalist$SS, dt)
return(datalist)
}
#' parse SA line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param SAid id this line
#' @param SSid id for parent SS table
#' @param SAparentid id for any parent sample (this line is a subsample)
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseSA <- function(linevec, datalist, SAid, SSid, SAparentid=NA, verbose=F){
if (verbose){
print(paste("Reading SA", SAid))
}
linevec[linevec==""]<-NA
dt <- data.table(SAid=as.integer(SAid),
SAparentid=as.integer(SAparentid),
SSid=as.integer(SSid),
SArecType=as.character(linevec[[1]]),
SAnatCode=as.character(linevec[[2]]),
SAstratification=as.character(linevec[[3]]),
SAstratum=as.character(linevec[[4]]),
SAsppCode=as.character(linevec[[5]]),
SAcommSpp=as.character(linevec[[6]]),
SApres=as.character(linevec[[7]]),
SAcatchCat=as.character(linevec[[8]]),
SAlandCat=as.character(linevec[[9]]),
SAcommCatScl=as.character(linevec[[10]]),
SAcommCat=as.character(linevec[[11]]),
SAsex=as.character(linevec[[12]]),
SAunitType=as.character(linevec[[13]]),
SAtotalWtLive=as.integer(linevec[[14]]),
SAsampWtLive=as.integer(linevec[[15]]),
SAtotal=as.numeric(linevec[[16]]),
SAsampled=as.numeric(linevec[[17]]),
SAprob=as.numeric(linevec[[18]]),
SAselectMeth=as.character(linevec[[19]]),
SAlowHierarchy=as.character(linevec[[20]]),
SAsampler=as.character(linevec[[21]]),
SAnoSampReasonFM=as.character(linevec[[22]]),
SAnoSampReasonBV=as.character(linevec[[23]]),
SAtotalWtMes=as.integer(linevec[[24]]),
SAsampWtMes=as.integer(linevec[[25]]),
SAconFacMesLive=as.numeric(linevec[[26]]),
SAspecState=as.character(linevec[[27]]))
datalist$SA <- rbind(datalist$SA, dt)
return(datalist)
}
#' parse BV line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param BVid id for this row
#' @param SAid id for any parent SA row
#' @param FMid id for any parent Fm row
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseBV <- function(linevec, datalist, BVid, SAid=NA, FMid=NA, verbose=F){
if (verbose){
print(paste("Reading BV", BVid))
}
linevec[linevec==""]<-NA
dt <- data.table(BVid=as.character(BVid),
SAid=as.integer(SAid),
FMid=as.integer(FMid),
BVrecType=as.character(linevec[[1]]),
BVfishID=as.character(linevec[[2]]),
BVstratification=as.character(linevec[[3]]),
BVstratum=as.character(linevec[[4]]),
BVtype=as.character(linevec[[5]]),
BVvalue=as.character(linevec[[6]]),
BVunitVal=as.character(linevec[[7]]),
BVunitRefList=as.character(linevec[[8]]),
BVmethod=as.character(linevec[[9]]),
BVMeEq=as.character(linevec[[10]]),
BVtotal=as.numeric(linevec[[11]]),
BVsampled=as.numeric(linevec[[12]]),
BVprob=as.numeric(linevec[[13]]),
BVselectMeth=as.character(linevec[[14]]),
BVsampler=as.character(linevec[[15]]))
datalist$BV <- rbind(datalist$BV, dt)
return(datalist)
}
#' Reads RDBES exhange format
#' @description
#' Parser is only implemented for the tables needed for hiearachy 13
#' @param filename filename for csv file with RDBES exhcange format v1.17
#' @param verbose logical determining whether progress information should be printed while parsing
#' @return list of data.tables corresponding to the different tables parsed. Tables are identified with their Record Type, and columns are identified with their R Name
#' @noRd
#' @keywords internal
parseRDBESexchangeH13 <- function(filename, verbose=F){
#populate this with one data frame for each table
datalist <- list()
# assigning id based on order in exhcange format
# keeping track of last assigned id
lastid <-list()
lastid$DE <- 0
lastid$SD <- 0
lastid$FO <- 0
lastid$SL <- 0
lastid$SS <- 0
lastid$SA <- 0
lastid$BV <- 0
f <- file(filename, open="rU")
lines <- readLines(f)
close(f)
for (l in lines){
linevec <- data.table::tstrsplit(paste(l,",",sep=""), ",") #add trailing comma as strsplit discards trailing empty values
if (linevec[[1]]=="DE"){
lastid$DE <- lastid$DE+1
datalist <- parseDE(linevec, datalist, lastid$DE, verbose=verbose)
}
else if (linevec[[1]]=="SD"){
lastid$SD <- lastid$SD+1
datalist <- parseSD(linevec, datalist, lastid$SD, lastid$DE, verbose=verbose)
}
else if (linevec[[1]]=="FO"){
lastid$FO <- lastid$FO+1
datalist <- parseFO(linevec, datalist, lastid$FO, SDid = lastid$SD, verbose=verbose)
}
else if (linevec[[1]]=="SL"){
datalist <- parseSL(linevec, datalist, lastid$SL, FOid = lastid$FO)
}
else if (linevec[[1]]=="SS"){
lastid$SS <- lastid$SS+1
lastid$SL <- lastid$SL+1 # SL comes after SS in exhange format
datalist <- parseSS(linevec, datalist, lastid$SS, lastid$SL, FOid=lastid$FO)
}
else if (linevec[[1]]=="SA"){
lastid$SA <- lastid$SA+1
datalist <- parseSA(linevec, datalist, lastid$SA, lastid$SS, verbose=verbose)
}
else if (linevec[[1]]=="BV"){
lastid$BV <- lastid$BV+1
datalist <- parseBV(linevec, datalist, lastid$BV, SAid=lastid$SA)
}
else{
stop(paste("Record type", linevec[[1]], "not supported"))
}
}
return(datalist)
}
#' Reads RDBES exhange format
#' @description
#' Parser is only implemented for the tables needed for hiearachy 5
#' @param filename filename for csv file with RDBES exhcange format v1.17
#' @param verbose logical determining whether progress information should be printed while parsing
#' @return list of data.tables corresponding to the different tables parsed. Tables are identified with their Record Type, and columns are identified with their R Name
#' @noRd
#' @keywords internal
parseRDBESexchangeH5 <- function(filename, verbose=F){
#populate this with one data frame for each table
datalist <- list()
# assigning id based on order in exhcange format
# keeping track of last assigned id
lastid <-list()
lastid$DE <- 0
lastid$SD <- 0
lastid$OS <- 0
lastid$VD <- 0
lastid$LE <- 0
lastid$SL <- 0
lastid$SS <- 0
lastid$SA <- 0
lastid$BV <- 0
f <- file(filename, open="rU")
lines <- readLines(f)
close(f)
for (l in lines){
linevec <- data.table::tstrsplit(paste(l,",",sep=""), ",") #add trailing comma as strsplit discards trailing empty values
if (linevec[[1]]=="DE"){
lastid$DE <- lastid$DE+1
datalist <- parseDE(linevec, datalist, lastid$DE, verbose=verbose)
}
else if (linevec[[1]]=="SD"){
lastid$SD <- lastid$SD+1
datalist <- parseSD(linevec, datalist, lastid$SD, lastid$DE, verbose=verbose)
}
else if (linevec[[1]]=="OS"){
lastid$OS <- lastid$OS+1
datalist <- parseOS(linevec, datalist, lastid$OS, SDid = lastid$SD, verbose=verbose)
}
else if (linevec[[1]]=="VD"){
lastid$VD <- lastid$VD+1
datalist <- parseVD(linevec, datalist, lastid$VD, verbose=verbose)
}
else if (linevec[[1]]=="LE"){
lastid$LE <- lastid$LE+1
datalist <- parseLE(linevec, datalist, lastid$LE, OSid=lastid$OS, VDid=lastid$VD, verbose=verbose)
}
else if (linevec[[1]]=="SL"){
datalist <- parseSL(linevec, datalist, lastid$SL, LEid = lastid$LE)
}
else if (linevec[[1]]=="SS"){
lastid$SS <- lastid$SS+1
# SL is a bit misspecified in v 1.17. Work around by making SLid repeating
lastid$SL <- lastid$SL+1 # SL comes after SS in exhange format
datalist <- parseSS(linevec, datalist, lastid$SS, lastid$SL, LEid=lastid$LE)
}
else if (linevec[[1]]=="SA"){
lastid$SA <- lastid$SA+1
datalist <- parseSA(linevec, datalist, lastid$SA, lastid$SS, verbose=verbose)
}
else if (linevec[[1]]=="BV"){
lastid$BV <- lastid$BV+1
datalist <- parseBV(linevec, datalist, lastid$BV, SAid=lastid$SA)
}
else{
stop(paste("Record type", linevec[[1]], "not supported"))
}
}
return(datalist)
}
#' Flatten RDBES
#' @param datalist RDBES v 1.17 as parsed by functions in this file
#' @return data.table
#' @noRd
#' @keywords internal
flattenRDBES <- function(datalist){
BV <- datalist$BV
stop("Not implemented")
}
#' Export to csv
#' @description
#' Exports RDBES data mode v1.17 to csv files.
#' @details
#' One file will be produced for each table
#' @param data list of data.table one for each table in hierarchy
#' @param targetdir character() directory to write files to
#' @param overwrite logical() whether to overwrite existing files
#' @noRd
#' @keywords internal
exportCsv <- function(data, targetdir, overwrite=F){
filenames <- paste(targetdir, unlist(lapply(names(data), FUN=function(x){paste(x, "csv", sep=".")})), sep="/")
if (!overwrite & any(file.exists(filenames))){
stop("Some files already exist. Consider overwrite=T")
}
for (i in 1:length(data)){
utils::write.csv(data[[i]], file=filenames[i], quote = F, row.names = F)
}
}
#' Parses landings on the LSS format
#' @noRd
#' @keywords internal
#' @param file file with LSS landings
#' @return data.table with LSS landings
#' @import data.table
#' @import readr
parseLSS <- function(file){
loc <- readr::default_locale()
loc$decimal_mark <- ","
loc$encoding <- "latin1"
db <- read_delim(file, delim="|", col_names=T, trim_ws=TRUE, na=c("", "na", "NA"), locale=loc, guess_max = 100000)
return(db)
}
edvinf/prepRECA documentation built on Nov. 11, 2019, 6:30 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions parseDE parseSD parseFO parseOS parseVD parseLE parseSL parseSS parseSA parseBV parseRDBESexchangeH13 parseRDBESexchangeH5 flattenRDBES exportCsv parseLSS
#' parse DE line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param DEid id this line
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
#' @import stats
#' @import data.table
parseDE <- function(linevec, datalist, DEid, verbose=F){
if (verbose){
print(paste("Reading DE", DEid))
}
linevec[linevec==""]<-NA
dt <- data.table(
DEid=as.integer(DEid),
DErecType=as.character(linevec[[1]]),
DEsampScheme=as.character(linevec[[2]]),
DEyear=as.integer(linevec[[3]]),
DEstratum=as.character(linevec[[4]]),
DEhierarchyCor=as.character(linevec[[5]]),
DEhierarchy=as.character(linevec[[6]])
)
datalist$DE <- rbind(datalist$DE, dt)
return(datalist)
}
#' parse SD line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param SDid id this line
#' @param DEid id of parent DE table
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseSD <- function(linevec, datalist, SDid, DEid, verbose=F){
if (verbose){
print(paste("Reading SD", SDid))
}
linevec[linevec==""]<-NA
dt <- data.table(
SDid=as.integer(SDid),
DEid=as.integer(DEid),
SDrecType=as.character(linevec[[1]]),
SDctry=as.character(linevec[[2]]),
SDinst=as.character(linevec[[3]])
)
datalist$SD <- rbind(datalist$SD, dt)
return(datalist)
}
#' parse FO line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param FOid id this line
#' @param FTid id of any parent FT table
#' @param SDid id of any parent SD table
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseFO <- function(linevec, datalist, FOid, FTid=NA, SDid=NA, verbose=F){
if (verbose){
print(paste("Reading FO", FOid))
}
linevec[linevec==""]<-NA
dt <- data.table(FOid=as.integer(FOid),
FTid=as.integer(FTid),
SDid=as.integer(SDid),
FOrecType=as.character(linevec[[1]]),
FOstratification=as.character(linevec[[2]]),
FOhaulNum=as.integer(linevec[[3]]),
FOstratum=as.character(linevec[[4]]),
FOclustering=as.character(linevec[[5]]),
FOclusterName=as.character(linevec[[6]]),
FOsampler=as.character(linevec[[7]]),
FOaggLev=as.character(linevec[[8]]),
FOval=as.character(linevec[[9]]),
FOcatReg=as.character(linevec[[10]]),
FOstartDate=as.POSIXct(linevec[[11]]),
FOstartTime=as.character(linevec[[12]]),
FOendDate=as.POSIXct(linevec[[13]]),
FOendTime=as.character(linevec[[14]]),
FOdur=as.integer(linevec[[15]]),
FOstartLat=as.numeric(linevec[[16]]),
FOstartLon=as.numeric(linevec[[17]]),
FOstopLat=as.numeric(linevec[[18]]),
FOstopLon=as.numeric(linevec[[19]]),
FOecoZone=as.character(linevec[[20]]),
FOarea=as.character(linevec[[21]]),
FOstatRect=as.character(linevec[[22]]),
FOsubRect=as.character(linevec[[23]]),
FOfu=as.character(linevec[[24]]),
FOdep=as.integer(linevec[[25]]),
FOwaterDep=as.integer(linevec[[26]]),
FOnatCat=as.character(linevec[[27]]),
FOmetier5=as.character(linevec[[28]]),
FOmetier6=as.character(linevec[[29]]),
FOgear=as.character(linevec[[30]]),
FOmeshSize=as.character(linevec[[31]]),
FOselDev=as.character(linevec[[33]]),
FOselDevMeshSize=as.character(linevec[[34]]),
FOtarget=as.character(linevec[[34]]),
FOobsCo=as.character(linevec[[35]]),
FOtotal=as.integer(linevec[[36]]),
FOsampled=as.integer(linevec[[37]]),
FOprob=as.numeric(linevec[[38]]),
FOselectMeth=as.character(linevec[[39]]),
FOselectMethCluster=as.character(linevec[[40]]),
FOtotalClusters=as.integer(linevec[[41]]),
FOsampledClusters=as.integer(linevec[[42]]),
FOprobCluster=as.integer(linevec[[43]]),
FOnoSampReason=as.character(linevec[[44]])
)
datalist$FO <- rbind(datalist$FO, dt)
return(datalist)
}
#' parse OS line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param OSid id for this line
#' @param SDid id of any parent SD table
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseOS <- function(linevec, datalist, OSid, SDid=NA, verbose=F){
if (verbose){
print(paste("Reading OS", OSid))
}
linevec[linevec==""]<-NA
dt <- data.table(OSid=as.integer(OSid),
SDid=as.integer(SDid),
OSrecType=as.character(linevec[[1]]),
OSnatName=as.character(linevec[[2]]),
OSstratification=as.character(linevec[[3]]),
OSloc=as.character(linevec[[4]]),
OSsamDate=as.POSIXct(linevec[[5]]),
OSsamTime=as.character(linevec[[6]]),
OSstratum=as.character(linevec[[7]]),
OSclustering=as.character(linevec[[8]]),
OSclusterName=as.character(linevec[[9]]),
OSsampler=as.character(linevec[[10]]),
OStimeUnit=as.POSIXct(linevec[[11]]),
OStimeValue=as.numeric(linevec[[12]]),
OStotal=as.integer(linevec[[13]]),
OSsampled=as.integer(linevec[[14]]),
OSprob=as.numeric(linevec[[15]]),
OSselectMeth=as.character(linevec[[16]]),
OSlocType=as.character(linevec[[17]]),
OSselectMethCluster=as.character(linevec[[18]]),
OStotalClusters=as.integer(linevec[[19]]),
OSsampledClusters=as.integer(linevec[[20]]),
OSprobCluster=as.numeric(linevec[[21]]),
OSnoSampReason=as.character(linevec[[22]])
)
datalist$OS <- rbind(datalist$OS, dt)
return(datalist)
}
#' parse VD line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param VDid id for this line
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseVD <- function(linevec, datalist, VDid, verbose=F){
if (verbose){
print(paste("Reading VD", VDid))
}
linevec[linevec==""]<-NA
dt <- data.table(VDid=as.integer(VDid),
VDrecType=as.character(linevec[[1]]),
VDencrCode=as.character(linevec[[2]]),
VDhomePort=as.character(linevec[[3]]),
VDflgCtry=as.character(linevec[[4]]),
VDlen=as.integer(linevec[[5]]),
VDlenCat=as.character(linevec[[6]]),
VDpwr=as.integer(linevec[[7]]),
VDsize=as.integer(linevec[[8]]),
VDsizeUnit=as.character(linevec[[9]]),
VDtype=as.integer(linevec[[10]])
)
datalist$VD <- rbind(datalist$VD, dt)
return(datalist)
}
#' parse LE line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param LEid id for this line
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseLE <- function(linevec, datalist, LEid, OSid=NA, FTid=NA, VSid=NA, VDid=NA, TEid=NA, SAid=NA, verbose=F){
if (verbose){
print(paste("Reading LE", LEid))
}
linevec[linevec==""]<-NA
dt <- data.table(LEid=as.integer(LEid),
OSid=as.integer(OSid),
FTid=as.integer(FTid),
VSid=as.integer(VSid),
VDid=as.integer(VDid),
TEid=as.integer(TEid),
SAid=as.integer(SAid),
LErecType=as.character(linevec[[1]]),
LEstratification=as.character(linevec[[2]]),
LEseqNum=as.integer(linevec[[3]]),
LEhaulNum=as.integer(linevec[[4]]),
LEstratum=as.character(linevec[[5]]),
LEclustering=as.character(linevec[[6]]),
LEclusterName=as.character(linevec[[7]]),
LEsampler=as.character(linevec[[8]]),
LEmixedTrip=as.character(linevec[[9]]),
LEcatReg=as.character(linevec[[10]]),
LEloc=as.character(linevec[[11]]),
LElocType=as.character(linevec[[12]]),
LEctry=as.character(linevec[[13]]),
LEdate=as.POSIXct(linevec[[14]]),
LEtime=as.character(linevec[[15]]),
LEecoZone=as.character(linevec[[16]]),
LEarea=as.character(linevec[[17]]),
LEstatRect=as.character(linevec[[18]]),
LEsubRect=as.character(linevec[[19]]),
LEfu=as.character(linevec[[20]]),
LEnatCat=as.character(linevec[[21]]),
LEmetier5=as.character(linevec[[22]]),
LEmetier6=as.character(linevec[[23]]),
LEgear=as.character(linevec[[24]]),
LEmeshSize=as.integer(linevec[[25]]),
LEselDev=as.character(linevec[[26]]),
LEselDevMeshSize=as.integer(linevec[[27]]),
LEtarget=as.integer(linevec[[28]]),
LEtotal=as.integer(linevec[[29]]),
LEsampled=as.integer(linevec[[30]]),
LEprob=as.numeric(linevec[[31]]),
LEselectMeth=as.character(linevec[[32]]),
LEselectMethCluster=as.character(linevec[[33]]),
LEtotalClusters=as.integer(linevec[[34]]),
LEsampledClusters=as.integer(linevec[[35]]),
LEprobCluster=as.numeric(linevec[[36]]),
LEnoSampReason=as.character(linevec[[37]]),
LEfullTripAva=as.character(linevec[[38]])
)
datalist$LE <- rbind(datalist$LE, dt)
return(datalist)
}
#' parse SL line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param SLid id this line
#' @param FOid id of any parent FO table
#' @param LEid id of any parent LE table
#' @param FTid id of any parent FT table
#' @param OSid id of any parent OS table
#' @param TEid id of any parent TE table
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseSL <- function(linevec, datalist, SLid, FOid=NA, LEid=NA, FTid=NA, OSid=NA, TEid=NA, verbose=F){
if (verbose){
print(paste("Reading SL", SLid))
}
linevec[linevec==""]<-NA
dt <- data.table(SLid=as.integer(SLid),
FOid=as.integer(FOid),
LEid=as.integer(LEid),
FTid=as.integer(FTid),
OSid=as.integer(OSid),
TEid=as.integer(TEid),
SLrecType=as.character(linevec[[1]]),
SLlistName=as.character(linevec[[2]]),
Slyear=as.integer(linevec[[3]]),
SLsppCode=as.character(linevec[[4]]),
SLcommSpp=as.character(linevec[[5]]),
SLCatchFrac=as.character(linevec[[6]]))
datalist$SL <- rbind(datalist$SL, dt)
return(datalist)
}
#' parse SS line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param SSid id this line
#' @param SLid id for parent species selection table
#' @param LEid id for any parent LE table
#' @param FOid id for any parent FO table
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseSS <- function(linevec, datalist, SSid, SLid, LEid=NA, FOid=NA, verbose=F){
if (verbose){
print(paste("Reading SS", SSid))
}
linevec[linevec==""]<-NA
dt <- data.table(SSid=as.integer(SSid),
SLid=as.integer(SLid),
LEid=as.integer(LEid),
FOid=as.integer(FOid),
SSrecType=as.character(linevec[[1]]),
SSstratification=as.character(linevec[[2]]),
SSobsActTyp=as.character(linevec[[3]]),
SScatchCat=as.character(linevec[[4]]),
SSobsTyp=as.character(linevec[[5]]),
SSstratum=as.character(linevec[[6]]),
SSclustering=as.character(linevec[[7]]),
SSclusterName=as.character(linevec[[8]]),
SSsampler=as.character(linevec[[9]]),
SSsppListName=as.character(linevec[[10]]),
SStotal=as.integer(linevec[[11]]),
SSsampled=as.integer(linevec[[12]]),
SSselectMeth=as.character(linevec[[13]]),
SSselectMethCluster=as.character(linevec[[14]]),
SStotalClusters=as.integer(linevec[[15]]),
SSsampledClusters=as.integer(linevec[[16]]),
SSprobCluster=as.numeric(linevec[[17]]),
SSnoSampReason=as.character(linevec[[18]])
)
datalist$SS <- rbind(datalist$SS, dt)
return(datalist)
}
#' parse SA line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param SAid id this line
#' @param SSid id for parent SS table
#' @param SAparentid id for any parent sample (this line is a subsample)
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseSA <- function(linevec, datalist, SAid, SSid, SAparentid=NA, verbose=F){
if (verbose){
print(paste("Reading SA", SAid))
}
linevec[linevec==""]<-NA
dt <- data.table(SAid=as.integer(SAid),
SAparentid=as.integer(SAparentid),
SSid=as.integer(SSid),
SArecType=as.character(linevec[[1]]),
SAnatCode=as.character(linevec[[2]]),
SAstratification=as.character(linevec[[3]]),
SAstratum=as.character(linevec[[4]]),
SAsppCode=as.character(linevec[[5]]),
SAcommSpp=as.character(linevec[[6]]),
SApres=as.character(linevec[[7]]),
SAcatchCat=as.character(linevec[[8]]),
SAlandCat=as.character(linevec[[9]]),
SAcommCatScl=as.character(linevec[[10]]),
SAcommCat=as.character(linevec[[11]]),
SAsex=as.character(linevec[[12]]),
SAunitType=as.character(linevec[[13]]),
SAtotalWtLive=as.integer(linevec[[14]]),
SAsampWtLive=as.integer(linevec[[15]]),
SAtotal=as.numeric(linevec[[16]]),
SAsampled=as.numeric(linevec[[17]]),
SAprob=as.numeric(linevec[[18]]),
SAselectMeth=as.character(linevec[[19]]),
SAlowHierarchy=as.character(linevec[[20]]),
SAsampler=as.character(linevec[[21]]),
SAnoSampReasonFM=as.character(linevec[[22]]),
SAnoSampReasonBV=as.character(linevec[[23]]),
SAtotalWtMes=as.integer(linevec[[24]]),
SAsampWtMes=as.integer(linevec[[25]]),
SAconFacMesLive=as.numeric(linevec[[26]]),
SAspecState=as.character(linevec[[27]]))
datalist$SA <- rbind(datalist$SA, dt)
return(datalist)
}
#' parse BV line, add result to datalist
#' @param linevec list of elements on line
#' @param datalist list of data frames representing the RDBES data model
#' @param BVid id for this row
#' @param SAid id for any parent SA row
#' @param FMid id for any parent Fm row
#' @param verbose logical whether to print progress info
#' @noRd
#' @keywords internal
parseBV <- function(linevec, datalist, BVid, SAid=NA, FMid=NA, verbose=F){
if (verbose){
print(paste("Reading BV", BVid))
}
linevec[linevec==""]<-NA
dt <- data.table(BVid=as.character(BVid),
SAid=as.integer(SAid),
FMid=as.integer(FMid),
BVrecType=as.character(linevec[[1]]),
BVfishID=as.character(linevec[[2]]),
BVstratification=as.character(linevec[[3]]),
BVstratum=as.character(linevec[[4]]),
BVtype=as.character(linevec[[5]]),
BVvalue=as.character(linevec[[6]]),
BVunitVal=as.character(linevec[[7]]),
BVunitRefList=as.character(linevec[[8]]),
BVmethod=as.character(linevec[[9]]),
BVMeEq=as.character(linevec[[10]]),
BVtotal=as.numeric(linevec[[11]]),
BVsampled=as.numeric(linevec[[12]]),
BVprob=as.numeric(linevec[[13]]),
BVselectMeth=as.character(linevec[[14]]),
BVsampler=as.character(linevec[[15]]))
datalist$BV <- rbind(datalist$BV, dt)
return(datalist)
}
#' Reads RDBES exhange format
#' @description
#' Parser is only implemented for the tables needed for hiearachy 13
#' @param filename filename for csv file with RDBES exhcange format v1.17
#' @param verbose logical determining whether progress information should be printed while parsing
#' @return list of data.tables corresponding to the different tables parsed. Tables are identified with their Record Type, and columns are identified with their R Name
#' @noRd
#' @keywords internal
parseRDBESexchangeH13 <- function(filename, verbose=F){
#populate this with one data frame for each table
datalist <- list()
# assigning id based on order in exhcange format
# keeping track of last assigned id
lastid <-list()
lastid$DE <- 0
lastid$SD <- 0
lastid$FO <- 0
lastid$SL <- 0
lastid$SS <- 0
lastid$SA <- 0
lastid$BV <- 0
f <- file(filename, open="rU")
lines <- readLines(f)
close(f)
for (l in lines){
linevec <- data.table::tstrsplit(paste(l,",",sep=""), ",") #add trailing comma as strsplit discards trailing empty values
if (linevec[[1]]=="DE"){
lastid$DE <- lastid$DE+1
datalist <- parseDE(linevec, datalist, lastid$DE, verbose=verbose)
}
else if (linevec[[1]]=="SD"){
lastid$SD <- lastid$SD+1
datalist <- parseSD(linevec, datalist, lastid$SD, lastid$DE, verbose=verbose)
}
else if (linevec[[1]]=="FO"){
lastid$FO <- lastid$FO+1
datalist <- parseFO(linevec, datalist, lastid$FO, SDid = lastid$SD, verbose=verbose)
}
else if (linevec[[1]]=="SL"){
datalist <- parseSL(linevec, datalist, lastid$SL, FOid = lastid$FO)
}
else if (linevec[[1]]=="SS"){
lastid$SS <- lastid$SS+1
lastid$SL <- lastid$SL+1 # SL comes after SS in exhange format
datalist <- parseSS(linevec, datalist, lastid$SS, lastid$SL, FOid=lastid$FO)
}
else if (linevec[[1]]=="SA"){
lastid$SA <- lastid$SA+1
datalist <- parseSA(linevec, datalist, lastid$SA, lastid$SS, verbose=verbose)
}
else if (linevec[[1]]=="BV"){
lastid$BV <- lastid$BV+1
datalist <- parseBV(linevec, datalist, lastid$BV, SAid=lastid$SA)
}
else{
stop(paste("Record type", linevec[[1]], "not supported"))
}
}
return(datalist)
}
#' Reads RDBES exhange format
#' @description
#' Parser is only implemented for the tables needed for hiearachy 5
#' @param filename filename for csv file with RDBES exhcange format v1.17
#' @param verbose logical determining whether progress information should be printed while parsing
#' @return list of data.tables corresponding to the different tables parsed. Tables are identified with their Record Type, and columns are identified with their R Name
#' @noRd
#' @keywords internal
parseRDBESexchangeH5 <- function(filename, verbose=F){
#populate this with one data frame for each table
datalist <- list()
# assigning id based on order in exhcange format
# keeping track of last assigned id
lastid <-list()
lastid$DE <- 0
lastid$SD <- 0
lastid$OS <- 0
lastid$VD <- 0
lastid$LE <- 0
lastid$SL <- 0
lastid$SS <- 0
lastid$SA <- 0
lastid$BV <- 0
f <- file(filename, open="rU")
lines <- readLines(f)
close(f)
for (l in lines){
linevec <- data.table::tstrsplit(paste(l,",",sep=""), ",") #add trailing comma as strsplit discards trailing empty values
if (linevec[[1]]=="DE"){
lastid$DE <- lastid$DE+1
datalist <- parseDE(linevec, datalist, lastid$DE, verbose=verbose)
}
else if (linevec[[1]]=="SD"){
lastid$SD <- lastid$SD+1
datalist <- parseSD(linevec, datalist, lastid$SD, lastid$DE, verbose=verbose)
}
else if (linevec[[1]]=="OS"){
lastid$OS <- lastid$OS+1
datalist <- parseOS(linevec, datalist, lastid$OS, SDid = lastid$SD, verbose=verbose)
}
else if (linevec[[1]]=="VD"){
lastid$VD <- lastid$VD+1
datalist <- parseVD(linevec, datalist, lastid$VD, verbose=verbose)
}
else if (linevec[[1]]=="LE"){
lastid$LE <- lastid$LE+1
datalist <- parseLE(linevec, datalist, lastid$LE, OSid=lastid$OS, VDid=lastid$VD, verbose=verbose)
}
else if (linevec[[1]]=="SL"){
datalist <- parseSL(linevec, datalist, lastid$SL, LEid = lastid$LE)
}
else if (linevec[[1]]=="SS"){
lastid$SS <- lastid$SS+1
# SL is a bit misspecified in v 1.17. Work around by making SLid repeating
lastid$SL <- lastid$SL+1 # SL comes after SS in exhange format
datalist <- parseSS(linevec, datalist, lastid$SS, lastid$SL, LEid=lastid$LE)
}
else if (linevec[[1]]=="SA"){
lastid$SA <- lastid$SA+1
datalist <- parseSA(linevec, datalist, lastid$SA, lastid$SS, verbose=verbose)
}
else if (linevec[[1]]=="BV"){
lastid$BV <- lastid$BV+1
datalist <- parseBV(linevec, datalist, lastid$BV, SAid=lastid$SA)
}
else{
stop(paste("Record type", linevec[[1]], "not supported"))
}
}
return(datalist)
}
#' Flatten RDBES
#' @param datalist RDBES v 1.17 as parsed by functions in this file
#' @return data.table
#' @noRd
#' @keywords internal
flattenRDBES <- function(datalist){
BV <- datalist$BV
stop("Not implemented")
}
#' Export to csv
#' @description
#' Exports RDBES data mode v1.17 to csv files.
#' @details
#' One file will be produced for each table
#' @param data list of data.table one for each table in hierarchy
#' @param targetdir character() directory to write files to
#' @param overwrite logical() whether to overwrite existing files
#' @noRd
#' @keywords internal
exportCsv <- function(data, targetdir, overwrite=F){
filenames <- paste(targetdir, unlist(lapply(names(data), FUN=function(x){paste(x, "csv", sep=".")})), sep="/")
if (!overwrite & any(file.exists(filenames))){
stop("Some files already exist. Consider overwrite=T")
}
for (i in 1:length(data)){
utils::write.csv(data[[i]], file=filenames[i], quote = F, row.names = F)
}
}
#' Parses landings on the LSS format
#' @noRd
#' @keywords internal
#' @param file file with LSS landings
#' @return data.table with LSS landings
#' @import data.table
#' @import readr
parseLSS <- function(file){
loc <- readr::default_locale()
loc$decimal_mark <- ","
loc$encoding <- "latin1"
db <- read_delim(file, delim="|", col_names=T, trim_ws=TRUE, na=c("", "na", "NA"), locale=loc, guess_max = 100000)
return(db)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.