void muste_statmsf(char *argv)
{
int i;
// RS Variable init
prind=1;
sum=NULL;
sum2=NULL;
f=NULL;
w=NULL;
f2=NULL;
X=NULL;
rlabX=NULL;
clabX=NULL;
T=NULL;
rlabT=NULL;
clabT=NULL;
v=NULL;
s_init(argv);
typeT=lrT=lcT=0; // to avoid warnings from compiler
// specs=spec_msf;
if (g<2)
{
init_remarks();
rem_pr("STATMSF <Survo_data>,<output_line> ");
rem_pr(" LIMITS=<low1>,<up1>,<up2>,...");
rem_pr("computes means, standard deviations, and frequency distributions");
rem_pr("of active variables. Cases can be limited by IND and CASES specifications.");
rem_pr("The frequencies are computed according to a classification given by the");
rem_pr("LIMITS specification where <low1> is the lower limit of the first class 1");
rem_pr("and <up1>,<up2>,... are the upper limits of the classes 1,2,...");
rem_pr("The default setting is LIMITS=0,1,2,3,4,5 .");
wait_remarks(1);
rem_pr("STATMSF <Survo_data> / TRESHOLDS=<matrix_file>");
rem_pr("where <matrix_file> is of the form");
rem_pr("row label 1st column");
rem_pr("variable_1 treshold_value_1");
rem_pr("variable_2 treshold_value_2");
rem_pr("...");
rem_pr("computes relative frequencies of values exceeding treshold values");
rem_pr("given as the first column of <matrix_file> for variables given");
rem_pr("as row labels in <matrix_file> for active observations");
rem_pr("in <Survo_data>.");
rem_pr("The results are saved in a matrix file TAILFREQ.M .");
wait_remarks(2);
return;
}
results_line=0;
i=spec_init(r1+r-1); if (i<0) return;
i=spfind("PRIND"); if (i>=0) prind=atoi(spb[i]);
i=spfind("TRESHOLDS");
if (i>=0) { pvalues(i); return; }
if (g>2)
{
results_line=edline2(word[2],1,1);
if (results_line==0) return;
}
i=data_read_open(word[1],&d); if (i<0) return;
i=spfind("LIMITS");
if (i<0)
{
n_class=5; limit[0]=0;
for (i=1; i<=5; ++i) limit[i]=i;
}
else
{
strcpy(x,spb[i]);
n_class=split(x,osa,MAXCLASS);
for (i=0; i<n_class; ++i) limit[i]=atof(osa[i]);
--n_class;
}
i=mask(&d); if (i<0) return;
weight_variable=activated(&d,'W');
i=m_test_scaletypes(); if (i<0) return;
i=conditions(&d); if (i<0) return; /* permitted only once */
m=d.m_act;
if (m==0)
{
sur_print("\nNo active (acceptable) variables!");
WAIT; return;
}
i=m_space_allocation(); if (i<0) return;
// i=optdim_d(); if (i && i<d.m) err(0);
// i=optdim_o(); if (i && (long)i<d.n) err(0);
compute_sums();
m_printout();
data_close(&d);
s_end(argv);
}
/* DIFF: was gto_fit_rxyscale */
static int
geo_fit_linear(
geomap_fit_t* const fit,
surface_t* const sx1,
surface_t* const sy1,
const size_t ncoord,
const coord_t* const input,
const coord_t* const ref,
const double* const weights,
double* const residual_x,
double* const residual_y,
stimage_error_t* error) {
bbox_t bbox;
double sw = 0.0;
coord_t sr = {0.0, 0.0};
coord_t si = {0.0, 0.0};
coord_t r0 = {0.0, 0.0};
coord_t i0 = {0.0, 0.0};
double sxrxr = 0.0;
double syryr = 0.0;
double syrxi = 0.0;
double sxryi = 0.0;
double sxrxi = 0.0;
double syryi = 0.0;
double num = 0.0;
double denom = 0.0;
double theta = 0.0;
double ctheta = 0.0;
double stheta = 0.0;
coord_t cthetac = {0.0, 0.0};
coord_t sthetac = {0.0, 0.0};
double xmag = 0.0;
double ymag = 0.0;
size_t i = 0;
int status = 1;
assert(fit);
assert(sx1);
assert(sy1);
assert(input);
assert(ref);
assert(weights);
assert(residual_x);
assert(residual_y);
surface_free(sx1);
surface_free(sy1);
bbox_copy(&fit->bbox, &bbox);
bbox_make_nonsingular(&bbox);
/* Compute the sums required to determine the offsets */
compute_sums(ncoord, input, ref, weights, &sw, &si, &sr);
if (sw < 3.0) {
if (fit->projection == geomap_proj_none) {
stimage_error_set_message(
error, "Too few data points for X and Y fits.");
} else {
stimage_error_set_message(
error, "Too few data points for XI and ETA fits.");
}
goto exit;
}
r0.x = sr.x / sw;
r0.y = sr.y / sw;
i0.x = si.x / sw;
i0.y = si.y / sw;
for (i = 0; i < ncoord; ++i) {
sxrxr += weights[i] * (ref[i].x - r0.x) * (ref[i].x - r0.x);
syryr += weights[i] * (ref[i].y - r0.y) * (ref[i].y - r0.y);
syrxi += weights[i] * (ref[i].y - r0.y) * (input[i].x - i0.x);
sxryi += weights[i] * (ref[i].x - r0.x) * (input[i].y - i0.y);
sxrxi += weights[i] * (ref[i].x - r0.x) * (input[i].x - i0.x);
syryi += weights[i] * (ref[i].y - r0.y) * (input[i].y - i0.y);
}
/* Compute the rotation angle */
num = 2.0 * (sxrxr * syrxi * syryi - syryr * sxrxi * sxryi);
denom = syryr * (sxrxi - sxryi) * (sxrxi + sxryi) - \
sxrxr * (syrxi + syryi) * (syrxi - syryi);
if (double_approx_equal(num, 0.0) && double_approx_equal(denom, 0.0)) {
theta = 0.0;
} else {
theta = atan2(num, denom) / 2.0;
if (theta < 0.0) {
theta += M_PI * 2.0;
}
}
ctheta = cos(theta);
stheta = sin(theta);
/* Compute the X magnification factor */
num = sxrxi * ctheta - sxryi * stheta;
denom = sxrxr;
if (denom <= 0.0) {
xmag = 1.0;
} else {
xmag = num / denom;
}
/* Compute the Y magnification factor */
num = syrxi * stheta + syryi * ctheta;
denom = syryr;
if (denom <= 0.0) {
ymag = 1.0;
} else {
ymag = num / denom;
}
/* Compute the polynomial coefficients */
cthetac.x = xmag * ctheta;
sthetac.x = ymag * stheta;
sthetac.y = xmag * stheta;
cthetac.x = ymag * ctheta;
/* Compute the X and Y fit coefficients */
if (compute_surface_coefficients(
fit->function, &bbox, &i0, &r0, &cthetac, &sthetac, sx1, sy1,
error)) goto exit;
/* Compute the residuals */
if (compute_residuals(
sx1, sy1, ncoord, input, ref, residual_x, residual_y,
error)) goto exit;
/* Compute the number of zero-weighted points */
fit->n_zero_weighted = count_zero_weighted(ncoord, weights);
/* Compute the rms of the x and y fits */
compute_rms(
ncoord, weights, residual_x, residual_y, &fit->xrms, &fit->yrms);
fit->ncoord = ncoord;
status = 0;
exit:
return status;
}
