//---------------------------------------------------------------------
// itm_wlist_record - 记录到发送列表
//---------------------------------------------------------------------
int itm_wlist_record(long hid)
{
static struct IVECTOR wlist;
static int inited = 0;
struct ITMD *itmd;
int retval;
if (inited == 0) {
iv_init(&wlist, NULL);
retval = iv_resize(&wlist, 8);
assert(retval == 0);
itm_wlist = (long*)wlist.data;
itm_wsize = 0;
inited = 1;
}
if ((itm_wsize * sizeof(long)) >= (unsigned long)wlist.length) {
retval = iv_resize(&wlist, wlist.length * 2);
assert(retval == 0);
itm_wlist = (long*)wlist.data;
}
itmd = itm_hid_itmd(hid);
if (itmd == NULL) return -1;
if (itmd->inwlist) return 1;
itmd->inwlist = 1;
itm_wlist[itm_wsize++] = hid;
return 0;
}
//---------------------------------------------------------------------
// itm_book_add
//---------------------------------------------------------------------
int itm_book_add(int category, int channel)
{
isize_t newsize;
short *book;
int booklen, i;
if (category < 0 || category > 511)
return -1;
newsize = (itm_booklen[category] + 1) * sizeof(short);
if (newsize > itm_bookv[category].length) {
if (iv_resize(&itm_bookv[category], newsize) != 0) {
return -3;
}
itm_book[category] = (short*)itm_bookv[category].data;
}
book = itm_book[category];
booklen = itm_booklen[category];
for (i = 0; i < booklen; i++) {
if (book[i] == channel)
return -4;
}
itm_book[category][booklen] = channel;
itm_booklen[category]++;
return 0;
}
//---------------------------------------------------------------------
// 增加 devpoll事件列表长度
//---------------------------------------------------------------------
static int apu_grow(PSTRUCT *ps, int size_fd, int size_chg)
{
int r;
if (size_fd >= 0) {
r = iv_resize(&ps->vresult, size_fd * sizeof(struct pollfd) * 2);
ps->mresult = (struct pollfd*)ps->vresult.data;
ps->max_fd = size_fd;
if (r) return -1;
}
if (size_chg >= 0) {
r = iv_resize(&ps->vchange, size_chg * sizeof(struct pollfd));
ps->mchange = (struct pollfd*)ps->vchange.data;
ps->max_chg= size_chg;
if (r) return -2;
}
return 0;
}
//---------------------------------------------------------------------
// itm_dsize
//---------------------------------------------------------------------
long itm_dsize(long length)
{
long size = length;
length = (size << 1) + size + 8192;
if (length >= (long)itm_datav.length) {
iv_resize(&itm_datav, length);
itm_data = (char*)itm_datav.data;
}
itm_crypt = itm_data + size;
itm_document = itm_crypt + size;
return 0;
}
//---------------------------------------------------------------------
// 改变描述列表大小
//---------------------------------------------------------------------
int apr_poll_fvresize(struct APOLLFV *fv, int size)
{
int retval = 0;
if (size <= (int)fv->count) return 0;
retval = iv_resize(&fv->vec, (int)sizeof(struct APOLLFD) * size);
if (retval) return -1;
fv->fds = (struct APOLLFD*)((void*)fv->vec.data);
fv->count = (unsigned long)size;
return 0;
}
extern int iv_resize_vars(int new_dim,...)
{
va_list ap;
int i=0;
IVEC **par;
va_start(ap, new_dim);
while (par = va_arg(ap,IVEC **)) { /* NULL ends the list*/
*par = iv_resize(*par,new_dim);
i++;
}
va_end(ap);
return i;
}
//---------------------------------------------------------------------
// itm_hostw
//---------------------------------------------------------------------
int itm_wchannel(int index, struct ITMD *itmd)
{
int retval, n, i;
if (itm_host == NULL) itm_hostc = -1;
if (index >= itm_hostc) {
n = (itm_hostc >= 0)? itm_hostc : 0;
itm_hostc = index + 1;
retval = iv_resize(&itm_hostv, itm_hostc * sizeof(struct ITMD*));
if (retval) return -1;
itm_host = (struct ITMD**)itm_hostv.data;
for (i = n; i < itm_hostc; i++) itm_host[i] = NULL;
}
itm_host[index] = itmd;
return 0;
}
//-------------------------------------------------------------------------
Prg_ASCEND::Prg_ASCEND()
{
_nvars = 0;
_nrels = 0;
_vars = NULL;
_rels = NULL;
_obj = NULL;
_safe_calc = TRUE;
_var_lb = v_resize(v_get(1), 0);
_var_ub = v_resize(v_get(1), 0);
_var_asc2hqp = iv_resize(iv_get(1), 0);
_derivatives = v_resize(v_get(1), 0);
_var_master_idxs = iv_resize(iv_get(1), 0);
_var_solver_idxs = iv_resize(iv_get(1), 0);
_Inf = 1e38; // todo: should be initialized from ASCEND data
_me_bounds = 0;
_m_bounds = 0;
memset(&_slv_status, 0, sizeof(slv_status_t));
// create interface elements
_ifList.append(new If_Int("prg_safe_calc", &_safe_calc));
slv_register_client(Prg_ASCEND::slv_register, NULL, NULL);
}
//--------------------------------------------------------------------------
void Hqp_IpRedSpBKP::init(const Hqp_Program *qp)
{
IVEC *degree, *neigh_start, *neighs;
SPMAT *QCTC;
SPROW *r1, *r2;
int i, j;
int len, dim;
Real sum;
_n = qp->c->dim;
_me = qp->b->dim;
_m = qp->d->dim;
dim = _n + _me;
// reallocations
_pivot = px_resize(_pivot, dim);
_blocks = px_resize(_blocks, dim);
_zw = v_resize(_zw, _m);
_scale = v_resize(_scale, _n);
_r12 = v_resize(_r12, dim);
_xy = v_resize(_xy, dim);
// store C' for further computations
// analyze structure of C'*C
_CT = sp_transp(qp->C, _CT);
sp_ones(_CT);
v_ones(_zw);
QCTC = sp_get(_n, _n, 10);
r1 = _CT->row;
for (i=0; i<_n; i++, r1++) {
r2 = r1;
for (j=i; j<_n; j++, r2++) {
sum = sprow_inprod(r1, _zw, r2);
if (sum != 0.0) {
sp_set_val(QCTC, i, j, sum);
if (i != j)
sp_set_val(QCTC, j, i, sum);
}
}
}
_CTC_degree = iv_resize(_CTC_degree, _n);
_CTC_neigh_start = iv_resize(_CTC_neigh_start, _n + 1);
_CTC_neighs = sp_rcm_scan(QCTC, SMNULL, SMNULL,
_CTC_degree, _CTC_neigh_start, _CTC_neighs);
// initialize structure of reduced qp
QCTC = sp_add(qp->Q, QCTC, QCTC);
// determine RCM ordering
degree = iv_get(dim);
neigh_start = iv_get(dim + 1);
neighs = sp_rcm_scan(QCTC, qp->A, SMNULL, degree, neigh_start, IVNULL);
_QP2J = sp_rcm_order(degree, neigh_start, neighs, _QP2J);
_sbw = sp_rcm_sbw(neigh_start, neighs, _QP2J);
_J2QP = px_inv(_QP2J, _J2QP);
iv_free(degree);
iv_free(neigh_start);
iv_free(neighs);
len = 1 + (int)(log((double)dim) / log(2.0));
sp_free(_J);
sp_free(_J_raw);
_J_raw = sp_get(dim, dim, len);
_J = SMNULL;
// fill up data (to allocate _J_raw)
sp_into_symsp(QCTC, -1.0, _J_raw, _QP2J, 0, 0);
spT_into_symsp(qp->A, 1.0, _J_raw, _QP2J, 0, _n);
sp_into_symsp(qp->A, 1.0, _J_raw, _QP2J, _n, 0);
sp_free(QCTC);
// prepare iterations
update(qp);
}
//-------------------------------------------------------------------------
void Prg_ASCEND::setup()
{
int n, me, m;
int i, j, row_idx, idx;
SPMAT *J;
int nincidences;
const struct var_variable **incidences;
// obtain ASCEND system
// todo: should check that system can be solved with HQP (e.g. no integers)
_nvars = slv_get_num_solvers_vars(_slv_system);
_vars = slv_get_solvers_var_list(_slv_system);
_nrels = slv_get_num_solvers_rels(_slv_system);
_rels = slv_get_solvers_rel_list(_slv_system);
_obj = slv_get_obj_relation(_slv_system);
// count number of optimization variables and bounds
_var_lb = v_resize(_var_lb, _nvars);
_var_ub = v_resize(_var_ub, _nvars);
_var_asc2hqp = iv_resize(_var_asc2hqp, _nvars);
_derivatives = v_resize(_derivatives, _nvars);
_var_master_idxs = iv_resize(_var_master_idxs, _nvars);
_var_solver_idxs = iv_resize(_var_solver_idxs, _nvars);
n = 0;
me = 0;
m = 0;
for (i = 0; i < _nvars; i++) {
_var_lb[i] = var_lower_bound(_vars[i]);
_var_ub[i] = var_upper_bound(_vars[i]);
/*
var_write_name(_slv_system, _vars[i], stderr);
fprintf(stderr, ":\t%i,\t%g,\t%g\n", var_fixed(_vars[i]),
_var_lb[i], _var_ub[i]);
*/
if (var_fixed(_vars[i])) {
_var_asc2hqp[i] = -1;
}
else {
_var_asc2hqp[i] = n++;
if (_var_lb[i] == _var_ub[i])
++me;
else {
if (_var_lb[i] > -_Inf)
++m;
if (_var_ub[i] < _Inf)
++m;
}
}
}
// consider bounds as linear constraints (i.e. no Jacobian update)
_me_bounds = me;
_m_bounds = m;
// count number of HQP constraints
for (i = 0; i < _nrels; i++) {
if (rel_equal(_rels[i]))
++me; // equality constraint
else
++m; // inequality constraint
}
// allocate QP approximation and optimization variables vector
_qp->resize(n, me, m);
_x = v_resize(_x, n);
// allocate sparse structure for bounds
// (write constant elements in Jacobians)
me = m = 0;
for (i = 0; i < _nvars; i++) {
idx = _var_asc2hqp[i];
if (idx < 0)
continue;
if (_var_lb[i] == _var_ub[i]) {
row_idx = me++;
sp_set_val(_qp->A, row_idx, idx, 1.0);
}
else {
if (_var_lb[i] > -_Inf) {
row_idx = m++;
sp_set_val(_qp->C, row_idx, idx, 1.0);
}
if (_var_ub[i] < _Inf) {
row_idx = m++;
sp_set_val(_qp->C, row_idx, idx, -1.0);
}
}
}
// allocate sparse structure for general constraints
// (just insert dummy values; actual values are set in update method)
for (i = 0; i < _nrels; i++) {
if (rel_equal(_rels[i])) {
row_idx = me++;
J = _qp->A;
}
else {
row_idx = m++;
J = _qp->C;
}
nincidences = rel_n_incidences(_rels[i]);
incidences = rel_incidence_list(_rels[i]);
for (j = 0; j < nincidences; j++) {
idx = _var_asc2hqp[var_sindex(incidences[j])];
if (idx >= 0)
sp_set_val(J, row_idx, idx, 1.0);
}
}
// todo: setup sparse structure of Hessian
// for now initialize something resulting in dense BFGS update
for (j = 0; j < n-1; j++) {
sp_set_val(_qp->Q, j, j, 0.0);
sp_set_val(_qp->Q, j, j+1, 0.0);
}
sp_set_val(_qp->Q, j, j, 0.0);
}
static int fit_GaussNewton(VARIOGRAM *vp, PERM *p, LM *lm, int iter, int *bounded) {
double s = 0.0, x, y, z;
int i, j, n_fit, model, fit_ranges = 0;
IVEC *fit = NULL;
VEC *start = NULL;
if (p->size == 0)
return 1;
fit = iv_resize(fit, 2 * vp->n_models);
/* index fit parameters: parameter fit->ive[j] corresponds to model i */
for (i = n_fit = 0; i < vp->n_models; i++) {
if (vp->part[i].fit_sill)
fit->ive[n_fit++] = i;
if (vp->part[i].fit_range) {
fit->ive[n_fit++] = i + vp->n_models; /* large -->> ranges */
fit_ranges = 1;
}
}
if (n_fit == 0) {
iv_free(fit);
return 0;
}
fit = iv_resize(fit, n_fit); /* shrink to fit */
lm->X = m_resize(lm->X, p->size, n_fit);
lm->y = v_resize(lm->y, p->size);
start = v_resize(start, n_fit);
for (i = 0; i < n_fit; i++) {
if (fit->ive[i] < vp->n_models) {
model = fit->ive[i];
start->ve[i] = vp->part[model].sill;
} else {
model = fit->ive[i] - vp->n_models;
start->ve[i] = vp->part[model].range[0];
}
}
for (i = 0; i < p->size; i++) {
x = vp->ev->direction.x * vp->ev->dist[p->pe[i]];
y = vp->ev->direction.y * vp->ev->dist[p->pe[i]];
z = vp->ev->direction.z * vp->ev->dist[p->pe[i]];
/* fill y with current residuals: */
if (is_variogram(vp))
s = get_semivariance(vp, x, y, z);
else
s = get_covariance(vp, x, y, z);
lm->y->ve[i] = vp->ev->gamma[p->pe[i]] - s;
/* fill X: */
for (j = 0; j < n_fit; j++) { /* cols */
if (fit->ive[j] < vp->n_models) {
model = fit->ive[j];
ME(lm->X, i, j) = (is_variogram(vp) ?
UnitSemivariance(vp->part[model],x,y,z) :
UnitCovariance(vp->part[model],x,y,z));
} else {
model = fit->ive[j] - vp->n_models;
ME(lm->X, i, j) = (is_variogram(vp) ?
da_Semivariance(vp->part[model],x,y,z) :
-da_Semivariance(vp->part[model],x,y,z));
}
}
}
if (iter == 0 && fill_weights(vp, p, lm)) {
iv_free(fit);
v_free(start);
return 1;
}
lm->has_intercept = 1; /* does not affect the fit */
lm = calc_lm(lm); /* solve WLS eqs. for beta */
if (DEBUG_FIT) {
Rprintf("beta: ");
v_logoutput(lm->beta);
}
if (lm->is_singular) {
iv_free(fit);
v_free(start);
return 1;
}
if (fit_ranges) {
s = v_norm2(lm->beta) / v_norm2(start);
if (s > 0.2) {
/* don't allow steps > 20% ---- */
sv_mlt(0.2 / s, lm->beta, lm->beta);
*bounded = 1;
} else
*bounded = 0; /* a `free', voluntary step */
} else /* we're basically doing linear regression here: */
*bounded = 0;
for (i = 0; i < n_fit; i++) {
if (fit->ive[i] < vp->n_models) {
model = fit->ive[i];
vp->part[model].sill = start->ve[i] + lm->beta->ve[i];
} else {
model = fit->ive[i] - vp->n_models;;
vp->part[model].range[0] = start->ve[i] + lm->beta->ve[i];
}
}
iv_free(fit);
v_free(start);
return 0;
}
