is_odd <- function(x) {
return(x %% 2 == 0) # Create even/odd logical
}
# Misc functions ----------------------------------------------------------------
#' Fulton condition factor
#'
#' Return Fulton's condition factor
#' @param w Weight in grams
#' @param l Length in mm
#'
#' @return
#' A numeric
#'
fulton <- function(w, l){
l <- as.numeric(l) / 10 # Convert length to cm
k <- 100 * (as.numeric(w) / l^3)
return(k)
}
#' Hex to dec pittag string
#'
#' Convert vector of pittags in hex to dec
#' @param tags character vector of tags in hex format
#'
#' @return character vector of tags in decimal format
#'
hex2dec <- function(tags) {
parts <- strsplit(tags, "\\.")
res <- sapply(parts, function(x) {
x[is.na(x)] <- 0
if (is.na(x[2])) {
x[2] <- 0
}
p1 <- strtoi(paste("0x", x[1], sep=""))
p2 <- strtoi(paste("0x", x[2], sep=""))
sprintf("%03d.%012d", p1, p2)
# paste(p1, p2, sep='.')
})
res <- ifelse(res == "000.000000000000", NA, res)
return(res)
}
#' Decimal to hex pittag string
#'
#' Convert vector of pittags in dec to hex
#' @param tags character vector of tags in hex format
#'
#' @return character vector of tags in decimal format
#'
dec2hex <- function(tags) {
if (grepl(tags[1], pattern = "\\.")) { # We assume that all tags are formated either with or without "."
tags <- ifelse(is.na(tags), "000.000000000000", tags)
parts <- strsplit(tags, "\\.") }
else {
tags <- ifelse(is.na(tags), "000000000000000", tags)
parts <- lapply(1:length(tags), function(x) {
return(c(substr(tags[x], start = 1, stop = 3),
substr(tags[x], start = 4, stop = nchar(tags[x]))))})
}
res <- sapply(parts, function(x) {
p1 <- sprintf("%03X", as.numeric(x[1]))
p2 <- sprintf("%010X", as.numeric(x[2])) # Pad with space may be platform dependent
paste(p1, p2, sep='.')
})
res <- ifelse(res == "000.0000000000", NA, res)
return(res)
}
##
#' remove_empty_row
#'
#' Remove rows from a data.frame when all fields in a row are NA
#'
#' @param df
#'
#' @return
#' a data.frame
#'
remove_empty_rows <- function(df) {
all.NA.idx <- which(apply(df,1,function(x)all(is.na(x))))
if (length(all.NA.idx) > 0) {
df <- df[-all.NA.idx,] # Rem rows with all cols == NA
}
return(df)
}
##
#' which_coerce_NA
#'
#' Return index of the elements that would coerce to NA in a vector
#'
#' @param x
#' @param allow.orig.NA Should NA be allowed. E.g. only NA introduced by as.numeric should be returned
#' @param orig.NA if allow.orig.NA id TRUE this number is internally used for NA in the input
#'
#' @return
#' Return index of the elements that would coerce to NA in a vector
#'
which_coerce_NA <- function(x, allow.orig.NA = TRUE, orig.NA = -989898) {
defaultW <- getOption("warn")
options(warn = -1)
if (allow.orig.NA) x[is.na(x)] <- orig.NA
res <- which(is.na(as.numeric(x)))
options(warn = defaultW)
return(res)
}
#' strip_time set components minutes and seconds to zero
#'
#' @param t a vector that can be coerced to time with as.POSIXlt
#'
#' @return
#' a vector of POSIXct
#'
strip_time <- function(t) {
lt <- as.POSIXlt(t)
lt[, "sec"] <- 0
lt[, "min"] <- 0
return(as.POSIXct(lt))
}
#' mean_nooutliers
#'
#' Remove outliers from x using boxplot.stats and return the mean of remaining data
#'
#' @param x
#'
#' @return
#' mean with outliers removed
#'
mean_nooutliers <- function(x) {
return(mean(grDevices::boxplot.stats(x)$stats))
}
# HOBO related functions ----
#' water_density
#'
#' Return water density at water temp temp_water
#' Borrowed from https://github.com/GLEON/rLakeAnalyzer/blob/master/R/water.density.R
#'
#' @param temp_water
#'
#' @return
#' water density at temperature
#'
water_density <- function(temp_water) {
return((1000 *
(1 -(temp_water+288.9414) *
(temp_water-3.9863)^2/(508929.2*(temp_water+68.12963)))))
}
#' Calculate water level
#'
#' Calculate water level from barimetric pressure at meassured bottom,
# a refererence air pressure and water temperature
#' @param P_water pressure in water in kPa
#' @param P_ref reference air pressure in kPa
#' @param temp_water water temperature in degrees Celsius
#'
#' @return
#' A numeric. water level in meters
#
calc_depth <- function(P_water, P_ref, temp_water) {
g <- 9.80665
rho <- water_density(temp_water)
depth <- (P_water*1000 - P_ref*1000) / (rho * g)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.