/*
try to find a 8.3 name in the cache, and if found then
replace the string with the original long name.
*/
static bool lookup_name_from_8_3(TALLOC_CTX *ctx,
const char *name,
char **pp_out, /* talloced on the given context. */
const struct share_params *p)
{
unsigned int hash, multiplier;
unsigned int i;
char *prefix;
char extension[4];
*pp_out = NULL;
/* make sure that this is a mangled name from this cache */
if (!is_mangled(name, p)) {
M_DEBUG(10,("lookup_name_from_8_3: %s -> not mangled\n", name));
return False;
}
/* we need to extract the hash from the 8.3 name */
hash = base_reverse[(unsigned char)name[7]];
for (multiplier=36, i=5;i>=mangle_prefix;i--) {
unsigned int v = base_reverse[(unsigned char)name[i]];
hash += multiplier * v;
multiplier *= 36;
}
/* now look in the prefix cache for that hash */
prefix = cache_lookup(ctx, hash);
if (!prefix) {
M_DEBUG(10,("lookup_name_from_8_3: %s -> %08X -> not found\n",
name, hash));
return False;
}
/* we found it - construct the full name */
if (name[8] == '.') {
strncpy(extension, name+9, 3);
extension[3] = 0;
} else {
extension[0] = 0;
}
if (extension[0]) {
M_DEBUG(10,("lookup_name_from_8_3: %s -> %s.%s\n",
name, prefix, extension));
*pp_out = talloc_asprintf(ctx, "%s.%s", prefix, extension);
} else {
M_DEBUG(10,("lookup_name_from_8_3: %s -> %s\n", name, prefix));
*pp_out = talloc_strdup(ctx, prefix);
}
TALLOC_FREE(prefix);
if (!*pp_out) {
M_DEBUG(0,("talloc_fail"));
return False;
}
return True;
}
bool
generate_default_ids(std::vector<std::string> & IDs)
{
// this leave one CPU to attend to everything else but our work
int cpu_cnt = get_available_cpu_count();
if (1 > cpu_cnt) {
M_NOTICE("CPU count does not meet minimum requirements");
return false;
}
M_DEBUG("cpu_cnt = %d\n", cpu_cnt);
char host_name[MAXHOSTNAMELEN] = { '\0' };
if (gethostname(host_name, sizeof(host_name))) {
M_ERROR("could not get host name %s", strerror(errno));
return false;
}
char domain_name[MAXHOSTNAMELEN] = { '\0' };
if (getdomainname(domain_name, sizeof(domain_name))) {
M_ERROR("could not get domain name %s", strerror(errno));
return false;
}
IDs.clear();
std::string id;
for (int n = 0; n < cpu_cnt; ++n) {
id = host_name;
id += ".";
id += domain_name;
id += n;
IDs.push_back(id);
}
return true;
}
/*
determine if a string is possibly in a mangled format, ignoring
case
In this algorithm, mangled names use only pure ascii characters (no
multi-byte) so we can avoid doing a UCS2 conversion
*/
static bool is_mangled_component(struct pvfs_mangle_context *ctx,
const char *name, size_t len)
{
unsigned int i;
M_DEBUG(10,("is_mangled_component %s (len %u) ?\n", name, (unsigned int)len));
/* check the length */
if (len > 12 || len < 8)
return false;
/* the best distinguishing characteristic is the ~ */
if (name[6] != '~')
return false;
/* check extension */
if (len > 8) {
if (name[8] != '.')
return false;
for (i=9; name[i] && i < len; i++) {
if (! FLAG_CHECK(name[i], FLAG_ASCII)) {
return false;
}
}
}
/* check lead characters */
for (i=0;i<ctx->mangle_prefix;i++) {
if (! FLAG_CHECK(name[i], FLAG_ASCII)) {
return false;
}
}
/* check rest of hash */
if (! FLAG_CHECK(name[7], FLAG_BASECHAR)) {
return false;
}
for (i=ctx->mangle_prefix;i<6;i++) {
if (! FLAG_CHECK(name[i], FLAG_BASECHAR)) {
return false;
}
}
M_DEBUG(10,("is_mangled_component %s (len %u) -> yes\n", name, (unsigned int)len));
return true;
}
/*
try to find a 8.3 name in the cache, and if found then
replace the string with the original long name.
*/
static BOOL check_cache(char *name, size_t maxlen)
{
u32 hash, multiplier;
unsigned int i;
const char *prefix;
char extension[4];
/* make sure that this is a mangled name from this cache */
if (!is_mangled(name)) {
M_DEBUG(10,("check_cache: %s -> not mangled\n", name));
return False;
}
/* we need to extract the hash from the 8.3 name */
hash = base_reverse[(unsigned char)name[7]];
for (multiplier=36, i=5;i>=mangle_prefix;i--) {
u32 v = base_reverse[(unsigned char)name[i]];
hash += multiplier * v;
multiplier *= 36;
}
/* now look in the prefix cache for that hash */
prefix = cache_lookup(hash);
if (!prefix) {
M_DEBUG(10,("check_cache: %s -> %08X -> not found\n", name, hash));
return False;
}
/* we found it - construct the full name */
if (name[8] == '.') {
strncpy(extension, name+9, 3);
extension[3] = 0;
} else {
extension[0] = 0;
}
if (extension[0]) {
M_DEBUG(10,("check_cache: %s -> %s.%s\n", name, prefix, extension));
slprintf(name, maxlen, "%s.%s", prefix, extension);
} else {
M_DEBUG(10,("check_cache: %s -> %s\n", name, prefix));
safe_strcpy(name, prefix, maxlen);
}
return True;
}
/*
try to find a 8.3 name in the cache, and if found then
return the original long name.
*/
static char *check_cache(struct pvfs_mangle_context *ctx,
TALLOC_CTX *mem_ctx, const char *name)
{
uint32_t hash, multiplier;
unsigned int i;
const char *prefix;
char extension[4];
/* make sure that this is a mangled name from this cache */
if (!is_mangled(ctx, name)) {
M_DEBUG(10,("check_cache: %s -> not mangled\n", name));
return NULL;
}
/* we need to extract the hash from the 8.3 name */
hash = ctx->base_reverse[(unsigned char)name[7]];
for (multiplier=36, i=5;i>=ctx->mangle_prefix;i--) {
uint32_t v = ctx->base_reverse[(unsigned char)name[i]];
hash += multiplier * v;
multiplier *= 36;
}
/* now look in the prefix cache for that hash */
prefix = cache_lookup(ctx, hash);
if (!prefix) {
M_DEBUG(10,("check_cache: %s -> %08X -> not found\n", name, hash));
return NULL;
}
/* we found it - construct the full name */
if (name[8] == '.') {
strncpy(extension, name+9, 3);
extension[3] = 0;
} else {
extension[0] = 0;
}
if (extension[0]) {
return talloc_asprintf(mem_ctx, "%s.%s", prefix, extension);
}
return talloc_strdup(mem_ctx, prefix);
}
static void
_rpc_thread(void* param)
{
int tid;
M_DEBUG("%s\n", __func__);
M_PRINTF("RPC thread running\n");
tid = GetThreadId();
sceSifSetRpcQueue(&rpc_queue, tid);
sceSifRegisterRpc(&rpc_server, SMAP_BIND_RPC_ID, (void *)_rpc_cmd_handler, _rpc_buffer, 0, 0, &rpc_queue);
sceSifRpcLoop(&rpc_queue);
}
/*
determine if a string is possibly in a mangled format, ignoring
case
In this algorithm, mangled names use only pure ascii characters (no
multi-byte) so we can avoid doing a UCS2 conversion
NOTE! This interface must be able to handle a path with unix
directory separators. It should return true if any component is
mangled
*/
static bool is_mangled(struct pvfs_mangle_context *ctx, const char *name)
{
const char *p;
const char *s;
M_DEBUG(10,("is_mangled %s ?\n", name));
for (s=name; (p=strchr(s, '/')); s=p+1) {
if (is_mangled_component(ctx, s, PTR_DIFF(p, s))) {
return true;
}
}
/* and the last part ... */
return is_mangled_component(ctx, s, strlen(s));
}
/*
determine if a string is possibly in a mangled format, ignoring
case
In this algorithm, mangled names use only pure ascii characters (no
multi-byte) so we can avoid doing a UCS2 conversion
NOTE! This interface must be able to handle a path with unix
directory separators. It should return true if any component is
mangled
*/
static BOOL is_mangled(const char *name)
{
const char *p;
const char *s;
M_DEBUG(10,("is_mangled %s ?\n", name));
for (s=name; (p=strchr(s, '/')); s=p+1) {
if (is_mangled_component(s, PTR_DIFF(p, s))) {
return True;
}
}
/* and the last part ... */
return is_mangled_component(s,strlen(s));
}
/*
the main forward mapping function, which converts a long filename to
a 8.3 name
if need83 is not set then we only do the mangling if the name is illegal
as a long name
if cache83 is not set then we don't cache the result
return NULL if we don't need to do any conversion
*/
static char *name_map(struct pvfs_mangle_context *ctx,
const char *name, bool need83, bool cache83)
{
char *dot_p;
char lead_chars[7];
char extension[4];
unsigned int extension_length, i;
unsigned int prefix_len;
uint32_t hash, v;
char *new_name;
const char *basechars = MANGLE_BASECHARS;
/* reserved names are handled specially */
if (!is_reserved_name(ctx, name)) {
/* if the name is already a valid 8.3 name then we don't need to
do anything */
if (is_8_3(ctx, name, false, false)) {
return NULL;
}
/* if the caller doesn't strictly need 8.3 then just check for illegal
filenames */
if (!need83 && is_legal_name(ctx, name)) {
return NULL;
}
}
/* find the '.' if any */
dot_p = strrchr(name, '.');
if (dot_p) {
/* if the extension contains any illegal characters or
is too long or zero length then we treat it as part
of the prefix */
for (i=0; i<4 && dot_p[i+1]; i++) {
if (! FLAG_CHECK(dot_p[i+1], FLAG_ASCII)) {
dot_p = NULL;
break;
}
}
if (i == 0 || i == 4) dot_p = NULL;
}
/* the leading characters in the mangled name is taken from
the first characters of the name, if they are ascii otherwise
'_' is used
*/
for (i=0;i<ctx->mangle_prefix && name[i];i++) {
lead_chars[i] = name[i];
if (! FLAG_CHECK(lead_chars[i], FLAG_ASCII)) {
lead_chars[i] = '_';
}
lead_chars[i] = toupper((unsigned char)lead_chars[i]);
}
for (;i<ctx->mangle_prefix;i++) {
lead_chars[i] = '_';
}
/* the prefix is anything up to the first dot */
if (dot_p) {
prefix_len = PTR_DIFF(dot_p, name);
} else {
prefix_len = strlen(name);
}
/* the extension of the mangled name is taken from the first 3
ascii chars after the dot */
extension_length = 0;
if (dot_p) {
for (i=1; extension_length < 3 && dot_p[i]; i++) {
unsigned char c = dot_p[i];
if (FLAG_CHECK(c, FLAG_ASCII)) {
extension[extension_length++] = toupper(c);
}
}
}
/* find the hash for this prefix */
v = hash = mangle_hash(ctx, name, prefix_len);
new_name = talloc_array(ctx, char, 13);
if (new_name == NULL) {
return NULL;
}
/* now form the mangled name. */
for (i=0;i<ctx->mangle_prefix;i++) {
new_name[i] = lead_chars[i];
}
new_name[7] = basechars[v % 36];
new_name[6] = '~';
for (i=5; i>=ctx->mangle_prefix; i--) {
v = v / 36;
new_name[i] = basechars[v % 36];
}
/* add the extension */
if (extension_length) {
new_name[8] = '.';
memcpy(&new_name[9], extension, extension_length);
new_name[9+extension_length] = 0;
} else {
new_name[8] = 0;
}
if (cache83) {
/* put it in the cache */
cache_insert(ctx, name, prefix_len, hash);
}
M_DEBUG(10,("name_map: %s -> %08X -> %s (cache=%d)\n",
name, hash, new_name, cache83));
return new_name;
}
/*
the main forward mapping function, which converts a long filename to
a 8.3 name
if need83 is not set then we only do the mangling if the name is illegal
as a long name
if cache83 is not set then we don't cache the result
the name parameter must be able to hold 13 bytes
*/
static void name_map(fstring name, BOOL need83, BOOL cache83, int default_case)
{
char *dot_p;
char lead_chars[7];
char extension[4];
unsigned int extension_length, i;
unsigned int prefix_len;
u32 hash, v;
char new_name[13];
/* reserved names are handled specially */
if (!is_reserved_name(name)) {
/* if the name is already a valid 8.3 name then we don't need to
do anything */
if (is_8_3(name, False, False)) {
return;
}
/* if the caller doesn't strictly need 8.3 then just check for illegal
filenames */
if (!need83 && is_legal_name(name)) {
return;
}
}
/* find the '.' if any */
dot_p = strrchr(name, '.');
if (dot_p) {
/* if the extension contains any illegal characters or
is too long or zero length then we treat it as part
of the prefix */
for (i=0; i<4 && dot_p[i+1]; i++) {
if (! FLAG_CHECK(dot_p[i+1], FLAG_ASCII)) {
dot_p = NULL;
break;
}
}
if (i == 0 || i == 4) dot_p = NULL;
}
/* the leading characters in the mangled name is taken from
the first characters of the name, if they are ascii otherwise
'_' is used
*/
for (i=0;i<mangle_prefix && name[i];i++) {
lead_chars[i] = name[i];
if (! FLAG_CHECK(lead_chars[i], FLAG_ASCII)) {
lead_chars[i] = '_';
}
lead_chars[i] = toupper(lead_chars[i]);
}
for (;i<mangle_prefix;i++) {
lead_chars[i] = '_';
}
/* the prefix is anything up to the first dot */
if (dot_p) {
prefix_len = PTR_DIFF(dot_p, name);
} else {
prefix_len = strlen(name);
}
/* the extension of the mangled name is taken from the first 3
ascii chars after the dot */
extension_length = 0;
if (dot_p) {
for (i=1; extension_length < 3 && dot_p[i]; i++) {
char c = dot_p[i];
if (FLAG_CHECK(c, FLAG_ASCII)) {
extension[extension_length++] = toupper(c);
}
}
}
/* find the hash for this prefix */
v = hash = mangle_hash(name, prefix_len);
/* now form the mangled name. */
for (i=0;i<mangle_prefix;i++) {
new_name[i] = lead_chars[i];
}
new_name[7] = base_forward(v % 36);
new_name[6] = '~';
for (i=5; i>=mangle_prefix; i--) {
v = v / 36;
new_name[i] = base_forward(v % 36);
}
/* add the extension */
if (extension_length) {
new_name[8] = '.';
memcpy(&new_name[9], extension, extension_length);
new_name[9+extension_length] = 0;
} else {
new_name[8] = 0;
}
if (cache83) {
/* put it in the cache */
cache_insert(name, prefix_len, hash);
}
M_DEBUG(10,("name_map: %s -> %08X -> %s (cache=%d)\n",
name, hash, new_name, cache83));
/* and overwrite the old name */
fstrcpy(name, new_name);
/* all done, we've managed to mangle it */
}
/*
* n_vars is the number of variables to be considered,
* d is the data array of variables d[0],...,d[n_vars-1],
* pred determines which estimate is required: BLUE, BLUP, or BLP
*/
void gls(DATA **d /* pointer to DATA array */,
int n_vars, /* length of DATA array (to consider) */
enum GLS_WHAT pred, /* what type of prediction is requested */
DPOINT *where, /* prediction location */
double *est /* output: array that holds the predicted values and variances */)
{
GLM *glm = NULL; /* to be copied to/from d */
static MAT *X0 = MNULL, *C0 = MNULL, *MSPE = MNULL, *CinvC0 = MNULL,
*Tmp1 = MNULL, *Tmp2 = MNULL, *Tmp3 = MNULL, *R = MNULL;
static VEC *blup = VNULL, *tmpa = VNULL, *tmpb = VNULL;
PERM *piv = PNULL;
volatile unsigned int i, rows_C;
unsigned int j, k, l = 0, row, col, start_i, start_j, start_X, global,
one_nbh_empty;
VARIOGRAM *v = NULL;
static enum GLS_WHAT last_pred = GLS_INIT; /* the initial value */
double c_value, *X_ori;
int info;
if (d == NULL) { /* clean up */
if (X0 != MNULL) M_FREE(X0);
if (C0 != MNULL) M_FREE(C0);
if (MSPE != MNULL) M_FREE(MSPE);
if (CinvC0 != MNULL) M_FREE(CinvC0);
if (Tmp1 != MNULL) M_FREE(Tmp1);
if (Tmp2 != MNULL) M_FREE(Tmp2);
if (Tmp3 != MNULL) M_FREE(Tmp3);
if (R != MNULL) M_FREE(R);
if (blup != VNULL) V_FREE(blup);
if (tmpa != VNULL) V_FREE(tmpa);
if (tmpb != VNULL) V_FREE(tmpb);
last_pred = GLS_INIT;
return;
}
if (DEBUG_COV) {
printlog("we're at %s X: %g Y: %g Z: %g\n",
IS_BLOCK(where) ? "block" : "point",
where->x, where->y, where->z);
}
if (pred != UPDATE) /* it right away: */
last_pred = pred;
assert(last_pred != GLS_INIT);
if (d[0]->glm == NULL) { /* allocate and initialize: */
glm = new_glm();
d[0]->glm = (void *) glm;
} else
glm = (GLM *) d[0]->glm;
glm->mu0 = v_resize(glm->mu0, n_vars);
MSPE = m_resize(MSPE, n_vars, n_vars);
if (pred == GLS_BLP || UPDATE_BLP) {
X_ori = where->X;
for (i = 0; i < n_vars; i++) { /* mu(0) */
glm->mu0->ve[i] = calc_mu(d[i], where);
blup = v_copy(glm->mu0, v_resize(blup, glm->mu0->dim));
where->X += d[i]->n_X; /* shift to next x0 entry */
}
where->X = X_ori; /* ... and set back */
for (i = 0; i < n_vars; i++) { /* Cij(0,0): */
for (j = 0; j <= i; j++) {
v = get_vgm(LTI(d[i]->id,d[j]->id));
ME(MSPE, i, j) = ME(MSPE, j, i) = COVARIANCE0(v, where, where, d[j]->pp_norm2);
}
}
fill_est(NULL, blup, MSPE, n_vars, est); /* in case of empty neighbourhood */
}
/* xxx */
/*
logprint_variogram(v, 1);
*/
/*
* selection dependent problem dimensions:
*/
for (i = rows_C = 0, one_nbh_empty = 0; i < n_vars; i++) {
rows_C += d[i]->n_sel;
if (d[i]->n_sel == 0)
one_nbh_empty = 1;
}
if (rows_C == 0 /* all selection lists empty */
|| one_nbh_empty == 1) { /* one selection list empty */
if (pred == GLS_BLP || UPDATE_BLP)
debug_result(blup, MSPE, pred);
return;
}
for (i = 0, global = 1; i < n_vars && global; i++)
global = (d[i]->sel == d[i]->list
&& d[i]->n_list == d[i]->n_original
&& d[i]->n_list == d[i]->n_sel);
/*
* global things: enter whenever (a) first time, (b) local selections or
* (c) the size of the problem grew since the last call (e.g. simulation)
*/
if (glm->C == NULL || !global || rows_C > glm->C->m) {
/*
* fill y:
*/
glm->y = get_y(d, glm->y, n_vars);
if (pred != UPDATE) {
glm->C = m_resize(glm->C, rows_C, rows_C);
if (gl_choleski == 0) /* use LDL' decomposition, allocate piv: */
piv = px_resize(piv, rows_C);
m_zero(glm->C);
glm->X = get_X(d, glm->X, n_vars);
M_DEBUG(glm->X, "X");
glm->CinvX = m_resize(glm->CinvX, rows_C, glm->X->n);
glm->XCinvX = m_resize(glm->XCinvX, glm->X->n, glm->X->n);
glm->beta = v_resize(glm->beta, glm->X->n);
for (i = start_X = start_i = 0; i < n_vars; i++) { /* row var */
/* fill C, mu: */
for (j = start_j = 0; j <= i; j++) { /* col var */
v = get_vgm(LTI(d[i]->id,d[j]->id));
for (k = 0; k < d[i]->n_sel; k++) { /* rows */
row = start_i + k;
for (l = 0, col = start_j; col <= row && l < d[j]->n_sel; l++, col++) {
if (pred == GLS_BLUP)
c_value = GCV(v, d[i]->sel[k], d[j]->sel[l]);
else
c_value = COVARIANCE(v, d[i]->sel[k], d[j]->sel[l]);
/* on the diagonal, if necessary, add measurement error variance */
if (d[i]->colnvariance && i == j && k == l)
c_value += d[i]->sel[k]->variance;
ME(glm->C, col, row) = c_value; /* fill upper */
if (col != row)
ME(glm->C, row, col) = c_value; /* fill all */
} /* for l */
} /* for k */
start_j += d[j]->n_sel;
} /* for j */
start_i += d[i]->n_sel;
if (d[i]->n_sel > 0)
start_X += d[i]->n_X - d[i]->n_merge;
} /* for i */
/*
if (d[0]->colnvmu)
glm->C = convert_vmuC(glm->C, d[0]);
*/
if (d[0]->variance_fn) {
glm->mu = get_mu(glm->mu, glm->y, d, n_vars);
convert_C(glm->C, glm->mu, d[0]->variance_fn);
}
if (DEBUG_COV && pred == GLS_BLUP)
printlog("[using generalized covariances: max_val - semivariance()]");
M_DEBUG(glm->C, "Covariances (x_i, x_j) matrix C (upper triangle)");
/*
* factorize C:
*/
CHfactor(glm->C, piv, &info);
if (info != 0) { /* singular: */
pr_warning("Covariance matrix singular at location [%g,%g,%g]: skipping...",
where->x, where->y, where->z);
m_free(glm->C);
glm->C = MNULL; /* assure re-entrance if global */
P_FREE(piv);
return;
}
if (piv == NULL)
M_DEBUG(glm->C, "glm->C, Choleski decomposed:")
else
M_DEBUG(glm->C, "glm->C, LDL' decomposed:")
} /* if (pred != UPDATE) */
/*
the main forward mapping function, which converts a long filename to
a 8.3 name
if cache83 is not set then we don't cache the result
*/
static bool hash2_name_to_8_3(const char *name,
char new_name[13],
bool cache83,
int default_case,
const struct share_params *p)
{
char *dot_p;
char lead_chars[7];
char extension[4];
unsigned int extension_length, i;
unsigned int prefix_len;
unsigned int hash, v;
/* reserved names are handled specially */
if (!is_reserved_name(name)) {
/* if the name is already a valid 8.3 name then we don't need to
* change anything */
if (is_legal_name(name) && is_8_3(name, False, False, p)) {
safe_strcpy(new_name, name, 12);
return True;
}
}
/* find the '.' if any */
dot_p = strrchr(name, '.');
if (dot_p) {
/* if the extension contains any illegal characters or
is too long or zero length then we treat it as part
of the prefix */
for (i=0; i<4 && dot_p[i+1]; i++) {
if (! FLAG_CHECK(dot_p[i+1], FLAG_ASCII)) {
dot_p = NULL;
break;
}
}
if (i == 0 || i == 4) {
dot_p = NULL;
}
}
/* the leading characters in the mangled name is taken from
the first characters of the name, if they are ascii otherwise
'_' is used
*/
for (i=0;i<mangle_prefix && name[i];i++) {
lead_chars[i] = name[i];
if (! FLAG_CHECK(lead_chars[i], FLAG_ASCII)) {
lead_chars[i] = '_';
}
lead_chars[i] = toupper_m(lead_chars[i]);
}
for (;i<mangle_prefix;i++) {
lead_chars[i] = '_';
}
/* the prefix is anything up to the first dot */
if (dot_p) {
prefix_len = PTR_DIFF(dot_p, name);
} else {
prefix_len = strlen(name);
}
/* the extension of the mangled name is taken from the first 3
ascii chars after the dot */
extension_length = 0;
if (dot_p) {
for (i=1; extension_length < 3 && dot_p[i]; i++) {
char c = dot_p[i];
if (FLAG_CHECK(c, FLAG_ASCII)) {
extension[extension_length++] =
toupper_m(c);
}
}
}
/* find the hash for this prefix */
v = hash = mangle_hash(name, prefix_len);
/* now form the mangled name. */
for (i=0;i<mangle_prefix;i++) {
new_name[i] = lead_chars[i];
}
new_name[7] = base_forward(v % 36);
new_name[6] = '~';
for (i=5; i>=mangle_prefix; i--) {
v = v / 36;
new_name[i] = base_forward(v % 36);
}
/* add the extension */
if (extension_length) {
new_name[8] = '.';
memcpy(&new_name[9], extension, extension_length);
new_name[9+extension_length] = 0;
} else {
new_name[8] = 0;
}
if (cache83) {
/* put it in the cache */
cache_insert(name, prefix_len, hash);
}
M_DEBUG(10,("hash2_name_to_8_3: %s -> %08X -> %s (cache=%d)\n",
name, hash, new_name, cache83));
return True;
}
/*
* n_vars is the number of variables to be considered,
* d is the data array of variables d[0],...,d[n_vars-1],
* pred determines which estimate is required: BLUE, BLUP, or BLP
*/
void gls(DATA **d /* pointer to DATA array */,
int n_vars, /* length of DATA array (to consider) */
enum GLS_WHAT pred, /* what type of prediction is requested */
DPOINT *where, /* prediction location */
double *est /* output: array that holds the predicted values and variances */)
{
GLM *glm = NULL; /* to be copied to/from d */
static MAT *X0 = MNULL, *C0 = MNULL, *MSPE = MNULL, *CinvC0 = MNULL,
*Tmp1 = MNULL, *Tmp2 = MNULL, *Tmp3, *R = MNULL;
static VEC *blup = VNULL, *tmpa = VNULL, *tmpb = VNULL;
volatile unsigned int i, rows_C;
unsigned int j, k, l = 0, row, col, start_i, start_j, start_X, global;
VARIOGRAM *v = NULL;
static enum GLS_WHAT last_pred = GLS_INIT; /* the initial value */
double c_value, *X_ori;
if (d == NULL) { /* clean up */
if (X0 != MNULL) M_FREE(X0);
if (C0 != MNULL) M_FREE(C0);
if (MSPE != MNULL) M_FREE(MSPE);
if (CinvC0 != MNULL) M_FREE(CinvC0);
if (Tmp1 != MNULL) M_FREE(Tmp1);
if (Tmp2 != MNULL) M_FREE(Tmp2);
if (Tmp3 != MNULL) M_FREE(Tmp3);
if (R != MNULL) M_FREE(R);
if (blup != VNULL) V_FREE(blup);
if (tmpa != VNULL) V_FREE(tmpa);
if (tmpb != VNULL) V_FREE(tmpb);
last_pred = GLS_INIT;
return;
}
#ifndef HAVE_SPARSE
if (gl_sparse) {
pr_warning("sparse matrices not supported: compile with --with-sparse");
gl_sparse = 0;
}
#endif
if (DEBUG_COV) {
printlog("we're at %s X: %g Y: %g Z: %g\n",
IS_BLOCK(where) ? "block" : "point",
where->x, where->y, where->z);
}
if (pred != UPDATE) /* it right away: */
last_pred = pred;
assert(last_pred != GLS_INIT);
if (d[0]->glm == NULL) { /* allocate and initialize: */
glm = new_glm();
d[0]->glm = (void *) glm;
} else
glm = (GLM *) d[0]->glm;
glm->mu0 = v_resize(glm->mu0, n_vars);
MSPE = m_resize(MSPE, n_vars, n_vars);
if (pred == GLS_BLP || UPDATE_BLP) {
X_ori = where->X;
for (i = 0; i < n_vars; i++) { /* mu(0) */
glm->mu0->ve[i] = calc_mu(d[i], where);
blup = v_copy(glm->mu0, v_resize(blup, glm->mu0->dim));
where->X += d[i]->n_X; /* shift to next x0 entry */
}
where->X = X_ori; /* ... and set back */
for (i = 0; i < n_vars; i++) { /* Cij(0,0): */
for (j = 0; j <= i; j++) {
v = get_vgm(LTI(d[i]->id,d[j]->id));
MSPE->me[i][j] = MSPE->me[j][i] = COVARIANCE0(v, where, where, d[j]->pp_norm2);
}
}
fill_est(NULL, blup, MSPE, n_vars, est); /* in case of empty neighbourhood */
}
/* xxx */
/*
logprint_variogram(v, 1);
*/
/*
* selection dependent problem dimensions:
*/
for (i = rows_C = 0; i < n_vars; i++)
rows_C += d[i]->n_sel;
if (rows_C == 0) { /* empty selection list(s) */
if (pred == GLS_BLP || UPDATE_BLP)
debug_result(blup, MSPE, pred);
return;
}
for (i = 0, global = 1; i < n_vars && global; i++)
global = (d[i]->sel == d[i]->list && d[i]->n_list == d[i]->n_original);
/*
* global things: enter whenever (a) first time, (b) local selections or
* (c) the size of the problem grew since the last call (e.g. simulation)
*/
if ((glm->C == NULL && glm->spC == NULL) || !global || rows_C > glm->C->m) {
/*
* fill y:
*/
glm->y = get_y(d, glm->y, n_vars);
if (pred != UPDATE) {
if (! gl_sparse) {
glm->C = m_resize(glm->C, rows_C, rows_C);
m_zero(glm->C);
}
#ifdef HAVE_SPARSE
else {
if (glm->C == NULL) {
glm->spC = sp_get(rows_C, rows_C, gl_sparse);
/* d->spLLT = spLLT = sp_get(rows_C, rows_C, gl_sparse); */
} else {
glm->spC = sp_resize(glm->spC, rows_C, rows_C);
/* d->spLLT = spLLT = sp_resize(spLLT, rows_C, rows_C); */
}
sp_zero(glm->spC);
}
#endif
glm->X = get_X(d, glm->X, n_vars);
M_DEBUG(glm->X, "X");
glm->CinvX = m_resize(glm->CinvX, rows_C, glm->X->n);
glm->XCinvX = m_resize(glm->XCinvX, glm->X->n, glm->X->n);
glm->beta = v_resize(glm->beta, glm->X->n);
for (i = start_X = start_i = 0; i < n_vars; i++) { /* row var */
/* fill C, mu: */
for (j = start_j = 0; j <= i; j++) { /* col var */
v = get_vgm(LTI(d[i]->id,d[j]->id));
for (k = 0; k < d[i]->n_sel; k++) { /* rows */
row = start_i + k;
for (l = 0, col = start_j; col <= row && l < d[j]->n_sel; l++, col++) {
if (pred == GLS_BLUP)
c_value = GCV(v, d[i]->sel[k], d[j]->sel[l]);
else
c_value = COVARIANCE(v, d[i]->sel[k], d[j]->sel[l]);
/* on the diagonal, if necessary, add measurement error variance */
if (d[i]->colnvariance && i == j && k == l)
c_value += d[i]->sel[k]->variance;
if (! gl_sparse)
glm->C->me[row][col] = c_value;
#ifdef HAVE_SPARSE
else {
if (c_value != 0.0)
sp_set_val(glm->spC, row, col, c_value);
}
#endif
} /* for l */
} /* for k */
start_j += d[j]->n_sel;
} /* for j */
start_i += d[i]->n_sel;
if (d[i]->n_sel > 0)
start_X += d[i]->n_X - d[i]->n_merge;
} /* for i */
/*
if (d[0]->colnvmu)
glm->C = convert_vmuC(glm->C, d[0]);
*/
if (d[0]->variance_fn) {
glm->mu = get_mu(glm->mu, glm->y, d, n_vars);
convert_C(glm->C, glm->mu, d[0]->variance_fn);
}
if (DEBUG_COV && pred == GLS_BLUP)
printlog("[using generalized covariances: max_val - semivariance()]");
if (! gl_sparse) {
M_DEBUG(glm->C, "Covariances (x_i, x_j) matrix C (lower triangle only)");
}
#ifdef HAVE_SPARSE
else {
SM_DEBUG(glm->spC, "Covariances (x_i, x_j) sparse matrix C (lower triangle only)")
}
#endif
/* check for singular C: */
if (! gl_sparse && gl_cn_max > 0.0) {
for (i = 0; i < rows_C; i++) /* row */
for (j = i+1; j < rows_C; j++) /* col > row */
glm->C->me[i][j] = glm->C->me[j][i]; /* fill symmetric */
if (is_singular(glm->C, gl_cn_max)) {
pr_warning("Covariance matrix (nearly) singular at location [%g,%g,%g]: skipping...",
where->x, where->y, where->z);
m_free(glm->C); glm->C = MNULL; /* assure re-entrance if global */
return;
}
}
/*
* factorize C:
*/
if (! gl_sparse)
LDLfactor(glm->C);
#ifdef HAVE_SPARSE
else {
sp_compact(glm->spC, 0.0);
spCHfactor(glm->spC);
}
#endif
} /* if (pred != UPDATE) */
if (pred != GLS_BLP && !UPDATE_BLP) { /* C-1 X and X'C-1 X, beta */
/*
* calculate CinvX:
*/
tmpa = v_resize(tmpa, rows_C);
for (i = 0; i < glm->X->n; i++) {
tmpa = get_col(glm->X, i, tmpa);
if (! gl_sparse)
tmpb = LDLsolve(glm->C, tmpa, tmpb);
#ifdef HAVE_SPARSE
else
tmpb = spCHsolve(glm->spC, tmpa, tmpb);
#endif
set_col(glm->CinvX, i, tmpb);
}
/*
* calculate X'C-1 X:
*/
glm->XCinvX = mtrm_mlt(glm->X, glm->CinvX, glm->XCinvX); /* X'C-1 X */
M_DEBUG(glm->XCinvX, "X'C-1 X");
if (gl_cn_max > 0.0 && is_singular(glm->XCinvX, gl_cn_max)) {
pr_warning("X'C-1 X matrix (nearly) singular at location [%g,%g,%g]: skipping...",
where->x, where->y, where->z);
m_free(glm->C); glm->C = MNULL; /* assure re-entrance if global */
return;
}
m_inverse(glm->XCinvX, glm->XCinvX);
/*
* calculate beta:
*/
tmpa = vm_mlt(glm->CinvX, glm->y, tmpa); /* X'C-1 y */
glm->beta = vm_mlt(glm->XCinvX, tmpa, glm->beta); /* (X'C-1 X)-1 X'C-1 y */
V_DEBUG(glm->beta, "beta");
M_DEBUG(glm->XCinvX, "Cov(beta), (X'C-1 X)-1");
M_DEBUG(R = get_corr_mat(glm->XCinvX, R), "Corr(beta)");
} /* if pred != GLS_BLP */
} /* if redo the heavy part */
