R/RcppExports.R

Defines functions vadose_response2 vadose_response weeks_1979 to_dummy_list to_dummy to_dummy_list_base fi pca_list_with_params pca_with_params pca cor_eigen pca_eigen pca_list_rotation_eigen scale_list_matrix_eigen pca_list_eigen cor_list_eigen scale_list_param_eigen scale_list_param_std scale_list_param ogata_banks_decay_vec ogata_banks_decay_ind ogata_banks_vec ogata_banks_ind llt_fitted llt_weighted_solve llt_solve_full llt_solve lag_list shift_subset get_end get_start get_length check_lag parallel_fractures_heat parallel_fractures_solute barker_herbert theis_laplace hantush_jacob_laplace jacob_lohman_laplace papadopulos_cooper_laplace cooper_bredehoeft_papadopulos_laplace cohen_c cohen_p stehfest_p stehfest_v bessel_k_cplx gamma_inc which_indices check_ffts determine_frequency group_frequency power_spaced make_groups spec_taper kernel_apply_list kernel_apply modified_daniell detrend_and_demean_list detrend_and_demean_matrix demean_vector demean_matrix detrend_vector detrend_matrix pad_vector next_n_eigen index_from_j_i get_column_number index_from_i_j gcd decimal_to_scaled_integer any_decimal list_multiply_subset row_multiply2 row_multiply3 row_sums_eigen dimensionless_S dimensionless_w_prime dimensionless_well_bore_storage dimensionless_gamma dimensionless_alpha dimensionless_sigma dimensionless_beta dimensionless_ratio dimensionless_head dimensionless_time well_delay shape_factor well_skin well_bore_storage harmonic_list quadratic_t_max double_exp_4 polder_3 hantush_3 gamma_3 gamma_3_parameter exp_2 exp_2_parameter ig hantush_jacob hantush_well_rcpp hantush_well_vec hantush_well hantush_epsilon grf_grid grf_time grf_u grf_coefficient grid_pumping_regimes theis_aniso_time theis_aniso_u_grid theis_aniso_u theis_aniso_coefficient theis_u_time_rcpp theis_u_time_vec theis_u well_function_coefficient_rcpp well_function_coefficient_vec well_function_coefficient calculate_distance binary_search bh_gamma_p_inv std_tgamma std_expint_vec std_expint rcpp_to_std std_to_rcpp eigen_to_std std_to_eigen impulse_function_eigen impulse_function_rcpp impulse_function gwr_barker_herbert barker_herbert_impulse gwr_p window_scale window_blackman_harris window_blackman_nuttall window_nuttall window_first_deriv window_rectangle window_hann_cplx window_tukey window_hann transfer_welch transfer_pgram transfer_pgram_smooth ordinary_coherence_phase solve_cplx_irr list_to_matrix solve_cplx_parallel spec_welch spec_pgram_list spec_pgram fill_lower_left multiply_ffts convolve_list2 convolve_list convolve_matrix convolve_tf convolve_overlap_save_list shift_eigen convolve_overlap_save convolve_overlap_add convolve_filter convolve_vec fft_matrix distributed_lag_list4 distributed_lag_list3 distributed_lag_list2 distributed_lag_list distributed_lag_thread_eigen distributed_lag_eigen convolve_eigen distributed_lag_thread be_dft dft_goertzel dft_with_window dft coordinate_rotate coordinate_transform bouwer_rice bouwer_rice_abc c_cpp b_cpp a_cpp be_transfer be_harmonic_cpp get_peaks be_least_squares_cpp be_least_squares_diff_cpp be_clark_cpp log_lags log_lags_arma b_spline_list3 b_spline_list2 n_spline_list b_spline_list

Documented in bessel_k_cplx

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

#' @title
#' b_spline_list
#'
#' @description
#' Create spline terms
#'
#' @inheritParams splines2::bSpline
#' @param internal_knots locations where parameters can change
#' @param boundary_knots end points of the spline
#' @param complete_basis intercept argument
#'
#' @return List of distributed lags
#'
#' @export
#'
#' @noRd
b_spline_list <- function(x, df, degree, internal_knots, boundary_knots, complete_basis = FALSE, periodic = FALSE, derivs = 0L, integral = FALSE) {
    .Call(`_hydrorecipes_b_spline_list`, x, df, degree, internal_knots, boundary_knots, complete_basis, periodic, derivs, integral)
}

#' @title
#' n_spline_list
#'
#' @description
#' Create spline terms
#'
#' @inheritParams splines2::naturalSpline
#' @param internal_knots locations where parameters can change
#' @param boundary_knots end points of the spline
#' @param complete_basis intercept argument
#'
#' @return List of distributed lags
#'
#' @export
#'
#' @noRd
#'
n_spline_list <- function(x, df, degree, internal_knots, boundary_knots, complete_basis, periodic = FALSE, derivs = 0L, integral = FALSE) {
    .Call(`_hydrorecipes_n_spline_list`, x, df, degree, internal_knots, boundary_knots, complete_basis, periodic, derivs, integral)
}

b_spline_list2 <- function(x, df, degree, internal_knots, boundary_knots, complete_basis = TRUE, periodic = FALSE, derivs = 0L, integral = FALSE) {
    .Call(`_hydrorecipes_b_spline_list2`, x, df, degree, internal_knots, boundary_knots, complete_basis, periodic, derivs, integral)
}

b_spline_list3 <- function(x, df, degree, internal_knots, boundary_knots, complete_basis = TRUE, periodic = FALSE, derivs = 0L, integral = FALSE) {
    .Call(`_hydrorecipes_b_spline_list3`, x, df, degree, internal_knots, boundary_knots, complete_basis, periodic, derivs, integral)
}

#' @title
#' log_lags_arma
#'
#' @description
#' Generate logarithmically spaced lags
#'
#' @param n integer number of lag terms
#' @param max_lag integer the maximum lag
#'
#' @return vector of logarithmically spaced lags
#'
#' @export
#'
#' @noRd
#'
log_lags_arma <- function(n, max_lag) {
    .Call(`_hydrorecipes_log_lags_arma`, n, max_lag)
}

#' @title
#' log_lags
#'
#' @description
#' Generate logarithmically spaced lags
#'
#' @param n integer number of lag terms
#' @param max_lag integer the maximum lag
#'
#' @return vector of logarithmically spaced lags
#'
#' @export
#'
#' @noRd
#'
log_lags <- function(n, max_lag) {
    .Call(`_hydrorecipes_log_lags`, n, max_lag)
}

#' @title
#' be_clark_cpp
#'
#' @description
#' Clark 1967 solution for calculating barometric efficiency (Algorithm from Batu 1998, pg 76)
#'
#' @param dep \code{numeric vector} of the dependent variable (ie:water level)
#' @param ind \code{numeric vector} of the independent variable (ie:barometric pressure)
#' @param lag_space \code{integer} spacing for lags, useful for higher frequency monitoring
#' @param inverse \code{logical} whether the barometric relationship is inverse
#'
#' @return barometric efficiency using Clark's method
#'
#'
#' @export
#'
#' @examples
#' n <- 1000
#' baro <- sin(seq(0, 2*pi, length.out = 1000))
#' wl <- -0.4 * baro + rnorm(1000, sd = 0.02)
#' be_clark_cpp(wl, baro, lag_space=1, inverse=TRUE)
#'
#' @noRd
#'
be_clark_cpp <- function(dep, ind, lag_space, inverse) {
    .Call(`_hydrorecipes_be_clark_cpp`, dep, ind, lag_space, inverse)
}

be_least_squares_diff_cpp <- function(dep, ind, lag_space, inverse) {
    .Call(`_hydrorecipes_be_least_squares_diff_cpp`, dep, ind, lag_space, inverse)
}

be_least_squares_cpp <- function(dep, ind, inverse) {
    .Call(`_hydrorecipes_be_least_squares_cpp`, dep, ind, inverse)
}

get_peaks <- function(freqs, f1, f2) {
    .Call(`_hydrorecipes_get_peaks`, freqs, f1, f2)
}

be_harmonic_cpp <- function(x, inverse) {
    .Call(`_hydrorecipes_be_harmonic_cpp`, x, inverse)
}

be_transfer <- function(x, spans, detrend, demean, taper, frequency, cycle_size) {
    .Call(`_hydrorecipes_be_transfer`, x, spans, detrend, demean, taper, frequency, cycle_size)
}

a_cpp <- function(x) {
    .Call(`_hydrorecipes_a_cpp`, x)
}

b_cpp <- function(x) {
    .Call(`_hydrorecipes_b_cpp`, x)
}

c_cpp <- function(x) {
    .Call(`_hydrorecipes_c_cpp`, x)
}

#' Calculate equations 4 and 5 from bouwer, 1989
#'
#' @param rw radius of well
#' @param Le Effecive screen length
#' @param Lw height of water from bottom of well
#' @param H height from bottom of aquifer
#'
#' @return ln(Re/rw)
#'
#' @noRd
bouwer_rice_abc <- function(rw, Le, Lw, H) {
    .Call(`_hydrorecipes_bouwer_rice_abc`, rw, Le, Lw, H)
}

#' Calculate transmissivity with Bouwer-Rice solution
#'
#' @param time the elapsed time
#' @param drawdown the drawdown
#' @param radius_screen radius of the screen
#' @param radius_casing radius of the casing where the water level is
#' @param Le Effecive screen length
#' @param Lw height of water from bottom of well
#' @param H height from bottom of aquifer
#'
#' @return transmissivity from bouwer_rice
#'
#' @export
#'
#' @noRd
bouwer_rice <- function(time, drawdown, radius_screen, radius_casing, Le, Lw, H) {
    .Call(`_hydrorecipes_bouwer_rice`, time, drawdown, radius_screen, radius_casing, Le, Lw, H)
}

coordinate_transform <- function(coords, anisotropy, major_axis_angle) {
    .Call(`_hydrorecipes_coordinate_transform`, coords, anisotropy, major_axis_angle)
}

coordinate_rotate <- function(coords, major_axis_angle) {
    .Call(`_hydrorecipes_coordinate_rotate`, coords, major_axis_angle)
}

dft <- function(x, frequency) {
    .Call(`_hydrorecipes_dft`, x, frequency)
}

dft_with_window <- function(x, frequency) {
    .Call(`_hydrorecipes_dft_with_window`, x, frequency)
}

dft_goertzel <- function(x, frequency) {
    .Call(`_hydrorecipes_dft_goertzel`, x, frequency)
}

be_dft <- function(x, frequency) {
    .Call(`_hydrorecipes_be_dft`, x, frequency)
}

#' @title
#' distributed_lag_thread
#'
#' @description
#' Create distributed lag terms
#'
#' @param x numeric vector to lag
#' @param bl numeric matrix basis lag
#' @param n_thread integer number of threads to use
#'
#' @return List of distributed lags
#'
#' @export
#'
#' @noRd
distributed_lag_thread <- function(x, bl, n_thread) {
    .Call(`_hydrorecipes_distributed_lag_thread`, x, bl, n_thread)
}

convolve_eigen <- function(x, y) {
    .Call(`_hydrorecipes_convolve_eigen`, x, y)
}

#' @title
#' distributed_lag_eigen
#'
#' @description
#' Create distributed lag terms
#'
#' @param x numeric vector to lag
#' @param bl numeric matrix basis lag
#'
#' @return List of distributed lags
#'
#' @export
#'
#' @noRd
#'
distributed_lag_eigen <- function(x, bl) {
    .Call(`_hydrorecipes_distributed_lag_eigen`, x, bl)
}

#' @title
#' distributed_lag_thread_eigen
#'
#' @description
#' Create distributed lag terms
#'
#' @param x numeric vector to lag
#' @param bl numeric matrix basis lag
#' @param lag_max integer maximum lag
#' @param n_subset take every n_subset rows
#' @param n_shift shift values from starting on first row.  Should be less than
#'  n_subset
#' @param n_thread integer number of threads to use
#'
#' @return List of distributed lags
#'
#' @export
#'
#' @noRd
#'
distributed_lag_thread_eigen <- function(x, bl, lag_max, n_subset, n_shift, n_thread) {
    .Call(`_hydrorecipes_distributed_lag_thread_eigen`, x, bl, lag_max, n_subset, n_shift, n_thread)
}

#' @title
#' distributed_lag_list
#'
#' @description
#' Create distributed lag terms
#' @inheritParams splines2::bSpline
#'
#' @param x numeric vector to lag
#' @param n_lag number of lag terms
#' @param max_lag integer the maximum lag
#' @param internal_knots location of internal knots
#' @param boundary_knots location of boundary knots
#' @param complete_basis logical intercept?
#'
#' @return List of distributed lags
#'
#' @export
#'
#' @noRd
#'
distributed_lag_list <- function(x, n_lag, max_lag, df, degree, internal_knots, boundary_knots, complete_basis, periodic, derivs, integral) {
    .Call(`_hydrorecipes_distributed_lag_list`, x, n_lag, max_lag, df, degree, internal_knots, boundary_knots, complete_basis, periodic, derivs, integral)
}

distributed_lag_list2 <- function(x, n_lag, max_lag, df, degree, internal_knots, boundary_knots, complete_basis, periodic, derivs, integral) {
    .Call(`_hydrorecipes_distributed_lag_list2`, x, n_lag, max_lag, df, degree, internal_knots, boundary_knots, complete_basis, periodic, derivs, integral)
}

distributed_lag_list3 <- function(x, n_lag, max_lag, df, degree, internal_knots, boundary_knots, complete_basis, periodic, derivs, integral) {
    .Call(`_hydrorecipes_distributed_lag_list3`, x, n_lag, max_lag, df, degree, internal_knots, boundary_knots, complete_basis, periodic, derivs, integral)
}

distributed_lag_list4 <- function(x, s, max_lag) {
    .Call(`_hydrorecipes_distributed_lag_list4`, x, s, max_lag)
}

#' @title
#' fft_matrix
#'
#' @description
#' Do an FFT for each matrix column
#'
#' @param x the matrix that holds the series (numeric matrix)
#' @param detrend remove the linear trend of the columns (boolean)
#' @param demean remove the mean for each column (boolean)
#' @param n_new the padded size (integer)
#'
#' @return A matrix with FFT results.
#'
#' @noRd
#'
fft_matrix <- function(x, n_new) {
    .Call(`_hydrorecipes_fft_matrix`, x, n_new)
}

#' @title
#' convolve_vec
#'
#' @description
#' Circular convolution of two vectors having the same length
#'
#' @param x the vector that holds the series (numeric vector)
#' @param y the vector to convolve with x (numeric vector)
#'
#'
#' @return numeric vector that is the circular convolution of two vectors
#'
#'
#' @noRd
#'
convolve_vec <- function(x, y) {
    .Call(`_hydrorecipes_convolve_vec`, x, y)
}

#' @title
#' convolve_filter
#'
#' @description
#' convolution of vector with matrix
#'
#' @param x vector to convolve with y (numeric vector)
#' @param y numeric matrix to convolve with x (column by column convolution)
#'  (numeric matrix)
#' @param remove_partial keep the end values or fill with NA (boolean)
#' @param reverse should x be reversed before convolution (boolean)
#'
#' @return numeric matrix of convolved values
#'
#' @export
#'
#'
#' @examples
#' a <- convolve_filter(x = 1:100,
#'                      y = c(1:10, rep(0, 90)),
#'                      remove_partial = FALSE,
#'                      reverse = TRUE)
#'
#' b <- stats::convolve(1:100, rev(1:10), type = 'filter')
#'
#' @noRd
#'
convolve_filter <- function(x, y, remove_partial, reverse) {
    .Call(`_hydrorecipes_convolve_filter`, x, y, remove_partial, reverse)
}

#' @title
#' convolve_overlap_add
#'
#' @description
#' Multiply a transfer function with a real input and take the inverse FFT.
#'
#' @param x the vector that holds the series (numeric vector)
#' @param y the kernel to convolve with x (complex numeric vector)
#'
#' @return the linear convolution of two vectors
#'
#' @noRd
#'
convolve_overlap_add <- function(x, y) {
    .Call(`_hydrorecipes_convolve_overlap_add`, x, y)
}

#' @title
#' convolve_overlap_save
#'
#' @description
#' Multiply a transfer function with a real input and take the inverse FFT.
#'
#' @param x the vector that holds the series (numeric vector)
#' @param y the kernel to convolve with x (complex numeric vector)
#' @param align right (0), center (1), or left (2) alignment
#'
#'
#' @return the linear convolution of two vectors
#'
#' @noRd
#'
convolve_overlap_save <- function(x, y, align) {
    .Call(`_hydrorecipes_convolve_overlap_save`, x, y, align)
}

shift_eigen <- function(x, n) {
    .Call(`_hydrorecipes_shift_eigen`, x, n)
}

#' @title
#' convolve_overlap_save_list
#'
#' @description
#' Multiply a transfer function with a real input and take the inverse FFT.
#'
#' @param x the vector that holds the series (numeric vector)
#' @param y the list of kernels to convolve with x
#' @param align right (0), center (1), or left (2) alignment
#'
#' @return the linear convolution of two vectors
#'
#' @noRd
#'
convolve_overlap_save_list <- function(x, y, align) {
    .Call(`_hydrorecipes_convolve_overlap_save_list`, x, y, align)
}

#' @title
#' convolve_tf
#'
#' @description
#' Multiply a transfer function with a real input and take the inverse FFT.
#'
#' @param x the vector that holds the series (numeric vector)
#' @param y the transfer function to multiply with x (complex numeric vector)
#'
#'
#' @return the circular convolution of two vectors
#'
#' @noRd
#'
convolve_tf <- function(x, y) {
    .Call(`_hydrorecipes_convolve_tf`, x, y)
}

#' @title
#' convolve_matrix
#'
#' @description
#' convolution of vector with matrix
#'
#' @param x vector to convolve with y (numeric vector)
#' @param y numeric matrix to convolve with x (column by column convolution)
#'  (numeric matrix)
#' @param remove_partial keep the end values or fill with NA (boolean)
#' @param reverse should x be reversed before convolution (boolean)
#'
#' @return numeric matrix of convolved values
#'
#' @export
#'
#'
#' @examples
#' a <- convolve_matrix(x = 1:100,
#'                      y = as.matrix(1:10),
#'                      remove_partial = FALSE,
#'                      reverse = TRUE)
#'
#' b <- stats::convolve(1:100, rev(1:10), type = 'filter')
#'
#' @noRd
#'
convolve_matrix <- function(x, y, remove_partial, reverse) {
    .Call(`_hydrorecipes_convolve_matrix`, x, y, remove_partial, reverse)
}

#' @title
#' convolve_matrix
#'
#' @description
#' convolution of vector with matrix
#'
#' @param x vector to convolve with y (numeric vector)
#' @param y numeric matrix to convolve with x (column by column convolution)
#'  (numeric matrix)
#' @param remove_partial keep the end values or fill with NA (boolean)
#' @param reverse should x be reversed before convolution (boolean)
#'
#' @return numeric matrix of convolved values
#'
#' @export
#'
#'
#' @examples
#' a <- convolve_matrix(x = 1:100,
#'                      y = as.matrix(1:10),
#'                      remove_partial = FALSE,
#'                      reverse = TRUE)
#'
#' b <- stats::convolve(1:100, rev(1:10), type = 'filter')
#'
#' @noRd
#'
convolve_list <- function(x, y, remove_partial, reverse) {
    .Call(`_hydrorecipes_convolve_list`, x, y, remove_partial, reverse)
}

convolve_list2 <- function(x, y, remove_partial, reverse) {
    .Call(`_hydrorecipes_convolve_list2`, x, y, remove_partial, reverse)
}

#' @title
#' multiply_ffts
#'
#' @description
#' Multiply each column of a complex matrix with all the columns.
#'
#' @param x complex matrix to convolve with itself (complex numeric matrix)
#' @param n_col number of columns in the original input series (integer)
#' @param truncated skip the first row to decrease memory use? (boolean)
#'
#'
#' @return pgram of input FFT values.
#'
#' @noRd
#'
multiply_ffts <- function(x) {
    .Call(`_hydrorecipes_multiply_ffts`, x)
}

#' @title
#' fill_lower_left
#'
#' @description
#' Fill in the complex conjugate columns.
#'
#' @param x complex matrix of pgram values (complex matrix)
#' @param n_col number of columns in the original input series (integer)
#' @param start the first row index to begin on (boolean)
#'
#'
#' @return Matrix with filled in complex conjugate columns.
#'
#' @noRd
#'
fill_lower_left <- function(x, start) {
    .Call(`_hydrorecipes_fill_lower_left`, x, start)
}

#' @title
#' spec_pgram
#'
#' @description
#' Calculate the periodogram.  This method only keeps the columns necessary for
#' the transfer function calculation. This method is based on `spec.pgram`.
#'
#' @inheritParams spec.pgram
#'
#'
#' @return periodogram from an input matrix using a Fast Fourier Transform.
#' Similar to `spec.pgram` but should be faster.
#'
#' @noRd
#'
spec_pgram <- function(x, spans, detrend, demean, taper, pad_fft) {
    .Call(`_hydrorecipes_spec_pgram`, x, spans, detrend, demean, taper, pad_fft)
}

#' @title
#' spec_pgram_list
#'
#' @description
#' Calculate the periodogram.  This method only keeps the columns necessary for
#' the transfer function calculation. This method is based on `spec.pgram`.
#'
#' @inheritParams spec.pgram
#'
#'
#' @return periodogram from an input matrix using a Fast Fourier Transform.
#' Similar to `spec.pgram` but should be faster.
#'
#' @noRd
#'
spec_pgram_list <- function(x, spans, detrend, demean, taper, pad_fft) {
    .Call(`_hydrorecipes_spec_pgram_list`, x, spans, detrend, demean, taper, pad_fft)
}

#' @title
#' spec_welch
#'
#' @description
#' Calculate the periodogram using Welch's method.  This method only keeps the
#' columns necessary for the transfer function calculation. This method is
#' based on `spec.pgram`.
#'
#' @inheritParams spec.pgram
#' @param length_subset length of each subset (integer)
#' @param overlap percent to overlap subsets (double)
#' @param window vector of length length_subset (numeric vector)
#'
#'
#' @return periodogram from an input matrix using a Fast Fourier Transform and
#' Welch's method.
#'
#' @noRd
#'
spec_welch <- function(x, length_subset, overlap, window) {
    .Call(`_hydrorecipes_spec_welch`, x, length_subset, overlap, window)
}

#' @title
#' solve_cplx_parallel
#'
#' @description
#' Calculate the transfer function from a periodogram.
#'
#' @inheritParams spec.pgram
#' @inheritParams make_groups
#'
#' @return the transfer functions.
#'
#' @noRd
#'
solve_cplx_parallel <- function(x) {
    .Call(`_hydrorecipes_solve_cplx_parallel`, x)
}

list_to_matrix <- function(x, sub_start, sub_end) {
    .Call(`_hydrorecipes_list_to_matrix`, x, sub_start, sub_end)
}

#' @title
#' solve_cplx_irr
#'
#' @description
#' Calculate the transfer function from a periodogram with irregular sized
#' groups. This is experimental to see if we can improve efficiency.
#' Instead of fitting every frequency it fits groups of frequencies
#' The goal is to lump many high frequency signals to increase signal to
#' noise ratios, and only few low frequency signals to keep resolution at low
#' frequency.
#'
#' @inheritParams make_groups
#' @inheritParams fill_lower_left
#'
#'
#' @return the transfer functions.
#'
#' @noRd
#'
solve_cplx_irr <- function(x, n_groups) {
    .Call(`_hydrorecipes_solve_cplx_irr`, x, n_groups)
}

#' @title
#' ordinary_coherence_phase
#'
#' @description
#' Calculate ordinary coherence and phase from a pgram. Reference:
#' https://vru.vibrationresearch.com/lesson/coherence-mathematics/
#'
#' @param x periodogram matrix (complex matrix)
#'
#' @return Matrix with ordinary coherence and phase.
#'
#' @noRd
#'
ordinary_coherence_phase <- function(x) {
    .Call(`_hydrorecipes_ordinary_coherence_phase`, x)
}

#' @title
#' transfer_pgram_smooth
#'
#' @description
#' Calculate the transfer function from an input matrix. This function uses
#' irregular sized groups using `make_groups`. This is experimental to see if
#' and designed to be relatively fast. Instead of fitting every frequency and
#' aggregating post solving, it fits groups of frequencies.
#' The goal is to lump many high frequency signals to increase signal to
#' noise ratios, and only few low frequency signals to keep resolution at low
#' frequency.
#'
#' @inheritParams spec.pgram
#' @inheritParams make_groups
#' @param n_col number of covariate columns (integer)
#'
#'
#' @return the transfer functions.
#'
#' @noRd
#'
transfer_pgram_smooth <- function(x, spans, detrend, demean, taper, n_groups) {
    .Call(`_hydrorecipes_transfer_pgram_smooth`, x, spans, detrend, demean, taper, n_groups)
}

transfer_pgram <- function(x, spans, detrend, demean, taper) {
    .Call(`_hydrorecipes_transfer_pgram`, x, spans, detrend, demean, taper)
}

#' @title
#' transfer_welch
#'
#' @description
#' Calculate the transfer function from an input matrix. This function uses
#' irregular sized groups using `make_groups`. This is experimental to see if
#' and designed to be relatively fast. Instead of fitting every frequency and
#' aggregating post solving, it fits groups of frequencies.
#' The goal is to lump many high frequency signals to increase signal to
#' noise ratios, and only few low frequency signals to keep resolution at low
#' frequency.
#'
#' @inheritParams spec.pgram
#' @inheritParams make_groups
#' @param n_col number of covariate columns (integer)
#'
#'
#' @return the transfer functions.
#'
#' @noRd
#'
transfer_welch <- function(x, length_subset, overlap, window) {
    .Call(`_hydrorecipes_transfer_welch`, x, length_subset, overlap, window)
}

#' @title
#' window_hann
#'
#' @description
#' Hann window for FFT.
#'
#' @param n length of the window vector (integer)
#'
#' @return window of length n.
#'
#' @noRd
#'
window_hann <- function(n) {
    .Call(`_hydrorecipes_window_hann`, n)
}

#' @title
#' window_tukey
#'
#' @description
#' Tukey window for FFT.
#'
#' @inheritParams window_hann
#' @param r percent on each side to taper (double)
#'
#' @return window of length n.
#'
#' @noRd
#'
window_tukey <- function(n, r) {
    .Call(`_hydrorecipes_window_tukey`, n, r)
}

#' @title
#' window_hann_cplx
#'
#' @description
#' Hann window for complex FFT.
#'
#' @inheritParams window_hann
#'
#' @return window of length n.
#'
#' @noRd
#'
window_hann_cplx <- function(n) {
    .Call(`_hydrorecipes_window_hann_cplx`, n)
}

#' @title
#' window_rectangle
#'
#' @description
#' Rectangular window.
#'
#' @inheritParams window_hann
#'
#' @return window of length n.
#'
#' @noRd
#'
window_rectangle <- function(n) {
    .Call(`_hydrorecipes_window_rectangle`, n)
}

#' @title
#' window_first_deriv
#'
#' @description
#' First derivative window for FFT
#'
#' @inheritParams window_hann
#'
#' @param a0 \code{double} coefficient
#' @param a1 \code{double} coefficient
#' @param a2 \code{double} coefficient
#' @param a3 \code{double} coefficient
#'
#' @return window
#'
#' @export
#'
#' @examples
#' # nuttall window
#' window_first_deriv(100, 0.355768, 0.487396, 0.144232, 0.012604)
#'
#' @noRd
#'
window_first_deriv <- function(n, a0, a1, a2, a3) {
    .Call(`_hydrorecipes_window_first_deriv`, n, a0, a1, a2, a3)
}

#' @title
#' window_nuttall
#'
#' @description
#' Nuttall window for FFT
#'
#' @inheritParams window_hann
#'
#' @return window
#'
#' @export
#'
#' @examples
#' window_nuttall(100)
#'
#' @noRd
#'
window_nuttall <- function(n) {
    .Call(`_hydrorecipes_window_nuttall`, n)
}

#' @title
#' window_blackman_nuttall
#'
#' @description
#' Blackman-Nuttall window for FFT
#'
#' @inheritParams window_hann
#'
#' @return window
#'
#' @export
#'
#' @examples
#' window_blackman_nuttall(100)
#'
#' @noRd
#'
window_blackman_nuttall <- function(n) {
    .Call(`_hydrorecipes_window_blackman_nuttall`, n)
}

#' @title
#' window_blackman_harris
#'
#' @description
#' Blackman-Harris window for FFT
#'
#' @inheritParams window_hann
#'
#' @return window
#'
#' @export
#'
#' @examples
#' window_blackman_harris(100)
#'
#' @noRd
#'
window_blackman_harris <- function(n) {
    .Call(`_hydrorecipes_window_blackman_harris`, n)
}

#' @title
#' window_scale
#'
#' @description
#' Scale factor for a window function.
#'
#' @param window the window function (numeric vector)
#' @param n_new length of the padded series (integer)
#' @param n_fft length of the input series (integer)
#'
#' @return window of length n.
#'
#' @noRd
#'
window_scale <- function(window, n_new, n_fft) {
    .Call(`_hydrorecipes_window_scale`, window, n_new, n_fft)
}

gwr_p <- function(time, n_gwr) {
    .Call(`_hydrorecipes_gwr_p`, time, n_gwr)
}

barker_herbert_impulse <- function(p, radius, radius_patch, t_1, t_2, s_1, s_2) {
    .Call(`_hydrorecipes_barker_herbert_impulse`, p, radius, radius_patch, t_1, t_2, s_1, s_2)
}

gwr_barker_herbert <- function(time, flow_rate, radius, radius_patch, t_1, t_2, s_1, s_2, n_gwr) {
    .Call(`_hydrorecipes_gwr_barker_herbert`, time, flow_rate, radius, radius_patch, t_1, t_2, s_1, s_2, n_gwr)
}

impulse_function <- function(u) {
    .Call(`_hydrorecipes_impulse_function`, u)
}

impulse_function_rcpp <- function(u) {
    .Call(`_hydrorecipes_impulse_function_rcpp`, u)
}

impulse_function_eigen <- function(u) {
    .Call(`_hydrorecipes_impulse_function_eigen`, u)
}

std_to_eigen <- function(u) {
    .Call(`_hydrorecipes_std_to_eigen`, u)
}

eigen_to_std <- function(u) {
    .Call(`_hydrorecipes_eigen_to_std`, u)
}

std_to_rcpp <- function(u) {
    .Call(`_hydrorecipes_std_to_rcpp`, u)
}

rcpp_to_std <- function(u) {
    .Call(`_hydrorecipes_rcpp_to_std`, u)
}

std_expint <- function(u) {
    .Call(`_hydrorecipes_std_expint`, u)
}

std_expint_vec <- function(u) {
    .Call(`_hydrorecipes_std_expint_vec`, u)
}

std_tgamma <- function(u, a) {
    .Call(`_hydrorecipes_std_tgamma`, u, a)
}

bh_gamma_p_inv <- function(a, p) {
    .Call(`_hydrorecipes_bh_gamma_p_inv`, a, p)
}

binary_search <- function(x, y) {
    .Call(`_hydrorecipes_binary_search`, x, y)
}

calculate_distance <- function(x_well, y_well, x_loc, y_loc) {
    .Call(`_hydrorecipes_calculate_distance`, x_well, y_well, x_loc, y_loc)
}

well_function_coefficient <- function(flow_rate, transmissivity) {
    .Call(`_hydrorecipes_well_function_coefficient`, flow_rate, transmissivity)
}

well_function_coefficient_vec <- function(flow_rate, transmissivity) {
    .Call(`_hydrorecipes_well_function_coefficient_vec`, flow_rate, transmissivity)
}

well_function_coefficient_rcpp <- function(flow_rate, transmissivity) {
    .Call(`_hydrorecipes_well_function_coefficient_rcpp`, flow_rate, transmissivity)
}

theis_u <- function(radius, storativity, transmissivity, time) {
    .Call(`_hydrorecipes_theis_u`, radius, storativity, transmissivity, time)
}

theis_u_time_vec <- function(radius, storativity, transmissivity, time) {
    .Call(`_hydrorecipes_theis_u_time_vec`, radius, storativity, transmissivity, time)
}

theis_u_time_rcpp <- function(radius, storativity, transmissivity, time) {
    .Call(`_hydrorecipes_theis_u_time_rcpp`, radius, storativity, transmissivity, time)
}

theis_aniso_coefficient <- function(transmissivity_x, transmissivity_y) {
    .Call(`_hydrorecipes_theis_aniso_coefficient`, transmissivity_x, transmissivity_y)
}

theis_aniso_u <- function(x, y, storativity, transmissivity_x, transmissivity_y) {
    .Call(`_hydrorecipes_theis_aniso_u`, x, y, storativity, transmissivity_x, transmissivity_y)
}

theis_aniso_u_grid <- function(x, y, storativity, transmissivity_x, transmissivity_y) {
    .Call(`_hydrorecipes_theis_aniso_u_grid`, x, y, storativity, transmissivity_x, transmissivity_y)
}

#' @title
#' theis_aniso_time
#'
#' @description
#' Convolution of GRF well function and flow rates in the time domain.
#' Time series needs to be regularily spaced and so are the flow rates.  Some
#' performance gains can be achieved if the number of flow rate does not change
#' for each time.
#'
#' @param radius distance to monitoring interval
#' @param specific_storage aquifer storativity
#' @param hydraulic_conductivity aquifer hydraulic conductivity
#' @param thickness aquifer thickness
#' @param time prediction times
#' @param flow_rate well flow rates
#' @param flow_time_interval time between flow rate measurements in samples
#' @param flow_dimension flow dimension
#'
#' @return theis solution for multiple pumping scenario
#'
#'
#' @export
#'
#' @noRd
theis_aniso_time <- function(distance_x, distance_y, storativity, transmissivity_x, transmissivity_y, thickness, time, flow_rate) {
    .Call(`_hydrorecipes_theis_aniso_time`, distance_x, distance_y, storativity, transmissivity_x, transmissivity_y, thickness, time, flow_rate)
}

grid_pumping_regimes <- function(distance_x, distance_y, output_times, start_times, flow_rates, well_x, well_y, storativity, transmissivity_x, transmissivity_y, thickness) {
    .Call(`_hydrorecipes_grid_pumping_regimes`, distance_x, distance_y, output_times, start_times, flow_rates, well_x, well_y, storativity, transmissivity_x, transmissivity_y, thickness)
}

grf_coefficient <- function(radius, hydraulic_conductivity, thickness, flow_dimension) {
    .Call(`_hydrorecipes_grf_coefficient`, radius, hydraulic_conductivity, thickness, flow_dimension)
}

grf_u <- function(radius, specific_storage, hydraulic_conductivity) {
    .Call(`_hydrorecipes_grf_u`, radius, specific_storage, hydraulic_conductivity)
}

#' @title
#' grf_time
#'
#' @description
#' Convolution of GRF well function and flow rates in the time domain.
#' Time series needs to be regularily spaced and so are the flow rates.  Some
#' performance gains can be achieved if the number of flow rate does not change
#' for each time.
#'
#' @param radius distance to monitoring interval
#' @param specific_storage aquifer storativity
#' @param hydraulic_conductivity aquifer hydraulic conductivity
#' @param thickness aquifer thickness
#' @param time prediction times
#' @param flow_rate well flow rates
#' @param flow_time_interval time between flow rate measurements in samples
#' @param flow_dimension flow dimension
#'
#' @return theis solution for multiple pumping scenario
#'
#'
#' @export
#'
#' @noRd
grf_time <- function(radius, specific_storage, hydraulic_conductivity, thickness, time, flow_rate, flow_dimension) {
    .Call(`_hydrorecipes_grf_time`, radius, specific_storage, hydraulic_conductivity, thickness, time, flow_rate, flow_dimension)
}

#' @title
#' grf_grid
#'
#' @description
#' Parallel convolution of GRF well function and flow rates in the time domain.
#' Time series needs to be regularily spaced and so are the flow rates.  Some
#' performance gains can be achieved if the number of flow rate does not change
#' for each time.
#'
#' @param radius distance to monitoring interval
#' @param specific_storage aquifer storativity
#' @param hydraulic_conductivity aquifer hydraulic conductivity
#' @param thickness aquifer thickness
#' @param time prediction times
#' @param flow_rate well flow rates
#' @param flow_time_interval time between flow rate measurements in samples
#' @param flow_dimension flow dimension
#'
#' @return theis solution for multiple pumping scenario
#'
#'
#' @export
#' @noRd
grf_grid <- function(grid, well_locations, flow_rate, time, specific_storage, hydraulic_conductivity, thickness, flow_dimension) {
    .Call(`_hydrorecipes_grf_grid`, grid, well_locations, flow_rate, time, specific_storage, hydraulic_conductivity, thickness, flow_dimension)
}

hantush_epsilon <- function(radius, leakage) {
    .Call(`_hydrorecipes_hantush_epsilon`, radius, leakage)
}

#' @title
#' hantush_well
#'
#' @description
#' Result of the hantush well function
#'
#' Prodanoff, J.H.A., Mansur, W.J. and Mascarenhas, F.C.B., 2006. Numerical
#'   evaluation of Theis and Hantush-Jacob well functions. Journal of
#'   hydrology, 318(1-4), pp.173-183.
#'
#' @param u value of the Theis u
#' @param b the leakance
#' @param n_terms the number of terms used in the hantush approximation
#'
#'
#' @return hantush well function
#'
#'
#' @export
#'
#' @noRd
#'
hantush_well <- function(u, b, precision) {
    .Call(`_hydrorecipes_hantush_well`, u, b, precision)
}

hantush_well_vec <- function(u, b, n_terms) {
    .Call(`_hydrorecipes_hantush_well_vec`, u, b, n_terms)
}

hantush_well_rcpp <- function(u, b, precision) {
    .Call(`_hydrorecipes_hantush_well_rcpp`, u, b, precision)
}

#' @title
#' hantush_jacob
#'
#' @description
#' Convolution of hantush well function and flow rates in the time domain.
#' Time series needs to be regularly spaced.
#'
#' @param radius distance to monitoring interval
#' @param storativity aquifer storativity
#' @param transmissivity aquifer transmissivity
#' @param leakage hantush leakage
#' @param time prediction times
#' @param flow_rate well flow rates
#' @param flow_time_interval time between flow rate measurements in samples
#' @param n_terms number of terms to use in Hantush solution.  More is more precise but slower.
#'
#' @return hantush jacob solution for multiple pumping scenario
#'
#'
#' @export
#'
#' @noRd
#'
hantush_jacob <- function(time, flow_rate, radius, storativity, transmissivity, leakage, precision) {
    .Call(`_hydrorecipes_hantush_jacob`, time, flow_rate, radius, storativity, transmissivity, leakage, precision)
}

ig <- function(a, u) {
    .Call(`_hydrorecipes_ig`, a, u)
}

exp_2_parameter <- function(t, amplitude, lamda) {
    .Call(`_hydrorecipes_exp_2_parameter`, t, amplitude, lamda)
}

exp_2 <- function(t, amplitude, lamda) {
    .Call(`_hydrorecipes_exp_2`, t, amplitude, lamda)
}

gamma_3_parameter <- function(t, amplitude, k, theta) {
    .Call(`_hydrorecipes_gamma_3_parameter`, t, amplitude, k, theta)
}

gamma_3 <- function(t, amplitude, k, theta) {
    .Call(`_hydrorecipes_gamma_3`, t, amplitude, k, theta)
}

hantush_3 <- function(t, A, a, b) {
    .Call(`_hydrorecipes_hantush_3`, t, A, a, b)
}

polder_3 <- function(t, A, a, b) {
    .Call(`_hydrorecipes_polder_3`, t, A, a, b)
}

double_exp_4 <- function(t, A, a, b, f) {
    .Call(`_hydrorecipes_double_exp_4`, t, A, a, b, f)
}

quadratic_t_max <- function(a, b, small = -720) {
    .Call(`_hydrorecipes_quadratic_t_max`, a, b, small)
}

#' @title
#' harmonic_list
#'
#' @description
#' Create sin and cosine terms for harmonic analysis
#'
#' @param time numeric vector of times
#' @param frequency numeric vector of frequencies
#' @param start time the cycle starts
#' @param cycle_size size of the cycle in number of measurements
#'
#' @return List of cosines and sines
#'
#' @export
#'
#' @noRd
#'
harmonic_list <- function(time, frequency, start, cycle_size) {
    .Call(`_hydrorecipes_harmonic_list`, time, frequency, start, cycle_size)
}

well_bore_storage <- function(rc, rw, Ss, zpl, zpd) {
    .Call(`_hydrorecipes_well_bore_storage`, rc, rw, Ss, zpl, zpd)
}

well_skin <- function(kr, ks, ds, rw) {
    .Call(`_hydrorecipes_well_skin`, kr, ks, ds, rw)
}

shape_factor <- function(L, rp, kr, kz) {
    .Call(`_hydrorecipes_shape_factor`, L, rp, kr, kz)
}

well_delay <- function(rp, rw, Ss, kr, kz, L) {
    .Call(`_hydrorecipes_well_delay`, rp, rw, Ss, kr, kz, L)
}

dimensionless_time <- function(Kr, t, rw, Ss, b = 1.0) {
    .Call(`_hydrorecipes_dimensionless_time`, Kr, t, rw, Ss, b)
}

dimensionless_head <- function(Kr, t, rw, ht, h, Q, b = 1) {
    .Call(`_hydrorecipes_dimensionless_head`, Kr, t, rw, ht, h, Q, b)
}

dimensionless_ratio <- function(a, b) {
    .Call(`_hydrorecipes_dimensionless_ratio`, a, b)
}

dimensionless_beta <- function(Kd, rd) {
    .Call(`_hydrorecipes_dimensionless_beta`, Kd, rd)
}

dimensionless_sigma <- function(Ss, b, Sy) {
    .Call(`_hydrorecipes_dimensionless_sigma`, Ss, b, Sy)
}

dimensionless_alpha <- function(Ss, b, Sy) {
    .Call(`_hydrorecipes_dimensionless_alpha`, Ss, b, Sy)
}

dimensionless_gamma <- function(alpha, b, Sy, Kz) {
    .Call(`_hydrorecipes_dimensionless_gamma`, alpha, b, Sy, Kz)
}

dimensionless_well_bore_storage <- function(rc, rw, Ss, l, d) {
    .Call(`_hydrorecipes_dimensionless_well_bore_storage`, rc, rw, Ss, l, d)
}

dimensionless_w_prime <- function(rc, rw, Ss, f_prime) {
    .Call(`_hydrorecipes_dimensionless_w_prime`, rc, rw, Ss, f_prime)
}

dimensionless_S <- function(Kr, ds, Ks, rw) {
    .Call(`_hydrorecipes_dimensionless_S`, Kr, ds, Ks, rw)
}

row_sums_eigen <- function(x) {
    .Call(`_hydrorecipes_row_sums_eigen`, x)
}

row_multiply3 <- function(x, y) {
    .Call(`_hydrorecipes_row_multiply3`, x, y)
}

row_multiply2 <- function(x, y) {
    .Call(`_hydrorecipes_row_multiply2`, x, y)
}

list_multiply_subset <- function(x, y, ind) {
    .Call(`_hydrorecipes_list_multiply_subset`, x, y, ind)
}

any_decimal <- function(x) {
    .Call(`_hydrorecipes_any_decimal`, x)
}

decimal_to_scaled_integer <- function(x) {
    .Call(`_hydrorecipes_decimal_to_scaled_integer`, x)
}

gcd <- function(x) {
    .Call(`_hydrorecipes_gcd`, x)
}

#' @title
#' index_from_i_j
#'
#' @description
#' Get the column number for the cross-spectra matrix.
#'
#' @param i row number (integer)
#' @param i column number (integer)
#' @param n_col the number of columns i.e. the number of covariates. (integer)
#'
#' @return integer value containing the column number of the cross-spectra.
#'
#' @noRd
#'
index_from_i_j <- function(i, j, n_col) {
    .Call(`_hydrorecipes_index_from_i_j`, i, j, n_col)
}

get_column_number <- function(n) {
    .Call(`_hydrorecipes_get_column_number`, n)
}

#' @title
#' index_from_j_i
#'
#' @description
#' Get the column number for the cross-spectra matrix.
#'
#' @inheritParams index_from_i_j
#'
#' @return integer value containing the column number of the cross-spectra
#' conjugate term.
#'
#' @noRd
#'
index_from_j_i <- function(i, j, n_col) {
    .Call(`_hydrorecipes_index_from_j_i`, i, j, n_col)
}

#' @title
#' next_n_eigen
#'
#' @description
#' Get the size of the nearest fast length for an FFT. This just uses the base
#' function right now.
#'
#' @inheritParams nextn
#'
#' @return 'nice' integer value for the length of the padded FFT.
#'
#' @noRd
#'
next_n_eigen <- function(n) {
    .Call(`_hydrorecipes_next_n_eigen`, n)
}

#' @title
#' pad_vector
#'
#' @description
#' Pad a vector with zeros to a desired length.
#'
#' @param x initial vector to pad (numeric vector)
#' @param x_old initial length of vector (integer)
#' @param x_new desired length of padded vector (integer)
#'
#' @return 'nice' integer value for the length of the padded FFT.
#'
#' @noRd
#'
pad_vector <- function(x, n_old, n_new) {
    .Call(`_hydrorecipes_pad_vector`, x, n_old, n_new)
}

#' @title
#' detrend_matrix
#'
#' @description
#' Linearly detrend the columns of a matrix. This is translated from spec.pgram
#'
#' @param x the matrix that holds multiple series (numeric matrix)
#'
#' @return columns of a matrix that have been linearly detrended.
#'
#' @noRd
#'
detrend_matrix <- function(x) {
    .Call(`_hydrorecipes_detrend_matrix`, x)
}

#' @title
#' detrend_vector
#'
#' @description
#' Linearly detrend the columns of a matrix. This is translated from spec.pgram
#'
#' @param x the matrix that holds multiple series (numeric matrix)
#'
#' @return columns of a matrix that have been linearly detrended.
#'
#' @noRd
#'
detrend_vector <- function(x) {
    .Call(`_hydrorecipes_detrend_vector`, x)
}

#' @title
#' demean_matrix
#'
#' @description
#' Remove the mean from each column of a matrix.
#'
#' @inheritParams detrend_matrix
#'
#' @return columns of a matrix with the means removed.
#'
#' @noRd
#'
demean_matrix <- function(x) {
    .Call(`_hydrorecipes_demean_matrix`, x)
}

#' @title
#' demean_matrix
#'
#' @description
#' Remove the mean from each column of a matrix.
#'
#' @inheritParams detrend_matrix
#'
#' @return columns of a matrix with the means removed.
#'
#' @noRd
#'
demean_vector <- function(x) {
    .Call(`_hydrorecipes_demean_vector`, x)
}

#' @title
#' detrend_and_demean_matrix
#'
#' @description
#' Remove the trend and mean from each column of a matrix.
#'
#' @inheritParams detrend_matrix
#' @param detrend should the trend be removed from each column (boolean)
#' @param demean should the mean be removed from each column (boolean)
#'
#' @return columns of a matrix with the means and/or trends removed.
#'
#' @noRd
#'
detrend_and_demean_matrix <- function(x, detrend, demean) {
    .Call(`_hydrorecipes_detrend_and_demean_matrix`, x, detrend, demean)
}

#' @title
#' detrend_and_demean_list
#'
#' @description
#' Remove the trend and mean from each column of a matrix.
#'
#' @inheritParams detrend_matrix
#' @param detrend should the trend be removed from each column (boolean)
#' @param demean should the mean be removed from each column (boolean)
#'
#' @return columns of a matrix with the means and/or trends removed.
#'
#' @noRd
#'
detrend_and_demean_list <- function(x, detrend, demean) {
    .Call(`_hydrorecipes_detrend_and_demean_list`, x, detrend, demean)
}

#' @title
#' modified_daniell
#'
#' @description
#' Create a modified daniell kernel using FFT. Adapted from `spec.pgram`.
#'
#' @inheritParams spec.pgram
#'
#' @param n length of the kernel (integer)
#'
#' @return modified Daniell kernel.
#'
#' @noRd
#'
modified_daniell <- function(spans) {
    .Call(`_hydrorecipes_modified_daniell`, spans)
}

#' @title
#' kernel_apply
#'
#' @description
#' Create a modified daniell kernel using FFT. Adapted from `spec.pgram`. This
#' only calculates the upper triangle when truncated is FALSE.  When truncated
#' is TRUE the first row is skipped.
#'
#' @inheritParams spec.pgram
#'
#'
#' @return modified Daniell kernel.
#'
#' @noRd
#'
kernel_apply <- function(x, y) {
    .Call(`_hydrorecipes_kernel_apply`, x, y)
}

#' @title
#' kernel_apply
#'
#' @description
#' Create a modified daniell kernel using FFT. Adapted from `spec.pgram`. This
#' only calculates the upper triangle when truncated is FALSE.  When truncated
#' is TRUE the first row is skipped.
#'
#' @inheritParams spec.pgram
#'
#'
#' @return modified Daniell kernel.
#'
#' @noRd
#'
kernel_apply_list <- function(x, y) {
    .Call(`_hydrorecipes_kernel_apply_list`, x, y)
}

#' @title
#' spec_taper
#'
#' @description
#' Create a cosine-bell taper. Adapted from `spec.taper`.
#'
#' @inheritParams spec.taper
#'
#'
#' @return cosine-bell taper.
#'
#' @noRd
#'
spec_taper <- function(n_row, p) {
    .Call(`_hydrorecipes_spec_taper`, n_row, p)
}

#' @title
#' make_groups
#'
#' @description
#' Create a set of lengths with increasing sizes useful from grouping results.
#' The first and last groups have length equal to 1.
#'
#' @param n the number of values to subset into groups. (integer)
#' @param max_lag how fast groups get bigger. Larger numbers have a larger range
#' of group sizes. (integer)
#' @param n_groups the number of groups to create. (integer)
#' @param min_aggregate the minimum size for a group. (integer)
#'
#'
#' @return Matrix with filled in complex conjugate columns.
#'
#' @noRd
#'
make_groups <- function(n_groups, n) {
    .Call(`_hydrorecipes_make_groups`, n_groups, n)
}

#' @title
#' power_spaced
#'
#' @description
#' Create an n length vector of power spaced series between min and max.
#'
#' @param n the number of values. (integer)
#' @param min minimum value in series. (integer)
#' @param max maximum value in series. (integer)
#' @param power how fast values change. (integer)
#'
#'
#' @return vector of power spaced series between min and max.
#'
#' @noRd
#'
power_spaced <- function(n, min, max, power) {
    .Call(`_hydrorecipes_power_spaced`, n, min, max, power)
}

#' @title
#' group_frequency
#'
#' @description
#' Get the mean frequency for each group.
#'
#' @inheritParams make_groups
#'
#' @param frequency vector of frequencies. (integer)
#'
#'
#' @return vector frequencies for each group.
#'
#' @noRd
#'
group_frequency <- function(frequencies, n_groups) {
    .Call(`_hydrorecipes_group_frequency`, frequencies, n_groups)
}

#' @title
#' determine_frequency
#'
#' @description
#' Get frequencies based on series length
#'
#'
#' @param n length of series. (integer)
#'
#'
#' @return vector of frequencies between 0 and 0.5.
#'
#' @noRd
#'
determine_frequency <- function(n) {
    .Call(`_hydrorecipes_determine_frequency`, n)
}

check_ffts <- function(x, cutoff) {
    .Call(`_hydrorecipes_check_ffts`, x, cutoff)
}

#' @title
#' which_indices
#'
#' @description
#' Determine the intervals that each x value falls in
#'
#' @inheritParams splines::bs
#' @param knots location of knots for the b-splines. Unlike `splines::bs` this
#' includes the boundary knots. (numeric vector)
#'
#'
#' @return the interval ids that each x value falls in.
#'
#' @noRd
#'
which_indices <- function(x, knots) {
    .Call(`_hydrorecipes_which_indices`, x, knots)
}

gamma_inc <- function(u, a) {
    .Call(`_hydrorecipes_gamma_inc`, u, a)
}

#' @title
#' bessel_k_cplx
#'
#' @description
#' Modified Bessel function of first kind order 1
#'
#' @param x \code{numeric} value to evaluate
#' @param nu \code{numeric} value to evaluate
#' @param expon_scaled \code{boolean} value to evaluate
#' @param n_seq \code{nseq} value to evaluate
#'
#' @return bessel function result
#'
#'
#' @export
bessel_k_cplx <- function(x, nu, expon_scaled, n_seq) {
    .Call(`_hydrorecipes_bessel_k_cplx`, x, nu, expon_scaled, n_seq)
}

stehfest_v <- function(n) {
    .Call(`_hydrorecipes_stehfest_v`, n)
}

stehfest_p <- function(time, n_terms) {
    .Call(`_hydrorecipes_stehfest_p`, time, n_terms)
}

cohen_p <- function(time, n_terms) {
    .Call(`_hydrorecipes_cohen_p`, time, n_terms)
}

cohen_c <- function(d, n_terms) {
    .Call(`_hydrorecipes_cohen_c`, d, n_terms)
}

cooper_bredehoeft_papadopulos_laplace <- function(time, r, r_c, r_w, Tr, S, h_0, n_terms) {
    .Call(`_hydrorecipes_cooper_bredehoeft_papadopulos_laplace`, time, r, r_c, r_w, Tr, S, h_0, n_terms)
}

papadopulos_cooper_laplace <- function(time, Q, r, r_c, r_w, Tr, S, prec, n_terms) {
    .Call(`_hydrorecipes_papadopulos_cooper_laplace`, time, Q, r, r_c, r_w, Tr, S, prec, n_terms)
}

jacob_lohman_laplace <- function(time, s, r, Tr, S, prec, n_terms) {
    .Call(`_hydrorecipes_jacob_lohman_laplace`, time, s, r, Tr, S, prec, n_terms)
}

hantush_jacob_laplace <- function(time, c, r, Tr, S, Q, prec, n_terms) {
    .Call(`_hydrorecipes_hantush_jacob_laplace`, time, c, r, Tr, S, Q, prec, n_terms)
}

theis_laplace <- function(time, r, Tr, S, Q, prec, n_terms) {
    .Call(`_hydrorecipes_theis_laplace`, time, r, Tr, S, Q, prec, n_terms)
}

barker_herbert <- function(time, radius, radius_patch, t_1, t_2, s_1, s_2, Q, prec, n_terms) {
    .Call(`_hydrorecipes_barker_herbert`, time, radius, radius_patch, t_1, t_2, s_1, s_2, Q, prec, n_terms)
}

parallel_fractures_solute <- function(time, z, x, concentration_influent, time_influent, c_0, b, B, v, alpha_l, D_star, k_f, k_m, t_half, rho_b, theta, tortuosity, n_terms) {
    .Call(`_hydrorecipes_parallel_fractures_solute`, time, z, x, concentration_influent, time_influent, c_0, b, B, v, alpha_l, D_star, k_f, k_m, t_half, rho_b, theta, tortuosity, n_terms)
}

parallel_fractures_heat <- function(time, z, x, temperature_influent, time_influent, t_0, b, B, v, lambda_fracture, lambda_matrix, spec_heat_w, spec_heat_s, rho_w, rho_s, theta, n_terms) {
    .Call(`_hydrorecipes_parallel_fractures_heat`, time, z, x, temperature_influent, time_influent, t_0, b, B, v, lambda_fracture, lambda_matrix, spec_heat_w, spec_heat_s, rho_w, rho_s, theta, n_terms)
}

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

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

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

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

#' @title
#' shift_subset
#'
#' @description
#' lag data and subset the results
#'
#' @inheritParams step_lead_lag
#' @param x to lag (numeric vector)
#' @param lag amount to lag or lead if negative (integer)
#'
#' @return vector with lagged values
#'
#' @noRd
#'
shift_subset <- function(x, lag, n_subset, n_shift) {
    .Call(`_hydrorecipes_shift_subset`, x, lag, n_subset, n_shift)
}

#' @title
#' lag_list
#'
#' @description
#' Create lagged terms
#'
#' @param x numeric vector - variable to lag
#' @param lags integer vector - amount to lag
#' @param n_subset take every n_subset rows
#' @param n_shift shift values from starting on first row.  Should be less than
#'  n_subset
#'
#' @return List of lagged terms
#'
#' @export
#'
#' @noRd
#'
lag_list <- function(x, lags, n_subset, n_shift) {
    .Call(`_hydrorecipes_lag_list`, x, lags, n_subset, n_shift)
}

llt_solve <- function(X, Y) {
    .Call(`_hydrorecipes_llt_solve`, X, Y)
}

llt_solve_full <- function(X, Y, subs) {
    .Call(`_hydrorecipes_llt_solve_full`, X, Y, subs)
}

llt_weighted_solve <- function(X, Y, w) {
    .Call(`_hydrorecipes_llt_weighted_solve`, X, Y, w)
}

llt_fitted <- function(X, Y) {
    .Call(`_hydrorecipes_llt_fitted`, X, Y)
}

#' @title
#' Ogata-Banks solution for 1-D flow.
#'
#' @description
#' Ogata, A., Banks, R.B., 1961. A solution of the differential equation of
#' longitudinal dispersion in porous media. U. S. Geol. Surv. Prof. Pap. 411-A.
#' 1-D, infinite source, uniform flow, constant parameters, no decay, no retardation
#'
#' @param D diffusion coefficient
#' @param v double velocity
#' @param C0 double concentration
#' @param x double x position
#' @param t double time
#'
#' @return ogata banks solution
#'
#' @export
#'
#' @noRd
#'
ogata_banks_ind <- function(D, v, C0, x, t) {
    .Call(`_hydrorecipes_ogata_banks_ind`, D, v, C0, x, t)
}

ogata_banks_vec <- function(D, v, C0, x, t) {
    .Call(`_hydrorecipes_ogata_banks_vec`, D, v, C0, x, t)
}

ogata_banks_decay_ind <- function(c0, v, D, R, k, x, t) {
    .Call(`_hydrorecipes_ogata_banks_decay_ind`, c0, v, D, R, k, x, t)
}

ogata_banks_decay_vec <- function(c0, v, D, R, k, x, t) {
    .Call(`_hydrorecipes_ogata_banks_decay_vec`, c0, v, D, R, k, x, t)
}

scale_list_param <- function(x, center, scale) {
    .Call(`_hydrorecipes_scale_list_param`, x, center, scale)
}

scale_list_param_std <- function(x, center, scale) {
    .Call(`_hydrorecipes_scale_list_param_std`, x, center, scale)
}

scale_list_param_eigen <- function(x, center, scale) {
    .Call(`_hydrorecipes_scale_list_param_eigen`, x, center, scale)
}

cor_list_eigen <- function(x, center, scale) {
    .Call(`_hydrorecipes_cor_list_eigen`, x, center, scale)
}

pca_list_eigen <- function(x, center, scale, prep = TRUE) {
    .Call(`_hydrorecipes_pca_list_eigen`, x, center, scale, prep)
}

scale_list_matrix_eigen <- function(x, center = TRUE, scale = TRUE) {
    .Call(`_hydrorecipes_scale_list_matrix_eigen`, x, center, scale)
}

pca_list_rotation_eigen <- function(x, center, scale, n_comp) {
    .Call(`_hydrorecipes_pca_list_rotation_eigen`, x, center, scale, n_comp)
}

pca_eigen <- function(x, center = TRUE, scale = TRUE) {
    .Call(`_hydrorecipes_pca_eigen`, x, center, scale)
}

cor_eigen <- function(X) {
    .Call(`_hydrorecipes_cor_eigen`, X)
}

pca <- function(x, center = TRUE, scale = TRUE) {
    .Call(`_hydrorecipes_pca`, x, center, scale)
}

pca_with_params <- function(x, center, scale) {
    .Call(`_hydrorecipes_pca_with_params`, x, center, scale)
}

pca_list_with_params <- function(x, center, scale) {
    .Call(`_hydrorecipes_pca_list_with_params`, x, center, scale)
}

fi <- function(x, vec, rightmost_closed, all_inside, left_open) {
    .Call(`_hydrorecipes_fi`, x, vec, rightmost_closed, all_inside, left_open)
}

to_dummy_list_base <- function(x, n_fact) {
    .Call(`_hydrorecipes_to_dummy_list_base`, x, n_fact)
}

#' @title
#' to_dummy
#'
#' @description
#' Create binary terms based on a factor column.
#'
#' @param ind integer vector of values to dummy encode
#'
#' @return List of dummy encoded terms
#'
#' @export
#'
#' @noRd
#'
to_dummy <- function(ind, one_hot) {
    .Call(`_hydrorecipes_to_dummy`, ind, one_hot)
}

#' @title
#' to_dummy_list
#'
#' @description
#' Create binary terms based on intervals. This function uses `findInterval`,
#' followed by a conversion to dummy encoding.
#'
#' @inheritParams base::findInterval
#'
#' @return List of dummy encoded terms
#'
#' @export
#'
#' @noRd
#'
to_dummy_list <- function(x, vec, one_hot = FALSE, rightmost_closed = FALSE, all_inside = FALSE, left_open = FALSE) {
    .Call(`_hydrorecipes_to_dummy_list`, x, vec, one_hot, rightmost_closed, all_inside, left_open)
}

weeks_1979 <- function(lag, D, L, precision, inverse) {
    .Call(`_hydrorecipes_weeks_1979`, lag, D, L, precision, inverse)
}

#' @title
#' vadose_response
#'
#' @description
#' weeks_1979 1-D air diffusivity
#'
#' @param time numeric vector of elapsed times
#' @param air_diffusivity A numeric value of the unsaturated zone air diffusivity
#' @param thickness A numeric value of the unsaturated zone thickness
#' @param precision A numeric value of for the solution precision
#' @param inverse A logical value indicating if an inverse water level relationship is desired
#'
#' @return weeks 1979 model
#'
#'
#' @export
#'
#' @examples
#' vr <- vadose_response(time = 0:43200,
#'                        air_diffusivity = 0.20,
#'                        thickness = 40,
#'                        precision = 1e-10,
#'                        inverse = FALSE)
#'
#' @noRd
#'
vadose_response <- function(time, air_diffusivity, thickness, precision, inverse) {
    .Call(`_hydrorecipes_vadose_response`, time, air_diffusivity, thickness, precision, inverse)
}

vadose_response2 <- function(time, air_diffusivity, thickness, precision, inverse) {
    .Call(`_hydrorecipes_vadose_response2`, time, air_diffusivity, thickness, precision, inverse)
}
jkennel/hydrorecipes documentation built on Dec. 24, 2024, 5:38 p.m.