static float get_start_val(Data_Obj *source,Data_Obj *control,dimension_t index)
{
float *f,*c,sum;
int i=0;
f = (float *)OBJ_DATA_PTR(source);
f += index*OBJ_PXL_INC(source);
c = (float *)OBJ_DATA_PTR(control);
c += index*OBJ_PXL_INC(control);
sum = 0.0;
while( (((int)index)-i) >= 0 && *c == 1.0 && i < max_avg ){
sum += *f;
f -= OBJ_PXL_INC(source);
c -= OBJ_PXL_INC(control);
i++;
}
#ifdef DEBUG
if( debug ){
sprintf(DEFAULT_ERROR_STRING,"get_start_val: index = %d n = %d sum = %f",index,i,sum);
NADVISE(DEFAULT_ERROR_STRING);
}
#endif
sum /= i;
return(sum);
}
void dobj_iterate(Data_Obj *dp,void (*func)(Data_Obj *,index_t))
{
dimension_t comp,col,row,frm,seq;
/* offsets for sequence, frame, row, pixel, component */
dimension_t s_os, f_os, r_os, p_os, c_os;
s_os=0;
for(seq=0;seq<OBJ_SEQS(dp);seq++){
f_os = s_os;
for(frm=0;frm<OBJ_FRAMES(dp);frm++){
r_os = f_os;
for(row=0;row<OBJ_ROWS(dp);row++){
p_os = r_os;
for(col=0;col<OBJ_COLS(dp);col++){
c_os = p_os;
for(comp=0;comp<OBJ_COMPS(dp);comp++){
(*func)(dp,c_os);
c_os += OBJ_COMP_INC(dp);
}
p_os += OBJ_PXL_INC(dp);
}
r_os += OBJ_ROW_INC(dp);
}
f_os += OBJ_FRM_INC(dp);
}
s_os += OBJ_SEQ_INC(dp);
}
}
int get_framerate_strings( QSP_ARG_DECL Data_Obj *str_dp, PGR_Cam *pgcp )
{
// Could check format of object here...
// Should be string table with enough entries to hold the modes
// Should the strings be rows or multidim pixels?
int i, n;
if( OBJ_COLS(str_dp) < pgcp->pc_framerates.num ){
sprintf(ERROR_STRING,"String object %s has too few columns (%ld) to hold %d framerates",
OBJ_NAME(str_dp),(long)OBJ_COLS(str_dp),pgcp->pc_framerates.num);
WARN(ERROR_STRING);
n = OBJ_COLS(str_dp);
} else {
n=pgcp->pc_framerates.num;
}
for(i=0;i<n;i++){
const char *src;
char *dst;
src = name_for_framerate(pgcp->pc_framerates.framerates[i]);
dst = OBJ_DATA_PTR(str_dp);
dst += i * OBJ_PXL_INC(str_dp);
if( strlen(src)+1 > OBJ_COMPS(str_dp) ){
sprintf(ERROR_STRING,"String object %s has too few components (%ld) to hold framerate string \"%s\"",
OBJ_NAME(str_dp),(long)OBJ_COMPS(str_dp),src);
WARN(ERROR_STRING);
} else {
strcpy(dst,src);
}
}
return n;
}
void _convolve(QSP_ARG_DECL Data_Obj *dpto,Data_Obj *dpfr,Data_Obj *dpfilt)
{
dimension_t i,j;
float val, *frptr;
dimension_t yos, offset;
// where is the other error checking done???
INSIST_RAM_OBJ(dpto,convolve)
INSIST_RAM_OBJ(dpfr,convolve)
INSIST_RAM_OBJ(dpfilt,convolve)
img_clear(dpto);
frptr = (float *) OBJ_DATA_PTR(dpfr);
j=OBJ_ROWS(dpto);
while(j--){
yos = j * OBJ_ROW_INC(dpfr);
i=OBJ_COLS(dpfr);
while(i--){
offset = yos+i*OBJ_PXL_INC(dpfr);
val = *(frptr+offset);
add_impulse(val,dpto,dpfilt,i,j);
}
}
}
static void get_data_params(Data_Obj *dp, u_long *np, long *incp)
{
if( OBJ_COLS(dp)==1 ) { /* maybe this is a column vector? */
*np=OBJ_ROWS(dp);
*incp = OBJ_ROW_INC(dp);
} else {
*np=OBJ_COLS(dp);
*incp = OBJ_PXL_INC(dp);
}
}
static float get_end_val(Data_Obj *source,Data_Obj *control,dimension_t index)
{
float *f,*c,sum;
int i=0;
f = (float *)OBJ_DATA_PTR(source);
f += index*OBJ_PXL_INC(source);
c = (float *)OBJ_DATA_PTR(control);
c += index*OBJ_PXL_INC(control);
sum = 0.0;
while( (index+i) < OBJ_COLS(source) && *c == 1.0 && i < max_avg ){
sum += *f;
f += OBJ_PXL_INC(source);
c += OBJ_PXL_INC(control);
i++;
}
sum /= i;
return(sum);
}
void add_impulse(double amp,Data_Obj *image_dp,Data_Obj *ir_dp,posn_t x,posn_t y)
{
float *image_ptr, *irptr;
incr_t i,j;
incr_t yos,xos,offset; /* offsets into image */
incr_t iryos,iros; /* offsets into impulse response */
incr_t pinc, ir_pinc;
pinc = OBJ_PXL_INC(image_dp);
ir_pinc = OBJ_PXL_INC(ir_dp);
image_ptr = (float *) OBJ_DATA_PTR(image_dp);
irptr = (float *) OBJ_DATA_PTR(ir_dp);
j=OBJ_ROWS(ir_dp);
while( j-- ){ /* foreach impulse row */
yos = ((y+j)-OBJ_ROWS(ir_dp)/2);
#ifdef NOWRAP
if( yos < 0 || yos >= (incr_t) OBJ_ROWS(image_dp) ) continue;
#else
if( yos < 0 ) yos+=OBJ_ROWS(image_dp);
else if( yos >= OBJ_ROWS(image_dp) ) yos-=OBJ_ROWS(image_dp);
#endif /* NOWRAP */
yos *= OBJ_ROW_INC(image_dp);
iryos = j * OBJ_ROW_INC(ir_dp);
i=OBJ_COLS(ir_dp);
while(i--){
xos = ((x+i)-OBJ_COLS(ir_dp)/2);
#ifdef NOWRAP
if( xos < 0 || xos >= (incr_t) OBJ_COLS(image_dp) ) continue;
#else
if( xos < 0 ) xos+=OBJ_COLS(image_dp);
else if( xos >= OBJ_COLS(image_dp) ) xos-=OBJ_COLS(image_dp);
#endif /* NOWRAP */
offset = (yos + xos*pinc);
iros = (iryos + i*ir_pinc);
*(image_ptr+offset) += *(irptr+iros) * amp;
}
}
}
void _dpair_iterate(QSP_ARG_DECL Data_Obj *dp1,Data_Obj *dp2,void (*func)(QSP_ARG_DECL Data_Obj *,index_t,Data_Obj *,index_t))
{
dimension_t comp,col,row,frm,seq;
/* offsets for sequence, frame, row, pixel, component */
dimension_t s_os1, f_os1, r_os1, p_os1, c_os1;
dimension_t s_os2, f_os2, r_os2, p_os2, c_os2;
s_os1=0;
s_os2=0;
for(seq=0;seq<OBJ_SEQS(dp1);seq++){
f_os1 = s_os1;
f_os2 = s_os2;
for(frm=0;frm<OBJ_FRAMES(dp1);frm++){
r_os1 = f_os1;
r_os2 = f_os2;
for(row=0;row<OBJ_ROWS(dp1);row++){
p_os1 = r_os1;
p_os2 = r_os2;
for(col=0;col<OBJ_COLS(dp1);col++){
c_os1 = p_os1;
c_os2 = p_os2;
for(comp=0;comp<OBJ_COMPS(dp1);comp++){
(*func)(QSP_ARG dp1,c_os1,dp2,c_os2);
c_os1 += OBJ_COMP_INC(dp1);
c_os2 += OBJ_COMP_INC(dp2);
}
p_os1 += OBJ_PXL_INC(dp1);
p_os2 += OBJ_PXL_INC(dp2);
}
r_os1 += OBJ_ROW_INC(dp1);
r_os2 += OBJ_ROW_INC(dp2);
}
f_os1 += OBJ_FRM_INC(dp1);
f_os2 += OBJ_FRM_INC(dp2);
}
s_os1 += OBJ_SEQ_INC(dp1);
s_os2 += OBJ_SEQ_INC(dp2);
}
}
void convert_polh_vector(Data_Obj *flt_dp,Data_Obj *polh_dp)
{
uint32_t i,j;
short *rpdp;
float *cvt_p;
Fmt_Pt fp1;
int station;
if( OBJ_PREC(flt_dp) != PREC_SP ){
sprintf(ERROR_STRING,"convert_polh_data: object %s has precision %s, should be %s",
OBJ_NAME(flt_dp),PREC_NAME(OBJ_PREC_PTR(flt_dp)),PREC_NAME(prec_for_code(PREC_SP)));
warn(ERROR_STRING);
return;
}
if( OBJ_COLS(flt_dp) != OBJ_COLS(polh_dp) ){
sprintf(ERROR_STRING,"convert_polh_data: vectors %s (%d) and %s (%d) do not have the same number of columns",
OBJ_NAME(flt_dp),OBJ_COLS(flt_dp),OBJ_NAME(polh_dp),OBJ_COLS(polh_dp));
warn(ERROR_STRING);
return;
}
/* BUG should make sure that tdim of flt_dp is correct! */
/* assume that the object has already been checked for proper dim, type... */
if( n_active_stations == 2 )
station=0;
else if(n_active_stations < 1 ){
warn("format_polh_vector: no active stations!?");
return;
} else
station=curr_station_idx;
rpdp = (short *) OBJ_DATA_PTR(polh_dp);
for(i=0;i<OBJ_COLS(polh_dp);i++){
Polh_Record_Format *prfp;
cvt_p = ((float *) OBJ_DATA_PTR(flt_dp)) + i * OBJ_PXL_INC(flt_dp);
prfp = &station_info[station].sd_multi_prf;
format_polh_data(&fp1,rpdp,prfp);
for(j=0;j<prfp->rf_n_data;j++){
Polh_Output_Type type;
type = prfp->rf_output[j];
convert_chunk(cvt_p,&fp1,type);
cvt_p += od_tbl[type].od_strings; /* BUG not the right variable?... */
}
rpdp += prfp->rf_n_words;
if( n_active_stations == 2 )
station ^= 1;
}
}
void img_clear(Data_Obj *dp)
{
dimension_t i,j;
float *ptr;
incr_t xos, yos;
ptr=(float *)OBJ_DATA_PTR(dp);
for(j=0;j<OBJ_ROWS(dp);j++){
yos = j * OBJ_ROW_INC(dp);
for(i=0;i<OBJ_COLS(dp);i++){
xos = i * OBJ_PXL_INC(dp);
*(ptr + yos + xos ) = 0.0;
}
}
}
int get_camera_names( QSP_ARG_DECL Data_Obj *str_dp )
{
// Could check format of object here...
// Should be string table with enough entries to hold the modes
// Should the strings be rows or multidim pixels?
List *lp;
Node *np;
PGR_Cam *pgcp;
int i, n;
lp = pgc_list();
if( lp == NULL ){
WARN("No cameras!?");
return 0;
}
n=eltcount(lp);
if( OBJ_COLS(str_dp) < n ){
sprintf(ERROR_STRING,"String object %s has too few columns (%ld) to hold %d camera names",
OBJ_NAME(str_dp),(long)OBJ_COLS(str_dp),n);
WARN(ERROR_STRING);
n = OBJ_COLS(str_dp);
}
np=QLIST_HEAD(lp);
i=0;
while(np!=NULL){
char *dst;
pgcp = (PGR_Cam *) NODE_DATA(np);
dst = OBJ_DATA_PTR(str_dp);
dst += i * OBJ_PXL_INC(str_dp);
if( strlen(pgcp->pc_name)+1 > OBJ_COMPS(str_dp) ){
sprintf(ERROR_STRING,"String object %s has too few components (%ld) to hold camera name \"%s\"",
OBJ_NAME(str_dp),(long)OBJ_COMPS(str_dp),pgcp->pc_name);
WARN(ERROR_STRING);
} else {
strcpy(dst,pgcp->pc_name);
}
i++;
if( i>=n )
np=NULL;
else
np = NODE_NEXT(np);
}
return i;
}
int get_video_mode_strings( QSP_ARG_DECL Data_Obj *str_dp, PGR_Cam *pgcp )
{
// Could check format of object here...
// Should be string table with enough entries to hold the modes
// Should the strings be rows or multidim pixels?
int i, n;
if( OBJ_COLS(str_dp) < pgcp->pc_video_modes.num ){
sprintf(ERROR_STRING,"String object %s has too few columns (%ld) to hold %d modes",
OBJ_NAME(str_dp),(long)OBJ_COLS(str_dp),pgcp->pc_video_modes.num);
WARN(ERROR_STRING);
n = OBJ_COLS(str_dp);
} else {
n=pgcp->pc_video_modes.num;
}
for(i=0;i<n;i++){
int k;
const char *src;
char *dst;
k=index_of_video_mode(pgcp->pc_video_modes.modes[i]);
src = all_video_modes[k].nvm_name;
dst = OBJ_DATA_PTR(str_dp);
dst += i * OBJ_PXL_INC(str_dp);
if( strlen(src)+1 > OBJ_COMPS(str_dp) ){
sprintf(ERROR_STRING,"String object %s has too few components (%ld) to hold mode string \"%s\"",
OBJ_NAME(str_dp),(long)OBJ_COMPS(str_dp),src);
WARN(ERROR_STRING);
} else {
strcpy(dst,src);
}
}
set_script_var_from_int("n_video_modes",n);
return n;
}
static void _ocl_offset_data(QSP_ARG_DECL Data_Obj *dp, index_t offset)
{
#ifndef USE_OPENCL_SUBREGION
/* The original code used subBuffers, but overlapping subregions
* don't work...
* So instead we use a common memory buffer, but keep track
* of the starting offset (in elements). This offset has
* to be passed to the kernels.
*/
//fprintf(stderr,"ocl_offset_data: obj %s, offset = %d\n",OBJ_NAME(dp),offset);
//fprintf(stderr,"\tparent obj %s, parent offset = %d\n",OBJ_NAME(OBJ_PARENT(dp)),
//OBJ_OFFSET(OBJ_PARENT(dp)));
if( IS_COMPLEX(dp) ){
assert( (offset & 1) == 0 );
offset /= 2;
//fprintf(stderr,"Adjusted offset (%d) for complex object %s\n",offset,OBJ_NAME(dp));
} else if( IS_QUAT(dp) ){
assert( (offset & 3) == 0 );
offset /= 4;
}
SET_OBJ_DATA_PTR(dp,OBJ_DATA_PTR(OBJ_PARENT(dp)));
SET_OBJ_OFFSET( dp, OBJ_OFFSET(OBJ_PARENT(dp)) + offset );
#else // USE_OPENCL_SUBREGION
cl_mem buf;
cl_mem parent_buf;
cl_buffer_region reg;
cl_int status;
int extra_offset;
parent_buf = find_parent_buf(OBJ_PARENT(dp),&extra_offset);
assert( parent_buf != NULL );
reg.origin = (offset+extra_offset) * ELEMENT_SIZE(dp);
// No - the region has to be big enough for all of the elements.
// The safest thing is to include everything from the start
// of the subregion to the end of the parent. Note that this
// cannot handle negative increments!?
// reg.size = OBJ_N_MACH_ELTS(dp) * ELEMENT_SIZE(dp);
// p p p p p p p
// p p c c c p p
// p p p p p p p
// p p c c c p p
reg.size = OBJ_SEQ_INC(dp)*(OBJ_SEQS(dp)-1)
+ OBJ_FRM_INC(dp)*(OBJ_FRAMES(dp)-1)
+ OBJ_ROW_INC(dp)*(OBJ_ROWS(dp)-1)
+ OBJ_PXL_INC(dp)*(OBJ_COLS(dp)-1)
+ OBJ_COMP_INC(dp)*(OBJ_COMPS(dp)-1)
+ 1;
reg.size *= ELEMENT_SIZE(dp);
//fprintf(stderr,"requesting subregion of %ld bytes at offset %ld\n",
//reg.size,reg.origin);
buf = clCreateSubBuffer ( parent_buf,
CL_MEM_READ_WRITE,
CL_BUFFER_CREATE_TYPE_REGION,
®,
&status);
if( status != CL_SUCCESS ){
report_ocl_error(status, "clCreateSubBuffer");
SET_OBJ_DATA_PTR(dp,OBJ_DATA_PTR(OBJ_PARENT(dp)));
} else {
SET_OBJ_DATA_PTR(dp,buf);
}
// BUG - Because this object doesn't "own" the data, the sub-buffer
// won't be released when the object is destroyed, a possible memory
// leak...
// We need to add a special case, or make data releasing a
// platform-specific function...
#endif // USE_OPENCL_SUBREGION
}
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};
index_t dst_offset, src_offset;
/* For simplicity, we don't allow size changes to be combined with conversions */
if( !dp_same_prec(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("chngsize_dst_obj",dst_dp,size_dsp,offsets,dst_incrs);
src_ss_dp=make_subsamp("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 */
dst_offset = dst_indices[0]*OBJ_COMP_INC(dst_dp) +
dst_indices[1]*OBJ_PXL_INC(dst_dp) +
dst_indices[2]*OBJ_ROW_INC(dst_dp) +
dst_indices[3]*OBJ_FRM_INC(dst_dp) +
dst_indices[4]*OBJ_SEQ_INC(dst_dp) ;
( * PF_OFFSET_DATA_FN(OBJ_PLATFORM(dst_ss_dp)) ) (QSP_ARG dst_ss_dp, dst_offset );
src_offset = src_indices[0]*OBJ_COMP_INC(src_dp) +
src_indices[1]*OBJ_PXL_INC(src_dp) +
src_indices[2]*OBJ_ROW_INC(src_dp) +
src_indices[3]*OBJ_FRM_INC(src_dp) +
src_indices[4]*OBJ_SEQ_INC(src_dp) ;
( * PF_OFFSET_DATA_FN(OBJ_PLATFORM(src_ss_dp)) ) (QSP_ARG src_ss_dp, src_offset );
// This doesn't check for cuda obj...
//vmov(oap);
perf_vfunc(QSP_ARG FVMOV, oap );
}
}
}
}
}
delvec(dst_ss_dp);
delvec(src_ss_dp);
SET_OBJ_FLAG_BITS(dst_dp, DT_ASSIGNED);
return(0);
}
static COMMAND_FUNC( do_cyplot )
{
Data_Obj *dp;
Data_Obj *cdp;
u_long i, np; /* number of points */
long inc;
long cinc;
std_type x,y,dx,*yp;
char *cp;
dp=PICK_OBJ("data vector");
cdp=PICK_OBJ("color vector");
if( dp==NO_OBJ ) return;
if( cdp==NO_OBJ ) return;
INSIST_RAM_OBJ(dp,"cyplot")
INSIST_RAM_OBJ(cdp,"cyplot")
if( OBJ_PREC(dp) != PREC_SP ) {
WARN("do_cyplot: data vector should be float");
return;
}
if( OBJ_PREC(cdp) != PREC_BY ) {
WARN("color vector should be byte");
return;
}
if( !dp_same_size(QSP_ARG dp,cdp,"do_cyplot") ) {
sprintf(ERROR_STRING,"data vector %s and color vector %s must have identical sizes",
OBJ_NAME(dp),OBJ_NAME(cdp));
WARN(ERROR_STRING);
return;
}
if( OBJ_COLS(dp)==1 ) { /* maybe this is a column vector? */
np=OBJ_ROWS(dp);
inc = OBJ_ROW_INC(dp);
cinc = OBJ_ROW_INC(cdp);
} else {
np=OBJ_COLS(dp);
inc = OBJ_PXL_INC(dp);
cinc = OBJ_PXL_INC(cdp);
}
x=0;
dx=1;
i=np-1;
yp = (std_type *) OBJ_DATA_PTR(dp);
cp = (char *) OBJ_DATA_PTR(cdp);
xp_fmove(x,*yp);
xp_select(*cp);
xp_fcont(x,*yp);
while(i--) {
yp += inc;
cp += cinc;
x += dx;
y = *yp;
xp_select(*cp);
xp_fcont(x,y);
}
}
void corr_matrix(Data_Obj *dpto,Data_Obj *dpfr)
{
int had_err=0;
float *op1, *op2;
float *dest, *dest2;
dimension_t i,j;
Vec_Args args;
if( ! is_real(dpto,"corr_matrix") ) return;
if( ! is_real(dpfr,"corr_matrix") ) return;
if( OBJ_COLS(dpto) != OBJ_ROWS(dpto) ){
sprintf(ERROR_STRING,"target matrix %s (%dx%d) must be square",OBJ_NAME(dpto),
OBJ_ROWS(dpto),OBJ_COLS(dpto));
WARN(ERROR_STRING);
had_err++;
}
if( OBJ_COLS(dpto) != OBJ_ROWS(dpfr) ){
sprintf(ERROR_STRING,
"target matrix %s size %d not equal to source matrix %s rows (%d)",
OBJ_NAME(dpto),OBJ_COLS(dpto),OBJ_NAME(dpfr),OBJ_ROWS(dpfr));
WARN(ERROR_STRING);
had_err++;
}
if( had_err ) return;
if( IS_COMPLEX(dpto) )
args.arg_argstype = COMPLEX_ARGS;
else
args.arg_argstype = REAL_ARGS;
args.arg_inc1 = OBJ_PXL_INC(dpfr);
args.arg_inc2 = OBJ_PXL_INC(dpfr);
args.arg_n1 = OBJ_COLS(dpfr);
args.arg_n2 = OBJ_COLS(dpfr);
args.arg_prec1 = OBJ_PREC(dpfr);
args.arg_prec2 = OBJ_PREC(dpfr);
op1 = OBJ_DATA_PTR(dpfr);
for(i=0;i<OBJ_ROWS(dpfr);i++){
dest = dest2 = OBJ_DATA_PTR(dpto);
dest += i*OBJ_ROW_INC(dpto);
dest += i*OBJ_PXL_INC(dpto);
dest2 += i*OBJ_PXL_INC(dpto);
dest2 += i*OBJ_ROW_INC(dpto);
op2 = OBJ_DATA_PTR(dpfr);
op2 += i*OBJ_ROW_INC(dpfr);
for(j=i;j<OBJ_ROWS(dpfr);j++){
args.arg_v1 = op1;
args.arg_v2 = op2;
vdot(&args);
*dest2 = *dest; /* symmetric matrix */
op2 += OBJ_ROW_INC(dpfr);
dest += OBJ_PXL_INC(dpto);
dest2 += OBJ_ROW_INC(dpto);
}
op1 += OBJ_ROW_INC(dpfr);
}
} /* end corr_matrix() */
void vinterp(QSP_ARG_DECL Data_Obj *target,Data_Obj *source,Data_Obj *control)
{
float *to, *fr, *c;
dimension_t i;
int32_t n_to_interpolate=0;
float *interp_dest;
int32_t start_index=(-1);
assert( target != NULL );
assert( source != NULL );
assert( control != NULL );
INSIST_RAM_OBJ(target,vinterp)
INSIST_RAM_OBJ(source,vinterp)
INSIST_RAM_OBJ(control,vinterp)
if( not_prec(target,PREC_SP) ) return;
if( not_prec(source,PREC_SP) ) return;
if( not_prec(control,PREC_SP) ) return;
if( !dp_same_size(target,source,"vinterp") ){
warn("vinterp: target/source length mismatch");
return;
}
if( !dp_same_size(target,control,"vinterp") ){
warn("vinterp: target/control length mismatch");
return;
}
if( OBJ_COMPS(source) != 1 || OBJ_COMPS(target) != 1 ){
warn("vinterp: component dimensions must be 1");
return;
}
/* could check that they are all vectors... */
to=(float *)OBJ_DATA_PTR(target);
fr=(float *)OBJ_DATA_PTR(source);
c=(float *)OBJ_DATA_PTR(control);
interp_dest=to;
for(i=0;i<OBJ_COLS(target);i++){
if( *c == 1.0 ){ /* copy data */
if( n_to_interpolate > 0 ){ /* end of gap? */
int j; float start_val, end_val;
end_val = get_end_val(source,control,i);
/* if we haven't seen any good values yet,
* just fill in with the first good value.
*/
if( start_index < 0 ) start_val=end_val;
/*
* Otherwise, use a starting value which
* is an average of the last N good values...
*/
else start_val = get_start_val(source,control,start_index);
#ifdef DEBUG
if( debug ){
sprintf(ERROR_STRING,
"vinterp: %d values at index %d (start_i = %d), start = %f end = %f",
n_to_interpolate,i,start_index,start_val,end_val);
advise(ERROR_STRING);
}
#endif /* DEBUG */
for(j=0;j<n_to_interpolate;j++){
float factor;
factor=((float)j+1)/((float)n_to_interpolate+1);
*interp_dest = factor*end_val
+ (1-factor)*start_val;
interp_dest += OBJ_PXL_INC(target);
}
}
*to = *fr;
start_index = i; /* always the last good one seen */
n_to_interpolate=0;
} else { /* control is 0 */
if( n_to_interpolate == 0 ) /* remember start */
interp_dest = to;
n_to_interpolate++;
}
to += OBJ_PXL_INC(target);
c += OBJ_PXL_INC(control);
fr += OBJ_PXL_INC(source);
}
if( n_to_interpolate > 0 ){ /* fill in at end? */
float fill_val;
int j;
if( start_index < 0 ){
warn("vinterp: no valid data!?");
fill_val=0.0;
} else fill_val = get_start_val(source,control,start_index);
for(j=0;j<n_to_interpolate;j++){
*interp_dest = fill_val;
interp_dest += OBJ_PXL_INC(target);
}
}
}
static COMMAND_FUNC( do_xyzplot )
{
Data_Obj *dp;
dimension_t i,j;
std_type x,y,z,*p;
std_type lastx,lasty;
#define DOWN 1
#define UP 2
int pen_state=UP;
dp=PICK_OBJ("data vector");
if( dp==NO_OBJ ) return;
INSIST_RAM_OBJ(dp,"xyzplot")
if( bad_plot_vec(QSP_ARG dp,3,"xyzplot") ) return;
for(i=0; i<OBJ_ROWS(dp); i++) {
p = (std_type *) OBJ_DATA_PTR(dp);
p += i*OBJ_ROW_INC(dp);
for(j=0; j<OBJ_COLS(dp); j++) {
x = *p;
y = *(p + OBJ_COMP_INC(dp));
z = *(p + 2*OBJ_COMP_INC(dp));
p += OBJ_PXL_INC(dp);
/* removed else so that a single column data set will plot the pt */
if( z < 0 ) {
lastx = x;
lasty = y;
pen_state = UP;
}
if( z >= 0 ) { /* draw this point */
/* THis is a hack for plotting lat/long without
* wrap-around... BUG
*/
if( pen_state == UP ) {
xp_fmove(x,y);
}
if( lat_long_hack ) {
if( fabs(lastx-x) < 180 &&
fabs(lasty-y) < 180 ) {
xp_fcont(x,y);
lastx=x;
lasty=y;
} else {
xp_move((int)x,(int)y);
lastx=x;
lasty=y;
}
} else {
xp_fcont(x,y);
lastx=x;
lasty=y;
}
pen_state=DOWN;
}
}
}
}
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);
}
}
}
