R/RcppExports.R

In jkennel/waterlevel: Well Water Level Analysis Tools

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' harmonic
#'
#' calculate sin and cos curves from POSIXct times (serial)
#'
#' @param times \code{numeric vector} times to calculate sin and cos at
#' @param freq \code{numeric vector} frequencies for sin and cos
#'
#' @return sin and cos curves
#'
#' @export
#'
harmonic <- function(times, freq) {
    .Call(`_waterlevel_harmonic`, times, freq)
}

check_lag <- function(n, lag, n_shift) {
    .Call(`_waterlevel_check_lag`, n, lag, n_shift)
}

get_length <- function(n, n_subset) {
    .Call(`_waterlevel_get_length`, n, n_subset)
}

get_start <- function(n_out, lag, n_subset) {
    .Call(`_waterlevel_get_start`, n_out, lag, n_subset)
}

get_end <- function(n, n_out, lag, n_subset) {
    .Call(`_waterlevel_get_end`, n, n_out, lag, n_subset)
}

#' @title
#' shift_subset
#'
#' @description
#' lag data and subset the results
#'
#' @param x \code{numeric vector} to lag
#' @param lag \code{integer vector} with the lags
#' @param n_subset \code{integer} subset every n_subset values
#' @param n_shift \code{integer} amount to shift results
#'
#' @return vector with lagged values
#'
#'
#' @export
shift_subset <- function(x, lag = 0L, n_subset = 1L, n_shift = 0L) {
    .Call(`_waterlevel_shift_subset`, x, lag, n_subset, n_shift)
}

#' @title
#' lag_matrix
#'
#' @description
#' lag data and subset the results
#'
#' @param x \code{numeric vector} to lag
#' @param lags \code{integer vector} with the lags
#' @param n_subset \code{integer} subset every n_subset values
#' @param n_shift \code{integer} amount to shift results
#' @param var_name \code{character} name for the generated matrix columns
#'
#' @return matrix with lagged values
#'
#'
#' @export
lag_matrix <- function(x, lags, n_subset = 1L, n_shift = 0L, var_name = "lag") {
    .Call(`_waterlevel_lag_matrix`, x, lags, n_subset, n_shift, var_name)
}

#' @title
#' distributed_lag_parallel
#'
#' @description
#' This method calculates the basis for a distributed lag in parallel.  It is currently
#' slow.
#'
#' @param x matrix value of lag
#' @param bl matrix the basis lags
#' @param lag_max integer maximum number of lags
#' @param n_subset integer subset the data
#' @param n_shift integer to shift
#'
#' @return distributed lag basis
#'
#'
#' @export
#'
distributed_lag_parallel <- function(x, bl, lag_max, n_subset = 1L, n_shift = 0L) {
    .Call(`_waterlevel_distributed_lag_parallel`, x, bl, lag_max, n_subset, n_shift)
}

#' @title
#' det_parallel
#'
#' @description
#' Determinant for an array in parallel
#'
#' @param a \code{numeric array} values to evaluate
#'
#' @return vector of determinants
#'
#'
#' @export
det_parallel <- function(a) {
    .Call(`_waterlevel_det_parallel`, a)
}

#' @title
#' solve_tf_parallel
#'
#' @description
#' Calculate the transfer functions for an array in parallel
#'
#' @param a \code{numeric array} values to evaluate
#'
#' @return vector of transfer functions
#'
#'
#' @export
solve_tf_parallel <- function(a) {
    .Call(`_waterlevel_solve_tf_parallel`, a)
}

calc_b_vals <- function(b, wb) {
    .Call(`_waterlevel_calc_b_vals`, b, wb)
}

konno_ohmachi <- function(b_vals, ref_z, f, x, i) {
    .Call(`_waterlevel_konno_ohmachi`, b_vals, ref_z, f, x, i)
}

#' @title
#' konno_ohmachi_parallel
#'
#' @description
#' This method does konno ohmachi smoothing
#'
#' @param x vector to smooth
#' @param f vector of frequencies
#' @param b integer even magnitude to smooth
#'
#' @return konno ohmachi smoothed results
#'
#'
#' @export
#'
konno_ohmachi_parallel <- function(x, f, b = 10L) {
    .Call(`_waterlevel_konno_ohmachi_parallel`, x, f, b)
}

#' @title
#' konno_ohmachi_serial
#'
#' @description
#' This method does konno ohmachi smoothing
#'
#' @param x \code{numeric vector} to smooth
#' @param f \code{numeric vector} of frequencies
#' @param b \code{integer} smoothing coefficient
#'
#' @return vector of konno ohmachi smoothed results
#'
#'
#' @export
#'
konno_ohmachi_serial <- function(x, f, b = 10L) {
    .Call(`_waterlevel_konno_ohmachi_serial`, x, f, b)
}

#' @rdname parabolic_weights_field
#' 
#' @param ntap the maximum number of tapers
#' 
#' @export
parabolic_weights_field <- function(ntap) {
    .Call(`_waterlevel_parabolic_weights_field`, ntap)
}

#' @title Resample an fft using varying numbers of sine tapers
#' 
#' @description
#' Produce an un-normalized psd based on an fft and a vector of optimal sine tapers
#' 
#' @details
#' To produce a psd estimate with our adaptive spectrum estimation method, we need only make one 
#' fft calculation initially and then
#' apply the weighting factors given by \code{\link{parabolic_weights_field}}, which this
#' function does.
#' 
#' @param fftz complex; a matrix representing the dual-length \code{\link{fft}}; see also the \code{dbl} argument
#' @param tapers integer; a vector of tapers
#' @param verbose logical; should messages be given?
#' @param dbl logical; should the code assume \code{fftz} is dual-length or single-length?
#' @param tapcap integer; the maximum number of tapers which can be applied; note that the length is
#' automatically limited by the length of the series.
#' 
#' @seealso \code{\link{riedsid}}
#' 
#' @examples
#' fftz <- complex(real=1:8, imaginary = 1:8)
#' taps <- 1:4
#' try(resample_fft_rcpp2(fftz, taps))
#' 
#' @export
resample_mvfft <- function(fftz, tapers, verbose = TRUE, dbl = TRUE, tapcap = 10000L) {
    .Call(`_waterlevel_resample_mvfft`, fftz, tapers, verbose, dbl, tapcap)
}

calc_psd <- function(fftz, taper_vec, para, j, ne2) {
    .Call(`_waterlevel_calc_psd`, fftz, taper_vec, para, j, ne2)
}

#' @title Resample an fft using varying numbers of sine tapers
#'
#' @description
#' Produce an un-normalized psd based on an fft and a vector of optimal sine tapers
#'
#' @details
#' To produce a psd estimate with our adaptive spectrum estimation method, we need only make one
#' fft calculation initially and then
#' apply the weighting factors given by \code{\link{parabolic_weights_rcpp}}, which this
#' function does.
#'
#' @param fftz complex; a matrix representing the dual-length \code{\link{fft}}; see also the \code{dbl} argument
#' @param tapers integer; a vector of tapers
#' @param verbose logical; should messages be given?
#' @param dbl logical; should the code assume \code{fftz} is dual-length or single-length?
#' @param tapcap integer; the maximum number of tapers which can be applied; note that the length is
#' automatically limited by the length of the series.
#'
#' @seealso \code{\link{riedsid}}
#'
#' @examples
#' fftz <- complex(real=1:8, imaginary = 1:8)
#' taps <- 1:4
#' try(resample_fft_rcpp2(fftz, taps))
#'
#' @export
resample_fft_parallel <- function(fftz, tapers, verbose = TRUE, dbl = TRUE, tapcap = 10000L) {
    .Call(`_waterlevel_resample_fft_parallel`, fftz, tapers, verbose, dbl, tapcap)
}