コード例 #1
0
ファイル: RS_wav_xform.c プロジェクト: cran/ifultools
/** 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 );
}
コード例 #2
0
ファイル: RS_wav_boot.c プロジェクト: rforge/ifultools
/** 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 );
}
コード例 #3
0
ファイル: RS_wav_wtmm.c プロジェクト: rforge/ifultools
/** 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 );
}
コード例 #4
0
ファイル: RS_fra_neig.c プロジェクト: rforge/ifultools
/** 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;
}
コード例 #5
0
ファイル: RS_fra_lyap.c プロジェクト: rforge/ifultools
/** 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 );
}