obj prod(obj v, obj (*func)(obj, obj)){
obj rr;
switch(type(v)){
case LIST:
assert(!! ul(v));
rr=retain(first(ul(v)));
for(list ll=rest(ul(v)); ll; ll=rest(ll)){
obj lt = rr;
rr = call_fn(func, lt, first(ll));
release(lt);
}
return rr;
case tLAVec:
case tDblArray:
case tDblAr2:
case tArray:
{
int len = size(v);
if(len==0) return nil;
rr = ind(v,0);
for(int i=1; i<len; i++){
obj lt = rr;
obj rt = ind(v,i);
rr = call_fnr(func, lt, rt);
// release(lt);
// release(rt);
}
return rr;
}
default:
error("not defined for that type.");
return nil;
}
}
/*
obj prod_eval0(list l, obj (*func)(obj, obj)){
obj lt,rt,rr;
assert(!! l);
lt = eval(fpp(l));
rr = lt;
for(; l; ){
rt = eval(fpp(l));
rr = call_fn(func, lt, rt);
release(lt);
release(rt);
lt = rr;
}
return rr;
}
*/
obj prod_eval(list l, obj (*func)(obj, obj)){
assert(!! l);
obj rr = eval(fpp(l));
for(; l; ){
push(rr);
push(eval(fpp(l)));
rr = call_fn(func, sp1, sp0);
release(pop(&is));
release(pop(&is));
}
return rr;
}
obj applyCS(obj (*func)(obj, obj), obj v1, obj v2){
assert(!isVec(type(v2)));
if(isVec(type(v1))){
int len=size(v1);
obj rr = aArray(len);
for(int i=0; i<len; i++){
obj lt=ind(v1,i);
uar(rr).v[i] = call_fn(func, lt, v2);
release(lt);
}
return rr;
}
if(type(v1)==LIST){
list l=phi();
for(list l1=ul(v1); l1; l1=rest(l1)){
l = cons(call_fn(func, first(l1), v2), l);
}
return List2v(reverse(l));
}
assert(0);
return nil;
}
obj eval(obj exp){
ev: assert(!! exp);
obj rr,lt, rt;
switch (exp->type) {
case tInd:
return doInd(eval(ult(exp)), ul(eval(urt(exp))));
case LIST:
return List2v(evalList(ul(exp)));
case tArray:
return map_obj(eval, exp);
case tAnd:
return prod_eval(ul(exp), mult);
case MULT:
return prod_eval(ul(exp), mult);
case ARITH:
return prod_eval(ul(exp), add);
case POW:
return prod_eval(ul(exp), power);
case DIVIDE:
return prod_eval(ul(exp), divide);
case tRef:
return retain(uref(exp));
case tSymbol:
if( macromode) {
if(obj rr = search_assoc(car(macro_env), exp)){
macromode = false;
// macro lexical scope should be pushed to the stack here
rr = exec(rr);
macromode = true;
return rr;
}
}
return eval_symbol(exp);
case tMinus:
lt = eval(uref(exp));
rr = uMinus(lt); // releasing
if(rr) {release(lt); return rr;}
static obj symumn = Symbol("-");
rr = udef_op0(symumn, lt);
if(rr) {release(lt); return rr;}
error("uMinus: not defined to that type");
case tReturn:
if(! uref(exp)) return encap(tSigRet, nil);
return encap(tSigRet, eval(uref(exp)));
case tBreak:
return retain(exp);
case CONDITION:
return evalCond(exp);
case tOp:
if(type(ult(exp)) ==tSymbol) {
lt = search_assoc(curr_interp->types, ult(exp));
if(lt) return encap((ValueType)vrInt(lt), eval(urt(exp)));}
lt = eval(ult(exp));
push(lt);
switch(lt->type){
case tCont:
assert(0);
case tSpecial:
rr = ufn(lt)(urt(exp));
break;
case tSyntaxLam:
rr = macro_exec(lt, urt(exp));
break;
case tInternalFn:
case tClosure:
rt = eval(urt(exp));
rr = eval_function(lt, rt);
break;
default:
rt = eval(urt(exp));
rr = call_fn(mult, lt, rt);
release(rt);
}
release(pop(&is));
return rr;
case tClosure:
assert(0);
case tCurry:
return eval_curry(exp, em0(exp));
/* obj vars = Assoc();
bind_vars(&vars, em0(exp), em2(exp));
rr = eval_curry(exp, vars);
release(vars);
return rr;
*/ case tArrow:
// return enclose(exp);
/* if(macromode){
if(obj rr = search_assoc(car(macro_env), exp)){
}
}
*/ return render(tClosure, list3(retain(em0(exp)), retain(em1(exp)), retain(env)));
case tDefine:
return func_def(em0(exp), em1(exp), em2(exp));
case tSyntaxDef:
let(lfind_var(em0(exp)), render(tSyntaxLam, list3(retain(em1(exp)), retain(em2(exp)), nil)));
return nil;
case tExec:
return exec(exp);
case tAssign:
lt = car(exp);
if(type(lt)==tOp){
return func_def(ult(lt), urt(lt), cdr(exp));
} else if(type(lt)==tMinus){
static obj symumn = Symbol("-");
return func_def(symumn, uref(lt), cdr(exp));
} else return do_assign(lt, eval(cdr(exp)));
case tIf:
rr = eval(em0(exp));
if (type(rr) != INT) error("if: Boolean Expected");
if (vrInt(rr)) {
rr = em1(exp);
} else {
rr = em2(exp);
}
return eval(rr);
case tWhile:
for(;;) {
rr = eval(car(exp));
if (type(rr) != INT) error("while: Boolean expected");
if(!vrInt(rr)) break;
rr = exec(cdr(exp));
if(rr && type(rr)==tSigRet) return rr;
if(rr && type(rr)==tBreak) {release(rr); break;}
if(rr) release(rr);
}
return nil;
default:
return retain(exp);
}
}
obj applyCC( obj (*func)(obj, obj), obj v1, obj v2){
if(type(v1)==LIST && type(v2)==LIST) {
list l1=ul(v1), l2=ul(v2);
list l=nil;
for(; l1 && l2; l1=rest(l1), l2=rest(l2)){
l= cons(call_fn(func, first(l1), first(l2)), l);
}
if(l1 || l2) error("unmatched num. of elems. in the lists");
return List2v(reverse(l));
}
obj lt,rt;
if(type(v1)==tDblArray && type(v2)==tDblArray){
int len = udar(v1).size;
if(len != udar(v2).size) error("num mismatch");
obj rr = dblArray(len);
// obj rr = new dblarr(len);
double* v = udar(rr).v;
for(int i=0; i<len; i++){
lt = Double(udar(v1).v[i]);//íxÇ¢
rt = Double(udar(v2).v[i]);
obj rx = call_fnr(func, lt,rt);
// release(lt);
// release(rt);
if(type(rx)!=tDouble) error("array: type mismatch");//kore mondai
v[i] = udbl(rx);
release(rx);
}
return rr;
}
if(isVec(type(v1)) && isVec(type(v2))){
int len=size(v1);
if(len!=size(v2)) error("num mismatch");
obj rr = aArray(len);
for(int i=0; i<len; i++){
lt = ind(v1,i);
rt = ind(v2,i);
uar(rr).v[i] = call_fnr(func, lt, rt);
// release(lt);
// release(rt);
}
return rr;
}
if( type(v1)==LIST && isVec(type(v2))){
list l=nil, l1=ul(v1);
int len=size(v2);
for(int i=0; i<len; i++,l1=rest(l1)){
if(! l1) error("num mismatch");
rt = ind(v2,i);
l = cons(call_fn(func, first(l1), rt), l);
release(rt);
}
return List2v(reverse(l));
}
if( isVec(type(v1)) && type(v2)==LIST){
list l=nil, l2=ul(v2);
int len=size(v1);
for(int i=0; i<len; i++,l2=rest(l2)){
if(! l2) error("num mismatch");
lt=ind(v1,i);
l=cons(call_fn(func, lt, first(l2)), l);
release(lt);
}
return List2v(reverse(l));
}
error("operation not defined.");
return nil;
}
inline obj call_fnr(obj (*func)(obj, obj), obj lt, obj rt){
obj rr = call_fn(func, lt, rt);
release(lt);
release(rt);
return rr;
}
void Interface::innerNormalPhase () {
Real oldnormc = normc;
Int fail = 0;
Int oldAcnt = 0;
while ( (normc > rho) && (nRest <= maxrest) && (NormalFlag == 0) && (current_time < max_time) ) {
#ifdef VERBOSE
if (verbosity_level > 1) {
std::cout << "Going to innerNormalStep: nRest " << nRest << std::endl
<< std::endl
<< "|c| = " << normc << std::endl
<< "rho = " << rho << std::endl
<< std::endl;
if ( (nvar < 10) && (ncon < 10) ) {
std::cout << "A = " << std::endl;
full(*J).print_more ();
std::cout << "xc = " << std::endl;
xc->print_more ();
}
}
GDBSTOP ();
#endif
nRest++;
call_ccfsg_xc(dciTrue, dciFalse);
cholesky();
infeasible_gradient = 1.0;
innerNormalDirection(infeasible_gradient);
#ifdef ITER_MATLAB
iter_file << "X(:,size(X,2)+1) = [" << xcx[0] << ";" << xcx[1] << "];" << std::endl;
#endif
#ifdef VERBOSE
if (verbosity_level > 1) {
std::cout << "After innerNormalStep" << std::endl;
std::cout << "|c| = " << normc << std::endl;
std::cout << "rho = " << rho << std::endl;
if ( (nvar < 10) && (ncon < 10) ) {
std::cout << "xc = " << std::endl;
xc->print_more();
}
}
#endif
#ifndef NDEBUG
checkInfactibility();
#endif
gavail = dciFalse;
if (normc > phi2*oldnormc) {
fail = fail + 1;
} else
fail = 0;
if (fail >= nfailv) {
#ifdef VERBOSE
if (verbosity_level > 1) {
std::cout << "Going to Safe Guard " << std::endl
<< std::endl;
if ( (nvar < 10) && (ncon < 10) ) {
std::cout << "A = " << std::endl;
full(*J).print_more ();
}
GDBSTOP ();
}
#endif
if (normc > 0 && infeasible_gradient/normc < infeasibility_tol)
NormalFlag = 2;
if (use_normal_safe_guard && NormalFlag == 0) {
Vector ssoc(*env, nvar + nconI);
Real asoc;
call_ccfsg_xc(dciTrue, dciTrue);
cholesky();
StepFlag = naStep (*c, ssoc);
scale_xc (ssoc);
// Arrumar tamanho do ssoc a partir do x
Real alphassoc = 1;
pReal ssocx = ssoc.get_doublex();
for (Int i = 0; i < nvar+nconI; i++) {
Real xi = xcx[i], bli = l_bndx[i], bui = u_bndx[i], di = ssocx[i];
if (di == 0)
continue;
if (di < 0) {
Real val = (bli - xi)*(1 - epsmu)/di;
alphassoc = Min (alphassoc, val);
} else {
Real val = (bui - xi)*(1 - epsmu)/di;
alphassoc = Min (alphassoc, val);
}
}
if (alphassoc < 1)
ssoc.scale (alphassoc);
asoc = ssoc.norm (0);
if (asoc > DeltaV)
xc->saxpy(ssoc, DeltaV/asoc);
else
xc->saxpy(ssoc, 1.0);
call_fn ();
normc = c->norm ();
}
fail = 0;
if (normal_fail_reboot && normc > rho && NormalFlag == 0) {
// Has failed but is not infeasible
Real constr[ncon], funval;
(*cfn) (&cuter_status, &nvar, &ncon, xcx, &funval, constr);
Int numI = nvar;
for (Int i = 0; i < ncon; i++) {
if (equatn[i] == dciFalse) {
if (constr[i] > clx[i] && constr[i] < cux[i])
xcx[numI] = constr[i]/constraint_scaling[i];
numI++;
}
}
normc = c->norm();
}
} else if ( ( (normc > thetaR*oldnormc) && (oldAcnt > 0) ) ||
(oldAcnt > 5) ) {
// Failed. Recompute A
if (!is_linear) {
call_ccfsg_xc (dciTrue, dciFalse); //CuterJacob
}
Aavail = dciTrue;
oldAcnt = 0;
if (!is_linear) {
this->cholesky ();
}
} else {
oldAcnt++;
Aavail = dciFalse;
}
oldnormc = normc;
DeltaV = Max (DeltaV, DeltaMin);
current_time = getTime() - start_time;
} //Fim do While
}
