R/utils.R

Defines functions setTemplOptions setDecimOptions setFileOptions setGraphicOptions checkMat checkLogical checkLength checkAlpha checkColor checkID checkOsGui read.tps save.tps

Documented in read.tps save.tps setDecimOptions setFileOptions setGraphicOptions setTemplOptions

# make.template<-function(full, deci, file.name=NULL,sdir=getwd(),over.write=FALSE,...){
#     # calls the function digit.mesh() to edit landmark on a reference mesh (target), and the function save.coo.matrix() to save the coordinates if a filename is provided
#
#     A<-DigitFixed(full, deci, ...)
#     if(!is.null(file.name)){
#         save.tps(A, ID=file.name, file.name, sdir=sdir,over.write=over.write)
#     }
#
#     return(A)
#
# }

# TPS utilities -----
#' @title Saves 3D Coordinates into a TPS File
#' @description Saves landmark coordinates as generated by \code{\link{digitMesh.mesh3d}} into a TPS file. \cr
#'              \strong{Note}: this is not a generic function to create TPS file, it's only designed for 3D landmark
#'                             data.
#' @details Given a matrix of landmark coordinates \code{A}, this function saves it into a TPS file whose filename is
#'          contained into \code{file.name}.
#' @usage
#' save.tps(A, ID, file.name, LMheader = "LM3", IDheader = "ID",
#'          sdir = getwd(), app = FALSE, over.write = FALSE)
#' @param A A 2D numerical matrix of landmark coordinates.
#' @param ID A character value containing the individual identifier.
#' @param file.name A character value containing the TPS file name (with extension).
#' @param LMheader A character value specifying the keyword to use in the TPS file to indicate the number of
#'                 landmarks. \cr
#'                 Default: \code{"LM3"}, for 3D landmarks.
#' @param IDheader A character value specifying the keyword to use in the TPS file to indicate the individual
#'                 identifier. \cr
#'                 Default: \code{"ID"}.
#' @param sdir A character value indicating the path to the saving directory. \cr
#'             Default: \code{getwd()}.
#' @param app A logical value indicating if the written data should be appended in the TPS file (if this file already
#'            exists). \cr
#'            Default: \code{FALSE}.
#' @param over.write A logical value indicating if the file to save should overwrite the previous TPS file with the
#'                   same name (if it exists). \cr
#'                   Default: \code{FALSE}.
#' @return Nothing.
#' @seealso \code{\link{read.tps}}.
#' @export
#'
#' @examples
#'
#' # Generates first a 10*3 random matrix, just for illustration purpose,
#' # but such as it could be obtained after a mesh digitization:
#' M <- matrix(rnorm(30), 10, 3)
#' # Then, saves it as a TPS file:
#' save.tps(M, ID = "randomMatrix", file.name = "TPSfile4randomMatrix.tps")
#'
#'
save.tps<-function(A,ID,file.name,LMheader="LM3",IDheader="ID",sdir=getwd(),app=FALSE,over.write=FALSE){
    # saves coordinates in matrix A into a TPS file

    setwd(sdir)

    lf<-list.files()
    full.name<-paste(file.name,c(".tps","")[1+grepl(".tps",tolower(file.name))],sep="") # add the ".tps" extension if needed
    if(!over.write & is.element(full.name,lf) & !app){
        stop("A file with this name already exists... Please provide another file name, or allow the current file to be deleted (by setting the over.write arg to TRUE)")
    }else{
        p<-nrow(A)
        write(paste0(paste0(LMheader,"="),p),full.name,append=app)
        write(t(A),full.name,ncolumns=3,append=TRUE)
        write(paste0(paste0(IDheader,"="),ID),full.name,append=TRUE)
    }

}

#' @title Reads 3D Coordinates from a TPS File
#' @description Reads landmark coordinates stored in a TPS file as generated by \code{\link{save.tps}}. \cr
#'              \strong{Note}: this is not a generic function to read TPS file, it's only designed for TPS file
#'                             storing 3D landmark data. For more generic function, see \emph{e.g.}:
#'                             \code{\link[geomorph]{readland.tps}}, \code{\link[Momocs]{import_tps}} or
#'                             \code{\link[Morpho]{readallTPS}}.
#' @details Given a TPS filename (\code{file.name}) contained in the \code{sdir} directory, this functions extracts 3D
#'          landmark coordinates (possibly scales them), and stores them into an array (landmarks by lines,
#'          dimensions=3 by columns, and individual by slices).
#' @usage
#' read.tps(file.name, sdir = getwd(), LMheader = "LM3",
#'          IDheader = "ID", SCheader = "SCALE", k = 3, quiet = FALSE)
#' @param file.name A character value containing the TPS file name (with extension).
#' @param sdir A character value indicating the path to the saving directory. \cr
#'             Default: \code{getwd()}.
#' @param LMheader A character value specifying the keyword to use in the TPS file to indicate the number of
#'                 landmarks. \cr
#'                 Default: \code{"LM3"}, for 3D landmarks.
#' @param IDheader A character value specifying the keyword to use in the TPS file to indicate the individual
#'                 identifier. \cr
#'                 Default: \code{"ID"}.
#' @param SCheader A character value specifying the keyword to use in the TPS file to indicate the scale
#'                 identifier. \cr
#'                 Default: \code{"SC"}.
#' @param k A numercial value (positive integer) indicating the dimensions of data. \cr
#'          Default: \code{3}.
#' @param quiet A logical value indicating if a line should be printed when the tps file is opened (see
#'              \code{\link[base]{scan}}).
#'
#' @return A \emph{p*k*n} numerical array (\emph{p}: nb of landmarks, \emph{k}: nb of dimensions, \emph{n}: number
#'         of individuals).
#' @seealso \code{\link{save.tps}}.
#' @export
#'
#' @examples
#'
#' # Generates first two 10*3 random matrices, just for illustration purpose,
#' # but such as it could be obtained after two mesh digitizations:
#' M <- matrix(rnorm(30), 10, 3)
#' N <- matrix(rnorm(30), 10, 3)
#' # Then, saves them as a TPS file:
#' save.tps(M, ID = "randomMatrix_M", file.name = "TPSfile4randomMatrix.tps")
#' save.tps(N, ID = "randomMatrix_N", file.name = "TPSfile4randomMatrix.tps", app=TRUE)
#' # And finally, read it:
#' A <- read.tps("TPSfile4randomMatrix.tps")
#'
read.tps<-function(file.name,sdir=getwd(),LMheader="LM3",IDheader="ID", SCheader="SCALE",k=3, quiet = FALSE){
    # read coordinates from a TPS file

    setwd(sdir)

    quiet<-checkLogical(quiet,1)

    full.name<-paste(file.name,c(".tps","")[1+grepl(".tps",tolower(file.name))],sep="")

    tmp<-scan(full.name,what="character",quiet=quiet)

    idxID<-which(startsWith(tmp,paste0(IDheader,"=")))
    ID<-unlist(lapply(strsplit(tmp[idxID],"="),f<-function(L){L[[2]]}))
    n<-length(ID)
    idxSc<-which(startsWith(tmp,paste0(SCheader,"=")))
    Sc<-unlist(lapply(strsplit(tmp[idxSc],"="),f<-function(L){L[[2]]}))
    Sc<-as.numeric(Sc)
    isScale<-FALSE
    if (length(Sc)>0){
        isScale<-TRUE
    }

    idxLM<-which(startsWith(tmp,paste0(LMheader,"=")))
    p<-unlist(lapply(strsplit(tmp[idxLM],"="),f<-function(L){L[[2]]}))
    p<-unique(as.numeric(p))
    if (length(p)>1){
        stop("Not consistent landmark number through the TPS file...")
    }else{
        A<-array(0,c(p,k,n))
        for (i in 1:n){
            ind<-as.numeric(tmp[(idxLM[i]+1):(idxLM[i]+k*p)])
            if (isScale){
                ind<-ind*Sc[i]
            }
            A[,,i]<-matrix(ind,p,k,byrow=TRUE)
        }
        n0<-nchar(as.character(p))-nchar(as.character(1:p))
        v0<-lapply(n0,f<-function(v,i){rep(0,v[1])})
        v0<-as.character(v0)
        v0[v0=="numeric(0)"]<-""
        dimnames(A)<-list(paste0("lm_", v0, 1:p), c("x","y","z")[1:k], ID)


        return(A)

    }
}


# checking ID, color, alpha etc... --------------
checkOsGui <- function(winNb, winSynchro) {
    # check OS and R GUI
    os <- Sys.info()[1]
    gui <- .Platform$GUI
    if (os == "Darwin"){
        if (gui == "RStudio"){
            # not supported
            stop("The function is not supported with the RStudio interface in Mac OS
                 Please, use the R gui instead.")
        } else{
            # in Mac OS only 2 separate windows are supported
            # => forcing graphic options...
            if (winNb == 1){
                warning('with mac OS, multiple interactive subscenes are not supported.
                        winWb option was set to 2')
                winNb <- 2
                winSynchro <- FALSE
            }
        }
    }
    return(list(winNb, winSynchro))
}

checkID<-function(ID1,ID2){

    if (length(ID1)!=length(ID2)){
        extra.full<-setdiff(ID1,ID2) # full sans deci
        extra.deci<-setdiff(ID2,ID1) # deci sans full
        cat("\n")
        if (as.logical(length(extra.full))){
            cat("The following files for full meshes miss equivalent files for decimated meshes:")
            cat(extra.full,sep="\n")
        }
        if (as.logical(length(extra.deci))){
            cat("The following files for decimated meshes miss equivalent files for full meshes:")
            cat(extra.deci,sep="\n")
        }
        stop("Mismatch between files of full and decimated meshes...")


    }else{
        if(identical(ID1,ID2)){
            ID<-ID1
        }else{
            extra.full<-setdiff(ID1,ID2) # full sans deci
            extra.deci<-setdiff(ID2,ID1) # deci sans full
            cat("\n")
            if (as.logical(length(extra.full))){
                cat("The following files for full meshes miss equivalent files for decimated meshes:")
                cat(extra.full,sep="\n")
            }
            if (as.logical(length(extra.deci))){
                cat("The following files for decimated meshes miss equivalent files for full meshes:")
                cat(extra.deci,sep="\n")
            }
            stop("Mismatch between files of full and decimated meshes...")
        }
    }
    return(ID)

}

checkColor<-function(M,message=as.character(deparse(substitute(M)))){
    t1<-is.element(c(M),colors())
    if (sum(t1)<length(t1)){
        stop(paste0(message," should be chosen within the values from colors()..."))
    }
}

checkAlpha<-function(M,message=as.character(deparse(substitute(M)))){
    if (!is.numeric(M) | any(is.na(M))){
        stop(paste0(message," should contain numeric values..."))
    }
    if (min(M)<0 | max(M)>1){
        stop(paste0(message," should contain values in [0,1]..."))
    }
}

checkLength<-function(M,len,message=as.character(deparse(substitute(M))),repV=TRUE){
    if (!is.element(length(M),len)){
        stop(paste0(message," should have length within {",paste(len,collapse=","),"}..."))
    }
    if (repV & length(M)>1 & length(M)<max(len)){
        stop(paste0(message," should have length within {",paste(range(len),collapse=","),"}..."))
    }
    if (repV & length(M)==1){
        M<-rep(M,max(len))
    }
    return(M)
}

checkLogical<-function(M,len,message=as.character(deparse(substitute(M)))){
    if(!is.logical(M) | any(is.na(M))){
        stop(paste0(message," should contain logical values..."))
    }
    M<-checkLength(M,len,message=message)
    return(M)
}

checkMat<-function(M,message=as.character(deparse(substitute(M)))){
    #?! (see Algebraic notation (chess) for meaning...)

    if (!any(is.element(class(M),c("matrix","numeric","character")))){
        stop(paste0(message," should be either a matrix or vector..."))
    }
    if (length(M)>4 | length(M)==3){
        stop(paste0("Wrong value number specified for ",message,"..."))
    }
    if (length(M)==1){
        M<-matrix(M,2,2)
    }
    if (length(M)==2){
        M<-matrix(c(M),2,2)
    }
    return(M)
}

# Set Options -----
#' @title Sets Graphic Options
#' @description Set graphic options for \code{\link{digitMesh.mesh3d()}} and \code{\link{digitMesh.character()}}.
#' @details This function allows user to set several parameters for graphical rendering for the landmark digitization
#'          process performed through the call of either \code{\link{digitMesh.mesh3d()}} or
#'          \code{\link{digitMesh.character()}}. With no arguments, this function returns the default settings for
#'          graphic options. Any of those options can be modified by setting new values for the corresponding
#'          arguments. Non-filled arguments will be set to default. Ill-filled arguments will return errors or
#'          warnings.
#'
#'          The arguments for graphic options are categorized by themes, and concerns: \strong{window options},
#'          \strong{mesh rendering options}, \strong{major plane options}, \strong{mesh/major plane intersection
#'          options}, \strong{sphere options}, \strong{labelling options} and \strong{zoom options}.
#'
#'          - the \strong{window options} allow to set the number of grahical devices (\code{winNb}), their size and
#'            positioning (\code{winSize}) and the synchronization or not between full and decimated meshes of the
#'            user action (rotation, zoom: \code{winSynchro});
#'
#'          - the \strong{mesh rendering options} allow to play on mesh color (\code{meshColor}), its transparency
#'            (\code{meshAlpha}), its mode of representation (shading for \code{meshShade}, 3D points for
#'            \code{meshPoints}, 3D wire for \code{meshWire});
#'
#'          - the \strong{major plane options} allow to perform or not the preliminary step of major plane adjustement
#'            before landmark digitization (\code{PCplanesDraw}), to set their color and transparency (
#'            \code{PCplanesColor}, \code{PCplanesAlpha});
#'
#'          - the \strong{mesh/major plane intersection options} allow to set the mode of representation for the
#'            intersection lines among major planes and mesh (via 3D lines for \code{intersectLines} or 3D points
#'            for \code{intersectPoints}) and their color (code{intersectColor});
#'
#'          - the \strong{sphere options} for landmark rendering allow to set their radius (\code{spheresRad}),
#'          their color (\code{spheresColor}), and their transparency (\code{spheresAlpha});
#'
#'          - the \strong{labelling options} for landmark numbering allow to set their size (\code{labelCex}),
#'          their color (\code{labelColor}) and their adjustment relative to the sphere (\code{labelAdj});
#'
#'          - the \strong{zoom options} allow to set the extent of the zoomed area (\code{zoomPercDist}), to project
#'            or not on the decimated mesh this extent (\code{zoomPtsDraw}) and to set its color (\code{zoomPtsCol}),
#'            to display or not on the full mesh the landmark pre-positionned on the decimated mesh
#'            (\code{zoomSeeLm}), and to display or not on the full mesh the already positionned landmarks
#'            (\code{zoomSeePrevLm}).
#' @usage
#' setGraphicOptions(winNb=1, winSize= rbind(c(0,50,830,904), c(840,50,1672,904)), winSynchro=TRUE,
#'                   meshVertCol=TRUE, meshColor=rep("gray",2), meshAlpha=rep(1,2), meshShade=rep(TRUE,2),
#'                   meshPoints=c(FALSE,TRUE), meshWire=rep(FALSE,2),
#'                   PCplanesDraw=FALSE, PCplanesColor= "cyan", PCplanesAlpha=0.7,
#'                   intersectLines=TRUE, intersectPoints=FALSE, intersectColor="red",
#'                   spheresRad=0.02, spheresColor=matrix(c("black","blue"),2,2), spheresAlpha=1,
#'                   labelCex=2, labelColor="magenta", labelAdj=0.02,
#'                   zoomPercDist=0.15, zoomPtsDraw=TRUE, zoomPtsCol="orange", zoomSeeLm=FALSE, zoomSeePrevLm=TRUE)
#'
#' @param winNb A numeric value within \{\code{1},\code{2}\} setting for the number of grahical devices: \cr
#'              - \code{1} (default) for a single device subdivided into 2 parts (one for the decimated mesh, the
#'                other for the zoomed mesh); \cr
#'              - \code{2} for two separate devices. \cr
#'              \strong{Warning}: For Mac users, only the setting with 2 separate devices is supported. The OS will be
#'                                automatically detected when calling the \code{digitMesh()} function and \code{winNb}
#'                                will be force to be 2 in case of a call from a Mac OS. \cr
#' @param winSize A vector or matrix indicating the size and positioning of graphical device(s): \cr
#'                - a vector with 4 positive values indicating the left, top, right and bottom (in pixels, see the
#'                  help for the \code{windowRect} parameter in \code{\link[rgl]{par3d}} for the device (when
#'                  \code{winNb=1}); \cr
#'                - a 2*4 matrix of positive values, each line indicating as before the left, top, right and bottom
#'                  (in pixels) for each device (when \code{winNb=2}).
#' @param winSynchro A logical value indicating if user interaction (zoom, rotation) applied on a mesh should be
#'                   synchronously applied on the second one (decimated or full mesh). Only Works for \code{winNb=1}.
#'                   \cr
#'                   Default: \code{TRUE} for synchronization.
#' @param meshVertCol A logical value indicating if the original vertex colors should be kept (\code{TRUE}) or not
#'                    (\code{FALSE}). In the last case, a uniform color specified by the \code{meshColor} will be
#'                    used.
#' @param meshColor A character vector of length 1 or 2 indicating the color(s) for mesh plotting. Values for
#'                  \code{meshColor} should be taken from \code{\link[grDevices]{colors}}(). A 1-length vector will
#'                  apply the same color for full and decimated mesh, and a 2-length will apply the first color for
#'                  the decimated mesh and the second one for the full mesh. \cr
#'                  \strong{Note}: for the \code{meshShade} and the \code{meshWire} options, but not for the
#'                                 \code{meshPoints} option (see details after), this color won't overwrite the color
#'                                 stored in the \code{material$color} (if any) from the \code{mesh3d} object for
#'                                 plotting. This color will be used only if the \code{material$color} is \code{NULL}.
#'                                 \cr
#'                  Default: \code{rep("gray",2)} => both meshes in gray.
#' @param meshAlpha A character vector of length 1 or 2 indicating the alpha value(s) (transparency) for mesh
#'                  plotting. It will overwrite the alpha value stored in \code{material$alpha} (if any). Values for
#'                  \code{meshAlpha} should be taken within [0,1]. A 1-length vector will apply the same alpha for
#'                  full and decimated mesh, and a 2-length vector will apply the first alpha for the decimated mesh
#'                  and the second one for the full mesh. \cr
#'                  Default: \code{rep(1,2)} => both meshes totally opaque.
#' @param meshShade Logical vector of length 1 or 2 indicating if the meshes should be plotted or not via
#'                  \code{\link[rgl]{shade3d}}. \code{TRUE} value will use \code{\link[rgl]{shade3d}}, and
#'                  \code{FALSE} won't. A 1-length vector will apply the same value for both meshes and a 2-length
#'                  will apply the first value for decimated mesh, and the second one for full mesh. \cr
#'                  \strong{Note}: each mesh should be plotted through one of the 3 possible representations (
#'                                 \code{meshShade}, \code{meshPoints}, \code{meshWire}), meaning that at least one
#'                                 \code{TRUE} value in this parameter is needed for each mesh. If not filled,
#'                                 \code{meshShade} will be automatically set to \code{TRUE}. \cr
#'                  Default: \code{rep(TRUE,2)} to use \code{\link[rgl]{shade3d}} for both meshes.
#' @param meshPoints Identical to \code{meshShade} to plot the mesh using using \code{\link[rgl]{points3d}}. \cr
#'                   Default: \code{c(FALSE,TRUE)} to use \code{\link[rgl]{points3d}} only for the full mesh.
#' @param meshWire Identical to \code{meshShade} to plot the mesh using \code{\link[rgl]{wire3d}}. \cr
#'                 Default: \code{rep(FALSE,2)} to not use \code{\link[rgl]{wire3d}} for both meshes.
#' @param PCplanesDraw A 1-length logical or a character vector of length 1, 2 or 3 indicating if major planes (from
#'                     mesh principal components) as well as their intersections with the mesh should be plotted, and
#'                     interactively set by user before the landmark digitizing step. Possible settings: \cr
#'                     - \code{TRUE} (or \code{FALSE}): in this case all (or no one of) the 3 major planes will be (or
#'                       won't be) plotted; \cr
#'                     - any combination of the values within \{\code{"pc1-pc2"},\code{"pc1-pc3"},\code{"pc2-pc3"}\}
#'                       indicating which particular plane(s) should be plotted. \cr
#'                     Default: \code{FALSE} to not draw the planes and their intersections.
#' @param PCplanesColor A character vector taking values within \code{\link[grDevices]{colors}}() indicating with which
#'                      color each plane should be plotted. If only one value is given for more than one plane, the
#'                      color value is recycled. Otherwise, this vector should have the same length than the number of
#'                      plotted planes. \cr
#'                      Default: \code{"cyan"}.
#' @param PCplanesAlpha A numerical vector taking values within [0,1] indicating with which transparency (alpha value)
#'                      each plane should be plotted. If only one value is given for more than one plane, the alpha
#'                      value is recycled. Otherwise, this vector should have the same length than the number of
#'                      plotted planes. \cr
#'                      Default: \code{0.7}.
#' @param intersectLines A logical vector indicating for each intersection plane if the \code{\link[rgl]{lines3d}}
#'                       mode of representation should be use to figure the mesh/major plane intersection. If only one
#'                       value is given for more than one plane, the logical value is recycled. Otherwise, this vector
#'                       should have the same length than the number of plotted planes. \cr
#'                       \strong{Note 1}: each intersection should be plotted through one of the 2 possible
#'                                        representations (\code{intersectLines},\code{intersectPoints}), meaning that
#'                                        at least one \code{TRUE} value in this parameter is needed for each mesh. If
#'                                        no, \code{intersectLines} will be automatically set to \code{TRUE}. \cr
#'                       \strong{Note 2}: for big meshes, the intersection plotting can be fasten by setting
#'                                        \code{intersectLines} to \code{FALSE}. \cr
#'                       Default: \code{TRUE}.
#' @param intersectPoints Identical to \code{intersectLines} to plot the interstions using \code{\link[rgl]{points3d}}.
#'                        \cr
#'                        Default: \code{FALSE}.
#' @param intersectColor A character vector taking values within \code{\link[grDevices]{colors}}() indicating with
#'                       which color each intersection should be plotted. If only one value is given for more than one
#'                       plane, the color value is recycled. Otherwise, this vector should have the same length than
#'                       the number of plotted planes. \cr
#'                       Default: \code{"red"}.
#' @param spheresRad A numerical vector or matrix taking values within [0,1] indicating with which radius the spheres
#'                   figuring the landmarks should be plotted. Actually, the radius is expressed as a fraction of the
#'                   mesh dimensions(so better values are close to 0). Possible settings: \cr
#'                   - a 2*2 matrix, the 1st line corresponding to the setting before user validation and the 2nd one
#'                     after, the 1st column correspondng to the setting for the decimated mesh and the second one for
#'                     the zoomed full mesh; \cr
#'                   - a vector of length 2 corresponding to the setting before user validation and the 2nd one after
#'                     (those values will be recycled for the full mesh); \cr
#'                   - a unique value for the setting before and after the user validation, and for the decimated and
#'                     the full mesh. \cr
#'                   Default: \code{0.01}.
#' @param spheresColor A character vector or matrix taking values within \code{\link[grDevices]{colors}}() indicating
#'                     with which color the spheres figuring the landmarks should be plotted. See \code{spheresRad}
#'                     for possible settings. \cr
#'                     Default: \code{matrix(c("black","blue"),2,2)} to plot on both meshes spheres in black while the
#'                              landmark has not been validated, and in blue after.
#' @param spheresAlpha A numerical vector or matrix taking values within [0,1] indicating with which transparency
#'                     (alpha value) the spheres figuring the landmarks should be plotted. See \code{spheresRad} for
#'                     possible settings. \cr
#'                     Default: \code{1} (no transparency for spheres).
#' @param labelCex A numerical vector or matrix taking positive values indicating with which size the landmark labels
#'                 should be plotted. See See \code{spheresRad} for possible settings. \cr
#'                 Default: \code{2}.
#' @param labelColor A character vector or matrix taking values within \code{\link[grDevices]{colors}}() indicating
#'                   with which color the landmark labels should be plotted. See spheresRad for possible settings. \cr
#'                   Default: "magenta".
#' @param labelAdj A numerical vector or matrix or array taking values within [0,1] indicating how to adjust the label
#'                 location relative to the landmark sphere. Possible settings: \cr
#'                 - a 2*2*2 array, the 1st line corresponding to the setting before user validation and the 2nd one
#'                   after, the 1st column correspondng to the setting for the decimated mesh and the second one for
#'                   the full mesh, the first slice corresponding to the horizontal adjustment and the second one to
#'                   the vertical adjustment; \cr
#'                 - a 2*2 matrix corresonding to the slide for horizontal adjustment which will be recycled for
#'                   vertical adjustment; \cr
#'                 - a vector of length 2 corresponding to the setting before user validation and the 2nd one after
#'                   (those values will be recycled for the full mesh and the vertical adjustment); \cr
#'                 - a unique value for the setting before and after the user validation (recycled for the full mesh
#'                    and the vertical adjustment). \cr
#'                 Default: \code{0.02}.
#' @param zoomPercDist A numerical value within [0,1] specifying the extent of the zoomed full mesh. This extent is
#'                     computed as the maximal distance between the clicked point and the mesh points multiplied by
#'                     \code{zoomPercDist}. \cr
#'                     Default: \code{0.15}.
#' @param zoomPtsDraw A logical value indicating if the exent of the zoomed mesh should be shown on the decimated mesh.
#'                    This extent will be represented as a 3D point cloud. \cr
#'                    Default: \code{TRUE}.
#' @param zoomPtsCol A character value taking values within \code{\link[grDevices]{colors}}() indicating with which
#'                   color the zoom extent (if \code{zoomPtsDraw} is set to \code{TRUE}) should be plotted. \cr
#'                   Default: \code{"orange"}.
#' @param zoomSeeLm A logical value indicating if the landmark placed by the user on the decimated mesh should be visible
#'                  on the zoomed mesh. It will slightly fasten the process of the landmark digitizing enabling the
#'                  direct validation (without any manual change) of the placed landmark, but at the risk of a more or
#'                  less important approximation on the landmark positioning depending on the degree of decimation
#'                  used for the decimated mesh. \cr
#'                  Default: \code{FALSE}.
#' @param zoomSeePrevLm A logical value indicating if the landmarks already placed by the user should be visible
#'                  on the zoomed mesh if they are located in the zoom extent. \cr
#'                  Default: \code{TRUE}.
#'
#' @return A list of those parameters gathered in sublists following the thematic categorization described above.
#' @seealso \code{\link{setDecimOptions}}, \code{\link{setFileOptions}}, \code{\link{setTemplOptions}}.
#' @export
#' @examples
#' # returning default settings:
#' GrOpt<-setGraphicOptions()
#'
#' # some possible settings (not exhaustive):
#' GrOpt<-setGraphicOptions(winNb=2, winSynchro= FALSE, PCplanesDraw=c("pc2-pc3"))
#' GrOpt<-setGraphicOptions(meshColor=c("gray","orange"), meshPoints=FALSE, zoomSeeLm=TRUE)
#' #...
#'
setGraphicOptions <- function(winNb = 1,
                              winSize = rbind(c(0, 50, 830, 904), c(840, 50, 1672, 904)),
                              winSynchro = TRUE,
                              meshVertCol = TRUE, meshColor = rep("gray",2),
                              meshAlpha = rep(1,2), meshShade = rep(TRUE, 2),
                              meshPoints = c(FALSE, FALSE), meshWire = rep(FALSE, 2),
                              PCplanesDraw = FALSE, PCplanesColor = "cyan", PCplanesAlpha = 0.7,
                              intersectLines = TRUE, intersectPoints = FALSE, intersectColor = "red",
                              spheresRad = 1e-2, spheresColor = matrix(c("black", "blue"), 2, 2), spheresAlpha = 1,
                              labelCex = 2, labelColor="magenta", labelAdj = 2e-2,
                              zoomPercDist = 0.15, zoomPtsDraw = TRUE,
                              zoomPtsCol = "orange", zoomSeeLm = FALSE, zoomSeePrevLm = TRUE) {

    # Allow to set graphical options for DigitFixed.
    # The simplest use with no argument returns a list with default values for all settable parameters:
    warn <- options()$warn
    options(warn = 1)

    # Window options
    if (!is.numeric(winNb) | length(winNb) != 1 | !is.element(winNb[1], c(1, 2))){
        stop("winNb should be a scalar taking values in {1,2}...")
    }
    if (!is.element(length(winSize), c(4, 8))){
        message<-paste("With ", winNb, " windows, winSize should contain ", 4*winNb, " integer values...", sep="")
        stop(message)
    }
    if (min(winSize) < 0 | !is.numeric(winSize) | any(is.na(winSize))){
        stop("winSize should contain positive integer values...")
    }
    if (!all(floor(winSize) == winSize, na.rm = TRUE)){
        stop("winSize should contain positive integer values...")
    }
    # checking for osx/Rstudio
    tmp <- checkOsGui(winNb, winSynchro)
    winNb <- tmp[[1]]
    winSynchro <- tmp[[2]]

    if (!is.logical(winSynchro) | is.na(winSynchro)){
        stop("winSynchro should be a logical value...")
    }
    if (winNb == 2 & winSynchro){
        winSynchro <- FALSE
        warning("With 2 separate windows, winSynchro=TRUE is not supported... Set to FALSE")
    }
    if (winNb == 2 & length(winSize) == 4){
        tmp <- winSize
        winSize <- rbind(tmp, tmp + c(tmp[3], 0, tmp[3], 0))
        warning(paste0("The size and position for the second window wasn't specified... Set to: c(",toString(winSize[2,]),")"))
    }
    winSize <- matrix(c(t(winSize))[1:(4*winNb)], nrow =  winNb, ncol =  4, byrow = TRUE)
    if (min(winSize[, 3] - winSize[, 1]) <= 0 | min(winSize[, 4] - winSize[, 2]) <= 0){
        stop("Wrong specification for winSize: see the help for windowRect parameter in rgl:::par3d for details")
    }
    winOptions <- list(winNb = winNb, winSize = winSize, winSynchro = winSynchro)

    # mesh options
    meshVertCol <- checkLogical(meshVertCol, 1)
    checkColor(meshColor)
    meshColor <- checkLength(meshColor, c(1, 2))

    checkAlpha(meshAlpha)
    meshAlpha <- checkLength(meshAlpha, c(1, 2))

    meshShade <- checkLogical(meshShade, c(1, 2))
    meshPoints <- checkLogical(meshPoints, c(1, 2))
    meshWire <- checkLogical(meshWire, c(1, 2))
    Sm <- meshShade + meshPoints + meshWire
    if (min(Sm) == 0){
        meshShade <- rep(TRUE, 2)
        warning("Some mesh plot modes are missing! meshShade will be set to TRUE for both windows...")
    }
    meshOptions <- list(meshVertCol = meshVertCol, meshColor = meshColor,
                        meshAlpha = meshAlpha, meshShade = meshShade,
                        meshPoints = meshPoints, meshWire = meshWire)

    # PC planes options
    stopMessage <- "PCplanesDraw should be a logical value, or a character vector taking value within {\"pc1-pc2\",\"pc1-pc3\",\"pc2-pc3\"}..."
    if (any(is.na(PCplanesDraw))){
        stop(stopMessage)
    }
    if (!is.character(PCplanesDraw) & !is.logical(PCplanesDraw)){
        stop(stopMessage)
    }
    PCplanesDraw <- checkLength(PCplanesDraw, 1:3, repV = FALSE)
    if (is.logical(PCplanesDraw) & length(PCplanesDraw)==1){
        nbPlanes <- 0
        if (PCplanesDraw){
            nbPlanes <- 3
        }
    } else {
        if (is.logical(PCplanesDraw)) {
            stop(stopMessage)
        }
        V <- c("pc2-pc3", "pc1-pc3", "pc1-pc2")
        t1 <- is.element(PCplanesDraw, V)
        nbPlanes <- sum(t1)
        if (sum(t1) != length(t1)) {
            stop(stopMessage)
        }
    }
    if (nbPlanes>0) {
        checkColor(PCplanesColor)
        PCplanesColor <- checkLength(PCplanesColor, 1:nbPlanes)
        checkAlpha(PCplanesAlpha)
        PCplanesAlpha <- checkLength(PCplanesAlpha, 1:nbPlanes)
    } else {
        PCplanesColor <- PCplanesAlpha <- NULL
    }
    PCplanesOptions <- list(PCplanesDraw = PCplanesDraw, PCplanesColor = PCplanesColor,
                            PCplanesAlpha = PCplanesAlpha)

    # intersect options
    if (nbPlanes > 0) {
        intersectLines <- checkLogical(intersectLines, 1:nbPlanes)
        intersectPoints <- checkLogical(intersectPoints, 1:nbPlanes)
        if (sum(intersectLines) == 0 & sum(intersectPoints) == 0){
            intersectLines <- rep(TRUE,nbPlanes)
            warning("To be visible, mesh/plane intersections should plotted at least by lines: instersectLines was set to TRUE...")
        }
        checkColor(intersectColor)
        intersectColor <- checkLength(intersectColor, 1:nbPlanes)

    } else {
        intersectLines <- intersectPoints <- FALSE
        intersectColor <- NULL
    }
    intersectOptions <- list(intersectLines = intersectLines,
                             intersectPoints = intersectPoints,
                             intersectColor = intersectColor)

    # sphere options
    if (!is.numeric(spheresRad) | any(spheresRad < 0)){
        stop("spheresRad should contained positive numerical values...")
    }
    if (max(spheresRad)>1){
        warning("spheresRad should be a fractional number < 1 to allow readable plots")
    }
    spheresRad <- checkMat(spheresRad)
    checkColor(spheresColor)
    spheresColor <- checkMat(spheresColor)
    checkAlpha(spheresAlpha)
    spheresAlpha <- checkMat(spheresAlpha)
    spheresOptions <- list(spheresRad = spheresRad, spheresColor = spheresColor,
                           spheresAlpha = spheresAlpha)

    # label options
    if (any(is.na(labelCex))){
        stop("labelCex should contained numerical values...")
    }
    if (!is.numeric(labelCex) | min(labelCex)<0){
        stop("labelCex should contained positive numerical values...")
    }
    labelCex <- checkMat(labelCex)
    checkColor(labelColor)
    labelColor <- checkMat(labelColor)
    if (!is.numeric(labelAdj) | any(is.na(labelAdj))){
        stop("labelAdj should be numeric...")
    }
    if (is.element(length(labelAdj),c(1,2,4))){
        labelAdj <- array(rep(c(labelAdj), 8/length(labelAdj)), dim = c(2, 2, 2))
    } else if(!identical(dim(labelAdj), as.integer(c(2, 2, 2)) )){
        stop("labelAdj should be a 2*2*2 array or a vector/matriw with 1, 2 or 4 values...")
    }
    if (max(labelAdj) > 1){
        warning("labelAdj should contain fractional values to allow readable plots")
    }
    labelOptions <- list(labelCex = labelCex, labelColor = labelColor, labelAdj = labelAdj)

    # zoom options
    if (length(zoomPercDist) != 1 | !is.numeric(zoomPercDist) | min(zoomPercDist) < 0 | max(zoomPercDist) > 1){
        stop("zoomPercDist should be a numerical value between 0 and 1...")
    }
    if (length(zoomPtsDraw) != 1 | !is.logical(zoomPtsDraw) | any(is.na(zoomPtsDraw))){
        stop("zoomPtsDraw should be a logical value...")
    }
    if (zoomPtsDraw) {
        if (length(zoomPtsCol) != 1 | any(!is.element(zoomPtsCol, colors()))){
            stop("zoomPtsCol should be a unique value chosen within the values from colors()...")
        }
    } else {
        zoomPtsCol <- NULL
    }
    if (length(zoomSeeLm) != 1 | !is.logical(zoomSeeLm) | any(is.na(zoomSeeLm))){
        stop("zoomSeeLm should be a logical value...")
    }
    if (length(zoomSeePrevLm) != 1 | !is.logical(zoomSeePrevLm) | any(is.na(zoomSeePrevLm))){
        stop("zoomSeePrevLm should be a logical value...")
    }
    zoomOptions <- list(zoomPercDist = zoomPercDist, zoomPtsDraw = zoomPtsDraw,
                        zoomPtsCol = zoomPtsCol, zoomSeeLm = zoomSeeLm, zoomSeePrevLm = zoomSeePrevLm)

    options(warn = warn)

    return(list(winOptions = winOptions, meshOptions = meshOptions,
                PCplanesOptions = PCplanesOptions, intersectOptions = intersectOptions,
                spheresOptions = spheresOptions, labelOptions = labelOptions,
                zoomOptions = zoomOptions))
}

#' @title Sets File Options
#' @description Set file options (opening and saving) for \code{\link{digitMesh.character}}.
#' @details This function allows user to set several parameters for mesh file opening and saving as well as TPS export
#'          needed during the call of \code{\link{digitMesh.character}}. With no arguments, this function returns the
#'          default settings for file options. Any of those options can be modified by setting new values for the
#'          corresponding arguments. Non-filled arguments will be set to default. Ill-filled arguments will return
#'          errors or warnings.
#'
#'          Depending on the user choice to perform the mesh decimation either during the mesh digitization, or to use
#'          already decimated meshes, the options linked to the decimated mesh (\code{deci.suffix}, \code{deci.dir})
#'          will concern either the saving of those meshes, or their opening.
#'
#'          Additionnally to the provided parameters, this function will return the information of the directory
#'          containing the full mesh(es) as well as the filename(s) of full mesh(es) to treat.
#' @usage
#' setFileOptions(M, sdir=getwd(), patt=".ply", deci.suffix=NULL, deci.dir="DecimMesh",
#'                saveTPS="", overwrite=FALSE , append=FALSE)
#' @param M A character value indicating either a mesh filename (with extension) contained in \code{sdir}, or a
#'          subdirectory name (not a path) contained in \code{sdir} in which a set of mesh files should be processed
#'          for digitization.
#' @param sdir A character value indicating the path for the directory containing either the mesh to digitize or the
#'             subdirectory containing the mesh files to digitize. \cr
#'             Default: \code{getwd()} => working directory.
#' @param patt A character value within \{\code{".ply"},\code{".stl"}\} indicating the kind of mesh file to open. \cr
#'             Default: \code{".ply"}.
#' @param deci.suffix A character value indicating the suffix added (or to add) at the end of the decimated mesh
#'                    filenames and before the exension. \cr
#'                    Default: \code{NULL}.
#' @param deci.dir A character value indicating the name of the subdirectory in \code{M} where the decimated mesh will
#'                 be saved or extracted. By default, \code{deci.dir} is set to \code{"DecimMesh"}, meaning that a
#'                 subdirectory named \code{"DecimMesh"}  will be automatically created within \code{M} (if it doesn't
#'                 exist yet).
#' @param saveTPS Either a character value indicating the name (with extension) for the TPS filename to export
#'                landmark coordinates, or a \code{FALSE} value if user don't want save coordinate. The TPS file will
#'                be saved within the directory specified by \code{M}. \cr
#'                Default: \code{""} indicates that the tps filename will be set depending on the processed mesh or directory (\code{M}).
#' @param overwrite A logical value taking values within \{\code{TRUE},\code{FALSE}\} indicating if the TPS file shoud
#'                  be overwritten if the provided filename already exists. \cr
#'                  Default: \code{FALSE} => will generate an error if the file aready exists...
#' @param append A logical value taking values within \{\code{TRUE},\code{FALSE}\} indicating if the landmark
#'               coordinates should be appended in the TPS file (it could be the case when user need to digitize a set
#'               of meshes in several session but want to store all results in the same file). \cr
#'               Default: \code{FALSE}.
#' @return A list of those parameters plus the information of the directory containing the full mesh(es) (
#'         \code{full.dir}, as a character value) and the filename(s) of full mesh(es) to treat (\code{full.files}
#'         as a character vector).
#' @seealso \code{\link{setDecimOptions}}, \code{\link{setGraphicOptions}}, \code{\link{setTemplOptions}}.
#' @export
#'
setFileOptions<-function(M, sdir = getwd(), patt = ".ply", deci.suffix = NULL,
                         deci.dir = "DecimMesh", saveTPS = "",
                         overwrite = FALSE , append = FALSE) {

    curdir <- getwd()
    # various checkings
    M <- checkLength(M,1)
    if (!is.character(M)) {
        stop("M should be a string...")
    }
    M <- rev(strsplit(M, "/")[[1]])[1]

    sdir <- checkLength(sdir,1)
    if (!is.character(sdir) | !dir.exists(sdir)) {
        stop("sdir should be a valid path name...")
    }

    deci.suffix <- checkLength(deci.suffix,0:1)
    if (!is.null(deci.suffix) & !is.character(deci.suffix)) {
        stop("deci.suffix should be either null or a string...")
    }

    deci.dir <- checkLength(deci.dir, 0:1)
    if (!is.null(deci.dir) & !is.character(deci.dir)) {
        stop("deci.dir should be either null or a string...")
    }
    deci.dir <- rev(strsplit(deci.dir, "/")[[1]])[1]

    if (is.null(deci.suffix) & is.null(deci.dir)) {
        stop("At least one of the following arguments should be provided: deci.suffix or deci.dir...")
    }

    saveTPS <- checkLength(saveTPS,1)
    if (!is.character(saveTPS)) {
        stop("saveTPS should be a string...")
    }

    # determination of full.dir, full.files and deci.dir
    setwd(sdir)
    if (dir.exists(M)){
        if (nchar(saveTPS) < 1){
            saveTPS <- M
        }

        full.dir <- paste(getwd(), M, sep = "/")
        setwd(full.dir)
        full.files <- list.files(pattern = patt, ignore.case = TRUE)

        if (!is.null(deci.dir)) {
            if (!dir.exists(deci.dir)) {
                dir.create(deci.dir)
            }
            deci.dir <- paste(full.dir, deci.dir, sep = "/")
        } else {
            deci.dir <- full.dir
        }
    } else {
        if (file.exists(M)) {
            full.files <- M
            if (is.null(deci.dir)) {
                full.dir <- deci.dir <- sdir
            } else {
                full.dir <- sdir
                setwd(full.dir)
                if (!dir.exists(deci.dir)) {
                    dir.create(deci.dir)
                }
                deci.dir <- paste(full.dir, deci.dir, sep = "/")
            }

            if (nchar(saveTPS) < 1){
                saveTPS <- paste(rev(rev(strsplit(M,"\\.")[[1]])[-1]), collapse = ".")
            }
        } else {
            stop("Provided filename doesn't exist...")
        }
    }

    if (is.logical(saveTPS)){
        saveTPS <- checkLogical(saveTPS, 1)
        if (saveTPS){
            stop("saveTPS should be either FALSE or a string...")
        }
        overwrite <- NA
        append <- NA
    } else {
        saveTPS <- checkLength(saveTPS, 1)
        if (!is.character(saveTPS)) {
            stop("saveTPS should be either FALSE or a string...")
        }
        overwrite <- checkLogical(overwrite,1)
        append <- checkLogical(append,1)
    }

    setwd(curdir)

    return(list(sdir = sdir, patt = patt, deci.suffix = deci.suffix, deci.dir = deci.dir,
                full.dir = full.dir, full.files = full.files, saveTPS = saveTPS,
                overwrite=overwrite , append = append))
}

#' @title Sets Decimation Options
#' @description Set decimation options for \code{\link{digitMesh.character}}.
#' @details This function allows user to set several parameters for mesh decimation needed during the call of
#'          \code{\link{digitMesh.character}}. With no arguments, this function returns the default  settings for
#'          decimation options. Any of those options can be modified by setting new values for the corresponding
#'          arguments. Non-filled arguments will be set to default. Ill-filled arguments will return errors or
#'          warnings.
#' @usage
#' setDecimOptions(makeDecimation = TRUE, sequential = TRUE,
#'                 tarface = 15000, patt = ".ply")
#' @param makeDecimation A logical value indicating if the decimation should be performed. \cr
#'                       Default: \code{TRUE}.
#' @param sequential A logical value indicating if the decimation should be performed mesh by mesh during the landmark
#'                   digitizing, or in a single pass for all meshes before the digitizing. \cr
#'                   Default: \code{TRUE} => decimation mesh by mesh during the digitization process.
#' @param tarface A numerical value (positive integer) indicating the targetted number of faces for the decimated
#'                meshes. \cr
#'                Default: \code{15000}.
#' @param patt A character value taking values within \{\code{".ply"},\code{".stl"}\} indicating the kind of mesh
#'             files to treat. \cr
#'             Default: \code{".ply"}.
#' @return A list of those parameters.
#' @seealso \code{\link{setFileOptions}}, \code{\link{setGraphicOptions}}, \code{\link{setTemplOptions}}.
#' @export
#' @examples
#' # returning default settings:
#' DeOpt<-setDecimOptions()
#'
#' # setting for non sequential stl decimations:
#' DeOpt<-setDecimOptions(sequential = FALSE, patt = ".stl")
#'
setDecimOptions <- function(makeDecimation = TRUE, sequential = TRUE,
                            tarface = 15000, patt = ".ply") {

    makeDecimation <- checkLogical(makeDecimation, 1)
    sequential <- checkLogical(sequential, 1)

    tarface <- checkLength(tarface, 1)
    if (!is.numeric(tarface)) {
        stop("tarface should be a numeric value...")
    }
    if (tarface < 1) {
        stop("tarface should be a positive integer value...")
    }
    if (round(tarface) != tarface){
        stop("tarface should be a positive integer value...")
    }

    patt <- checkLength(patt, 1)
    if (!is.character(patt) | !is.element(tolower(patt), c(".ply", ".stl"))){
        stop("Only ply and stl files are supported...")
    }

    return(list(makeDecimation = makeDecimation, sequential = sequential,
                tarface = tarface, patt = patt))
}

#' @title Sets Template Options
#' @description Set options for template during the digitizing process through the call of
#'              \code{\link{digitMesh.character}}.
#' @details This function allows user to set several parameters for the use of a template possibly needed during the
#'          call of \code{\link{digitMesh.character}}. With no arguments, this function returns the default settings
#'          for the template options. Any of those options can be modified by setting new values for the corresponding
#'          arguments. Non-filled arguments will be set to default. Ill-filled arguments will return errors or
#'          warnings.
#' @usage
#' setTemplOptions(fixed, template = TRUE,
#'                 idxTemplate = 1:4, full.files = FALSE)
#' @param fixed A numerical value (positive integer) indicating the number of landmarks to digitize.
#' @param template Possible settings: \cr
#'                 - a logical value (\code{TRUE}: the 1st mesh in the directory will serve as template, \code{FALSE}:
#'                   no template will be used); \cr
#'                 - a character value indicating the filename (with extension) of the mesh to use for template; \cr
#'                 - a numerical \code{fixed*3} matrix containing the template coordinates. \cr
#'                 Default: \code{TRUE}.
#' @param idxTemplate Numeric vector with positive integers indicating the numbers of landmarks of the template used to
#'                    fit it on the mesh, sorted in the order with which they will be digitized on the mesh. For
#'                    example, if the landmarks used are the landmarks numbered 10, 12, 17 and 23, and digitized in the
#'                    following order on the mesh: 12, 10, 23, 17, \code{idxTemplate} should be set to:
#'                    \code{c(12, 10, 23, 17)}. \cr
#'                    Default: \code{1:4} => the first four landmarks will serve as reference landmarks.
#' @param full.files Either a character vector containing the full mesh filenames to treat (in this case the template
#'                   filename given in the \code{template} argument will be ckecked against the filenames provided in
#'                   \code{full.files}), or \code{FALSE} (if \code{template} isn't a filename). \cr
#'                   Default: \code{FALSE}.
#' @return A list with \code{template}, \code{idxTemplate} plus a logical value \code{makeTempl} indicating if a
#'         template should be created during the digitization process.
#' @export
#' @examples
#' # returning default settings for 30 landmarks:
#' TeOpt<-setTemplOptions(30)
#'
#' # setting for using a 30*3 coordinate matrix as a template, and for digitizing landmarks {8,14,29,3}
#' # (in this order) to fit th template
#' # 1. generates first a 30*3 random matrix, just for illustration purpose:
#' M <- matrix(rnorm(90), 30, 3)
#' TeOpt<-setTemplOptions(30, template = M, idxTemplate = c(8, 14, 29, 3))
#'
setTemplOptions <- function(fixed, template = TRUE, idxTemplate = 1:4, full.files = FALSE) {

    # template & full.files
    if(length(template) < 1){
        stop("Wrong specification for template argument...")
    }
    if (!is.character(template)){
        if (!is.matrix(template)){
            template <- checkLogical(template, 1)

            if (template & is.null(full.files)) {
                stop("For template=TRUE, full.files argument should be specified...")
            } else if(template) {
                if (length(full.files) < 1) {
                    stop("full.files should contain at least one mesh filename...")
                }
                if (length(full.files) == 1 & is.logical(full.files)) {
                    if (!full.files) {
                        template <- template
                        makeTempl <- template
                    }
                } else {
                    if (!is.character(full.files)) {
                        stop("full.files should contain character values...")
                    }
                    template <- full.files[1]
                    makeTempl <- TRUE
                }
            } else if (!template) {
                makeTempl <- FALSE
            }
        } else {
            if(ncol(template) != 3) {
                stop("When template is set as a matrix, it should contain 3 columns...")
            }
            if(nrow(template) < 3) {
                stop("When template is set as a matrix, it should contain at least 3 lines...")
            }
            if (!is.numeric(template)){
                stop("When template is set as a matrix, it should contain numerical values...")
            }
            makeTempl <- FALSE
        }
    } else {
        template <- checkLength(template, 1)
        if (!is.logical(full.files)) {
            if (!is.element(template, full.files)){
                stop("Designed filename mesh for template wasn't found...")
            }
            makeTempl <- TRUE
        } else {
            makeTempl <- TRUE
        }
    }

    # fixed
    fixed <- checkLength(fixed, 1)
    if (!is.numeric(fixed)) {
        stop("fixed should be an positive integer value...")
    }
    if (fixed < 1) {
        stop("fixed should be an positive integer value...")
    }
    if (round(fixed) != fixed) {
        stop("fixed should be an positive integer value...")
    }

    # idxTempalte
    if(length(idxTemplate) < 3 | length(idxTemplate) > fixed) {
        stop("idxTemplate should contain at least 3 landmarks, and less landmarks than the total number of landmarks...")
    }
    if (!is.numeric(idxTemplate)) {
        stop("idxTemplate should contain positive integer values...")
    }
    if (min(idxTemplate) < 1 | max(idxTemplate) > fixed) {
        stop("idxTemplate should contain positive integer values correponsding to landmark indexes...")
    }
    if (length(unique(idxTemplate)) != length(idxTemplate)) {
        stop("idxTemplate should contain unique values...")
    }
    if (any(round(idxTemplate) != idxTemplate)) {
        stop("idxTemplate should contain integer values...")
    }

    return(list(template = template, idxTemplate = idxTemplate, makeTempl = makeTempl))
}
morphOptics/digit3DLand documentation built on July 17, 2021, 8:27 p.m.