R/Routes.R

In StoXProject/RstoxFramework: The Engine of StoX

##### Models: #####


##################################################
##################################################
#' Get objects for use in the GUI
#'
#' \code{getModelNames} and \code{getModelInfo} return the names and description of the StoX models. \cr \cr
#' \code{getCanShowInMap}: can the data produces by a process using this function be shown in the map? \cr \cr
#' \code{getInteractiveData} and \code{getInteractiveMode} get the interactive data and the mode of interactive data (data that canbe set and get iva the GUI) . \cr \cr
#' \code{getMapData} gets the data to plot in the map of the GUI. \cr \cr
#' \code{getProcessPropertySheet} gets the properties of a process. \cr \cr
#' \code{setProcessPropertyValue} gets the properties of a process. \cr \cr
#' \code{getFunctionHelpAsHtml} and \code{getObjectHelpAsHtml} get the R documentation of a StoX function or object as html for display in the GUI. \cr \cr
#' \code{getFilterOptionsAll} gets possible tables, operators and unique values for use in the filter expression builder. \cr \cr
#' \code{getParameterTableInfo} and \code{getParameterVectorInfo} get information of a parameter table or vector. \cr \cr
#' 
#' @inheritParams general_arguments
#' @param n The number of colour steps.
#' @param as.rgb Logical: If TRUE return RGB table instead of HEX.
#' @param col A vector of colour steps.
#' @param groupName The name of the property group, one of "processArguments", "functionInputs" and "functionParameters".
#' @param name The name of the property, such as "processName", "functionName", one of the process parameters ("enabled", "showInMap" and "fileOutput"), the name of a funciton input, or the name of a function parameter. 
#' @param value The value to set to the property (string).
#' @param stylesheet The html stylesheet to use, defaulted to no stylesheet.
#' @param include.numeric Logical: If TRUE get possible values for numeric ariables as well as categorical variables.
#' @param stopIfEmptyPossibleValues Logical: If TRUE get possible values for numeric ariables as well as categorical variables.
#' @param format A character string naming the format to get info for.
#' @param objectName The R object to get help as html for.
#' @param packageName The package holding the object to get help as html for.
#' 
#' @name StoXGUI_interfaces
#'
NULL



#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
getModelInfo <- function() {
    getRstoxFrameworkDefinitions("stoxModelInfo")
}


getModel <- function(modelName) {
    modelNames <- getRstoxFrameworkDefinitions("stoxModelNames")
    output <- intersect(modelName, modelNames)
    if(!length(output)) {
        warning("modelName must be one of ", paste0(modelNames, collapse = ", "), ".")
        output <- NA
    }
    return(output)
}

##########


##### Templates: #####

# This function is unused, as templates are abandoned in StoX 3.0.0
### #' 
### #' @export
### #' 
### getAvailableTemplatesDescriptions <- function() {
###     # Get the evailable templates:
###     availableTemplates <- getAvaiableTemplates(TRUE)
###     # Return the tempates as a data frame of name and description:
###     data.table::data.table(
###         name = names(availableTemplates), 
###         description = sapply(availableTemplates, attr, "description")
###     )
### } 
##########




##### Processes: #####
getCanShowInMap <- function(functionName, dataType = NULL) {
    # Get the data types returned by the functions of the processes:
    if(length(dataType) == 0) {
        dataType <- getStoxFunctionMetaData(functionName, metaDataName = "functionOutputDataType")
    }
    
    # Is the datatype of the dataTypesToShowInMap?:
    if(length(dataType) == 0 || (length(dataType) && nchar(dataType[1]) == 0)) {
        return(FALSE)
    }
    else {
        return(dataType %in% getRstoxFrameworkDefinitions("dataTypesToShowInMap"))
    }
}



##### Interactive: #####

# Function for getting the interactive mode of the process:
#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
getInteractiveMode <- function(projectPath, modelName, processID) {
    
    # Get the data type of the process:
    dataType <- getDataType(
        projectPath = projectPath, 
        modelName = modelName, 
        processID = processID
    )
    
    # Get the function name:
    functionName <- getFunctionNameFromPackageFunctionName(
        getFunctionName(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID
        )
    )
    
    # Get also the process parameters to detect whether showInMap is FALSE, in which case interactiveMode should be "none":
    showInMap <- getProcessParameters(projectPath = projectPath, modelName = modelName, processID = processID)$showInMap
    
    # Select the type of interactive mode depending on the output data type from the process:
    if(dataType %in% getRstoxFrameworkDefinitions("stratumDataType") && showInMap) {
        "stratum"
    }
    else if(dataType %in% getRstoxFrameworkDefinitions("acousticPSUDataType")) {
        "acousticPSU"
    }
    else if(dataType %in% getRstoxFrameworkDefinitions("bioticPSUDataType")) {
        "bioticPSU"
    }
    else if(dataType %in% getRstoxFrameworkDefinitions("acousticLayerDataType")) {
        "acousticLayer"
    }
    else if(dataType %in% getRstoxFrameworkDefinitions("bioticLayerDataType")) {
        "bioticLayer"
    }
    else if(dataType %in% getRstoxFrameworkDefinitions("bioticAssignmentDataType") && isProcessDataFunction(functionName)) {
        "bioticAssignment"
    }
    #else if(functionName == "StoxBiotic" && dataType %in% getRstoxFrameworkDefinitions("stationDataType") && showInMap) {
    else if(dataType %in% getRstoxFrameworkDefinitions("stationDataType") && showInMap) {
        "station"
    }
    #else if(functionName == "FilterStoxBiotic" && dataType %in% getRstoxFrameworkDefinitions("stationDataType") && showInMap) {
    #    "filterStation"
    #}
    else if(dataType %in% getRstoxFrameworkDefinitions("EDSUDataType") && showInMap) {
        "EDSU"
    }
    else {
        "none"
    }
}


# Functions for getting the appropriate process data from the process, called depending on the interactive mode:
#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
getInteractiveData  <- function(projectPath, modelName, processID) {
    
    # Get the interactive mode:
    interactiveMode <- getInteractiveMode(projectPath = projectPath, modelName = modelName, processID = processID)
    
    # Call the appropriate function depending on the interactive mode:
    if(interactiveMode == "stratum") {
        getStratumList(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID
        )
    }
    else if(interactiveMode == "bioticAssignment") {
        getBioticAssignmentData(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID
        )
    }
    else if(interactiveMode == "acousticPSU") {
        getAcousticPSUData(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID
        )
    }
    else if(interactiveMode == "bioticPSU") {
        getBioticPSUData(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID
        )
    }
    else if(interactiveMode == "acousticLayer") {
        getAcousticLayerData(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID
        )
    }
    else if(interactiveMode == "bioticLayer") {
        getBioticLayerData(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID
        )
    }
    else {
        stop("StoX: Invalid interactiveMode")
    }
}

# Functions for getting the appropriate map data from the process, called depending on the map mode:
#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
getMapData  <- function(projectPath, modelName, processID) {
    
    # Get the interactive mode:
    interactiveMode <- getInteractiveMode(projectPath = projectPath, modelName = modelName, processID = processID)
    
    # Call the appropriate function depending on the interactive mode:
    if(interactiveMode == "stratum") {
        getStratumData(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID
        )
    }
    #else if(interactiveMode %in% c("station", "filterStation")) {
    else if(interactiveMode == "station") {
        getStationData(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID
        )
    }
    else if(interactiveMode == "EDSU") {
        getEDSUData(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID
        )
    }
    else {
        warning("StoX: No map data available from the process ", processID, " of model ", modelName, " of project ", projectPath)
        #geojsonio::geojson_json(getRstoxFrameworkDefinitions("emptyStratumPolygon"))
        getRstoxFrameworkDefinitions("emptyStratumPolygonGeojson")
    }
}


# Individual get data functions:
getStratumData <- function(projectPath, modelName, processID) {
    
    # Get the process data:
    processData <- getProcessData(projectPath = projectPath, modelName = modelName, processID = processID)
    # Return an empty StratumPolygon if processData is empty:
    # Change this to an error?????????????????
    if(length(processData) == 0) {
        return(getRstoxFrameworkDefinitions("emptyStratumPolygon"))
    }
    
    # Issue an error of the process data are not of StratumPolygon type:
    if(names(processData) != "StratumPolygon"){
        processName <- getProcessName(projectPath = projectPath, modelName = modelName, processID = processID)
        warning("StoX: The process ", processName, " does not return process data of type StratumPolygon")
        return(NULL)
    }
    
    # Return if the StratumPolygon is empty:
    if(!length(processData$StratumPolygon)) {
        return(list(stratumPolygon = geojsonsf::sf_geojson(processData$StratumPolygon, simplify = FALSE)))
    }
    
    # Add StratumName, as this is used by the GUI:
    processData$StratumPolygon$StratumName <- getStratumNames(processData$StratumPolygon)
    
    # Create the objects EDSU_PSU, PSU_Stratum and Stratum
    # On 2020-12-21 changed to using geojsonsf to reduce depencdencies:
    #stratumPolygon <- geojsonio::geojson_json(processData$StratumPolygon)
    stratumPolygon <- geojsonsf::sf_geojson(processData$StratumPolygon, simplify = FALSE)
    
    #stratum <- data.table::data.table(
    #    stratum = names(processData), 
    #    includeInTotal = 
    #)
    
    return(list(stratumPolygon = stratumPolygon))
    #stratumPolygon
}

# Function to get acousic PSU data:
getAcousticPSUData <- function(projectPath, modelName, processID) {
    
    # Get the process data:
    processData <- getProcessData(projectPath = projectPath, modelName = modelName, processID = processID)
    # Issue an error of the process data are not of AcousticPSU type:
    if(! "EDSU_PSU" %in% names(processData)){
        processName <- getProcessName(projectPath = projectPath, modelName = modelName, processID = processID)
        warning("StoX: The process ", processName, " does not return process data of type AcousticPSU")
        return(NULL)
    }
    
    return(processData)
}

# Function to get swept-area PSU data:
getBioticPSUData <- function(projectPath, modelName, processID) {
    
    # Get the process data:
    processData <- getProcessData(projectPath = projectPath, modelName = modelName, processID = processID)
    # Issue an error of the process data are not of BioticPSU type:
    if(! "Station_PSU" %in% names(processData)){
        processName <- getProcessName(projectPath = projectPath, modelName = modelName, processID = processID)
        warning("StoX: The process ", processName, " does not return process data of type BioticPSU")
        return(NULL)
    }
    
    return(processData)
}

# Function to get acousic PSU data:
getAcousticLayerData <- function(projectPath, modelName, processID) {
    
    # Get the process data:
    processData <- getProcessData(projectPath = projectPath, modelName = modelName, processID = processID)
    # Issue an error of the process data are not of AcousticPSU type:
    if(! "AcousticLayer" %in% names(processData)){
        processName <- getProcessName(projectPath = projectPath, modelName = modelName, processID = processID)
        warning("StoX: The process ", processName, " does not return process data of type AcousticLayer")
        return(NULL)
    }
    
    return(processData)
}

# Function to get swept-area PSU data:
getBioticLayerData <- function(projectPath, modelName, processID) {
    
    # Get the process data:
    processData <- getProcessData(projectPath = projectPath, modelName = modelName, processID = processID)
    # Issue an error of the process data are not of BioticPSU type:
    if(! "BioticLayer" %in% names(processData)){
        processName <- getProcessName(projectPath = projectPath, modelName = modelName, processID = processID)
        warning("StoX: The process ", processName, " does not return process data of type BioticLayer")
        return(NULL)
    }
    
    return(processData)
}

# Function to get biotic assignment data:
getBioticAssignmentData <- function(projectPath, modelName, processID) {
    
    # Get the process data:
    processData <- getProcessData(projectPath = projectPath, modelName = modelName, processID = processID)
    # Issue an error of the process data are not of BioticAssignment type:
    if(names(processData) != "BioticAssignment"){
        processName <- getProcessName(projectPath = projectPath, modelName = modelName, processID = processID)
        warning("StoX: The process ", processName, " does not return process data of type BioticAssignment")
        return(NULL)
    }
    
    ### # Create the objects EDSU_PSU, PSU_Stratum and Stratum
    ### PSU_Layer_AssignmentID <- unique(processData$Assignment[, c("PSU", "Layer", "AssignmentID")])
    ### AssignmentID_Station_StationWeight <- unique(processData$Assignment[, c("AssignmentID", "Station", "StationWeight")])
    ### 
    ### # Return the list of data.tables:
    ### list(
    ###     PSU_Layer_AssignmentID = PSU_Layer_AssignmentID, 
    ###     AssignmentID_Station_StationWeight = AssignmentID_Station_StationWeight
    ### )
    return(processData)
}


# Function to get a list of strata names:
getStratumList <- function(projectPath, modelName, processID) {
    
    # Get the process data:
    processData <- getProcessData(projectPath = projectPath, modelName = modelName, processID = processID)
    # Return an empty list if processData is empty:
    if(length(processData) == 0) {
        return(list())
    }
    
    # Issue an error of the process data are not of StratumPolygon type:
    if(names(processData) != "StratumPolygon"){
        processName <- getProcessName(projectPath = projectPath, modelName = modelName, processID = processID)
        warning("StoX: The process ", processName, " does not return process data of type StratumPolygon")
        return(list())
    }
    
    # Create the objects EDSU_PSU, PSU_Stratum and Stratum
    stratumList <- as.list(RstoxBase::getStratumNames(processData$StratumPolygon))
    #stratum <- data.table::data.table(
    #    stratum = names(processData), 
    #    includeInTotal = 
    #)
    
    #list(stratumList)
    return(stratumList)
}

# Function to get a list of station data:
getStationData <- function(projectPath, modelName, processID) {
    # Get the station data:
    Cruise <- getProcessOutput(projectPath = projectPath, modelName = modelName, processID = processID, tableName = "Cruise")$Cruise
    Station <- getProcessOutput(projectPath = projectPath, modelName = modelName, processID = processID, tableName = "Station")$Station
    CruiseStation <- merge(Cruise, Station, by = intersect(names(Cruise), names(Station)))
    
    Haul <- getProcessOutput(projectPath = projectPath, modelName = modelName, processID = processID, tableName = "Haul")$Haul
    Station_Haul <- merge(Station, Haul, by = intersect(names(Station), names(Haul)))
    
    # Split the Station table into the coordinates and the properties:
    #coordinateNames <- c("Longitude", "Latitude")
    #coordinates <- CruiseStation[, ..coordinateNames]
    
    #rownames(coordinates) <- Station$Station
    #infoToKeep <- c("CruiseKey", "Platform", "StationKey", "Station", "CatchPlatform", "DateTime", "Longitude", "Latitude", "BottomDepth")
    stationInfoToKeep <- c("Station", "Platform", "DateTime", "Longitude", "Latitude", "BottomDepth")
    stationInfo <- CruiseStation[, ..stationInfoToKeep]
    #properties <- stationInfo[, "Station"]
    
    haulInfoToKeep <- c("Station", "Haul", "Gear", "EffectiveTowDistance", "MinHaulDepth", "MaxHaulDepth")
    haulInfo <- Station_Haul[, ..haulInfoToKeep]
    
    
    #properties <- Station[, !(colnames(Station) %in% c("Longitude", "Latitude")), with = FALSE]
    #rownames(properties) <- Station$Station
    
    # Add the haul info as a property, wrapped in a JSON string:
    #HaulInfo <- Station_Haul[, .(HaulInfo = jsonlite::toJSON(.SD)), .SDcols = names(Haul), by = Station]
    #properties$HaulInfo <- HaulInfo$HaulInfo
    
    # Create a spatial points data frame and convert to geojson:
    #stationPoints <- sp::SpatialPointsDataFrame(coordinates, properties, match.ID = TRUE)
    stationPoints <- dataTable2sf_POINT(CruiseStation, coords = c("Longitude", "Latitude"), idCol = "Station")
    #stationPoints <- geojsonio::geojson_json(stationPoints)
    #stationPoints <- geojsonsf::sf_geojson(sf::st_as_sf(stationPoints))
    stationPoints <- geojsonsf::sf_geojson(stationPoints)
    
    return(
        list(
            stationPoints = stationPoints, 
            stationInfo = stationInfo, 
            haulInfo = haulInfo
        )
    )
}

# Function to get EDSU data:
getEDSUData <- function(projectPath, modelName, processID) {
    
    # Get the Log data:
    tableNames <- c(
        "Cruise", 
        "Log", 
        "Beam"
    )
    EDSUData <- sapply(tableNames, function(tableName) getProcessOutput(projectPath = projectPath, modelName = modelName, processID = processID, tableName = tableName)[[tableName]], simplify = FALSE)
    CruiseLog <- RstoxData::mergeDataTables(EDSUData, tableNames = tableNames, output.only.last = TRUE)
    # Uniquify in case e.g. there are data from different instruments:
    #EDSUInfoToKeep <- c("EDSU", "Platform", "Log", "DateTime", "Longitude", "Latitude", "EffectiveLogDistance", "BottomDepth")
    EDSUInfoToKeep <- c("EDSU", "Longitude", "Latitude", "LogDistance")
    CruiseLog <- unique(CruiseLog, by = EDSUInfoToKeep)
    
    # Order by Beam:
    setorderv(CruiseLog, c("Beam", "EDSU"))
    
    # Extrapolate: 
    #if(!all(is.na(CruiseLog$LogOrigin)) && !all(is.na(CruiseLog$LogOrigin2))) {
        CruiseLog <- extrapolateEDSU(CruiseLog)
    #}
    
    # Define two feature collections, (1) one for the click points for the EDSUs with properties such as position, time, log etc., and (2) the line segments from start to stop point, with the property 'interpolated':
    
    # (1) Click points:
    # Extract the click points:
    #coordinateNames <- c("Longitude", "Latitude")
    #clickPointNames <- c("clickLongitude", "clickLatitude")
    #clickPoints <- CruiseLog[, ..clickPointNames]
    #data.table::setnames(clickPoints, old = clickPointNames, new = coordinateNames)
    
    # ...and define the properties:
    #infoToKeep <- c("CruiseKey", "Platform", "LogKey", "Log", "EDSU", "DateTime", "Longitude", "Latitude", "LogOrigin", "Longitude2", "Latitude2", "LogOrigin2", "LogDuration", "LogDistance", "EffectiveLogDistance", "BottomDepth")
    EDSUInfo <- CruiseLog[, ..EDSUInfoToKeep]
    #properties <- EDSUInfo[, "EDSU"]
    
    # Create a spatial points data frame and convert to geojson:
    #EDSUPoints <- sp::SpatialPointsDataFrame(clickPoints, properties, match.ID = FALSE)
    EDSUPoints <- dataTable2sf_POINT(CruiseLog, coords = c("Longitude", "Latitude"), idCol = "EDSU")
    #EDSUPoints <- geojsonio::geojson_json(EDSUPoints)
    #EDSUPoints <- geojsonsf::sf_geojson(sf::st_as_sf(EDSUPoints))
    EDSUPoints <- geojsonsf::sf_geojson(EDSUPoints, simplify = FALSE)
    
    # (2) Line segments:
    ##lineStrings <- CruiseLog[, sp::Line(cbind(c(startLongitude, endLongitude), c(startLatitude, endLatitude))), by = EDSU]
    #LineList <- apply(
    #    CruiseLog[, c("startLongitude", "endLongitude", "startLatitude", "endLatitude")], 
    #    1, 
    #    function(x) sp::Line(array(x, dim = c(2, 2)))
    #)
    #LinesList <- lapply(seq_along(LineList), function(ind) sp::Lines(LineList[[ind]], ID = CruiseLog$EDSU[ind]))
    #EDSULines <- sp::SpatialLines(LinesList)
    #EDSULines <- sp::SpatialLinesDataFrame(EDSULines, data = CruiseLog[, "interpolated"], match.ID = FALSE)
    ##EDSULines <- geojsonio::geojson_json(EDSULines)
    #EDSULines <- geojsonsf::sf_geojson(sf::st_as_sf(EDSULines))
    
    # geojsonsf::sf_geojson could not handle an extra column in the linestrings:
    #EDSULines <- dataTable2sf_LINESTRING(CruiseLog, x1x2y1y2 = c("startLongitude", "endLongitude", "startLatitude", "endLatitude"), idCol = "interpolated")
    EDSULines <- dataTable2sf_LINESTRING(CruiseLog, x1x2y1y2 = c("startLongitude", "startLatitude", "endLongitude", "endLatitude"))
    EDSULines <- geojsonsf::sf_geojson(EDSULines, simplify = FALSE)
    
    ## List the points and lines and return:
    #EDSUData <- list(
    #    EDSUPoints = EDSUPoints, 
    #    EDSULines = EDSULines
    #)
    
    return(
        list(
            EDSUPoints = EDSUPoints, 
            EDSULines = EDSULines, 
            EDSUInfo = EDSUInfo
        )
    )
    #return(EDSUData)
}


#Log2SpatialLinesPolygon <- function(Log) {
#    
#    getLine <- function(Log) {
#        l <- cbind(
#            c(Log$startLongitude, Log$endLongitude), 
#            c(Log$startLatitude, Log$endLatitude)
#        )
#        L <- Line(l)
#        Lines(list(L), ID = Log$EDSU)
#        
#    }
#    segments <- Log[, getLine(.SD), .SDcols = names(Log)]
#    
#    
#        
#            
#    
#    ## from the sp vignette:
#    l1 <- cbind(c(1, 2, 3), c(3, 2, 2))
#    l2 <- cbind(c(1, 2, 3), c(1, 1.5, 1))
#    
#    Sl1 <- Line(l1)
#    Sl2 <- Line(l2)
#    
#    S1 <- Lines(list(Sl1), ID = "a")
#    S2 <- Lines(list(Sl2), ID = "b")
#    
#    Sl <- SpatialLines(list(S1, S2))
#    
#    
#}
 


extrapolateEDSU <- function(Log, pos = 0.5) {
    # Run the extrapolation function on each Paltform, effectively ordering the data by platform:
    Log <- Log[, extrapolateLongitudeLatitude(.SD), by = CruiseKey, .SDcols = names(Log)]
    
    # Get the click points of the EDSUs:
    Log <- getClickPoints(Log, pos = pos)
    
    Log
}


getClickPoints <- function(Log, pos = 0.5) {
    # Create the click points as a weighted average of the start and end points:
    Log$clickLongitude <- (Log$startLongitude * (1 - pos) + Log$endLongitude * pos)
    Log$clickLatitude <- (Log$startLatitude * (1 - pos) + Log$endLatitude * pos)
    Log
}

# Function to extract the start, middle and end positions from StoxBiotic:
getStartMiddleEndPosition <- function(Log, positionOrigins = c("start", "middle", "end"), coordinateNames = c("Longitude", "Latitude")) {
    
    # Get the number of positions of the Log:
    numPositions <- nrow(Log)
    
    # Define the position names:
    positionNames <- c(outer(positionOrigins, coordinateNames, paste0))
    
    # Create a table with missing positions:
    positionsNA <- data.table::as.data.table(
        array(NA_real_, dim = c(numPositions, length(positionNames)), dimnames = list(NULL, positionNames))
    )
    # Fill in the present data:
    #if(!all(Log$LogOrigin[1] == Log$LogOrigin && Log$LogOrigin2[1] == Log$LogOrigin2)) {
    if(!Log[, RstoxBase::allEqual(LogOrigin) && RstoxBase::allEqual(LogOrigin2)]) {
        hasSomeNAs <- Log[, any(is.na(LogOrigin)) && any(!is.na(LogOrigin))]
        hasSomeNAs2 <- Log[, any(is.na(LogOrigin2)) && any(!is.na(LogOrigin2))]
        onlyLastLogIsNA <- Log[, is.na(utils::tail(LogOrigin, 1)) && sum(is.na(LogOrigin)) == 1]
        onlyLastLogIsNA2 <- Log[, is.na(utils::tail(LogOrigin2, 1)) && sum(is.na(LogOrigin2)) == 1]
        if(onlyLastLogIsNA || onlyLastLogIsNA2) {
            stop("StoX: The last LogOrigin or LogOrigin2 is NAs, which suggests an incomplete file. Try using FilterStoxAcoustic() to filter out LogOrigin or LogOrigin2 that are NA.")
        }
        if(hasSomeNAs || hasSomeNAs2) {
            stop("StoX: Some LogOrigin or LogOrigin2 are NAs. Try using FilterStoxAcoustic() to filter out LogOrigin or LogOrigin2 that are NA.")
        }
        else {
            stop("StoX: LogOrigin or LogOrigin2 is not constant")
        }
    }
    
    presentNames <- c(outer(Log[1, c(LogOrigin, LogOrigin2)], c("Longitude", "Latitude"), paste0))
    presentVariables <- c("Longitude", "Longitude2", "Latitude", "Latitude2")
    # Do not add the presentNames that start with NA:
    startingWithNA <- startsWith(presentNames, "NA")
    if(any(startingWithNA)) {
        presentNames <- presentNames[!startingWithNA]
        presentVariables <- presentVariables[!startingWithNA]
    }
    # Fill in the positions:
    positionsNA[, presentNames] <- Log[, ..presentVariables]
    
    # Add the missing positions to the Log:
    Log <- cbind(Log, positionsNA)
    
    Log
}

# Add stop position of the EDSUs for plotting in the map:
extrapolateLongitudeLatitude <- function(Log) {
    
    # Funciton to map values outside of a range to the maximum value:
    mapToRange <- function(x, length) {
        x[x < 1] <- 1
        x[x > length] <- length
        return(x)
    }
    
    # Get the number of positions of the Log:
    numPositions <- nrow(Log)
    
    # Extract the start, middle and end position:
    Log <- getStartMiddleEndPosition(Log)
    
    # Add the 'interpolated' tag:
    Log$interpolated <- FALSE
    
    # Detect missing values:
    naStart <- is.na(Log$startLongitude) | is.na(Log$startLatitude)
    naMiddle <- is.na(Log$middleLongitude) | is.na(Log$middleLatitude)
    naEnd <- is.na(Log$endLongitude) | is.na(Log$endLatitude)
    StartNotEnd <- which(!naStart & naEnd)
    onlyMiddle <- which(naStart & !naMiddle & naEnd)
    EndNotStart <- which(naStart & !naEnd)
    
    
    truncateTo1_length <- function(x, length) {
        x[x <= 0] <- 1
        x[x >= length] <- length
        return(x)
    }
    
    # Interpolate:
    if(length(StartNotEnd)) {
        Log[StartNotEnd, c("endLongitude", "endLatitude")] <- Log[mapToRange(StartNotEnd + 1, numPositions), c("startLongitude", "startLatitude")]
        Log$interpolated[StartNotEnd] <- TRUE
    }
    if(length(onlyMiddle)) {
        Log[onlyMiddle, c("startLongitude", "startLatitude")] <- (
            Log[mapToRange(onlyMiddle - 1, numPositions), c("middleLongitude", "middleLatitude")] +
            Log[onlyMiddle, c("middleLongitude", "middleLatitude")]
        ) / 2
        
        Log[onlyMiddle, c("endLongitude", "endLatitude")] <- (
            Log[onlyMiddle, c("middleLongitude", "middleLatitude")] + 
            Log[mapToRange(onlyMiddle + 1, numPositions), c("middleLongitude", "middleLatitude")]
        ) / 2
        Log$interpolated[onlyMiddle] <- TRUE
    }
    if(length(EndNotStart)) {
        Log[EndNotStart, c("startLongitude", "startLatitude")] <- Log[mapToRange(EndNotStart - 1, numPositions), c("endLongitude", "endLatitude")]
        Log$interpolated[EndNotStart] <- TRUE
    }

    Log
}




#' Define color scale for EDSU map data:
#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
getEDSUColours <- function(n = 5, as.rgb = FALSE, col = c("pink", "red4", "darkorange2")) {
    col <- grDevices::colorRampPalette(col)(n)
    if(as.rgb) {
        col <- grDevices::col2rgb(col)
    }
    return(col)
}

#' Define color scale for Station map data:
#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
getStationColours <- function(n = 5, as.rgb = FALSE, col = c("steelblue2", "darkblue", "mediumvioletred")) {
    col <- grDevices::colorRampPalette(col)(n)
    if(as.rgb) {
        col <- grDevices::col2rgb(col)
    }
    return(col)
}





##########



##### Process properties: #####


getFormatClass <- function(format) {
    # Get the format definitions:
    processPropertyFormats <- getRstoxFrameworkDefinitions("processPropertyFormats")
    # Extract the classes:
    formatClass <- lapply(format, function(thisFormat) processPropertyFormats[[thisFormat]]$class)
    # Replace unknown by "single":
    formatClass[lengths(formatClass) == 0] <- "none"
    # Unlist to a vector:
    formatClass <- unlist(formatClass)
    
    return(formatClass)
}

isVectorParameter <- function(format) {
    # Find those formats that are vector:
    getFormatClass(format) == "vector"
}
isSingleParameter <- function(format) {
    # Find those formats that are vector:
    getFormatClass(format) == "single"
}


#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
getProcessPropertySheet <- function(projectPath, modelName, processID) {
    
    # The project properties contains the following elements:
    # 1. name
    # 2. displayName
    # 3. description
    # 4. type
    # 5. format
    # 6. possibleValues
    # 7. value
    
    # Possible values of 'type':
    # "integer"
    # "double"
    # "logical"
    # "character"
    
    # Possible values of 'format':
    # "none"
    # "filterExpressionTable"
    # "filePath"
    # "filePaths"
    # "directoryPath"
    # "catchabilityTable"
    # "NASCTable"
    # "length2TSTable" 
    # "speciesCategoryTable"
    # "acousticCategoryTable" 
    
    #######################
    ##### 1. Process: #####
    #######################
    
    # Get the process properties to return, which are all but the processData:
    functionName <- getFunctionName(projectPath = projectPath, modelName = modelName, processID = processID)
    processName <- getProcessName(projectPath = projectPath, modelName = modelName, processID = processID)
    processParameters <- getProcessParameters(projectPath = projectPath, modelName = modelName, processID = processID)
    functionInputs <- getFunctionInputs(projectPath = projectPath, modelName = modelName, processID = processID)
    functionParameters <- getFunctionParameters(projectPath = projectPath, modelName = modelName, processID = processID)
    
    # Get the process properties depending on the processPropertyName:
    #processParameters <- getRstoxFrameworkDefinitions("processParameters")
    processParametersDisplayNames <- getRstoxFrameworkDefinitions("processParametersDisplayNames")
    processParametersDescriptions <- getRstoxFrameworkDefinitions("processParametersDescriptions")
    processParameterNames <- names(processParameters)
    
    
    ##### Define the process name, the function name and the process parameters as the process property "process": #####
    processArgumentsToReturn <- data.table::data.table(
        # 1. name:
        name = as.list(c(
            "processName", 
            "functionName", 
            processParameterNames
        )), 
        # 2. displayName:
        displayName = as.list(c(
            "Process name", 
            "Function", 
            unname(unlist(processParametersDisplayNames))
        )), 
        # 3. description:
        description = as.list(c(
            "The name of the process, which must be unique within each model", 
            "The name of the function called by the process", 
            processParametersDescriptions
        )), 
        # 4. type:
        type = as.list(c(
            "character", 
            "character", 
            sapply(processParameters, getRelevantClass)
        )), 
        # 5a. format:
        # The number 2 is functionName and processName:
        format = as.list(rep("none", 2 + length(processParameters))), 
        # 5b. formatClass:
        formatClass = as.list(rep("single", 2 + length(processParameters))), 
        # 6. possibleValues:
        possibleValues = c(
            list(NULL), 
            # Set this as list to ensure that we keep the square brackets "[]" in the JSON string even with auto_unbox = TRUE.
            as.list(getAvailableStoxFunctionNames(modelName)), 
            # Removed the possible values for logicals, since these are not used as dropdown in the GUI, but rather as a checkbox:
            rep(list(c(FALSE, TRUE)), length(processParameters))
            #rep(list(character(1)), length(processParameters))
        ), 
        # 7. value:
        value = c(
            processName, 
            # Remove the package address and only use the function name:
            getFunctionNameFromPackageFunctionName(functionName), 
            processParameters
        )
    )
    
    # Remove the showInMap argument if not relevant:
    if(!getCanShowInMap(functionName)) {
        keep <- c(
            TRUE, 
            TRUE, 
            processParameterNames != "showInMap"
        )
        processArgumentsToReturn <- processArgumentsToReturn[keep, ]
    }
    
    # Convert all possibleValues and value to character:
    toJSONString(processArgumentsToReturn)
    #######################
    
    
    # Declare functionInputs and functionParameters and 
    functionInputsToReturn <- data.table::data.table()
    functionParametersToReturn <- data.table::data.table()
    
    if(length(functionName)) {
        
        ##############################
        ##### 2. FunctionInputs: #####
        ##############################
        # Run only if there are function inputs:
        if(length(functionInputs)) {
            # Get the process table, which is needed to get the output data types from the prior processes for use in the function inputs:
            # scanForModelError is enough...
            #processTable <- getProcessTable(projectPath = projectPath, modelName = modelName, beforeProcessID = processID)
            #processTable <- scanForModelError(projectPath = projectPath, modelName = modelName, beforeProcessID = processID)
            processTable <- scanForModelError(projectPath = projectPath, modelName = NULL, beforeProcessID = processID)
            
            #thisProcessIndex <- which(processTable$processID == processID)
            #processTable <- processTable[seq_len(thisProcessIndex), ]
            functionInputNames <- names(functionInputs)
            
            # Define the function inputs:
            functionInputsToReturn <- data.table::data.table(
                # 1. name:
                name = as.list(functionInputNames), 
                # 2. displayName:
                displayName = as.list(functionInputNames), 
                # 3. description:
                description = getStoxFunctionMetaData(functionName, "functionArgumentDescription")[functionInputNames], 
                # 4. type:
                type = as.list(rep("character", length(functionInputNames))),
                # 5a. format:
                format = as.list(rep("none", length(functionInputNames))),
                # 5b. formatClass:
                formatClass = as.list(rep("single", length(functionInputNames))),
                # 6. possibleValues:
                #possibleValues = lapply(functionInputNames, getProcessNamesByDataType, processTable = processTable),
                # Set each element (using as.list()) as list to ensure that we keep the square brackets "[]" in the JSON string even with auto_unbox = TRUE.
                #possibleValues = lapply(lapply(functionInputNames, getProcessNamesByDataType, processTable = processTable), as.list),
                possibleValues = lapply(functionInputNames, getProcessNamesByDataType, processTable = processTable),
                # 7. value:
                value = functionInputs
            )
            
            # Convert all possibleValues and value to character:
            toJSONString(functionInputsToReturn)
        }
        ##############################
        
        
        ##################################
        ##### 3. FunctionParameters: #####
        ##################################
        
        # Run only if there are function parameters (which there always will be):
        if(length(functionParameters)) {
            # Get the names of the function parameters:
            functionParameterNames <- names(functionParameters)
            
            format <- getFunctionParameterFormats(functionName)[functionParameterNames]
            
            # Define the function parameters:
            functionParametersToReturn <- data.table::data.table(
                # 1. name:
                name = as.list(functionParameterNames), 
                # 2. displayName:
                displayName = as.list(functionParameterNames), 
                # 3. description:
                description = getStoxFunctionMetaData(functionName, "functionArgumentDescription")[functionParameterNames], 
                # 4. type:
                type = getStoxFunctionParameterTypes(functionName)[functionParameterNames],
                # 5a. format:
                format = format,
                # 5b. formatClass:
                formatClass = getFormatClass(format),
                # 6. possibleValues:
                # Set this as list to ensure that we keep the square brackets "[]" in the JSON string even with auto_unbox = TRUE.
                #possibleValues = ifelse(
                #    isSingleParameter(format), 
                #    # Format class "single" used for data dependent possigle values:
                #    mapply(
                #        getParameterVectorPossibleValues,
                #        projectPath = projectPath, 
                #        modelName = modelName, 
                #        processID = processID, 
                #        format = format, 
                #        stopIfEmptyPossibleValues = FALSE, 
                #        SIMPLIFY = FALSE, 
                #        USE.NAMES = FALSE
                #    ),
                #    # Use the default values of the parameter:
                #    getStoxFunctionParameterPossibleValues(functionName)[functionParameterNames]
                #),
                
                possibleValues = getStoxFunctionParameterPossibleValues(functionName)[functionParameterNames], 
                # 7. value:
                value = functionParameters
            )
            
            # Convert to a JSON string if the parameter has a format:
            hasFormat <- functionParametersToReturn$format != "none"
            #if(any(hasFormat)) {
            #    functionParametersToReturn$value[hasFormat] = lapply(functionParametersToReturn$value[hasFormat], formatJSONString)
            #}
            
            # Convert all possibleValues and value to character:
            toJSONString(functionParametersToReturn)
        }
        
        # Apply the StoX funciton argument hierarcy here using getStoxFunctionMetaData("functionArgumentHierarchy"):
        argumentsToShow <- getArgumentsToShow(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID
        )
        
        # Select only the items to show in the GUI:
        if(length(functionParametersToReturn) && any(!functionParametersToReturn$name %in% argumentsToShow)) {
            functionParametersToReturn <- subset(functionParametersToReturn, name %in% argumentsToShow)
        }
        if(length(functionInputsToReturn) && any(!functionInputsToReturn$name %in% argumentsToShow)) {
            functionInputsToReturn <- subset(functionInputsToReturn, name %in% argumentsToShow)
        }
    }
    
    # Create a list of the different properties, adding category and displayName:
    propertySheet <- list(
        list(
            groupName = "processArguments", 
            displayName = "Process", 
            properties = processArgumentsToReturn
        ), 
        list(
            groupName = "functionInputs", 
            displayName = "Function inputs", 
            properties = functionInputsToReturn
        ), 
        list(
            groupName = "functionParameters", 
            displayName = "Function parameters", 
            properties = functionParametersToReturn
        )
    )
    
    # Set the propertyDirty flag to FALSE, so that a GUI can update the properties:
    # Do we really need this??????????????!!!!!!!!!!!!!!!!!!!!
    #### writeActiveProcessID(projectPath, modelName, propertyDirty = FALSE)
    
    # Return the list of process property groups (process property sheet):
    output <- list(
        propertySheet = propertySheet, 
        activeProcess = getActiveProcess(projectPath = projectPath, modelName = modelName)
    )
    output
}


# Function that gets the process names of the processes returning the specified data type
getProcessNamesByDataType <- function(dataType, processTable) {
    hasRequestedDataType <- processTable$functionOutputDataType == dataType
    if(any(hasRequestedDataType)) {
        output <- processTable$processName[hasRequestedDataType]
    }
    else {
        output <- NULL
    }
    
    ### This is a trick to keep arrays through jsonlite::toJSON, and must happen here (before the data.table is created):
    #as.list(output)
    return(output)
}

# Function to replace an empty object by double(0) or character(1), which results in [] in JSON (since OpenCPU uses auto-unbox = TRUE):
replaceEmpty <- function(x, vector = TRUE) {
    areEmpty <- lengths(x) == 0
    if(any(areEmpty)) {
        if(vector) {
            x[areEmpty] <- rep(list(double(0)), sum(areEmpty))
        }
        else {
            x[areEmpty] <- rep(list(character(1)), sum(areEmpty))
        }
    }
    x   
}


# Function to convert to JSON string, used to send only strings and arrays of strings to the GUI:
toJSONString <- function(DT) {
    
    # Convert the possible values, which can have 0 or positive length:
    ####possibleValuesToJSONString(DT)
    #DT[, possibleValues := lapply(possibleValues, vectorToJSONStringOne, stringifyVector = FALSE)]
    DT[, possibleValues := lapply(possibleValues, possibleValuesToJSONStringOne, nrow = nrow(DT))]
    
    # Convert vector value:
    atVector <- isVectorParameter(DT$format)
    if(any(atVector)) {
        DT[atVector, value := lapply(value, vectorToJSONStringOne, stringifyVector = TRUE)]
    }
    
    # Convert all the other columns, which are required to have length 1:
    other <- setdiff(names(DT), "possibleValues")
    cellToJSONString(DT, cols = other)
    DT[]
}



cellToJSONString <- function(DT, cols) {
    DT[, (cols) := lapply(.SD, cellToJSONStringOneColumn), .SDcols = cols]
}
cellToJSONStringOneColumn <- function(x) {
    lapply(x, cellToJSONStringOne)
}
cellToJSONStringOne <- function(x) {
    if(length(x) == 0) {
        #warning("StoX: Length 1 required for process properties except possibleValues.")
        x <- ""
    }
    if(!is.character(x)) {
        x <- as.character(toJSON_Rstox(x))
    }
    return(x)
}





#vectorToJSONString <- function(DT) {
#    output <- DT[, possibleValues := lapply(possibleValues, vectorToJSONStringOne, nrow = nrow(DT))]
#    return(output)
#}

# The parameter nrow is needed to ensure that data.table does not intruduce an extra list when there is more than one row and one of the cells has only one element:
vectorToJSONStringOne <- function(x, stringifyVector = TRUE) {
    # Set empty possible values to numeric(), which ensures [] in OpenCPUs conversion to JSON (jsonlite::toJSON with auto_unbox = TRUE):
    if(length(x) == 0) {
        x <- numeric()
        #as.character(jsonlite::toJSON(x, auto_unbox = TRUE))
    }
    
    ## If data.table, simply convert to JSON string:
    #else if(data.table::is.data.table(x)) {
    #    as.character(jsonlite::toJSON(x, auto_unbox = TRUE))
    #}
    
    # Convert to JSON string for each element if not already character:
    else if(!data.table::is.data.table(x)) {
        # Why was this used??????
        ### if(!is.character(x)) {
        ###     browser()
        ###     x <- sapply(x, function(y) as.character(toJSON_Rstox(y)))
        ### }
        if(length(x) == 1) {
            # This trick with a double list is to ensure that data.table actually converts to a list so that jsonlite returns square brackets (do not change this unless you really know what you are doing!!!!!!!!!!):
            x <- list(x)
        }
    }
    
    if(stringifyVector) {
        x <- as.character(toJSON_Rstox(x))
    }
    return(x)
}


# The parameter nrow is needed to ensure that data.table does not intruduce an extra list when there is more than one row and one of the cells has only one element:
possibleValuesToJSONStringOne <- function(x, nrow) {
    # Set empty possible values to numeric(), which ensures [] in OpenCPUs conversion to JSON (jsonlite::toJSON with auto_unbox = TRUE):
    if(length(x) == 0) {
        x <- numeric()
    }
    # Convert to JSON string for each element if not already character:
    else {
        if(!is.character(x)) {
            x <- sapply(x, function(y) as.character(toJSON_Rstox(y)))
        }
        if(length(x) == 1) {
            # This trick with a double list is to ensure that data.table actually converts to a list so that jsonlite returns square brackets (do not change this unless you really know what you are doing!!!!!!!!!!):
            if(nrow == 1) {
                x <- list(list(x))
            }
            else {
                x <- list(x)
            }
        }
    }
    return(x)
}





#' GUI function: Set procecss properties.
#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
setProcessPropertyValue <- function(groupName, name, value, projectPath, modelName, processID) {
    
    # Parse the value (this takes care of converting true to TRUE, interpret integers and strings, and even to parse JSON strings to R objects):
    #value <- parseParameter(value)
    #value <- jsonlite::fromJSON(value, simplifyVector = FALSE)
    value <- parseParameter(value, simplifyVector = FALSE)
    
    # The flag updateHelp is TRUE only if the functionName is changed:
    updateHelp <- FALSE
    changed <- FALSE
    
    # If the process property 'processArguments' is given, modify the process name, function name or process parameters:
    if(groupName == "processArguments") {
        # Modify process name:
        if(name == "processName") {
            # Format the process name:
            newProcessName <- formatProcessName(value)
            
            # Modify the process name:
            changed <- changed || modifyProcessName(
                projectPath = projectPath, 
                modelName = modelName, 
                processID = processID, 
                newProcessName = newProcessName, 
                strict = TRUE
            )
        }
        # Modify function name:
        else if(name == "functionName") {
            # Format the function name:
            newFunctionName <- formatFunctionName(value)
            # And get the full name of the function:
            newFunctionName <- getPackageFunctionName(newFunctionName)
            
            # Set updateHelp to TRUE, so that the GUI can update the help page only when needed:
            updateHelp <- TRUE
            
            # Modify function name:
            changed <- changed || modifyFunctionName(
                projectPath = projectPath, 
                modelName = modelName, 
                processID = processID, 
                newFunctionName = newFunctionName, 
                # As of RstoxFramework 3.6.0 defaults are supported:
                add.defaults = TRUE
            )
        }
        # Modify process parameter:
        else {
            # Create a list named with the process parameter to modify (only one process parameter can be modified by setProcessPropertyValue()):
            newProcessParameters <- stats::setNames(list(value), name)
            
            # All process parameters are logical:
            newProcessParameters <- formatProcessParameters(newProcessParameters)
            
            # Modify process parameter:
            changed <- changed || modifyProcessParameters(
                projectPath = projectPath, 
                modelName = modelName, 
                processID = processID, 
                newProcessParameters = newProcessParameters
            )
        }
    }
    # If the process property 'functionInputs' is given, modify the function inputs:
    if(groupName == "functionInputs") {
        # Create a list named with the process parameter to modify (only one process parameter can be modified by setProcessPropertyValue()):
        newFunctionInputs <- stats::setNames(list(value), name)
        
        # All process parameters are logical:
        newFunctionInputs <- formatFunctionInputs(newFunctionInputs)
        
        changed <- changed || modifyFunctionInputs(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID, 
            newFunctionInputs = newFunctionInputs
        )
    }
    # If the process property 'functionParameters' is given, modify the function parameters:
    if(groupName == "functionParameters") {
        ###    ### This is unnecessary, since jsonlite::fromJSON takes care of the types in parseParmeter() ###
        ###    # Convert to R object based on the type:
        ###    value <- convertFunctionParameter(
        ###        functionParameterName = name, 
        ###        functionParameterValue = value, 
        ###        functionName = getFunctionName(projectPath, modelName, processID)
        ###    )
        
        # Create a list named with the process parameter to modify (only one process parameter can be modified by setProcessPropertyValue()):
        newFunctionParameters <- stats::setNames(list(value), name)
        
        # Format the function parameters:
        functionName <- getFunctionName(projectPath = projectPath, modelName = modelName, processID = processID)
        newFunctionParameters <- formatFunctionParameters(newFunctionParameters, functionName = functionName, projectPath = projectPath, modelName = modelName, processID = processID)
        
        # Modify the process parameter:
        changed <- changed || modifyFunctionParameters(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID, 
            newFunctionParameters = newFunctionParameters
        )
    }
    
    if(changed) {
        # Reset the active process ID to the process before the modified process:
        resetModel(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID, 
            #processDirty = hasBeenRun(
            #    projectPath = projectPath, 
            #    modelName = modelName, 
            #    processID = processID
            #), 
            processDirty = TRUE, 
            shift = 0, 
            delete = c("memory", if(!hasUseOutputData(projectPath, modelName, processID)) "text"), 
            deleteCurrent = TRUE
        )
    }
    
    # Return the modified process properties:
    output <- getProcessPropertySheet(
        projectPath = projectPath, 
        modelName = modelName, 
        processID = processID
    )
    
    # Add the process table, so that the GUI can update the list of processes, and all its symbols:
    output <- c(
        list(processTable = getProcessTable(projectPath = projectPath, modelName = modelName)), 
        output
    )
    
    # Add updateHelp:
    output <- c(
        list(updateHelp = updateHelp), 
        output
    )
    # Add also the saved status:
    output$saved <- isSaved(projectPath)
    
    return(output)
}

# Convert to the type of the parameters:
convertFunctionParameter <- function(functionParameterName, functionParameterValue, functionName) {
    # Get the primitive type and the format:
    type <- getStoxFunctionParameterTypes(functionName)[functionParameterName]
    format = getFunctionParameterFormats(functionName)[functionParameterName]
    
    # Apply the conversion function:
    #if(format %in% c("single", "vector")) {
    if(format %in% "single") {
        # If empty string, convert to NULL for non-character type:
        if(is.character(functionParameterValue) && nchar(functionParameterValue) == 0 && type != "character") {
            functionParameterValue <- NULL
        }
        fun <- paste0("as.", type)
        functionParameterValue <- do.call(fun, list(functionParameterValue))
    }
    
    return(functionParameterValue)
}

##########


getPathToSingleFunctionPDF <- function(functionName) {
    # Extract the package name:
    packageName <- getPackageNameFromPackageFunctionName(functionName)
    # Build the path to the function PDF:
    pathToSingleFunctionPDF <- file.path(
        system.file("extdata", "singleFunctionPDFs", package = packageName), 
        paste(functionName, "pdf", sep = ".")
    )
    pathToSingleFunctionPDF
}



#' Function used by the GUI to display R documentation.
#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
getFunctionHelpAsHtml <- function(projectPath, modelName, processID, stylesheet = "") {
    
    # Extract the packageName::functionName:
    packageName_functionName <- getFunctionName(
        projectPath = projectPath, 
        modelName = modelName, 
        processID = processID
    )
    # Return empty string if the function name is missing:
    if(length(packageName_functionName) == 0 || nchar(packageName_functionName) == 0) {
        return("")
    }
    
    # Get the package and function name:
    packageName <- getPackageNameFromPackageFunctionName(packageName_functionName)
    functionName <- getFunctionNameFromPackageFunctionName(packageName_functionName)
    # Get the help:
    html <- getObjectHelpAsHtml(packageName = packageName, objectName = functionName, stylesheet = stylesheet)
    return(html)
}


#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
getObjectHelpAsHtml <- function(packageName, objectName, stylesheet = "") {
    
    if(objectName == "00Index") {
        # Parse the  Index:
        html <- tools::parse_Rd(system.file("html", "00Index.html", package = packageName))
        
        # Remove logo and arrows:
        html <- html[!grepl("Rlogo.svg", html)]
        html <- html[!grepl("left.jpg", html)]
        html <- html[!grepl("up.jpg", html)]
        html <- html[!grepl("DESCRIPTION", html)]
        
        # Find lines with links:
        docLinkMatch <- ".*href=\"(.+).html\">.*"
        atHref <- which(grepl(docLinkMatch, html))
        # Insert proper links which are expected by the GUI:
        for(at in atHref) {
            toReplace <- paste0(gsub(docLinkMatch, "\\1", html[at]), ".html")
            toReplaceBy <- paste0("../../", packageName, "/html/", toReplace)
            html[at] <- gsub(toReplace, toReplaceBy, html[at])
        }
        # Paste to one string:
        html <- paste(html, collapse="\n")
        
        return(html)
    }
    
    
    # Read the documentation database:
    db <- tools::Rd_db(packageName)
    # Add 00Index:
    db[["00Index.Rd"]] <- tools::parse_Rd(system.file('html', "00Index.html", package = packageName))
    
    # Write the help to file as html and read back:
    objectName.Rd <- paste0(objectName, ".Rd")
    
    # Get the links of the package:
    Links <- tools::findHTMLlinks(pkgDir = find.package(packageName))
    ## Add the index links of the Rstox packages:
    #Links <- c(
    #    Links, 
    #    structure(paste0("../../", packageName, "/html/00Index.html"), names = packageName)
    #)
    
    # Return empty string if the function 
    if(! objectName.Rd %in% names(db)) {
        return("")
    }
    
    # Write to a temporary file
    outfile <- tempfile(fileext = ".html")
    tools::Rd2HTML(
        db[[objectName.Rd]], 
        out = outfile, 
        package = packageName, 
        Links = Links, 
        stylesheet = stylesheet
    )
    html <- paste(readLines(outfile), collapse="\n")
    
    # This hack was needed as of R 4.1 or something, where the links all of a sudden were with "help" instead of "html":
    html  <-  gsub("/help/",  "/html/", html)
    
    # Add the index links of the Rstox packages:
    html  <-  gsub(
        "href=\"00Index.html\">Index",  
        paste0("href=\"../../", packageName, "/html/00Index.html\">Index"), 
        html
    )
    
    unlink(outfile, force = TRUE)
    
    return(html)
}



#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
getFilterOptionsAll <- function(projectPath, modelName, processID, include.numeric = TRUE, stopIfEmptyPossibleValues = FALSE) {

    # Run the process without saving and without filter:
    processOutput <- runProcess(projectPath = projectPath, modelName = modelName, processID = processID, msg = FALSE, returnProcessOutput = TRUE, replaceArgs = list(FilterExpression = list()))
    
    # Add a warning if the process output is empty:
    if(!length(processOutput)) {
        warnText <- paste0("StoX: The process used as input the process ", getProcessNameFromProcessID(projectPath = projectPath, modelName = modelName, processID = processID), " must bee run to use the filter expression builder.")
        if(stopIfEmptyPossibleValues) {
            stop(warnText)
        }
        #else {
        #    warning(warnText)
        #}
        return(emptyNamedList())
    }
    
    # If the process output is a list of lists, unlist the top level and add names separated by slash:
    processOutput <- unlistProcessOutput(processOutput)
    
    # Get the column names:
    name <- lapply(processOutput, names)
    
    # Get the data types:
    type <- lapply(processOutput, function(x) sapply(x, getRelevantClass))
    
    # Get the operators:
    operators <- lapply(type, function(x) if(length(x)) getRstoxFrameworkDefinitions("filterOperators")[x] else NULL)
    
    # Get a list of unique values for each column of each table:
    #options <- lapply(processOutput, getPossibleValuesOneTable, include.numeric = include.numeric)
    options <- mapply(getPossibleValuesOneTable, processOutput, type, include.numeric = include.numeric, SIMPLIFY = FALSE)
    options <- lapply(options, function(x) lapply(x, getOptionList))
    
    # Return the
    output <- lapply(
        seq_along(options),
        function(ind)
            structure(
                list(
                    mapply(
                        list,
                            name = name[[ind]],
                            type = type[[ind]],
                            operators = operators[[ind]],
                            options = options[[ind]],
                            SIMPLIFY = FALSE
                        )
                    ), 
                names = "fields"
                )
            )
    
    names(output) <- names(options)
    
    # Add the fields level:
    output <- list(
        tableNames = as.list1(names(output)),
        allFields = output
    )
    
    # Return a list of the tableNames, columnNames and possibleValues:
    return(output)
}

    

getOptionList <- function(option, digits = 6) {
    lapply(option, function(x) list(name = if(is.numeric(x)) format(x, digits = digits) else x, value = x))
}


getPossibleValuesOneTable <- function(table, type, include.numeric = FALSE, include.POSIXct = FALSE) {
    
    # Return empty named list if no input:
    if(length(table) == 0) {
        return(emptyNamedList())
    }
    
    # Get the indices of the variables to get possible values from:
    validInd <- seq_len(ncol(table))
    if(!include.numeric) {
        validInd <- setdiff(validInd, which(type %in% c("numeric", "integer", "double")))
    }
    if(!include.POSIXct) {
        validInd <- setdiff(validInd, which(type %in% c("POSIXct")))
    }
    
    #if(include.numeric) {
    #    validInd <- seq_len(ncol(table))
    #}
    #else {
    #    validInd <- which(! type %in% c("numeric", "integer", "double"))
    #}
    
    # Declare a list for the output, with empty on numeric type if include.numeric = FALSE
    output <- vector("list", ncol(table))
    # Unique and then sort each column:
    output[validInd] <- lapply(table[, ..validInd], sortUnique)
    
    #lapply(table, sortUnique)
    output
}

# Simple function to sort the unique values:
sortUnique <- function(y) {
    # 2020-06-18 Added na.last = FALSE to include NAs in the filter options:
    #sort(unique(y), na.last = FALSE)
    
    # Get first the unique values, then check that the length of these are not identical to the length of the vector, and then sort:
    uniquey <- unique(y)
    
    #if(length(uniquey) < length(y)) {
    #    sort(uniquey, na.last = FALSE)
    #}
    #else {
    #    NULL
    #}
    # Get unique values only if not all are unique
    ###if(length(uniquey) == length(y) && length(y) > 1) {
    ###    NULL
    ###}
    ###else {
        sort(uniquey, na.last = FALSE)
    ###}
}



##### Handle parameter formats: #####
getParameterFormatElement <- function(projectPath, modelName, processID, format, element) {
    # Get the parameterTableInfo
    processPropertyFormats <- getRstoxFrameworkDefinitions("processPropertyFormats")
    
    # If given as a function, apply that function to the function arguments. This is used when e.g. the title of a parameter table is a function of some other parameter of the function, see conversionTable of RstoxData::processPropertyFormats:
    if(is.function(processPropertyFormats[[format]][[element]])) {
        # Get the function arguments:
        functionArguments <- getFunctionArguments(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID
        )$functionArguments
        # Apply the function:
        output <- RstoxData::do.call_robust(
            processPropertyFormats[[format]][[element]], 
            functionArguments
        )
    }
    else {
        output <- processPropertyFormats[[format]][[element]]
    }
    
    return(output)
}

# Get the variable types of a parameter table:
getParameterVariableTypes <- function(projectPath, modelName, processID, format, list.out = FALSE) {
    variableTypes <- getParameterFormatElement(
        projectPath = projectPath, 
        modelName = modelName, 
        processID = processID, 
        format = format, 
        element = "variableTypes"
    )
    variableTypes <- replace(variableTypes, variableTypes %in% c("double"), "numeric")
    
    # Return a list named by the column names if specified:
    if(list.out) {
        columnNames <- getParameterFormatElement(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID, 
            format = format, 
            element = "columnNames"
        )
        variableTypes <- structure(as.list(variableTypes), names = columnNames)
    }
    
    return(variableTypes)
}
    
# Get the possible values of a parameter table:
getParameterTablePossibleValues <- function(projectPath, modelName, processID, format, stopIfEmptyPossibleValues = FALSE, length1ToList = FALSE) {
    possibleValues <- getParameterFormatElement(
        projectPath = projectPath, 
        modelName = modelName, 
        processID = processID, 
        format = format, 
        element = "possibleValues"
    )
    
    if(!length(possibleValues)) {
        warnText <- paste0("StoX: One or more input processes of the process ", getProcessName(projectPath = projectPath, modelName = modelName, processID = processID), " have not been run.")
        if(stopIfEmptyPossibleValues) {
            stop(warnText)
        }
        columnNames <- getParameterFormatElement(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID, 
            format = format, 
            element = "columnNames"
        )
        # This results in the JSON string "[[],[],[]]" as is expected by the GUI:
        possibleValues <- rep(list(list()), length(columnNames))
    }
    else {
        # If only one element, wrap to a list to make sure the array is kept when converting to JSON with auto_unbox = TRUE:
        if(length1ToList) {
            possibleValues <- lapply(possibleValues, as.list1)
        }
    }
    # Ensure that the output is an unnnamed list, which will appear as array in JSON even for length 1:
    possibleValues <- lapply(possibleValues, as.list)
    
    return(possibleValues)
}

# Get the possible values of a parameter table:
getParameterVectorPossibleValues <- function(projectPath, modelName, processID, format, stopIfEmptyPossibleValues = FALSE, length1ToList = FALSE) {
    possibleValues <- getParameterFormatElement(
        projectPath = projectPath, 
        modelName = modelName, 
        processID = processID, 
        format = format, 
        element = "possibleValues"
    )
    
    if(!length(possibleValues)) {
        warnText <- paste0("StoX: One or more input processes of the process ", getProcessName(projectPath = projectPath, modelName = modelName, processID = processID), " have not been run.")
        if(stopIfEmptyPossibleValues) {
            stop(warnText)
        }
        #else {
        #    warning(warnText)
        #}
        possibleValues <- list()
    }
    else {
        # If only one element, wrap to a list to make sure the array is kept when converting to JSON with auto_unbox = TRUE:
        if(length1ToList) {
            possibleValues <- as.list1(possibleValues)
        }
    }
    
    return(possibleValues)
}



#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
getParameterTableInfo <- function(projectPath, modelName, processID, format, stopIfEmptyPossibleValues = FALSE) {
    list(
        parameterTableTitle = getParameterFormatElement(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID, 
            format = format, 
            element = "title"
        ), 
        parameterTableColumnNames = getParameterFormatElement(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID, 
            format = format, 
            element = "columnNames"
        ), 
        parameterTableVariableTypes = getParameterVariableTypes(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID, 
            format = format
        ), 
        parameterTablePossibleValues = getParameterTablePossibleValues(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID, 
            format = format, 
            stopIfEmptyPossibleValues = stopIfEmptyPossibleValues, 
            length1ToList = TRUE
        )
    )
}


#' 
#' @export
#' @rdname StoXGUI_interfaces
#' 
getParameterVectorInfo <- function(projectPath, modelName, processID, format, stopIfEmptyPossibleValues = FALSE) {
    list(
        parameterVectorTitle = getParameterFormatElement(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID, 
            format = format, 
            element = "title"
        ), 
        parameterVectorVariableTypes = getParameterVariableTypes(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID, 
            format = format
        ), 
        parameterVectorPossibleValues = getParameterVectorPossibleValues(
            projectPath = projectPath, 
            modelName = modelName, 
            processID = processID, 
            format = format, 
            stopIfEmptyPossibleValues = stopIfEmptyPossibleValues, 
            length1ToList = TRUE
        )
    )
}
######