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");
}
}
