# R/miscellaneous.R In EcoGenetics: Management and Exploratory Analysis of Spatial Data in Landscape Genetics

#### Documented in misc.2symmetricmisc.dlatlon2distmmisc.parse.filtermisc.undimmattg

```#' Conversion of a non symmetric binary matrix into symmetric.
#' @param mat Matrix.
#' @author Leandro Roser \email{learoser@@gmail.com}
#' @keywords internal

misc.2symmetric <- function(mat) {
mat[row(mat) > col(mat)] <- mat[row(mat) > col(mat)] + mat[row(mat) < col(mat)]
mat[row(mat) > col(mat)][mat[row(mat) > col(mat)] > 0] <- 1
mat[row(mat) < col(mat)] <- mat[row(mat) > col(mat)]
mat
}

#' Creates a matrix without diagonal, in row order
#' @param mat Matrix.
#' @author Leandro Roser \email{learoser@@gmail.com}
#' @keywords internal

misc.undimmattg <- function(mat) {
ncolp <- ncol(mat) -1
mat2 <- as.vector(t(mat))
mat2 <-mat2[-which(col(mat) == row(mat))]
mat2<-matrix(mat2, ncol = ncolp, byrow = T)
mat2
}

#' Computing a distance matrix in meters among points in decimal degrees
#' under a spherical Earth model
#' @param XY data frame or matrix with latitude-longitude coordinates
#' in decimal degrees format.
#' This program computes a distance matrix for Earth points in decimal degrees.
#' It assumes a spherical model with an Earth radius of 6371 km.
#' @author Leandro Roser \email{learoser@@gmail.com}
#' @keywords internal

misc.dlatlon2distm <- function(XY) {
out <- matrix(,nrow(XY), nrow(XY))
for(i in 1:nrow(XY)) {
for(j in 1:nrow(XY)) {
lat1 <- XY[i, 1]
lon1 <- XY[i, 2]
lat2 <- XY[j, 1]
lon2 <- XY[j, 2]
R <- 6371
dLat <- (lat2 - lat1) * pi / 180
dLon <- (lon2 - lon1) * pi / 180
a <- sin((dLat/2)) ^ 2 + cos(lat1 * pi / 180) * cos(lat2 * pi / 180) * (sin(dLon / 2)) ^2
c <- 2 * atan2(sqrt(a), sqrt(1-a))
d <- R * c
out[i, j] <- d
}
}
rownames(out) <- rownames(XY)
colnames(out) <- rownames(XY)
as.dist(out)
}

#' Filter a raster using a conditional expression and values in a conditional vector
#' @param data raster data
#' @param expr logical expression to apply a a character string. Must have the
#' argument "filter" and the form "filter < 3", "filter == 3" || filter< 4"
#' @param filter vector with the values to use for filtering the data (included
#' or excluded of the matrix). If a column or row of the data, filter is
#' the value data[row, ], data[, col].
#' @param byrow filter the rows? default FALSE (filter the columns)
#' @author Leandro Roser \email{learoser@@gmail.com}
#' @keywords internal

misc.parse.filter <- function(data, expr, filter, byrow = TRUE) {

#conditional vector checkpoint
l.cond <- length(filter)
if(byrow) {
if(l.cond != nrow(data)) {
stop("the conditional vector do not match the number of rows of the data")
}
} else {
if(l.cond != ncol(data)) {
stop("the conditional vector do not match the number of columns of the data")
}
}

# conditional expression checkpoint
## obtain expression. Logical o character allowed
cond <- deparse(substitute(expr))
cond <- gsub("\\\"", "", cond)
cond <- gsub(" ", "", cond)

# evaluate expression
cond <- eval(parse(text = cond))

# all FALSE -> stop
if(all(cond == FALSE)) {
stop("the condition is not satisfied by any value")
}

# if incorrect length -> stop
if(length(cond) != length(filter)) {
}

# now filter the matrix
if(byrow) {
out <- data[cond, , drop = FALSE]
} else {
out <- data[, cond , drop = FALSE]
}

out
}
```

## Try the EcoGenetics package in your browser

Any scripts or data that you put into this service are public.

EcoGenetics documentation built on July 8, 2020, 5:46 p.m.