/** 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 );
}
/** The gain functions for Daubechies wavelet and scaling filters.
* @source RS\_wav\_filt.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #itCall( "RS_wavelets_filters_daubechies_gain", filter.type, filter.length, num.levels, num.fft, normalize))#
* @return An R ... containing ...
* @param filter.type Pointer to an R object containing ... filter.type
* @param filter.length Pointer to an R object containing ... filter.length
* @param num.levels Pointer to an R object containing ... num.levels
* @param num.fft Pointer to an R object containing ... num.fft
* @param normalize Pointer to an R object containing ... normalize
* @see _wav_filter_type
* @see wavuniv_filters_daubechies
* @see wavuniv_filters_zero_phase
*/
EXTERN_R SEXP RS_wavelets_filters_daubechies_gain(
SEXP pr_filter_type,
SEXP pr_filter_length,
SEXP pr_num_levels,
SEXP pr_num_fft,
SEXP pr_normalize )
{
SEXP pr_ret_gain_frequency;
SEXP pr_ret_gain_scaling;
SEXP pr_ret_gain_wavelet;
SEXP pr_ret_obj;
boolean normalize;
mutil_errcode err;
sint32 filter_length;
sint32 num_fft;
sint32 num_levels;
univ_mat gain_frequency;
univ_mat gain_scaling;
univ_mat gain_wavelet;
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_filter_type to filter_type */
WAV_FILTER_TYPE_FROM_R( pr_filter_type, &filter_type );
/* ... pr_filter_length to filter_length */
SINT32_FROM_R( pr_filter_length, &filter_length );
/* ... pr_num_levels to num_levels */
SINT32_FROM_R( pr_num_levels, &num_levels );
/* ... pr_num_fft to num_fft */
SINT32_FROM_R( pr_num_fft, &num_fft );
/* ... pr_normalize to normalize */
BOOLEAN_FROM_R( pr_normalize, &normalize );
/* Call the function */
err = wavuniv_filters_daubechies_gain(
filter_type,
filter_length,
num_levels,
num_fft,
normalize,
VPNULL,
&gain_frequency,
&gain_wavelet,
&gain_scaling );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Problem calling wavuniv_filters_daubechies_gain() function" );
err = memlist_member_register( &list, &gain_frequency, MEMTYPE_MATUNIV);
MEMLIST_FREE_ON_ERROR_REGISTER( err, &list );
err = memlist_member_register( &list, &gain_wavelet, MEMTYPE_MATUNIV);
MEMLIST_FREE_ON_ERROR_REGISTER( err, &list );
err = memlist_member_register( &list, &gain_scaling, MEMTYPE_MATUNIV);
MEMLIST_FREE_ON_ERROR_REGISTER( err, &list );
/* create the output R object */
err = matuniv_to_R( &gain_frequency, (mutil_R_class_type) MUTIL_R_MATRIX, &pr_ret_gain_frequency );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Unable to convert output data to R format" );
err = matuniv_to_R( &gain_wavelet, (mutil_R_class_type) MUTIL_R_MATRIX, &pr_ret_gain_wavelet );
MEMLIST_FREE_ON_ERROR_SPLUS( err, &list, "Unable to convert output data to R format" );
err = matuniv_to_R( &gain_scaling, (mutil_R_class_type) MUTIL_R_MATRIX, &pr_ret_gain_scaling );
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_gain_frequency );
SET_VECTOR_ELT( pr_ret_obj, 1, pr_ret_gain_wavelet );
SET_VECTOR_ELT( pr_ret_obj, 2, pr_ret_gain_scaling );
UNPROTECT(1);
/* free registered local memory */
MUTIL_FREE_WARN( memlist, &list );
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;
}
/** 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;
}
