double _get_dobj_size(QSP_ARG_DECL Data_Obj *dp,int index)
{
assert( dp != NULL );
assert( index >= 0 && index < N_DIMENSIONS );
return( (double) OBJ_TYPE_DIM(dp,index) );
}
static void zero_dimension(Data_Obj *dp,float *base,int dim,long index)
{
dimension_t i;
if( dim > 1 ){
for(i=0;i<OBJ_TYPE_DIM(dp,dim);i++)
zero_dimension(dp,base+i*OBJ_TYPE_INC(dp,dim),dim-1,i);
} else {
for(i=0;i<OBJ_COLS(dp);i++)
base[i] = 0.0;
}
}
int old_cksiz(QSP_ARG_DECL int argtyp,Data_Obj *src_dp,Data_Obj *dst_dp)
{
int i;
/* allow exception for vmaxg, etc. */
if( argtyp == V_SCALRET2 )
return(0);
for(i=0;i<N_DIMENSIONS;i++){
if( OBJ_TYPE_DIM(src_dp,i) != OBJ_TYPE_DIM(dst_dp,i) ){
/* if we get to here, we're not happy... */
sprintf(ERROR_STRING,
"old_cksiz: %s count mismatch, %s (%d) & %s (%d)",
dimension_name[i],
OBJ_NAME(src_dp),OBJ_TYPE_DIM(src_dp,i),
OBJ_NAME(dst_dp),OBJ_TYPE_DIM(dst_dp,i));
WARN(ERROR_STRING);
return(-1);
}
}
return(0);
} /* end old_cksiz() */
int cksiz(QSP_ARG_DECL int argtyp,Data_Obj *src_dp,Data_Obj *dst_dp)
{
int i;
/* allow exception for vmaxg, etc.
* These functions return two scalars, the max value,
* and number of occurrences, PLUS a vector with the
* indices of the occurrences.
*
* But where do we check them? Do we need to do any checking for them?
*/
if( argtyp == V_SCALRET2 )
return(0);
for(i=0;i<N_DIMENSIONS;i++){
if( OBJ_TYPE_DIM(src_dp,i) != OBJ_TYPE_DIM(dst_dp,i) ){
/* special case for real/cpx fft */
if( i==1 ){
if( (argtyp & FWD_FT) && IS_REAL(src_dp) && IS_COMPLEX(dst_dp) ){
if( OBJ_COLS(dst_dp) == (1+OBJ_COLS(src_dp)/2) )
continue;
} else if( (argtyp & INV_FT) && IS_COMPLEX(src_dp) && IS_REAL(dst_dp) ){
if( OBJ_COLS(src_dp) == (1+OBJ_COLS(dst_dp)/2) )
continue;
}
}
/* if we get to here, the dimensions don't match... */
/* if the source dimension is 1, it may be an outer op */
/* if the destination dimension is 1, it may be a projection op */
if( OBJ_TYPE_DIM(src_dp,i) == 1 /* && (argtyp&VV_SOURCES) == VV_SOURCES */ ){
/* vmul, vadd, vsub, vatan2 */
/* vvm_gt etc also */
/* don't need VV_SOURCES... */
continue;
} else if( OBJ_TYPE_DIM(dst_dp,i) == 1 && CAN_PROJECT(argtyp) ){
/* vsum, vmaxv, vmainv, etc */
continue;
} else {
/* if we get to here, we're not happy... */
sprintf(ERROR_STRING,
"cksiz: %s count mismatch, %s (%d) & %s (%d)",
dimension_name[i],
OBJ_NAME(src_dp),OBJ_TYPE_DIM(src_dp,i),
OBJ_NAME(dst_dp),OBJ_TYPE_DIM(dst_dp,i));
WARN(ERROR_STRING);
return(-1);
}
}
}
return(0);
} /* end cksiz() */
static int change_size(QSP_ARG_DECL Data_Obj *dst_dp,Data_Obj *src_dp )
{
Dimension_Set ef, *enlargement_factor=&ef;
Dimension_Set rf, *reduction_factor=&rf;
Vec_Obj_Args oa1, *oap=&oa1;
Dimension_Set size_ds, n_ds;
Dimension_Set *size_dsp=(&size_ds), *n_dsp=(&n_ds);
Data_Obj *src_ss_dp, *dst_ss_dp;
dimension_t i,j,k,l,m;
index_t offsets[N_DIMENSIONS]={0,0,0,0,0};
incr_t dst_incrs[N_DIMENSIONS], src_incrs[N_DIMENSIONS];
index_t dst_indices[N_DIMENSIONS]={0,0,0,0,0}, src_indices[N_DIMENSIONS]={0,0,0,0,0};
/* For simplicity, we don't allow size changes to be combined with conversions */
if( !dp_same_prec(QSP_ARG dst_dp,src_dp,"change_size") )
return(-1);
for(i=0;i<N_DIMENSIONS;i++){
if( OBJ_TYPE_DIM(dst_dp,i) > OBJ_TYPE_DIM(src_dp,i) ){
/* enlargement - subsample the destination */
SET_DIMENSION(enlargement_factor,i,
floor( OBJ_TYPE_DIM(dst_dp,i) / OBJ_TYPE_DIM(src_dp,i) ) );
SET_DIMENSION(reduction_factor,i, 0);
SET_DIMENSION(size_dsp,i, OBJ_TYPE_DIM(src_dp,i) );
SET_DIMENSION(n_dsp,i, DIMENSION(enlargement_factor,i) );
dst_incrs[i] = DIMENSION(n_dsp,i);
src_incrs[i] = 1;
} else {
/* reduction - subsample the source */
SET_DIMENSION(reduction_factor,i,
ceil( OBJ_TYPE_DIM(src_dp,i) / OBJ_TYPE_DIM(dst_dp,i) ) );
SET_DIMENSION(enlargement_factor,i, 0 );
SET_DIMENSION(size_dsp,i, floor( OBJ_TYPE_DIM(src_dp,i) /
DIMENSION(reduction_factor,i) ) );
/* We don't need to do this multiple times, just pick one and do it */
/*SET_DIMENSION(n_dsp,i, DIMENSION(reduction_factor,i) ); */
SET_DIMENSION(n_dsp,i, 1);
src_incrs[i] = DIMENSION(reduction_factor,i);
dst_incrs[i] = 1;
}
}
/* make the subsamples.
* the column increment is expressed in columns, etc.
*/
dst_ss_dp=make_subsamp(QSP_ARG "chngsize_dst_obj",dst_dp,size_dsp,offsets,dst_incrs);
src_ss_dp=make_subsamp(QSP_ARG "chngsize_src_obj",src_dp,size_dsp,offsets,src_incrs);
clear_obj_args(oap);
SET_OA_DEST(oap,dst_ss_dp);
SET_OA_SRC_OBJ(oap,0, src_ss_dp);
SET_OA_ARGSTYPE(oap, REAL_ARGS);
SET_OA_PFDEV(oap,OBJ_PFDEV(dst_dp));
for(i=0;i<DIMENSION(n_dsp,4);i++){ /* foreach sequence to copy */
if( dst_incrs[4] > 1 )
dst_indices[4]=i;
else src_indices[4]=i;
for(j=0;j<DIMENSION(n_dsp,3);j++){ /* foreach frame to copy */
if( dst_incrs[3] > 1 )
dst_indices[3]=j;
else src_indices[3]=j;
for(k=0;k<DIMENSION(n_dsp,2);k++){ /* foreach row */
if( dst_incrs[2] > 1 )
dst_indices[2]=k;
else src_indices[2]=k;
for(l=0;l<DIMENSION(n_dsp,1);l++){ /* foreach col */
if( dst_incrs[1] > 1 )
dst_indices[1]=l;
else src_indices[1]=l;
for(m=0;m<DIMENSION(n_dsp,0);m++){ /* foreach comp */
if( dst_incrs[0] > 1 )
dst_indices[0]=m;
else src_indices[0]=m;
/* relocate the appropriate subsample */
SET_OBJ_DATA_PTR(dst_ss_dp, multiply_indexed_data(dst_dp,dst_indices) );
SET_OBJ_DATA_PTR(src_ss_dp, multiply_indexed_data(src_dp,src_indices) );
// This doesn't check for cuda obj...
//vmov(oap);
perf_vfunc(QSP_ARG FVMOV, oap );
}
}
}
}
}
delvec(QSP_ARG dst_ss_dp);
delvec(QSP_ARG src_ss_dp);
SET_OBJ_FLAG_BITS(dst_dp, DT_ASSIGNED);
return(0);
}
static COMMAND_FUNC( mk_subsample )
{
const char *obj_name;
Data_Obj *dp;
Dimension_Set ds1, *dsp=(&ds1);
index_t offsets[N_DIMENSIONS];
long l_offset[N_DIMENSIONS];
incr_t incrs[N_DIMENSIONS];
long size[N_DIMENSIONS];
char pmpt[MAX_PMPT_LEN];
int i;
obj_name=NAMEOF("name for subsample object");
dp=pick_obj(PARENT_PROMPT);
/* We violate the rule of returning before getting
* all arguments, because the fields of dp are needed
* to determine what to prompt for!
*/
if( dp==NULL ) return;
for(i=0;i<N_DIMENSIONS;i++){
/* BUG? should we prompt for all dimensions, instead of just those > 1 ?
* If we did, then we could defer the return above...
*/
if( OBJ_TYPE_DIM(dp,i) > 1 ){
if( i < (N_DIMENSIONS-1) )
// BUG check length
sprintf(pmpt,"number of %ss per %s",dimension_name[i], dimension_name[i+1]);
else
sprintf(pmpt,"number of %ss",dimension_name[i]);
size[i]=(long) how_many(pmpt);
sprintf(pmpt,"%s offset",dimension_name[i]);
l_offset[i] = (long) how_many(pmpt);
sprintf(pmpt,"%s increment",dimension_name[i]);
incrs[i] =(incr_t)how_many(pmpt); // this can be negative...
} else {
size[i] = 1;
l_offset[i]=0;
incrs[i]=1;
}
}
for(i=0;i<N_DIMENSIONS;i++){
char offset_descr[LLEN];
INSIST_POSITIVE_DIM(size[i],dimension_name[i],"mk_subsample");
sprintf(offset_descr,"%s offset",dimension_name[i]);
INSIST_NONNEGATIVE(l_offset[i],offset_descr,"mk_subsample");
}
for(i=0;i<N_DIMENSIONS;i++){
SET_DIMENSION(dsp,i,size[i]);
offsets[i] = (index_t) l_offset[i];
}
// make_subsamp checks the increments...
if( make_subsamp(obj_name,dp,dsp,offsets,incrs) == NULL )
warn("error making subsamp object");
}
void multivariate_histo(QSP_ARG_DECL Data_Obj *histo_dp,Data_Obj *data_dp,float *width_array,float *min_array)
{
dimension_t n_dimensions;
dimension_t i,j,k;
unsigned int l;
float *fbase, *fptr, *f;
float *histbuf;
incr_t index[MAX_DIMENSIONS];
int n_bins[MAX_DIMENSIONS];
int n_under[MAX_DIMENSIONS], n_over[MAX_DIMENSIONS];
INSIST_RAM_OBJ(histo_dp,compute_histo);
INSIST_RAM_OBJ(data_dp,compute_histo);
if( OBJ_PREC(histo_dp) != PREC_SP ){
NWARN("2D histogram precision must be float");
return;
}
if( OBJ_COMPS(histo_dp) != 1 ){
NWARN("2D histogram data must be real");
return;
}
if( OBJ_PXL_INC(histo_dp) != 1 ){
NWARN("2D histogram data must be contiguous");
return;
}
n_dimensions = OBJ_COMPS(data_dp);
if( n_dimensions > MAX_DIMENSIONS ){
NWARN("Too many 2D histogram dimensions");
return;
}
if( OBJ_PREC(data_dp) != PREC_SP ){
NWARN("2D data precision must be float");
return;
}
fbase = (float *) OBJ_DATA_PTR(data_dp);
for(l=0;l<n_dimensions;l++){
n_over[l]=0;
n_under[l]=0;
n_bins[l] = OBJ_TYPE_DIM(histo_dp,l+1);
}
histbuf = (float *) OBJ_DATA_PTR(histo_dp);
zero_dimension(histo_dp,(float *)OBJ_DATA_PTR(histo_dp),n_dimensions,0L);
for(l=0;l<MAX_DIMENSIONS;l++)
index[l]=0;
for(i=0;i<OBJ_FRAMES(data_dp);i++){
fptr = fbase;
for(j=0;j<OBJ_ROWS(data_dp);j++){
f=fptr;
for(k=0;k<OBJ_COLS(data_dp);k++){
float num[MAX_DIMENSIONS];
for(l=0;l<n_dimensions;l++){
num[l] = f[l]; /* assume cinc=1 */
num[l] -= min_array[l];
num[l] /= width_array[l];
num[l] += 0.5;
index[l] = (incr_t)num[l]; /* cast to int */
if( index[l] < 0 ){
index[l]=0;
n_under[l]++;
} else if( index[l] >= n_bins[l] ){
index[l] = n_bins[l]-1;
n_over[l]++;
}
}
histbuf[
index[0] +
index[1] * OBJ_ROW_INC(histo_dp) +
index[2] * OBJ_FRM_INC(histo_dp)
] += 1.0;
f += OBJ_PXL_INC(data_dp);
}
fptr += OBJ_ROW_INC(data_dp);
}
fbase += OBJ_FRM_INC(data_dp);
}
for(l=0;l<n_dimensions;l++){
if( (n_under[l] > 0) || (n_over[l] > 0) ){
sprintf(ERROR_STRING,
"Histogram for %s had %d underflows and %d overflows in dimension %d",
OBJ_NAME(data_dp),n_under[l],n_over[l],l);
advise(ERROR_STRING);
}
}
}
