/** 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; }