/** The inverse maximum overlap discrete wavelet transform (IMODWT).
* @source RS\_wav\_modw.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #itCall( "RS_wavelets_transform_maximum_overlap_inverse", modwt, filters, level, node, xformtype))#
* @return An R ... containing ...
* @param modwt Pointer to an R object containing ... modwt
* @param filters Pointer to an R object containing ... filters
* @see wavuniv_filters_daubechies
* @see wavuniv_transform_maximum_overlap
* @see wavuniv_transform_maximum_overlap_packet
* @see wavuniv_transform_packet_detail
*/
EXTERN_R SEXP RS_wavelets_transform_maximum_overlap_inverse(
SEXP pr_modwt,
SEXP pr_filters )
{
SEXP pr_ret_result;
mat_set filters;
mat_set modwt;
mutil_errcode err;
univ_mat result;
void *VPNULL = NULL;
memlist list;
/* Avoid lint warning */
(void) whatssi;
/* initialize memory list */
MEMLIST_INIT( list );
/* Conversion of input data ... */
/* ... pr_modwt to modwt */
READ_MATSET_REGISTER( pr_modwt, MUTIL_DOUBLE, &modwt );
/* ... pr_filters to filters */
READ_MATSET_REGISTER( pr_filters, MUTIL_DOUBLE, &filters );
/* Call the function */
err = wavuniv_transform_maximum_overlap_inverse(
&modwt,
&filters,
VPNULL,
&result );
CONVERT_MATRIX_AND_RETURN( wavuniv_transform_maximum_overlap_inverse, &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 );
}
/** 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 );
}
/** Find the whitest set of DWPT crystals.
* @source RS\_wav\_boot.c
* @author Copyright (c), 1988, 2006 Insightful Corp. All rights reserved.
* @usage #.Call( "RS_wavelets_transform_packet_whitest", dwpt, significance, white.noise.test))#
* @return An R ... containing ...
* @param dwpt Pointer to an R object containing ... dwpt
* @param significance Pointer to an R object containing ... significance
* @param white.noise.test Pointer to an R object containing ... white.noise.test
* @see _wav_white_test
* @see wavuniv_bootstrap
* @see wavuniv_transform_packet
* @see wavuniv_transform_packet_inverse
*/
EXTERN_R SEXP RS_wavelets_transform_packet_whitest(
SEXP pr_dwpt,
SEXP pr_significance,
SEXP pr_white_noise_test )
{
SEXP pr_ret_result;
double significance;
mat_set dwpt;
mutil_errcode err;
univ_mat result;
void *VPNULL = NULL;
wav_white_test white_noise_test;
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_significance to significance */
DOUBLE_FROM_R( pr_significance, &significance );
/* ... pr_white_noise_test to white_noise_test */
err = wav_white_test_from_R( pr_white_noise_test, &white_noise_test );
CHECK_CONVERSION( wav_white_test, pr_white_noise_test, &white_noise_test );
/* Call the function */
err = wavuniv_transform_packet_whitest(
&dwpt,
significance,
white_noise_test,
VPNULL,
&result );
CONVERT_MATRIX_AND_RETURN( wavuniv_transform_packet_whitest, &result, &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;
}
