void dp_moment(QSP_ARG_DECL Data_Obj *d_dp) { /* std_type *d_rowlist[MAX_DIM]; */ int n; if( ! IS_CONTIGUOUS(d_dp) ){ sprintf(DEFAULT_ERROR_STRING,"dp_moment: Object %s must be contiguous for eigsrt",OBJ_NAME(d_dp)); NWARN(DEFAULT_ERROR_STRING); return; } n = OBJ_COLS(d_dp); if( OBJ_MACH_PREC(d_dp) == PREC_SP ){ float adev, var, skew, curt; float ave, sdev; /* BUG - the results don't get passed out anywhere!? */ float_moment(((float *)(OBJ_DATA_PTR(d_dp))),n,&ave,&adev,&sdev,&var,&skew,&curt); } else if( OBJ_MACH_PREC(d_dp) == PREC_DP ){ double adev, var, skew, curt; double ave, sdev; double_moment(((double *)(OBJ_DATA_PTR(d_dp))),n,&ave,&adev,&sdev,&var,&skew,&curt); } }
static int is_good_for_inner(Data_Obj *dp,const char *func_name) { int retval=1; //#ifdef CAUTIOUS // if( dp == NO_OBJ ){ // NWARN("CAUTIOUS: is_good_for_inner passed null object pointer!?"); // return(0); // } //#endif /* CAUTIOUS */ assert( dp != NO_OBJ ); if( OBJ_COMPS(dp) > 1 ){ sprintf(DEFAULT_ERROR_STRING,"%s: object %s has %d components (should be 1)", func_name,OBJ_NAME(dp),OBJ_COMPS(dp)); NWARN(DEFAULT_ERROR_STRING); retval=0; } if( OBJ_MACH_PREC(dp) != PREC_SP && OBJ_MACH_PREC(dp) != PREC_DP ){ sprintf(DEFAULT_ERROR_STRING,"%s: object %s has machine prec %s (should be float or double)", func_name,OBJ_NAME(dp),OBJ_MACH_PREC_NAME(dp) ); NWARN(DEFAULT_ERROR_STRING); retval=0; } return(retval); }
void dp_jacobi(QSP_ARG_DECL Data_Obj *v_dp, Data_Obj *d_dp, Data_Obj *a_dp, int *nrotp) { void *a_rowlist[MAX_DIM], *v_rowlist[MAX_DIM]; int n; if( OBJ_COLS(a_dp) != OBJ_ROWS(a_dp) ){ sprintf(DEFAULT_ERROR_STRING,"dp_jacobi: matrix %s must be square for jacobi",OBJ_NAME(a_dp)); NWARN(DEFAULT_ERROR_STRING); return; } if( OBJ_COLS(v_dp) != OBJ_ROWS(v_dp) ){ sprintf(DEFAULT_ERROR_STRING,"dp_jacobi: matrix %s must be square for jacobi",OBJ_NAME(v_dp)); NWARN(DEFAULT_ERROR_STRING); return; } if( OBJ_COLS(v_dp) != OBJ_COLS(a_dp) ){ sprintf(DEFAULT_ERROR_STRING,"dp_jacobi: size of eigenvector matrix %s must match input matrix %s for jacobi", OBJ_NAME(v_dp),OBJ_NAME(a_dp)); NWARN(DEFAULT_ERROR_STRING); return; } if( OBJ_COLS(d_dp) != OBJ_COLS(a_dp) ){ sprintf(DEFAULT_ERROR_STRING,"dp_jacobi: size of eigenvalue vector %s must match input matrix %s for jacobi", OBJ_NAME(d_dp),OBJ_NAME(a_dp)); NWARN(DEFAULT_ERROR_STRING); return; } if( ! IS_CONTIGUOUS(a_dp) ){ sprintf(DEFAULT_ERROR_STRING,"dp_jacobi: Object %s must be contiguous for jacobi",OBJ_NAME(a_dp)); NWARN(DEFAULT_ERROR_STRING); return; } if( ! IS_CONTIGUOUS(d_dp) ){ sprintf(DEFAULT_ERROR_STRING,"dp_jacobi: Object %s must be contiguous for jacobi",OBJ_NAME(d_dp)); NWARN(DEFAULT_ERROR_STRING); return; } if( ! IS_CONTIGUOUS(v_dp) ){ sprintf(DEFAULT_ERROR_STRING,"dp_jacobi: Object %s must be contiguous for jacobi",OBJ_NAME(v_dp)); NWARN(DEFAULT_ERROR_STRING); return; } n = OBJ_COLS(a_dp); /* BUG make sure types match */ if( OBJ_MACH_PREC(a_dp) == PREC_SP ){ float_init_rowlist((float **)(void *)a_rowlist,a_dp); float_init_rowlist((float **)(void *)v_rowlist,v_dp); float_jacobi(((float **)(void *)a_rowlist)-1,n,((float *)(OBJ_DATA_PTR(d_dp)))-1,((float **)(void *)v_rowlist)-1,nrotp); } else if( OBJ_MACH_PREC(a_dp) == PREC_DP ){ double_init_rowlist((double **)(void *)a_rowlist,a_dp); double_init_rowlist((double **)(void *)v_rowlist,v_dp); double_jacobi(((double **)(void *)a_rowlist)-1,n,((double *)(OBJ_DATA_PTR(d_dp)))-1,((double **)(void *)v_rowlist)-1,nrotp); } else { NWARN("bad precision in dp_jacobi"); } }
static PF_COMMAND_FUNC( centroid ) { Data_Obj *dst1_dp; Data_Obj *dst2_dp; Data_Obj *src_dp; Vec_Obj_Args oargs; dst1_dp = PICK_OBJ("x scratch image"); dst2_dp = PICK_OBJ("y scratch image"); src_dp = PICK_OBJ("source image"); if( OBJ_MACH_PREC(src_dp) != PREC_SP && OBJ_MACH_PREC(src_dp) != PREC_DP ){ sprintf(ERROR_STRING,"Object %s (%s) must have %s or %s precision for centroid helper", OBJ_NAME(src_dp),PREC_NAME(OBJ_PREC_PTR(src_dp)),PREC_NAME(PREC_FOR_CODE(PREC_SP)), PREC_NAME(PREC_FOR_CODE(PREC_DP))); WARN(ERROR_STRING); return; } // BUG - do more checking here sizes must match, precisions must match. setvarg3(&oargs,dst1_dp,dst2_dp,src_dp); /* abusing this a little */ if( OBJ_PREC(src_dp) == PREC_SP ) sp_cu2_centroid(&oargs); else if( OBJ_PREC(src_dp) == PREC_DP ) dp_cu2_centroid(&oargs); #ifdef CAUTIOUS else ERROR1("CAUTIOUS: centroid: unexpected source precision!?"); #endif /* CAUTIOUS */ }
void dp_zroots(Data_Obj *r_dp, Data_Obj *a_dp, int polish ) { int m,n; n=OBJ_COLS(a_dp); /* polynomial degree + 1 */ m=OBJ_COLS(r_dp); if( m != n-1 ){ sprintf(DEFAULT_ERROR_STRING, "dp_zroots: len of root vector %s (%d) inconsistent with coefficients vector %s (%d)", OBJ_NAME(r_dp),OBJ_COLS(r_dp),OBJ_NAME(a_dp),OBJ_COLS(a_dp)); NWARN(DEFAULT_ERROR_STRING); return; } /* BUG make sure are row vectors */ if(OBJ_ROWS(a_dp) != 1 ){ sprintf(DEFAULT_ERROR_STRING,"dp_zroots: coefficient vector %s should be a row vector, (rows = %d)!?", OBJ_NAME(a_dp),OBJ_ROWS(a_dp)); NWARN(DEFAULT_ERROR_STRING); return; } if( OBJ_ROWS(r_dp) != 1 ){ sprintf(DEFAULT_ERROR_STRING,"dp_zroots: root vector %s should be a row vector, (rows = %d)!?", OBJ_NAME(r_dp),OBJ_ROWS(r_dp)); NWARN(DEFAULT_ERROR_STRING); return; } /* BUG make sure all vectors have same precision */ if( OBJ_MACH_PREC(a_dp) == PREC_SP ){ /* Why do we subtract 1 from the address of the roots, but not * the coefficients!? */ float_zroots( ((fcomplex *)OBJ_DATA_PTR(a_dp))/*-1*/, m, ((fcomplex *)OBJ_DATA_PTR(r_dp))-1, polish); } else if( OBJ_MACH_PREC(a_dp) == PREC_DP ){ double_zroots( ((dcomplex *)OBJ_DATA_PTR(a_dp))-1,m,((dcomplex *)OBJ_DATA_PTR(r_dp))-1,polish); } else { NWARN("bad machine precision in dp_zroots"); } }
FIO_DP_TO_FT_FUNC(wav,Wav_Header) { /* num_frame set when when write request given */ /* BUG questionable cast */ hd_p->wh_n_channels = (short) OBJ_COMPS(dp); switch( OBJ_MACH_PREC(dp) ){ case PREC_UBY: hd_p->wh_bits_per_sample = 8; break; case PREC_IN: hd_p->wh_bits_per_sample = 16; break; default: sprintf(ERROR_STRING, "dp_to_wav: vector %s has unsupported source precision %s", OBJ_NAME(dp),PREC_NAME(OBJ_MACH_PREC_PTR(dp))); warn(ERROR_STRING); return(-1); break; } hd_p->wh_datasize = OBJ_N_TYPE_ELTS(dp) * PREC_SIZE( OBJ_MACH_PREC_PTR(dp) ); hd_p->wh_chunksize = 36 + hd_p->wh_datasize; /* BUG dp's don't have a way to carry around the sample rate with them??? */ /* So we assume that the current sample rate is the one that corresponds * to this object BUG */ hd_p->wh_samp_rate = (*samp_rate_func)(); hd_p->wh_blk_align = hd_p->wh_n_channels * hd_p->wh_bits_per_sample / 8; hd_p->wh_bytes_per_sec = hd_p->wh_blk_align * hd_p->wh_samp_rate; return 0; }
static COMMAND_FUNC( do_xyplot ) { Data_Obj *dp; dp=PICK_OBJ("data vector"); if( dp==NO_OBJ ) return; INSIST_RAM_OBJ(dp,"xyplot") if( bad_plot_vec2(QSP_ARG dp,2,"xyplot") ) return; switch( OBJ_MACH_PREC(dp) ) { case PREC_SP: float_xyplot(dp); break; case PREC_DP: double_xyplot(dp); break; default: sprintf(ERROR_STRING,"do_xyplot: unhandled precision %s (object %s)", OBJ_PREC_NAME(dp),OBJ_NAME(dp)); WARN(ERROR_STRING); break; } }
void dp_choldc(Data_Obj *a_dp, Data_Obj *p_dp) { unsigned m, n; void *a_rowlist[MAX_DIM]; /* n=OBJ_ROWS(a_dp); if( n > MAX_DIM ){ NWARN("Sorry, MAX dimension exceeded in dp_choldc"); sprintf(DEFAULT_ERROR_STRING,"dp_choldc: MAX_DIM = %d, n = %d", MAX_DIM,n); NADVISE(DEFAULT_ERROR_STRING); return; } */ n=OBJ_COLS(a_dp); m=OBJ_ROWS(a_dp); if( n > MAX_DIM || m > MAX_DIM ){ NWARN("Sorry, MAX dimension exceeded in dp_choldc"); sprintf(DEFAULT_ERROR_STRING,"dp_choldc: MAX_DIM = %d, n = %d, m = %d", MAX_DIM,n,m); NADVISE(DEFAULT_ERROR_STRING); return; } printf("nrmenu:numrec.c data %f\n", *((float *)OBJ_DATA_PTR(a_dp))); if( OBJ_MACH_PREC(a_dp) == PREC_SP ){ float_init_rowlist((float **)(void *)a_rowlist,a_dp); float_choldc(((float **)(void *)a_rowlist)-1,n,((float *)OBJ_DATA_PTR(p_dp))-1); } else if( OBJ_MACH_PREC(a_dp) == PREC_DP ){ double_init_rowlist((double **)(void *)a_rowlist,a_dp); double_choldc(((double **)(void *)a_rowlist)-1,n,((double *)OBJ_DATA_PTR(p_dp))-1); } else { NWARN("bad machine precision in dp_choldc"); } }
double comp_func( Data_Obj *dp, index_t index ) { double d; mach_prec mp; if( dp==NO_OBJ ) return(0.0); #ifdef FOOBAR #ifdef HAVE_CUDA if( ! object_is_in_ram(DEFAULT_QSP_ARG dp, "use value functions on CUDA object") ){ return(0.0); } #endif /* HAVE_CUDA */ #endif // FOOBAR if( !IS_SCALAR(dp) ){ sprintf(DEFAULT_ERROR_STRING,"comp_func: %s is not a scalar", OBJ_NAME(dp)); NWARN(DEFAULT_ERROR_STRING); return(0.0); } if( OBJ_MACH_DIM(dp,0) <= (dimension_t)index ){ sprintf(DEFAULT_ERROR_STRING, "Component index %d out of range for object %s", index,OBJ_NAME(dp)); NWARN(DEFAULT_ERROR_STRING); } mp = OBJ_MACH_PREC(dp); switch( mp ){ case PREC_SP: d = (* (((float *)OBJ_DATA_PTR(dp))+index) ); break; case PREC_DP: d = (* (((double *)OBJ_DATA_PTR(dp))+index) ); break; case PREC_IN: d = (* (((short *)OBJ_DATA_PTR(dp))+index) ); break; case PREC_DI: d = (* (((int32_t *)OBJ_DATA_PTR(dp))+index) ); break; case PREC_LI: d = (* (((int64_t *)OBJ_DATA_PTR(dp))+index) ); break; case PREC_BY: d = (* (((char *)OBJ_DATA_PTR(dp))+index) ); break; case PREC_UIN: d = (* (((u_short *)OBJ_DATA_PTR(dp))+index) ); break; case PREC_UDI: if( IS_BITMAP(dp) ){ FETCH_BIT } else { d = (* (((uint32_t *)OBJ_DATA_PTR(dp))+index) ); } break; case PREC_ULI: if( IS_BITMAP(dp) ){ FETCH_BIT } else {
void dp_svbksb(Data_Obj *x_dp, Data_Obj *u_dp, Data_Obj *w_dp, Data_Obj *v_dp, Data_Obj *b_dp) { unsigned m,n; void *u_rowlist[MAX_DIM], *v_rowlist[MAX_DIM]; n=OBJ_COLS(u_dp); m=OBJ_ROWS(u_dp); if( m < n ){ sprintf(DEFAULT_ERROR_STRING,"dp_svbksb: matrix %s (%d x %d) cannot be wider than tall", OBJ_NAME(u_dp),m,n); NWARN(DEFAULT_ERROR_STRING); return; } if( OBJ_COLS(w_dp) != n ){ sprintf(DEFAULT_ERROR_STRING, "dimension of eigenvalue vector %s (%d) must be match # of columns of matrix %s (%d)", OBJ_NAME(w_dp),OBJ_COLS(w_dp),OBJ_NAME(u_dp),n); NWARN(DEFAULT_ERROR_STRING); return; } if(OBJ_ROWS(w_dp) != 1){ sprintf(DEFAULT_ERROR_STRING,"dp_svbksb: eigenvalue vector %s (%d rows) should be a row vector!?", OBJ_NAME(w_dp),OBJ_ROWS(w_dp)); NWARN(DEFAULT_ERROR_STRING); return; } if(OBJ_ROWS(b_dp) != 1){ sprintf(DEFAULT_ERROR_STRING,"dp_svbksb: data vector %s (%d rows) should be a row vector!?", OBJ_NAME(b_dp),OBJ_ROWS(b_dp)); NWARN(DEFAULT_ERROR_STRING); return; } if( OBJ_ROWS(x_dp) != 1 ){ sprintf(DEFAULT_ERROR_STRING,"dp_svbksb: weight vector %s (%d rows) should be a row vector!?", OBJ_NAME(x_dp),OBJ_ROWS(x_dp)); NWARN(DEFAULT_ERROR_STRING); return; } if( OBJ_COLS(v_dp) != n || OBJ_ROWS(v_dp) != n ){ sprintf(DEFAULT_ERROR_STRING,"dp_svbksb: V matrix %s (%d x %d) should be square with dimension %d", OBJ_NAME(v_dp),OBJ_ROWS(v_dp),OBJ_COLS(v_dp),n); NWARN(DEFAULT_ERROR_STRING); return; } if( OBJ_ROWS(u_dp) > MAX_DIM ){ sprintf(DEFAULT_ERROR_STRING,"dp_svbksb: matrix %s has %d rows, max is %d", OBJ_NAME(u_dp),OBJ_ROWS(u_dp),MAX_DIM); NWARN(DEFAULT_ERROR_STRING); return; } if( OBJ_ROWS(v_dp) > MAX_DIM ){ sprintf(DEFAULT_ERROR_STRING,"dp_svbksb: matrix %s has %d rows, max is %d", OBJ_NAME(v_dp),OBJ_ROWS(u_dp),MAX_DIM); NWARN(DEFAULT_ERROR_STRING); return; } if( OBJ_COLS(b_dp) != OBJ_ROWS(u_dp) ){ sprintf(DEFAULT_ERROR_STRING,"dp_svbksb: Number of elements of data vector %s (%ld) should match number of rows of U matrix %s (%ld)", OBJ_NAME(b_dp),(long)OBJ_COLS(b_dp),OBJ_NAME(u_dp),(long)OBJ_ROWS(u_dp)); NWARN(DEFAULT_ERROR_STRING); return; } /* BUG make sure precisions match */ if( OBJ_MACH_PREC(u_dp) == PREC_SP ){ float_init_rowlist((float **)(void *)u_rowlist,u_dp); float_init_rowlist((float **)(void *)v_rowlist,v_dp); //advise("calling float_svbksb..."); float_svbksb(((float **)(void *)u_rowlist)-1,((float *)OBJ_DATA_PTR(w_dp))-1,((float **)(void *)v_rowlist)-1, m,n,(((float *)OBJ_DATA_PTR(b_dp))-1),(((float *)OBJ_DATA_PTR(x_dp))-1)); //advise("back from float_svbksb..."); } else if( OBJ_MACH_PREC(u_dp) == PREC_DP ){ double_init_rowlist((double **)(void *)u_rowlist,u_dp); double_init_rowlist((double **)(void *)v_rowlist,v_dp); double_svbksb(((double **)(void *)u_rowlist)-1,((double *)OBJ_DATA_PTR(w_dp))-1,((double **)(void *)v_rowlist)-1, m,n,(((double *)OBJ_DATA_PTR(b_dp))-1),(((double *)OBJ_DATA_PTR(x_dp))-1)); } else { NWARN("bad precision in dp_svbksb"); } }
void dp_svd(Data_Obj *a_dp, Data_Obj *w_dp, Data_Obj *v_dp) { unsigned m,n; void *a_rowlist[MAX_DIM], *v_rowlist[MAX_DIM]; n=OBJ_COLS(a_dp); m=OBJ_ROWS(a_dp); if( n > MAX_DIM || m > MAX_DIM ){ NWARN("Sorry, MAX dimension exceeded in dp_svd"); sprintf(DEFAULT_ERROR_STRING,"dp_svdcmp: MAX_DIM = %d, n = %d, m = %d", MAX_DIM,n,m); NADVISE(DEFAULT_ERROR_STRING); return; } /* if( m < n ){ sprintf(DEFAULT_ERROR_STRING,"dp_svdcmp: input matrix %s (%d x %d) cannot be wider than tall!?", OBJ_NAME(a_dp),m,n); NWARN(DEFAULT_ERROR_STRING); return; } */ if( OBJ_COLS(w_dp) != n ){ sprintf(DEFAULT_ERROR_STRING,"dp_svdcmp: weight vector %s should have %d columns, to match input matrix %s!?", OBJ_NAME(w_dp),n,OBJ_NAME(a_dp)); NWARN(DEFAULT_ERROR_STRING); return; } if(OBJ_ROWS(w_dp) != 1 ){ sprintf(DEFAULT_ERROR_STRING,"dp_svdcmp: weight vector %s should be a vector, (rows = %d)!?", OBJ_NAME(w_dp),OBJ_ROWS(w_dp)); NWARN(DEFAULT_ERROR_STRING); return; } if( OBJ_COLS(v_dp) != n || OBJ_ROWS(v_dp) != n ){ sprintf(DEFAULT_ERROR_STRING, "V matrix %s should be square with dimension %d, to match # columns of input %s", OBJ_NAME(v_dp),n,OBJ_NAME(a_dp)); NWARN(DEFAULT_ERROR_STRING); return; } /* BUG make sure all vectors have same precision */ if( OBJ_MACH_PREC(a_dp) == PREC_SP ){ float_init_rowlist((float **)(void *)a_rowlist,a_dp); float_init_rowlist((float **)(void *)v_rowlist,v_dp); //advise("calling float_svdcmp"); float_svdcmp(((float **)(void *)a_rowlist)-1,m,n,((float *)OBJ_DATA_PTR(w_dp))-1,((float **)(void *)v_rowlist)-1); //advise("back from float_svdcmp"); /* The eigenvectors aren't sorted by numerical recipes... */ //float_sort_svd_eigenvectors(a_dp,w_dp,v_dp); } else if( OBJ_MACH_PREC(a_dp) == PREC_DP ){ double_init_rowlist((double **)(void *)a_rowlist,a_dp); double_init_rowlist((double **)(void *)v_rowlist,v_dp); //advise("calling double_svdcmp"); double_svdcmp(((double **)(void *)a_rowlist)-1,m,n,((double *)OBJ_DATA_PTR(w_dp))-1,((double **)(void *)v_rowlist)-1); //advise("back from double_svdcmp"); /* The eigenvectors aren't sorted by numerical recipes... */ //double_sort_svd_eigenvectors(a_dp,w_dp,v_dp); } else { NWARN("bad machine precision in dp_svd"); } }