/** The continuous wavelet transform.
* @source RS\_wav\_xform.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #itCall( "RS_wavelets_transform_continuous_wavelet", time.series, sampling.interval, filter.type, filter.arg, scale))#
* @return An R ... containing ...
* @param time.series Pointer to an R object containing ... time.series
* @param sampling.interval Pointer to an R object containing ... sampling.interval
* @param filter.type Pointer to an R object containing ... filter.type
* @param filter.arg Pointer to an R object containing ... filter.arg
* @param scale Pointer to an R object containing ... scale
* @see _wav_filter_type
* @see wavuniv_filters_continuous
*/
EXTERN_R SEXP RS_wavelets_transform_continuous_wavelet(
SEXP pr_time_series,
SEXP pr_sampling_interval,
SEXP pr_filter_type,
SEXP pr_filter_arg,
SEXP pr_scale )
{
SEXP pr_ret_result;
double filter_arg;
double sampling_interval;
mutil_data_type type;
mutil_errcode err;
univ_mat result;
univ_mat scale;
univ_mat time_series;
void *VPNULL = NULL;
wav_filter_type filter_type;
memlist list;
/* Avoid lint warning */
(void) whatssi;
/* initialize memory list */
MEMLIST_INIT( list );
/* Conversion of input data ... */
/* ... pr_time_series to time_series */
READ_MATRIX_REGISTER( pr_time_series, &time_series );
/* ... pr_sampling_interval to sampling_interval */
DOUBLE_FROM_R( pr_sampling_interval, &sampling_interval );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Unable to convert double type argument pr_sampling_interval to sampling_interval" );
/* ... pr_filter_type to filter_type */
WAV_FILTER_TYPE_FROM_R( pr_filter_type, &filter_type );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Unable to convert wav_filter_type type argument pr_filter_type to filter_type" );
/* ... pr_filter_arg to filter_arg */
DOUBLE_FROM_R( pr_filter_arg, &filter_arg );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Unable to convert double type argument pr_filter_arg to filter_arg" );
/* ... pr_scale to scale */
READ_MATRIX_REGISTER( pr_scale, &scale );
/* Call the function */
err = wavuniv_transform_continuous_wavelet(
&time_series,
sampling_interval,
filter_type,
filter_arg,
&scale,
VPNULL,
&result );
CONVERT_MATRIX_AND_RETURN( wavuniv_transform_continuous_wavelet, &result, &pr_ret_result );
}
/** Adaptive wavelet-based bootstrapping.
* @source RS\_wav\_boot.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #.Call( "RS_wavelets_bootstrap", dwpt, filters, white.indices, n.realization))#
* @return An R ... containing ...
* @param dwpt Pointer to an R object containing ... dwpt
* @param filters Pointer to an R object containing ... filters
* @param white.indices Pointer to an R object containing ... white.indices
* @param n.realization Pointer to an R object containing ... n.realization
* @see wavuniv_transform_packet_whitest
* @see wavuniv_transform_packet
* @see wavuniv_transform_packet_inverse
*/
EXTERN_R SEXP RS_wavelets_bootstrap(
SEXP pr_dwpt,
SEXP pr_filters,
SEXP pr_white_indices,
SEXP pr_n_realization )
{
SEXP pr_ret_result;
mat_set dwpt;
mat_set filters;
mat_set result;
mutil_data_type type;
mutil_errcode err;
sint32 n_realization;
univ_mat white_indices;
void *VPNULL = NULL;
memlist list;
/* Avoid lint warning */
(void) whatssi;
/* initialize memory list */
MEMLIST_INIT( list );
/* Conversion of input data ... */
/* ... pr_dwpt to dwpt */
READ_MATSET_REGISTER( pr_dwpt, MUTIL_DOUBLE, &dwpt );
/* ... pr_filters to filters */
READ_MATSET_REGISTER( pr_filters, MUTIL_DOUBLE, &filters );
/* ... pr_white_indices to white_indices */
READ_MATRIX_REGISTER( pr_white_indices, &white_indices );
/* ... pr_n_realization to n_realization */
SINT32_FROM_R( pr_n_realization, &n_realization );
/* Call the function */
err = wavuniv_bootstrap(
&dwpt,
&filters,
&white_indices,
n_realization,
VPNULL,
&result );
CONVERT_MATSET_AND_RETURN( wavuniv_bootstrap, &result, &pr_ret_result );
}
/** One-sided autocovariance.
* @source R\_mth\_var.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #.Call( "RS_math_acvs", time.series, biased, recenter))#
* @return An R ... containing ...
* @param time.series Pointer to an R object containing ... time.series
* @param biased Pointer to an R object containing ... biased
* @param recenter Pointer to an R object containing ... recenter
* @see fra_spectral_density_function_direct
*/
EXTERN_R SEXP RS_math_acvs(
SEXP pr_time_series,
SEXP pr_biased,
SEXP pr_recenter )
{
SEXP pr_ret_result;
boolean biased;
boolean recenter;
mutil_data_type type;
mutil_errcode err;
univ_mat result;
univ_mat time_series;
void *VPNULL = NULL;
memlist list;
/* Avoid lint warning */
(void) whatssi;
/* initialize memory list */
MEMLIST_INIT( list );
/* Conversion of input data ... */
/* ... pr_time_series to time_series */
READ_MATRIX_REGISTER( pr_time_series, &time_series );
/* ... pr_biased to biased */
BOOLEAN_FROM_R( pr_biased, &biased );
/* ... pr_recenter to recenter */
BOOLEAN_FROM_R( pr_recenter, &recenter );
/* Call the function */
err = mthuniv_acvs(
&time_series,
biased,
recenter,
VPNULL,
&result );
CONVERT_MATRIX_AND_RETURN( mthuniv_acvs, &result, &pr_ret_result );
}
/** The maximum overlap discrete wavelet packet transform (MODWPT).
* @source RS\_wav\_modw.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #itCall( "RS_wavelets_transform_maximum_overlap_packet", time.series, filters, n.level))#
* @return An R ... containing ...
* @param time.series Pointer to an R object containing ... time.series
* @param filters Pointer to an R object containing ... filters
* @param n.level Pointer to an R object containing ... n.level
* @see wavuniv_transform_maximum_overlap
* @see wavuniv_transform_maximum_overlap_inverse
* @see wavuniv_transform_packet_detail
*/
EXTERN_R SEXP RS_wavelets_transform_maximum_overlap_packet(
SEXP pr_time_series,
SEXP pr_filters,
SEXP pr_n_level )
{
SEXP pr_ret_result;
mat_set filters;
mat_set result;
mutil_data_type type;
mutil_errcode err;
sint32 n_level;
univ_mat time_series;
void *VPNULL = NULL;
memlist list;
/* Avoid lint warning */
(void) whatssi;
/* initialize memory list */
MEMLIST_INIT( list );
/* Conversion of input data ... */
/* ... pr_time_series to time_series */
READ_MATRIX_REGISTER( pr_time_series, &time_series );
/* ... pr_filters to filters */
READ_MATSET_REGISTER( pr_filters, MUTIL_DOUBLE, &filters );
/* ... pr_n_level to n_level */
SINT32_FROM_R( pr_n_level, &n_level );
/* Call the function */
err = wavuniv_transform_maximum_overlap_packet(
&time_series,
&filters,
n_level,
VPNULL,
&result );
CONVERT_MATSET_AND_RETURN( wavuniv_transform_maximum_overlap_packet, &result, &pr_ret_result );
}
/** One- or two-dimensional signal correlation, with arbitrary step and phase.
* @source RS\_sig\_conv.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #.Call( "RS_signal_correlate", in.sig, kernel, row.step, col.step, row.overlap, col.overlap, boundary
* @return An RS ... containing ...
* @param in.sig Pointer to an RS object containing ... in.sig
* @param kernel Pointer to an RS object containing ... kernel
* @param row.step Pointer to an RS object containing ... row.step
* @param col.step Pointer to an RS object containing ... col.step
* @param row.overlap Pointer to an RS object containing ... row.overlap
* @param col.overlap Pointer to an RS object containing ... col.overlap
* @param boundary Pointer to an RS object containing ... boundary
* @see siguniv_convolve
* @see _mutil_boundary_type
* @see Matrix Data Types
* @see Interrupt Handling
*/
EXTERN_R SEXP RS_signal_correlate(
SEXP pr_series,
SEXP pr_kernel,
SEXP pr_boundary)
{
SEXP pr_ret_result;
mutil_boundary_type boundary;
mutil_data_type type;
mutil_errcode err;
univ_mat series;
univ_mat kernel;
univ_mat result;
void *VPNULL = NULL;
memlist list;
sint32 n_series;
sint32 n_kernel;
sint32 n_out;
/* Avoid lint warning */
(void) whatssi;
/* initialize memory list */
MEMLIST_INIT( list );
/* Conversion of input data ... */
/* ... pr_series to series */
READ_MATRIX_REGISTER( pr_series, &series );
/* ... pr_kernel to kernel */
READ_MATRIX_REGISTER( pr_kernel, &kernel );
/* ... pr_boundary to boundary */
err = mutil_boundary_type_from_R( pr_boundary, &boundary );
CHECK_CONVERSION( mutil_boundary_type, pr_boundary, &boundary );
/* initialize parameters */
n_series = MATUNIV_NELEM( &series );
n_kernel = MATUNIV_NELEM( &kernel );
n_out = n_series + n_kernel - 1;
/* force the input vectors to be single-rows */
series.mat.dblmat.ncol = n_series;
series.mat.dblmat.nrow = 1;
kernel.mat.dblmat.ncol = n_kernel;
kernel.mat.dblmat.nrow = 1;
/* allocate space for the result */
err = matuniv_malloc_register( &result, 1, n_out, MUTIL_DOUBLE, &list );
if ( err ){
MUTIL_FREE_WARN( memlist, &list );
PROBLEM "Problem allocating and registering memory" ERROR;
}
/* Call the function */
err = siguniv_convolve( &series, &kernel, 1, 1, 1, 1, boundary, VPNULL, &result );
if ( err ){
MUTIL_FREE_WARN( memlist, &list );
PROBLEM "Problem calling siguniv_convolve() function" ERROR;
}
/* create the output RS object */
err = matuniv_to_R( &result, (mutil_R_class_type) MUTIL_R_MATRIX, &pr_ret_result );
MUTIL_FREE_WARN( memlist, &list );
if ( err ) {
PROBLEM "Unable to convert output data to RS format" ERROR;
}
return pr_ret_result;
}
/** Extracts a discrete wavelet packet transform subset.
* @source RS\_wav\_dwtc.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #itCall( "RS_wavelets_transform_packet_basis", dwpt, transform.indices, n.level))#
* @return An R ... containing ...
* @param dwpt Pointer to an R object containing ... dwpt
* @param transform.indices Pointer to an R object containing ... transform.indices
* @see wavuniv_transform_packet_convert_indices
* @see wavuniv_transform_packet
* @see wavuniv_transform_maximum_overlap_packet
* @see _wav_dwpt_extra
* @see wavuniv_transform_packet_inverse
*/
EXTERN_R SEXP RS_wavelets_transform_packet_basis(
SEXP pr_dwpt,
SEXP pr_transform_indices )
{
SEXP pr_ret_obj;
SEXP tmpobj;
mat_set dwpt;
mat_set result;
mutil_data_type type;
mutil_errcode err;
univ_mat transform_indices;
void *VPNULL = NULL;
wav_dwpt_extra extra;
univ_mat extra_atoms;
univ_mat extra_levelmap;
sint32 i;
memlist list;
/* Avoid lint warning */
(void) whatssi;
/* initialize memory list */
MEMLIST_INIT( list );
/* Conversion of input data ... */
/* ... pr_dwpt to dwpt */
READ_MATSET_REGISTER( pr_dwpt, MUTIL_DOUBLE, &dwpt );
/* ... pr_transform_indices to transform_indices */
READ_MATRIX_REGISTER( pr_transform_indices, &transform_indices );
/* Call the function */
err = wavuniv_transform_packet_basis(
&dwpt,
&transform_indices,
VPNULL,
&result,
&extra );
MUTIL_FREE_WARN( memlist, &list );
if ( err ){
PROBLEM "Problem calling wavuniv_transform_packet_basis() function" ERROR;
}
/* in the case where there are extra dwpt atoms that need to
be stored, there will be memory allocated for the
'extra' structure above. the easiest way to get this
back to R is to pack everything into a list */
if ( extra.nelem > 0 ){
/* wrap universal matrix headers around extra matrices */
err = matuniv_wrap_matrix( &extra_atoms, &(extra.atoms), MUTIL_DOUBLE);
if ( err ){
MUTIL_ERROR( "Unable to wrap universal matrix around extra atoms matrix" );
PROBLEM "Problem creating R list" ERROR;
}
err = matuniv_wrap_matrix( &extra_levelmap, &(extra.levelmap), MUTIL_SINT32 );
if ( err ){
MUTIL_ERROR( "Unable to wrap universal matrix around extra levelmap matrix" );
PROBLEM "Problem creating R list" ERROR;
}
/* create an R list object */
PROTECT( pr_ret_obj = allocVector( VECSXP, result.nelem + 2 ) );
/* create R matrix objects and pack the extra crystals into the list */
for( i = 0; i < result.nelem; i++ ) {
err = matuniv_to_R( &(result.mats[i]), (mutil_R_class_type) MUTIL_R_MATRIX, &tmpobj );
if( err ){
PROBLEM "Problem adding DWPT crystal to R list" ERROR;
}
/*LINTED: cast OK, checked range */
SET_VECTOR_ELT( pr_ret_obj, (int) i, tmpobj);
}
/* pack the extra atoms crystal into the R list */
err = matuniv_to_R( &extra_atoms, (mutil_R_class_type) MUTIL_R_MATRIX, &tmpobj );
if( err ){
PROBLEM "Problem adding extra DWPT crystal to R list" ERROR;
}
/*LINTED: cast OK, checked range */
SET_VECTOR_ELT( pr_ret_obj, (int) i++, tmpobj );
/* finally, pack the levelmap vector into the list */
err = matuniv_to_R( &extra_levelmap, (mutil_R_class_type) MUTIL_R_MATRIX, &tmpobj );
if( err ){
PROBLEM "Problem adding extra DWPT levelmap crystal to R list" ERROR;
}
/*LINTED: cast OK, checked range */
SET_VECTOR_ELT( pr_ret_obj, (int) i, tmpobj );
/* free the memory */
MUTIL_FREE_WARN( matuniv, &extra_levelmap );
MUTIL_FREE_WARN( matuniv, &extra_atoms );
MUTIL_FREEALL_MATSET_WARN( &result );
UNPROTECT(1);
}
else{
err = matset_to_R_list( &result, &pr_ret_obj );
MUTIL_FREEALL_MATSET_WARN( &result );
if ( err ) {
PROBLEM "Unable to convert output data to Splus format" ERROR;
}
}
return pr_ret_obj;
}
/** Conversion and validation of wavelet packet indices.
* @source RS\_wav\_dwtc.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #itCall( "RS_wavelets_transform_packet_convert_indices", transform.indices, filters, n.level))#
* @return An R ... containing ...
* @param transform.indices Pointer to an R object containing ... transform.indices
* @see wavuniv_transform_packet
* @see wavuniv_transform_maximum_overlap_packet
*/
EXTERN_R SEXP RS_wavelets_transform_packet_convert_indices(
SEXP pr_transform_indices )
{
SEXP pr_ret_flat;
SEXP pr_ret_level;
SEXP pr_ret_obj;
SEXP pr_ret_osc;
mutil_data_type type;
mutil_errcode err;
univ_mat flat;
univ_mat level;
univ_mat osc;
univ_mat transform_indices;
void *VPNULL = NULL;
memlist list;
/* Avoid lint warning */
(void) whatssi;
/* initialize memory list */
MEMLIST_INIT( list );
/* Conversion of input data ... */
/* ... pr_transform_indices to transform_indices */
READ_MATRIX_REGISTER( pr_transform_indices, &transform_indices );
/* Call the function */
err = wavuniv_transform_packet_convert_indices(
&transform_indices,
VPNULL,
&flat,
&level,
&osc );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Problem calling wavuniv_transform_packet_convert_indices() function" );
err = memlist_member_register( &list, &flat, MEMTYPE_MATUNIV);
MEMLIST_FREE_ON_ERROR_REGISTER( err, &list );
err = memlist_member_register( &list, &level, MEMTYPE_MATUNIV);
MEMLIST_FREE_ON_ERROR_REGISTER( err, &list );
err = memlist_member_register( &list, &osc, MEMTYPE_MATUNIV);
MEMLIST_FREE_ON_ERROR_REGISTER( err, &list );
/* create the output R object */
err = matuniv_to_R( &flat, (mutil_R_class_type) MUTIL_R_MATRIX, &pr_ret_flat );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Unable to convert output data to R format" );
err = matuniv_to_R( &level, (mutil_R_class_type) MUTIL_R_MATRIX, &pr_ret_level );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Unable to convert output data to R format" );
err = matuniv_to_R( &osc, (mutil_R_class_type) MUTIL_R_MATRIX, &pr_ret_osc );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Unable to convert output data to R format" );
PROTECT( pr_ret_obj = allocVector( VECSXP, 3 ) );
SET_VECTOR_ELT( pr_ret_obj, 0, pr_ret_flat );
SET_VECTOR_ELT( pr_ret_obj, 1, pr_ret_level );
SET_VECTOR_ELT( pr_ret_obj, 2, pr_ret_osc );
UNPROTECT(1);
/* free registered local memory */
MUTIL_FREE_WARN( memlist, &list );
return pr_ret_obj;
}
/** The modulus maxima of a continuous wavelet transform.
* @source RRS\_wav\_wtmm.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #.Call( "RS_wavelets_transform_continuous_wavelet_modulus_maxima", cwt, tolerance))#
* @return An R ... containing ...
* @param cwt Pointer to an R object containing ... cwt
* @param tolerance Pointer to an R object containing ... tolerance
* @see wavuniv_transform_continuous_wavelet
* @see wavuniv_transform_continuous_wavelet_modulus_maxima_tree
*/
EXTERN_R SEXP RS_wavelets_transform_continuous_wavelet_modulus_maxima(
SEXP pr_cwt,
SEXP pr_tolerance,
SEXP pr_peak_type )
{
SEXP pr_ret_iscale;
SEXP pr_ret_itime;
SEXP pr_ret_obj;
mutil_data_type type;
mutil_errcode err;
univ_mat iscale;
univ_mat itime;
univ_mat cwt;
univ_mat tolerance;
void *VPNULL = NULL;
memlist list;
wav_transform_peak peak_type;
/* Avoid lint warning */
(void) whatssi;
/* initialize memory list */
MEMLIST_INIT( list );
/* Conversion of input data ... */
/* ... pr_cwt to cwt */
READ_MATRIX_REGISTER( pr_cwt, &cwt );
/* ... pr_tolerance to tolerance */
READ_MATRIX_REGISTER( pr_tolerance, &tolerance );
/* ... pr_peak_type to peak_type */
WAV_TRANSFORM_PEAK_FROM_R( pr_peak_type, &peak_type );
/* Call the function */
err = wavuniv_transform_continuous_wavelet_modulus_maxima(
&cwt,
&tolerance,
peak_type,
VPNULL,
&(itime.mat.s32mat),
&(iscale.mat.s32mat) );
MUTIL_FREE_WARN( matuniv, &cwt );
MUTIL_FREE_WARN( matuniv, &tolerance );
if ( err ){
PROBLEM "Problem calling wavuniv_transform_continuous_wavelet_modulus_maxima() function" ERROR;
}
/* free registered local memory */
MUTIL_FREE_WARN( memlist, &list );
/* wrap the sint32 output matrices into a universal matrix */
err = matuniv_wrap_matrix( &itime, &(itime.mat.s32mat), MUTIL_SINT32 );
if (err){
MUTIL_FREE_WARN( matuniv, &itime );
PROBLEM "Problem wrapping WTMM time index matrix into a universal matrix" ERROR;
}
err = matuniv_wrap_matrix( &iscale, &(iscale.mat.s32mat), MUTIL_SINT32 );
if (err){
MUTIL_FREE_WARN( matuniv, &iscale );
PROBLEM "Problem wrapping WTMM scale index matrix into a universal matrix" ERROR;
}
/* create the output R object */
err = matuniv_to_R( &itime, (mutil_R_class_type) MUTIL_R_MATRIX, &pr_ret_itime );
MUTIL_FREE_WARN( matuniv, &itime );
if ( err ) {
PROBLEM "Unable to convert output data to Splus format" ERROR;
}
err = matuniv_to_R( &iscale, (mutil_R_class_type) MUTIL_R_MATRIX, &pr_ret_iscale );
MUTIL_FREE_WARN( matuniv, &iscale );
if ( err ) {
PROBLEM "Unable to convert output data to Splus format" ERROR;
}
PROTECT( pr_ret_obj = allocVector( VECSXP, 2 ) );
SET_VECTOR_ELT( pr_ret_obj, 0, pr_ret_itime );
SET_VECTOR_ELT( pr_ret_obj, 1, pr_ret_iscale );
UNPROTECT(1);
return pr_ret_obj;
}
/** The modulus maxima tree of a continuous wavelet transform.
* @source RRS\_wav\_wtmm.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #.Call( "RS_wavelets_transform_continuous_wavelet_modulus_maxima_tree", wtmm.time.index, wtmm.scale.index, cwt, cwt.time, cwt.scale, bridge.gaps, n.octave.min, wtmm.strength.min))#
* @return An R ... containing ...
* @param wtmm.time.index Pointer to an R object containing ... wtmm.time.index
* @param wtmm.scale.index Pointer to an R object containing ... wtmm.scale.index
* @param cwt Pointer to an R object containing ... cwt
* @param cwt.time Pointer to an R object containing ... cwt.time
* @param cwt.scale Pointer to an R object containing ... cwt.scale
* @param bridge.gaps Pointer to an R object containing ... bridge.gaps
* @param n.octave.min Pointer to an R object containing ... n.octave.min
* @param wtmm.strength.min Pointer to an R object containing ... wtmm.strength.min
* @see wavuniv_transform_continuous_wavelet
* @see wavuniv_transform_continuous_wavelet_modulus_maxima
*/
EXTERN_R SEXP RS_wavelets_transform_continuous_wavelet_modulus_maxima_tree(
SEXP pr_wtmm_time_index,
SEXP pr_wtmm_scale_index,
SEXP pr_cwt,
SEXP pr_cwt_time,
SEXP pr_cwt_scale,
SEXP pr_bridge_gaps,
SEXP pr_n_octave_min,
SEXP pr_wtmm_strength_min )
{
boolean bridge_gaps;
double n_octave_min;
double wtmm_strength_min;
mat_set result;
memlist list;
mutil_data_type type;
mutil_errcode err;
SEXP pr_ret_result;
univ_mat cwt;
univ_mat cwt_scale;
univ_mat cwt_time;
univ_mat wtmm_scale_index;
univ_mat wtmm_time_index;
void *VPNULL = NULL;
/* Avoid lint warning */
(void) whatssi;
/* initialize memory list */
MEMLIST_INIT( list );
/* Conversion of input data ... */
READ_MATRIX_REGISTER( pr_wtmm_time_index, &wtmm_time_index );
READ_MATRIX_REGISTER( pr_wtmm_scale_index, &wtmm_scale_index );
READ_MATRIX_REGISTER( pr_cwt, &cwt );
READ_MATRIX_REGISTER( pr_cwt_scale, &cwt_scale );
READ_MATRIX_REGISTER( pr_cwt_time, &cwt_time );
/* ... pr_bridge_gaps to bridge_gaps */
BOOLEAN_FROM_R( pr_bridge_gaps, &bridge_gaps );
/* ... pr_n_octave_min to n_octave_min */
DOUBLE_FROM_R( pr_n_octave_min, &n_octave_min );
/* ... pr_wtmm_strength_min to wtmm_strength_min */
DOUBLE_FROM_R( pr_wtmm_strength_min, &wtmm_strength_min );
/* Call the function */
err = wavuniv_transform_continuous_wavelet_modulus_maxima_tree(
&(wtmm_time_index.mat.s32mat),
&(wtmm_scale_index.mat.s32mat),
&(cwt.mat.cpxmat),
&(cwt_time.mat.dblmat),
&(cwt_scale.mat.dblmat),
bridge_gaps,
n_octave_min,
wtmm_strength_min,
VPNULL,
&result );
CONVERT_MATSET_AND_RETURN( wavuniv_transform_continuous_wavelet_modulus_maxima_tree, &result, &pr_ret_result );
}
/** Find the nearest neighbors of a multidimensional embedding of data in the phase space.
* @source RS\_fra\_neig.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #.Call( "RS_fractal_neighbor_find", embedding, n.neighbor, distance.max, distance.metric, pdmatrix, sort.distances, orbital.lag))#
* @return An R ... containing ...
* @param embedding Pointer to an R object containing ... embedding
* @param n.neighbor Pointer to an R object containing ... n.neighbor
* @param distance.max Pointer to an R object containing ... distance.max
* @param distance.metric Pointer to an R object containing ... distance.metric
* @param pdmatrix Pointer to an R object containing ... pdmatrix
* @param sort.distances Pointer to an R object containing ... sort.distances
* @param orbital.lag Pointer to an R object containing ... orbital.lag
* @see _fra_distance_metric
* @see frauniv_embed_neighbors
*/
EXTERN_R SEXP RS_fractal_neighbor_find(
SEXP pr_embedding,
SEXP pr_n_neighbor,
SEXP pr_distance_max,
SEXP pr_distance_metric,
SEXP pr_sort_distances,
SEXP pr_orbital_lag )
{
SEXP pr_ret_neighbor_distances;
SEXP pr_ret_neighbor_indices;
SEXP pr_ret_obj;
SEXP pr_ret_original_indices;
boolean sort_distances;
double distance_max;
fra_distance_metric distance_metric;
mutil_data_type type;
mutil_errcode err;
sint32 n_neighbor;
sint32 orbital_lag;
univ_mat embedding;
univ_mat neighbor_distances;
univ_mat neighbor_indices;
univ_mat original_indices;
void *VPNULL = NULL;
memlist list;
/* Avoid lint warning */
(void) whatssi;
/* initialize memory list */
MEMLIST_INIT( list );
/* Conversion of input data ... */
/* ... pr_time_series to time_series */
READ_MATRIX_REGISTER( pr_embedding, &embedding );
/* ... pr_n_neighbor to n_neighbor */
SINT32_FROM_R( pr_n_neighbor, &n_neighbor );
/* ... pr_distance_max to distance_max */
DOUBLE_FROM_R( pr_distance_max, &distance_max );
/* ... pr_distance_metric to distance_metric */
DISTANCE_METRIC_FROM_R( pr_distance_metric, &distance_metric );
/* ... pr_sort_distances to sort_distances */
BOOLEAN_FROM_R( pr_sort_distances, &sort_distances );
/* ... pr_orbital_lag to orbital_lag */
SINT32_FROM_R( pr_orbital_lag, &orbital_lag );
/* Call the function */
err = frauniv_neighbor_find(
&embedding,
n_neighbor,
distance_max,
distance_metric,
(univ_mat*) NULL,
sort_distances,
orbital_lag,
VPNULL,
&original_indices,
&neighbor_indices,
&neighbor_distances );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Problem calling frauniv_neighbor_find() function" );
err = memlist_member_register( &list, &original_indices, MEMTYPE_MATUNIV);
MEMLIST_FREE_ON_ERROR_REGISTER( err, &list );
err = memlist_member_register( &list, &neighbor_indices, MEMTYPE_MATUNIV);
MEMLIST_FREE_ON_ERROR_REGISTER( err, &list );
err = memlist_member_register( &list, &neighbor_distances, MEMTYPE_MATUNIV);
MEMLIST_FREE_ON_ERROR_REGISTER( err, &list );
/* create the output R object */
err = matuniv_to_R( &original_indices, (mutil_R_class_type) MUTIL_R_MATRIX, &pr_ret_original_indices );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Unable to convert output data to R format" );
err = matuniv_to_R( &neighbor_indices, (mutil_R_class_type) MUTIL_R_MATRIX, &pr_ret_neighbor_indices );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Unable to convert output data to R format" );
err = matuniv_to_R( &neighbor_distances, (mutil_R_class_type) MUTIL_R_MATRIX, &pr_ret_neighbor_distances );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Unable to convert output data to R format" );
PROTECT( pr_ret_obj = allocVector( VECSXP, 3 ) );
SET_VECTOR_ELT( pr_ret_obj, 0, pr_ret_original_indices );
SET_VECTOR_ELT( pr_ret_obj, 1, pr_ret_neighbor_indices );
SET_VECTOR_ELT( pr_ret_obj, 2, pr_ret_neighbor_distances );
UNPROTECT(1);
/* free registered local memory */
MUTIL_FREE_WARN( memlist, &list );
return pr_ret_obj;
}
/** Local Lyapunov spectrum estimation.
* @source RS\_fra\_lyap.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #.Call( "RS_fractal_local_lyapunov_spectrum", time.series, embedding.dimension, time.lag, orbital.lag, sampling.interval, local.dimension, polynomial.order, global.reference, n.reference.local, metric, scale))#
* @return An R ... containing ...
* @param time.series Pointer to an R object containing ... time.series
* @param embedding.dimension Pointer to an R object containing ... embedding.dimension
* @param time.lag Pointer to an R object containing ... time.lag
* @param orbital.lag Pointer to an R object containing ... orbital.lag
* @param sampling.interval Pointer to an R object containing ... sampling.interval
* @param local.dimension Pointer to an R object containing ... local.dimension
* @param polynomial.order Pointer to an R object containing ... polynomial.order
* @param global.reference Pointer to an R object containing ... global.reference
* @param n.reference.local Pointer to an R object containing ... n.reference.local
* @param metric Pointer to an R object containing ... metric
* @param scale Pointer to an R object containing ... scale
* @see frauniv_embed
* @see frauniv_dimension_correlation_summation
* @see frauniv_dimension_information
*/
EXTERN_R SEXP RS_fractal_local_lyapunov_spectrum(
SEXP pr_time_series,
SEXP pr_embedding_dimension,
SEXP pr_time_lag,
SEXP pr_orbital_lag,
SEXP pr_sampling_interval,
SEXP pr_local_dimension,
SEXP pr_polynomial_order,
SEXP pr_global_reference,
SEXP pr_n_reference_local,
SEXP pr_metric,
SEXP pr_scale )
{
SEXP pr_ret_result;
double sampling_interval;
fra_distance_metric metric;
mat_set result;
mutil_data_type type;
mutil_errcode err;
sint32 embedding_dimension;
sint32 local_dimension;
sint32 n_reference_local;
sint32 orbital_lag;
sint32 polynomial_order;
sint32 time_lag;
univ_mat global_reference;
univ_mat scale;
univ_mat time_series;
void *VPNULL = NULL;
memlist list;
/* Avoid lint warning */
(void) whatssi;
/* initialize memory list */
MEMLIST_INIT( list );
/* Conversion of input data ... */
/* ... pr_time_series to time_series */
READ_MATRIX_REGISTER( pr_time_series, &time_series );
/* ... pr_embedding_dimension to embedding_dimension */
SINT32_FROM_R( pr_embedding_dimension, &embedding_dimension );
/* ... pr_time_lag to time_lag */
SINT32_FROM_R( pr_time_lag, &time_lag );
/* ... pr_orbital_lag to orbital_lag */
SINT32_FROM_R( pr_orbital_lag, &orbital_lag );
/* ... pr_sampling_interval to sampling_interval */
DOUBLE_FROM_R( pr_sampling_interval, &sampling_interval );
/* ... pr_local_dimension to local_dimension */
SINT32_FROM_R( pr_local_dimension, &local_dimension );
/* ... pr_polynomial_order to polynomial_order */
SINT32_FROM_R( pr_polynomial_order, &polynomial_order );
/* ... pr_global_reference to global_reference */
READ_MATRIX_REGISTER( pr_global_reference, &global_reference );
/* ... pr_n_reference_local to n_reference_local */
SINT32_FROM_R( pr_n_reference_local, &n_reference_local );
/* ... pr_metric to metric */
DISTANCE_METRIC_FROM_R( pr_metric, &metric );
/* ... pr_scale to scale */
READ_MATRIX_REGISTER( pr_scale, &scale );
/* Call the function */
err = frauniv_local_lyapunov_spectrum(
&time_series,
embedding_dimension,
time_lag,
orbital_lag,
sampling_interval,
local_dimension,
polynomial_order,
&global_reference,
n_reference_local,
metric,
&scale,
VPNULL,
&result );
CONVERT_MATSET_AND_RETURN( frauniv_local_lyapunov_spectrum, &result, &pr_ret_result );
}
