Scippy

SCIP

Solving Constraint Integer Programs

cons_quadratic.c
Go to the documentation of this file.
1 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
2 /* */
3 /* This file is part of the program and library */
4 /* SCIP --- Solving Constraint Integer Programs */
5 /* */
6 /* Copyright (C) 2002-2019 Konrad-Zuse-Zentrum */
7 /* fuer Informationstechnik Berlin */
8 /* */
9 /* SCIP is distributed under the terms of the ZIB Academic License. */
10 /* */
11 /* You should have received a copy of the ZIB Academic License */
12 /* along with SCIP; see the file COPYING. If not visit scip.zib.de. */
13 /* */
14 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
15 
16 /**@file cons_quadratic.c
17  * @brief constraint handler for quadratic constraints \f$\textrm{lhs} \leq \sum_{i,j=1}^n a_{i,j} x_i x_j + \sum_{i=1}^n b_i x_i \leq \textrm{rhs}\f$
18  * @author Stefan Vigerske
19  * @author Benjamin Mueller
20  * @author Felipe Serrano
21  *
22  * @todo SCIP might fix linear variables on +/- infinity; remove them in presolve and take care later
23  * @todo round constraint sides to integers if all coefficients and variables are (impl.) integer
24  * @todo constraints in one variable should be replaced by linear or bounddisjunction constraint
25  * @todo check if some quadratic terms appear in several constraints and try to simplify (e.g., nous1)
26  * @todo skip separation in enfolp if for current LP (check LP id) was already separated
27  * @todo watch unbounded variables to enable/disable propagation
28  * @todo sort order in bilinvar1/bilinvar2 such that the var which is involved in more terms is in bilinvar1, and use this info propagate and AddLinearReform
29  * @todo underestimate for multivariate concave quadratic terms as in cons_nonlinear
30  */
31 
32 /*---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----0----+----1----+----2*/
33 
34 #define SCIP_PRIVATE_ROWPREP
35 
36 #include "blockmemshell/memory.h"
37 #include <ctype.h>
38 #include "nlpi/nlpi.h"
39 #include "nlpi/nlpi_ipopt.h"
40 #include "nlpi/pub_expr.h"
41 #include "nlpi/type_expr.h"
42 #include "scip/cons_and.h"
44 #include "scip/cons_linear.h"
45 #include "scip/cons_nonlinear.h"
46 #include "scip/cons_quadratic.h"
47 #include "scip/cons_varbound.h"
48 #include "scip/debug.h"
49 #include "scip/heur_subnlp.h"
50 #include "scip/heur_trysol.h"
51 #include "scip/intervalarith.h"
52 #include "scip/pub_cons.h"
53 #include "scip/pub_event.h"
54 #include "scip/pub_heur.h"
55 #include "scip/pub_lp.h"
56 #include "scip/pub_message.h"
57 #include "scip/pub_misc.h"
58 #include "scip/pub_misc_sort.h"
59 #include "scip/pub_nlp.h"
60 #include "scip/pub_sol.h"
61 #include "scip/pub_tree.h"
62 #include "scip/pub_var.h"
63 #include "scip/scip_branch.h"
64 #include "scip/scip_cons.h"
65 #include "scip/scip_copy.h"
66 #include "scip/scip_cut.h"
67 #include "scip/scip_event.h"
68 #include "scip/scip_general.h"
69 #include "scip/scip_heur.h"
70 #include "scip/scip_lp.h"
71 #include "scip/scip_mem.h"
72 #include "scip/scip_message.h"
73 #include "scip/scip_nlp.h"
74 #include "scip/scip_nonlinear.h"
75 #include "scip/scip_numerics.h"
76 #include "scip/scip_param.h"
77 #include "scip/scip_prob.h"
78 #include "scip/scip_probing.h"
79 #include "scip/scip_sepa.h"
80 #include "scip/scip_sol.h"
81 #include "scip/scip_solve.h"
82 #include "scip/scip_solvingstats.h"
83 #include "scip/scip_tree.h"
84 #include "scip/scip_var.h"
85 #include <string.h>
86 
87 /* Inform compiler that this code accesses the floating-point environment, so that
88  * certain optimizations should be omitted (http://www.cplusplus.com/reference/cfenv/FENV_ACCESS/).
89  * Not supported by Clang (gives warning) and GCC (silently), at the moment.
90  */
91 #ifndef __clang__
92 #pragma STD FENV_ACCESS ON
93 #endif
94 
95 /* constraint handler properties */
96 #define CONSHDLR_NAME "quadratic"
97 #define CONSHDLR_DESC "quadratic constraints of the form lhs <= b' x + x' A x <= rhs"
98 #define CONSHDLR_SEPAPRIORITY 10 /**< priority of the constraint handler for separation */
99 #define CONSHDLR_ENFOPRIORITY -50 /**< priority of the constraint handler for constraint enforcing */
100 #define CONSHDLR_CHECKPRIORITY -4000000 /**< priority of the constraint handler for checking feasibility */
101 #define CONSHDLR_SEPAFREQ 1 /**< frequency for separating cuts; zero means to separate only in the root node */
102 #define CONSHDLR_PROPFREQ 1 /**< frequency for propagating domains; zero means only preprocessing propagation */
103 #define CONSHDLR_EAGERFREQ 100 /**< frequency for using all instead of only the useful constraints in separation,
104  * propagation and enforcement, -1 for no eager evaluations, 0 for first only */
105 #define CONSHDLR_MAXPREROUNDS -1 /**< maximal number of presolving rounds the constraint handler participates in (-1: no limit) */
106 #define CONSHDLR_DELAYSEPA FALSE /**< should separation method be delayed, if other separators found cuts? */
107 #define CONSHDLR_DELAYPROP FALSE /**< should propagation method be delayed, if other propagators found reductions? */
108 #define CONSHDLR_NEEDSCONS TRUE /**< should the constraint handler be skipped, if no constraints are available? */
110 #define CONSHDLR_PROP_TIMING SCIP_PROPTIMING_BEFORELP /**< propagation timing mask of the constraint handler */
111 #define CONSHDLR_PRESOLTIMING SCIP_PRESOLTIMING_ALWAYS /**< presolving timing of the constraint handler (fast, medium, or exhaustive) */
113 #define MAXDNOM 10000LL /**< maximal denominator for simple rational fixed values */
114 #define NONLINCONSUPGD_PRIORITY 40000 /**< priority of upgrading nonlinear constraints */
115 #define INITLPMAXVARVAL 1000.0 /**< maximal absolute value of variable for still generating a linearization cut at that point in initlp */
117 /* Activating this define enables reformulation of bilinear terms x*y with implications from x to y into linear terms.
118  * However, implications are not enforced by SCIP. Thus, if, e.g., the used implication was derived from this constraint and we then reformulate the constraint,
119  * then the implication may not be enforced in a solution.
120  * This issue need to be fixed before this feature can be enabled.
121  */
122 /* #define CHECKIMPLINBILINEAR */
123 
124 /* enable new propagation for bivariate quadratic terms */
125 #define PROPBILINNEW
127 /* epsilon for differentiating between a boundary and interior point */
128 #define INTERIOR_EPS 1e-1
130 /* scaling factor for gauge function */
131 #define GAUGESCALE 0.99999
133 #define ROWPREP_SCALEUP_VIOLNONZERO (10.0*SCIPepsilon(scip)) /**< minimal violation for considering up-scaling of rowprep (we want to avoid upscaling very small violations) */
134 #define ROWPREP_SCALEUP_MINVIOLFACTOR 2.0 /**< scale up will target a violation of ~MINVIOLFACTOR*minviol, where minviol is given by caller */
135 #define ROWPREP_SCALEUP_MAXMINCOEF (1.0 / SCIPfeastol(scip)) /**< scale up only if min. coef is below this number (before scaling) */
136 #define ROWPREP_SCALEUP_MAXMAXCOEF SCIPgetHugeValue(scip) /**< scale up only if max. coef will not exceed this number by scaling */
137 #define ROWPREP_SCALEUP_MAXSIDE SCIPgetHugeValue(scip) /**< scale up only if side will not exceed this number by scaling */
138 #define ROWPREP_SCALEDOWN_MINMAXCOEF (1.0 / SCIPfeastol(scip)) /**< scale down if max. coef is at least this number (before scaling) */
139 #define ROWPREP_SCALEDOWN_MINCOEF SCIPfeastol(scip) /**< scale down only if min. coef does not drop below this number by scaling */
141 /*
142  * Data structures
143  */
144 
145 /** eventdata for variable bound change events in quadratic constraints */
146 struct SCIP_QuadVarEventData
147 {
148  SCIP_CONS* cons; /**< the constraint */
149  int varidx; /**< the index of the variable which bound change is caught, positive for linear variables, negative for quadratic variables */
150  int filterpos; /**< position of eventdata in SCIP's event filter */
151 };
152 
153 /** Data of a quadratic constraint. */
154 struct SCIP_ConsData
155 {
156  SCIP_Real lhs; /**< left hand side of constraint */
157  SCIP_Real rhs; /**< right hand side of constraint */
158 
159  int nlinvars; /**< number of linear variables */
160  int linvarssize; /**< length of linear variable arrays */
161  SCIP_VAR** linvars; /**< linear variables */
162  SCIP_Real* lincoefs; /**< coefficients of linear variables */
163  SCIP_QUADVAREVENTDATA** lineventdata; /**< eventdata for bound change of linear variable */
164 
165  int nquadvars; /**< number of variables in quadratic terms */
166  int quadvarssize; /**< length of quadratic variable terms arrays */
167  SCIP_QUADVARTERM* quadvarterms; /**< array with quadratic variable terms */
168 
169  int nbilinterms; /**< number of bilinear terms */
170  int bilintermssize; /**< length of bilinear term arrays */
171  SCIP_BILINTERM* bilinterms; /**< bilinear terms array */
172  int* bilintermsidx; /**< unique index of each bilinear term xy in the bilinestimators array of the constraint handler data */
173 
174  SCIP_NLROW* nlrow; /**< a nonlinear row representation of this constraint */
175 
176  unsigned int linvarssorted:1; /**< are the linear variables already sorted? */
177  unsigned int linvarsmerged:1; /**< are equal linear variables already merged? */
178  unsigned int quadvarssorted:1; /**< are the quadratic variables already sorted? */
179  unsigned int quadvarsmerged:1; /**< are equal quadratic variables already merged? */
180  unsigned int bilinsorted:1; /**< are the bilinear terms already sorted? */
181  unsigned int bilinmerged:1; /**< are equal bilinear terms (and bilinear terms with zero coefficient) already merged? */
182 
183  unsigned int isconvex:1; /**< is quadratic function is convex ? */
184  unsigned int isconcave:1; /**< is quadratic function is concave ? */
185  unsigned int iscurvchecked:1; /**< is quadratic function checked on convexity or concavity ? */
186  unsigned int isremovedfixings:1; /**< did we removed fixed/aggr/multiaggr variables ? */
187  unsigned int ispropagated:1; /**< was the constraint propagated with respect to the current bounds ? */
188  unsigned int ispresolved:1; /**< did we checked for possibilities of upgrading or implicit integer variables ? */
189  unsigned int initialmerge:1; /**< did we perform an initial merge and clean in presolving yet ? */
190 #ifdef CHECKIMPLINBILINEAR
191  unsigned int isimpladded:1; /**< has there been an implication added for a binary variable in a bilinear term? */
192 #endif
193  unsigned int isgaugeavailable:1; /**< is the gauge function computed? */
194  unsigned int isedavailable:1; /**< is the eigen decomposition of A available? */
195 
196  SCIP_Real minlinactivity; /**< sum of minimal activities of all linear terms with finite minimal activity */
197  SCIP_Real maxlinactivity; /**< sum of maximal activities of all linear terms with finite maximal activity */
198  int minlinactivityinf; /**< number of linear terms with infinite minimal activity */
199  int maxlinactivityinf; /**< number of linear terms with infinity maximal activity */
200  SCIP_INTERVAL quadactivitybounds; /**< bounds on the activity of the quadratic term, if up to date, otherwise empty interval */
201  SCIP_Real activity; /**< activity of quadratic function w.r.t. current solution */
202  SCIP_Real lhsviol; /**< violation of lower bound by current solution (used temporarily inside constraint handler) */
203  SCIP_Real rhsviol; /**< violation of lower bound by current solution (used temporarily inside constraint handler) */
204 
205  int linvar_maydecrease; /**< index of a variable in linvars that may be decreased without making any other constraint infeasible, or -1 if none */
206  int linvar_mayincrease; /**< index of a variable in linvars that may be increased without making any other constraint infeasible, or -1 if none */
207 
208  SCIP_VAR** sepaquadvars; /**< variables corresponding to quadvarterms to use in separation, only available in solving stage */
209  int* sepabilinvar2pos; /**< position of second variable in bilinear terms to use in separation, only available in solving stage */
210  SCIP_Real lincoefsmin; /**< minimal absolute value of coefficients in linear part, only available in solving stage */
211  SCIP_Real lincoefsmax; /**< maximal absolute value of coefficients in linear part, only available in solving stage */
212 
213  SCIP_Real* factorleft; /**< coefficients of left factor if constraint function is factorable */
214  SCIP_Real* factorright; /**< coefficients of right factor if constraint function is factorable */
215 
216  SCIP_Real* gaugecoefs; /**< coefficients of the gauge function */
217  SCIP_Real gaugeconst; /**< constant of the gauge function */
218  SCIP_Real* interiorpoint; /**< interior point of the region defined by the convex function */
219  SCIP_Real interiorpointval; /**< function value at interior point */
220 
221  SCIP_Real* eigenvalues; /**< eigenvalues of A */
222  SCIP_Real* eigenvectors; /**< orthonormal eigenvectors of A; if A = P D P^T, then eigenvectors is P^T */
223  SCIP_Real* bp; /**< stores b * P where b are the linear coefficients of the quadratic vars */
224  SCIP_Real maxnonconvexity; /**< nonconvexity measure: estimate on largest absolute value of nonconvex eigenvalues */
225 
226  SCIP_Bool isdisaggregated; /**< has the constraint already been disaggregated? if might happen that more disaggreation would be potentially
227  possible, but we reached the maximum number of sparsity components during presolveDisaggregate() */
228 };
229 
230 /** quadratic constraint update method */
232 {
233  SCIP_DECL_QUADCONSUPGD((*quadconsupgd)); /**< method to call for upgrading quadratic constraint */
234  int priority; /**< priority of upgrading method */
235  SCIP_Bool active; /**< is upgrading enabled */
236 };
237 typedef struct SCIP_QuadConsUpgrade SCIP_QUADCONSUPGRADE; /**< quadratic constraint update method */
239 /** structure to store everything needed for using linear inequalities to improve upon the McCormick relaxation */
240 struct BilinearEstimator
241 {
242  SCIP_VAR* x; /**< first variable */
243  SCIP_VAR* y; /**< second variable */
244  SCIP_Real inequnderest[6]; /**< at most two inequalities that can be used to underestimate xy; stored as (xcoef,ycoef,constant) with xcoef x <= ycoef y + constant */
245  SCIP_Real ineqoverest[6]; /**< at most two inequalities that can be used to overestimate xy; stored as (xcoef,ycoef,constant) with xcoef x <= ycoef y + constant */
246  SCIP_Real maxnonconvexity; /**< estimate on largest absolute value of nonconvex eigenvalues of all quadratic constraint containing xy */
247  int ninequnderest; /**< total number of inequalities for underestimating xy */
248  int nineqoverest; /**< total number of inequalities for overestimating xy */
249  int nunderest; /**< number of constraints that require to underestimate xy */
250  int noverest; /**< number of constraints that require to overestimate xy */
252  SCIP_Real lastimprfac; /**< last achieved improvement factor */
253 };
254 typedef struct BilinearEstimator BILINESTIMATOR;
256 /** constraint handler data */
257 struct SCIP_ConshdlrData
258 {
259  int replacebinaryprodlength; /**< length of linear term which when multiplied with a binary variable is replaced by an auxiliary variable and an equivalent linear formulation */
260  int empathy4and; /**< how much empathy we have for using the AND constraint handler: 0 avoid always; 1 use sometimes; 2 use as often as possible */
261  SCIP_Bool binreforminitial; /**< whether to make constraints added due to replacing products with binary variables initial */
262  SCIP_Bool binreformbinaryonly;/**< whether to consider only binary variables when reformulating products with binary variables */
263  SCIP_Real binreformmaxcoef; /**< factor on 1/feastol to limit coefficients and coef range in linear constraints created by binary reformulation */
264  SCIP_Real cutmaxrange; /**< maximal range (maximal coef / minimal coef) of a cut in order to be added to LP */
265  SCIP_Bool linearizeheursol; /**< whether linearizations of convex quadratic constraints should be added to cutpool when some heuristics finds a new solution */
266  SCIP_Bool checkcurvature; /**< whether functions should be checked for convexity/concavity */
267  SCIP_Bool checkfactorable; /**< whether functions should be checked to be factorable */
268  char checkquadvarlocks; /**< whether quadratic variables contained in a single constraint should be forced to be at their lower or upper bounds ('d'isable, change 't'ype, add 'b'ound disjunction) */
269  SCIP_Bool linfeasshift; /**< whether to make solutions in check feasible if possible */
270  int maxdisaggrsize; /**< maximum number of components when disaggregating a quadratic constraint (<= 1: off) */
271  char disaggrmergemethod; /**< method on merging blocks in disaggregation */
272  int maxproprounds; /**< limit on number of propagation rounds for a single constraint within one round of SCIP propagation during solve */
273  int maxproproundspresolve; /**< limit on number of propagation rounds for a single constraint within one presolving round */
274  SCIP_Real sepanlpmincont; /**< minimal required fraction of continuous variables in problem to use solution of NLP relaxation in root for separation */
275  SCIP_Bool enfocutsremovable; /**< are cuts added during enforcement removable from the LP in the same node? */
276  SCIP_Bool gaugecuts; /**< should convex quadratics generated strong cuts via gauge function? */
277  SCIP_Bool projectedcuts; /**< should convex quadratics generated strong cuts via projections? */
278  char interiorcomputation;/**< how the interior point should be computed: 'a'ny point per constraint, 'm'ost interior per constraint */
279  char branchscoring; /**< method to use to compute score of branching candidates */
280  int enfolplimit; /**< maximum number of enforcement round before declaring the LP relaxation
281  * infeasible (-1: no limit); WARNING: if this parameter is not set to -1,
282  * SCIP might declare sub-optimal solutions optimal or feasible instances
283  * infeasible; thus, the result returned by SCIP might be incorrect!
284  */
285  SCIP_HEUR* subnlpheur; /**< a pointer to the subnlp heuristic, if available */
286  SCIP_HEUR* trysolheur; /**< a pointer to the trysol heuristic, if available */
287  SCIP_EVENTHDLR* eventhdlr; /**< our handler for variable bound change events */
288  int newsoleventfilterpos; /**< filter position of new solution event handler, if caught */
289  SCIP_Bool sepanlp; /**< where linearization of the NLP relaxation solution added? */
290  SCIP_NODE* lastenfonode; /**< the node for which enforcement was called the last time (and some constraint was violated) */
291  int nenforounds; /**< counter on number of enforcement rounds for the current node */
292  SCIP_QUADCONSUPGRADE** quadconsupgrades; /**< quadratic constraint upgrade methods for specializing quadratic constraints */
293  int quadconsupgradessize; /**< size of quadconsupgrade array */
294  int nquadconsupgrades; /**< number of quadratic constraint upgrade methods */
295 
296  BILINESTIMATOR* bilinestimators; /**< array containing all required information for using stronger estimators for each bilinear term in all quadratic constraints */
297  int nbilinterms; /**< number of bilinear terms in all quadratic constraints */
298 
299  SCIP_Bool usebilinineqbranch; /**< should linear inequalities be considered when computing the branching scores for bilinear terms? */
300  SCIP_Bool storedbilinearterms; /**< did we already try to store all bilinear terms? */
301 
302  SCIP_Real minscorebilinterms; /**< minimal required score in order to use linear inequalities for tighter bilinear relaxations */
303  SCIP_Real mincurvcollectbilinterms;/**< minimal curvature of constraints to be considered when returning bilinear terms to other plugins */
304  int bilinineqmaxseparounds; /**< maximum number of separation rounds to use linear inequalities for the bilinear term relaxation in a local node */
305 };
306 
307 
308 /*
309  * local methods for managing quadratic constraint update methods
310  */
311 
312 
313 /** checks whether a quadratic constraint upgrade method has already be registered */
314 static
316  SCIP* scip, /**< SCIP data structure */
317  SCIP_CONSHDLRDATA* conshdlrdata, /**< constraint handler data */
318  SCIP_DECL_QUADCONSUPGD((*quadconsupgd)), /**< method to call for upgrading quadratic constraint */
319  const char* conshdlrname /**< name of the constraint handler */
320  )
321 {
322  int i;
323 
324  assert(scip != NULL);
325  assert(conshdlrdata != NULL);
326  assert(quadconsupgd != NULL);
327  assert(conshdlrname != NULL);
328 
329  for( i = conshdlrdata->nquadconsupgrades - 1; i >= 0; --i )
330  {
331  if( conshdlrdata->quadconsupgrades[i]->quadconsupgd == quadconsupgd )
332  {
333  SCIPwarningMessage(scip, "Try to add already known upgrade message for constraint handler <%s>.\n", conshdlrname);
334  return TRUE;
335  }
336  }
337 
338  return FALSE;
339 }
340 
341 /*
342  * Local methods
343  */
344 
345 /** translate from one value of infinity to another
346  *
347  * if val is >= infty1, then give infty2, else give val
348  */
349 #define infty2infty(infty1, infty2, val) ((val) >= (infty1) ? (infty2) : (val))
351 /** catches variable bound change events on a linear variable in a quadratic constraint */
352 static
354  SCIP* scip, /**< SCIP data structure */
355  SCIP_EVENTHDLR* eventhdlr, /**< event handler */
356  SCIP_CONS* cons, /**< constraint for which to catch bound change events */
357  int linvarpos /**< position of variable in linear variables array */
358  )
359 {
360  SCIP_CONSDATA* consdata;
361  SCIP_QUADVAREVENTDATA* eventdata;
362  SCIP_EVENTTYPE eventtype;
363 
364  assert(scip != NULL);
365  assert(eventhdlr != NULL);
366  assert(cons != NULL);
367 
368  consdata = SCIPconsGetData(cons);
369  assert(consdata != NULL);
370 
371  assert(linvarpos >= 0);
372  assert(linvarpos < consdata->nlinvars);
373  assert(consdata->lineventdata != NULL);
374 
375  SCIP_CALL( SCIPallocBlockMemory(scip, &eventdata) );
376 
377  eventdata->cons = cons;
378  eventdata->varidx = linvarpos;
379 
381  if( !SCIPisInfinity(scip, consdata->rhs) )
382  {
383  /* if right hand side is finite, then a tightening in the lower bound of coef*linvar is of interest
384  * since we also want to keep activities in consdata up-to-date, we also need to know when the corresponding bound is relaxed */
385  if( consdata->lincoefs[linvarpos] > 0.0 )
386  eventtype |= SCIP_EVENTTYPE_LBCHANGED;
387  else
388  eventtype |= SCIP_EVENTTYPE_UBCHANGED;
389  }
390  if( !SCIPisInfinity(scip, -consdata->lhs) )
391  {
392  /* if left hand side is finite, then a tightening in the upper bound of coef*linvar is of interest
393  * since we also want to keep activities in consdata up-to-date, we also need to know when the corresponding bound is relaxed */
394  if( consdata->lincoefs[linvarpos] > 0.0 )
395  eventtype |= SCIP_EVENTTYPE_UBCHANGED;
396  else
397  eventtype |= SCIP_EVENTTYPE_LBCHANGED;
398  }
399 
400  SCIP_CALL( SCIPcatchVarEvent(scip, consdata->linvars[linvarpos], eventtype, eventhdlr, (SCIP_EVENTDATA*)eventdata, &eventdata->filterpos) );
401 
402  consdata->lineventdata[linvarpos] = eventdata;
403 
404  /* invalidate activity information
405  * NOTE: It could happen that a constraint gets temporary deactivated and some variable bounds change. In this case
406  * we do not recognize those bound changes with the variable events and thus we have to recompute the activities.
407  */
408  consdata->minlinactivity = SCIP_INVALID;
409  consdata->maxlinactivity = SCIP_INVALID;
410  consdata->minlinactivityinf = -1;
411  consdata->maxlinactivityinf = -1;
412 
413  return SCIP_OKAY;
414 }
415 
416 /** drops variable bound change events on a linear variable in a quadratic constraint */
417 static
419  SCIP* scip, /**< SCIP data structure */
420  SCIP_EVENTHDLR* eventhdlr, /**< event handler */
421  SCIP_CONS* cons, /**< constraint for which to catch bound change events */
422  int linvarpos /**< position of variable in linear variables array */
423  )
424 {
425  SCIP_CONSDATA* consdata;
426  SCIP_EVENTTYPE eventtype;
427 
428  assert(scip != NULL);
429  assert(eventhdlr != NULL);
430  assert(cons != NULL);
431 
432  consdata = SCIPconsGetData(cons);
433  assert(consdata != NULL);
434 
435  assert(linvarpos >= 0);
436  assert(linvarpos < consdata->nlinvars);
437  assert(consdata->lineventdata != NULL);
438  assert(consdata->lineventdata[linvarpos] != NULL);
439  assert(consdata->lineventdata[linvarpos]->cons == cons);
440  assert(consdata->lineventdata[linvarpos]->varidx == linvarpos);
441  assert(consdata->lineventdata[linvarpos]->filterpos >= 0);
442 
444  if( !SCIPisInfinity(scip, consdata->rhs) )
445  {
446  /* if right hand side is finite, then a tightening in the lower bound of coef*linvar is of interest
447  * since we also want to keep activities in consdata up-to-date, we also need to know when the corresponding bound is relaxed */
448  if( consdata->lincoefs[linvarpos] > 0.0 )
449  eventtype |= SCIP_EVENTTYPE_LBCHANGED;
450  else
451  eventtype |= SCIP_EVENTTYPE_UBCHANGED;
452  }
453  if( !SCIPisInfinity(scip, -consdata->lhs) )
454  {
455  /* if left hand side is finite, then a tightening in the upper bound of coef*linvar is of interest
456  * since we also want to keep activities in consdata up-to-date, we also need to know when the corresponding bound is relaxed */
457  if( consdata->lincoefs[linvarpos] > 0.0 )
458  eventtype |= SCIP_EVENTTYPE_UBCHANGED;
459  else
460  eventtype |= SCIP_EVENTTYPE_LBCHANGED;
461  }
462 
463  SCIP_CALL( SCIPdropVarEvent(scip, consdata->linvars[linvarpos], eventtype, eventhdlr, (SCIP_EVENTDATA*)consdata->lineventdata[linvarpos], consdata->lineventdata[linvarpos]->filterpos) );
464 
465  SCIPfreeBlockMemory(scip, &consdata->lineventdata[linvarpos]); /*lint !e866 */
466 
467  return SCIP_OKAY;
468 }
469 
470 /** catches variable bound change events on a quadratic variable in a quadratic constraint */
471 static
473  SCIP* scip, /**< SCIP data structure */
474  SCIP_EVENTHDLR* eventhdlr, /**< event handler */
475  SCIP_CONS* cons, /**< constraint for which to catch bound change events */
476  int quadvarpos /**< position of variable in quadratic variables array */
477  )
478 {
479  SCIP_CONSDATA* consdata;
480  SCIP_QUADVAREVENTDATA* eventdata;
481  SCIP_EVENTTYPE eventtype;
482 
483  assert(scip != NULL);
484  assert(eventhdlr != NULL);
485  assert(cons != NULL);
486 
487  consdata = SCIPconsGetData(cons);
488  assert(consdata != NULL);
489 
490  assert(quadvarpos >= 0);
491  assert(quadvarpos < consdata->nquadvars);
492  assert(consdata->quadvarterms[quadvarpos].eventdata == NULL);
493 
494  SCIP_CALL( SCIPallocBlockMemory(scip, &eventdata) );
495 
497 #ifdef CHECKIMPLINBILINEAR
498  eventtype |= SCIP_EVENTTYPE_IMPLADDED;
499 #endif
500  eventdata->cons = cons;
501  eventdata->varidx = -quadvarpos-1;
502  SCIP_CALL( SCIPcatchVarEvent(scip, consdata->quadvarterms[quadvarpos].var, eventtype, eventhdlr, (SCIP_EVENTDATA*)eventdata, &eventdata->filterpos) );
503 
504  consdata->quadvarterms[quadvarpos].eventdata = eventdata;
505 
506  /* invalidate activity information
507  * NOTE: It could happen that a constraint gets temporary deactivated and some variable bounds change. In this case
508  * we do not recognize those bound changes with the variable events and thus we have to recompute the activities.
509  */
510  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
511 
512  return SCIP_OKAY;
513 }
514 
515 /** catches variable bound change events on a quadratic variable in a quadratic constraint */
516 static
518  SCIP* scip, /**< SCIP data structure */
519  SCIP_EVENTHDLR* eventhdlr, /**< event handler */
520  SCIP_CONS* cons, /**< constraint for which to catch bound change events */
521  int quadvarpos /**< position of variable in quadratic variables array */
522  )
523 {
524  SCIP_CONSDATA* consdata;
525  SCIP_EVENTTYPE eventtype;
526 
527  assert(scip != NULL);
528  assert(eventhdlr != NULL);
529  assert(cons != NULL);
530 
531  consdata = SCIPconsGetData(cons);
532  assert(consdata != NULL);
533 
534  assert(quadvarpos >= 0);
535  assert(quadvarpos < consdata->nquadvars);
536  assert(consdata->quadvarterms[quadvarpos].eventdata != NULL);
537  assert(consdata->quadvarterms[quadvarpos].eventdata->cons == cons);
538  assert(consdata->quadvarterms[quadvarpos].eventdata->varidx == -quadvarpos-1);
539  assert(consdata->quadvarterms[quadvarpos].eventdata->filterpos >= 0);
540 
542 #ifdef CHECKIMPLINBILINEAR
543  eventtype |= SCIP_EVENTTYPE_IMPLADDED;
544 #endif
545 
546  SCIP_CALL( SCIPdropVarEvent(scip, consdata->quadvarterms[quadvarpos].var, eventtype, eventhdlr, (SCIP_EVENTDATA*)consdata->quadvarterms[quadvarpos].eventdata, consdata->quadvarterms[quadvarpos].eventdata->filterpos) );
547 
548  SCIPfreeBlockMemory(scip, &consdata->quadvarterms[quadvarpos].eventdata);
549 
550  return SCIP_OKAY;
551 }
552 
553 /** catch variable events */
554 static
556  SCIP* scip, /**< SCIP data structure */
557  SCIP_EVENTHDLR* eventhdlr, /**< event handler */
558  SCIP_CONS* cons /**< constraint for which to catch bound change events */
559  )
560 {
561  SCIP_CONSDATA* consdata;
562  SCIP_VAR* var;
563  int i;
564 
565  assert(scip != NULL);
566  assert(cons != NULL);
567  assert(eventhdlr != NULL);
568 
569  consdata = SCIPconsGetData(cons);
570  assert(consdata != NULL);
571  assert(consdata->lineventdata == NULL);
572 
573  /* we will update isremovedfixings, so reset it to TRUE first */
574  consdata->isremovedfixings = TRUE;
575 
576  SCIP_CALL( SCIPallocBlockMemoryArray(scip, &consdata->lineventdata, consdata->linvarssize) );
577  for( i = 0; i < consdata->nlinvars; ++i )
578  {
579  SCIP_CALL( catchLinearVarEvents(scip, eventhdlr, cons, i) );
580 
581  var = consdata->linvars[i];
582  consdata->isremovedfixings = consdata->isremovedfixings && SCIPvarIsActive(var)
583  && !SCIPisEQ(scip, SCIPvarGetLbGlobal(var), SCIPvarGetUbGlobal(var));
584  }
585 
586  for( i = 0; i < consdata->nquadvars; ++i )
587  {
588  assert(consdata->quadvarterms[i].eventdata == NULL);
589 
590  SCIP_CALL( catchQuadVarEvents(scip, eventhdlr, cons, i) );
591 
592  var = consdata->quadvarterms[i].var;
593  consdata->isremovedfixings = consdata->isremovedfixings && SCIPvarIsActive(var)
594  && !SCIPisEQ(scip, SCIPvarGetLbGlobal(var), SCIPvarGetUbGlobal(var));
595  }
596 
597  consdata->ispropagated = FALSE;
598 
599  return SCIP_OKAY;
600 }
601 
602 /** drop variable events */
603 static
605  SCIP* scip, /**< SCIP data structure */
606  SCIP_EVENTHDLR* eventhdlr, /**< event handler */
607  SCIP_CONS* cons /**< constraint for which to drop bound change events */
608  )
609 {
610  SCIP_CONSDATA* consdata;
611  int i;
612 
613  assert(scip != NULL);
614  assert(eventhdlr != NULL);
615  assert(cons != NULL);
616 
617  consdata = SCIPconsGetData(cons);
618  assert(consdata != NULL);
619 
620  if( consdata->lineventdata != NULL )
621  {
622  for( i = 0; i < consdata->nlinvars; ++i )
623  {
624  if( consdata->lineventdata[i] != NULL )
625  {
626  SCIP_CALL( dropLinearVarEvents(scip, eventhdlr, cons, i) );
627  }
628  }
629  SCIPfreeBlockMemoryArray(scip, &consdata->lineventdata, consdata->linvarssize);
630  }
631 
632  for( i = 0; i < consdata->nquadvars; ++i )
633  {
634  if( consdata->quadvarterms[i].eventdata != NULL )
635  {
636  SCIP_CALL( dropQuadVarEvents(scip, eventhdlr, cons, i) );
637  }
638  }
639 
640  return SCIP_OKAY;
641 }
642 
643 /** locks a linear variable in a constraint */
644 static
646  SCIP* scip, /**< SCIP data structure */
647  SCIP_CONS* cons, /**< constraint where to lock a variable */
648  SCIP_VAR* var, /**< variable to lock */
649  SCIP_Real coef /**< coefficient of variable in constraint */
650  )
651 {
652  SCIP_CONSDATA* consdata;
653 
654  assert(scip != NULL);
655  assert(cons != NULL);
656  assert(var != NULL);
657  assert(coef != 0.0);
658 
659  consdata = SCIPconsGetData(cons);
660  assert(consdata != NULL);
661 
662  if( coef > 0.0 )
663  {
664  SCIP_CALL( SCIPlockVarCons(scip, var, cons, !SCIPisInfinity(scip, -consdata->lhs), !SCIPisInfinity(scip, consdata->rhs)) );
665  }
666  else
667  {
668  SCIP_CALL( SCIPlockVarCons(scip, var, cons, !SCIPisInfinity(scip, consdata->rhs), !SCIPisInfinity(scip, -consdata->lhs)) );
669  }
670 
671  return SCIP_OKAY;
672 }
673 
674 /** unlocks a linear variable in a constraint */
675 static
677  SCIP* scip, /**< SCIP data structure */
678  SCIP_CONS* cons, /**< constraint where to unlock a variable */
679  SCIP_VAR* var, /**< variable to unlock */
680  SCIP_Real coef /**< coefficient of variable in constraint */
681  )
682 {
683  SCIP_CONSDATA* consdata;
684 
685  assert(scip != NULL);
686  assert(cons != NULL);
687  assert(var != NULL);
688  assert(coef != 0.0);
689 
690  consdata = SCIPconsGetData(cons);
691  assert(consdata != NULL);
692 
693  if( coef > 0.0 )
694  {
695  SCIP_CALL( SCIPunlockVarCons(scip, var, cons, !SCIPisInfinity(scip, -consdata->lhs), !SCIPisInfinity(scip, consdata->rhs)) );
696  }
697  else
698  {
699  SCIP_CALL( SCIPunlockVarCons(scip, var, cons, !SCIPisInfinity(scip, consdata->rhs), !SCIPisInfinity(scip, -consdata->lhs)) );
700  }
701 
702  return SCIP_OKAY;
703 }
704 
705 /** locks a quadratic variable in a constraint */
706 static
708  SCIP* scip, /**< SCIP data structure */
709  SCIP_CONS* cons, /**< constraint where to lock a variable */
710  SCIP_VAR* var /**< variable to lock */
711  )
712 {
713  SCIP_CALL( SCIPlockVarCons(scip, var, cons, TRUE, TRUE) );
714 
715  return SCIP_OKAY;
716 }
717 
718 /** unlocks a quadratic variable in a constraint */
719 static
721  SCIP* scip, /**< SCIP data structure */
722  SCIP_CONS* cons, /**< constraint where to unlock a variable */
723  SCIP_VAR* var /**< variable to unlock */
724  )
725 {
726  SCIP_CALL( SCIPunlockVarCons(scip, var, cons, TRUE, TRUE) );
727 
728  return SCIP_OKAY;
729 }
730 
731 /** computes the minimal and maximal activity for the linear part in a constraint data
732  *
733  * Only sums up terms that contribute finite values.
734  * Gives the number of terms that contribute infinite values.
735  * Only computes those activities where the corresponding side of the constraint is finite.
736  */
737 static
739  SCIP* scip, /**< SCIP data structure */
740  SCIP_CONSDATA* consdata, /**< constraint data */
741  SCIP_Real intervalinfty /**< infinity value used in interval operations */
742  )
743 { /*lint --e{666}*/
744  SCIP_ROUNDMODE prevroundmode;
745  int i;
746  SCIP_Real bnd;
747 
748  assert(scip != NULL);
749  assert(consdata != NULL);
750 
751  /* if variable bounds are not strictly consistent, then the activity update methods may yield inconsistent activities
752  * in this case, we also recompute the activities
753  */
754  if( consdata->minlinactivity != SCIP_INVALID && consdata->maxlinactivity != SCIP_INVALID && /*lint !e777 */
755  (consdata->minlinactivityinf > 0 || consdata->maxlinactivityinf > 0 || consdata->minlinactivity <= consdata->maxlinactivity) )
756  {
757  /* activities should be up-to-date */
758  assert(consdata->minlinactivityinf >= 0);
759  assert(consdata->maxlinactivityinf >= 0);
760  return;
761  }
762 
763  consdata->minlinactivityinf = 0;
764  consdata->maxlinactivityinf = 0;
765 
766  /* if lhs is -infinite, then we do not compute a maximal activity, so we set it to infinity
767  * if rhs is infinite, then we do not compute a minimal activity, so we set it to -infinity
768  */
769  consdata->minlinactivity = SCIPisInfinity(scip, consdata->rhs) ? -intervalinfty : 0.0;
770  consdata->maxlinactivity = SCIPisInfinity(scip, -consdata->lhs) ? intervalinfty : 0.0;
771 
772  if( consdata->nlinvars == 0 )
773  return;
774 
775  /* if the activities computed here should be still up-to-date after bound changes,
776  * variable events need to be caught */
777  assert(consdata->lineventdata != NULL);
778 
779  prevroundmode = SCIPintervalGetRoundingMode();
780 
781  if( !SCIPisInfinity(scip, consdata->rhs) )
782  {
783  /* compute minimal activity only if there is a finite right hand side */
785 
786  for( i = 0; i < consdata->nlinvars; ++i )
787  {
788  assert(consdata->lineventdata[i] != NULL);
789  if( consdata->lincoefs[i] >= 0.0 )
790  {
791  bnd = MIN(SCIPvarGetLbLocal(consdata->linvars[i]), SCIPvarGetUbLocal(consdata->linvars[i]));
792  if( SCIPisInfinity(scip, -bnd) )
793  {
794  ++consdata->minlinactivityinf;
795  continue;
796  }
797  assert(!SCIPisInfinity(scip, bnd)); /* do not like variables that are fixed at +infinity */
798  }
799  else
800  {
801  bnd = MAX(SCIPvarGetLbLocal(consdata->linvars[i]), SCIPvarGetUbLocal(consdata->linvars[i]));
802  if( SCIPisInfinity(scip, bnd) )
803  {
804  ++consdata->minlinactivityinf;
805  continue;
806  }
807  assert(!SCIPisInfinity(scip, -bnd)); /* do not like variables that are fixed at -infinity */
808  }
809  consdata->minlinactivity += consdata->lincoefs[i] * bnd;
810  }
811  }
812 
813  if( !SCIPisInfinity(scip, -consdata->lhs) )
814  {
815  /* compute maximal activity only if there is a finite left hand side */
817 
818  for( i = 0; i < consdata->nlinvars; ++i )
819  {
820  assert(consdata->lineventdata[i] != NULL);
821  if( consdata->lincoefs[i] >= 0.0 )
822  {
823  bnd = MAX(SCIPvarGetLbLocal(consdata->linvars[i]), SCIPvarGetUbLocal(consdata->linvars[i]));
824  if( SCIPisInfinity(scip, bnd) )
825  {
826  ++consdata->maxlinactivityinf;
827  continue;
828  }
829  assert(!SCIPisInfinity(scip, -bnd)); /* do not like variables that are fixed at -infinity */
830  }
831  else
832  {
833  bnd = MIN(SCIPvarGetLbLocal(consdata->linvars[i]), SCIPvarGetUbLocal(consdata->linvars[i]));
834  if( SCIPisInfinity(scip, -bnd) )
835  {
836  ++consdata->maxlinactivityinf;
837  continue;
838  }
839  assert(!SCIPisInfinity(scip, bnd)); /* do not like variables that are fixed at +infinity */
840  }
841  consdata->maxlinactivity += consdata->lincoefs[i] * bnd;
842  }
843  }
844 
845  SCIPintervalSetRoundingMode(prevroundmode);
846 
847  assert(consdata->minlinactivityinf > 0 || consdata->maxlinactivityinf > 0 || consdata->minlinactivity <= consdata->maxlinactivity);
848 }
849 
850 /** update the linear activities after a change in the lower bound of a variable */
851 static
853  SCIP* scip, /**< SCIP data structure */
854  SCIP_CONSDATA* consdata, /**< constraint data */
855  SCIP_Real coef, /**< coefficient of variable in constraint */
856  SCIP_Real oldbnd, /**< previous lower bound of variable */
857  SCIP_Real newbnd /**< new lower bound of variable */
858  )
859 {
860  SCIP_ROUNDMODE prevroundmode;
861 
862  assert(scip != NULL);
863  assert(consdata != NULL);
864  /* we can't deal with lower bounds at infinity */
865  assert(!SCIPisInfinity(scip, oldbnd));
866  assert(!SCIPisInfinity(scip, newbnd));
867 
868  /* @todo since we check the linear activity for consistency later anyway, we may skip changing the rounding mode here */
869 
870  /* assume lhs <= a*x + y <= rhs, then the following bound changes can be deduced:
871  * a > 0: y <= rhs - a*lb(x), y >= lhs - a*ub(x)
872  * a < 0: y <= rhs - a*ub(x), y >= lhs - a*lb(x)
873  */
874 
875  if( coef > 0.0 )
876  {
877  /* we should only be called if rhs is finite */
878  assert(!SCIPisInfinity(scip, consdata->rhs));
879 
880  /* we have no min activities computed so far, so cannot update */
881  if( consdata->minlinactivity == SCIP_INVALID ) /*lint !e777 */
882  return;
883 
884  prevroundmode = SCIPintervalGetRoundingMode();
886 
887  /* update min activity */
888  if( SCIPisInfinity(scip, -oldbnd) )
889  {
890  --consdata->minlinactivityinf;
891  assert(consdata->minlinactivityinf >= 0);
892  }
893  else
894  {
895  SCIP_Real minuscoef;
896  minuscoef = -coef;
897  consdata->minlinactivity += minuscoef * oldbnd;
898  }
899 
900  if( SCIPisInfinity(scip, -newbnd) )
901  {
902  ++consdata->minlinactivityinf;
903  }
904  else
905  {
906  consdata->minlinactivity += coef * newbnd;
907  }
908 
909  SCIPintervalSetRoundingMode(prevroundmode);
910  }
911  else
912  {
913  /* we should only be called if lhs is finite */
914  assert(!SCIPisInfinity(scip, -consdata->lhs));
915 
916  /* we have no max activities computed so far, so cannot update */
917  if( consdata->maxlinactivity == SCIP_INVALID ) /*lint !e777 */
918  return;
919 
920  prevroundmode = SCIPintervalGetRoundingMode();
922 
923  /* update max activity */
924  if( SCIPisInfinity(scip, -oldbnd) )
925  {
926  --consdata->maxlinactivityinf;
927  assert(consdata->maxlinactivityinf >= 0);
928  }
929  else
930  {
931  SCIP_Real minuscoef;
932  minuscoef = -coef;
933  consdata->maxlinactivity += minuscoef * oldbnd;
934  }
935 
936  if( SCIPisInfinity(scip, -newbnd) )
937  {
938  ++consdata->maxlinactivityinf;
939  }
940  else
941  {
942  consdata->maxlinactivity += coef * newbnd;
943  }
944 
945  SCIPintervalSetRoundingMode(prevroundmode);
946  }
947 }
948 
949 /** update the linear activities after a change in the upper bound of a variable */
950 static
952  SCIP* scip, /**< SCIP data structure */
953  SCIP_CONSDATA* consdata, /**< constraint data */
954  SCIP_Real coef, /**< coefficient of variable in constraint */
955  SCIP_Real oldbnd, /**< previous lower bound of variable */
956  SCIP_Real newbnd /**< new lower bound of variable */
957  )
958 {
959  SCIP_ROUNDMODE prevroundmode;
960 
961  assert(scip != NULL);
962  assert(consdata != NULL);
963  /* we can't deal with upper bounds at -infinity */
964  assert(!SCIPisInfinity(scip, -oldbnd));
965  assert(!SCIPisInfinity(scip, -newbnd));
966 
967  /* @todo since we check the linear activity for consistency later anyway, we may skip changing the rounding mode here */
968 
969  /* assume lhs <= a*x + y <= rhs, then the following bound changes can be deduced:
970  * a > 0: y <= rhs - a*lb(x), y >= lhs - a*ub(x)
971  * a < 0: y <= rhs - a*ub(x), y >= lhs - a*lb(x)
972  */
973 
974  if( coef > 0.0 )
975  {
976  /* we should only be called if lhs is finite */
977  assert(!SCIPisInfinity(scip, -consdata->lhs));
978 
979  /* we have no max activities computed so far, so cannot update */
980  if( consdata->maxlinactivity == SCIP_INVALID ) /*lint !e777 */
981  return;
982 
983  prevroundmode = SCIPintervalGetRoundingMode();
985 
986  /* update max activity */
987  if( SCIPisInfinity(scip, oldbnd) )
988  {
989  --consdata->maxlinactivityinf;
990  assert(consdata->maxlinactivityinf >= 0);
991  }
992  else
993  {
994  SCIP_Real minuscoef;
995  minuscoef = -coef;
996  consdata->maxlinactivity += minuscoef * oldbnd;
997  }
998 
999  if( SCIPisInfinity(scip, newbnd) )
1000  {
1001  ++consdata->maxlinactivityinf;
1002  }
1003  else
1004  {
1005  consdata->maxlinactivity += coef * newbnd;
1006  }
1007 
1008  SCIPintervalSetRoundingMode(prevroundmode);
1009  }
1010  else
1011  {
1012  /* we should only be called if rhs is finite */
1013  assert(!SCIPisInfinity(scip, consdata->rhs));
1014 
1015  /* we have no min activities computed so far, so cannot update */
1016  if( consdata->minlinactivity == SCIP_INVALID ) /*lint !e777 */
1017  return;
1018 
1019  prevroundmode = SCIPintervalGetRoundingMode();
1021 
1022  /* update min activity */
1023  if( SCIPisInfinity(scip, oldbnd) )
1024  {
1025  --consdata->minlinactivityinf;
1026  assert(consdata->minlinactivityinf >= 0);
1027  }
1028  else
1029  {
1030  SCIP_Real minuscoef;
1031  minuscoef = -coef;
1032  consdata->minlinactivity += minuscoef * oldbnd;
1033  }
1034 
1035  if( SCIPisInfinity(scip, newbnd) )
1036  {
1037  ++consdata->minlinactivityinf;
1038  }
1039  else
1040  {
1041  consdata->minlinactivity += coef * newbnd;
1042  }
1043 
1044  SCIPintervalSetRoundingMode(prevroundmode);
1045  }
1046 }
1047 
1048 /** returns whether a quadratic variable domain can be reduced to its lower or upper bound; this is the case if the
1049  * quadratic variable is in just one single quadratic constraint and (sqrcoef > 0 and LHS = -infinity), or
1050  * (sqrcoef < 0 and RHS = +infinity) hold
1051  */
1052 static
1054  SCIP* scip, /**< SCIP data structure */
1055  SCIP_CONSDATA* consdata, /**< constraint data */
1056  int idx /**< index of quadratic variable */
1057  )
1058 {
1059  SCIP_VAR* var;
1060  SCIP_Real quadcoef;
1061  SCIP_Bool haslhs;
1062  SCIP_Bool hasrhs;
1063 
1064  assert(scip != NULL);
1065  assert(consdata != NULL);
1066  assert(idx >= 0 && idx < consdata->nquadvars);
1067 
1068  var = consdata->quadvarterms[idx].var;
1069  assert(var != NULL);
1070 
1071  quadcoef = consdata->quadvarterms[idx].sqrcoef;
1072  haslhs = !SCIPisInfinity(scip, -consdata->lhs);
1073  hasrhs = !SCIPisInfinity(scip, consdata->rhs);
1074 
1077  && SCIPvarGetType(var) != SCIP_VARTYPE_BINARY && ((quadcoef < 0.0 && !haslhs) || (quadcoef > 0.0 && !hasrhs));
1078 }
1079 
1080 /** processes variable fixing or bound change event */
1081 static
1082 SCIP_DECL_EVENTEXEC(processVarEvent)
1084  SCIP_CONS* cons;
1085  SCIP_CONSDATA* consdata;
1086  SCIP_EVENTTYPE eventtype;
1087  int varidx;
1088 
1089  assert(scip != NULL);
1090  assert(event != NULL);
1091  assert(eventdata != NULL);
1092  assert(eventhdlr != NULL);
1093 
1094  cons = ((SCIP_QUADVAREVENTDATA*)eventdata)->cons;
1095  assert(cons != NULL);
1096  consdata = SCIPconsGetData(cons);
1097  assert(consdata != NULL);
1098 
1099  varidx = ((SCIP_QUADVAREVENTDATA*)eventdata)->varidx;
1100  assert(varidx < 0 || varidx < consdata->nlinvars);
1101  assert(varidx >= 0 || -varidx-1 < consdata->nquadvars);
1102 
1103  eventtype = SCIPeventGetType(event);
1104 
1105  /* process local bound changes */
1106  if( eventtype & SCIP_EVENTTYPE_BOUNDCHANGED )
1107  {
1108  if( varidx < 0 )
1109  {
1110  /* mark activity bounds for quad term as not up to date anymore */
1111  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
1112  }
1113  else
1114  {
1115  /* update activity bounds for linear terms */
1116  if( eventtype & SCIP_EVENTTYPE_LBCHANGED )
1117  consdataUpdateLinearActivityLbChange(scip, consdata, consdata->lincoefs[varidx], SCIPeventGetOldbound(event), SCIPeventGetNewbound(event));
1118  else
1119  consdataUpdateLinearActivityUbChange(scip, consdata, consdata->lincoefs[varidx], SCIPeventGetOldbound(event), SCIPeventGetNewbound(event));
1120  }
1121 
1122  if( eventtype & SCIP_EVENTTYPE_BOUNDTIGHTENED )
1123  {
1124  SCIP_CALL( SCIPmarkConsPropagate(scip, cons) );
1125  consdata->ispropagated = FALSE;
1126  }
1127  }
1128 
1129  /* process global bound changes */
1130  if( eventtype & SCIP_EVENTTYPE_GBDCHANGED )
1131  {
1132  SCIP_VAR* var;
1133 
1134  var = varidx < 0 ? consdata->quadvarterms[-varidx-1].var : consdata->linvars[varidx];
1135  assert(var != NULL);
1136 
1137  if( varidx < 0 )
1138  {
1139  SCIP_QUADVARTERM* quadvarterm;
1140 
1141  quadvarterm = &consdata->quadvarterms[-varidx-1];
1142 
1143  /* if an integer variable x with a x^2 is tightened to [0,1], then we can replace the x^2 by x, which is done in mergeAndCleanQuadVarTerms()
1144  * we currently do this only if the binary variable does not show up in any bilinear terms
1145  */
1147  quadvarterm->sqrcoef != 0.0 && quadvarterm->nadjbilin == 0 )
1148  {
1149  consdata->quadvarsmerged = FALSE;
1150  consdata->initialmerge = FALSE;
1151  }
1152  }
1153 
1154  if( SCIPisEQ(scip, SCIPvarGetLbGlobal(var), SCIPvarGetUbGlobal(var)) )
1155  consdata->isremovedfixings = FALSE;
1156  }
1157 
1158  /* process variable fixing event */
1159  if( eventtype & SCIP_EVENTTYPE_VARFIXED )
1160  {
1161  consdata->isremovedfixings = FALSE;
1162  }
1163 
1164 #ifdef CHECKIMPLINBILINEAR
1165  if( eventtype & SCIP_EVENTTYPE_IMPLADDED )
1166  {
1167  assert(varidx < 0); /* we catch impladded events only for quadratic variables */
1168  /* if variable is binary (quite likely if an implication has been added) and occurs in a bilinear term, then mark that we should check implications */
1169  if( SCIPvarIsBinary(SCIPeventGetVar(event)) && consdata->quadvarterms[-varidx-1].nadjbilin > 0 )
1170  consdata->isimpladded = TRUE;
1171  }
1172 #endif
1173 
1174  return SCIP_OKAY;
1175 }
1176 
1177 /** ensures, that linear vars and coefs arrays can store at least num entries */
1178 static
1180  SCIP* scip, /**< SCIP data structure */
1181  SCIP_CONSDATA* consdata, /**< quadratic constraint data */
1182  int num /**< minimum number of entries to store */
1183  )
1184 {
1185  assert(scip != NULL);
1186  assert(consdata != NULL);
1187  assert(consdata->nlinvars <= consdata->linvarssize);
1188 
1189  if( num > consdata->linvarssize )
1190  {
1191  int newsize;
1192 
1193  newsize = SCIPcalcMemGrowSize(scip, num);
1194  SCIP_CALL( SCIPreallocBlockMemoryArray(scip, &consdata->linvars, consdata->linvarssize, newsize) );
1195  SCIP_CALL( SCIPreallocBlockMemoryArray(scip, &consdata->lincoefs, consdata->linvarssize, newsize) );
1196  if( consdata->lineventdata != NULL )
1197  {
1198  SCIP_CALL( SCIPreallocBlockMemoryArray(scip, &consdata->lineventdata, consdata->linvarssize, newsize) );
1199  }
1200  consdata->linvarssize = newsize;
1201  }
1202  assert(num <= consdata->linvarssize);
1203 
1204  return SCIP_OKAY;
1205 }
1206 
1207 /** ensures, that quadratic variable terms array can store at least num entries */
1208 static
1210  SCIP* scip, /**< SCIP data structure */
1211  SCIP_CONSDATA* consdata, /**< quadratic constraint data */
1212  int num /**< minimum number of entries to store */
1213  )
1214 {
1215  assert(scip != NULL);
1216  assert(consdata != NULL);
1217  assert(consdata->nquadvars <= consdata->quadvarssize);
1218 
1219  if( num > consdata->quadvarssize )
1220  {
1221  int newsize;
1222 
1223  newsize = SCIPcalcMemGrowSize(scip, num);
1224  SCIP_CALL( SCIPreallocBlockMemoryArray(scip, &consdata->quadvarterms, consdata->quadvarssize, newsize) );
1225  consdata->quadvarssize = newsize;
1226  }
1227  assert(num <= consdata->quadvarssize);
1228 
1229  return SCIP_OKAY;
1230 }
1231 
1232 /** ensures, that adjacency array can store at least num entries */
1233 static
1235  SCIP* scip, /**< SCIP data structure */
1236  SCIP_QUADVARTERM* quadvarterm, /**< quadratic variable term */
1237  int num /**< minimum number of entries to store */
1238  )
1239 {
1240  assert(scip != NULL);
1241  assert(quadvarterm != NULL);
1242  assert(quadvarterm->nadjbilin <= quadvarterm->adjbilinsize);
1243 
1244  if( num > quadvarterm->adjbilinsize )
1245  {
1246  int newsize;
1247 
1248  newsize = SCIPcalcMemGrowSize(scip, num);
1249  SCIP_CALL( SCIPreallocBlockMemoryArray(scip, &quadvarterm->adjbilin, quadvarterm->adjbilinsize, newsize) );
1250  quadvarterm->adjbilinsize = newsize;
1251  }
1252  assert(num <= quadvarterm->adjbilinsize);
1253 
1254  return SCIP_OKAY;
1255 }
1256 
1257 /** ensures, that bilinear term arrays can store at least num entries */
1258 static
1260  SCIP* scip, /**< SCIP data structure */
1261  SCIP_CONSDATA* consdata, /**< quadratic constraint data */
1262  int num /**< minimum number of entries to store */
1263  )
1264 {
1265  assert(scip != NULL);
1266  assert(consdata != NULL);
1267  assert(consdata->nbilinterms <= consdata->bilintermssize);
1268 
1269  if( num > consdata->bilintermssize )
1270  {
1271  int newsize;
1272 
1273  newsize = SCIPcalcMemGrowSize(scip, num);
1274  SCIP_CALL( SCIPreallocBlockMemoryArray(scip, &consdata->bilinterms, consdata->bilintermssize, newsize) );
1275  consdata->bilintermssize = newsize;
1276  }
1277  assert(num <= consdata->bilintermssize);
1278 
1279  return SCIP_OKAY;
1280 }
1281 
1282 /** creates empty constraint data structure */
1283 static
1285  SCIP* scip, /**< SCIP data structure */
1286  SCIP_CONSDATA** consdata /**< a buffer to store pointer to new constraint data */
1287  )
1288 {
1289  assert(scip != NULL);
1290  assert(consdata != NULL);
1291 
1292  SCIP_CALL( SCIPallocBlockMemory(scip, consdata) );
1293  BMSclearMemory(*consdata);
1294 
1295  (*consdata)->lhs = -SCIPinfinity(scip);
1296  (*consdata)->rhs = SCIPinfinity(scip);
1297 
1298  (*consdata)->linvarssorted = TRUE;
1299  (*consdata)->linvarsmerged = TRUE;
1300  (*consdata)->quadvarssorted = TRUE;
1301  (*consdata)->quadvarsmerged = TRUE;
1302  (*consdata)->bilinsorted = TRUE;
1303  (*consdata)->bilinmerged = TRUE;
1304 
1305  (*consdata)->isremovedfixings = TRUE;
1306  (*consdata)->ispropagated = TRUE;
1307  (*consdata)->initialmerge = FALSE;
1308 
1309  (*consdata)->linvar_maydecrease = -1;
1310  (*consdata)->linvar_mayincrease = -1;
1311 
1312  (*consdata)->minlinactivity = SCIP_INVALID;
1313  (*consdata)->maxlinactivity = SCIP_INVALID;
1314  (*consdata)->minlinactivityinf = -1;
1315  (*consdata)->maxlinactivityinf = -1;
1316 
1317  (*consdata)->isgaugeavailable = FALSE;
1318  (*consdata)->isedavailable = FALSE;
1319 
1320  return SCIP_OKAY;
1321 }
1322 
1323 /** creates constraint data structure */
1324 static
1326  SCIP* scip, /**< SCIP data structure */
1327  SCIP_CONSDATA** consdata, /**< a buffer to store pointer to new constraint data */
1328  SCIP_Real lhs, /**< left hand side of constraint */
1329  SCIP_Real rhs, /**< right hand side of constraint */
1330  int nlinvars, /**< number of linear variables */
1331  SCIP_VAR** linvars, /**< array of linear variables */
1332  SCIP_Real* lincoefs, /**< array of coefficients of linear variables */
1333  int nquadvars, /**< number of quadratic variables */
1334  SCIP_QUADVARTERM* quadvarterms, /**< array of quadratic variable terms */
1335  int nbilinterms, /**< number of bilinear terms */
1336  SCIP_BILINTERM* bilinterms, /**< array of bilinear terms */
1337  SCIP_Bool capturevars /**< whether we should capture variables */
1338  )
1339 {
1340  int i;
1341 
1342  assert(scip != NULL);
1343  assert(consdata != NULL);
1344 
1345  assert(nlinvars == 0 || linvars != NULL);
1346  assert(nlinvars == 0 || lincoefs != NULL);
1347  assert(nquadvars == 0 || quadvarterms != NULL);
1348  assert(nbilinterms == 0 || bilinterms != NULL);
1349 
1350  SCIP_CALL( SCIPallocBlockMemory(scip, consdata) );
1351  BMSclearMemory(*consdata);
1352 
1353  (*consdata)->minlinactivity = SCIP_INVALID;
1354  (*consdata)->maxlinactivity = SCIP_INVALID;
1355  (*consdata)->minlinactivityinf = -1;
1356  (*consdata)->maxlinactivityinf = -1;
1357 
1358  (*consdata)->lhs = lhs;
1359  (*consdata)->rhs = rhs;
1360 
1361  if( nlinvars > 0 )
1362  {
1363  SCIP_CALL( SCIPduplicateBlockMemoryArray(scip, &(*consdata)->linvars, linvars, nlinvars) );
1364  SCIP_CALL( SCIPduplicateBlockMemoryArray(scip, &(*consdata)->lincoefs, lincoefs, nlinvars) );
1365  (*consdata)->nlinvars = nlinvars;
1366  (*consdata)->linvarssize = nlinvars;
1367 
1368  if( capturevars )
1369  for( i = 0; i < nlinvars; ++i )
1370  {
1371  SCIP_CALL( SCIPcaptureVar(scip, linvars[i]) );
1372  }
1373  }
1374  else
1375  {
1376  (*consdata)->linvarssorted = TRUE;
1377  (*consdata)->linvarsmerged = TRUE;
1378  (*consdata)->minlinactivity = 0.0;
1379  (*consdata)->maxlinactivity = 0.0;
1380  (*consdata)->minlinactivityinf = 0;
1381  (*consdata)->maxlinactivityinf = 0;
1382  }
1383 
1384  if( nquadvars > 0 )
1385  {
1386  SCIP_CALL( SCIPduplicateBlockMemoryArray(scip, &(*consdata)->quadvarterms, quadvarterms, nquadvars) );
1387 
1388  for( i = 0; i < nquadvars; ++i )
1389  {
1390  (*consdata)->quadvarterms[i].eventdata = NULL;
1391  if( quadvarterms[i].nadjbilin )
1392  {
1393  SCIP_CALL( SCIPduplicateBlockMemoryArray(scip, &(*consdata)->quadvarterms[i].adjbilin, quadvarterms[i].adjbilin, quadvarterms[i].nadjbilin) );
1394  (*consdata)->quadvarterms[i].adjbilinsize = quadvarterms[i].nadjbilin;
1395  }
1396  else
1397  {
1398  assert((*consdata)->quadvarterms[i].nadjbilin == 0);
1399  (*consdata)->quadvarterms[i].adjbilin = NULL;
1400  (*consdata)->quadvarterms[i].adjbilinsize = 0;
1401  }
1402  if( capturevars )
1403  {
1404  SCIP_CALL( SCIPcaptureVar(scip, quadvarterms[i].var) );
1405  }
1406  }
1407 
1408  (*consdata)->nquadvars = nquadvars;
1409  (*consdata)->quadvarssize = nquadvars;
1410  SCIPintervalSetEmpty(&(*consdata)->quadactivitybounds);
1411  }
1412  else
1413  {
1414  (*consdata)->quadvarssorted = TRUE;
1415  (*consdata)->quadvarsmerged = TRUE;
1416  SCIPintervalSet(&(*consdata)->quadactivitybounds, 0.0);
1417  }
1418 
1419  if( nbilinterms > 0 )
1420  {
1421  SCIP_CALL( SCIPduplicateBlockMemoryArray(scip, &(*consdata)->bilinterms, bilinterms, nbilinterms) );
1422  (*consdata)->nbilinterms = nbilinterms;
1423  (*consdata)->bilintermssize = nbilinterms;
1424  }
1425  else
1426  {
1427  (*consdata)->bilinsorted = TRUE;
1428  (*consdata)->bilinmerged = TRUE;
1429  }
1430 
1431  (*consdata)->linvar_maydecrease = -1;
1432  (*consdata)->linvar_mayincrease = -1;
1433 
1434  (*consdata)->activity = SCIP_INVALID;
1435  (*consdata)->lhsviol = SCIPisInfinity(scip, -lhs) ? 0.0 : SCIP_INVALID;
1436  (*consdata)->rhsviol = SCIPisInfinity(scip, rhs) ? 0.0 : SCIP_INVALID;
1437 
1438  (*consdata)->isgaugeavailable = FALSE;
1439 
1440  return SCIP_OKAY;
1441 }
1442 
1443 /** frees constraint data structure */
1444 static
1446  SCIP* scip, /**< SCIP data structure */
1447  SCIP_CONSDATA** consdata /**< pointer to constraint data to free */
1448  )
1449 {
1450  int i;
1451 
1452  assert(scip != NULL);
1453  assert(consdata != NULL);
1454  assert(*consdata != NULL);
1455 
1456  /* free sepa arrays, may exists if constraint is deleted in solving stage */
1457  SCIPfreeBlockMemoryArrayNull(scip, &(*consdata)->sepaquadvars, (*consdata)->nquadvars);
1458  SCIPfreeBlockMemoryArrayNull(scip, &(*consdata)->sepabilinvar2pos, (*consdata)->nbilinterms);
1459 
1460  /* release linear variables and free linear part */
1461  if( (*consdata)->linvarssize > 0 )
1462  {
1463  for( i = 0; i < (*consdata)->nlinvars; ++i )
1464  {
1465  assert((*consdata)->lineventdata == NULL || (*consdata)->lineventdata[i] == NULL); /* variable events should have been dropped earlier */
1466  SCIP_CALL( SCIPreleaseVar(scip, &(*consdata)->linvars[i]) );
1467  }
1468  SCIPfreeBlockMemoryArray(scip, &(*consdata)->linvars, (*consdata)->linvarssize);
1469  SCIPfreeBlockMemoryArray(scip, &(*consdata)->lincoefs, (*consdata)->linvarssize);
1470  SCIPfreeBlockMemoryArrayNull(scip, &(*consdata)->lineventdata, (*consdata)->linvarssize);
1471  }
1472  assert((*consdata)->linvars == NULL);
1473  assert((*consdata)->lincoefs == NULL);
1474  assert((*consdata)->lineventdata == NULL);
1475 
1476  /* release quadratic variables and free quadratic variable term part */
1477  for( i = 0; i < (*consdata)->nquadvars; ++i )
1478  {
1479  assert((*consdata)->quadvarterms[i].eventdata == NULL); /* variable events should have been dropped earlier */
1480  SCIPfreeBlockMemoryArrayNull(scip, &(*consdata)->quadvarterms[i].adjbilin, (*consdata)->quadvarterms[i].adjbilinsize);
1481  SCIP_CALL( SCIPreleaseVar(scip, &(*consdata)->quadvarterms[i].var) );
1482  }
1483  SCIPfreeBlockMemoryArrayNull(scip, &(*consdata)->quadvarterms, (*consdata)->quadvarssize);
1484 
1485  /* free bilinear terms */
1486  SCIPfreeBlockMemoryArrayNull(scip, &(*consdata)->bilinterms, (*consdata)->bilintermssize);
1487 
1488  /* free nonlinear row representation */
1489  if( (*consdata)->nlrow != NULL )
1490  {
1491  SCIP_CALL( SCIPreleaseNlRow(scip, &(*consdata)->nlrow) );
1492  }
1493 
1494  /* free interior point information, may exists if constraint is deleted in solving stage */
1495  SCIPfreeBlockMemoryArrayNull(scip, &(*consdata)->interiorpoint, (*consdata)->nquadvars);
1496  SCIPfreeBlockMemoryArrayNull(scip, &(*consdata)->gaugecoefs, (*consdata)->nquadvars);
1497 
1498  /* free eigen decomposition information */
1499  SCIPfreeBlockMemoryArrayNull(scip, &(*consdata)->eigenvalues, (*consdata)->nquadvars);
1500  SCIPfreeBlockMemoryArrayNull(scip, &(*consdata)->eigenvectors, (int)((*consdata)->nquadvars*(*consdata)->nquadvars));
1501  SCIPfreeBlockMemoryArrayNull(scip, &(*consdata)->bp, (*consdata)->nquadvars);
1502 
1503  /* free unique indices of bilinear terms array */
1504  SCIPfreeBlockMemoryArrayNull(scip, &(*consdata)->bilintermsidx, (*consdata)->nbilinterms);
1505 
1506  SCIPfreeBlockMemory(scip, consdata);
1507  *consdata = NULL;
1508 
1509  return SCIP_OKAY;
1510 }
1511 
1512 /** sorts linear part of constraint data */
1513 static
1515  SCIP_CONSDATA* consdata /**< quadratic constraint data */
1516  )
1517 {
1518  assert(consdata != NULL);
1519 
1520  if( consdata->linvarssorted )
1521  return;
1522 
1523  if( consdata->nlinvars <= 1 )
1524  {
1525  consdata->linvarssorted = TRUE;
1526  return;
1527  }
1528 
1529  if( consdata->lineventdata == NULL )
1530  {
1531  SCIPsortPtrReal((void**)consdata->linvars, consdata->lincoefs, SCIPvarComp, consdata->nlinvars);
1532  }
1533  else
1534  {
1535  int i;
1536 
1537  SCIPsortPtrPtrReal((void**)consdata->linvars, (void**)consdata->lineventdata, consdata->lincoefs, SCIPvarComp, consdata->nlinvars);
1538 
1539  /* update variable indices in event data */
1540  for( i = 0; i < consdata->nlinvars; ++i )
1541  if( consdata->lineventdata[i] != NULL )
1542  consdata->lineventdata[i]->varidx = i;
1543  }
1544 
1545  consdata->linvarssorted = TRUE;
1546 }
1547 
1548 #ifdef SCIP_DISABLED_CODE /* no-one needs this routine currently */
1549 /** returns the position of variable in the linear coefficients array of a constraint, or -1 if not found */
1550 static
1551 int consdataFindLinearVar(
1552  SCIP_CONSDATA* consdata, /**< quadratic constraint data */
1553  SCIP_VAR* var /**< variable to search for */
1554  )
1555 {
1556  int pos;
1557 
1558  assert(consdata != NULL);
1559  assert(var != NULL);
1560 
1561  if( consdata->nlinvars == 0 )
1562  return -1;
1563 
1564  consdataSortLinearVars(consdata);
1565 
1566  if( !SCIPsortedvecFindPtr((void**)consdata->linvars, SCIPvarComp, (void*)var, consdata->nlinvars, &pos) )
1567  pos = -1;
1568 
1569  return pos;
1570 }
1571 #endif
1572 
1573 /** index comparison method for quadratic variable terms: compares two indices of the quadratic variable set in the quadratic constraint */
1574 static
1575 SCIP_DECL_SORTINDCOMP(quadVarTermComp)
1576 { /*lint --e{715}*/
1577  SCIP_CONSDATA* consdata = (SCIP_CONSDATA*)dataptr;
1578 
1579  assert(consdata != NULL);
1580  assert(0 <= ind1 && ind1 < consdata->nquadvars);
1581  assert(0 <= ind2 && ind2 < consdata->nquadvars);
1582 
1583  return SCIPvarCompare(consdata->quadvarterms[ind1].var, consdata->quadvarterms[ind2].var);
1584 }
1585 
1586 /** sorting of quadratic variable terms */
1587 static
1589  SCIP* scip, /**< SCIP data structure */
1590  SCIP_CONSDATA* consdata /**< quadratic constraint data */
1591  )
1592 {
1593  int* perm;
1594  int i;
1595  int nexti;
1596  int v;
1597  SCIP_QUADVARTERM quadterm;
1598 
1599  assert(scip != NULL);
1600  assert(consdata != NULL);
1601 
1602  if( consdata->quadvarssorted )
1603  return SCIP_OKAY;
1604 
1605  if( consdata->nquadvars == 0 )
1606  {
1607  consdata->quadvarssorted = TRUE;
1608  return SCIP_OKAY;
1609  }
1610 
1611  /* get temporary memory to store the sorted permutation */
1612  SCIP_CALL( SCIPallocBufferArray(scip, &perm, consdata->nquadvars) );
1613 
1614  /* call bubble sort */
1615  SCIPsort(perm, quadVarTermComp, (void*)consdata, consdata->nquadvars);
1616 
1617  /* permute the quadratic variable terms according to the resulting permutation */
1618  for( v = 0; v < consdata->nquadvars; ++v )
1619  {
1620  if( perm[v] != v )
1621  {
1622  quadterm = consdata->quadvarterms[v];
1623 
1624  i = v;
1625  do
1626  {
1627  assert(0 <= perm[i] && perm[i] < consdata->nquadvars);
1628  assert(perm[i] != i);
1629  consdata->quadvarterms[i] = consdata->quadvarterms[perm[i]];
1630  if( consdata->quadvarterms[i].eventdata != NULL )
1631  {
1632  consdata->quadvarterms[i].eventdata->varidx = -i-1;
1633  }
1634  nexti = perm[i];
1635  perm[i] = i;
1636  i = nexti;
1637  }
1638  while( perm[i] != v );
1639  consdata->quadvarterms[i] = quadterm;
1640  if( consdata->quadvarterms[i].eventdata != NULL )
1641  {
1642  consdata->quadvarterms[i].eventdata->varidx = -i-1;
1643  }
1644  perm[i] = i;
1645  }
1646  }
1647  consdata->quadvarssorted = TRUE;
1648 
1649  /* free temporary memory */
1650  SCIPfreeBufferArray(scip, &perm);
1651 
1652  return SCIP_OKAY;
1653 }
1654 
1655 /** returns the position of variable in the quadratic variable terms array of a constraint, or -1 if not found */
1656 static
1658  SCIP* scip, /**< SCIP data structure */
1659  SCIP_CONSDATA* consdata, /**< quadratic constraint data */
1660  SCIP_VAR* var, /**< variable to search for */
1661  int* pos /**< buffer where to store position of var in quadvarterms array, or -1 if not found */
1662  )
1663 {
1664  int left;
1665  int right;
1666  int cmpres;
1667 
1668  assert(consdata != NULL);
1669  assert(var != NULL);
1670  assert(pos != NULL);
1671 
1672  if( consdata->nquadvars == 0 )
1673  {
1674  *pos = -1;
1675  return SCIP_OKAY;
1676  }
1677 
1678  SCIP_CALL( consdataSortQuadVarTerms(scip, consdata) );
1679 
1680  left = 0;
1681  right = consdata->nquadvars - 1;
1682  while( left <= right )
1683  {
1684  int middle;
1685 
1686  middle = (left+right)/2;
1687  assert(0 <= middle && middle < consdata->nquadvars);
1688 
1689  cmpres = SCIPvarCompare(var, consdata->quadvarterms[middle].var);
1690 
1691  if( cmpres < 0 )
1692  right = middle - 1;
1693  else if( cmpres > 0 )
1694  left = middle + 1;
1695  else
1696  {
1697  *pos = middle;
1698  return SCIP_OKAY;
1699  }
1700  }
1701  assert(left == right+1);
1702 
1703  *pos = -1;
1704 
1705  return SCIP_OKAY;
1706 }
1707 
1708 /** index comparison method for bilinear terms: compares two index pairs of the bilinear term set in the quadratic constraint */
1709 static
1710 SCIP_DECL_SORTINDCOMP(bilinTermComp)
1711 { /*lint --e{715}*/
1712  SCIP_CONSDATA* consdata = (SCIP_CONSDATA*)dataptr;
1713  int var1cmp;
1714 
1715  assert(consdata != NULL);
1716  assert(0 <= ind1 && ind1 < consdata->nbilinterms);
1717  assert(0 <= ind2 && ind2 < consdata->nbilinterms);
1718 
1719  var1cmp = SCIPvarCompare(consdata->bilinterms[ind1].var1, consdata->bilinterms[ind2].var1);
1720  if( var1cmp != 0 )
1721  return var1cmp;
1722 
1723  return SCIPvarCompare(consdata->bilinterms[ind1].var2, consdata->bilinterms[ind2].var2);
1724 }
1725 
1726 #ifndef NDEBUG
1727 /** checks if all bilinear terms are sorted correctly */
1728 static
1730  SCIP_CONSDATA* consdata
1731  )
1732 {
1733  int i;
1734 
1735  assert(consdata != NULL);
1736 
1737  /* nothing to check if the bilinear terms have not been sorted yet */
1738  if( !consdata->bilinsorted )
1739  return TRUE;
1740 
1741  for( i = 0; i < consdata->nbilinterms - 1; ++i )
1742  {
1743  if( bilinTermComp(consdata, i, i+1) > 0 )
1744  return FALSE;
1745  }
1746  return TRUE;
1747 }
1748 #endif
1749 
1750 /** sorting of bilinear terms */
1751 static
1753  SCIP* scip, /**< SCIP data structure */
1754  SCIP_CONSDATA* consdata /**< quadratic constraint data */
1755  )
1756 {
1757  int* perm;
1758  int* invperm;
1759  int i;
1760  int nexti;
1761  int v;
1762  SCIP_BILINTERM bilinterm;
1763 
1764  assert(scip != NULL);
1765  assert(consdata != NULL);
1766 
1767  if( consdata->bilinsorted )
1768  return SCIP_OKAY;
1769 
1770  if( consdata->nbilinterms == 0 )
1771  {
1772  consdata->bilinsorted = TRUE;
1773  return SCIP_OKAY;
1774  }
1775 
1776  /* get temporary memory to store the sorted permutation and the inverse permutation */
1777  SCIP_CALL( SCIPallocBufferArray(scip, &perm, consdata->nbilinterms) );
1778  SCIP_CALL( SCIPallocBufferArray(scip, &invperm, consdata->nbilinterms) );
1779 
1780  /* call bubble sort */
1781  SCIPsort(perm, bilinTermComp, (void*)consdata, consdata->nbilinterms);
1782 
1783  /* compute inverted permutation */
1784  for( v = 0; v < consdata->nbilinterms; ++v )
1785  {
1786  assert(0 <= perm[v] && perm[v] < consdata->nbilinterms);
1787  invperm[perm[v]] = v;
1788  }
1789 
1790  /* permute the bilinear terms according to the resulting permutation */
1791  for( v = 0; v < consdata->nbilinterms; ++v )
1792  {
1793  if( perm[v] != v )
1794  {
1795  bilinterm = consdata->bilinterms[v];
1796 
1797  i = v;
1798  do
1799  {
1800  assert(0 <= perm[i] && perm[i] < consdata->nbilinterms);
1801  assert(perm[i] != i);
1802  consdata->bilinterms[i] = consdata->bilinterms[perm[i]];
1803  nexti = perm[i];
1804  perm[i] = i;
1805  i = nexti;
1806  }
1807  while( perm[i] != v );
1808  consdata->bilinterms[i] = bilinterm;
1809  perm[i] = i;
1810  }
1811  }
1812 
1813  /* update the adjacency information in the quadratic variable terms */
1814  for( v = 0; v < consdata->nquadvars; ++v )
1815  for( i = 0; i < consdata->quadvarterms[v].nadjbilin; ++i )
1816  consdata->quadvarterms[v].adjbilin[i] = invperm[consdata->quadvarterms[v].adjbilin[i]];
1817 
1818  consdata->bilinsorted = TRUE;
1819  assert(consdataCheckBilinTermsSort(consdata));
1820 
1821  /* free temporary memory */
1822  SCIPfreeBufferArray(scip, &invperm);
1823  SCIPfreeBufferArray(scip, &perm);
1824 
1825  return SCIP_OKAY;
1826 }
1827 
1828 /** moves a linear variable from one position to another */
1829 static
1831  SCIP_CONSDATA* consdata, /**< constraint data */
1832  int oldpos, /**< position of variable that shall be moved */
1833  int newpos /**< new position of variable */
1834  )
1835 {
1836  assert(consdata != NULL);
1837  assert(oldpos >= 0);
1838  assert(oldpos < consdata->nlinvars);
1839  assert(newpos >= 0);
1840  assert(newpos < consdata->linvarssize);
1841 
1842  if( newpos == oldpos )
1843  return;
1844 
1845  consdata->linvars [newpos] = consdata->linvars [oldpos];
1846  consdata->lincoefs[newpos] = consdata->lincoefs[oldpos];
1847 
1848  if( consdata->lineventdata != NULL )
1849  {
1850  assert(newpos >= consdata->nlinvars || consdata->lineventdata[newpos] == NULL);
1851 
1852  consdata->lineventdata[newpos] = consdata->lineventdata[oldpos];
1853  consdata->lineventdata[newpos]->varidx = newpos;
1854 
1855  consdata->lineventdata[oldpos] = NULL;
1856  }
1857 
1858  consdata->linvarssorted = FALSE;
1859 }
1860 
1861 /** moves a quadratic variable from one position to another */
1862 static
1864  SCIP_CONSDATA* consdata, /**< constraint data */
1865  int oldpos, /**< position of variable that shall be moved */
1866  int newpos /**< new position of variable */
1867  )
1868 {
1869  assert(consdata != NULL);
1870  assert(oldpos >= 0);
1871  assert(oldpos < consdata->nquadvars);
1872  assert(newpos >= 0);
1873  assert(newpos < consdata->quadvarssize);
1874 
1875  if( newpos == oldpos )
1876  return;
1877 
1878  assert(newpos >= consdata->nquadvars || consdata->quadvarterms[newpos].eventdata == NULL);
1879 
1880  consdata->quadvarterms[newpos] = consdata->quadvarterms[oldpos];
1881 
1882  if( consdata->quadvarterms[newpos].eventdata != NULL )
1883  {
1884  consdata->quadvarterms[newpos].eventdata->varidx = -newpos-1;
1885  consdata->quadvarterms[oldpos].eventdata = NULL;
1886  }
1887 
1888  consdata->quadvarssorted = FALSE;
1889 }
1890 
1891 /** adds linear coefficient in quadratic constraint */
1892 static
1894  SCIP* scip, /**< SCIP data structure */
1895  SCIP_CONS* cons, /**< quadratic constraint */
1896  SCIP_VAR* var, /**< variable of constraint entry */
1897  SCIP_Real coef /**< coefficient of constraint entry */
1898  )
1899 {
1900  SCIP_CONSDATA* consdata;
1901  SCIP_Bool transformed;
1902 
1903  assert(scip != NULL);
1904  assert(cons != NULL);
1905  assert(var != NULL);
1906 
1907  /* ignore coefficient if it is nearly zero */
1908  if( SCIPisZero(scip, coef) )
1909  return SCIP_OKAY;
1910 
1911  consdata = SCIPconsGetData(cons);
1912  assert(consdata != NULL);
1913 
1914  /* are we in the transformed problem? */
1915  transformed = SCIPconsIsTransformed(cons);
1916 
1917  /* always use transformed variables in transformed constraints */
1918  if( transformed )
1919  {
1920  SCIP_CALL( SCIPgetTransformedVar(scip, var, &var) );
1921  }
1922  assert(var != NULL);
1923  assert(transformed == SCIPvarIsTransformed(var));
1924 
1925  SCIP_CALL( consdataEnsureLinearVarsSize(scip, consdata, consdata->nlinvars+1) );
1926  consdata->linvars [consdata->nlinvars] = var;
1927  consdata->lincoefs[consdata->nlinvars] = coef;
1928 
1929  ++consdata->nlinvars;
1930 
1931  /* catch variable events */
1932  if( SCIPconsIsEnabled(cons) )
1933  {
1934  SCIP_CONSHDLR* conshdlr;
1935  SCIP_CONSHDLRDATA* conshdlrdata;
1936 
1937  /* get event handler */
1938  conshdlr = SCIPconsGetHdlr(cons);
1939  conshdlrdata = SCIPconshdlrGetData(conshdlr);
1940  assert(conshdlrdata != NULL);
1941  assert(conshdlrdata->eventhdlr != NULL);
1942 
1943  assert(consdata->lineventdata != NULL);
1944  consdata->lineventdata[consdata->nlinvars-1] = NULL;
1945 
1946  /* catch bound change events of variable */
1947  SCIP_CALL( catchLinearVarEvents(scip, conshdlrdata->eventhdlr, cons, consdata->nlinvars-1) );
1948  }
1949 
1950  /* invalidate activity information */
1951  consdata->activity = SCIP_INVALID;
1952  consdata->minlinactivity = SCIP_INVALID;
1953  consdata->maxlinactivity = SCIP_INVALID;
1954  consdata->minlinactivityinf = -1;
1955  consdata->maxlinactivityinf = -1;
1956 
1957  /* invalidate nonlinear row */
1958  if( consdata->nlrow != NULL )
1959  {
1960  SCIP_CALL( SCIPreleaseNlRow(scip, &consdata->nlrow) );
1961  }
1962 
1963  /* install rounding locks for new variable */
1964  SCIP_CALL( lockLinearVariable(scip, cons, var, coef) );
1965 
1966  /* capture new variable */
1967  SCIP_CALL( SCIPcaptureVar(scip, var) );
1968 
1969  consdata->ispropagated = FALSE;
1970  consdata->ispresolved = FALSE;
1971  consdata->isremovedfixings = consdata->isremovedfixings && SCIPvarIsActive(var)
1972  && !SCIPisEQ(scip, SCIPvarGetLbGlobal(var), SCIPvarGetUbGlobal(var));
1973  if( consdata->nlinvars == 1 )
1974  consdata->linvarssorted = TRUE;
1975  else
1976  consdata->linvarssorted = consdata->linvarssorted && (SCIPvarCompare(consdata->linvars[consdata->nlinvars-2], consdata->linvars[consdata->nlinvars-1]) == -1);
1977  /* always set too FALSE since the new linear variable should be checked if already existing as quad var term */
1978  consdata->linvarsmerged = FALSE;
1979 
1980  return SCIP_OKAY;
1981 }
1982 
1983 /** deletes linear coefficient at given position from quadratic constraint data */
1984 static
1986  SCIP* scip, /**< SCIP data structure */
1987  SCIP_CONS* cons, /**< quadratic constraint */
1988  int pos /**< position of coefficient to delete */
1989  )
1990 {
1991  SCIP_CONSDATA* consdata;
1992  SCIP_VAR* var;
1993  SCIP_Real coef;
1994 
1995  assert(scip != NULL);
1996  assert(cons != NULL);
1997 
1998  consdata = SCIPconsGetData(cons);
1999  assert(consdata != NULL);
2000  assert(0 <= pos && pos < consdata->nlinvars);
2001 
2002  var = consdata->linvars[pos];
2003  coef = consdata->lincoefs[pos];
2004  assert(var != NULL);
2005 
2006  /* remove rounding locks for deleted variable */
2007  SCIP_CALL( unlockLinearVariable(scip, cons, var, coef) );
2008 
2009  /* if we catch variable events, drop the events on the variable */
2010  if( consdata->lineventdata != NULL )
2011  {
2012  SCIP_CONSHDLR* conshdlr;
2013  SCIP_CONSHDLRDATA* conshdlrdata;
2014 
2015  /* get event handler */
2016  conshdlr = SCIPconsGetHdlr(cons);
2017  conshdlrdata = SCIPconshdlrGetData(conshdlr);
2018  assert(conshdlrdata != NULL);
2019  assert(conshdlrdata->eventhdlr != NULL);
2020 
2021  /* drop bound change events of variable */
2022  SCIP_CALL( dropLinearVarEvents(scip, conshdlrdata->eventhdlr, cons, pos) );
2023  }
2024 
2025  /* release variable */
2026  SCIP_CALL( SCIPreleaseVar(scip, &consdata->linvars[pos]) );
2027 
2028  /* move the last variable to the free slot */
2029  consdataMoveLinearVar(consdata, consdata->nlinvars-1, pos);
2030 
2031  --consdata->nlinvars;
2032 
2033  /* invalidate activity */
2034  consdata->activity = SCIP_INVALID;
2035  consdata->minlinactivity = SCIP_INVALID;
2036  consdata->maxlinactivity = SCIP_INVALID;
2037  consdata->minlinactivityinf = -1;
2038  consdata->maxlinactivityinf = -1;
2039 
2040  /* invalidate nonlinear row */
2041  if( consdata->nlrow != NULL )
2042  {
2043  SCIP_CALL( SCIPreleaseNlRow(scip, &consdata->nlrow) );
2044  }
2045 
2046  consdata->ispropagated = FALSE;
2047  consdata->ispresolved = FALSE;
2048 
2049  return SCIP_OKAY;
2050 }
2051 
2052 /** changes linear coefficient value at given position of quadratic constraint */
2053 static
2055  SCIP* scip, /**< SCIP data structure */
2056  SCIP_CONS* cons, /**< quadratic constraint */
2057  int pos, /**< position of linear coefficient to change */
2058  SCIP_Real newcoef /**< new value of linear coefficient */
2059  )
2060 {
2061  SCIP_CONSHDLR* conshdlr;
2062  SCIP_CONSHDLRDATA* conshdlrdata;
2063  SCIP_CONSDATA* consdata;
2064  SCIP_VAR* var;
2065  SCIP_Real coef;
2066 
2067  assert(scip != NULL);
2068  assert(cons != NULL);
2070  assert(!SCIPisZero(scip, newcoef));
2071 
2072  conshdlrdata = NULL;
2073 
2074  consdata = SCIPconsGetData(cons);
2075  assert(consdata != NULL);
2076  assert(0 <= pos);
2077  assert(pos < consdata->nlinvars);
2078  assert(!SCIPisZero(scip, newcoef));
2079 
2080  var = consdata->linvars[pos];
2081  coef = consdata->lincoefs[pos];
2082  assert(var != NULL);
2083  assert(SCIPconsIsTransformed(cons) == SCIPvarIsTransformed(var));
2084 
2085  /* invalidate activity */
2086  consdata->activity = SCIP_INVALID;
2087  consdata->minlinactivity = SCIP_INVALID;
2088  consdata->maxlinactivity = SCIP_INVALID;
2089  consdata->minlinactivityinf = -1;
2090  consdata->maxlinactivityinf = -1;
2091 
2092  /* invalidate nonlinear row */
2093  if( consdata->nlrow != NULL )
2094  {
2095  SCIP_CALL( SCIPreleaseNlRow(scip, &consdata->nlrow) );
2096  }
2097 
2098  /* if necessary, remove the rounding locks and event catching of the variable */
2099  if( newcoef * coef < 0.0 )
2100  {
2101  if( SCIPconsIsLocked(cons) )
2102  {
2103  assert(SCIPconsIsTransformed(cons));
2104 
2105  /* remove rounding locks for variable with old coefficient */
2106  SCIP_CALL( unlockLinearVariable(scip, cons, var, coef) );
2107  }
2108 
2109  if( consdata->lineventdata[pos] != NULL )
2110  {
2111  /* get event handler */
2112  conshdlr = SCIPconsGetHdlr(cons);
2113  conshdlrdata = SCIPconshdlrGetData(conshdlr);
2114  assert(conshdlrdata != NULL);
2115  assert(conshdlrdata->eventhdlr != NULL);
2116 
2117  /* drop bound change events of variable */
2118  SCIP_CALL( dropLinearVarEvents(scip, conshdlrdata->eventhdlr, cons, pos) );
2119  }
2120  }
2121 
2122  /* change the coefficient */
2123  consdata->lincoefs[pos] = newcoef;
2124 
2125  /* if necessary, install the rounding locks and event catching of the variable again */
2126  if( newcoef * coef < 0.0 )
2127  {
2128  if( SCIPconsIsLocked(cons) )
2129  {
2130  /* install rounding locks for variable with new coefficient */
2131  SCIP_CALL( lockLinearVariable(scip, cons, var, newcoef) );
2132  }
2133 
2134  if( conshdlrdata != NULL )
2135  {
2136  assert(SCIPconsIsEnabled(cons));
2137 
2138  /* catch bound change events of variable */
2139  SCIP_CALL( catchLinearVarEvents(scip, conshdlrdata->eventhdlr, cons, pos) );
2140  }
2141  }
2142 
2143  consdata->ispropagated = FALSE;
2144  consdata->ispresolved = FALSE;
2145 
2146  return SCIP_OKAY;
2147 }
2148 
2149 /** adds quadratic variable term to quadratic constraint */
2150 static
2152  SCIP* scip, /**< SCIP data structure */
2153  SCIP_CONS* cons, /**< quadratic constraint */
2154  SCIP_VAR* var, /**< variable to add */
2155  SCIP_Real lincoef, /**< linear coefficient of variable */
2156  SCIP_Real sqrcoef /**< square coefficient of variable */
2157  )
2158 {
2159  SCIP_CONSDATA* consdata;
2160  SCIP_Bool transformed;
2161  SCIP_QUADVARTERM* quadvarterm;
2162 
2163  assert(scip != NULL);
2164  assert(cons != NULL);
2165  assert(var != NULL);
2166 
2167  consdata = SCIPconsGetData(cons);
2168  assert(consdata != NULL);
2169 
2170  /* are we in the transformed problem? */
2171  transformed = SCIPconsIsTransformed(cons);
2172 
2173  /* always use transformed variables in transformed constraints */
2174  if( transformed )
2175  {
2176  SCIP_CALL( SCIPgetTransformedVar(scip, var, &var) );
2177  }
2178  assert(var != NULL);
2179  assert(transformed == SCIPvarIsTransformed(var));
2180 
2181  SCIP_CALL( consdataEnsureQuadVarTermsSize(scip, consdata, consdata->nquadvars+1) );
2182 
2183  quadvarterm = &consdata->quadvarterms[consdata->nquadvars];
2184  quadvarterm->var = var;
2185  quadvarterm->lincoef = lincoef;
2186  quadvarterm->sqrcoef = sqrcoef;
2187  quadvarterm->adjbilinsize = 0;
2188  quadvarterm->nadjbilin = 0;
2189  quadvarterm->adjbilin = NULL;
2190  quadvarterm->eventdata = NULL;
2191 
2192  ++consdata->nquadvars;
2193 
2194  /* capture variable */
2195  SCIP_CALL( SCIPcaptureVar(scip, var) );
2196 
2197  /* catch variable events, if we do so */
2198  if( SCIPconsIsEnabled(cons) )
2199  {
2200  SCIP_CONSHDLR* conshdlr;
2201  SCIP_CONSHDLRDATA* conshdlrdata;
2202 
2203  /* get event handler */
2204  conshdlr = SCIPconsGetHdlr(cons);
2205  conshdlrdata = SCIPconshdlrGetData(conshdlr);
2206  assert(conshdlrdata != NULL);
2207  assert(conshdlrdata->eventhdlr != NULL);
2208 
2209  /* catch bound change events of variable */
2210  SCIP_CALL( catchQuadVarEvents(scip, conshdlrdata->eventhdlr, cons, consdata->nquadvars-1) );
2211  }
2212 
2213  /* invalidate activity information */
2214  consdata->activity = SCIP_INVALID;
2215  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
2216 
2217  /* invalidate nonlinear row */
2218  if( consdata->nlrow != NULL )
2219  {
2220  SCIP_CALL( SCIPreleaseNlRow(scip, &consdata->nlrow) );
2221  }
2222 
2223  /* install rounding locks for new variable */
2224  SCIP_CALL( lockQuadraticVariable(scip, cons, var) );
2225 
2226  consdata->ispropagated = FALSE;
2227  consdata->ispresolved = FALSE;
2228  consdata->isremovedfixings = consdata->isremovedfixings && SCIPvarIsActive(var)
2229  && !SCIPisEQ(scip, SCIPvarGetLbGlobal(var), SCIPvarGetUbGlobal(var));
2230  if( consdata->nquadvars == 1 )
2231  consdata->quadvarssorted = TRUE;
2232  else
2233  consdata->quadvarssorted = consdata->quadvarssorted &&
2234  (SCIPvarCompare(consdata->quadvarterms[consdata->nquadvars-2].var, consdata->quadvarterms[consdata->nquadvars-1].var) == -1);
2235  /* also set to FALSE if nquadvars == 1, since the new variable should be checked for linearity and other stuff in mergeAndClean ... */
2236  consdata->quadvarsmerged = FALSE;
2237 
2238  consdata->iscurvchecked = FALSE;
2239 
2240  return SCIP_OKAY;
2241 }
2242 
2243 /** deletes quadratic variable term at given position from quadratic constraint data */
2244 static
2246  SCIP* scip, /**< SCIP data structure */
2247  SCIP_CONS* cons, /**< quadratic constraint */
2248  int pos /**< position of term to delete */
2249  )
2250 {
2251  SCIP_CONSDATA* consdata;
2252  SCIP_VAR* var;
2253 
2254  assert(scip != NULL);
2255  assert(cons != NULL);
2256 
2257  consdata = SCIPconsGetData(cons);
2258  assert(consdata != NULL);
2259  assert(0 <= pos && pos < consdata->nquadvars);
2260 
2261  var = consdata->quadvarterms[pos].var;
2262  assert(var != NULL);
2263  assert(consdata->quadvarterms[pos].nadjbilin == 0);
2264 
2265  /* remove rounding locks for deleted variable */
2266  SCIP_CALL( unlockQuadraticVariable(scip, cons, var) );
2267 
2268  /* if we catch variable events, drop the events on the variable */
2269  if( consdata->quadvarterms[pos].eventdata != NULL )
2270  {
2271  SCIP_CONSHDLR* conshdlr;
2272  SCIP_CONSHDLRDATA* conshdlrdata;
2273 
2274  /* get event handler */
2275  conshdlr = SCIPconsGetHdlr(cons);
2276  conshdlrdata = SCIPconshdlrGetData(conshdlr);
2277  assert(conshdlrdata != NULL);
2278  assert(conshdlrdata->eventhdlr != NULL);
2279 
2280  /* drop bound change events of variable */
2281  SCIP_CALL( dropQuadVarEvents(scip, conshdlrdata->eventhdlr, cons, pos) );
2282  }
2283 
2284  /* release variable */
2285  SCIP_CALL( SCIPreleaseVar(scip, &consdata->quadvarterms[pos].var) );
2286 
2287  /* free adjacency array */
2288  SCIPfreeBlockMemoryArrayNull(scip, &consdata->quadvarterms[pos].adjbilin, consdata->quadvarterms[pos].adjbilinsize);
2289 
2290  /* move the last variable term to the free slot */
2291  consdataMoveQuadVarTerm(consdata, consdata->nquadvars-1, pos);
2292 
2293  --consdata->nquadvars;
2294 
2295  /* invalidate activity */
2296  consdata->activity = SCIP_INVALID;
2297  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
2298 
2299  /* invalidate nonlinear row */
2300  if( consdata->nlrow != NULL )
2301  {
2302  SCIP_CALL( SCIPreleaseNlRow(scip, &consdata->nlrow) );
2303  }
2304 
2305  consdata->ispropagated = FALSE;
2306  consdata->ispresolved = FALSE;
2307  consdata->iscurvchecked = FALSE;
2308 
2309  return SCIP_OKAY;
2310 }
2311 
2312 /** replace variable in quadratic variable term at given position of quadratic constraint data
2313  *
2314  * Allows to replace x by coef*y+offset, thereby maintaining linear and square coefficients and bilinear terms.
2315  */
2316 static
2318  SCIP* scip, /**< SCIP data structure */
2319  SCIP_CONS* cons, /**< quadratic constraint */
2320  int pos, /**< position of term to replace */
2321  SCIP_VAR* var, /**< new variable */
2322  SCIP_Real coef, /**< linear coefficient of new variable */
2323  SCIP_Real offset /**< offset of new variable */
2324  )
2325 {
2326  SCIP_CONSDATA* consdata;
2327  SCIP_QUADVARTERM* quadvarterm;
2328  SCIP_EVENTHDLR* eventhdlr;
2329  SCIP_BILINTERM* bilinterm;
2330  SCIP_Real constant;
2331 
2332  int i;
2333  SCIP_VAR* var2;
2334 
2335  consdata = SCIPconsGetData(cons);
2336  assert(consdata != NULL);
2337  assert(pos >= 0);
2338  assert(pos < consdata->nquadvars);
2339 
2340  quadvarterm = &consdata->quadvarterms[pos];
2341 
2342  /* remove rounding locks for old variable */
2343  SCIP_CALL( unlockQuadraticVariable(scip, cons, quadvarterm->var) );
2344 
2345  /* if we catch variable events, drop the events on the old variable */
2346  if( quadvarterm->eventdata != NULL )
2347  {
2348  SCIP_CONSHDLR* conshdlr;
2349  SCIP_CONSHDLRDATA* conshdlrdata;
2350 
2351  /* get event handler */
2352  conshdlr = SCIPconsGetHdlr(cons);
2353  conshdlrdata = SCIPconshdlrGetData(conshdlr);
2354  assert(conshdlrdata != NULL);
2355  assert(conshdlrdata->eventhdlr != NULL);
2356 
2357  eventhdlr = conshdlrdata->eventhdlr;
2358 
2359  /* drop bound change events of variable */
2360  SCIP_CALL( dropQuadVarEvents(scip, eventhdlr, cons, pos) );
2361  }
2362  else
2363  {
2364  eventhdlr = NULL;
2365  }
2366 
2367  /* compute constant and put into lhs/rhs */
2368  constant = quadvarterm->lincoef * offset + quadvarterm->sqrcoef * offset * offset;
2369  if( constant != 0.0 )
2370  {
2371  /* maintain constant part */
2372  if( !SCIPisInfinity(scip, -consdata->lhs) )
2373  consdata->lhs -= constant;
2374  if( !SCIPisInfinity(scip, consdata->rhs) )
2375  consdata->rhs -= constant;
2376  }
2377 
2378  /* update linear and square coefficient */
2379  quadvarterm->lincoef *= coef;
2380  quadvarterm->lincoef += 2.0 * quadvarterm->sqrcoef * coef * offset;
2381  quadvarterm->sqrcoef *= coef * coef;
2382 
2383  /* update bilinear terms */
2384  for( i = 0; i < quadvarterm->nadjbilin; ++i )
2385  {
2386  bilinterm = &consdata->bilinterms[quadvarterm->adjbilin[i]];
2387 
2388  if( bilinterm->var1 == quadvarterm->var )
2389  {
2390  bilinterm->var1 = var;
2391  var2 = bilinterm->var2;
2392  }
2393  else
2394  {
2395  assert(bilinterm->var2 == quadvarterm->var);
2396  bilinterm->var2 = var;
2397  var2 = bilinterm->var1;
2398  }
2399 
2400  if( var == var2 )
2401  {
2402  /* looks like we actually have a square term here */
2403  quadvarterm->lincoef += bilinterm->coef * offset;
2404  quadvarterm->sqrcoef += bilinterm->coef * coef;
2405  /* deleting bilinear terms is expensive, since it requires updating adjacency information
2406  * thus, for now we just set the coefficient to 0.0 and clear in later when the bilinear terms are merged */
2407  bilinterm->coef = 0.0;
2408  continue;
2409  }
2410 
2411  /* swap var1 and var2 if they are in wrong order */
2412  if( SCIPvarCompare(bilinterm->var1, bilinterm->var2) > 0 )
2413  {
2414  SCIP_VAR* tmp;
2415  tmp = bilinterm->var1;
2416  bilinterm->var1 = bilinterm->var2;
2417  bilinterm->var2 = tmp;
2418  }
2419  assert(SCIPvarCompare(bilinterm->var1, bilinterm->var2) == -1);
2420 
2421  if( offset != 0.0 )
2422  {
2423  /* need to find var2 and add offset*bilinterm->coef to linear coefficient */
2424  int var2pos;
2425 
2426  var2pos = 0;
2427  while( consdata->quadvarterms[var2pos].var != var2 )
2428  {
2429  ++var2pos;
2430  assert(var2pos < consdata->nquadvars);
2431  }
2432 
2433  consdata->quadvarterms[var2pos].lincoef += bilinterm->coef * offset;
2434  }
2435 
2436  bilinterm->coef *= coef;
2437  }
2438 
2439  /* release old variable */
2440  SCIP_CALL( SCIPreleaseVar(scip, &quadvarterm->var) );
2441 
2442  /* set new variable */
2443  quadvarterm->var = var;
2444 
2445  /* capture new variable */
2446  SCIP_CALL( SCIPcaptureVar(scip, quadvarterm->var) );
2447 
2448  /* catch variable events, if we do so */
2449  if( eventhdlr != NULL )
2450  {
2451  assert(SCIPconsIsEnabled(cons));
2452 
2453  /* catch bound change events of variable */
2454  SCIP_CALL( catchQuadVarEvents(scip, eventhdlr, cons, pos) );
2455  }
2456 
2457  /* invalidate activity information */
2458  consdata->activity = SCIP_INVALID;
2459  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
2460 
2461  /* invalidate nonlinear row */
2462  if( consdata->nlrow != NULL )
2463  {
2464  SCIP_CALL( SCIPreleaseNlRow(scip, &consdata->nlrow) );
2465  }
2466 
2467  /* install rounding locks for new variable */
2468  SCIP_CALL( lockQuadraticVariable(scip, cons, var) );
2469 
2470  consdata->isremovedfixings = consdata->isremovedfixings && SCIPvarIsActive(var)
2471  && !SCIPisEQ(scip, SCIPvarGetLbGlobal(var), SCIPvarGetUbGlobal(var));
2472  consdata->quadvarssorted = (consdata->nquadvars == 1);
2473  consdata->quadvarsmerged = FALSE;
2474  consdata->bilinsorted &= (quadvarterm->nadjbilin == 0); /*lint !e514*/
2475  consdata->bilinmerged &= (quadvarterm->nadjbilin == 0); /*lint !e514*/
2476 
2477  consdata->ispropagated = FALSE;
2478  consdata->ispresolved = FALSE;
2479  consdata->iscurvchecked = FALSE;
2480 
2481  return SCIP_OKAY;
2482 }
2483 
2484 /** adds a bilinear term to quadratic constraint */
2485 static
2487  SCIP* scip, /**< SCIP data structure */
2488  SCIP_CONS* cons, /**< quadratic constraint */
2489  int var1pos, /**< position of first variable in quadratic variables array */
2490  int var2pos, /**< position of second variable in quadratic variables array */
2491  SCIP_Real coef /**< coefficient of bilinear term */
2492  )
2493 {
2494  SCIP_CONSDATA* consdata;
2495  SCIP_BILINTERM* bilinterm;
2496 
2497  assert(scip != NULL);
2498  assert(cons != NULL);
2499 
2500  if( var1pos == var2pos )
2501  {
2502  SCIPerrorMessage("tried to add bilinear term where both variables are the same\n");
2503  return SCIP_INVALIDDATA;
2504  }
2505 
2506  consdata = SCIPconsGetData(cons);
2507  assert(consdata != NULL);
2508 
2509  /* check if the bilinear terms are sorted */
2510  assert(consdataCheckBilinTermsSort(consdata));
2511 
2512  assert(var1pos >= 0);
2513  assert(var1pos < consdata->nquadvars);
2514  assert(var2pos >= 0);
2515  assert(var2pos < consdata->nquadvars);
2516 
2517  SCIP_CALL( consdataEnsureBilinSize(scip, consdata, consdata->nbilinterms + 1) );
2518 
2519  bilinterm = &consdata->bilinterms[consdata->nbilinterms];
2520  if( SCIPvarCompare(consdata->quadvarterms[var1pos].var, consdata->quadvarterms[var2pos].var) < 0 )
2521  {
2522  bilinterm->var1 = consdata->quadvarterms[var1pos].var;
2523  bilinterm->var2 = consdata->quadvarterms[var2pos].var;
2524  }
2525  else
2526  {
2527  bilinterm->var1 = consdata->quadvarterms[var2pos].var;
2528  bilinterm->var2 = consdata->quadvarterms[var1pos].var;
2529  }
2530  bilinterm->coef = coef;
2531 
2532  if( bilinterm->var1 == bilinterm->var2 )
2533  {
2534  SCIPerrorMessage("tried to add bilinear term where both variables are the same, but appear at different positions in quadvarterms array\n");
2535  return SCIP_INVALIDDATA;
2536  }
2537  assert(SCIPvarCompare(bilinterm->var1, bilinterm->var2) == -1);
2538 
2539  SCIP_CALL( consdataEnsureAdjBilinSize(scip, &consdata->quadvarterms[var1pos], consdata->quadvarterms[var1pos].nadjbilin + 1) );
2540  SCIP_CALL( consdataEnsureAdjBilinSize(scip, &consdata->quadvarterms[var2pos], consdata->quadvarterms[var2pos].nadjbilin + 1) );
2541 
2542  consdata->quadvarterms[var1pos].adjbilin[consdata->quadvarterms[var1pos].nadjbilin] = consdata->nbilinterms;
2543  consdata->quadvarterms[var2pos].adjbilin[consdata->quadvarterms[var2pos].nadjbilin] = consdata->nbilinterms;
2544  ++consdata->quadvarterms[var1pos].nadjbilin;
2545  ++consdata->quadvarterms[var2pos].nadjbilin;
2546 
2547  ++consdata->nbilinterms;
2548 
2549  /* invalidate activity information */
2550  consdata->activity = SCIP_INVALID;
2551  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
2552 
2553  /* invalidate nonlinear row */
2554  if( consdata->nlrow != NULL )
2555  {
2556  SCIP_CALL( SCIPreleaseNlRow(scip, &consdata->nlrow) );
2557  }
2558 
2559  consdata->ispropagated = FALSE;
2560  consdata->ispresolved = FALSE;
2561  if( consdata->nbilinterms == 1 )
2562  {
2563  consdata->bilinsorted = TRUE;
2564 
2565  /* we have to take care of the bilinear term in mergeAndCleanBilinearTerms() if the coefficient is zero */
2566  consdata->bilinmerged = !SCIPisZero(scip, consdata->bilinterms[0].coef);
2567  }
2568  else
2569  {
2570  consdata->bilinsorted = consdata->bilinsorted
2571  && (bilinTermComp(consdata, consdata->nbilinterms-2, consdata->nbilinterms-1) <= 0);
2572  consdata->bilinmerged = FALSE;
2573  }
2574 
2575  consdata->iscurvchecked = FALSE;
2576 
2577  /* check if the bilinear terms are sorted */
2578  assert(consdataCheckBilinTermsSort(consdata));
2579 
2580  return SCIP_OKAY;
2581 }
2582 
2583 /** removes a set of bilinear terms and updates adjacency information in quad var terms
2584  *
2585  * Note: this function sorts the given array termposs.
2586  */
2587 static
2589  SCIP* scip, /**< SCIP data structure */
2590  SCIP_CONS* cons, /**< quadratic constraint */
2591  int nterms, /**< number of terms to delete */
2592  int* termposs /**< indices of terms to delete */
2593  )
2594 {
2595  SCIP_CONSDATA* consdata;
2596  int* newpos;
2597  int i;
2598  int j;
2599  int offset;
2600 
2601  assert(scip != NULL);
2602  assert(cons != NULL);
2603  assert(nterms == 0 || termposs != NULL);
2604 
2605  if( nterms == 0 )
2606  return SCIP_OKAY;
2607 
2608  consdata = SCIPconsGetData(cons);
2609  assert(consdata != NULL);
2610 
2611  SCIPsortInt(termposs, nterms);
2612 
2613  SCIP_CALL( SCIPallocBufferArray(scip, &newpos, consdata->nbilinterms) );
2614 
2615  i = 0;
2616  offset = 0;
2617  for( j = 0; j < consdata->nbilinterms; ++j )
2618  {
2619  /* if j'th term is deleted, increase offset and continue */
2620  if( i < nterms && j == termposs[i] )
2621  {
2622  ++offset;
2623  ++i;
2624  newpos[j] = -1;
2625  continue;
2626  }
2627 
2628  /* otherwise, move it forward and remember new position */
2629  if( offset > 0 )
2630  consdata->bilinterms[j-offset] = consdata->bilinterms[j];
2631  newpos[j] = j - offset;
2632  }
2633  assert(offset == nterms);
2634 
2635  /* update adjacency and activity information in quad var terms */
2636  for( i = 0; i < consdata->nquadvars; ++i )
2637  {
2638  offset = 0;
2639  for( j = 0; j < consdata->quadvarterms[i].nadjbilin; ++j )
2640  {
2641  assert(consdata->quadvarterms[i].adjbilin[j] < consdata->nbilinterms);
2642  if( newpos[consdata->quadvarterms[i].adjbilin[j]] == -1 )
2643  {
2644  /* corresponding bilinear term was deleted, thus increase offset */
2645  ++offset;
2646  }
2647  else
2648  {
2649  /* update index of j'th bilinear term and store at position j-offset */
2650  consdata->quadvarterms[i].adjbilin[j-offset] = newpos[consdata->quadvarterms[i].adjbilin[j]];
2651  }
2652  }
2653  consdata->quadvarterms[i].nadjbilin -= offset;
2654  /* some bilinear term was removed, so invalidate activity bounds */
2655  }
2656 
2657  consdata->nbilinterms -= nterms;
2658 
2659  SCIPfreeBufferArray(scip, &newpos);
2660 
2661  /* some quad vars may be linear now */
2662  consdata->quadvarsmerged = FALSE;
2663 
2664  consdata->ispropagated = FALSE;
2665  consdata->ispresolved = FALSE;
2666  consdata->iscurvchecked = FALSE;
2667 
2668  /* invalidate activity */
2669  consdata->activity = SCIP_INVALID;
2670  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
2671 
2672  /* invalidate nonlinear row */
2673  if( consdata->nlrow != NULL )
2674  {
2675  SCIP_CALL( SCIPreleaseNlRow(scip, &consdata->nlrow) );
2676  }
2677 
2678  return SCIP_OKAY;
2679 }
2680 
2681 /** merges quad var terms that correspond to the same variable and does additional cleanup
2682  *
2683  * If a quadratic variable terms is actually linear, makes a linear term out of it
2684  * also replaces squares of binary variables by the binary variables, i.e., adds sqrcoef to lincoef.
2685  */
2686 static
2688  SCIP* scip, /**< SCIP data structure */
2689  SCIP_CONS* cons /**< quadratic constraint */
2690  )
2691 {
2692  SCIP_QUADVARTERM* quadvarterm;
2693  SCIP_CONSDATA* consdata;
2694  int i;
2695  int j;
2696 
2697  assert(scip != NULL);
2698  assert(cons != NULL);
2699 
2700  consdata = SCIPconsGetData(cons);
2701 
2702  if( consdata->quadvarsmerged )
2703  return SCIP_OKAY;
2704 
2705  if( consdata->nquadvars == 0 )
2706  {
2707  consdata->quadvarsmerged = TRUE;
2708  return SCIP_OKAY;
2709  }
2710 
2711  i = 0;
2712  while( i < consdata->nquadvars )
2713  {
2714  /* make sure quad var terms are sorted (do this in every round, since we may move variables around) */
2715  SCIP_CALL( consdataSortQuadVarTerms(scip, consdata) );
2716 
2717  quadvarterm = &consdata->quadvarterms[i];
2718 
2719  for( j = i+1; j < consdata->nquadvars && consdata->quadvarterms[j].var == quadvarterm->var; ++j )
2720  {
2721  /* add quad var term j to current term i */
2722  quadvarterm->lincoef += consdata->quadvarterms[j].lincoef;
2723  quadvarterm->sqrcoef += consdata->quadvarterms[j].sqrcoef;
2724  if( consdata->quadvarterms[j].nadjbilin > 0 )
2725  {
2726  /* move adjacency information from j to i */
2727  SCIP_CALL( consdataEnsureAdjBilinSize(scip, quadvarterm, quadvarterm->nadjbilin + consdata->quadvarterms[j].nadjbilin) );
2728  BMScopyMemoryArray(&quadvarterm->adjbilin[quadvarterm->nadjbilin], consdata->quadvarterms[j].adjbilin, consdata->quadvarterms[j].nadjbilin); /*lint !e866*/
2729  quadvarterm->nadjbilin += consdata->quadvarterms[j].nadjbilin;
2730  consdata->quadvarterms[j].nadjbilin = 0;
2731  }
2732  consdata->quadvarterms[j].lincoef = 0.0;
2733  consdata->quadvarterms[j].sqrcoef = 0.0;
2734  /* mark that activity information in quadvarterm is not up to date anymore */
2735  }
2736 
2737  /* remove quad var terms i+1..j-1 backwards */
2738  for( j = j-1; j > i; --j )
2739  {
2740  SCIP_CALL( delQuadVarTermPos(scip, cons, j) );
2741  }
2742 
2743  /* for binary variables, x^2 = x
2744  * however, we may destroy convexity of a quadratic term that involves also bilinear terms
2745  * thus, we do this step only if the variable does not appear in any bilinear term */
2746  if( quadvarterm->sqrcoef != 0.0 && SCIPvarIsBinary(quadvarterm->var) && quadvarterm->nadjbilin == 0 )
2747  {
2748  SCIPdebugMsg(scip, "replace square of binary variable by itself: <%s>^2 --> <%s>\n", SCIPvarGetName(quadvarterm->var), SCIPvarGetName(quadvarterm->var));
2749  quadvarterm->lincoef += quadvarterm->sqrcoef;
2750  quadvarterm->sqrcoef = 0.0;
2751 
2752  /* invalidate nonlinear row */
2753  if( consdata->nlrow != NULL )
2754  {
2755  SCIP_CALL( SCIPreleaseNlRow(scip, &consdata->nlrow) );
2756  }
2757  }
2758 
2759  /* if its 0.0 or linear, get rid of it */
2760  if( SCIPisZero(scip, quadvarterm->sqrcoef) && quadvarterm->nadjbilin == 0 )
2761  {
2762  if( !SCIPisZero(scip, quadvarterm->lincoef) )
2763  {
2764  /* seem to be a linear term now, thus add as linear term */
2765  SCIP_CALL( addLinearCoef(scip, cons, quadvarterm->var, quadvarterm->lincoef) );
2766  }
2767  /* remove term at pos i */
2768  SCIP_CALL( delQuadVarTermPos(scip, cons, i) );
2769  }
2770  else
2771  {
2772  ++i;
2773  }
2774  }
2775 
2776  consdata->quadvarsmerged = TRUE;
2777  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
2778 
2779  return SCIP_OKAY;
2780 }
2781 
2782 /** merges entries with same linear variable into one entry and cleans up entries with coefficient 0.0 */
2783 static
2785  SCIP* scip, /**< SCIP data structure */
2786  SCIP_CONS* cons /**< quadratic constraint */
2787  )
2788 {
2789  SCIP_CONSDATA* consdata;
2790  SCIP_Real newcoef;
2791  int i;
2792  int j;
2793  int qvarpos;
2794 
2795  assert(scip != NULL);
2796  assert(cons != NULL);
2797 
2798  consdata = SCIPconsGetData(cons);
2799 
2800  if( consdata->linvarsmerged )
2801  return SCIP_OKAY;
2802 
2803  if( consdata->nlinvars == 0 )
2804  {
2805  consdata->linvarsmerged = TRUE;
2806  return SCIP_OKAY;
2807  }
2808 
2809  i = 0;
2810  while( i < consdata->nlinvars )
2811  {
2812  /* make sure linear variables are sorted (do this in every round, since we may move variables around) */
2813  consdataSortLinearVars(consdata);
2814 
2815  /* sum up coefficients that correspond to variable i */
2816  newcoef = consdata->lincoefs[i];
2817  for( j = i+1; j < consdata->nlinvars && consdata->linvars[i] == consdata->linvars[j]; ++j )
2818  newcoef += consdata->lincoefs[j];
2819  /* delete the additional variables in backward order */
2820  for( j = j-1; j > i; --j )
2821  {
2822  SCIP_CALL( delLinearCoefPos(scip, cons, j) );
2823  }
2824 
2825  /* check if there is already a quadratic variable term with this variable */
2826  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, consdata->linvars[i], &qvarpos) );
2827  if( qvarpos >= 0)
2828  {
2829  /* add newcoef to linear coefficient of quadratic variable and mark linear variable as to delete */
2830  assert(qvarpos < consdata->nquadvars);
2831  assert(consdata->quadvarterms[qvarpos].var == consdata->linvars[i]);
2832  consdata->quadvarterms[qvarpos].lincoef += newcoef;
2833  newcoef = 0.0;
2834  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
2835  }
2836 
2837  /* delete also entry at position i, if it became zero (or was zero before) */
2838  if( SCIPisZero(scip, newcoef) )
2839  {
2840  SCIP_CALL( delLinearCoefPos(scip, cons, i) );
2841  }
2842  else
2843  {
2844  SCIP_CALL( chgLinearCoefPos(scip, cons, i, newcoef) );
2845  ++i;
2846  }
2847  }
2848 
2849  consdata->linvarsmerged = TRUE;
2850 
2851  return SCIP_OKAY;
2852 }
2853 
2854 /** merges bilinear terms with same variables into a single term, removes bilinear terms with coefficient 0.0 */
2855 static
2857  SCIP* scip, /**< SCIP data structure */
2858  SCIP_CONS* cons /**< quadratic constraint */
2859  )
2860 {
2861  SCIP_CONSDATA* consdata;
2862  SCIP_BILINTERM* bilinterm;
2863  int i;
2864  int j;
2865  int* todelete;
2866  int ntodelete;
2867 
2868  assert(scip != NULL);
2869  assert(cons != NULL);
2870 
2871  consdata = SCIPconsGetData(cons);
2872 
2873  /* check if the bilinear terms are sorted */
2874  assert(consdataCheckBilinTermsSort(consdata));
2875 
2876  if( consdata->bilinmerged )
2877  return SCIP_OKAY;
2878 
2879  if( consdata->nbilinterms == 0 )
2880  {
2881  consdata->bilinmerged = TRUE;
2882  return SCIP_OKAY;
2883  }
2884 
2885  /* alloc memory for array of terms that need to be deleted finally */
2886  ntodelete = 0;
2887  SCIP_CALL( SCIPallocBufferArray(scip, &todelete, consdata->nbilinterms) );
2888 
2889  /* make sure bilinear terms are sorted */
2890  SCIP_CALL( consdataSortBilinTerms(scip, consdata) );
2891 
2892  i = 0;
2893  while( i < consdata->nbilinterms )
2894  {
2895  bilinterm = &consdata->bilinterms[i];
2896 
2897  /* sum up coefficients that correspond to same variables as term i */
2898  for( j = i+1; j < consdata->nbilinterms && bilinterm->var1 == consdata->bilinterms[j].var1 && bilinterm->var2 == consdata->bilinterms[j].var2; ++j )
2899  {
2900  bilinterm->coef += consdata->bilinterms[j].coef;
2901  todelete[ntodelete++] = j;
2902  }
2903 
2904  /* delete also entry at position i, if it became zero (or was zero before) */
2905  if( SCIPisZero(scip, bilinterm->coef) )
2906  {
2907  todelete[ntodelete++] = i;
2908  }
2909 
2910  /* continue with term after the current series */
2911  i = j;
2912  }
2913 
2914  /* delete bilinear terms */
2915  SCIP_CALL( removeBilinearTermsPos(scip, cons, ntodelete, todelete) );
2916 
2917  SCIPfreeBufferArray(scip, &todelete);
2918 
2919  consdata->bilinmerged = TRUE;
2920 
2921  /* check if the bilinear terms are sorted */
2922  assert(consdataCheckBilinTermsSort(consdata));
2923 
2924  return SCIP_OKAY;
2925 }
2926 
2927 /** removes fixes (or aggregated) variables from a quadratic constraint */
2928 static
2930  SCIP* scip, /**< SCIP data structure */
2931  SCIP_CONS* cons /**< quadratic constraint */
2932  )
2933 {
2934  SCIP_CONSDATA* consdata;
2935  SCIP_BILINTERM* bilinterm;
2936  SCIP_Real bilincoef;
2937  SCIP_Real coef;
2938  SCIP_Real offset;
2939  SCIP_VAR* var;
2940  SCIP_VAR* var2;
2941  int var2pos;
2942  int i;
2943  int j;
2944  int k;
2945 
2946  SCIP_Bool have_change;
2947 
2948  assert(scip != NULL);
2949  assert(cons != NULL);
2950 
2951  consdata = SCIPconsGetData(cons);
2952 
2953  have_change = FALSE;
2954  i = 0;
2955  while( i < consdata->nlinvars )
2956  {
2957  var = consdata->linvars[i];
2958 
2959  if( SCIPvarIsActive(var) && !SCIPisEQ(scip, SCIPvarGetLbGlobal(var), SCIPvarGetUbGlobal(var)) )
2960  {
2961  ++i;
2962  continue;
2963  }
2964 
2965  have_change = TRUE;
2966 
2967  coef = consdata->lincoefs[i];
2968  offset = 0.0;
2969 
2970  if( SCIPisEQ(scip, SCIPvarGetLbGlobal(var), SCIPvarGetUbGlobal(var)) )
2971  {
2972  offset = coef * (SCIPvarGetLbGlobal(var) + SCIPvarGetUbGlobal(var)) / 2.0;
2973  coef = 0.0;
2974  }
2975  else
2976  {
2977  SCIP_CALL( SCIPgetProbvarSum(scip, &var, &coef, &offset) );
2978  }
2979 
2980  SCIPdebugMsg(scip, " linear term %g*<%s> is replaced by %g * <%s> + %g\n", consdata->lincoefs[i], SCIPvarGetName(consdata->linvars[i]),
2981  coef, SCIPvarGetName(var), offset);
2982 
2983  /* delete previous variable (this will move another variable to position i) */
2984  SCIP_CALL( delLinearCoefPos(scip, cons, i) );
2985 
2986  /* put constant part into bounds */
2987  if( offset != 0.0 )
2988  {
2989  if( !SCIPisInfinity(scip, -consdata->lhs) )
2990  consdata->lhs -= offset;
2991  if( !SCIPisInfinity(scip, consdata->rhs) )
2992  consdata->rhs -= offset;
2993  }
2994 
2995  /* nothing left to do if variable had been fixed */
2996  if( coef == 0.0 )
2997  continue;
2998 
2999  /* if GetProbvar gave a linear variable, just add it
3000  * if it's a multilinear variable, add it's disaggregated variables */
3001  if( SCIPvarIsActive(var) )
3002  {
3003  SCIP_CALL( addLinearCoef(scip, cons, var, coef) );
3004  }
3005  else
3006  {
3007  int naggrs;
3008  SCIP_VAR** aggrvars;
3009  SCIP_Real* aggrscalars;
3010  SCIP_Real aggrconstant;
3011 
3012  assert(SCIPvarGetStatus(var) == SCIP_VARSTATUS_MULTAGGR);
3013 
3014  naggrs = SCIPvarGetMultaggrNVars(var);
3015  aggrvars = SCIPvarGetMultaggrVars(var);
3016  aggrscalars = SCIPvarGetMultaggrScalars(var);
3017  aggrconstant = SCIPvarGetMultaggrConstant(var);
3018 
3019  SCIP_CALL( consdataEnsureLinearVarsSize(scip, consdata, consdata->nlinvars + naggrs) );
3020 
3021  for( j = 0; j < naggrs; ++j )
3022  {
3023  SCIP_CALL( addLinearCoef(scip, cons, aggrvars[j], coef * aggrscalars[j]) );
3024  }
3025 
3026  if( aggrconstant != 0.0 )
3027  {
3028  if( !SCIPisInfinity(scip, -consdata->lhs) )
3029  consdata->lhs -= coef * aggrconstant;
3030  if( !SCIPisInfinity(scip, consdata->rhs) )
3031  consdata->rhs -= coef * aggrconstant;
3032  }
3033  }
3034  }
3035 
3036  i = 0;
3037  while( i < consdata->nquadvars )
3038  {
3039  var = consdata->quadvarterms[i].var;
3040 
3041  if( SCIPvarIsActive(var) && !SCIPisEQ(scip, SCIPvarGetLbGlobal(var), SCIPvarGetUbGlobal(var)) )
3042  {
3043  ++i;
3044  continue;
3045  }
3046 
3047  have_change = TRUE;
3048 
3049  coef = 1.0;
3050  offset = 0.0;
3051 
3052  if( !SCIPisEQ(scip, SCIPvarGetLbGlobal(var), SCIPvarGetUbGlobal(var)) )
3053  {
3054  SCIP_CALL( SCIPgetProbvarSum(scip, &var, &coef, &offset) );
3055  }
3056  else
3057  {
3058  coef = 0.0;
3059  offset = (SCIPvarGetLbGlobal(var) + SCIPvarGetUbGlobal(var)) / 2.0;
3060  }
3061 
3062  SCIPdebugMsg(scip, " quadratic variable <%s> with status %d is replaced by %g * <%s> + %g\n", SCIPvarGetName(consdata->quadvarterms[i].var),
3063  SCIPvarGetStatus(consdata->quadvarterms[i].var), coef, SCIPvarGetName(var), offset);
3064 
3065  /* handle fixed variable */
3066  if( coef == 0.0 )
3067  {
3068  /* if not fixed to 0.0, add to linear coefs of vars in bilinear terms, and deal with linear and square term as constant */
3069  if( offset != 0.0 )
3070  {
3071  for( j = 0; j < consdata->quadvarterms[i].nadjbilin; ++j )
3072  {
3073  bilinterm = &consdata->bilinterms[consdata->quadvarterms[i].adjbilin[j]];
3074 
3075  var2 = bilinterm->var1 == consdata->quadvarterms[i].var ? bilinterm->var2 : bilinterm->var1;
3076  assert(var2 != consdata->quadvarterms[i].var);
3077 
3078  var2pos = 0;
3079  while( consdata->quadvarterms[var2pos].var != var2 )
3080  {
3081  ++var2pos;
3082  assert(var2pos < consdata->nquadvars);
3083  }
3084  consdata->quadvarterms[var2pos].lincoef += bilinterm->coef * offset;
3085  }
3086 
3087  offset = consdata->quadvarterms[i].lincoef * offset + consdata->quadvarterms[i].sqrcoef * offset * offset;
3088  if( !SCIPisInfinity(scip, -consdata->lhs) )
3089  consdata->lhs -= offset;
3090  if( !SCIPisInfinity(scip, consdata->rhs) )
3091  consdata->rhs -= offset;
3092  }
3093 
3094  /* remove bilinear terms */
3095  SCIP_CALL( removeBilinearTermsPos(scip, cons, consdata->quadvarterms[i].nadjbilin, consdata->quadvarterms[i].adjbilin) );
3096 
3097  /* delete quad. var term i */
3098  SCIP_CALL( delQuadVarTermPos(scip, cons, i) );
3099 
3100  continue;
3101  }
3102 
3103  assert(var != NULL);
3104 
3105  /* if GetProbvar gave an active variable, replace the quad var term so that it uses the new variable */
3106  if( SCIPvarIsActive(var) )
3107  {
3108  /* replace x by coef*y+offset */
3109  SCIP_CALL( replaceQuadVarTermPos(scip, cons, i, var, coef, offset) );
3110 
3111  continue;
3112  }
3113  else
3114  {
3115  /* if GetProbVar gave a multi-aggregated variable, add new quad var terms and new bilinear terms
3116  * x is replaced by coef * (sum_i a_ix_i + b) + offset
3117  * lcoef * x + scoef * x^2 + bcoef * x * y ->
3118  * (b*coef + offset) * (lcoef + (b*coef + offset) * scoef)
3119  * + sum_i a_i*coef * (lcoef + 2 (b*coef + offset) * scoef) x_i
3120  * + sum_i (a_i*coef)^2 * scoef * x_i^2
3121  * + 2 sum_{i,j, i<j} (a_i a_j coef^2 scoef) x_i x_j
3122  * + bcoef * (b*coef + offset + coef * sum_i a_ix_i) y
3123  */
3124  int naggrs;
3125  SCIP_VAR** aggrvars; /* x_i */
3126  SCIP_Real* aggrscalars; /* a_i */
3127  SCIP_Real aggrconstant; /* b */
3128  int nquadtermsold;
3129 
3130  SCIP_Real lcoef;
3131  SCIP_Real scoef;
3132 
3133  assert(SCIPvarGetStatus(var) == SCIP_VARSTATUS_MULTAGGR);
3134 
3135  naggrs = SCIPvarGetMultaggrNVars(var);
3136  aggrvars = SCIPvarGetMultaggrVars(var);
3137  aggrscalars = SCIPvarGetMultaggrScalars(var);
3138  aggrconstant = SCIPvarGetMultaggrConstant(var);
3139 
3140  lcoef = consdata->quadvarterms[i].lincoef;
3141  scoef = consdata->quadvarterms[i].sqrcoef;
3142 
3143  nquadtermsold = consdata->nquadvars;
3144 
3145  SCIP_CALL( consdataEnsureQuadVarTermsSize(scip, consdata, consdata->nquadvars + naggrs) );
3146 
3147  /* take care of constant part */
3148  if( aggrconstant != 0.0 || offset != 0.0 )
3149  {
3150  SCIP_Real constant;
3151  constant = (aggrconstant * coef + offset) * (lcoef + (aggrconstant * coef + offset) * scoef);
3152  if( !SCIPisInfinity(scip, -consdata->lhs) )
3153  consdata->lhs -= constant;
3154  if( !SCIPisInfinity(scip, consdata->rhs) )
3155  consdata->rhs -= constant;
3156  }
3157 
3158  /* add x_i's with linear and square coefficients */
3159  for( j = 0; j < naggrs; ++j )
3160  {
3161  SCIP_CALL( addQuadVarTerm(scip, cons, aggrvars[j],
3162  coef * aggrscalars[j] * (lcoef + 2.0 * scoef * (coef * aggrconstant + offset)),
3163  coef * coef * aggrscalars[j] * aggrscalars[j] * scoef) );
3164  }
3165 
3166  /* ensure space for bilinear terms */
3167  SCIP_CALL( consdataEnsureBilinSize(scip, consdata, consdata->nquadvars + (scoef != 0.0 ? (naggrs * (naggrs-1))/2 : 0) + consdata->quadvarterms[j].nadjbilin * naggrs) );
3168 
3169  /* add x_j*x_k's */
3170  if( scoef != 0.0 )
3171  {
3172  for( j = 0; j < naggrs; ++j )
3173  for( k = 0; k < j; ++k )
3174  {
3175  assert(aggrvars[j] != aggrvars[k]);
3176  SCIP_CALL( addBilinearTerm(scip, cons, nquadtermsold + j, nquadtermsold + k,
3177  2.0 * aggrscalars[j] * aggrscalars[k] * coef * coef * scoef) );
3178  }
3179  }
3180 
3181  /* add x_i*y's */
3182  for( k = 0; k < consdata->quadvarterms[i].nadjbilin; ++k )
3183  {
3184  bilinterm = &consdata->bilinterms[consdata->quadvarterms[i].adjbilin[k]];
3185  bilincoef = bilinterm->coef; /* copy coef, as bilinterm pointer may become invalid by realloc in addBilinearTerm() below */
3186  var2 = (bilinterm->var1 == consdata->quadvarterms[i].var) ? bilinterm->var2 : bilinterm->var1;
3187  assert(var2 != consdata->quadvarterms[i].var);
3188 
3189  /* this is not efficient, but we cannot sort the quadratic terms here, since we currently iterate over them */
3190  var2pos = 0;
3191  while( consdata->quadvarterms[var2pos].var != var2 )
3192  {
3193  ++var2pos;
3194  assert(var2pos < consdata->nquadvars);
3195  }
3196 
3197  for( j = 0; j < naggrs; ++j )
3198  {
3199  if( aggrvars[j] == var2 )
3200  { /* x_i == y, so we have a square term here */
3201  consdata->quadvarterms[var2pos].sqrcoef += bilincoef * coef * aggrscalars[j];
3202  }
3203  else
3204  { /* x_i != y, so we need to add a bilinear term here */
3205  SCIP_CALL( addBilinearTerm(scip, cons, nquadtermsold + j, var2pos, bilincoef * coef * aggrscalars[j]) );
3206  }
3207  }
3208 
3209  consdata->quadvarterms[var2pos].lincoef += bilincoef * (aggrconstant * coef + offset);
3210  }
3211 
3212  /* remove bilinear terms */
3213  SCIP_CALL( removeBilinearTermsPos(scip, cons, consdata->quadvarterms[i].nadjbilin, consdata->quadvarterms[i].adjbilin) );
3214 
3215  /* delete quad. var term i */
3216  SCIP_CALL( delQuadVarTermPos(scip, cons, i) );
3217  }
3218  }
3219 
3220  consdata->isremovedfixings = TRUE;
3221 
3222  SCIPdebugMsg(scip, "removed fixations from <%s>\n -> ", SCIPconsGetName(cons));
3223  SCIPdebugPrintCons(scip, cons, NULL);
3224 
3225 #ifndef NDEBUG
3226  for( i = 0; i < consdata->nlinvars; ++i )
3227  assert(SCIPvarIsActive(consdata->linvars[i]));
3228 
3229  for( i = 0; i < consdata->nquadvars; ++i )
3230  assert(SCIPvarIsActive(consdata->quadvarterms[i].var));
3231 #endif
3232 
3233  if( !have_change )
3234  return SCIP_OKAY;
3235 
3236  /* some quadratic variable may have been replaced by an already existing linear variable
3237  * in this case, we want the linear variable to be removed, which happens in mergeAndCleanLinearVars
3238  */
3239  consdata->linvarsmerged = FALSE;
3240 
3241  SCIP_CALL( mergeAndCleanBilinearTerms(scip, cons) );
3242  SCIP_CALL( mergeAndCleanQuadVarTerms(scip, cons) );
3243  SCIP_CALL( mergeAndCleanLinearVars(scip, cons) );
3244 
3245 #ifndef NDEBUG
3246  for( i = 0; i < consdata->nbilinterms; ++i )
3247  {
3248  assert(consdata->bilinterms[i].var1 != consdata->bilinterms[i].var2);
3249  assert(consdata->bilinterms[i].coef != 0.0);
3250  assert(SCIPvarCompare(consdata->bilinterms[i].var1, consdata->bilinterms[i].var2) < 0);
3251  }
3252 #endif
3253 
3254  return SCIP_OKAY;
3255 }
3256 
3257 /** create a nonlinear row representation of the constraint and stores them in consdata */
3258 static
3260  SCIP* scip, /**< SCIP data structure */
3261  SCIP_CONS* cons /**< quadratic constraint */
3262  )
3263 {
3264  SCIP_CONSDATA* consdata;
3265  int nquadvars; /* number of variables in quadratic terms */
3266  SCIP_VAR** quadvars; /* variables in quadratic terms */
3267  int nquadelems; /* number of quadratic elements (square and bilinear terms) */
3268  SCIP_QUADELEM* quadelems; /* quadratic elements (square and bilinear terms) */
3269  int nquadlinterms; /* number of linear terms using variables that are in quadratic terms */
3270  SCIP_VAR** quadlinvars; /* variables of linear terms using variables that are in quadratic terms */
3271  SCIP_Real* quadlincoefs; /* coefficients of linear terms using variables that are in quadratic terms */
3272  int i;
3273  int idx1;
3274  int idx2;
3275  int lincnt;
3276  int elcnt;
3277  SCIP_VAR* lastvar;
3278  int lastvaridx;
3279  SCIP_EXPRCURV curvature;
3280 
3281  assert(scip != NULL);
3282  assert(cons != NULL);
3283 
3284  consdata = SCIPconsGetData(cons);
3285  assert(consdata != NULL);
3286 
3287  if( consdata->nlrow != NULL )
3288  {
3289  SCIP_CALL( SCIPreleaseNlRow(scip, &consdata->nlrow) );
3290  }
3291 
3292  nquadvars = consdata->nquadvars;
3293  nquadelems = consdata->nbilinterms;
3294  nquadlinterms = 0;
3295  for( i = 0; i < nquadvars; ++i )
3296  {
3297  if( consdata->quadvarterms[i].sqrcoef != 0.0 )
3298  ++nquadelems;
3299  if( !SCIPisZero(scip, consdata->quadvarterms[i].lincoef) )
3300  ++nquadlinterms;
3301  }
3302 
3303  SCIP_CALL( SCIPallocBufferArray(scip, &quadvars, nquadvars) );
3304  SCIP_CALL( SCIPallocBufferArray(scip, &quadelems, nquadelems) );
3305  SCIP_CALL( SCIPallocBufferArray(scip, &quadlinvars, nquadlinterms) );
3306  SCIP_CALL( SCIPallocBufferArray(scip, &quadlincoefs, nquadlinterms) );
3307 
3308  lincnt = 0;
3309  elcnt = 0;
3310  for( i = 0; i < nquadvars; ++i )
3311  {
3312  quadvars[i] = consdata->quadvarterms[i].var;
3313 
3314  if( consdata->quadvarterms[i].sqrcoef != 0.0 )
3315  {
3316  assert(elcnt < nquadelems);
3317  quadelems[elcnt].idx1 = i;
3318  quadelems[elcnt].idx2 = i;
3319  quadelems[elcnt].coef = consdata->quadvarterms[i].sqrcoef;
3320  ++elcnt;
3321  }
3322 
3323  if( !SCIPisZero(scip, consdata->quadvarterms[i].lincoef) )
3324  {
3325  assert(lincnt < nquadlinterms);
3326  quadlinvars [lincnt] = consdata->quadvarterms[i].var;
3327  quadlincoefs[lincnt] = consdata->quadvarterms[i].lincoef;
3328  ++lincnt;
3329  }
3330  }
3331  assert(lincnt == nquadlinterms);
3332 
3333  /* bilinear terms are sorted first by first variable, then by second variable
3334  * thus, it makes sense to remember the index of the previous first variable for the case a series of bilinear terms with the same first var appears */
3335  lastvar = NULL;
3336  lastvaridx = -1;
3337  for( i = 0; i < consdata->nbilinterms; ++i )
3338  {
3339  if( lastvar == consdata->bilinterms[i].var1 )
3340  {
3341  assert(lastvaridx >= 0);
3342  assert(consdata->quadvarterms[lastvaridx].var == consdata->bilinterms[i].var1);
3343  }
3344  else
3345  {
3346  lastvar = consdata->bilinterms[i].var1;
3347  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, lastvar, &lastvaridx) );
3348  }
3349  idx1 = lastvaridx;
3350 
3351  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, consdata->bilinterms[i].var2, &idx2) );
3352 
3353  assert(elcnt < nquadelems);
3354  quadelems[elcnt].idx1 = MIN(idx1, idx2);
3355  quadelems[elcnt].idx2 = MAX(idx1, idx2);
3356  quadelems[elcnt].coef = consdata->bilinterms[i].coef;
3357  ++elcnt;
3358  }
3359  assert(elcnt == nquadelems);
3360 
3361  /* set curvature for the nonlinear row */
3362  if( consdata->isconcave && consdata->isconvex )
3363  {
3364  assert(consdata->nbilinterms == 0 && consdata->nquadvars == 0);
3365  curvature = SCIP_EXPRCURV_LINEAR;
3366  }
3367  else if( consdata->isconcave )
3368  curvature = SCIP_EXPRCURV_CONCAVE;
3369  else if( consdata->isconvex )
3370  curvature = SCIP_EXPRCURV_CONVEX;
3371  else
3372  curvature = SCIP_EXPRCURV_UNKNOWN;
3373 
3374  SCIP_CALL( SCIPcreateNlRow(scip, &consdata->nlrow, SCIPconsGetName(cons), 0.0,
3375  consdata->nlinvars, consdata->linvars, consdata->lincoefs,
3376  nquadvars, quadvars, nquadelems, quadelems,
3377  NULL, consdata->lhs, consdata->rhs,
3378  curvature) );
3379 
3380  SCIP_CALL( SCIPaddLinearCoefsToNlRow(scip, consdata->nlrow, nquadlinterms, quadlinvars, quadlincoefs) );
3381 
3382  SCIPfreeBufferArray(scip, &quadlincoefs);
3383  SCIPfreeBufferArray(scip, &quadlinvars);
3384  SCIPfreeBufferArray(scip, &quadelems);
3385  SCIPfreeBufferArray(scip, &quadvars);
3386 
3387  return SCIP_OKAY;
3388 }
3389 
3390 /** solve constraint as presolving */
3391 static
3393  SCIP* scip, /**< SCIP data structure */
3394  SCIP_CONS* cons, /**< constraint */
3395  SCIP_RESULT* result, /**< to store result of solve: cutoff, success, or do-not-find */
3396  SCIP_Bool* redundant, /**< to store whether constraint is redundant now (should be deleted) */
3397  int* naggrvars /**< counter on number of variable aggregations */
3398  )
3399 {
3400  SCIP_CONSDATA* consdata;
3401 
3402  assert(scip != NULL);
3403  assert(cons != NULL);
3404  assert(result != NULL);
3405  assert(redundant != NULL);
3406 
3407  *result = SCIP_DIDNOTFIND;
3408  *redundant = FALSE;
3409 
3410  consdata = SCIPconsGetData(cons);
3411  assert(consdata != NULL);
3412 
3413  /* if constraint is an equality with two variables, at least one of them binary,
3414  * and linear after fixing the binary, then we can aggregate the variables */
3415  if( SCIPisEQ(scip, consdata->lhs, consdata->rhs) && consdata->nlinvars == 0 && consdata->nquadvars == 2 &&
3416  ((SCIPvarIsBinary(consdata->quadvarterms[0].var) && consdata->quadvarterms[1].sqrcoef == 0.0) ||
3417  (SCIPvarIsBinary(consdata->quadvarterms[1].var) && consdata->quadvarterms[0].sqrcoef == 0.0)) )
3418  {
3419  SCIP_Bool infeasible;
3420  SCIP_Bool aggregated;
3421  SCIP_Real a;
3422  SCIP_Real b;
3423  SCIP_Real c;
3424  SCIP_VAR* x;
3425  SCIP_VAR* y;
3426  int binvaridx;
3427 
3428  /* constraint is a*(x+x^2) + b*y + c*x*y = rhs, with x binary variable
3429  * x = 0 -> b*y == rhs
3430  * x = 1 -> (b+c)*y == rhs - a
3431  *
3432  * if b != 0 and b+c != 0, then y = (rhs-a)/(b+c) * x + rhs/b * (1-x) = ((rhs-a)/(b+c) - rhs/b) * x + rhs/b
3433  */
3434 
3435  binvaridx = (SCIPvarIsBinary(consdata->quadvarterms[0].var) && consdata->quadvarterms[1].sqrcoef == 0.0) ? 0 : 1;
3436 
3437  x = consdata->quadvarterms[binvaridx].var;
3438  a = consdata->quadvarterms[binvaridx].sqrcoef + consdata->quadvarterms[binvaridx].lincoef;
3439 
3440  y = consdata->quadvarterms[1-binvaridx].var;
3441  b = consdata->quadvarterms[1-binvaridx].lincoef;
3442 
3443  assert(consdata->nbilinterms <= 1); /* should actually be 1, since constraint is otherwise linear */
3444  c = (consdata->nbilinterms == 1) ? consdata->bilinterms[0].coef : 0.0;
3445 
3446  if( !SCIPisZero(scip, b) && !SCIPisZero(scip, b+c) )
3447  {
3448  SCIPdebugMsg(scip, "<%s> = 0 -> %g*<%s> = %g and <%s> = 1 -> %g*<%s> = %g\n", SCIPvarGetName(x), b, SCIPvarGetName(y), consdata->rhs,
3449  SCIPvarGetName(x), b+c, SCIPvarGetName(y), consdata->rhs - a);
3450  SCIPdebugMsg(scip, "=> attempt aggregation <%s> = %g*<%s> + %g\n", SCIPvarGetName(y), (consdata->rhs-a)/(b+c) - consdata->rhs/b,
3451  SCIPvarGetName(x), consdata->rhs/b);
3452 
3453  SCIP_CALL( SCIPaggregateVars(scip, x, y, (consdata->rhs-a)/(b+c) - consdata->rhs/b, -1.0, -consdata->rhs/b, &infeasible, redundant, &aggregated) );
3454  if( infeasible )
3455  *result = SCIP_CUTOFF;
3456  else if( *redundant || aggregated )
3457  {
3458  /* aggregated (or were already aggregated), so constraint is now redundant */
3459  *result = SCIP_SUCCESS;
3460  *redundant = TRUE;
3461 
3462  if( aggregated )
3463  ++*naggrvars;
3464  }
3465  }
3466 
3467  /* @todo if b is 0 or b+c is 0, or lhs != rhs, then could replace by varbound constraint */
3468  }
3469 
3470  return SCIP_OKAY;
3471 }
3472 
3473 
3474 /** reformulates products of binary variables as AND constraint
3475  *
3476  * For a product x*y, with x and y binary variables, the product is replaced by a new auxiliary variable z and the constraint z = {x and y} is added.
3477  */
3478 static
3480  SCIP* scip, /**< SCIP data structure */
3481  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
3482  SCIP_CONS* cons, /**< constraint */
3483  int* naddconss /**< buffer where to add the number of AND constraints added */
3484  )
3485 {
3486  SCIP_CONSHDLRDATA* conshdlrdata;
3487  SCIP_CONSDATA* consdata;
3488  char name[SCIP_MAXSTRLEN];
3489  SCIP_VAR* vars[2];
3490  SCIP_VAR* auxvar;
3491  SCIP_CONS* andcons;
3492  int i;
3493  int ntodelete;
3494  int* todelete;
3495 
3496  assert(scip != NULL);
3497  assert(conshdlr != NULL);
3498  assert(cons != NULL);
3499  assert(naddconss != NULL);
3500 
3501  conshdlrdata = SCIPconshdlrGetData(conshdlr);
3502  assert(conshdlrdata != NULL);
3503 
3504  /* if no binary variables, then we will find nothing to reformulate here
3505  * (note that this does not count in integer variables with {0,1} bounds...)
3506  */
3507  if( SCIPgetNBinVars(scip) == 0 )
3508  return SCIP_OKAY;
3509 
3510  /* if user does not like AND very much, then return */
3511  if( conshdlrdata->empathy4and < 2 )
3512  return SCIP_OKAY;
3513 
3514  consdata = SCIPconsGetData(cons);
3515  assert(consdata != NULL);
3516 
3517  if( consdata->nbilinterms == 0 )
3518  return SCIP_OKAY;
3519 
3520  /* get array to store indices of bilinear terms that shall be deleted */
3521  SCIP_CALL( SCIPallocBufferArray(scip, &todelete, consdata->nbilinterms) );
3522  ntodelete = 0;
3523 
3524  for( i = 0; i < consdata->nbilinterms; ++i )
3525  {
3526  vars[0] = consdata->bilinterms[i].var1;
3527  if( !SCIPvarIsBinary(vars[0]) )
3528  continue;
3529 
3530  vars[1] = consdata->bilinterms[i].var2;
3531  if( !SCIPvarIsBinary(vars[1]) )
3532  continue;
3533 
3534  /* create auxiliary variable */
3535  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "prod%s_%s_%s", SCIPvarGetName(vars[0]), SCIPvarGetName(vars[1]), SCIPconsGetName(cons));
3536  SCIP_CALL( SCIPcreateVar(scip, &auxvar, name, 0.0, 1.0, 0.0, SCIP_VARTYPE_BINARY,
3537  SCIPvarIsInitial(vars[0]) || SCIPvarIsInitial(vars[1]), SCIPvarIsRemovable(vars[0]) && SCIPvarIsRemovable(vars[1]), NULL, NULL, NULL, NULL, NULL) );
3538  SCIP_CALL( SCIPaddVar(scip, auxvar) );
3539 #ifdef WITH_DEBUG_SOLUTION
3540  if( SCIPdebugIsMainscip(scip) )
3541  {
3542  SCIP_Real var0val;
3543  SCIP_Real var1val;
3544  SCIP_CALL( SCIPdebugGetSolVal(scip, vars[0], &var0val) );
3545  SCIP_CALL( SCIPdebugGetSolVal(scip, vars[1], &var1val) );
3546  SCIP_CALL( SCIPdebugAddSolVal(scip, auxvar, var0val * var1val) );
3547  }
3548 #endif
3549 
3550  /* create AND-constraint auxvar = x and y, need to be enforced as not redundant */
3551  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "%sAND%s", SCIPvarGetName(vars[0]), SCIPvarGetName(vars[1]));
3552  SCIP_CALL( SCIPcreateConsAnd(scip, &andcons, name, auxvar, 2, vars,
3553  SCIPconsIsInitial(cons) && conshdlrdata->binreforminitial,
3554  SCIPconsIsSeparated(cons), TRUE, TRUE,
3557  SCIP_CALL( SCIPaddCons(scip, andcons) );
3558  SCIPdebugMsg(scip, "added AND constraint: ");
3559  SCIPdebugPrintCons(scip, andcons, NULL);
3560  SCIP_CALL( SCIPreleaseCons(scip, &andcons) );
3561  ++*naddconss;
3562 
3563  /* add bilincoef * auxvar to linear terms */
3564  SCIP_CALL( addLinearCoef(scip, cons, auxvar, consdata->bilinterms[i].coef) );
3565  SCIP_CALL( SCIPreleaseVar(scip, &auxvar) );
3566 
3567  /* remember that we have to delete this bilinear term */
3568  assert(ntodelete < consdata->nbilinterms);
3569  todelete[ntodelete++] = i;
3570  }
3571 
3572  /* remove bilinear terms that have been replaced */
3573  SCIP_CALL( removeBilinearTermsPos(scip, cons, ntodelete, todelete) );
3574  SCIPfreeBufferArray(scip, &todelete);
3575 
3576  return SCIP_OKAY;
3577 }
3578 
3579 /** gets bounds of variable y if x takes a certain value; checks whether x = xval has implications on y */
3580 static
3582  SCIP* scip, /**< SCIP data structure */
3583  SCIP_VAR* x, /**< variable which implications to check */
3584  SCIP_Bool xval, /**< value of x to check for (TRUE for 1, FALSE for 0) */
3585  SCIP_VAR* y, /**< variable to check if bounds can be reduced */
3586  SCIP_INTERVAL* resultant /**< buffer to store bounds on y */
3587  )
3588 {
3589  SCIP_VAR** implvars;
3590  SCIP_BOUNDTYPE* impltypes;
3591  SCIP_Real* implbounds;
3592  int nimpls;
3593  int pos;
3594 
3595  assert(scip != NULL);
3596  assert(x != NULL);
3597  assert(y != NULL);
3598  assert(resultant != NULL);
3599 
3601 
3602  if( !SCIPvarIsBinary(x) || !SCIPvarIsActive(x) )
3603  return SCIP_OKAY;
3604 
3605  /* check in cliques for binary to binary implications */
3606  if( SCIPvarIsBinary(y) )
3607  {
3608  resultant->inf = MAX(resultant->inf, MIN(resultant->sup, 0.0));
3609  resultant->sup = MIN(resultant->sup, MAX(resultant->inf, 1.0));
3610 
3611  if( SCIPhaveVarsCommonClique(scip, x, xval, y, TRUE, FALSE) )
3612  {
3613  resultant->sup = MIN(resultant->sup, MAX(resultant->inf, 0.0));
3614  }
3615  else if( SCIPhaveVarsCommonClique(scip, x, xval, y, FALSE, FALSE) )
3616  {
3617  resultant->inf = MAX(resultant->inf, MIN(resultant->sup, 1.0));
3618  }
3619 
3620  return SCIP_OKAY;
3621  }
3622 
3623  /* analyze implications for x = xval */
3624  nimpls = SCIPvarGetNImpls(x, xval);
3625  if( nimpls == 0 )
3626  return SCIP_OKAY;
3627 
3628  implvars = SCIPvarGetImplVars (x, xval);
3629  impltypes = SCIPvarGetImplTypes (x, xval);
3630  implbounds = SCIPvarGetImplBounds(x, xval);
3631 
3632  assert(implvars != NULL);
3633  assert(impltypes != NULL);
3634  assert(implbounds != NULL);
3635 
3636  /* find implications */
3637  if( !SCIPsortedvecFindPtr((void**)implvars, SCIPvarComp, (void*)y, nimpls, &pos) )
3638  return SCIP_OKAY;
3639 
3640  /* if there are several implications on y, go to the first one */
3641  while( pos > 0 && implvars[pos-1] == y )
3642  --pos;
3643 
3644  /* update implied lower and upper bounds on y
3645  * but make sure that resultant will not be empty, due to tolerances
3646  */
3647  while( pos < nimpls && implvars[pos] == y )
3648  {
3649  if( impltypes[pos] == SCIP_BOUNDTYPE_LOWER )
3650  resultant->inf = MAX(resultant->inf, MIN(resultant->sup, implbounds[pos]));
3651  else
3652  resultant->sup = MIN(resultant->sup, MAX(resultant->inf, implbounds[pos]));
3653  ++pos;
3654  }
3655 
3656  assert(resultant->sup >= resultant->inf);
3657 
3658  return SCIP_OKAY;
3659 }
3660 
3661 /** Reformulates products of binary times bounded continuous variables as system of linear inequalities (plus auxiliary variable).
3662  *
3663  * For a product x*y, with y a binary variable and x a continous variable with finite bounds,
3664  * an auxiliary variable z and the inequalities \f$ x^L y \leq z \leq x^U y \f$ and \f$ x - (1-y) x^U \leq z \leq x - (1-y) x^L \f$ are added.
3665  *
3666  * If x is a linear term consisting of more than one variable, it is split up in groups of linear terms of length at most maxnrvar.
3667  * For each product of linear term of length at most maxnrvar with y, an auxiliary z and linear inequalities are added.
3668  *
3669  * If y is a binary variable, the AND constraint \f$ z = x \wedge y \f$ may be added instead of linear constraints.
3670  */
3671 static
3673  SCIP* scip, /**< SCIP data structure */
3674  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
3675  SCIP_CONS* cons, /**< constraint */
3676  int* naddconss /**< buffer where to add the number of auxiliary constraints added */
3677  )
3678 { /*lint --e{666} */
3679  SCIP_CONSHDLRDATA* conshdlrdata;
3680  SCIP_CONSDATA* consdata;
3681  SCIP_VAR** xvars;
3682  SCIP_Real* xcoef;
3683  SCIP_INTERVAL xbndszero;
3684  SCIP_INTERVAL xbndsone;
3685  SCIP_INTERVAL act0;
3686  SCIP_INTERVAL act1;
3687  int nxvars;
3688  SCIP_VAR* y;
3689  SCIP_VAR* bvar;
3690  char name[SCIP_MAXSTRLEN];
3691  int nbilinterms;
3692  SCIP_VAR* auxvar;
3693  SCIP_CONS* auxcons;
3694  int i;
3695  int j;
3696  int k;
3697  int bilinidx;
3698  SCIP_Real bilincoef;
3699  SCIP_Real mincoef;
3700  SCIP_Real maxcoef;
3701  int* todelete;
3702  int ntodelete;
3703  int maxnrvar;
3704  SCIP_Bool integral;
3705  SCIP_Longint gcd;
3706  SCIP_Bool auxvarinitial;
3707  SCIP_Bool auxvarremovable;
3708 
3709  assert(scip != NULL);
3710  assert(conshdlr != NULL);
3711  assert(cons != NULL);
3712  assert(naddconss != NULL);
3713 
3714  /* if no binary variables, then we will find nothing to reformulate here
3715  * (note that this does not count in integer variables with {0,1} bounds...)
3716  */
3717  if( SCIPgetNBinVars(scip) == 0 )
3718  return SCIP_OKAY;
3719 
3720  conshdlrdata = SCIPconshdlrGetData(conshdlr);
3721  assert(conshdlrdata != NULL);
3722 
3723  maxnrvar = conshdlrdata->replacebinaryprodlength;
3724  if( maxnrvar == 0 )
3725  return SCIP_OKAY;
3726 
3727  consdata = SCIPconsGetData(cons);
3728  assert(consdata != NULL);
3729 
3730  xvars = NULL;
3731  xcoef = NULL;
3732  todelete = NULL;
3733  gcd = 0;
3734 
3735  for( i = 0; i < consdata->nquadvars; ++i )
3736  {
3737  y = consdata->quadvarterms[i].var;
3738  if( !SCIPvarIsBinary(y) )
3739  continue;
3740 
3741  nbilinterms = consdata->quadvarterms[i].nadjbilin;
3742  if( nbilinterms == 0 )
3743  continue;
3744 
3745  SCIP_CALL( SCIPreallocBufferArray(scip, &xvars, MIN(maxnrvar, nbilinterms)+2) ); /* add 2 for later use when creating linear constraints */
3746  SCIP_CALL( SCIPreallocBufferArray(scip, &xcoef, MIN(maxnrvar, nbilinterms)+2) );
3747 
3748  /* alloc array to store indices of bilinear terms that shall be deleted */
3749  SCIP_CALL( SCIPreallocBufferArray(scip, &todelete, nbilinterms) );
3750  ntodelete = 0;
3751 
3752  auxvarinitial = SCIPvarIsInitial(y);
3753  auxvarremovable = SCIPvarIsRemovable(y);
3754 
3755  /* setup a list of bounded variables x_i with coefficients a_i that are multiplied with binary y: y*(sum_i a_i*x_i)
3756  * and compute range of sum_i a_i*x_i for the cases y = 0 and y = 1
3757  * we may need several rounds if maxnrvar < nbilinterms
3758  */
3759  j = 0;
3760  do
3761  {
3762  nxvars = 0;
3763  SCIPintervalSet(&xbndszero, 0.0);
3764  SCIPintervalSet(&xbndsone, 0.0);
3765 
3766  mincoef = SCIPinfinity(scip);
3767  maxcoef = 0.0;
3768  integral = TRUE;
3769 
3770  /* collect at most maxnrvar variables for x term */
3771  for( ; j < nbilinterms && nxvars < maxnrvar; ++j )
3772  {
3773  bilinidx = consdata->quadvarterms[i].adjbilin[j];
3774  assert(bilinidx >= 0);
3775  assert(bilinidx < consdata->nbilinterms);
3776 
3777  bvar = consdata->bilinterms[bilinidx].var1;
3778  if( bvar == y )
3779  bvar = consdata->bilinterms[bilinidx].var2;
3780  assert(bvar != y);
3781 
3782  /* skip products with unbounded variables */
3783  if( SCIPisInfinity(scip, -SCIPvarGetLbGlobal(bvar)) || SCIPisInfinity(scip, SCIPvarGetUbGlobal(bvar)) )
3784  {
3785  SCIPdebugMsg(scip, "skip reform of <%s><%s> due to unbounded second variable [%g,%g]\n",
3787  continue;
3788  }
3789 
3790  /* skip products with non-binary variables if binreformbinaryonly is set */
3791  if( conshdlrdata->binreformbinaryonly && !SCIPvarIsBinary(bvar) )
3792  {
3793  SCIPdebugMsg(scip, "skip reform of <%s><%s> because second variable is not binary\n",
3794  SCIPvarGetName(y), SCIPvarGetName(bvar));
3795  continue;
3796  }
3797 
3798  bilincoef = consdata->bilinterms[bilinidx].coef;
3799  assert(bilincoef != 0.0);
3800 
3801  /* get activity of bilincoef * x if y = 0 */
3802  SCIP_CALL( getImpliedBounds(scip, y, FALSE, bvar, &act0) );
3803  SCIPintervalMulScalar(SCIPinfinity(scip), &act0, act0, bilincoef);
3804 
3805  /* get activity of bilincoef * x if y = 1 */
3806  SCIP_CALL( getImpliedBounds(scip, y, TRUE, bvar, &act1) );
3807  SCIPintervalMulScalar(SCIPinfinity(scip), &act1, act1, bilincoef);
3808 
3809  /* skip products that give rise to very large coefficients (big big-M's) */
3810  if( SCIPfeastol(scip) * REALABS(act0.inf) >= conshdlrdata->binreformmaxcoef || SCIPfeastol(scip) * REALABS(act0.sup) >= conshdlrdata->binreformmaxcoef )
3811  {
3812  SCIPdebugMsg(scip, "skip reform of %g<%s><%s> due to huge activity [%g,%g] for <%s> = 0.0\n",
3813  bilincoef, SCIPvarGetName(y), SCIPvarGetName(bvar), SCIPintervalGetInf(act0), SCIPintervalGetSup(act0), SCIPvarGetName(y));
3814  continue;
3815  }
3816  if( SCIPfeastol(scip) * REALABS(act1.inf) >= conshdlrdata->binreformmaxcoef || SCIPfeastol(scip) * REALABS(act1.sup) >= conshdlrdata->binreformmaxcoef )
3817  {
3818  SCIPdebugMsg(scip, "skip reform of %g<%s><%s> due to huge activity [%g,%g] for <%s> = 1.0\n",
3819  bilincoef, SCIPvarGetName(y), SCIPvarGetName(bvar), SCIPintervalGetInf(act1), SCIPintervalGetSup(act1), SCIPvarGetName(y));
3820  continue;
3821  }
3822  if( !SCIPisZero(scip, MIN(REALABS(act0.inf), REALABS(act0.sup))) &&
3823  SCIPfeastol(scip) * MAX(REALABS(act0.inf), REALABS(act0.sup)) / MIN(REALABS(act0.inf), REALABS(act0.sup)) >= conshdlrdata->binreformmaxcoef )
3824  {
3825  SCIPdebugMsg(scip, "skip reform of %g<%s><%s> due to huge activity ratio %g for <%s> = 0.0\n", bilincoef, SCIPvarGetName(y), SCIPvarGetName(bvar),
3826  MAX(REALABS(act0.inf), REALABS(act0.sup)) / MIN(REALABS(act0.inf), REALABS(act0.sup)), SCIPvarGetName(y));
3827  continue;
3828  }
3829  if( !SCIPisZero(scip, MIN(REALABS(act1.inf), REALABS(act1.sup))) &&
3830  SCIPfeastol(scip) * MAX(REALABS(act1.inf), REALABS(act1.sup)) / MIN(REALABS(act1.inf), REALABS(act1.sup)) >= conshdlrdata->binreformmaxcoef )
3831  {
3832  SCIPdebugMsg(scip, "skip reform of %g<%s><%s> due to huge activity ratio %g for <%s> = 0.0\n", bilincoef, SCIPvarGetName(y), SCIPvarGetName(bvar),
3833  MAX(REALABS(act1.inf), REALABS(act1.sup)) / MIN(REALABS(act1.inf), REALABS(act1.sup)), SCIPvarGetName(y));
3834  continue;
3835  }
3836 
3837  /* add bvar to x term */
3838  xvars[nxvars] = bvar;
3839  xcoef[nxvars] = bilincoef;
3840  ++nxvars;
3841 
3842  /* update bounds on x term */
3843  SCIPintervalAdd(SCIPinfinity(scip), &xbndszero, xbndszero, act0);
3844  SCIPintervalAdd(SCIPinfinity(scip), &xbndsone, xbndsone, act1);
3845 
3846  if( REALABS(bilincoef) < mincoef )
3847  mincoef = ABS(bilincoef);
3848  if( REALABS(bilincoef) > maxcoef )
3849  maxcoef = ABS(bilincoef);
3850 
3851  /* update whether all coefficients will be integral and if so, compute their gcd */
3852  integral &= (SCIPvarGetType(bvar) < SCIP_VARTYPE_CONTINUOUS) && SCIPisIntegral(scip, bilincoef); /*lint !e514 */
3853  if( integral )
3854  {
3855  if( nxvars == 1 )
3856  gcd = (SCIP_Longint)SCIPround(scip, REALABS(bilincoef));
3857  else
3858  gcd = SCIPcalcGreComDiv(gcd, (SCIP_Longint)SCIPround(scip, REALABS(bilincoef)));
3859  }
3860 
3861  /* if bvar is initial, then also the auxiliary variable should be initial
3862  * if bvar is not removable, then also the auxiliary variable should not be removable
3863  */
3864  auxvarinitial |= SCIPvarIsInitial(bvar);
3865  auxvarremovable &= SCIPvarIsRemovable(bvar);
3866 
3867  /* remember that we have to remove this bilinear term later */
3868  assert(ntodelete < nbilinterms);
3869  todelete[ntodelete++] = bilinidx;
3870  }
3871 
3872  if( nxvars == 0 ) /* all (remaining) x_j seem to be unbounded */
3873  break;
3874 
3875  assert(!SCIPisInfinity(scip, -SCIPintervalGetInf(xbndszero)));
3876  assert(!SCIPisInfinity(scip, SCIPintervalGetSup(xbndszero)));
3877  assert(!SCIPisInfinity(scip, -SCIPintervalGetInf(xbndsone)));
3878  assert(!SCIPisInfinity(scip, SCIPintervalGetSup(xbndsone)));
3879 
3880 #ifdef SCIP_DEBUG
3881  if( SCIPintervalGetInf(xbndszero) != SCIPintervalGetInf(xbndsone) || /*lint !e777*/
3882  +SCIPintervalGetSup(xbndszero) != SCIPintervalGetSup(xbndsone) ) /*lint !e777*/
3883  {
3884  SCIPdebugMsg(scip, "got different bounds for y = 0: [%g, %g] and y = 1: [%g, %g]\n", xbndszero.inf, xbndszero.sup, xbndsone.inf, xbndsone.sup);
3885  }
3886 #endif
3887 
3888  if( nxvars == 1 && conshdlrdata->empathy4and >= 1 && SCIPvarIsBinary(xvars[0]) )
3889  {
3890  /* product of two binary variables, replace by auxvar and AND constraint */
3891  /* add auxiliary variable z */
3892  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "prod%s_%s_%s", SCIPvarGetName(y), SCIPvarGetName(xvars[0]), SCIPconsGetName(cons));
3893  SCIP_CALL( SCIPcreateVar(scip, &auxvar, name, 0.0, 1.0, 0.0, SCIP_VARTYPE_IMPLINT,
3894  auxvarinitial, auxvarremovable, NULL, NULL, NULL, NULL, NULL) );
3895  SCIP_CALL( SCIPaddVar(scip, auxvar) );
3896 
3897 #ifdef WITH_DEBUG_SOLUTION
3898  if( SCIPdebugIsMainscip(scip) )
3899  {
3900  SCIP_Real var0val;
3901  SCIP_Real var1val;
3902  SCIP_CALL( SCIPdebugGetSolVal(scip, xvars[0], &var0val) );
3903  SCIP_CALL( SCIPdebugGetSolVal(scip, y, &var1val) );
3904  SCIP_CALL( SCIPdebugAddSolVal(scip, auxvar, var0val * var1val) );
3905  }
3906 #endif
3907 
3908  /* add constraint z = x and y; need to be enforced, as it is not redundant w.r.t. existing constraints */
3909  xvars[1] = y;
3910  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "%sAND%s_%s", SCIPvarGetName(y), SCIPvarGetName(xvars[0]), SCIPconsGetName(cons));
3911  SCIP_CALL( SCIPcreateConsAnd(scip, &auxcons, name, auxvar, 2, xvars,
3912  SCIPconsIsInitial(cons) && conshdlrdata->binreforminitial,
3913  SCIPconsIsSeparated(cons), TRUE, TRUE,
3916  SCIP_CALL( SCIPaddCons(scip, auxcons) );
3917  SCIPdebugMsg(scip, "added AND constraint: ");
3918  SCIPdebugPrintCons(scip, auxcons, NULL);
3919  SCIP_CALL( SCIPreleaseCons(scip, &auxcons) );
3920  ++*naddconss;
3921 
3922  /* add linear term coef*auxvar */
3923  SCIP_CALL( addLinearCoef(scip, cons, auxvar, xcoef[0]) );
3924 
3925  /* forget about auxvar */
3926  SCIP_CALL( SCIPreleaseVar(scip, &auxvar) );
3927  }
3928  else
3929  {
3930  /* product of binary variable with more than one binary or with continuous variables or with binary and user
3931  * did not like AND -> replace by auxvar and linear constraints */
3932  SCIP_Real scale;
3933 
3934  /* scale auxiliary constraint by some nice value,
3935  * if all coefficients are integral, take a value that preserves integrality (-> gcd), so we can make the auxiliary variable impl. integer
3936  */
3937  if( integral )
3938  {
3939  scale = (SCIP_Real)gcd;
3940  assert(scale >= 1.0);
3941  }
3942  else if( nxvars == 1 )
3943  {
3944  /* scaling by the only coefficient gives auxiliary variable = x * y, which thus will be implicit integral provided y is not continuous */
3945  assert(mincoef == maxcoef); /*lint !e777 */
3946  scale = mincoef;
3947  integral = SCIPvarGetType(xvars[0]) < SCIP_VARTYPE_CONTINUOUS;
3948  }
3949  else
3950  {
3951  scale = 1.0;
3952  if( maxcoef < 0.5 )
3953  scale = maxcoef;
3954  if( mincoef > 2.0 )
3955  scale = mincoef;
3956  if( scale != 1.0 )
3957  scale = SCIPselectSimpleValue(scale / 2.0, 1.5 * scale, MAXDNOM);
3958  }
3959  assert(scale > 0.0);
3960  assert(!SCIPisInfinity(scip, scale));
3961 
3962  /* if x-term is always negative for y = 1, negate scale so we get a positive auxiliary variable; maybe this is better sometimes? */
3963  if( !SCIPisPositive(scip, SCIPintervalGetSup(xbndsone)) )
3964  scale = -scale;
3965 
3966  SCIPdebugMsg(scip, "binary reformulation using scale %g, nxvars = %d, integral = %u\n", scale, nxvars, integral);
3967  if( scale != 1.0 )
3968  {
3969  SCIPintervalDivScalar(SCIPinfinity(scip), &xbndszero, xbndszero, scale);
3970  SCIPintervalDivScalar(SCIPinfinity(scip), &xbndsone, xbndsone, scale);
3971  for( k = 0; k < nxvars; ++k )
3972  xcoef[k] /= scale;
3973  }
3974 
3975  /* add auxiliary variable z */
3976  if( nxvars == 1 )
3977  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "prod%s_%s_%s", SCIPvarGetName(y), SCIPvarGetName(xvars[0]), SCIPconsGetName(cons));
3978  else
3979  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "prod%s_%s_more_%s", SCIPvarGetName(y), SCIPvarGetName(xvars[0]), SCIPconsGetName(cons));
3980  SCIP_CALL( SCIPcreateVar(scip, &auxvar, name, MIN(0., SCIPintervalGetInf(xbndsone)), MAX(0., SCIPintervalGetSup(xbndsone)),
3982  auxvarinitial, auxvarremovable, NULL, NULL, NULL, NULL, NULL) );
3983  SCIP_CALL( SCIPaddVar(scip, auxvar) );
3984 
3985  /* compute value of auxvar in debug solution */
3986 #ifdef WITH_DEBUG_SOLUTION
3987  if( SCIPdebugIsMainscip(scip) )
3988  {
3989  SCIP_Real debugval;
3990  SCIP_Real varval;
3991 
3992  SCIP_CALL( SCIPdebugGetSolVal(scip, y, &varval) );
3993  if( SCIPisZero(scip, varval) )
3994  {
3995  SCIP_CALL( SCIPdebugAddSolVal(scip, auxvar, 0.0) );
3996  }
3997  else
3998  {
3999  assert(SCIPisEQ(scip, varval, 1.0));
4000 
4001  debugval = 0.0;
4002  for( k = 0; k < nxvars; ++k )
4003  {
4004  SCIP_CALL( SCIPdebugGetSolVal(scip, xvars[k], &varval) );
4005  debugval += xcoef[k] * varval;
4006  }
4007  SCIP_CALL( SCIPdebugAddSolVal(scip, auxvar, debugval) );
4008  }
4009  }
4010 #endif
4011 
4012  /* add auxiliary constraints
4013  * it seems to be advantageous to make the varbound constraints initial and the linear constraints not initial
4014  * maybe because it is more likely that a binary variable takes value 0 instead of 1, and thus the varbound constraints
4015  * are more often active, compared to the linear constraints added below
4016  * also, the varbound constraints are more sparse than the linear cons
4017  */
4018  if( SCIPisNegative(scip, SCIPintervalGetInf(xbndsone)) )
4019  {
4020  /* add 0 <= z - xbndsone.inf * y constraint (as varbound constraint), need to be enforced as not redundant */
4021  if( nxvars == 1 )
4022  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "linreform%s*%s_%s_1", SCIPvarGetName(y), SCIPvarGetName(xvars[0]), SCIPconsGetName(cons));
4023  else
4024  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "linreform%s*%s*more_%s_1", SCIPvarGetName(y), SCIPvarGetName(xvars[0]), SCIPconsGetName(cons));
4025  SCIP_CALL( SCIPcreateConsVarbound(scip, &auxcons, name, auxvar, y, -SCIPintervalGetInf(xbndsone), 0.0, SCIPinfinity(scip),
4026  SCIPconsIsInitial(cons) /*&& conshdlrdata->binreforminitial*/,
4027  SCIPconsIsSeparated(cons), TRUE, TRUE,
4030  SCIP_CALL( SCIPaddCons(scip, auxcons) );
4031  SCIPdebugMsg(scip, "added varbound constraint: ");
4032  SCIPdebugPrintCons(scip, auxcons, NULL);
4033  SCIP_CALL( SCIPreleaseCons(scip, &auxcons) );
4034  ++*naddconss;
4035  }
4036  if( SCIPisPositive(scip, SCIPintervalGetSup(xbndsone)) )
4037  {
4038  /* add z - xbndsone.sup * y <= 0 constraint (as varbound constraint), need to be enforced as not redundant */
4039  if( nxvars == 1 )
4040  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "linreform%s*%s_%s_2", SCIPvarGetName(y), SCIPvarGetName(xvars[0]), SCIPconsGetName(cons));
4041  else
4042  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "linreform%s*%s*more_%s_2", SCIPvarGetName(y), SCIPvarGetName(xvars[0]), SCIPconsGetName(cons));
4043  SCIP_CALL( SCIPcreateConsVarbound(scip, &auxcons, name, auxvar, y, -SCIPintervalGetSup(xbndsone), -SCIPinfinity(scip), 0.0,
4044  SCIPconsIsInitial(cons) /*&& conshdlrdata->binreforminitial*/,
4045  SCIPconsIsSeparated(cons), TRUE, TRUE,
4048  SCIP_CALL( SCIPaddCons(scip, auxcons) );
4049  SCIPdebugMsg(scip, "added varbound constraint: ");
4050  SCIPdebugPrintCons(scip, auxcons, NULL);
4051  SCIP_CALL( SCIPreleaseCons(scip, &auxcons) );
4052  ++*naddconss;
4053  }
4054 
4055  /* add xbndszero.inf <= sum_i a_i*x_i + xbndszero.inf * y - z constraint, need to be enforced as not redundant */
4056  xvars[nxvars] = y;
4057  xvars[nxvars+1] = auxvar;
4058  xcoef[nxvars] = SCIPintervalGetInf(xbndszero);
4059  xcoef[nxvars+1] = -1;
4060 
4061  if( nxvars == 1 )
4062  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "linreform%s*%s_%s_3", SCIPvarGetName(y), SCIPvarGetName(xvars[0]), SCIPconsGetName(cons));
4063  else
4064  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "linreform%s*%s*more_%s_3", SCIPvarGetName(y), SCIPvarGetName(xvars[0]), SCIPconsGetName(cons));
4065  SCIP_CALL( SCIPcreateConsLinear(scip, &auxcons, name, nxvars+2, xvars, xcoef, SCIPintervalGetInf(xbndszero), SCIPinfinity(scip),
4066  SCIPconsIsInitial(cons) && conshdlrdata->binreforminitial,
4067  SCIPconsIsSeparated(cons), TRUE, TRUE,
4070  SCIP_CALL( SCIPaddCons(scip, auxcons) );
4071  SCIPdebugMsg(scip, "added linear constraint: ");
4072  SCIPdebugPrintCons(scip, auxcons, NULL);
4073  SCIP_CALL( SCIPreleaseCons(scip, &auxcons) );
4074  ++*naddconss;
4075 
4076  /* add sum_i a_i*x_i + xbndszero.sup * y - z <= xbndszero.sup constraint, need to be enforced as not redundant */
4077  xcoef[nxvars] = SCIPintervalGetSup(xbndszero);
4078 
4079  if( nxvars == 1 )
4080  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "linreform%s*%s_%s_4", SCIPvarGetName(y), SCIPvarGetName(xvars[0]), SCIPconsGetName(cons));
4081  else
4082  (void)SCIPsnprintf(name, SCIP_MAXSTRLEN, "linreform%s*%s*more_%s_4", SCIPvarGetName(y), SCIPvarGetName(xvars[0]), SCIPconsGetName(cons));
4083  SCIP_CALL( SCIPcreateConsLinear(scip, &auxcons, name, nxvars+2, xvars, xcoef, -SCIPinfinity(scip), SCIPintervalGetSup(xbndszero),
4084  SCIPconsIsInitial(cons) && conshdlrdata->binreforminitial,
4085  SCIPconsIsSeparated(cons), TRUE, TRUE,
4088  SCIP_CALL( SCIPaddCons(scip, auxcons) );
4089  SCIPdebugMsg(scip, "added linear constraint: ");
4090  SCIPdebugPrintCons(scip, auxcons, NULL);
4091  SCIP_CALL( SCIPreleaseCons(scip, &auxcons) );
4092  ++*naddconss;
4093 
4094  /* add linear term scale*auxvar to this constraint */
4095  SCIP_CALL( addLinearCoef(scip, cons, auxvar, scale) );
4096 
4097  /* forget about auxvar */
4098  SCIP_CALL( SCIPreleaseVar(scip, &auxvar) );
4099  }
4100  }
4101  while( j < nbilinterms );
4102 
4103  /* remove bilinear terms that have been replaced */
4104  SCIP_CALL( removeBilinearTermsPos(scip, cons, ntodelete, todelete) );
4105  }
4106  SCIPdebugMsg(scip, "resulting quadratic constraint: ");
4107  SCIPdebugPrintCons(scip, cons, NULL);
4108 
4109  SCIPfreeBufferArrayNull(scip, &todelete);
4110  SCIPfreeBufferArrayNull(scip, &xcoef);
4111  SCIPfreeBufferArrayNull(scip, &xvars);
4112 
4113  return SCIP_OKAY;
4114 }
4115 
4116 /** tries to automatically convert a quadratic constraint (or a part of it) into a more specific and more specialized constraint */
4117 static
4119  SCIP* scip, /**< SCIP data structure */
4120  SCIP_CONSHDLR* conshdlr, /**< constraint handler data structure */
4121  SCIP_CONS* cons, /**< source constraint to try to convert */
4122  SCIP_Bool* upgraded, /**< buffer to store whether constraint was upgraded */
4123  int* nupgdconss, /**< buffer to increase if constraint was upgraded */
4124  int* naddconss, /**< buffer to increase with number of additional constraints created during upgrade */
4125  SCIP_PRESOLTIMING presoltiming /**< current presolving timing */
4126  )
4127 {
4128  SCIP_CONSHDLRDATA* conshdlrdata;
4129  SCIP_CONSDATA* consdata;
4130  SCIP_VAR* var;
4131  SCIP_Real lincoef;
4132  SCIP_Real quadcoef;
4133  SCIP_Real lb;
4134  SCIP_Real ub;
4135  int nbinlin;
4136  int nbinquad;
4137  int nintlin;
4138  int nintquad;
4139  int nimpllin;
4140  int nimplquad;
4141  int ncontlin;
4142  int ncontquad;
4143  SCIP_Bool integral;
4144  int i;
4145  int j;
4146  SCIP_CONS** upgdconss;
4147  int upgdconsssize;
4148  int nupgdconss_;
4149 
4150  assert(scip != NULL);
4151  assert(conshdlr != NULL);
4152  assert(cons != NULL);
4153  assert(!SCIPconsIsModifiable(cons));
4154  assert(upgraded != NULL);
4155  assert(nupgdconss != NULL);
4156  assert(naddconss != NULL);
4157 
4158  *upgraded = FALSE;
4159 
4160  nupgdconss_ = 0;
4161 
4162  conshdlrdata = SCIPconshdlrGetData(conshdlr);
4163  assert(conshdlrdata != NULL);
4164 
4165  /* if there are no upgrade methods, we can also stop */
4166  if( conshdlrdata->nquadconsupgrades == 0 )
4167  return SCIP_OKAY;
4168 
4169  upgdconsssize = 2;
4170  SCIP_CALL( SCIPallocBufferArray(scip, &upgdconss, upgdconsssize) );
4171 
4172  consdata = SCIPconsGetData(cons);
4173  assert(consdata != NULL);
4174 
4175  /* calculate some statistics on quadratic constraint */
4176  nbinlin = 0;
4177  nbinquad = 0;
4178  nintlin = 0;
4179  nintquad = 0;
4180  nimpllin = 0;
4181  nimplquad = 0;
4182  ncontlin = 0;
4183  ncontquad = 0;
4184  integral = TRUE;
4185  for( i = 0; i < consdata->nlinvars; ++i )
4186  {
4187  var = consdata->linvars[i];
4188  lincoef = consdata->lincoefs[i];
4189  lb = SCIPvarGetLbLocal(var);
4190  ub = SCIPvarGetUbLocal(var);
4191  assert(!SCIPisZero(scip, lincoef));
4192 
4193  switch( SCIPvarGetType(var) )
4194  {
4195  case SCIP_VARTYPE_BINARY:
4196  if( !SCIPisZero(scip, lb) || !SCIPisZero(scip, ub) )
4197  integral = integral && SCIPisIntegral(scip, lincoef);
4198  nbinlin++;
4199  break;
4200  case SCIP_VARTYPE_INTEGER:
4201  if( !SCIPisZero(scip, lb) || !SCIPisZero(scip, ub) )
4202  integral = integral && SCIPisIntegral(scip, lincoef);
4203  nintlin++;
4204  break;
4205  case SCIP_VARTYPE_IMPLINT:
4206  if( !SCIPisZero(scip, lb) || !SCIPisZero(scip, ub) )
4207  integral = integral && SCIPisIntegral(scip, lincoef);
4208  nimpllin++;
4209  break;
4211  integral = integral && SCIPisRelEQ(scip, lb, ub) && SCIPisIntegral(scip, lincoef * lb);
4212  ncontlin++;
4213  break;
4214  default:
4215  SCIPerrorMessage("unknown variable type\n");
4216  return SCIP_INVALIDDATA;
4217  }
4218  }
4219 
4220  for( i = 0; i < consdata->nquadvars; ++i )
4221  {
4222  var = consdata->quadvarterms[i].var;
4223  lincoef = consdata->quadvarterms[i].lincoef;
4224  quadcoef = consdata->quadvarterms[i].sqrcoef;
4225  lb = SCIPvarGetLbLocal(var);
4226  ub = SCIPvarGetUbLocal(var);
4227 
4228  switch( SCIPvarGetType(var) )
4229  {
4230  case SCIP_VARTYPE_BINARY:
4231  if( !SCIPisZero(scip, lb) || !SCIPisZero(scip, ub) )
4232  integral = integral && SCIPisIntegral(scip, lincoef) && SCIPisIntegral(scip, quadcoef);
4233  nbinquad++;
4234  break;
4235  case SCIP_VARTYPE_INTEGER:
4236  if( !SCIPisZero(scip, lb) || !SCIPisZero(scip, ub) )
4237  integral = integral && SCIPisIntegral(scip, lincoef) && SCIPisIntegral(scip, quadcoef);
4238  nintquad++;
4239  break;
4240  case SCIP_VARTYPE_IMPLINT:
4241  if( !SCIPisZero(scip, lb) || !SCIPisZero(scip, ub) )
4242  integral = integral && SCIPisIntegral(scip, lincoef) && SCIPisIntegral(scip, quadcoef);
4243  nimplquad++;
4244  break;
4246  integral = integral && SCIPisRelEQ(scip, lb, ub) && SCIPisIntegral(scip, lincoef * lb + quadcoef * lb * lb);
4247  ncontquad++;
4248  break;
4249  default:
4250  SCIPerrorMessage("unknown variable type\n");
4251  return SCIP_INVALIDDATA;
4252  }
4253  }
4254 
4255  if( integral )
4256  {
4257  for( i = 0; i < consdata->nbilinterms && integral; ++i )
4258  {
4259  if( SCIPvarGetType(consdata->bilinterms[i].var1) < SCIP_VARTYPE_CONTINUOUS && SCIPvarGetType(consdata->bilinterms[i].var2) < SCIP_VARTYPE_CONTINUOUS )
4260  integral = integral && SCIPisIntegral(scip, consdata->bilinterms[i].coef);
4261  else
4262  integral = FALSE;
4263  }
4264  }
4265 
4266  /* call the upgrading methods */
4267 
4268  SCIPdebugMsg(scip, "upgrading quadratic constraint <%s> (%d upgrade methods):\n",
4269  SCIPconsGetName(cons), conshdlrdata->nquadconsupgrades);
4270  SCIPdebugMsg(scip, " binlin=%d binquad=%d intlin=%d intquad=%d impllin=%d implquad=%d contlin=%d contquad=%d integral=%u\n",
4271  nbinlin, nbinquad, nintlin, nintquad, nimpllin, nimplquad, ncontlin, ncontquad, integral);
4272  SCIPdebugPrintCons(scip, cons, NULL);
4273 
4274  /* try all upgrading methods in priority order in case the upgrading step is enable */
4275  for( i = 0; i < conshdlrdata->nquadconsupgrades; ++i )
4276  {
4277  if( !conshdlrdata->quadconsupgrades[i]->active )
4278  continue;
4279 
4280  SCIP_CALL( conshdlrdata->quadconsupgrades[i]->quadconsupgd(scip, cons,
4281  nbinlin, nbinquad, nintlin, nintquad, nimpllin, nimplquad, ncontlin, ncontquad, integral,
4282  &nupgdconss_, upgdconss, upgdconsssize, presoltiming) );
4283 
4284  while( nupgdconss_ < 0 )
4285  {
4286  /* upgrade function requires more memory: resize upgdconss and call again */
4287  assert(-nupgdconss_ > upgdconsssize);
4288  upgdconsssize = -nupgdconss_;
4289  SCIP_CALL( SCIPreallocBufferArray(scip, &upgdconss, -nupgdconss_) );
4290 
4291  SCIP_CALL( conshdlrdata->quadconsupgrades[i]->quadconsupgd(scip, cons,
4292  nbinlin, nbinquad, nintlin, nintquad, nimpllin, nimplquad, ncontlin, ncontquad, integral,
4293  &nupgdconss_, upgdconss, upgdconsssize, presoltiming) );
4294 
4295  assert(nupgdconss_ != 0);
4296  }
4297 
4298  if( nupgdconss_ > 0 )
4299  {
4300  /* got upgrade */
4301  SCIPdebugPrintCons(scip, cons, NULL);
4302  SCIPdebugMsg(scip, " -> upgraded to %d constraints:\n", nupgdconss_);
4303 
4304  /* add the upgraded constraints to the problem and forget them */
4305  for( j = 0; j < nupgdconss_; ++j )
4306  {
4307  SCIPdebugMsgPrint(scip, "\t");
4308  SCIPdebugPrintCons(scip, upgdconss[j], NULL);
4309 
4310  SCIP_CALL( SCIPaddCons(scip, upgdconss[j]) ); /*lint !e613*/
4311  SCIP_CALL( SCIPreleaseCons(scip, &upgdconss[j]) ); /*lint !e613*/
4312  }
4313 
4314  /* count the first upgrade constraint as constraint upgrade and the remaining ones as added constraints */
4315  *nupgdconss += 1;
4316  *naddconss += nupgdconss_ - 1;
4317  *upgraded = TRUE;
4318 
4319  /* delete upgraded constraint */
4320  SCIPdebugMsg(scip, "delete constraint <%s> after upgrade\n", SCIPconsGetName(cons));
4321  SCIP_CALL( SCIPdelCons(scip, cons) );
4322 
4323  break;
4324  }
4325  }
4326 
4327  SCIPfreeBufferArray(scip, &upgdconss);
4328 
4329  return SCIP_OKAY;
4330 }
4331 
4332 /** helper function for presolveDisaggregate */
4333 static
4335  SCIP* scip, /**< SCIP data structure */
4336  SCIP_CONSDATA* consdata, /**< constraint data */
4337  int quadvaridx, /**< index of quadratic variable to mark */
4338  SCIP_HASHMAP* var2component, /**< variables to components mapping */
4339  int componentnr, /**< the component number to mark to */
4340  int* componentsize /**< buffer to store size of component (incremented by 1) */
4341  )
4342 {
4343  SCIP_QUADVARTERM* quadvarterm;
4344  SCIP_VAR* othervar;
4345  int othervaridx;
4346  int i;
4347 
4348  assert(consdata != NULL);
4349  assert(quadvaridx >= 0);
4350  assert(quadvaridx < consdata->nquadvars);
4351  assert(var2component != NULL);
4352  assert(componentnr >= 0);
4353 
4354  quadvarterm = &consdata->quadvarterms[quadvaridx];
4355 
4356  if( SCIPhashmapExists(var2component, quadvarterm->var) )
4357  {
4358  /* if we saw the variable before, then it should have the same component number */
4359  assert(SCIPhashmapGetImageInt(var2component, quadvarterm->var) == componentnr);
4360  return SCIP_OKAY;
4361  }
4362 
4363  /* assign component number to variable */
4364  SCIP_CALL( SCIPhashmapInsertInt(var2component, quadvarterm->var, componentnr) );
4365  ++*componentsize;
4366 
4367  /* assign same component number to all variables this variable is multiplied with */
4368  for( i = 0; i < quadvarterm->nadjbilin; ++i )
4369  {
4370  othervar = consdata->bilinterms[quadvarterm->adjbilin[i]].var1 == quadvarterm->var ?
4371  consdata->bilinterms[quadvarterm->adjbilin[i]].var2 : consdata->bilinterms[quadvarterm->adjbilin[i]].var1;
4372  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, othervar, &othervaridx) );
4373  assert(othervaridx >= 0);
4374  SCIP_CALL( presolveDisaggregateMarkComponent(scip, consdata, othervaridx, var2component, componentnr, componentsize) );
4375  }
4376 
4377  return SCIP_OKAY;
4378 }
4379 
4380 /** merges components in variables connectivity graph */
4381 static
4383  SCIP* scip, /**< SCIP data structure */
4384  SCIP_CONSHDLR* conshdlr, /**< constraint handler data structure */
4385  SCIP_HASHMAP* var2component, /**< variables to component mapping */
4386  int nvars, /**< number of variables */
4387  int* ncomponents, /**< number of components */
4388  int* componentssize /**< size of components */
4389  )
4390 {
4391  SCIP_CONSHDLRDATA* conshdlrdata;
4392  SCIP_HASHMAPENTRY* entry;
4393  int maxncomponents;
4394  int* oldcompidx;
4395  int* newcompidx;
4396  int i;
4397  int oldcomponent;
4398  int newcomponent;
4399 
4400  assert(scip != NULL);
4401  assert(conshdlr != NULL);
4402  assert(var2component != NULL);
4403  assert(ncomponents != NULL);
4404  assert(componentssize != NULL);
4405 
4406  conshdlrdata = SCIPconshdlrGetData(conshdlr);
4407  assert(conshdlrdata != NULL);
4408 
4409  maxncomponents = conshdlrdata->maxdisaggrsize;
4410  assert(maxncomponents > 0);
4411 
4412  /* if already not too many components, then nothing to do */
4413  if( *ncomponents <= maxncomponents )
4414  return SCIP_OKAY;
4415 
4416  /*
4417  printf("component sizes before:");
4418  for( i = 0; i < *ncomponents; ++i )
4419  printf(" %d", componentssize[i]);
4420  printf("\n");
4421  */
4422 
4423  SCIP_CALL( SCIPallocBufferArray(scip, &oldcompidx, *ncomponents) );
4424  SCIP_CALL( SCIPallocBufferArray(scip, &newcompidx, *ncomponents) );
4425 
4426  for( i = 0; i < *ncomponents; ++i )
4427  oldcompidx[i] = i;
4428 
4429  switch( conshdlrdata->disaggrmergemethod )
4430  {
4431  case 's' :
4432  /* sort components by size, increasing order */
4433  SCIPsortIntInt(componentssize, oldcompidx, *ncomponents);
4434  break;
4435  case 'b' :
4436  case 'm' :
4437  /* sort components by size, decreasing order */
4438  SCIPsortDownIntInt(componentssize, oldcompidx, *ncomponents);
4439  break;
4440  default :
4441  SCIPerrorMessage("invalid value for constraints/quadratic/disaggrmergemethod parameter");
4442  return SCIP_PARAMETERWRONGVAL;
4443  }
4444 
4445  SCIPdebugMsg(scip, "%-30s: % 4d components of size % 4d to % 4d, median: % 4d\n", SCIPgetProbName(scip), *ncomponents, componentssize[0], componentssize[*ncomponents-1], componentssize[*ncomponents/2]);
4446 
4447  if( conshdlrdata->disaggrmergemethod == 'm' )
4448  {
4449  SCIP_Real targetsize;
4450  int count = 0;
4451 
4452  /* a minimal component size we should reach to have all components roughly the same size */
4453  targetsize = nvars / maxncomponents; /*lint !e653*/
4454  for( i = 0; i < *ncomponents; ++i )
4455  {
4456  newcompidx[oldcompidx[i]] = i;
4457  count += componentssize[i];
4458 
4459  /* fill with small components until we reach targetsize
4460  * Since targetsize might be fractional, we also add another component if
4461  * the number of variables remaining (=nvars-count) is larger than
4462  * what we expect to put into the remaining components (=targetsize * (maxncomponents - i-1)).
4463  * Thus, from time to time, a component is made larger than the targetsize to avoid
4464  * having to add much into the last component.
4465  */
4466  while( i < *ncomponents-1 && (componentssize[i] + componentssize[*ncomponents-1] <= targetsize ||
4467  nvars - count > targetsize * (maxncomponents - i)) )
4468  {
4469  /* map last (=smallest) component to component i */
4470  newcompidx[oldcompidx[*ncomponents-1]] = i;
4471 
4472  /* increase size of component i accordingly */
4473  componentssize[i] += componentssize[*ncomponents-1];
4474  count += componentssize[*ncomponents-1];
4475 
4476  /* forget about last component */
4477  --*ncomponents;
4478  }
4479  }
4480  assert(count == nvars);
4481  }
4482  else
4483  {
4484  /* get inverse permutation */
4485  for( i = 0; i < *ncomponents; ++i )
4486  newcompidx[oldcompidx[i]] = i;
4487  }
4488 
4489  /* assign new component numbers to variables, cutting off at maxncomponents */
4490  for( i = 0; i < SCIPhashmapGetNEntries(var2component); ++i )
4491  {
4492  entry = SCIPhashmapGetEntry(var2component, i);
4493  if( entry == NULL )
4494  continue;
4495 
4496  oldcomponent = (int)(size_t)SCIPhashmapEntryGetImage(entry);
4497 
4498  newcomponent = newcompidx[oldcomponent];
4499  if( newcomponent >= maxncomponents )
4500  {
4501  newcomponent = maxncomponents-1;
4502  ++componentssize[maxncomponents-1];
4503  }
4504 
4505  SCIPhashmapEntrySetImage(entry, (void*)(size_t)newcomponent); /*lint !e571*/
4506  }
4507  if( *ncomponents > maxncomponents )
4508  *ncomponents = maxncomponents;
4509 
4510  /*
4511  printf("component sizes after :");
4512  for( i = 0; i < *ncomponents; ++i )
4513  printf(" %d", componentssize[i]);
4514  printf("\n");
4515  */
4516 
4517  SCIPfreeBufferArray(scip, &newcompidx);
4518  SCIPfreeBufferArray(scip, &oldcompidx);
4519 
4520  return SCIP_OKAY;
4521 }
4522 
4523 /** compute the next highest power of 2 for a 32-bit argument
4524  *
4525  * Source: https://graphics.stanford.edu/~seander/bithacks.html#RoundUpPowerOf2
4526  *
4527  * @note Returns 0 for v=0.
4528  */
4529 static
4530 unsigned int nextPowerOf2(
4531  unsigned int v /**< input */
4532  )
4533 {
4534  v--;
4535  v |= v >> 1;
4536  v |= v >> 2;
4537  v |= v >> 4;
4538  v |= v >> 8;
4539  v |= v >> 16;
4540  v++;
4541 
4542  return v;
4543 }
4544 
4545 
4546 /** for quadratic constraints that consists of a sum of quadratic terms, disaggregates the sum into a set of constraints by introducing auxiliary variables
4547  *
4548  * Assume the quadratic constraint can be written in the form
4549  * lhs <= b'x + sum_{k=1..p} q_k(x_k) <= rhs
4550  * where x_k denotes a subset of the variables in x and these subsets are pairwise disjunct
4551  * and q_k(.) is a quadratic form.
4552  * p is selected as large as possible, but to be <= conshdlrdata->maxdisaggrsize.
4553  *
4554  * Without additional scaling, the constraint is disaggregated into
4555  * lhs <= b'x + sum_k c_k z_k <= rhs
4556  * c_k z_k ~ q_k(x)
4557  * where "~" is either "<=", "==", or ">=", depending on whether lhs or rhs are infinite.
4558  * Further, c_k is chosen to be the maximal absolute value of the coefficients of the quadratic terms in q_k(x).
4559  * This is done to ensure that z_k takes values with a similar magnitute as the variables in x_k (better for separation).
4560  *
4561  * However, a solution of this disaggregated system can violate the original constraint by (p+1)*epsilon
4562  * (assuming unscaled violations are used, which is the default).
4563  * Therefore, all constraints are scaled by p+1:
4564  * (p+1)*lhs <= (p+1)*b'x + (p+1) * sum_k c_k z_k <= (p+1) * rhs
4565  * (p+1)*c_k z_k ~ (p+1)*q_k(x)
4566  */
4567 static
4569  SCIP* scip, /**< SCIP data structure */
4570  SCIP_CONSHDLR* conshdlr, /**< constraint handler data structure */
4571  SCIP_CONS* cons, /**< source constraint to try to convert */
4572  int* naddconss /**< pointer to counter of added constraints */
4573  )
4574 {
4575  SCIP_CONSDATA* consdata;
4576  SCIP_HASHMAP* var2component;
4577  int* componentssize;
4578  int ncomponents;
4579  int i;
4580  int comp;
4581  SCIP_CONS** auxconss;
4582  SCIP_VAR** auxvars;
4583  SCIP_Real* auxcoefs;
4584 #ifdef WITH_DEBUG_SOLUTION
4585  SCIP_Real* auxsolvals; /* value of auxiliary variable in debug solution */
4586 #endif
4587  SCIP_Real scale;
4588  char name[SCIP_MAXSTRLEN];
4589 
4590  assert(scip != NULL);
4591  assert(conshdlr != NULL);
4592  assert(cons != NULL);
4593  assert(naddconss != NULL);
4594 
4595  consdata = SCIPconsGetData(cons);
4596  assert(consdata != NULL);
4597 
4598  /* skip if constraint has been already disaggregated */
4599  if( consdata->isdisaggregated )
4600  return SCIP_OKAY;
4601 
4602  consdata->isdisaggregated = TRUE;
4603 
4604  /* make sure there are no quadratic variables without coefficients */
4605  SCIP_CALL( mergeAndCleanBilinearTerms(scip, cons) );
4606  SCIP_CALL( mergeAndCleanQuadVarTerms(scip, cons) );
4607 
4608  if( consdata->nquadvars <= 1 )
4609  return SCIP_OKAY;
4610 
4611  /* sort quadratic variable terms here, so we can later search in it without reordering the array */
4612  SCIP_CALL( consdataSortQuadVarTerms(scip, consdata) );
4613 
4614  /* check how many quadratic terms with non-overlapping variables we have
4615  * in other words, the number of components in the sparsity graph of the quadratic term matrix
4616  */
4617  ncomponents = 0;
4618  SCIP_CALL( SCIPhashmapCreate(&var2component, SCIPblkmem(scip), consdata->nquadvars) );
4619  SCIP_CALL( SCIPallocBufferArray(scip, &componentssize, consdata->nquadvars) );
4620  for( i = 0; i < consdata->nquadvars; ++i )
4621  {
4622  /* if variable was marked already, skip it */
4623  if( SCIPhashmapExists(var2component, (void*)consdata->quadvarterms[i].var) )
4624  continue;
4625 
4626  /* start a new component with variable i */
4627  componentssize[ncomponents] = 0;
4628  SCIP_CALL( presolveDisaggregateMarkComponent(scip, consdata, i, var2component, ncomponents, componentssize + ncomponents) );
4629  ++ncomponents;
4630  }
4631 
4632  assert(ncomponents >= 1);
4633 
4634  /* if there is only one component, we cannot disaggregate
4635  * @todo we could still split the constraint into several while keeping the number of variables sharing several constraints as small as possible
4636  */
4637  if( ncomponents == 1 )
4638  {
4639  SCIPhashmapFree(&var2component);
4640  SCIPfreeBufferArray(scip, &componentssize);
4641  return SCIP_OKAY;
4642  }
4643 
4644  /* merge some components, if necessary */
4645  SCIP_CALL( presolveDisaggregateMergeComponents(scip, conshdlr, var2component, consdata->nquadvars, &ncomponents, componentssize) );
4646 
4647  SCIPfreeBufferArray(scip, &componentssize);
4648 
4649  /* scale all new constraints (ncomponents+1 many) by ncomponents+1 (or its next power of 2), so violations sum up to at most epsilon */
4650  scale = nextPowerOf2((unsigned int)ncomponents + 1);
4651 
4652  SCIP_CALL( SCIPallocBufferArray(scip, &auxconss, ncomponents) );
4653  SCIP_CALL( SCIPallocBufferArray(scip, &auxvars, ncomponents) );
4654  SCIP_CALL( SCIPallocBufferArray(scip, &auxcoefs, ncomponents) );
4655 #ifdef WITH_DEBUG_SOLUTION
4656  SCIP_CALL( SCIPallocClearBufferArray(scip, &auxsolvals, ncomponents) );
4657 #endif
4658 
4659  /* create auxiliary variables and empty constraints for each component */
4660  for( comp = 0; comp < ncomponents; ++comp )
4661  {
4662  (void) SCIPsnprintf(name, SCIP_MAXSTRLEN, "%s_comp%d", SCIPconsGetName(cons), comp);
4663 
4664  SCIP_CALL( SCIPcreateVar(scip, &auxvars[comp], name, -SCIPinfinity(scip), SCIPinfinity(scip), 0.0,
4666 
4667  SCIP_CALL( SCIPcreateConsQuadratic2(scip, &auxconss[comp], name, 0, NULL, NULL, 0, NULL, 0, NULL,
4668  (SCIPisInfinity(scip, -consdata->lhs) ? -SCIPinfinity(scip) : 0.0),
4669  (SCIPisInfinity(scip, consdata->rhs) ? SCIPinfinity(scip) : 0.0),
4672  SCIPconsIsDynamic(cons), SCIPconsIsRemovable(cons)) );
4673 
4674  auxcoefs[comp] = SCIPinfinity(scip);
4675  }
4676 
4677  /* add quadratic variables to each component constraint
4678  * delete adjacency information */
4679  for( i = 0; i < consdata->nquadvars; ++i )
4680  {
4681  assert(SCIPhashmapExists(var2component, consdata->quadvarterms[i].var));
4682 
4683  comp = SCIPhashmapGetImageInt(var2component, consdata->quadvarterms[i].var);
4684  assert(comp >= 0);
4685  assert(comp < ncomponents);
4686 
4687  /* add variable term to corresponding constraint */
4688  SCIP_CALL( SCIPaddQuadVarQuadratic(scip, auxconss[comp], consdata->quadvarterms[i].var, scale * consdata->quadvarterms[i].lincoef, scale * consdata->quadvarterms[i].sqrcoef) );
4689 
4690  /* reduce coefficient of aux variable */
4691  if( !SCIPisZero(scip, consdata->quadvarterms[i].lincoef) && ABS(consdata->quadvarterms[i].lincoef) < auxcoefs[comp] )
4692  auxcoefs[comp] = REALABS(consdata->quadvarterms[i].lincoef);
4693  if( !SCIPisZero(scip, consdata->quadvarterms[i].sqrcoef) && ABS(consdata->quadvarterms[i].sqrcoef) < auxcoefs[comp] )
4694  auxcoefs[comp] = REALABS(consdata->quadvarterms[i].sqrcoef);
4695 
4696  SCIPfreeBlockMemoryArray(scip, &consdata->quadvarterms[i].adjbilin, consdata->quadvarterms[i].adjbilinsize);
4697  consdata->quadvarterms[i].nadjbilin = 0;
4698  consdata->quadvarterms[i].adjbilinsize = 0;
4699 
4700 #ifdef WITH_DEBUG_SOLUTION
4701  if( SCIPdebugIsMainscip(scip) )
4702  {
4703  SCIP_Real debugvarval;
4704 
4705  SCIP_CALL( SCIPdebugGetSolVal(scip, consdata->quadvarterms[i].var, &debugvarval) );
4706  auxsolvals[comp] += consdata->quadvarterms[i].lincoef * debugvarval + consdata->quadvarterms[i].sqrcoef * debugvarval * debugvarval;
4707  }
4708 #endif
4709  }
4710 
4711  /* add bilinear terms to each component constraint */
4712  for( i = 0; i < consdata->nbilinterms; ++i )
4713  {
4714  assert(SCIPhashmapExists(var2component, consdata->bilinterms[i].var1));
4715  assert(SCIPhashmapExists(var2component, consdata->bilinterms[i].var2));
4716 
4717  comp = SCIPhashmapGetImageInt(var2component, consdata->bilinterms[i].var1);
4718  assert(comp == SCIPhashmapGetImageInt(var2component, consdata->bilinterms[i].var2));
4719  assert(!SCIPisZero(scip, consdata->bilinterms[i].coef));
4720 
4721  SCIP_CALL( SCIPaddBilinTermQuadratic(scip, auxconss[comp],
4722  consdata->bilinterms[i].var1, consdata->bilinterms[i].var2, scale * consdata->bilinterms[i].coef) );
4723 
4724  if( ABS(consdata->bilinterms[i].coef) < auxcoefs[comp] )
4725  auxcoefs[comp] = ABS(consdata->bilinterms[i].coef);
4726 
4727 #ifdef WITH_DEBUG_SOLUTION
4728  if( SCIPdebugIsMainscip(scip) )
4729  {
4730  SCIP_Real debugvarval1;
4731  SCIP_Real debugvarval2;
4732 
4733  SCIP_CALL( SCIPdebugGetSolVal(scip, consdata->bilinterms[i].var1, &debugvarval1) );
4734  SCIP_CALL( SCIPdebugGetSolVal(scip, consdata->bilinterms[i].var2, &debugvarval2) );
4735  auxsolvals[comp] += consdata->bilinterms[i].coef * debugvarval1 * debugvarval2;
4736  }
4737 #endif
4738  }
4739 
4740  /* forget about bilinear terms in cons */
4741  SCIPfreeBlockMemoryArray(scip, &consdata->bilinterms, consdata->bilintermssize);
4742  consdata->nbilinterms = 0;
4743  consdata->bilintermssize = 0;
4744 
4745  /* remove quadratic variable terms from cons */
4746  for( i = consdata->nquadvars - 1; i >= 0; --i )
4747  {
4748  SCIP_CALL( delQuadVarTermPos(scip, cons, i) );
4749  }
4750  assert(consdata->nquadvars == 0);
4751 
4752  /* scale remaining linear variables and sides by scale */
4753  for( i = 0; i < consdata->nlinvars; ++i )
4754  {
4755  SCIP_CALL( chgLinearCoefPos(scip, cons, i, scale * consdata->lincoefs[i]) );
4756  }
4757  if( !SCIPisInfinity(scip, -consdata->lhs) )
4758  {
4759  consdata->lhs *= scale;
4760  assert(!SCIPisInfinity(scip, -consdata->lhs) );
4761  }
4762  if( !SCIPisInfinity(scip, consdata->rhs) )
4763  {
4764  consdata->rhs *= scale;
4765  assert(!SCIPisInfinity(scip, consdata->rhs) );
4766  }
4767 
4768  /* add auxiliary variables to auxiliary constraints
4769  * add aux vars and constraints to SCIP
4770  * add aux vars to this constraint
4771  * set value of aux vars in debug solution, if any
4772  */
4773  SCIPdebugMsg(scip, "add %d constraints for disaggregation of quadratic constraint <%s>\n", ncomponents, SCIPconsGetName(cons));
4774  SCIP_CALL( consdataEnsureLinearVarsSize(scip, consdata, consdata->nlinvars + ncomponents) );
4775  for( comp = 0; comp < ncomponents; ++comp )
4776  {
4777  SCIP_CONSDATA* auxconsdata;
4778 
4779  SCIP_CALL( SCIPaddLinearVarQuadratic(scip, auxconss[comp], auxvars[comp], -scale * auxcoefs[comp]) );
4780 
4781  SCIP_CALL( SCIPaddVar(scip, auxvars[comp]) );
4782 
4783  SCIP_CALL( SCIPaddCons(scip, auxconss[comp]) );
4784  SCIPdebugPrintCons(scip, auxconss[comp], NULL);
4785 
4786  SCIP_CALL( addLinearCoef(scip, cons, auxvars[comp], scale * auxcoefs[comp]) );
4787 
4788  /* mark that the constraint should not further be disaggregated */
4789  auxconsdata = SCIPconsGetData(auxconss[comp]);
4790  assert(auxconsdata != NULL);
4791  auxconsdata->isdisaggregated = TRUE;
4792 
4793 #ifdef WITH_DEBUG_SOLUTION
4794  if( SCIPdebugIsMainscip(scip) )
4795  {
4796  /* auxvar should take value from auxsolvals in debug solution, but we also scaled auxvar by auxcoefs[comp] */
4797  SCIP_CALL( SCIPdebugAddSolVal(scip, auxvars[comp], auxsolvals[comp] / auxcoefs[comp]) );
4798  }
4799 #endif
4800 
4801  SCIP_CALL( SCIPreleaseCons(scip, &auxconss[comp]) );
4802  SCIP_CALL( SCIPreleaseVar(scip, &auxvars[comp]) );
4803  }
4804  *naddconss += ncomponents;
4805 
4806  SCIPdebugPrintCons(scip, cons, NULL);
4807 
4808  SCIPfreeBufferArray(scip, &auxconss);
4809  SCIPfreeBufferArray(scip, &auxvars);
4810  SCIPfreeBufferArray(scip, &auxcoefs);
4811 #ifdef WITH_DEBUG_SOLUTION
4812  SCIPfreeBufferArray(scip, &auxsolvals);
4813 #endif
4814  SCIPhashmapFree(&var2component);
4815 
4816  return SCIP_OKAY;
4817 }
4818 
4819 #ifdef CHECKIMPLINBILINEAR
4820 /** checks if there are bilinear terms x*y with a binary variable x and an implication x = {0,1} -> y = 0
4821  *
4822  * In this case, the bilinear term can be removed (x=0 case) or replaced by y (x=1 case).
4823  */
4824 static
4825 SCIP_RETCODE presolveApplyImplications(
4826  SCIP* scip, /**< SCIP data structure */
4827  SCIP_CONS* cons, /**< quadratic constraint */
4828  int* nbilinremoved /**< buffer to store number of removed bilinear terms */
4829  )
4830 {
4831  SCIP_CONSDATA* consdata;
4832  SCIP_VAR* x;
4833  SCIP_VAR* y;
4834  SCIP_INTERVAL implbnds;
4835  int i;
4836  int j;
4837  int k;
4838 
4839  assert(scip != NULL);
4840  assert(cons != NULL);
4841  assert(nbilinremoved != NULL);
4842 
4843  *nbilinremoved = 0;
4844 
4845  consdata = SCIPconsGetData(cons);
4846  assert(consdata != NULL);
4847 
4848  SCIPdebugMsg(scip, "apply implications in <%s>\n", SCIPconsGetName(cons));
4849 
4850  /* sort quadvarterms in case we need to search */
4851  SCIP_CALL( consdataSortQuadVarTerms(scip, consdata) );
4852 
4853  for( i = 0; i < consdata->nquadvars; ++i )
4854  {
4855  x = consdata->quadvarterms[i].var;
4856  assert(x != NULL);
4857 
4858  if( consdata->quadvarterms[i].nadjbilin == 0 )
4859  continue;
4860 
4861  if( !SCIPvarIsBinary(x) )
4862  continue;
4863 
4864  if( !SCIPvarIsActive(x) )
4865  continue;
4866 
4867  if( SCIPvarGetNImpls(x, TRUE) == 0 && SCIPvarGetNImpls(x, FALSE) == 0 )
4868  continue;
4869 
4870  for( j = 0; j < consdata->quadvarterms[i].nadjbilin; ++j )
4871  {
4872  k = consdata->quadvarterms[i].adjbilin[j];
4873  assert(k >= 0);
4874  assert(k < consdata->nbilinterms);
4875 
4876  if( consdata->bilinterms[k].coef == 0.0 )
4877  continue;
4878 
4879  y = consdata->bilinterms[k].var1 == x ? consdata->bilinterms[k].var2 : consdata->bilinterms[k].var1;
4880  assert(x != y);
4881 
4882  SCIP_CALL( getImpliedBounds(scip, x, TRUE, y, &implbnds) );
4883  if( SCIPisZero(scip, implbnds.inf) && SCIPisZero(scip, implbnds.sup) )
4884  {
4885  /* if x = 1 implies y = 0, then we can remove the bilinear term x*y, since it is always 0
4886  * we only set the coefficient to 0.0 here and mark the bilinterms as not merged */
4887  SCIPdebugMsg(scip, "remove bilinear term %g<%s><%s> from <%s> due to implication\n", consdata->bilinterms[k].coef, SCIPvarGetName(x), SCIPvarGetName(y), SCIPconsGetName(cons));
4888  consdata->bilinterms[k].coef = 0.0;
4889  consdata->bilinmerged = FALSE;
4890  ++*nbilinremoved;
4891  continue;
4892  }
4893 
4894  SCIP_CALL( getImpliedBounds(scip, x, FALSE, y, &implbnds) );
4895  if( SCIPisZero(scip, implbnds.inf) && SCIPisZero(scip, implbnds.sup) )
4896  {
4897  /* if x = 0 implies y = 0, then we can replace the bilinear term x*y by y
4898  * we only move the coefficient to the linear coef of y here and mark the bilinterms as not merged */
4899  SCIPdebugMsg(scip, "replace bilinear term %g<%s><%s> by %g<%s> in <%s> due to implication\n", consdata->bilinterms[k].coef, SCIPvarGetName(x), SCIPvarGetName(y), consdata->bilinterms[k].coef, SCIPvarGetName(y), SCIPconsGetName(cons));
4900  assert(consdata->quadvarssorted);
4901  SCIP_CALL( SCIPaddQuadVarLinearCoefQuadratic(scip, cons, y, consdata->bilinterms[k].coef) );
4902  consdata->bilinterms[k].coef = 0.0;
4903  consdata->bilinmerged = FALSE;
4904  ++*nbilinremoved;
4905  }
4906  }
4907  }
4908 
4909  if( *nbilinremoved > 0 )
4910  {
4911  SCIP_CALL( mergeAndCleanBilinearTerms(scip, cons) );
4912 
4913  /* invalidate nonlinear row */
4914  if( consdata->nlrow != NULL )
4915  {
4916  SCIP_CALL( SCIPreleaseNlRow(scip, &consdata->nlrow) );
4917  }
4918 
4919  consdata->ispropagated = FALSE;
4920  consdata->ispresolved = FALSE;
4921  consdata->iscurvchecked = FALSE;
4922  }
4923 
4924  consdata->isimpladded = FALSE;
4925 
4926  return SCIP_OKAY;
4927 }
4928 #endif
4929 
4930 /** checks a quadratic constraint for convexity and/or concavity without checking multivariate functions */
4931 static
4932 void checkCurvatureEasy(
4933  SCIP* scip, /**< SCIP data structure */
4934  SCIP_CONS* cons, /**< quadratic constraint */
4935  SCIP_Bool* determined, /**< pointer to store whether the curvature could be determined */
4936  SCIP_Bool checkmultivariate /**< whether curvature will be checked later on for multivariate functions */
4937  )
4938 {
4939  SCIP_CONSDATA* consdata;
4940  int nquadvars;
4941 
4942  assert(scip != NULL);
4943  assert(cons != NULL);
4944  assert(determined != NULL);
4945 
4946  consdata = SCIPconsGetData(cons);
4947  assert(consdata != NULL);
4948 
4949  nquadvars = consdata->nquadvars;
4950  *determined = TRUE;
4951 
4952  if( consdata->iscurvchecked )
4953  return;
4954 
4955  SCIPdebugMsg(scip, "Checking curvature of constraint <%s> without multivariate functions\n", SCIPconsGetName(cons));
4956 
4957  consdata->maxnonconvexity = 0.0;
4958  if( nquadvars == 1 )
4959  {
4960  assert(consdata->nbilinterms == 0);
4961  consdata->isconvex = !SCIPisNegative(scip, consdata->quadvarterms[0].sqrcoef);
4962  consdata->isconcave = !SCIPisPositive(scip, consdata->quadvarterms[0].sqrcoef);
4963  consdata->iscurvchecked = TRUE;
4964 
4965  if( !SCIPisInfinity(scip, -consdata->lhs) && consdata->quadvarterms[0].sqrcoef > 0.0 )
4966  consdata->maxnonconvexity = consdata->quadvarterms[0].sqrcoef;
4967  if( !SCIPisInfinity(scip, consdata->rhs) && consdata->quadvarterms[0].sqrcoef < 0.0 )
4968  consdata->maxnonconvexity = -consdata->quadvarterms[0].sqrcoef;
4969  }
4970  else if( nquadvars == 0 )
4971  {
4972  consdata->isconvex = TRUE;
4973  consdata->isconcave = TRUE;
4974  consdata->iscurvchecked = TRUE;
4975  }
4976  else if( consdata->nbilinterms == 0 )
4977  {
4978  int v;
4979 
4980  consdata->isconvex = TRUE;
4981  consdata->isconcave = TRUE;
4982 
4983  for( v = nquadvars - 1; v >= 0; --v )
4984  {
4985  consdata->isconvex = consdata->isconvex && !SCIPisNegative(scip, consdata->quadvarterms[v].sqrcoef);
4986  consdata->isconcave = consdata->isconcave && !SCIPisPositive(scip, consdata->quadvarterms[v].sqrcoef);
4987 
4988  if( !SCIPisInfinity(scip, -consdata->lhs) && consdata->quadvarterms[v].sqrcoef > consdata->maxnonconvexity )
4989  consdata->maxnonconvexity = consdata->quadvarterms[0].sqrcoef;
4990  if( !SCIPisInfinity(scip, consdata->rhs) && -consdata->quadvarterms[v].sqrcoef > consdata->maxnonconvexity )
4991  consdata->maxnonconvexity = -consdata->quadvarterms[0].sqrcoef;
4992  }
4993 
4994  consdata->iscurvchecked = TRUE;
4995  }
4996  else if( !checkmultivariate )
4997  {
4998  consdata->isconvex = FALSE;
4999  consdata->isconcave = FALSE;
5000  consdata->iscurvchecked = TRUE;
5001  consdata->maxnonconvexity = SCIPinfinity(scip);
5002  }
5003  else
5004  *determined = FALSE;
5005 }
5006 
5007 /** checks a quadratic constraint for convexity and/or concavity */
5008 static
5010  SCIP* scip, /**< SCIP data structure */
5011  SCIP_CONS* cons, /**< quadratic constraint */
5012  SCIP_Bool checkmultivariate /**< whether curvature should also be checked for multivariate functions */
5013  )
5014 {
5015  SCIP_CONSDATA* consdata;
5016  double* matrix;
5017  SCIP_HASHMAP* var2index;
5018  int i;
5019  int n;
5020  int nn;
5021  int row;
5022  int col;
5023  double* alleigval;
5024  SCIP_Bool determined;
5025 
5026  assert(scip != NULL);
5027  assert(cons != NULL);
5028 
5029  consdata = SCIPconsGetData(cons);
5030  assert(consdata != NULL);
5031 
5032  n = consdata->nquadvars;
5033 
5034  if( consdata->iscurvchecked )
5035  return SCIP_OKAY;
5036 
5037  /* easy checks for curvature detection */
5038  checkCurvatureEasy(scip, cons, &determined, checkmultivariate);
5039 
5040  /* if curvature was already detected stop */
5041  if( determined )
5042  {
5043  return SCIP_OKAY;
5044  }
5045 
5046  SCIPdebugMsg(scip, "Checking curvature of constraint <%s> with multivariate functions\n", SCIPconsGetName(cons));
5047 
5048  if( n == 2 )
5049  {
5050  SCIP_Real tracehalf;
5051  SCIP_Real discriminantroot;
5052 
5053  /* compute eigenvalues by hand */
5054  assert(consdata->nbilinterms == 1);
5055  consdata->isconvex =
5056  consdata->quadvarterms[0].sqrcoef >= 0 &&
5057  consdata->quadvarterms[1].sqrcoef >= 0 &&
5058  4 * consdata->quadvarterms[0].sqrcoef * consdata->quadvarterms[1].sqrcoef >= consdata->bilinterms[0].coef * consdata->bilinterms[0].coef;
5059  consdata->isconcave =
5060  consdata->quadvarterms[0].sqrcoef <= 0 &&
5061  consdata->quadvarterms[1].sqrcoef <= 0 &&
5062  4 * consdata->quadvarterms[0].sqrcoef * consdata->quadvarterms[1].sqrcoef >= consdata->bilinterms[0].coef * consdata->bilinterms[0].coef;
5063 
5064  /* store largest eigenvalue causing nonconvexity according to sides */
5065  tracehalf = (consdata->quadvarterms[0].sqrcoef + consdata->quadvarterms[1].sqrcoef) / 2.0;
5066  discriminantroot = consdata->quadvarterms[0].sqrcoef * consdata->quadvarterms[1].sqrcoef - SQR(consdata->bilinterms[0].coef / 2.0);
5067  discriminantroot = SQR(tracehalf) - discriminantroot;
5068  assert(!SCIPisNegative(scip, discriminantroot));
5069  discriminantroot = SQRT(MAX(0.0, discriminantroot));
5070 
5071  consdata->maxnonconvexity = 0.0;
5072  if( !SCIPisInfinity(scip, -consdata->lhs) )
5073  consdata->maxnonconvexity = MAX(consdata->maxnonconvexity, tracehalf + discriminantroot);
5074  if( !SCIPisInfinity(scip, consdata->rhs) )
5075  consdata->maxnonconvexity = MAX(consdata->maxnonconvexity, discriminantroot - tracehalf);
5076 
5077  consdata->iscurvchecked = TRUE;
5078  return SCIP_OKAY;
5079  }
5080 
5081  /* do not check curvature if n is too large */
5082  nn = n * n;
5083  if( nn < 0 || (unsigned) (int) nn > UINT_MAX / sizeof(SCIP_Real) )
5084  {
5085  SCIPverbMessage(scip, SCIP_VERBLEVEL_FULL, NULL, "cons_quadratic - n is too large to check the curvature\n");
5086  consdata->isconvex = FALSE;
5087  consdata->isconcave = FALSE;
5088  consdata->iscurvchecked = TRUE;
5089  consdata->maxnonconvexity = SCIPinfinity(scip);
5090  return SCIP_OKAY;
5091  }
5092 
5093  /* lower triangular of quadratic term matrix */
5094  SCIP_CALL( SCIPallocBufferArray(scip, &matrix, nn) );
5095  BMSclearMemoryArray(matrix, nn);
5096 
5097  consdata->isconvex = TRUE;
5098  consdata->isconcave = TRUE;
5099  consdata->maxnonconvexity = 0.0;
5100 
5101  SCIP_CALL( SCIPhashmapCreate(&var2index, SCIPblkmem(scip), n) );
5102  for( i = 0; i < n; ++i )
5103  {
5104  if( consdata->quadvarterms[i].nadjbilin > 0 )
5105  {
5106  SCIP_CALL( SCIPhashmapInsertInt(var2index, consdata->quadvarterms[i].var, i) );
5107  matrix[i*n + i] = consdata->quadvarterms[i].sqrcoef;
5108  }
5109  else
5110  {
5111  /* if pure square term, then update maximal nonconvex eigenvalue, as it will not be considered in lapack call below */
5112  if( !SCIPisInfinity(scip, -consdata->lhs) && consdata->quadvarterms[i].sqrcoef > consdata->maxnonconvexity )
5113  consdata->maxnonconvexity = consdata->quadvarterms[i].sqrcoef;
5114  if( !SCIPisInfinity(scip, consdata->rhs) && -consdata->quadvarterms[i].sqrcoef > consdata->maxnonconvexity )
5115  consdata->maxnonconvexity = -consdata->quadvarterms[i].sqrcoef;
5116  }
5117  /* nonzero elements on diagonal tell a lot about convexity/concavity */
5118  if( SCIPisNegative(scip, consdata->quadvarterms[i].sqrcoef) )
5119  consdata->isconvex = FALSE;
5120  if( SCIPisPositive(scip, consdata->quadvarterms[i].sqrcoef) )
5121  consdata->isconcave = FALSE;
5122  }
5123 
5124  /* skip lapack call, if we know already that we are indefinite
5125  * NOTE: this will leave out updating consdata->maxnonconvexity, so that it only provides a lower bound in this case
5126  */
5127  if( !consdata->isconvex && !consdata->isconcave )
5128  {
5129  SCIPfreeBufferArray(scip, &matrix);
5130  SCIPhashmapFree(&var2index);
5131  consdata->iscurvchecked = TRUE;
5132  /* make sure that maxnonconvexity is strictly different from zero if nonconvex
5133  * TODO one could think about doing some eigenvalue estimation here (Gershgorin)
5134  */
5135  consdata->maxnonconvexity = MAX(1000.0, consdata->maxnonconvexity);
5136  return SCIP_OKAY;
5137  }
5138 
5140  {
5141  for( i = 0; i < consdata->nbilinterms; ++i )
5142  {
5143  assert(SCIPhashmapExists(var2index, consdata->bilinterms[i].var1));
5144  assert(SCIPhashmapExists(var2index, consdata->bilinterms[i].var2));
5145  row = SCIPhashmapGetImageInt(var2index, consdata->bilinterms[i].var1);
5146  col = SCIPhashmapGetImageInt(var2index, consdata->bilinterms[i].var2);
5147  if( row < col )
5148  matrix[row * n + col] = consdata->bilinterms[i].coef/2;
5149  else
5150  matrix[col * n + row] = consdata->bilinterms[i].coef/2;
5151  }
5152 
5153  SCIP_CALL( SCIPallocBufferArray(scip, &alleigval, n) );
5154  /* @todo Can we compute only min and max eigen value?
5155  * @todo Can we estimate the numerical error?
5156  * @todo Trying a cholesky factorization may be much faster.
5157  */
5158  if( LapackDsyev(FALSE, n, matrix, alleigval) != SCIP_OKAY )
5159  {
5160  SCIPwarningMessage(scip, "Failed to compute eigenvalues of quadratic coefficient matrix of constraint %s. Assuming matrix is indefinite.\n", SCIPconsGetName(cons));
5161  consdata->isconvex = FALSE;
5162  consdata->isconcave = FALSE;
5163  }
5164  else
5165  {
5166  /* deconvexification reformulates a stricly convex quadratic function in binaries such that it becomes not-strictly convex
5167  * by adding the -lambda*(x^2-x) terms for lambda the smallest eigenvalue of the matrix
5168  * the result is still a convex form "but less so" (ref. papers by Guignard et.al.), but with hopefully tighter value for the continuous relaxation
5169  */
5170 #ifdef DECONVEXIFY
5171  SCIP_Bool allbinary;
5172  printf("cons <%s>[%g,%g] spectrum = [%g,%g]\n", SCIPconsGetName(cons), consdata->lhs, consdata->rhs, alleigval[0], alleigval[n-1]);
5173 #endif
5174  consdata->isconvex &= !SCIPisNegative(scip, alleigval[0]); /*lint !e514*/
5175  consdata->isconcave &= !SCIPisPositive(scip, alleigval[n-1]); /*lint !e514*/
5176  consdata->iscurvchecked = TRUE;
5177 #ifdef DECONVEXIFY
5178  for( i = 0; i < consdata->nquadvars; ++i )
5179  if( !SCIPvarIsBinary(consdata->quadvarterms[i].var) )
5180  break;
5181  allbinary = i == consdata->nquadvars;
5182 
5183  if( !SCIPisInfinity(scip, consdata->rhs) && alleigval[0] > 0.1 && allbinary )
5184  {
5185  printf("deconvexify cons <%s> by shifting hessian by %g\n", SCIPconsGetName(cons), alleigval[0]);
5186  for( i = 0; i < consdata->nquadvars; ++i )
5187  {
5188  consdata->quadvarterms[i].sqrcoef -= alleigval[0];
5189  consdata->quadvarterms[i].lincoef += alleigval[0];
5190  }
5191  }
5192 
5193  if( !SCIPisInfinity(scip, consdata->lhs) && alleigval[n-1] < -0.1 && allbinary )
5194  {
5195  printf("deconcavify cons <%s> by shifting hessian by %g\n", SCIPconsGetName(cons), alleigval[n-1]);
5196  for( i = 0; i < consdata->nquadvars; ++i )
5197  {
5198  consdata->quadvarterms[i].sqrcoef -= alleigval[n-1];
5199  consdata->quadvarterms[i].lincoef += alleigval[n-1];
5200  }
5201  }
5202 #endif
5203  }
5204 
5205  /* update largest eigenvalue causing nonconvexity according to sides */
5206  if( !SCIPisInfinity(scip, -consdata->lhs) )
5207  consdata->maxnonconvexity = MAX(consdata->maxnonconvexity, alleigval[n-1]);
5208  if( !SCIPisInfinity(scip, consdata->rhs) )
5209  consdata->maxnonconvexity = MAX(consdata->maxnonconvexity, -alleigval[0]);
5210 
5211  SCIPfreeBufferArray(scip, &alleigval);
5212  }
5213  else
5214  {
5215  consdata->isconvex = FALSE;
5216  consdata->isconcave = FALSE;
5217  consdata->iscurvchecked = TRUE; /* set to TRUE since it does not help to repeat this procedure again and again (that will not bring Ipopt in) */
5218  consdata->maxnonconvexity = SCIPinfinity(scip);
5219  }
5220 
5221  SCIPhashmapFree(&var2index);
5222  SCIPfreeBufferArray(scip, &matrix);
5223 
5224  return SCIP_OKAY;
5225 }
5226 
5227 /** check whether indefinite constraint function is factorable and store corresponding coefficients */
5228 static
5230  SCIP* scip, /**< SCIP data structure */
5231  SCIP_CONS* cons /**< constraint */
5232  )
5233 {
5234  SCIP_BILINTERM* bilinterm;
5235  SCIP_CONSDATA* consdata;
5236  SCIP_Real* a;
5237  SCIP_Real* eigvals;
5238  SCIP_Real sigma1;
5239  SCIP_Real sigma2;
5240  SCIP_Bool success;
5241  int n;
5242  int i;
5243  int idx1;
5244  int idx2;
5245  int posidx;
5246  int negidx;
5247 
5248  assert(scip != NULL);
5249  assert(cons != NULL);
5250 
5251  consdata = SCIPconsGetData(cons);
5252  assert(consdata != NULL);
5253  assert(consdata->factorleft == NULL);
5254  assert(consdata->factorright == NULL);
5255 
5256  /* we don't need this if there are no bilinear terms */
5257  if( consdata->nbilinterms == 0 )
5258  return SCIP_OKAY;
5259 
5260  /* write constraint as lhs <= linear + x'^T A x' <= rhs where x' = (x,1) and
5261  * A = ( Q b/2 )
5262  * ( b^T/2 0 )
5263  * compute an eigenvalue factorization of A and check if there are one positive and one negative eigenvalue
5264  * if so, then let sigma1^2 and -sigma2^2 be these eigenvalues and v1 and v2 be the first two rows of the inverse eigenvector matrix
5265  * thus, x'^T A x' = sigma1^2 (v1^T x')^2 - sigma2^2 (v2^T x')^2
5266  * = (sigma1 (v1^T x') - sigma2 (v2^T x')) * (sigma1 (v1^T x') + sigma2 (v2^T x'))
5267  * we then store sigma1 v1^T - sigma2 v2^T as left factor coef, and sigma1 v1^T + sigma2 v2^T as right factor coef
5268  */
5269 
5270  /* if we already know that there are only positive or only negative eigenvalues, then don't try */
5271  if( consdata->iscurvchecked && (consdata->isconvex || consdata->isconcave) )
5272  return SCIP_OKAY;
5273 
5274  n = consdata->nquadvars + 1;
5275 
5276  /* @todo handle case n=3 explicitly */
5277 
5278  /* skip too large matrices */
5279  if( n > 50 )
5280  return SCIP_OKAY;
5281 
5282  /* need routine to compute eigenvalues/eigenvectors */
5283  if( !SCIPisIpoptAvailableIpopt() )
5284  return SCIP_OKAY;
5285 
5286  SCIP_CALL( consdataSortQuadVarTerms(scip, consdata) );
5287 
5288  SCIP_CALL( SCIPallocBufferArray(scip, &a, n*n) );
5289  BMSclearMemoryArray(a, n*n);
5290 
5291  /* set lower triangular entries of A corresponding to bilinear terms */
5292  for( i = 0; i < consdata->nbilinterms; ++i )
5293  {
5294  bilinterm = &consdata->bilinterms[i];
5295 
5296  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, bilinterm->var1, &idx1) );
5297  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, bilinterm->var2, &idx2) );
5298  assert(idx1 >= 0);
5299  assert(idx2 >= 0);
5300  assert(idx1 != idx2);
5301 
5302  a[MIN(idx1,idx2) * n + MAX(idx1,idx2)] = bilinterm->coef / 2.0;
5303  }
5304 
5305  /* set lower triangular entries of A corresponding to square and linear terms */
5306  for( i = 0; i < consdata->nquadvars; ++i )
5307  {
5308  a[i*n + i] = consdata->quadvarterms[i].sqrcoef;
5309  a[i*n + n-1] = consdata->quadvarterms[i].lincoef / 2.0;
5310  }
5311 
5312  SCIP_CALL( SCIPallocBufferArray(scip, &eigvals, n) );
5313  if( LapackDsyev(TRUE, n, a, eigvals) != SCIP_OKAY )
5314  {
5315  SCIPdebugMsg(scip, "Failed to compute eigenvalues and eigenvectors of augmented quadratic form matrix for constraint <%s>.\n", SCIPconsGetName(cons));
5316  goto CLEANUP;
5317  }
5318 
5319  /* check if there is exactly one positive and one negative eigenvalue */
5320  posidx = -1;
5321  negidx = -1;
5322  for( i = 0; i < n; ++i )
5323  {
5324  if( SCIPisPositive(scip, eigvals[i]) )
5325  {
5326  if( posidx == -1 )
5327  posidx = i;
5328  else
5329  break;
5330  }
5331  else if( SCIPisNegative(scip, eigvals[i]) )
5332  {
5333  if( negidx == -1 )
5334  negidx = i;
5335  else
5336  break;
5337  }
5338  }
5339  if( i < n || posidx == -1 || negidx == -1 )
5340  {
5341  SCIPdebugMsg(scip, "Augmented quadratic form of constraint <%s> is not factorable.\n", SCIPconsGetName(cons));
5342  goto CLEANUP;
5343  }
5344  assert(SCIPisPositive(scip, eigvals[posidx]));
5345  assert(SCIPisNegative(scip, eigvals[negidx]));
5346 
5347  /* compute factorleft and factorright */
5348  SCIP_CALL( SCIPallocBlockMemoryArray(scip, &consdata->factorleft, consdata->nquadvars + 1) );
5349  SCIP_CALL( SCIPallocBlockMemoryArray(scip, &consdata->factorright, consdata->nquadvars + 1) );
5350 
5351  /* eigenvectors are stored in a, inverse eigenvector matrix is transposed of a
5352  * it seems that v1 and v2 are at &a[posidx*n] and &a[negidx*n]
5353  */
5354  sigma1 = sqrt( eigvals[posidx]);
5355  sigma2 = sqrt(-eigvals[negidx]);
5356  for( i = 0; i < n; ++i )
5357  {
5358  consdata->factorleft[i] = sigma1 * a[posidx * n + i] - sigma2 * a[negidx * n + i];
5359  consdata->factorright[i] = sigma1 * a[posidx * n + i] + sigma2 * a[negidx * n + i];
5360  /* set almost-zero elements to zero */
5361  if( SCIPisZero(scip, consdata->factorleft[i]) )
5362  consdata->factorleft[i] = 0.0;
5363  if( SCIPisZero(scip, consdata->factorright[i]) )
5364  consdata->factorright[i] = 0.0;
5365  }
5366 
5367 #ifdef SCIP_DEBUG
5368  SCIPdebugMsg(scip, "constraint <%s> has factorable quadratic form: (%g", SCIPconsGetName(cons), consdata->factorleft[n-1]);
5369  for( i = 0; i < consdata->nquadvars; ++i )
5370  {
5371  if( consdata->factorleft[i] != 0.0 )
5372  SCIPdebugMsgPrint(scip, " %+g<%s>", consdata->factorleft[i], SCIPvarGetName(consdata->quadvarterms[i].var));
5373  }
5374  SCIPdebugMsgPrint(scip, ") * (%g", consdata->factorright[n-1]);
5375  for( i = 0; i < consdata->nquadvars; ++i )
5376  {
5377  if( consdata->factorright[i] != 0.0 )
5378  SCIPdebugMsgPrint(scip, " %+g<%s>", consdata->factorright[i], SCIPvarGetName(consdata->quadvarterms[i].var));
5379  }
5380  SCIPdebugMsgPrint(scip, ")\n");
5381 #endif
5382 
5383  /* check whether factorleft * factorright^T is matrix of augmented quadratic form
5384  * we check here only the nonzero entries from the quadratic form
5385  */
5386  success = TRUE;
5387 
5388  /* check bilinear terms */
5389  for( i = 0; i < consdata->nbilinterms; ++i )
5390  {
5391  bilinterm = &consdata->bilinterms[i];
5392 
5393  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, bilinterm->var1, &idx1) );
5394  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, bilinterm->var2, &idx2) );
5395 
5396  if( !SCIPisRelEQ(scip, consdata->factorleft[idx1] * consdata->factorright[idx2] + consdata->factorleft[idx2] * consdata->factorright[idx1], bilinterm->coef) )
5397  {
5398  success = FALSE;
5399  break;
5400  }
5401  }
5402 
5403  /* set lower triangular entries of A corresponding to square and linear terms */
5404  for( i = 0; i < consdata->nquadvars; ++i )
5405  {
5406  if( !SCIPisRelEQ(scip, consdata->factorleft[i] * consdata->factorright[i], consdata->quadvarterms[i].sqrcoef) )
5407  {
5408  success = FALSE;
5409  break;
5410  }
5411 
5412  if( !SCIPisRelEQ(scip, consdata->factorleft[n-1] * consdata->factorright[i] + consdata->factorleft[i] * consdata->factorright[n-1], consdata->quadvarterms[i].lincoef) )
5413  {
5414  success = FALSE;
5415  break;
5416  }
5417  }
5418 
5419  if( !success )
5420  {
5421  SCIPdebugMsg(scip, "Factorization not accurate enough. Dropping it.\n");
5422  SCIPfreeBlockMemoryArray(scip, &consdata->factorleft, consdata->nquadvars + 1);
5423  SCIPfreeBlockMemoryArray(scip, &consdata->factorright, consdata->nquadvars + 1);
5424  }
5425 
5426  CLEANUP:
5427  SCIPfreeBufferArray(scip, &eigvals);
5428  SCIPfreeBufferArray(scip, &a);
5429 
5430  return SCIP_OKAY;
5431 }
5432 
5433 /** computes activity and violation of a constraint
5434  *
5435  * If solution violates bounds by more than feastol, the violation is still computed, but *solviolbounds is set to TRUE
5436  */
5437 static
5439  SCIP* scip, /**< SCIP data structure */
5440  SCIP_CONS* cons, /**< constraint */
5441  SCIP_SOL* sol, /**< solution or NULL if LP solution should be used */
5442  SCIP_Bool* solviolbounds /**< buffer to store whether quadratic variables in solution are outside their bounds by more than feastol */
5443  )
5444 { /*lint --e{666}*/
5445  SCIP_CONSDATA* consdata;
5446  SCIP_Real varval;
5447  SCIP_Real varval2;
5448  SCIP_Real absviol;
5449  SCIP_Real relviol;
5450  SCIP_VAR* var;
5451  SCIP_VAR* var2;
5452  int i;
5453  int j;
5454 
5455  assert(scip != NULL);
5456  assert(cons != NULL);
5457  assert(solviolbounds != NULL);
5458 
5459  consdata = SCIPconsGetData(cons);
5460  assert(consdata != NULL);
5461 
5462  *solviolbounds = FALSE;
5463  consdata->activity = 0.0;
5464  consdata->lhsviol = 0.0;
5465  consdata->rhsviol = 0.0;
5466 
5467  for( i = 0; i < consdata->nlinvars; ++i )
5468  {
5469  SCIP_Real activity;
5470 
5471  var = consdata->linvars[i];
5472  varval = SCIPgetSolVal(scip, sol, var);
5473  activity = consdata->lincoefs[i] * varval;
5474 
5475  /* the contribution of a variable with |varval| = +inf is +inf when activity > 0.0, -inf when activity < 0.0, and
5476  * 0.0 otherwise
5477  */
5478  if( SCIPisInfinity(scip, REALABS(varval)) )
5479  {
5480  if( activity > 0.0 && !SCIPisInfinity(scip, consdata->rhs) )
5481  {
5482  consdata->activity = SCIPinfinity(scip);
5483  consdata->rhsviol = SCIPinfinity(scip);
5484  return SCIP_OKAY;
5485  }
5486 
5487  if( activity < 0.0 && !SCIPisInfinity(scip, -consdata->lhs) )
5488  {
5489  consdata->activity = -SCIPinfinity(scip);
5490  consdata->lhsviol = SCIPinfinity(scip);
5491  return SCIP_OKAY;
5492  }
5493  }
5494 
5495  consdata->activity += activity;
5496  }
5497 
5498  for( j = 0; j < consdata->nquadvars; ++j )
5499  {
5500  SCIP_Real activity;
5501 
5502  var = consdata->quadvarterms[j].var;
5503  varval = SCIPgetSolVal(scip, sol, var);
5504  activity = (consdata->quadvarterms[j].lincoef + consdata->quadvarterms[j].sqrcoef * varval) * varval;
5505 
5506  /* the contribution of a variable with |varval| = +inf is +inf when activity > 0.0, -inf when activity < 0.0, and
5507  * 0.0 otherwise
5508  */
5509  if( SCIPisInfinity(scip, REALABS(varval)) )
5510  {
5511  if( activity > 0.0 && !SCIPisInfinity(scip, consdata->rhs) )
5512  {
5513  consdata->activity = SCIPinfinity(scip);
5514  consdata->rhsviol = SCIPinfinity(scip);
5515  return SCIP_OKAY;
5516  }
5517 
5518  if( activity < 0.0 && !SCIPisInfinity(scip, -consdata->lhs) )
5519  {
5520  consdata->activity = -SCIPinfinity(scip);
5521  consdata->lhsviol = SCIPinfinity(scip);
5522  return SCIP_OKAY;
5523  }
5524  }
5525 
5526  /* project onto local box, in case the LP solution is slightly outside the bounds (which is not our job to enforce) */
5527  if( sol == NULL )
5528  {
5529  /* with non-initial columns, variables can shortly be a column variable before entering the LP and have value 0.0 in this case, which might violated the variable bounds */
5530  if( (!SCIPisInfinity(scip, -SCIPvarGetLbLocal(var)) && !SCIPisFeasGE(scip, varval, SCIPvarGetLbLocal(var))) ||
5531  (!SCIPisInfinity(scip, SCIPvarGetUbLocal(var)) && !SCIPisFeasLE(scip, varval, SCIPvarGetUbLocal(var))) )
5532  *solviolbounds = TRUE;
5533  else
5534  {
5535  varval = MAX(SCIPvarGetLbLocal(var), MIN(SCIPvarGetUbLocal(var), varval));
5536  activity = (consdata->quadvarterms[j].lincoef + consdata->quadvarterms[j].sqrcoef * varval) * varval;
5537  }
5538  }
5539 
5540  consdata->activity += activity;
5541  }
5542 
5543  for( j = 0; j < consdata->nbilinterms; ++j )
5544  {
5545  SCIP_Real activity;
5546 
5547  var = consdata->bilinterms[j].var1;
5548  var2 = consdata->bilinterms[j].var2;
5549  varval = SCIPgetSolVal(scip, sol, var);
5550  varval2 = SCIPgetSolVal(scip, sol, var2);
5551 
5552  /* project onto local box, in case the LP solution is slightly outside the bounds (which is not our job to enforce) */
5553  if( sol == NULL )
5554  {
5555  /* with non-initial columns, variables can shortly be a column variable before entering the LP and have value 0.0 in this case, which might violated the variable bounds */
5556  if( (!SCIPisInfinity(scip, -SCIPvarGetLbLocal(var)) && !SCIPisFeasGE(scip, varval, SCIPvarGetLbLocal(var))) ||
5557  (!SCIPisInfinity(scip, SCIPvarGetUbLocal(var)) && !SCIPisFeasLE(scip, varval, SCIPvarGetUbLocal(var))) )
5558  *solviolbounds = TRUE;
5559  else
5560  varval = MAX(SCIPvarGetLbLocal(var), MIN(SCIPvarGetUbLocal(var), varval));
5561 
5562  /* with non-initial columns, variables can shortly be a column variable before entering the LP and have value 0.0 in this case, which might violated the variable bounds */
5563  if( (!SCIPisInfinity(scip, -SCIPvarGetLbLocal(var2)) && !SCIPisFeasGE(scip, varval2, SCIPvarGetLbLocal(var2))) ||
5564  (!SCIPisInfinity(scip, SCIPvarGetUbLocal(var2)) && !SCIPisFeasLE(scip, varval2, SCIPvarGetUbLocal(var2))) )
5565  *solviolbounds = TRUE;
5566  else
5567  varval2 = MAX(SCIPvarGetLbLocal(var2), MIN(SCIPvarGetUbLocal(var2), varval2));
5568  }
5569 
5570  activity = consdata->bilinterms[j].coef * varval * varval2;
5571 
5572  /* consider var*var2 as a new variable and handle it as it would appear linearly */
5573  if( SCIPisInfinity(scip, REALABS(varval*varval2)) )
5574  {
5575  if( activity > 0.0 && !SCIPisInfinity(scip, consdata->rhs) )
5576  {
5577  consdata->activity = SCIPinfinity(scip);
5578  consdata->rhsviol = SCIPinfinity(scip);
5579  return SCIP_OKAY;
5580  }
5581 
5582  if( activity < 0.0 && !SCIPisInfinity(scip, -consdata->lhs) )
5583  {
5584  consdata->activity = -SCIPinfinity(scip);
5585  consdata->lhsviol = SCIPinfinity(scip);
5586  return SCIP_OKAY;
5587  }
5588  }
5589 
5590  consdata->activity += activity;
5591  }
5592 
5593  absviol = 0.0;
5594  relviol = 0.0;
5595  /* compute absolute violation left hand side */
5596  if( consdata->activity < consdata->lhs && !SCIPisInfinity(scip, -consdata->lhs) )
5597  {
5598  consdata->lhsviol = consdata->lhs - consdata->activity;
5599  absviol = consdata->lhsviol;
5600  relviol = SCIPrelDiff(consdata->lhs, consdata->activity);
5601  }
5602  else
5603  consdata->lhsviol = 0.0;
5604 
5605  /* compute absolute violation right hand side */
5606  if( consdata->activity > consdata->rhs && !SCIPisInfinity(scip, consdata->rhs) )
5607  {
5608  consdata->rhsviol = consdata->activity - consdata->rhs;
5609  absviol = consdata->rhsviol;
5610  relviol = SCIPrelDiff(consdata->activity, consdata->rhs);
5611  }
5612  else
5613  consdata->rhsviol = 0.0;
5614 
5615  /* update absolute and relative violation of the solution */
5616  if( sol != NULL )
5617  SCIPupdateSolConsViolation(scip, sol, absviol, relviol);
5618 
5619  return SCIP_OKAY;
5620 }
5621 
5622 /** computes violation of a set of constraints */
5623 static
5625  SCIP* scip, /**< SCIP data structure */
5626  SCIP_CONS** conss, /**< constraints */
5627  int nconss, /**< number of constraints */
5628  SCIP_SOL* sol, /**< solution or NULL if LP solution should be used */
5629  SCIP_Bool* solviolbounds, /**< buffer to store whether quadratic variables in solution are outside their bounds by more than feastol in some constraint */
5630  SCIP_CONS** maxviolcon /**< buffer to store constraint with largest violation, or NULL if solution is feasible */
5631  )
5632 {
5633  SCIP_CONSDATA* consdata;
5634  SCIP_Real viol;
5635  SCIP_Real maxviol;
5636  SCIP_Bool solviolbounds1;
5637  int c;
5638 
5639  assert(scip != NULL);
5640  assert(conss != NULL || nconss == 0);
5641  assert(solviolbounds != NULL);
5642  assert(maxviolcon != NULL);
5643 
5644  *solviolbounds = FALSE;
5645  *maxviolcon = NULL;
5646 
5647  maxviol = 0.0;
5648 
5649  for( c = 0; c < nconss; ++c )
5650  {
5651  assert(conss != NULL);
5652  assert(conss[c] != NULL);
5653 
5654  SCIP_CALL( computeViolation(scip, conss[c], sol, &solviolbounds1) );
5655  *solviolbounds |= solviolbounds1;
5656 
5657  consdata = SCIPconsGetData(conss[c]);
5658  assert(consdata != NULL);
5659 
5660  viol = MAX(consdata->lhsviol, consdata->rhsviol);
5661  if( viol > maxviol && SCIPisGT(scip, viol, SCIPfeastol(scip)) )
5662  {
5663  maxviol = viol;
5664  *maxviolcon = conss[c];
5665  }
5666  }
5667 
5668  return SCIP_OKAY;
5669 }
5670 
5671 
5672 /** index comparison method for bilinear terms */
5673 static
5674 SCIP_DECL_SORTINDCOMP(bilinTermComp2)
5675 { /*lint --e{715}*/
5676  SCIP_BILINTERM* bilinterms = (SCIP_BILINTERM*)dataptr;
5677  int var1cmp;
5678 
5679  assert(bilinterms != NULL);
5680 
5681  var1cmp = SCIPvarCompare(bilinterms[ind1].var1, bilinterms[ind2].var1);
5682  if( var1cmp != 0 )
5683  return var1cmp;
5684 
5685  return SCIPvarCompare(bilinterms[ind1].var2, bilinterms[ind2].var2);
5686 }
5687 
5688 /** volume comparison method for bilinear terms; prioritizes bilinear products with a larger volume */
5689 static
5690 SCIP_DECL_SORTINDCOMP(bilinTermCompVolume)
5691 { /*lint --e{715}*/
5692  SCIP_BILINTERM* bilinterms = (SCIP_BILINTERM*)dataptr;
5693  SCIP_Real vol1;
5694  SCIP_Real vol2;
5695 
5696  assert(bilinterms != NULL);
5697 
5698  vol1 = (SCIPvarGetUbLocal(bilinterms[ind1].var1) - SCIPvarGetLbLocal(bilinterms[ind1].var1))
5699  * (SCIPvarGetUbLocal(bilinterms[ind1].var2) - SCIPvarGetLbLocal(bilinterms[ind1].var2));
5700  vol2 = (SCIPvarGetUbLocal(bilinterms[ind2].var1) - SCIPvarGetLbLocal(bilinterms[ind2].var1))
5701  * (SCIPvarGetUbLocal(bilinterms[ind2].var2) - SCIPvarGetLbLocal(bilinterms[ind2].var2));
5702 
5703  if( vol1 > vol2 )
5704  return -1;
5705  else if( vol1 < vol2 )
5706  return 1;
5707  return bilinTermComp2(dataptr, ind1, ind2);
5708 }
5709 
5710 /** helper function to sort all bilinear terms in the constraint handler data */
5711 static
5713  SCIP* scip, /**< SCIP data structure */
5714  SCIP_BILINTERM* bilinterms, /**< array containing all bilinear terms */
5715  int nbilinterms, /**< total number of bilinear terms */
5716  SCIP_CONS** bilinconss, /**< array for mapping each term to its constraint */
5717  int* bilinposs /**< array for mapping each term to its position in the corresponding
5718  * bilinconss constraint */
5719  )
5720 {
5721  int* perm;
5722  int i;
5723  int nexti;
5724  int v;
5725  SCIP_BILINTERM bilinterm;
5726  SCIP_CONS* bilincons;
5727  int bilinpos;
5728 
5729  assert(scip != NULL);
5730  assert(bilinterms != NULL);
5731  assert(nbilinterms > 0);
5732  assert(bilinconss != NULL);
5733  assert(bilinposs != NULL);
5734 
5735  /* get temporary memory to store the sorted permutation and the inverse permutation */
5736  SCIP_CALL( SCIPallocBufferArray(scip, &perm, nbilinterms) );
5737 
5738  /* call quicksort */
5739  SCIPsort(perm, bilinTermCompVolume, (void*)bilinterms, nbilinterms);
5740 
5741  /* permute the bilinear terms according to the resulting permutation */
5742  for( v = 0; v < nbilinterms; ++v )
5743  {
5744  if( perm[v] != v )
5745  {
5746  bilinterm = bilinterms[v];
5747  bilincons = bilinconss[v];
5748  bilinpos = bilinposs[v];
5749 
5750  i = v;
5751  do
5752  {
5753  assert(0 <= perm[i] && perm[i] < nbilinterms);
5754  assert(perm[i] != i);
5755 
5756  bilinterms[i] = bilinterms[perm[i]];
5757  bilinconss[i] = bilinconss[perm[i]];
5758  bilinposs[i] = bilinposs[perm[i]];
5759 
5760  nexti = perm[i];
5761  perm[i] = i;
5762  i = nexti;
5763  }
5764  while( perm[i] != v );
5765  bilinterms[i] = bilinterm;
5766  bilinconss[i] = bilincons;
5767  bilinposs[i] = bilinpos;
5768  perm[i] = i;
5769  }
5770  }
5771 
5772  /* free temporary memory */
5773  SCIPfreeBufferArray(scip, &perm);
5774 
5775  return SCIP_OKAY;
5776 }
5777 
5778 /** stores all bilinear terms in the quadratic constraint handler data; in addition, for each bilinear term we store
5779  * the number of nonconvex constraints that require to over- or underestimate this term, which only depends on the
5780  * lhs, rhs, and the bilinear coefficient
5781  */
5782 static
5784  SCIP* scip, /**< SCIP data structure */
5785  SCIP_CONSHDLRDATA* conshdlrdata, /**< constraint handler data */
5786  SCIP_CONS** conss, /**< constraints to process */
5787  int nconss /**< number of constraints */
5788  )
5789 {
5790  SCIP_BILINTERM* bilinterms;
5791  SCIP_CONS** bilincons;
5792  int* bilinpos;
5793  int nbilinterms;
5794  int pos;
5795  int c;
5796  int i;
5797 
5798  assert(scip != NULL);
5799  assert(conshdlrdata != NULL);
5800  assert(conss != NULL);
5801 
5802  /* check for all cases for which we don't want to spend time for collecting all bilinear terms */
5803  if( nconss == 0 || conshdlrdata->storedbilinearterms || SCIPgetSubscipDepth(scip) != 0 || SCIPgetDepth(scip) >= 1
5804  || SCIPinProbing(scip) || SCIPinDive(scip) )
5805  return SCIP_OKAY;
5806 
5807  assert(conshdlrdata->bilinestimators == NULL);
5808  assert(conshdlrdata->nbilinterms == 0);
5809 
5810  conshdlrdata->storedbilinearterms = TRUE;
5811  nbilinterms = 0;
5812 
5813  /* count the number of bilinear terms (including duplicates) */
5814  for( c = 0; c < nconss; ++c )
5815  {
5816  SCIP_CONSDATA* consdata = SCIPconsGetData(conss[c]);
5817  assert(consdata != NULL);
5818  nbilinterms += consdata->nbilinterms;
5819  }
5820 
5821  /* no bilinear terms available -> stop */
5822  if( nbilinterms == 0 )
5823  return SCIP_OKAY;
5824 
5825  /* allocate temporary memory for sorting all bilinear terms (including duplicates) */
5826  SCIP_CALL( SCIPallocBufferArray(scip, &bilinterms, nbilinterms) );
5827  SCIP_CALL( SCIPallocBufferArray(scip, &bilincons, nbilinterms) );
5828  SCIP_CALL( SCIPallocBufferArray(scip, &bilinpos, nbilinterms) );
5829 
5830  /* copy all bilinear terms; note that we need separate entries for x*y and y*x */
5831  pos = 0;
5832  for( c = 0; c < nconss; ++c )
5833  {
5834  SCIP_CONSDATA* consdata = SCIPconsGetData(conss[c]);
5835 
5836  /* allocate memory to store the later computed indices of each bilinear term in the bilinterms array of the
5837  * constraint handler data
5838  */
5839  if( consdata->nbilinterms > 0 )
5840  {
5841  SCIP_CALL( SCIPallocBlockMemoryArray(scip, &consdata->bilintermsidx, consdata->nbilinterms) );
5842  }
5843 
5844  for( i = 0; i < consdata->nbilinterms; ++i )
5845  {
5846  assert(consdata->bilinterms != NULL);
5847  assert(consdata->bilinterms[i].var1 != consdata->bilinterms[i].var2);
5848 
5849  /* add xy */
5850  bilinterms[pos] = consdata->bilinterms[i];
5851  bilincons[pos] = conss[c];
5852  bilinpos[pos] = i;
5853  ++pos;
5854 
5855  /* invalidate bilinear term index */
5856  assert(consdata->bilintermsidx != NULL);
5857  consdata->bilintermsidx[i] = -1;
5858  }
5859  }
5860  assert(pos == nbilinterms);
5861 
5862  /* sorts all bilinear terms (including duplicates) */
5863  SCIP_CALL( sortAllBilinTerms(scip, bilinterms, nbilinterms, bilincons, bilinpos) );
5864 
5865  /* count the number of bilinear terms without duplicates */
5866  conshdlrdata->nbilinterms = nbilinterms;
5867  for( i = 0; i < nbilinterms - 1; ++i )
5868  {
5869  assert(bilinTermCompVolume((void*)bilinterms, i, i+1) != 0 || bilinTermComp2((void*)bilinterms, i, i+1) <= 0);
5870 
5871  if( bilinTermComp2((void*)bilinterms, i, i+1) == 0 )
5872  --(conshdlrdata->nbilinterms);
5873  }
5874  assert(conshdlrdata->nbilinterms <= nbilinterms && conshdlrdata->nbilinterms > 0);
5875 
5876  /* store all information for each bilinear term into the constraint handler data */
5877  SCIP_CALL( SCIPallocClearBlockMemoryArray(scip, &conshdlrdata->bilinestimators, conshdlrdata->nbilinterms) );
5878 
5879  /* filter duplicates and update entries in the corresponding constraint datas */
5880  pos = 0;
5881  for( i = 0; i < nbilinterms; ++i )
5882  {
5883  SCIP_CONSDATA* consdata = SCIPconsGetData(bilincons[i]);
5884  SCIP_VAR* x;
5885  SCIP_Bool haslhs = !SCIPisInfinity(scip, -consdata->lhs);
5886  SCIP_Bool hasrhs = !SCIPisInfinity(scip, consdata->rhs);
5887 
5888  assert(consdata != NULL);
5889  assert(bilinpos[i] >= 0 && bilinpos[i] < consdata->nbilinterms);
5890 
5891  /* check for a new bilinear term */
5892  if( i == 0 || bilinTermComp2((void*)bilinterms, i-1, i) != 0 )
5893  {
5894  conshdlrdata->bilinestimators[pos].x = bilinterms[i].var1;
5895  conshdlrdata->bilinestimators[pos].y = bilinterms[i].var2;
5896  conshdlrdata->bilinestimators[pos].lastimprfac = 0.0;
5897  conshdlrdata->bilinestimators[pos].maxnonconvexity = 0.0;
5898  ++pos;
5899  }
5900 
5901  /* store whether under- or overestimation is needed for each bilinear term; note that we do not consider convex
5902  * constraints because they will not be used in separated generateCutNonConvex(), which is the only function that
5903  * uses a term-wise relaxation
5904  */
5905  if( SCIPisPositive(scip, bilinterms[i].coef) )
5906  {
5907  conshdlrdata->bilinestimators[pos-1].nunderest += (hasrhs && !consdata->isconvex) ? 1 : 0;
5908  conshdlrdata->bilinestimators[pos-1].noverest += (haslhs && !consdata->isconcave) ? 1 : 0;
5909  conshdlrdata->bilinestimators[pos-1].maxnonconvexity = MAX(conshdlrdata->bilinestimators[pos-1].maxnonconvexity, consdata->maxnonconvexity);
5910  }
5911  else
5912  {
5913  assert(SCIPisNegative(scip, bilinterms[i].coef));
5914  conshdlrdata->bilinestimators[pos-1].nunderest += (haslhs && !consdata->isconcave) ? 1 : 0;
5915  conshdlrdata->bilinestimators[pos-1].noverest += (hasrhs && !consdata->isconvex) ? 1 : 0;
5916  conshdlrdata->bilinestimators[pos-1].maxnonconvexity = MAX(conshdlrdata->bilinestimators[pos-1].maxnonconvexity, consdata->maxnonconvexity);
5917  }
5918 
5919  /* update index of bilinear term in the constraint data */
5920  x = consdata->bilinterms[bilinpos[i]].var1;
5921 
5922  assert(pos > 0);
5923  if( x == conshdlrdata->bilinestimators[pos-1].x )
5924  {
5925  assert(consdata->bilinterms[bilinpos[i]].var2 == conshdlrdata->bilinestimators[pos-1].y);
5926  consdata->bilintermsidx[bilinpos[i]] = pos-1;
5927  }
5928  }
5929  assert(pos == conshdlrdata->nbilinterms);
5930 
5931 #ifndef NDEBUG
5932  /* check whether
5933  * - all bilintermsidx entries have been set
5934  * - variables in bilinear terms of each constraint data and the constraint handler data match
5935  */
5936  for( c = 0; c < nconss; ++c )
5937  {
5938  SCIP_CONSDATA* consdata = SCIPconsGetData(conss[c]);
5939  assert(consdata != NULL);
5940 
5941  for( i = 0; i < consdata->nbilinterms; ++i )
5942  {
5943  SCIP_VAR* x = consdata->bilinterms[i].var1;
5944  SCIP_VAR* y = consdata->bilinterms[i].var2;
5945  int idx = consdata->bilintermsidx[i];
5946 
5947  assert(idx >= 0 && idx < conshdlrdata->nbilinterms);
5948  assert(x == conshdlrdata->bilinestimators[idx].x);
5949  assert(y == conshdlrdata->bilinestimators[idx].y);
5950 
5951  /* at least one direction is important if the constraint is not convex */
5952  if( !SCIPisInfinity(scip, consdata->rhs) && !consdata->isconvex )
5953  assert(conshdlrdata->bilinestimators[idx].nunderest + conshdlrdata->bilinestimators[idx].noverest > 0);
5954  if( !SCIPisInfinity(scip, -consdata->lhs) && !consdata->isconcave )
5955  assert(conshdlrdata->bilinestimators[idx].nunderest + conshdlrdata->bilinestimators[idx].noverest > 0);
5956  }
5957  }
5958 #endif
5959 
5960  /* free memory */
5961  SCIPfreeBufferArray(scip, &bilinpos);
5962  SCIPfreeBufferArray(scip, &bilincons);
5963  SCIPfreeBufferArray(scip, &bilinterms);
5964 
5965  return SCIP_OKAY;
5966 }
5967 
5968 /** frees memory allocated in storeAllBilinearTerms() */
5969 static
5971  SCIP* scip, /**< SCIP data structure */
5972  SCIP_CONSHDLRDATA* conshdlrdata, /**< constraint handler data */
5973  SCIP_CONS** conss, /**< constraints to process */
5974  int nconss /**< number of constraints */
5975 
5976  )
5977 {
5978  int c;
5979 
5980  assert(conshdlrdata != NULL);
5981 
5982  for( c = 0; c < nconss; ++c )
5983  {
5984  SCIP_CONSDATA* consdata = SCIPconsGetData(conss[c]); /*lint !e613*/
5985  assert(consdata != NULL);
5986 
5987  SCIPfreeBlockMemoryArrayNull(scip, &consdata->bilintermsidx, consdata->nbilinterms);
5988  }
5989 
5990  SCIPfreeBlockMemoryArrayNull(scip, &conshdlrdata->bilinestimators, conshdlrdata->nbilinterms);
5991 
5992  conshdlrdata->nbilinterms = 0;
5993  conshdlrdata->storedbilinearterms = FALSE;
5994 
5995  return SCIP_OKAY;
5996 }
5997 
5998 /** tries to compute cut for multleft * <coefleft, x'> * multright <= rhs / (multright * <coefright, x'>) where x'=(x,1) */
5999 static
6001  SCIP* scip, /**< SCIP data structure */
6002  SCIP_CONS* cons, /**< constraint */
6003  SCIP_Real* ref, /**< reference solution where to generate the cut */
6004  SCIP_Real multleft, /**< multiplicator on lhs */
6005  SCIP_Real* coefleft, /**< coefficient for factor on lhs */
6006  SCIP_Real multright, /**< multiplicator on both sides */
6007  SCIP_Real* coefright, /**< coefficient for factor that goes to rhs */
6008  SCIP_Real rightminactivity, /**< minimal activity of <coefright, x> */
6009  SCIP_Real rightmaxactivity, /**< maximal activity of <coefright, x> */
6010  SCIP_Real rhs, /**< denominator on rhs */
6011  SCIP_ROWPREP* rowprep, /**< rowprep to store cut coefs and constant */
6012  SCIP_Bool* success /**< buffer to indicate whether a cut was successfully computed */
6013  )
6014 {
6015  SCIP_CONSDATA* consdata;
6016  SCIP_Real constant;
6017  SCIP_Real coef;
6018  int i;
6019 
6020  assert(rowprep != NULL);
6021  assert(rightminactivity * multright > 0.0);
6022  assert(rightmaxactivity * multright > 0.0);
6023  assert(multright == 1.0 || multright == -1.0);
6024 
6025  consdata = SCIPconsGetData(cons);
6026  assert(consdata != NULL);
6027 
6028  rowprep->sidetype = SCIP_SIDETYPE_RIGHT;
6029 
6030  if( rhs > 0.0 )
6031  {
6032  /* if rhs > 0.0, then rhs / (multright * <coefright, x'>) is convex, thus need secant:
6033  * 1 / multright*<coefright, x'> <= 1/minact + 1/maxact - 1/(minact * maxact) multright*<coefright, x'>
6034  * where [minact, maxact] = multright * [rightminactivity, rightmaxactivity]
6035  *
6036  * assuming multright is either -1 or 1, and substituting gives
6037  * multright/rightminactivity + multright/rightmaxactivity - multright/(rightminactivity * rightmaxactivity) *<coefright, x'>
6038  *
6039  * multiplying by rhs, gives the estimate
6040  * rhs / (multright * <coefright, x'>) <= rhs * multright * (1/rightminactivity + 1/rightmaxactivity - 1/(rightminactivity * rightmaxactivity) * <coefright, x'>)
6041  */
6042 
6043  /* cannot do if unbounded */
6044  if( SCIPisInfinity(scip, rightmaxactivity * multright) )
6045  {
6046  *success = FALSE;
6047  return SCIP_OKAY;
6048  }
6049 
6050  assert(SCIPisFeasLE(scip, rightminactivity, rightmaxactivity));
6051 
6052  constant = multleft * multright * coefleft[consdata->nquadvars];
6053  constant -= rhs * multright * (1.0 / rightminactivity + 1.0 / rightmaxactivity);
6054  constant += rhs * multright * coefright[consdata->nquadvars] / (rightminactivity * rightmaxactivity);
6055 
6056  SCIPaddRowprepConstant(rowprep, constant);
6057 
6058  for( i = 0; i < consdata->nquadvars; ++i )
6059  {
6060  coef = multleft * multright * coefleft[i];
6061  coef += rhs * multright / (rightminactivity * rightmaxactivity) * coefright[i];
6062  SCIP_CALL( SCIPaddRowprepTerm(scip, rowprep, consdata->quadvarterms[i].var, coef) );
6063  }
6064 
6065  (void) SCIPsnprintf(rowprep->name, SCIP_MAXSTRLEN, "%s_factorablesecant_%d", SCIPconsGetName(cons), SCIPgetNLPs(scip));
6066 
6067  rowprep->local = TRUE;
6068  }
6069  else
6070  {
6071  SCIP_Real refvalue;
6072 
6073  /* if rhs < 0.0, then rhs / (multright * <coefright, x'>) is convex, thus need linearization:
6074  * rhs / (multright * <coefright, x'>)
6075  * <= rhs / (multright * <coefright, ref'>) - rhs / (multright * <coefright, ref'>)^2 * (multright * <coefright, x'> - multright * <coefright, ref'>)
6076  * = 2*rhs / (multright * <coefright, ref'>) - rhs / (multright * <coefright, ref'>)^2 * (multright * <coefright, x'>)
6077  *
6078  * where ref' = (ref, 1)
6079  */
6080 
6081  /* compute <coefright, ref'> */
6082  refvalue = coefright[consdata->nquadvars];
6083  for( i = 0; i < consdata->nquadvars; ++i )
6084  refvalue += coefright[i] * ref[i];
6085 
6086  /* should not happen, since we checked activity of <coefright,x> before, and assume ref within bounds */
6087  assert(!SCIPisZero(scip, refvalue));
6088 
6089  constant = multleft * multright * coefleft[consdata->nquadvars];
6090  constant -= 2.0 * rhs / (multright * refvalue);
6091  constant += rhs / (refvalue * refvalue) * multright * coefright[consdata->nquadvars];
6092 
6093  SCIPaddRowprepConstant(rowprep, constant);
6094 
6095  for( i = 0; i < consdata->nquadvars; ++i )
6096  {
6097  coef = multleft * multright * coefleft[i];
6098  coef += rhs / (refvalue * refvalue) * multright * coefright[i];
6099  SCIP_CALL( SCIPaddRowprepTerm(scip, rowprep, consdata->quadvarterms[i].var, coef) );
6100  }
6101 
6102  (void) SCIPsnprintf(rowprep->name, SCIP_MAXSTRLEN, "%s_factorablelinearization_%d", SCIPconsGetName(cons), SCIPgetNLPs(scip));
6103  }
6104 
6105  *success = TRUE;
6106 
6107  return SCIP_OKAY;
6108 }
6109 
6110 /** tries to generate a cut if constraint quadratic function is factorable and there are no linear variables
6111  * (ax+b)(cx+d) <= rhs and cx+d >= 0 -> (ax+b) <= rhs / (cx+d), where the right hand side is concave and can be linearized
6112  */
6113 static
6115  SCIP* scip, /**< SCIP data structure */
6116  SCIP_CONS* cons, /**< constraint */
6117  SCIP_SIDETYPE violside, /**< for which side a cut should be generated */
6118  SCIP_Real* ref, /**< reference solution where to generate the cut */
6119  SCIP_ROWPREP* rowprep, /**< data structure to store cut coefficients */
6120  SCIP_Bool* success /**< buffer to indicate whether a cut was successfully computed */
6121  )
6122 {
6123  SCIP_CONSDATA* consdata;
6124  SCIP_Real leftminactivity;
6125  SCIP_Real leftmaxactivity;
6126  SCIP_Real rightminactivity;
6127  SCIP_Real rightmaxactivity;
6128  SCIP_Real leftminactivityglobal;
6129  SCIP_Real leftmaxactivityglobal;
6130  SCIP_Real rightminactivityglobal;
6131  SCIP_Real rightmaxactivityglobal;
6132  SCIP_Real multleft;
6133  SCIP_Real multright;
6134  SCIP_Real rhs;
6135  int i;
6136 
6137  assert(scip != NULL);
6138  assert(cons != NULL);
6139  assert(ref != NULL);
6140  assert(rowprep != NULL);
6141  assert(success != NULL);
6142 
6143  consdata = SCIPconsGetData(cons);
6144  assert(consdata != NULL);
6145  assert(consdata->nlinvars == 0);
6146  assert(consdata->factorleft != NULL);
6147  assert(consdata->factorright != NULL);
6148 
6149  *success = FALSE;
6150 
6151  leftminactivityglobal = leftminactivity = consdata->factorleft[consdata->nquadvars];
6152  leftmaxactivityglobal = leftmaxactivity = consdata->factorleft[consdata->nquadvars];
6153  rightminactivityglobal = rightminactivity = consdata->factorright[consdata->nquadvars];
6154  rightmaxactivityglobal = rightmaxactivity = consdata->factorright[consdata->nquadvars];
6155  for( i = 0; i < consdata->nquadvars; ++i )
6156  {
6157  if( !SCIPisInfinity(scip, -leftminactivity) )
6158  {
6159  if( consdata->factorleft[i] > 0.0 )
6160  {
6161  if( SCIPisInfinity(scip, -SCIPvarGetLbLocal(consdata->quadvarterms[i].var)) )
6162  leftminactivity = -SCIPinfinity(scip);
6163  else
6164  leftminactivity += consdata->factorleft[i] * SCIPvarGetLbLocal(consdata->quadvarterms[i].var);
6165  }
6166  else if( consdata->factorleft[i] < 0.0 )
6167  {
6168  if( SCIPisInfinity(scip, SCIPvarGetUbLocal(consdata->quadvarterms[i].var)) )
6169  leftminactivity = -SCIPinfinity(scip);
6170  else
6171  leftminactivity += consdata->factorleft[i] * SCIPvarGetUbLocal(consdata->quadvarterms[i].var);
6172  }
6173  }
6174  if( !SCIPisInfinity(scip, leftmaxactivity) )
6175  {
6176  if( consdata->factorleft[i] > 0.0 )
6177  {
6178  if( SCIPisInfinity(scip, SCIPvarGetUbLocal(consdata->quadvarterms[i].var)) )
6179  leftmaxactivity = SCIPinfinity(scip);
6180  else
6181  leftmaxactivity += consdata->factorleft[i] * SCIPvarGetUbLocal(consdata->quadvarterms[i].var);
6182  }
6183  else if( consdata->factorleft[i] < 0.0 )
6184  {
6185  if( SCIPisInfinity(scip, -SCIPvarGetLbLocal(consdata->quadvarterms[i].var)) )
6186  leftmaxactivity = SCIPinfinity(scip);
6187  else
6188  leftmaxactivity += consdata->factorleft[i] * SCIPvarGetLbLocal(consdata->quadvarterms[i].var);
6189  }
6190  }
6191 
6192  if( !SCIPisInfinity(scip, -rightminactivity) )
6193  {
6194  if( consdata->factorright[i] > 0.0 )
6195  {
6196  if( SCIPisInfinity(scip, -SCIPvarGetLbLocal(consdata->quadvarterms[i].var)) )
6197  rightminactivity = -SCIPinfinity(scip);
6198  else
6199  rightminactivity += consdata->factorright[i] * SCIPvarGetLbLocal(consdata->quadvarterms[i].var);
6200  }
6201  else if( consdata->factorright[i] < 0.0 )
6202  {
6203  if( SCIPisInfinity(scip, SCIPvarGetUbLocal(consdata->quadvarterms[i].var)) )
6204  rightminactivity = -SCIPinfinity(scip);
6205  else
6206  rightminactivity += consdata->factorright[i] * SCIPvarGetUbLocal(consdata->quadvarterms[i].var);
6207  }
6208  }
6209  if( !SCIPisInfinity(scip, rightmaxactivity) )
6210  {
6211  if( consdata->factorright[i] > 0.0 )
6212  {
6213  if( SCIPisInfinity(scip, SCIPvarGetUbLocal(consdata->quadvarterms[i].var)) )
6214  rightmaxactivity = SCIPinfinity(scip);
6215  else
6216  rightmaxactivity += consdata->factorright[i] * SCIPvarGetUbLocal(consdata->quadvarterms[i].var);
6217  }
6218  else if( consdata->factorright[i] < 0.0 )
6219  {
6220  if( SCIPisInfinity(scip, -SCIPvarGetLbLocal(consdata->quadvarterms[i].var)) )
6221  rightmaxactivity = SCIPinfinity(scip);
6222  else
6223  rightmaxactivity += consdata->factorright[i] * SCIPvarGetLbLocal(consdata->quadvarterms[i].var);
6224  }
6225  }
6226 
6227  if( SCIPgetDepth(scip) > 0 )
6228  {
6229  if( !SCIPisInfinity(scip, -leftminactivityglobal) )
6230  {
6231  if( consdata->factorleft[i] > 0.0 )
6232  {
6233  if( SCIPisInfinity(scip, -SCIPvarGetLbGlobal(consdata->quadvarterms[i].var)) )
6234  leftminactivityglobal = -SCIPinfinity(scip);
6235  else
6236  leftminactivityglobal += consdata->factorleft[i] * SCIPvarGetLbGlobal(consdata->quadvarterms[i].var);
6237  }
6238  else if( consdata->factorleft[i] < 0.0 )
6239  {
6240  if( SCIPisInfinity(scip, SCIPvarGetUbGlobal(consdata->quadvarterms[i].var)) )
6241  leftminactivityglobal = -SCIPinfinity(scip);
6242  else
6243  leftminactivityglobal += consdata->factorleft[i] * SCIPvarGetUbGlobal(consdata->quadvarterms[i].var);
6244  }
6245  }
6246  if( !SCIPisInfinity(scip, leftmaxactivityglobal) )
6247  {
6248  if( consdata->factorleft[i] > 0.0 )
6249  {
6250  if( SCIPisInfinity(scip, SCIPvarGetUbGlobal(consdata->quadvarterms[i].var)) )
6251  leftmaxactivityglobal = SCIPinfinity(scip);
6252  else
6253  leftmaxactivityglobal += consdata->factorleft[i] * SCIPvarGetUbGlobal(consdata->quadvarterms[i].var);
6254  }
6255  else if( consdata->factorleft[i] < 0.0 )
6256  {
6257  if( SCIPisInfinity(scip, -SCIPvarGetLbGlobal(consdata->quadvarterms[i].var)) )
6258  leftmaxactivityglobal = SCIPinfinity(scip);
6259  else
6260  leftmaxactivityglobal += consdata->factorleft[i] * SCIPvarGetLbGlobal(consdata->quadvarterms[i].var);
6261  }
6262  }
6263 
6264  if( !SCIPisInfinity(scip, -rightminactivityglobal) )
6265  {
6266  if( consdata->factorright[i] > 0.0 )
6267  {
6268  if( SCIPisInfinity(scip, -SCIPvarGetLbGlobal(consdata->quadvarterms[i].var)) )
6269  rightminactivityglobal = -SCIPinfinity(scip);
6270  else
6271  rightminactivityglobal += consdata->factorright[i] * SCIPvarGetLbGlobal(consdata->quadvarterms[i].var);
6272  }
6273  else if( consdata->factorright[i] < 0.0 )
6274  {
6275  if( SCIPisInfinity(scip, SCIPvarGetUbGlobal(consdata->quadvarterms[i].var)) )
6276  rightminactivityglobal = -SCIPinfinity(scip);
6277  else
6278  rightminactivityglobal += consdata->factorright[i] * SCIPvarGetUbGlobal(consdata->quadvarterms[i].var);
6279  }
6280  }
6281  if( !SCIPisInfinity(scip, rightmaxactivityglobal) )
6282  {
6283  if( consdata->factorright[i] > 0.0 )
6284  {
6285  if( SCIPisInfinity(scip, SCIPvarGetUbGlobal(consdata->quadvarterms[i].var)) )
6286  rightmaxactivityglobal = SCIPinfinity(scip);
6287  else
6288  rightmaxactivityglobal += consdata->factorright[i] * SCIPvarGetUbGlobal(consdata->quadvarterms[i].var);
6289  }
6290  else if( consdata->factorright[i] < 0.0 )
6291  {
6292  if( SCIPisInfinity(scip, -SCIPvarGetLbGlobal(consdata->quadvarterms[i].var)) )
6293  rightmaxactivityglobal = SCIPinfinity(scip);
6294  else
6295  rightmaxactivityglobal += consdata->factorright[i] * SCIPvarGetLbGlobal(consdata->quadvarterms[i].var);
6296  }
6297  }
6298  }
6299  }
6300 
6301  /* write violated constraints as multleft * factorleft * factorright <= rhs */
6302  if( violside == SCIP_SIDETYPE_RIGHT )
6303  {
6304  rhs = consdata->rhs;
6305  multleft = 1.0;
6306  }
6307  else
6308  {
6309  rhs = -consdata->lhs;
6310  multleft = -1.0;
6311  }
6312 
6313  if( SCIPisZero(scip, rhs) )
6314  {
6315  /* @todo do something for rhs == 0.0? */
6316  return SCIP_OKAY;
6317  }
6318 
6319  if( !SCIPisFeasPositive(scip, leftminactivity) && !SCIPisFeasNegative(scip, leftmaxactivity) )
6320  {
6321  /* left factor has 0 within activity bounds, or is very close, at least */
6322  if( !SCIPisFeasPositive(scip, rightminactivity) && !SCIPisFeasNegative(scip, rightmaxactivity) )
6323  {
6324  /* right factor also has 0 within activity bounds, or is very close, at least
6325  * -> cannot separate
6326  */
6327  return SCIP_OKAY;
6328  }
6329 
6330  /* write violated constraint as multleft * factorleft * multright * (multright * factorright) <= rhs
6331  * such that multright * factorright > 0.0
6332  */
6333  if( rightminactivity < 0.0 )
6334  multright = -1.0;
6335  else
6336  multright = 1.0;
6337 
6338  /* generate cut for multleft * factorleft * multright <= rhs / (factorright * multright) */
6339  SCIP_CALL( generateCutFactorableDo(scip, cons, ref, multleft, consdata->factorleft, multright, consdata->factorright, rightminactivity, rightmaxactivity, rhs, rowprep, success) );
6340 
6341  /* if right factor has 0 within global activity bounds, then the added linearization is not globally valid */
6342  if( rhs < 0.0 && SCIPgetDepth(scip) > 0 && rightminactivityglobal < 0.0 && rightmaxactivityglobal > 0.0 )
6343  rowprep->local = TRUE;
6344  }
6345  else if( !SCIPisFeasPositive(scip, rightminactivity) && !SCIPisFeasNegative(scip, rightmaxactivity) )
6346  {
6347  /* left factor is bounded away from 0
6348  * right factor has 0 within activity bounds, or is very close, at least
6349  * -> so divide by left factor
6350  */
6351 
6352  /* write violated constraint as multleft * factorright * multright * (multright * factorleft) <= rhs
6353  * such that multright * factorleft > 0.0
6354  */
6355  if( leftminactivity < 0.0 )
6356  multright = -1.0;
6357  else
6358  multright = 1.0;
6359 
6360  /* generate cut for multleft * factorright * multright <= rhs / (factorleft * multright) */
6361  SCIP_CALL( generateCutFactorableDo(scip, cons, ref, multleft, consdata->factorright, multright, consdata->factorleft, leftminactivity, leftmaxactivity, rhs, rowprep, success) );
6362 
6363  /* if left factor has 0 within global activity bounds, then the added linearization is not globally valid */
6364  if( rhs < 0.0 && SCIPgetDepth(scip) > 0 && leftminactivityglobal < 0.0 && leftmaxactivityglobal > 0.0 )
6365  rowprep->local = TRUE;
6366  }
6367  else if( SCIPisInfinity(scip, -leftminactivity) || SCIPisInfinity(scip, leftmaxactivity) ||
6368  (!SCIPisInfinity(scip, -rightminactivity) && !SCIPisInfinity(scip, rightmaxactivity) && rightmaxactivity - rightminactivity < leftmaxactivity - leftminactivity) )
6369  {
6370  /* both factors are bounded away from 0, but the right one has a smaller activity range, so divide by that one */
6371 
6372  /* write violated constraint as multleft * factorleft * multright * (multright * factorright) <= rhs
6373  * such that multright * factorright > 0.0
6374  */
6375  if( rightminactivity < 0.0 )
6376  multright = -1.0;
6377  else
6378  multright = 1.0;
6379 
6380  /* generate cut for multleft * factorleft * multright <= rhs / (factorright * multright) */
6381  SCIP_CALL( generateCutFactorableDo(scip, cons, ref, multleft, consdata->factorleft, multright, consdata->factorright, rightminactivity, rightmaxactivity, rhs, rowprep, success) );
6382 
6383  /* if right factor has 0 within global activity bounds, then the added linearization is not globally valid */
6384  if( rhs < 0.0 && SCIPgetDepth(scip) > 0 && rightminactivityglobal < 0.0 && rightmaxactivityglobal > 0.0 )
6385  rowprep->local = TRUE;
6386  }
6387  else
6388  {
6389  /* both factors are bounded away from 0, but the left one has a smaller activity range, so divide by that one */
6390 
6391  /* write violated constraint as multleft * factorright * multright * (multright * factorleft) <= rhs
6392  * such that multright * factorleft > 0.0
6393  */
6394  if( leftminactivity < 0.0 )
6395  multright = -1.0;
6396  else
6397  multright = 1.0;
6398 
6399  /* generate cut for multleft * factorright * multright <= rhs / (factorleft * multright) */
6400  SCIP_CALL( generateCutFactorableDo(scip, cons, ref, multleft, consdata->factorright, multright, consdata->factorleft, leftminactivity, leftmaxactivity, rhs, rowprep, success) );
6401 
6402  /* if left factor has 0 within global activity bounds, then the added linearization is not globally valid */
6403  if( rhs < 0.0 && SCIPgetDepth(scip) > 0 && leftminactivityglobal < 0.0 && leftmaxactivityglobal > 0.0 )
6404  rowprep->local = TRUE;
6405  }
6406 
6407  return SCIP_OKAY;
6408 }
6409 
6410 /* finds intersections of a parametric line (x,y) = (x0,y0) + t [(x1,y1) - (x0,y0)] on curves x*y = wl and x*y = wu;
6411  * returns TRUE if unsuccessful and FALSE otherwise
6412  */
6413 static
6415  SCIP* scip,
6416  SCIP_Real x0,
6417  SCIP_Real y0_,
6418  SCIP_Real x1,
6419  SCIP_Real y1_,
6420  SCIP_Real wl,
6421  SCIP_Real wu,
6422  SCIP_Real* xl,
6423  SCIP_Real* yl,
6424  SCIP_Real* xu,
6425  SCIP_Real* yu
6426  )
6427 {
6428  SCIP_Real a;
6429  SCIP_Real b;
6430  SCIP_Real c;
6431  SCIP_Real tl;
6432  SCIP_Real tu;
6433 
6434  /* The parametric line is of the form
6435  *
6436  * x = x0 + t (x1-x0)
6437  * y = y0 + t (y1-y0)
6438  *
6439  * and for that to satisfy xy = wl and xy = wu we must have
6440  *
6441  * x0 y0 + t [x0 (y1-y0) + y0 (x1-x0)] + t^2 (x1-x0) (y1-y0) = wl
6442  * = wu
6443  *
6444  * or a t^2 + b t + c - wl = 0 for proper values of a,b,c.
6445  * a t^2 + b t + c - wu = 0
6446  *
6447  * Because of the way this procedure will be used, one of the two
6448  * solutions found we must always use the minimum nonnegative one
6449  */
6450 
6451  a = (x1 - x0) * (y1_ - y0_);
6452  c = x0 * y0_;
6453  b = x0 * y1_ + y0_ * x1 - 2.0 * c;
6454 
6455  tl = 0.0;
6456  tu = 0.0;
6457 
6458  if( !SCIPisZero(scip, (SCIP_Real)a) )
6459  {
6460  if( wl != SCIP_INVALID ) /*lint !e777 */
6461  {
6462  SCIP_Real tl1;
6463  SCIP_Real tl2;
6464  SCIP_Real denom;
6465  SCIP_Real q;
6466 
6467  if( b * b - 4.0 * a * (c - wl) < 0.0 )
6468  {
6469  SCIPdebugMsg(scip, "probable numerical difficulties, give up\n");
6470  return TRUE;
6471  }
6472 
6473  denom = sqrt(b * b - 4.0 * a * (c - wl));
6474  q = -0.5 * (b + COPYSIGN(denom, b));
6475  tl1 = q / a;
6476  tl2 = (c - wl) / q;
6477 
6478  /* choose the smallest non-negative root */
6479  tl = (tl1 >= 0.0 && (tl2 < 0.0 || tl1 < tl2)) ? tl1 : tl2;
6480  }
6481 
6482  if( wu != SCIP_INVALID ) /*lint !e777 */
6483  {
6484  SCIP_Real tu1;
6485  SCIP_Real tu2;
6486  SCIP_Real denom;
6487  SCIP_Real q;
6488 
6489  if( b * b - 4.0 * a * (c - wu) < 0.0 )
6490  {
6491  SCIPdebugMsg(scip, "probable numerical difficulties, give up\n");
6492  return TRUE;
6493  }
6494 
6495  denom = sqrt(b * b - 4.0 * a * (c - wu));
6496  q = -0.5 * (b + COPYSIGN(denom, b));
6497  tu1 = q / a;
6498  tu2 = (c - wu) / q;
6499 
6500  /* choose the smallest non-negative root */
6501  tu = (tu1 >= 0.0 && (tu2 < 0.0 || tu1 < tu2)) ? tu1 : tu2;
6502  }
6503  }
6504  else if( !SCIPisZero(scip, (SCIP_Real)b) )
6505  {
6506  if( wl != SCIP_INVALID ) /*lint !e777 */
6507  tl = (wl - c) / b;
6508  if( wu != SCIP_INVALID ) /*lint !e777 */
6509  tu = (wu - c) / b;
6510  }
6511  else
6512  {
6513  /* no or infinitely many solutions */
6514  return TRUE;
6515  }
6516 
6517  if( wl != SCIP_INVALID ) /*lint !e777 */
6518  {
6519  assert(xl != NULL);
6520  assert(yl != NULL);
6521 
6522  *xl = (SCIP_Real)(x0 + tl * (x1 - x0 ));
6523  *yl = (SCIP_Real)(y0_ + tl * (y1_ - y0_));
6524 
6525  if( SCIPisInfinity(scip, -*xl) || SCIPisInfinity(scip, -*yl) || !SCIPisRelEQ(scip, *xl * *yl, wl) )
6526  {
6527  SCIPdebugMsg(scip, "probable numerical difficulties, give up\n");
6528  return TRUE;
6529  }
6530  }
6531 
6532  if( wu != SCIP_INVALID ) /*lint !e777 */
6533  {
6534  assert(xu != NULL);
6535  assert(yu != NULL);
6536 
6537  *xu = (SCIP_Real)(x0 + tu * (x1 - x0));
6538  *yu = (SCIP_Real)(y0_ + tu * (y1_ - y0_));
6539 
6540  if( SCIPisInfinity(scip, *xu) || SCIPisInfinity(scip, *yu) || !SCIPisRelEQ(scip, *xu * *yu, wu) )
6541  {
6542  SCIPdebugMsg(scip, "probable numerical difficulties, give up\n");
6543  return TRUE;
6544  }
6545  }
6546 
6547  return FALSE;
6548 }
6549 
6550 /** generate coefficients for a plane through points (x1, y1_, x1*y1) and (x2, y2, x2*y2)
6551  * such that intersecting it with one of them (the first if whichuse is FALSE, the second otherwise)
6552  * gives a tangent to the curve x*y = k
6553  *
6554  * Returns TRUE on error and FALSE on success.
6555  */
6556 static
6558  SCIP* scip,
6559  SCIP_Real x1,
6560  SCIP_Real y1_,
6561  SCIP_Real x2,
6562  SCIP_Real y2,
6563  SCIP_Bool whichuse,
6564  SCIP_Real* cx,
6565  SCIP_Real* cy,
6566  SCIP_Real* cw
6567  )
6568 {
6569  SCIP_Real xd;
6570  SCIP_Real yd;
6571  SCIP_Real xo;
6572  SCIP_Real yo;
6573 
6574  assert(cx != NULL);
6575  assert(cy != NULL);
6576  assert(cw != NULL);
6577 
6578  /* the x-y slope of this constraint must be tangent to a curve x*y = k at (xD,yD) */
6579  if( !whichuse )
6580  {
6581  xd = x1;
6582  xo = x2;
6583  yd = y1_;
6584  yo = y2;
6585  }
6586  else
6587  {
6588  xd = x2;
6589  xo = x1;
6590  yd = y2;
6591  yo = y1_;
6592  }
6593 
6594  *cx = yd;
6595  *cy = xd;
6596 
6597  /* lift it so that it touches the other curve */
6598 
6599  /* if the two points are on the same curve, then no cut */
6600  if( SCIPisZero(scip, xo * yo - xd * yd) )
6601  return TRUE;
6602 
6603  /* should ALWAYS be negative */
6604  *cw = (2.0 * xd * yd - (*cx * xo + *cy * yo)) / (xo * yo - xd * yd);
6605 
6606  return FALSE;
6607 }
6608 
6609 /** computes coefficients of a lifted-tangent inequality for x*y = w
6610  *
6611  * The code is an adaptation of the methods in exprMul-upperHull.cpp in Couenne/stable/0.4 rev773,
6612  * written by P. Belotti and licensed under Eclipse Public License.
6613  */
6614 static
6616  SCIP* scip, /**< SCIP data structure */
6617  SCIP_Real xl, /**< lower bound on x */
6618  SCIP_Real xu, /**< upper bound on x */
6619  SCIP_Real x0, /**< reference point for x */
6620  SCIP_Real yl, /**< lower bound on y */
6621  SCIP_Real yu, /**< upper bound on y */
6622  SCIP_Real y0_, /**< reference point for y */
6623  SCIP_Real wl, /**< lower bound on w */
6624  SCIP_Real wu, /**< upper bound on w */
6625  SCIP_Real w0, /**< reference point for w */
6626  SCIP_Real* cx, /**< buffer where to store cut coefficient for x */
6627  SCIP_Real* cy, /**< buffer where to store cut coefficient for y */
6628  SCIP_Real* cw, /**< buffer where to store cut coefficient for w */
6629  SCIP_Real* c0, /**< buffer where to store cut left-hand-side */
6630  SCIP_Bool* success /**< buffer where to indicate whether cut coefficients were computed */
6631  )
6632 {
6633  SCIP_Bool flipx;
6634  SCIP_Bool flipy;
6635  SCIP_Bool flipw;
6636  SCIP_Real tmp;
6637  SCIP_Real xlow = 0.0;
6638  SCIP_Real ylow = 0.0;
6639  SCIP_Real xupp = 0.0;
6640  SCIP_Real yupp = 0.0;
6641  SCIP_Real c0x;
6642  SCIP_Real c0y;
6643  SCIP_Real c0w;
6644 
6645  assert(scip != NULL);
6646  assert(cx != NULL);
6647  assert(cy != NULL);
6648  assert(cw != NULL);
6649  assert(c0 != NULL);
6650  assert(success != NULL);
6651 
6652  *success = FALSE;
6653  *cx = 0.0;
6654  *cy = 0.0;
6655  *cw = 0.0;
6656  *c0 = 0.0;
6657 
6658  SCIPdebugMsg(scip, "entering points:\n");
6659  SCIPdebugMsg(scip, "x: %9g\t[%9g\t%9g]\n", x0, xl, xu);
6660  SCIPdebugMsg(scip, "y: %9g\t[%9g\t%9g]\n", y0_, yl, yu);
6661  SCIPdebugMsg(scip, "w: %9g\t[%9g\t%9g]\n", w0, wl, wu);
6662 
6663  /* generateCutLTI should have recognized these */
6664  assert(wl >= 0.0 || wu <= 0.0);
6665  assert(!SCIPisInfinity(scip, -wl));
6666  assert(!SCIPisInfinity(scip, wu));
6667 
6668  assert(SCIPisFeasGE(scip, x0, xl));
6669  assert(SCIPisFeasLE(scip, x0, xu));
6670  assert(SCIPisFeasGE(scip, y0_, yl));
6671  assert(SCIPisFeasLE(scip, y0_, yu));
6672 
6673  /* preliminary bound tightening */
6674  if( wl >= 0.0 )
6675  {
6676  if( xl >= 0.0 || yl >= 0.0 || SCIPisLT(scip, xl * yl, wl) )
6677  {
6678  xl = MAX(xl, 0.0);
6679  yl = MAX(yl, 0.0);
6680  }
6681  else if( xu <= 0.0 || yu <= 0.0 || SCIPisLT(scip, xu * yu, wl) )
6682  {
6683  xu = MIN(xu, 0.0);
6684  yu = MIN(yu, 0.0);
6685  }
6686  else
6687  {
6688  /* both variables have mixed sign (xl < 0 && xu > 0 && yl < 0 && yu > 0) and both xl*yl and xu*yu are feasible
6689  * cannot generate cut for this
6690  */
6691  return;
6692  }
6693  }
6694  else
6695  {
6696  if( xl >= 0.0 || yu <= 0.0 || SCIPisGT(scip, xl * yu, wu) )
6697  {
6698  xl = MAX(xl, 0.0);
6699  yu = MIN(yu, 0.0);
6700  }
6701  else if( xu <= 0.0 || yl >= 0.0 || SCIPisGT(scip, xu * yl, wu))
6702  {
6703  xu = MIN(xu, 0.0);
6704  yl = MAX(yl, 0.0);
6705  }
6706  else
6707  {
6708  /* both variables have mixed sign (xl < 0 && xu > 0 && yl < 0 && yu > 0) and both xl*yu and xu*yl are feasible
6709  * cannot generate cut for this
6710  */
6711  return;
6712  }
6713  }
6714 
6715  /* if x or y is fixed now or even infeasible, then do not think about a cut */
6716  if( SCIPisGE(scip, xl, xu) || SCIPisGE(scip, yl, yu) )
6717  return;
6718 
6719  /* reduce to positive orthant by flipping variables */
6720  if( xl < 0.0 )
6721  {
6722  flipx = TRUE;
6723  tmp = xu;
6724  xu = -xl;
6725  xl = -tmp;
6726  x0 = -x0;
6727  }
6728  else
6729  flipx = FALSE;
6730 
6731  if( yl < 0.0 )
6732  {
6733  flipy = TRUE;
6734  tmp = yu;
6735  yu = -yl;
6736  yl = -tmp;
6737  y0_ = -y0_;
6738  }
6739  else
6740  flipy = FALSE;
6741 
6742  if( flipx ^ flipy )
6743  {
6744  flipw = TRUE;
6745  tmp = wu;
6746  wu = -wl;
6747  wl = -tmp;
6748  w0 = -w0;
6749  }
6750  else
6751  flipw = FALSE;
6752 
6753  /* project refpoint into box not only for numerical reasons, but also due to preliminary bound tightening above */
6754  x0 = MIN(xu, MAX(x0, xl));
6755  y0_ = MIN(yu, MAX(y0_, yl));
6756  w0 = MIN(wu, MAX(w0, wl));
6757 
6758  SCIPdebugMsg(scip, "reduced points:\n");
6759  SCIPdebugMsg(scip, "x: %9g\t[%9g\t%9g]\n", x0, xl, xu);
6760  SCIPdebugMsg(scip, "y: %9g\t[%9g\t%9g]\n", y0_, yl, yu);
6761  SCIPdebugMsg(scip, "w: %9g\t[%9g\t%9g]\n", w0, wl, wu);
6762 
6763  if( SCIPisGE(scip, xl * yl, wl) && SCIPisLE(scip, xu * yu, wu) )
6764  {
6765  SCIPdebugMsg(scip, "box for x and y inside feasible region -> nothing to separate\n");
6766  return;
6767  }
6768  if( SCIPisGE(scip, x0 * y0_, w0) )
6769  {
6770  SCIPdebugMsg(scip, "point to separate not below curve -> cannot separate\n");
6771  return;
6772  }
6773 
6774  /* find intersections of halfline from origin
6775  * return if no proper point could be found
6776  */
6777  if( generateCutLTIfindIntersection(scip, 0.0, 0.0, x0, y0_, wl, wu, &xlow, &ylow, &xupp, &yupp) )
6778  return;
6779 
6780  SCIPdebugMsg(scip, "intersections:\n");
6781  SCIPdebugMsg(scip, "lower: %9g\t%9g\tprod %9g\n", xlow, ylow, xlow*ylow);
6782  SCIPdebugMsg(scip, "upper: %9g\t%9g\tprod %9g\n", xupp, yupp, xupp*yupp);
6783 
6784  /* Case 1: If both are outside of bounding box, either NW or SE, then McCormick is sufficient, so return */
6785  if( (xlow <= xl && yupp >= yu) || (ylow <= yl && xupp >= xu) )
6786  return;
6787 
6788  /* There will be at least one cut. Define coefficients and rhs ---will have to change them back if (flipX || flipY) */
6789  if( xlow >= xl && xupp <= xu && ylow >= yl && yupp <= yu )
6790  {
6791  /* Case 2: both are inside. Easy lifting... */
6792  if( generateCutLTIgenMulCoeff(scip, xlow, ylow, xupp, yupp, FALSE, cx, cy, cw) )
6793  return;
6794 
6795  c0x = *cx * xlow;
6796  c0y = *cy * ylow;
6797  c0w = *cw * wl;
6798  }
6799  else if( xlow >= xl && ylow >= yl && (xupp > xu || yupp > yu) )
6800  {
6801  /* Case 3a and 3b: through lower curve, but not upper. */
6802  if( yupp > yu )
6803  {
6804  /* upper intersect is North; place it within box */
6805  assert(!SCIPisInfinity(scip, yu));
6806  yupp = yu;
6807  xupp = wu / yu;
6808  }
6809  else
6810  {
6811  /* upper intersect is East; place it within box */
6812  assert(!SCIPisInfinity(scip, xu));
6813  xupp = xu;
6814  yupp = wu / xu;
6815  }
6816 
6817  /* find intersection on low curve on half line through new point and (x0,y0_) */
6818  if( generateCutLTIfindIntersection(scip, xupp, yupp, x0, y0_, wl, SCIP_INVALID, &xlow, &ylow, NULL, NULL) )
6819  return;
6820 
6821  /* check whether McCormick is sufficient */
6822  if( xlow < xl || ylow < yl )
6823  return;
6824 
6825  /* lift inequality on lower point */
6826  if( generateCutLTIgenMulCoeff(scip, xlow, ylow, xupp, yupp, FALSE, cx, cy, cw) )
6827  return;
6828 
6829  c0x = *cx * xlow;
6830  c0y = *cy * ylow;
6831  c0w = *cw * wl;
6832  }
6833  else if( xupp <= xu && yupp <= yu && (xlow < xl || ylow < yl) )
6834  {
6835  /* Case 4a and 4b: viceversa (lift for validity) */
6836  if( ylow < yl )
6837  {
6838  /* upper intersect is South; place it within box */
6839  assert(!SCIPisZero(scip, yl));
6840  ylow = yl;
6841  xlow = wl / yl;
6842  }
6843  else
6844  {
6845  /* upper intersect is West; place it within box */
6846  assert(!SCIPisZero(scip, xl));
6847  xlow = xl;
6848  ylow = wl / xl;
6849  }
6850 
6851  /* find intersection on low curve on half line through new point and (x0,y0) */
6852  if( generateCutLTIfindIntersection(scip, xlow, ylow, x0, y0_, SCIP_INVALID, wu, NULL, NULL, &xupp, &yupp) )
6853  return;
6854 
6855  /* check whether McCormick is sufficient */
6856  if( xupp > xu || yupp > yu )
6857  return;
6858 
6859  /* lift inequality on UPPER point */
6860  if( generateCutLTIgenMulCoeff(scip, xlow, ylow, xupp, yupp, TRUE, cx, cy, cw) )
6861  return;
6862 
6863  c0x = *cx * xupp;
6864  c0y = *cy * yupp;
6865  c0w = *cw * wu;
6866  }
6867  else if( (xlow < xl && xupp > xu) || (ylow < yl && yupp > yu) )
6868  {
6869  /* Case 5: both outside of bounding box, N and S or W and E. */
6870 #if 0
6871  SCIP_Real xlow2;
6872  SCIP_Real ylow2;
6873  SCIP_Real xupp2;
6874  SCIP_Real yupp2;
6875 #endif
6876 
6877  if( ylow < yl )
6878  {
6879  /* upper intersect is South; place it within box */
6880  assert(!SCIPisZero(scip, yl));
6881  assert(!SCIPisZero(scip, yu));
6882  ylow = yl;
6883  yupp = yu;
6884  xlow = wl / yl;
6885  xupp = wu / yu;
6886  }
6887  else
6888  {
6889  /* upper intersect is West; place it within box */
6890  assert(!SCIPisZero(scip, xl));
6891  assert(!SCIPisZero(scip, xu));
6892  xlow = xl;
6893  xupp = xu;
6894  ylow = wl / xl;
6895  yupp = wu / xu;
6896  }
6897 
6898  SCIPdebugMsg(scip, "New intersections:\n");
6899  SCIPdebugMsg(scip, "lower: %9g\t%9g\tprod %9g\n", xlow, ylow, xlow*ylow);
6900  SCIPdebugMsg(scip, "upper: %9g\t%9g\tprod %9g\n", xupp, yupp, xupp*yupp);
6901 
6902 #if 1
6903  /* Nothing to find. Just separate two inequalities at the same point, just using different support */
6904  if( generateCutLTIgenMulCoeff(scip, xlow, ylow, xupp, yupp, FALSE, cx, cy, cw) )
6905  {
6906  if( generateCutLTIgenMulCoeff(scip, xlow, ylow, xupp, yupp, TRUE, cx, cy, cw) )
6907  return;
6908 
6909  c0x = *cx * xupp;
6910  c0y = *cy * yupp;
6911  c0w = *cw * wu;
6912  }
6913  else
6914  {
6915  c0x = *cx * xlow;
6916  c0y = *cy * ylow;
6917  c0w = *cw * wl;
6918  }
6919 
6920 #else
6921  /* find the intersection on the lower (upper) curve on the line through xLP and the upper (lower) point
6922  * this does not seem to work (cuts off solution at nous2), so it is disabled for now
6923  */
6924  if( generateCutLTIfindIntersection(scip, xlow, ylow, x0, y0_, SCIP_INVALID, wu, NULL, NULL, &xupp2, &yupp2) ||
6925  generateCutLTIgenMulCoeff(scip, xlow, ylow, xupp2, yupp2, FALSE, cx, cx, cw) )
6926  {
6927  if( generateCutLTIfindIntersection(scip, xupp, yupp, x0, y0_, wl, SCIP_INVALID, &xlow2, &ylow2, NULL, NULL) ||
6928  generateCutLTIgenMulCoeff(scip, xlow2, ylow2, xupp, yupp, TRUE, cx, cy, cw) )
6929  return;
6930 
6931  c0x = *cx * xupp;
6932  c0y = *cy * yupp;
6933  c0w = *cw * wu;
6934  }
6935  else
6936  {
6937  c0x = *cx * xlow;
6938  c0y = *cy * ylow;
6939  c0w = *cw * wl;
6940  }
6941 #endif
6942  }
6943  else
6944  {
6945  SCIPdebugMsg(scip, "points are in a weird position:\n");
6946  SCIPdebugMsg(scip, "lower: %9g\t%9g\tprod %9g\n", xlow, ylow, xlow*ylow);
6947  SCIPdebugMsg(scip, "upper: %9g\t%9g\tprod %9g\n", xupp, yupp, xupp*yupp);
6948 
6949  return;
6950  }
6951 
6952  SCIPdebugMsg(scip, "cut w.r.t. reduced points: %gx-%g %+gy-%g %+gw-%g >= 0\n",
6953  *cx, c0x, *cy, c0y, *cw, c0w);
6954 
6955  /* re-transform back into original variables */
6956  if( flipx )
6957  *cx = -*cx;
6958  if( flipy )
6959  *cy = -*cy;
6960  if( flipw )
6961  *cw = -*cw;
6962 
6963  *c0 = c0x + c0y + c0w;
6964 
6965  *success = TRUE;
6966 }
6967 
6968 /** tries to generate a cut if constraint quadratic function is factorable and there are linear variables
6969  *
6970  * Computes what is called a lifted tangent inequality described in@n
6971  * Belotti, Miller, Namazifar, Lifted inequalities for bounded products of variables, SIAG/OPT Views-and-News 22:1, 2011
6972  */
6973 static
6975  SCIP* scip, /**< SCIP data structure */
6976  SCIP_CONS* cons, /**< constraint */
6977  SCIP_SIDETYPE violside, /**< for which side a cut should be generated */
6978  SCIP_Real* ref, /**< reference solution where to generate the cut */
6979  SCIP_SOL* sol, /**< solution that shall be cutoff, NULL for LP solution */
6980  SCIP_ROWPREP* rowprep, /**< rowprep to store cut data */
6981  SCIP_Bool* success /**< buffer to indicate whether a cut was successfully computed */
6982  )
6983 {
6984  SCIP_CONSDATA* consdata;
6985  SCIP_Real leftminactivity;
6986  SCIP_Real leftmaxactivity;
6987  SCIP_Real leftrefactivity;
6988  SCIP_Real rightminactivity;
6989  SCIP_Real rightmaxactivity;
6990  SCIP_Real rightrefactivity;
6991  SCIP_Real rhsminactivity;
6992  SCIP_Real rhsmaxactivity;
6993  SCIP_Real rhsrefactivity;
6994  SCIP_Real coefleft;
6995  SCIP_Real coefright;
6996  SCIP_Real coefrhs;
6997  SCIP_Real cutlhs;
6998  int i;
6999 
7000  assert(scip != NULL);
7001  assert(cons != NULL);
7002  assert(ref != NULL);
7003  assert(rowprep != NULL);
7004  assert(success != NULL);
7005  /* currently only separate LP solution or solutions given as SCIP_SOL, i.e., no cutgeneration during initlp */
7006  assert(sol != NULL || SCIPgetLPSolstat(scip) == SCIP_LPSOLSTAT_OPTIMAL);
7007 
7008  consdata = SCIPconsGetData(cons);
7009  assert(consdata != NULL);
7010  assert(consdata->nlinvars > 0);
7011  assert(consdata->factorleft != NULL);
7012  assert(consdata->factorright != NULL);
7013 
7014  *success = FALSE;
7015  rowprep->sidetype = SCIP_SIDETYPE_LEFT;
7016 
7017  /* write violated constraints as factorleft * factorright '==' rhs
7018  * where rhs are constraint sides - activity bound of linear part
7019  */
7020  rhsminactivity = consdata->lhs;
7021  rhsmaxactivity = consdata->rhs;
7022  rhsrefactivity = (violside == SCIP_SIDETYPE_LEFT ? consdata->lhs : consdata->rhs);
7023 
7024  for( i = 0; i < consdata->nlinvars; ++i )
7025  {
7026  if( !SCIPisInfinity(scip, -rhsminactivity) )
7027  {
7028  if( consdata->lincoefs[i] < 0.0 )
7029  {
7030  if( SCIPisInfinity(scip, -SCIPvarGetLbLocal(consdata->linvars[i])) )
7031  rhsminactivity = -SCIPinfinity(scip);
7032  else
7033  rhsminactivity -= consdata->lincoefs[i] * SCIPvarGetLbLocal(consdata->linvars[i]);
7034  }
7035  else
7036  {
7037  assert(consdata->lincoefs[i] > 0.0);
7038  if( SCIPisInfinity(scip, SCIPvarGetUbLocal(consdata->linvars[i])) )
7039  rhsminactivity = -SCIPinfinity(scip);
7040  else
7041  rhsminactivity -= consdata->lincoefs[i] * SCIPvarGetUbLocal(consdata->linvars[i]);
7042  }
7043  }
7044  if( !SCIPisInfinity(scip, rhsmaxactivity) )
7045  {
7046  if( consdata->lincoefs[i] < 0.0 )
7047  {
7048  if( SCIPisInfinity(scip, SCIPvarGetUbLocal(consdata->linvars[i])) )
7049  rhsmaxactivity = SCIPinfinity(scip);
7050  else
7051  rhsmaxactivity -= consdata->lincoefs[i] * SCIPvarGetUbLocal(consdata->linvars[i]);
7052  }
7053  else
7054  {
7055  assert(consdata->lincoefs[i] > 0.0);
7056  if( SCIPisInfinity(scip, -SCIPvarGetLbLocal(consdata->linvars[i])) )
7057  rhsmaxactivity = SCIPinfinity(scip);
7058  else
7059  rhsmaxactivity -= consdata->lincoefs[i] * SCIPvarGetLbLocal(consdata->linvars[i]);
7060  }
7061  }
7062  rhsrefactivity -= consdata->lincoefs[i] * SCIPgetSolVal(scip, sol, consdata->linvars[i]);
7063  }
7064 
7065  if( SCIPisInfinity(scip, -rhsminactivity) || SCIPisInfinity(scip, rhsmaxactivity) )
7066  {
7067  /* if right hand side is unbounded, then cannot do LTI */
7068  return SCIP_OKAY;
7069  }
7070 
7071  if( !SCIPisFeasPositive(scip, rhsminactivity) && !SCIPisFeasNegative(scip, rhsmaxactivity) )
7072  {
7073  /* if right hand side has 0 inside activity, then cannot do anything
7074  * if it has 0.0 as min or max activity, then a usual McCormick should be sufficient, too
7075  */
7076  return SCIP_OKAY;
7077  }
7078 
7079  leftminactivity = consdata->factorleft[consdata->nquadvars];
7080  leftmaxactivity = consdata->factorleft[consdata->nquadvars];
7081  leftrefactivity = consdata->factorleft[consdata->nquadvars];
7082  rightminactivity = consdata->factorright[consdata->nquadvars];
7083  rightmaxactivity = consdata->factorright[consdata->nquadvars];
7084  rightrefactivity = consdata->factorright[consdata->nquadvars];
7085  for( i = 0; i < consdata->nquadvars; ++i )
7086  {
7087  if( !SCIPisInfinity(scip, -leftminactivity) )
7088  {
7089  if( consdata->factorleft[i] > 0.0 )
7090  {
7091  if( SCIPisInfinity(scip, -SCIPvarGetLbLocal(consdata->quadvarterms[i].var)) )
7092  leftminactivity = -SCIPinfinity(scip);
7093  else
7094  leftminactivity += consdata->factorleft[i] * SCIPvarGetLbLocal(consdata->quadvarterms[i].var);
7095  }
7096  else if( consdata->factorleft[i] < 0.0 )
7097  {
7098  if( SCIPisInfinity(scip, SCIPvarGetUbLocal(consdata->quadvarterms[i].var)) )
7099  leftminactivity = -SCIPinfinity(scip);
7100  else
7101  leftminactivity += consdata->factorleft[i] * SCIPvarGetUbLocal(consdata->quadvarterms[i].var);
7102  }
7103  }
7104  if( !SCIPisInfinity(scip, leftmaxactivity) )
7105  {
7106  if( consdata->factorleft[i] > 0.0 )
7107  {
7108  if( SCIPisInfinity(scip, SCIPvarGetUbLocal(consdata->quadvarterms[i].var)) )
7109  leftmaxactivity = SCIPinfinity(scip);
7110  else
7111  leftmaxactivity += consdata->factorleft[i] * SCIPvarGetUbLocal(consdata->quadvarterms[i].var);
7112  }
7113  else if( consdata->factorleft[i] < 0.0 )
7114  {
7115  if( SCIPisInfinity(scip, -SCIPvarGetLbLocal(consdata->quadvarterms[i].var)) )
7116  leftmaxactivity = SCIPinfinity(scip);
7117  else
7118  leftmaxactivity += consdata->factorleft[i] * SCIPvarGetLbLocal(consdata->quadvarterms[i].var);
7119  }
7120  }
7121  leftrefactivity += consdata->factorleft[i] * ref[i];
7122 
7123  if( !SCIPisInfinity(scip, -rightminactivity) )
7124  {
7125  if( consdata->factorright[i] > 0.0 )
7126  {
7127  if( SCIPisInfinity(scip, -SCIPvarGetLbLocal(consdata->quadvarterms[i].var)) )
7128  rightminactivity = -SCIPinfinity(scip);
7129  else
7130  rightminactivity += consdata->factorright[i] * SCIPvarGetLbLocal(consdata->quadvarterms[i].var);
7131  }
7132  else if( consdata->factorright[i] < 0.0 )
7133  {
7134  if( SCIPisInfinity(scip, SCIPvarGetUbLocal(consdata->quadvarterms[i].var)) )
7135  rightminactivity = -SCIPinfinity(scip);
7136  else
7137  rightminactivity += consdata->factorright[i] * SCIPvarGetUbLocal(consdata->quadvarterms[i].var);
7138  }
7139  }
7140  if( !SCIPisInfinity(scip, rightmaxactivity) )
7141  {
7142  if( consdata->factorright[i] > 0.0 )
7143  {
7144  if( SCIPisInfinity(scip, SCIPvarGetUbLocal(consdata->quadvarterms[i].var)) )
7145  rightmaxactivity = SCIPinfinity(scip);
7146  else
7147  rightmaxactivity += consdata->factorright[i] * SCIPvarGetUbLocal(consdata->quadvarterms[i].var);
7148  }
7149  else if( consdata->factorright[i] < 0.0 )
7150  {
7151  if( SCIPisInfinity(scip, -SCIPvarGetLbLocal(consdata->quadvarterms[i].var)) )
7152  rightmaxactivity = SCIPinfinity(scip);
7153  else
7154  rightmaxactivity += consdata->factorright[i] * SCIPvarGetLbLocal(consdata->quadvarterms[i].var);
7155  }
7156  }
7157  rightrefactivity += consdata->factorright[i] * ref[i];
7158  }
7159 
7160  /* if activities exceed "opposite" infinity, huge bounds seem to be involved, for which the below method is not prepared */
7161  if( SCIPisInfinity(scip, leftminactivity) || SCIPisInfinity(scip, -leftmaxactivity) ||
7162  SCIPisInfinity(scip, rightminactivity) || SCIPisInfinity(scip, -rightmaxactivity) )
7163  return SCIP_OKAY;
7164 
7165  /* if activity in reference point exceeds value for infinity, then the below method will also not work properly */
7166  if( SCIPisInfinity(scip, REALABS(leftrefactivity)) || SCIPisInfinity(scip, REALABS(rightrefactivity)) )
7167  return SCIP_OKAY;
7168 
7169  /* if any of the factors is essentially fixed, give up and do usual method (numerically less sensitive, I hope) */
7170  if( SCIPisRelEQ(scip, leftminactivity, leftmaxactivity) || SCIPisRelEQ(scip, rightminactivity, rightmaxactivity) )
7171  return SCIP_OKAY;
7172 
7173  /* success can only be expected for separation of violated x*y <= w, assuming x>=0, y>=0
7174  * @todo we should check this early? */
7175 
7176  /* call Couenne magic */
7178  leftminactivity, leftmaxactivity, leftrefactivity,
7179  rightminactivity, rightmaxactivity, rightrefactivity,
7180  rhsminactivity, rhsmaxactivity, rhsrefactivity,
7181  &coefleft, &coefright, &coefrhs, &cutlhs,
7182  success);
7183 
7184  if( !*success )
7185  return SCIP_OKAY;
7186 
7187  SCIPdebugMsg(scip, "LTI for x[%g,%g] * y[%g,%g] = w[%g,%g]: %gx %+gy %+gw >= %g; feas: %g\n",
7188  leftminactivity, leftmaxactivity, rightminactivity, rightmaxactivity, rhsminactivity, rhsmaxactivity,
7189  coefleft, coefright, coefrhs, cutlhs,
7190  coefleft * leftrefactivity + coefright * rightrefactivity + coefrhs * rhsrefactivity - cutlhs
7191  );
7192 
7193  if( coefleft * leftrefactivity + coefright * rightrefactivity + coefrhs * rhsrefactivity >= cutlhs )
7194  {
7195  SCIPdebugMsg(scip, "does not cutoff point? :-(\n");
7196  *success = FALSE;
7197  return SCIP_OKAY;
7198  }
7199 
7200  /* setup cut coefs for
7201  * coefleft * leftfactor + coefright * rightfactor + coefrhs * w >= cutlhs, where conslhs - lincoefs <= w <= consrhs - lincoefs
7202  */
7203  for( i = 0; i < consdata->nquadvars; ++i )
7204  {
7205  SCIP_CALL( SCIPaddRowprepTerm(scip, rowprep, consdata->quadvarterms[i].var, coefleft * consdata->factorleft[i] + coefright * consdata->factorright[i]) );
7206  }
7207  SCIPaddRowprepConstant(rowprep, coefleft * consdata->factorleft[i] + coefright * consdata->factorright[i]);
7208 
7209  for( i = 0; i < consdata->nlinvars; ++i )
7210  {
7211  SCIP_CALL( SCIPaddRowprepTerm(scip, rowprep, consdata->linvars[i], -coefrhs * consdata->lincoefs[i]) );
7212  }
7213  if( coefrhs > 0.0 )
7214  {
7215  /* use coefrhs * w <= coefrhs * (consrhs - lincoefs) */
7216  assert(!SCIPisInfinity(scip, consdata->rhs));
7217  SCIPaddRowprepConstant(rowprep, coefrhs * consdata->rhs);
7218  }
7219  else
7220  {
7221  /* use coefrhs * w <= coeflhs * (conslhs - lincoefs) */
7222  assert(!SCIPisInfinity(scip, -consdata->lhs));
7223  SCIPaddRowprepConstant(rowprep, coefrhs * consdata->lhs);
7224  }
7225  SCIPaddRowprepSide(rowprep, cutlhs);
7226 
7227  rowprep->local = TRUE;
7228 
7229  (void) SCIPsnprintf(rowprep->name, SCIP_MAXSTRLEN, "%s_lti_%d", SCIPconsGetName(cons), SCIPgetNLPs(scip));
7230 
7231  *success = TRUE;
7232 
7233  return SCIP_OKAY;
7234 }
7235 
7236 /** computes cut coefficients by linearizing a quadratic function */
7237 static
7239  SCIP* scip, /**< SCIP data structure */
7240  SCIP_CONS* cons, /**< constraint */
7241  SCIP_SIDETYPE violside, /**< side for which to generate cut */
7242  SCIP_Real* ref, /**< reference solution where to generate the cut */
7243  SCIP_ROWPREP* rowprep, /**< rowprep to store cut data */
7244  SCIP_Bool* success /**< buffer to indicate whether a cut was successfully computed */
7245  )
7246 {
7247  SCIP_CONSDATA* consdata;
7248  SCIP_BILINTERM* bilinterm;
7249  SCIP_Real constant;
7250  SCIP_Real coef;
7251  SCIP_Real coef2;
7252  SCIP_VAR* var;
7253  int var2pos;
7254  int j;
7255  int k;
7256 
7257  assert(scip != NULL);
7258  assert(cons != NULL);
7259  assert(ref != NULL);
7260  assert(success != NULL);
7261 
7262  consdata = SCIPconsGetData(cons);
7263  assert(consdata != NULL);
7264 
7265  *success = TRUE;
7266 
7267  /* do first-order Taylor for each term */
7268  for( j = 0; j < consdata->nquadvars && *success; ++j )
7269  {
7270  var = consdata->quadvarterms[j].var;
7271 
7272  /* initialize coefficients to linear coefficients of quadratic variables */
7273  SCIP_CALL( SCIPaddRowprepTerm(scip, rowprep, var, consdata->quadvarterms[j].lincoef) );
7274 
7275  /* add linearization of square term */
7276  coef = 0.0;
7277  constant = 0.0;
7278  SCIPaddSquareLinearization(scip, consdata->quadvarterms[j].sqrcoef, ref[j],
7279  consdata->quadvarterms[j].nadjbilin == 0 && SCIPvarGetType(var) < SCIP_VARTYPE_CONTINUOUS, &coef, &constant, success);
7280  SCIP_CALL( SCIPaddRowprepTerm(scip, rowprep, var, coef) );
7281  SCIPaddRowprepConstant(rowprep, constant);
7282 
7283  /* add linearization of bilinear terms that have var as first variable */
7284  for( k = 0; k < consdata->quadvarterms[j].nadjbilin && *success; ++k )
7285  {
7286  bilinterm = &consdata->bilinterms[consdata->quadvarterms[j].adjbilin[k]];
7287  if( bilinterm->var1 != var )
7288  continue;
7289  assert(bilinterm->var2 != var);
7290  assert(consdata->sepabilinvar2pos != NULL);
7291 
7292  var2pos = consdata->sepabilinvar2pos[consdata->quadvarterms[j].adjbilin[k]];
7293  assert(var2pos >= 0);
7294  assert(var2pos < consdata->nquadvars);
7295  assert(consdata->quadvarterms[var2pos].var == bilinterm->var2);
7296 
7297  coef = 0.0;
7298  coef2 = 0.0;
7299  constant = 0.0;
7300  SCIPaddBilinLinearization(scip, bilinterm->coef, ref[j], ref[var2pos], &coef, &coef2, &constant, success);
7301  SCIP_CALL( SCIPaddRowprepTerm(scip, rowprep, var, coef) );
7302  SCIP_CALL( SCIPaddRowprepTerm(scip, rowprep, bilinterm->var2, coef2) );
7303  SCIPaddRowprepConstant(rowprep, constant);
7304  }
7305  }
7306 
7307  if( !*success )
7308  {
7309  SCIPdebugMsg(scip, "no success in linearization of <%s> in reference point\n", SCIPconsGetName(cons));
7310  return SCIP_OKAY;
7311  }
7312 
7313  rowprep->sidetype = violside;
7314  SCIPaddRowprepSide(rowprep, violside == SCIP_SIDETYPE_LEFT ? consdata->lhs : consdata->rhs);
7315 
7316  (void) SCIPsnprintf(rowprep->name, SCIP_MAXSTRLEN, "%s_side%d_linearization_%d", SCIPconsGetName(cons), violside, SCIPgetNLPs(scip));
7317 
7318  return SCIP_OKAY;
7319 }
7320 
7321 /** helper function to update the best relaxation for a bilinear term when using valid linear inequalities */
7322 static
7324  SCIP* scip, /**< SCIP data structure */
7325  SCIP_VAR* RESTRICT x, /**< first variable */
7326  SCIP_VAR* RESTRICT y, /**< second variable */
7327  SCIP_Real bilincoef, /**< coefficient of the bilinear term */
7328  SCIP_SIDETYPE violside, /**< side of quadratic constraint that is violated */
7329  SCIP_Real refx, /**< reference point for the x variable */
7330  SCIP_Real refy, /**< reference point for the y variable */
7331  SCIP_Real* RESTRICT ineqs, /**< coefficients of each linear inequality; stored as triple (xcoef,ycoef,constant) */
7332  int nineqs, /**< total number of inequalities */
7333  SCIP_Real mccormickval, /**< value of the McCormick relaxation at the reference point */
7334  SCIP_Real* RESTRICT bestcoefx, /**< pointer to update the x coefficient */
7335  SCIP_Real* RESTRICT bestcoefy, /**< pointer to update the y coefficient */
7336  SCIP_Real* RESTRICT bestconst, /**< pointer to update the constant */
7337  SCIP_Real* RESTRICT bestval, /**< value of the best relaxation that have been found so far */
7338  SCIP_Bool* success /**< buffer to store whether we found a better relaxation */
7339  )
7340 {
7341  SCIP_Real constshift[2] = {0.0, 0.0};
7342  SCIP_Real constant;
7343  SCIP_Real xcoef;
7344  SCIP_Real ycoef;
7345  SCIP_Real lbx;
7346  SCIP_Real ubx;
7347  SCIP_Real lby;
7348  SCIP_Real uby;
7349  SCIP_Bool update;
7350  SCIP_Bool overestimate;
7351  int i;
7352 
7353  assert(x != y);
7354  assert(!SCIPisZero(scip, bilincoef));
7355  assert(nineqs >= 0 && nineqs <= 2);
7356  assert(bestcoefx != NULL);
7357  assert(bestcoefy != NULL);
7358  assert(bestconst != NULL);
7359  assert(bestval != NULL);
7360 
7361  /* no inequalities available */
7362  if( nineqs == 0 )
7363  return;
7364  assert(ineqs != NULL);
7365 
7366  lbx = SCIPvarGetLbLocal(x);
7367  ubx = SCIPvarGetUbLocal(x);
7368  lby = SCIPvarGetLbLocal(y);
7369  uby = SCIPvarGetUbLocal(y);
7370  overestimate = (violside == SCIP_SIDETYPE_LEFT);
7371 
7372  /* check cases for which we can't compute a tighter relaxation */
7373  if( SCIPisFeasLE(scip, refx, lbx) || SCIPisFeasGE(scip, refx, ubx)
7374  || SCIPisFeasLE(scip, refy, lby) || SCIPisFeasGE(scip, refy, uby) )
7375  return;
7376 
7377  /* due to the feasibility tolerances of the LP and NLP solver, it might possible that the reference point is
7378  * violating the linear inequalities; to ensure that we compute a valid underestimate, we relax the linear
7379  * inequality by changing its constant part
7380  */
7381  for( i = 0; i < nineqs; ++i )
7382  {
7383  constshift[i] = MAX(0.0, ineqs[3*i] * refx - ineqs[3*i+1] * refy - ineqs[3*i+2]);
7384  SCIPdebugMsg(scip, "constant shift of inequality %d = %.16f\n", constshift[i]);
7385  }
7386 
7387  /* try to use both inequalities */
7388  if( nineqs == 2 )
7389  {
7390  SCIPcomputeBilinEnvelope2(scip, bilincoef, lbx, ubx, refx, lby, uby, refy, overestimate, ineqs[0], ineqs[1],
7391  ineqs[2] + constshift[0], ineqs[3], ineqs[4], ineqs[5] + constshift[1], &xcoef, &ycoef, &constant, &update);
7392 
7393  if( update )
7394  {
7395  SCIP_Real val = xcoef * refx + ycoef * refy + constant;
7396  SCIP_Real relimpr = 1.0 - (REALABS(val - bilincoef * refx * refy) + 1e-4) / (REALABS(*bestval - bilincoef * refx * refy) + 1e-4);
7397  SCIP_Real absimpr = REALABS(val - (*bestval));
7398 
7399  /* update relaxation if possible */
7400  if( relimpr > 0.05 && absimpr > 1e-3 && ((overestimate && SCIPisRelLT(scip, val, *bestval)) || (!overestimate && SCIPisRelGT(scip, val, *bestval))) )
7401  {
7402  *bestcoefx = xcoef;
7403  *bestcoefy = ycoef;
7404  *bestconst = constant;
7405  *bestval = val;
7406  *success = TRUE;
7407  }
7408  }
7409  }
7410 
7411  /* use inequalities individually */
7412  for( i = 0; i < nineqs; ++i )
7413  {
7414  SCIPcomputeBilinEnvelope1(scip, bilincoef, lbx, ubx, refx, lby, uby, refy, overestimate, ineqs[3*i], ineqs[3*i+1],
7415  ineqs[3*i+2] + constshift[i], &xcoef, &ycoef, &constant, &update);
7416 
7417  if( update )
7418  {
7419  SCIP_Real val = xcoef * refx + ycoef * refy + constant;
7420  SCIP_Real relimpr = 1.0 - (REALABS(val - bilincoef * refx * refy) + 1e-4) / (REALABS(mccormickval - bilincoef * refx * refy) + 1e-4);
7421  SCIP_Real absimpr = REALABS(val - (*bestval));
7422 
7423  /* update relaxation if possible */
7424  if( relimpr > 0.05 && absimpr > 1e-3 && ((overestimate && SCIPisRelLT(scip, val, *bestval)) || (!overestimate && SCIPisRelGT(scip, val, *bestval))) )
7425  {
7426  *bestcoefx = xcoef;
7427  *bestcoefy = ycoef;
7428  *bestconst = constant;
7429  *bestval = val;
7430  *success = TRUE;
7431  }
7432  }
7433  }
7434 }
7435 
7436 /* returns the interiority of a reference point w.r.t. given bounds */
7437 static
7439  SCIP* scip, /**< SCIP data structure */
7440  SCIP_Real lbx, /**< lower bound of the first variable */
7441  SCIP_Real ubx, /**< upper bound of the first variable */
7442  SCIP_Real refx, /**< reference point of the first variable */
7443  SCIP_Real lby, /**< lower bound of the second variable */
7444  SCIP_Real uby, /**< upper bound of the second variable */
7445  SCIP_Real refy /**< reference point of the second variable */
7446  )
7447 {
7448  SCIP_Real interiorityx;
7449  SCIP_Real interiorityy;
7450 
7451  interiorityx = MIN(refx-lbx, ubx-refx) / MAX(ubx-lbx, SCIPepsilon(scip)); /*lint !e666*/
7452  interiorityy = MIN(refy-lby, uby-refy) / MAX(uby-lby, SCIPepsilon(scip)); /*lint !e666*/
7453 
7454  return 2.0*MIN(interiorityx, interiorityy);
7455 }
7456 
7457 /** computes cut coefficients for a nonconvex quadratic function */
7458 static
7460  SCIP* scip, /**< SCIP data structure */
7461  SCIP_CONSHDLRDATA* conshdlrdata, /**< constraint handler data */
7462  SCIP_CONS* cons, /**< constraint */
7463  SCIP_SIDETYPE violside, /**< side for which to generate cut */
7464  SCIP_Real* ref, /**< reference solution where to generate the cut */
7465  SCIP_ROWPREP* rowprep, /**< rowprep to store cut data */
7466  SCIP_Bool* success /**< buffer to indicate whether a cut was successfully computed */
7467  )
7468 {
7469  SCIP_CONSDATA* consdata;
7470  SCIP_BILINTERM* bilinterm;
7471  SCIP_Real sqrcoef;
7472  SCIP_Real coef;
7473  SCIP_Real coef2;
7474  SCIP_Real constant;
7475  SCIP_VAR* var;
7476  int var2pos;
7477  int j;
7478  int k;
7479 
7480  assert(scip != NULL);
7481  assert(conshdlrdata != NULL);
7482  assert(cons != NULL);
7483  assert(ref != NULL);
7484  assert(success != NULL);
7485 
7486  consdata = SCIPconsGetData(cons);
7487  assert(consdata != NULL);
7488 
7489  rowprep->local = TRUE;
7490  *success = TRUE;
7491 
7492  /* underestimate (secant, McCormick) or linearize each term separately */
7493  for( j = 0; j < consdata->nquadvars && *success; ++j )
7494  {
7495  var = consdata->quadvarterms[j].var;
7496 
7497  /* initialize coefficients to linear coefficients of quadratic variables */
7498  SCIP_CALL( SCIPaddRowprepTerm(scip, rowprep, var, consdata->quadvarterms[j].lincoef) );
7499 
7500  sqrcoef = consdata->quadvarterms[j].sqrcoef;
7501  if( sqrcoef != 0.0 )
7502  {
7503  coef = 0.0;
7504  constant = 0.0;
7505  if( (violside == SCIP_SIDETYPE_LEFT && sqrcoef <= 0.0) || (violside == SCIP_SIDETYPE_RIGHT && sqrcoef > 0.0) )
7506  {
7507  /* convex -> linearize */
7508  SCIPaddSquareLinearization(scip, sqrcoef, ref[j], SCIPvarGetType(var) < SCIP_VARTYPE_CONTINUOUS, &coef,
7509  &constant, success);
7510  }
7511  else
7512  {
7513  /* not convex -> secant approximation */
7514  SCIPaddSquareSecant(scip, sqrcoef, SCIPvarGetLbLocal(var), SCIPvarGetUbLocal(var), ref[j], &coef,
7515  &constant, success);
7516  }
7517  SCIP_CALL( SCIPaddRowprepTerm(scip, rowprep, var, coef) );
7518  SCIPaddRowprepConstant(rowprep, constant);
7519  }
7520 
7521  /* relax each bilinear term */
7522  for( k = 0; k < consdata->quadvarterms[j].nadjbilin && (*success); ++k )
7523  {
7524  SCIP_VAR* x;
7525  SCIP_VAR* y;
7526  SCIP_Real refx;
7527  SCIP_Real refy;
7528  SCIP_Real lbx;
7529  SCIP_Real ubx;
7530  SCIP_Real lby;
7531  SCIP_Real uby;
7532  int idx;
7533 
7534  idx = consdata->quadvarterms[j].adjbilin[k];
7535  bilinterm = &consdata->bilinterms[idx];
7536  if( bilinterm->var1 != var )
7537  continue;
7538  assert(bilinterm->var2 != var);
7539  assert(consdata->sepabilinvar2pos != NULL);
7540 
7541  var2pos = consdata->sepabilinvar2pos[consdata->quadvarterms[j].adjbilin[k]];
7542  assert(var2pos >= 0);
7543  assert(var2pos < consdata->nquadvars);
7544  assert(consdata->quadvarterms[var2pos].var == bilinterm->var2);
7545 
7546  /* get data of the variables in the bilinear term */
7547  x = var;
7548  y = bilinterm->var2;
7549  refx = ref[j];
7550  refy = ref[var2pos];
7551  lbx = SCIPvarGetLbLocal(x);
7552  ubx = SCIPvarGetUbLocal(x);
7553  lby = SCIPvarGetLbLocal(y);
7554  uby = SCIPvarGetUbLocal(y);
7555  SCIPdebugMsg(scip, "bilinear term %g %s %s with (%g,%g) in [%g,%g]x[%g,%g] overestimate=%u\n", bilinterm->coef,
7556  SCIPvarGetName(x), SCIPvarGetName(y), refx, refy, lbx, ubx, lby, uby, violside == SCIP_SIDETYPE_LEFT);
7557 
7558  /* use the McCormick relaxation for under- or overestimating the bilinear term */
7559  coef = 0.0;
7560  coef2 = 0.0;
7561  constant = 0.0;
7562  SCIPaddBilinMcCormick(scip, bilinterm->coef, lbx, ubx, refx, lby, uby, refy,
7563  violside == SCIP_SIDETYPE_LEFT, &coef, &coef2, &constant, success);
7564  SCIPdebugMsg(scip, "McCormick = %g (%u)\n", refx * coef + refy * coef2 + constant, *success);
7565 
7566  /* tries to compute a tighter relaxation for xy by using valid linear inequalities */
7567  if( conshdlrdata->bilinestimators != NULL && ubx - lbx >= 0.1 && uby - lby >= 0.1
7568  && (SCIPgetNSepaRounds(scip) <= conshdlrdata->bilinineqmaxseparounds || SCIPgetDepth(scip) == 0) )
7569  {
7570  BILINESTIMATOR* bilinestimator;
7571  SCIP_Real mccormick;
7572  SCIP_Real score;
7573  int bilintermidx;
7574 
7575  mccormick = refx * coef + refy * coef2 + constant;
7576  score = getInteriority(scip, lbx, ubx, refx, lby, uby, refy);
7577 
7578  /* get data for bilinear term */
7579  bilintermidx = consdata->bilintermsidx[idx];
7580  assert(conshdlrdata->bilinestimators != NULL);
7581  bilinestimator = &(conshdlrdata->bilinestimators[bilintermidx]);
7582  assert(bilinestimator->x == x);
7583  assert(bilinestimator->y == y);
7584 
7585  /* reset the last improvement factor (used for getting better branching decisions) */
7586  bilinestimator->lastimprfac = 0.0;
7587 
7588  /* compute tighter relaxation for xy if the current score is large enough */
7589  if( SCIPisGE(scip, score, conshdlrdata->minscorebilinterms)
7590  && bilinestimator->nineqoverest + bilinestimator->ninequnderest > 0 )
7591  {
7592  SCIP_Real bestval = mccormick;
7593  SCIP_Bool updaterelax = FALSE;
7594 
7595  /*
7596  * note that we check the sign of the bilinear coefficient together with violside in
7597  * updateBilinearRelaxation in order to decide whether a valid under- or overestimate can be computed
7598  */
7599 
7600  /* use overestimates */
7601  updateBilinearRelaxation(scip, x, y, bilinterm->coef, violside, refx, refy, bilinestimator->ineqoverest,
7602  bilinestimator->nineqoverest, mccormick, &coef, &coef2, &constant, &bestval, &updaterelax);
7603 
7604  /* use underestimates */
7605  updateBilinearRelaxation(scip, x, y, bilinterm->coef, violside, refx, refy, bilinestimator->inequnderest,
7606  bilinestimator->ninequnderest, mccormick, &coef, &coef2, &constant, &bestval, &updaterelax);
7607 
7608  SCIPdebugMsg(scip, "found better relaxation value: %u (%g)\n", updaterelax, bestval);
7609 
7610  /* check whether the new relaxation is under- or overestimating xy properly */
7611  if( updaterelax )
7612  {
7613  /* update improvement factor */
7614  bilinestimator->lastimprfac = 1.0 - REALABS(bestval - bilinterm->coef * refx * refy) / REALABS(mccormick - bilinterm->coef * refx * refy);
7615 
7616 #ifndef NDEBUG
7617  assert(SCIPisEQ(scip, bestval, coef * refx + coef2 * refy + constant));
7618  if( violside == SCIP_SIDETYPE_LEFT )
7619  {
7620  assert(SCIPisRelGE(scip, bestval, bilinterm->coef * refx * refy));
7621  assert(SCIPisRelLE(scip, bestval, mccormick));
7622  }
7623  else
7624  {
7625  assert(SCIPisRelLE(scip, bestval, bilinterm->coef * refx * refy));
7626  assert(SCIPisRelGE(scip, bestval, mccormick));
7627  }
7628 #endif
7629  }
7630  }
7631  }
7632 
7633  SCIP_CALL( SCIPaddRowprepTerm(scip, rowprep, var, coef) );
7634  SCIP_CALL( SCIPaddRowprepTerm(scip, rowprep, bilinterm->var2, coef2) );
7635  SCIPaddRowprepConstant(rowprep, constant);
7636  }
7637  }
7638 
7639  if( !*success )
7640  {
7641  SCIPdebugMsg(scip, "no success to find estimator for nonconvex <%s>\n", SCIPconsGetName(cons));
7642  return SCIP_OKAY;
7643  }
7644 
7645  rowprep->sidetype = violside;
7646  SCIPaddRowprepSide(rowprep, violside == SCIP_SIDETYPE_LEFT ? consdata->lhs : consdata->rhs);
7647 
7648  (void) SCIPsnprintf(rowprep->name, SCIP_MAXSTRLEN, "%s_side%d_estimation_%d", SCIPconsGetName(cons), violside, SCIPgetNLPs(scip));
7649 
7650  return SCIP_OKAY;
7651 }
7652 
7653 /** generates a cut based on linearization (if convex) or McCormick (if nonconvex) in a given reference point */
7654 static
7656  SCIP* scip, /**< SCIP data structure */
7657  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
7658  SCIP_CONS* cons, /**< constraint */
7659  SCIP_Real* ref, /**< reference solution where to generate the cut */
7660  SCIP_SOL* sol, /**< point that we aim to separate, or NULL for LP solution */
7661  SCIP_SIDETYPE violside, /**< for which side a cut should be generated */
7662  SCIP_ROW** row, /**< storage for cut */
7663  SCIP_Real* efficacy, /**< buffer to store efficacy of row in reference solution, or NULL if not of interest */
7664  SCIP_Bool checkcurvmultivar, /**< are we allowed to check the curvature of a multivariate quadratic function, if not done yet */
7665  SCIP_Real minefficacy /**< minimal required efficacy */
7666  )
7667 {
7668  SCIP_CONSHDLRDATA* conshdlrdata;
7669  SCIP_CONSDATA* consdata;
7670  SCIP_ROWPREP* rowprep;
7671  SCIP_Bool success;
7672  SCIP_Real viol = 0.0;
7673 
7674  assert(scip != NULL);
7675  assert(conshdlr != NULL);
7676  assert(cons != NULL);
7677  assert(ref != NULL);
7678  assert(row != NULL);
7679 
7680  conshdlrdata = SCIPconshdlrGetData(conshdlr);
7681  assert(conshdlrdata != NULL);
7682 
7683  consdata = SCIPconsGetData(cons);
7684  assert(consdata != NULL);
7685  assert(violside != SCIP_SIDETYPE_LEFT || !SCIPisInfinity(scip, -consdata->lhs));
7686  assert(violside != SCIP_SIDETYPE_RIGHT || !SCIPisInfinity(scip, consdata->rhs));
7687 
7688  *row = NULL;
7689 
7691  success = FALSE;
7692 
7693  /* if constraint function is factorable, then try to use factorable form to generate cut */
7694  if( consdata->factorleft != NULL )
7695  {
7696  if( consdata->nlinvars == 0 )
7697  {
7698  SCIP_CALL( generateCutFactorable(scip, cons, violside, ref, rowprep, &success) );
7699  }
7700  else if( sol != NULL || SCIPgetLPSolstat(scip) == SCIP_LPSOLSTAT_OPTIMAL )
7701  {
7702  /* generateCutLTI needs reference values also for the linear variables, which we only have if sol is given or LP has been solved */
7703  SCIP_CALL( generateCutLTI(scip, cons, violside, ref, sol, rowprep, &success) );
7704  }
7705  }
7706 
7707  /* if constraint is not factorable or failed to generate cut, try default method */
7708  if( !success )
7709  {
7710  SCIP_CALL( checkCurvature(scip, cons, checkcurvmultivar) );
7711 
7712  if( (violside == SCIP_SIDETYPE_LEFT && consdata->isconcave) || (violside == SCIP_SIDETYPE_RIGHT && consdata->isconvex) )
7713  {
7714  SCIP_CALL( generateCutConvex(scip, cons, violside, ref, rowprep, &success) );
7715  }
7716  else
7717  {
7718  SCIP_CALL( generateCutNonConvex(scip, conshdlrdata, cons, violside, ref, rowprep, &success) );
7719  }
7720 
7721  SCIP_CALL( SCIPaddRowprepTerms(scip, rowprep, consdata->nlinvars, consdata->linvars, consdata->lincoefs) );
7722  }
7723 
7724  /* check if reference point violates cut at least a little bit */
7725  if( success && !SCIPisInfinity(scip, -minefficacy) )
7726  {
7727  viol = SCIPgetRowprepViolation(scip, rowprep, sol);
7728  if( viol <= 0.0 ) /*lint !e644*/
7729  {
7730  SCIPdebugMsg(scip, "skip cut for constraint <%s> because efficacy %g too low (< %g)\n", SCIPconsGetName(cons), viol, minefficacy);
7731  success = FALSE;
7732  }
7733  }
7734 
7735  /* cleanup and improve cut */
7736  if( success )
7737  {
7738  SCIP_Real coefrange;
7739 
7740  /* merge terms */
7741  SCIPmergeRowprepTerms(scip, rowprep);
7742 
7743  /* improve coefficients */
7744  SCIP_CALL( SCIPcleanupRowprep(scip, rowprep, sol, conshdlrdata->cutmaxrange, minefficacy, &coefrange, &viol) );
7745  success = coefrange <= conshdlrdata->cutmaxrange;
7746  }
7747 
7748  /* check that side is finite */ /*lint --e{514} */
7749  success &= !SCIPisInfinity(scip, REALABS(rowprep->side)); /*lint !e514*/
7750 
7751  /* check whether maximal coef is finite, if any */ /*lint --e{514} */
7752  success &= (rowprep->nvars == 0) || !SCIPisInfinity(scip, REALABS(rowprep->coefs[0])); /*lint !e514*/
7753 
7754  /* check if reference point violates cut sufficiently */
7755  if( success && !SCIPisInfinity(scip, -minefficacy) && viol < minefficacy ) /*lint !e644*/
7756  {
7757  SCIPdebugMsg(scip, "skip cut for constraint <%s> because efficacy %g too low (< %g)\n", SCIPconsGetName(cons), viol, minefficacy);
7758  success = FALSE;
7759  }
7760 
7761  /* generate row */
7762  if( success )
7763  {
7764  SCIP_CALL( SCIPgetRowprepRowCons(scip, row, rowprep, SCIPconsGetHdlr(cons)) );
7765 
7766  SCIPdebugMsg(scip, "found cut <%s>, lhs=%g, rhs=%g, mincoef=%g, maxcoef=%g, range=%g, nnz=%d, efficacy=%g\n",
7767  SCIProwGetName(*row), SCIProwGetLhs(*row), SCIProwGetRhs(*row),
7768  rowprep->nvars > 0 ? rowprep->coefs[rowprep->nvars-1] : 0.0, rowprep->nvars > 0 ? rowprep->coefs[0] : 0.0,
7769  rowprep->nvars > 0 ? rowprep->coefs[0]/rowprep->coefs[rowprep->nvars-1] : 1.0,
7770  SCIProwGetNNonz(*row), viol); /*lint !e414 */
7771 
7772  if( efficacy != NULL )
7773  *efficacy = viol;
7774  }
7775 
7776  SCIPfreeRowprep(scip, &rowprep);
7777 
7778  return SCIP_OKAY;
7779 }
7780 
7781 /** computes eigen decomposition of A, where \f$ f(x) = x^T A x + b^T x \f$.
7782  *
7783  * The eigen decomposition is given by A = P D P^T, where D is diagonal formed by the eigenvalues and P is orthonormal
7784  * whose columns are the eigenvectors; we also compute b^T * P, in case one needs the change of variables P^T x = y <=>
7785  * x = P y We store P^T in an array, specifically, in consdata->eigenvectors we store P^T row-wise, i.e., the first row
7786  * of P^T is stored in eigenvector[0..n-1], the second row is stored in eigenvectors[n..2n-1], etc; equivalently, the
7787  * first eigenvector is eigenvector[0..n-1], the second one is eigenvectors[n..2n-1], etc.
7788  *
7789  * @todo: - at the moment of writing, checkCurvature computes the eigenvalues (and vectors) for determining curvature
7790  * when it can't to it via other considerations. so one could try to merge both methods together.
7791  * - it seems that if A is of the form [I 0; 0 A'], one only needs to compute the decomposition for A' so one
7792  * could do better in terms of memory and speed. For instance, when the matrix is diagonal, the eigenvectors
7793  * are the identity matrix and the eigenvalues are readily available from the constraint, so one could adapt
7794  * the functions that uses the eigenvectors in this particular case. One could also think about storing the
7795  * eigenvectors in a sparse fashion, though eigenvectors are seldom sparse.
7796  */
7797 static
7799  SCIP* scip, /**< SCIP data structure */
7800  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
7801  SCIP_CONS* cons /**< constraint */
7802  )
7803 {
7804  SCIP_CONSDATA* consdata;
7805  int n;
7806  int nn;
7807  int row;
7808  int col;
7809  int i;
7810  int j;
7811  double* matrix;
7812  SCIP_HASHMAP* var2index;
7813 
7814  SCIPdebugMsg(scip, "computing ED for cons %s\n", SCIPconsGetName(cons));
7815 
7816  assert(scip != NULL);
7817  assert(conshdlr != NULL);
7818  assert(cons != NULL);
7819 
7820  consdata = SCIPconsGetData(cons);
7821  assert(consdata != NULL);
7822 
7823  /* function has to be convex with finite rhs or concave with finite lhs */
7824  assert((consdata->isconvex && !SCIPisInfinity(scip, consdata->rhs)) ||
7825  (consdata->isconcave && !SCIPisInfinity(scip, -consdata->lhs)));
7826 
7827  /* can't compute eigenvectors without IPOPT */
7828  if( !SCIPisIpoptAvailableIpopt() )
7829  {
7830  consdata->isedavailable = FALSE;
7831  return SCIP_OKAY;
7832  }
7833 
7834  /* @todo: - it seems that if A is of the form [I 0; 0 A'], one only needs to compute the decomposition for A'
7835  * so one could do better in terms of memory and speed
7836  * - if n too big don't compute SVD
7837  */
7838  n = consdata->nquadvars;
7839 
7840  /* do not compute eigendecomposition if n is too large */
7841  nn = n * n;
7842  if( nn < 0 || (unsigned) (int) nn > UINT_MAX / sizeof(SCIP_Real) )
7843  {
7844  SCIPdebugMsg(scip, "n is too large to compute eigendecomposition\n");
7845  consdata->isedavailable = FALSE;
7846  return SCIP_OKAY;
7847  }
7848 
7849  /* we just need to pass the upper triangle of A since it is symmetric; build it here */
7850  SCIP_CALL( SCIPallocBlockMemoryArray(scip, &consdata->eigenvectors, nn) );
7851  matrix = consdata->eigenvectors;
7852  BMSclearMemoryArray(matrix, nn);
7853 
7854  /* @todo if we are called in solving stage (or late from initsol), we can avoid the hashmap by using sepabilinvar2pos */
7855  SCIP_CALL( SCIPhashmapCreate(&var2index, SCIPblkmem(scip), n) );
7856 
7857  for( i = 0; i < n; ++i )
7858  {
7859  SCIP_CALL( SCIPhashmapInsertInt(var2index, consdata->quadvarterms[i].var, i) );
7860  matrix[i*n + i] = consdata->quadvarterms[i].sqrcoef;
7861 #ifdef DEBUG_PROJ
7862  printf("inserting in position %d, value %g\n", i*n + i, consdata->quadvarterms[i].sqrcoef);
7863 #endif
7864  }
7865 
7866  for( i = 0; i < consdata->nbilinterms; ++i )
7867  {
7868  assert(SCIPhashmapExists(var2index, consdata->bilinterms[i].var1));
7869  assert(SCIPhashmapExists(var2index, consdata->bilinterms[i].var2));
7870  row = SCIPhashmapGetImageInt(var2index, consdata->bilinterms[i].var1);
7871  col = SCIPhashmapGetImageInt(var2index, consdata->bilinterms[i].var2);
7872  if( row < col )
7873  {
7874  matrix[row * n + col] = consdata->bilinterms[i].coef/2;
7875 #ifdef DEBUG_PROJ
7876  printf("inserting in position %d, value %g\n", row*n + col, consdata->bilinterms[i].coef/2);
7877 #endif
7878  }
7879  else
7880  {
7881  matrix[col * n + row] = consdata->bilinterms[i].coef/2;
7882 #ifdef DEBUG_PROJ
7883  printf("inserting in position %d, value %g\n", col*n + row, consdata->bilinterms[i].coef/2);
7884 #endif
7885  }
7886  }
7887 
7888 #ifdef DEBUG_PROJ
7889  printf("matrix built:\n");
7890  for( i = 0; i < n; i++ )
7891  {
7892  for( j = 0; j < n; j++ )
7893  printf("%g ", matrix[i*n + j]);
7894  printf("\n");
7895  }
7896 #endif
7897 
7898  /* compute eigenvalues and eigenvectors */
7899  SCIP_CALL( SCIPallocBlockMemoryArray(scip, &consdata->eigenvalues, n) );
7900 
7901  if( LapackDsyev(TRUE, n, matrix, consdata->eigenvalues) != SCIP_OKAY )
7902  {
7903  SCIPdebugMsg(scip, "couldn't compute ED for cons %s\n", SCIPconsGetName(cons));
7904  consdata->isedavailable = FALSE;
7905  }
7906  else
7907  {
7908  consdata->isedavailable = TRUE;
7909 
7910  /* compute b^T*P */
7911  SCIP_CALL( SCIPallocClearBlockMemoryArray(scip, &consdata->bp, n) );
7912  for( i = 0; i < n; i++ )
7913  for( j = 0; j < n; j++ )
7914  consdata->bp[i] += consdata->quadvarterms[j].lincoef * matrix[i*n + j];
7915 
7916 #ifdef DEBUG_PROJ
7917  printf("eigenvalues:\n");
7918  for( j = 0; j < n; j++ )
7919  printf("%g ", consdata->eigenvalues[j]);
7920 
7921  printf("\neigenvectors (P^T):\n");
7922  for( i = 0; i < n; i++ )
7923  {
7924  for( j = 0; j < n; j++ )
7925  printf("%g ", matrix[i*n + j]);
7926  printf("\n");
7927  }
7928 
7929  printf("b*P^T:\n");
7930  for( j = 0; j < n; j++ )
7931  printf("%g ", consdata->bp[j]);
7932  printf("svd computed successfully\n");
7933 #endif
7934  }
7935 
7936  SCIPhashmapFree(&var2index);
7937 
7938  return SCIP_OKAY;
7939 }
7940 
7941 /** computes an interior point for the quadratic part of the convex constraint
7942  *
7943  * There are different methods for computing the interior point
7944  * - 'a'ny: solves min 0, f(x) <= rhs, x in bounds
7945  * - 'm'ost interior: solves min f(x), x in bounds
7946  *
7947  * @todo: other methods for computing an interior point?
7948  */
7949 static
7951  SCIP* scip, /**< SCIP data structure */
7952  SCIP_CONS* cons, /**< constraint */
7953  char method, /**< method for computing interior point ('a' any point, 'm'ost interior) */
7954  SCIP_Bool* success /**< buffer to store if an interior point was found */
7955  )
7956 {
7957  SCIP_CONSDATA* consdata;
7958  SCIP_QUADELEM* nlrowquadelems;
7959  SCIP_NLPIPROBLEM* prob;
7960  SCIP_NLPI* nlpi;
7961  SCIP_Real* interiorpoint;
7962  SCIP_Real* lbs;
7963  SCIP_Real* ubs;
7964  SCIP_Real* lincoefs;
7965  SCIP_Real nlpiside;
7966  char probname[SCIP_MAXSTRLEN];
7967  int* lininds;
7968  int nlrownquadelems;
7969  int nquadvars;
7970  int i;
7971 
7972  assert(scip != NULL);
7973  assert(cons != NULL);
7974 
7975  assert(success != NULL);
7976  *success = FALSE;
7977 
7978  consdata = SCIPconsGetData(cons);
7979  assert(consdata != NULL);
7980 
7981  assert((consdata->isconvex && !SCIPisInfinity(scip, consdata->rhs)) ||
7982  (consdata->isconcave && !SCIPisInfinity(scip, -consdata->lhs)));
7983 
7984  /* need an NLP solver */
7985  if( SCIPgetNNlpis(scip) == 0 )
7986  return SCIP_OKAY;
7987 
7988  nlpi = NULL;
7989  prob = NULL;
7990  lbs = NULL;
7991  ubs = NULL;
7992  lincoefs = NULL;
7993  lininds = NULL;
7994 
7995 #ifdef SCIP_DEBUG_INT
7996  SCIPinfoMessage(scip, NULL, "Computing interior point for\n");
7997  SCIP_CALL( SCIPprintCons(scip, cons, NULL) );
7998  SCIPinfoMessage(scip, NULL, ";\n");
7999 #endif
8000 
8001  /* in the convex case, we try to find an interior point of x^T A x + b^T x <= rhs - maximum activity linear part
8002  * in the concave case: lhs - minimum activity linear part <= x^T A x + b^T x; we compute activities ourselves,
8003  * since consdata->max(min)linactivity are only computed when lhs (rhs) is finite and this not always holds
8004  */
8005  if( consdata->isconvex )
8006  {
8007  /* compute maximum activity */
8008  nlpiside = 0;
8009  for( i = 0; i < consdata->nlinvars; ++i )
8010  {
8011  if( consdata->lincoefs[i] >= 0.0 )
8012  {
8013  if( SCIPisInfinity(scip, SCIPvarGetUbLocal(consdata->linvars[i]) ) )
8014  nlpiside = SCIPinfinity(scip);
8015  else
8016  nlpiside += consdata->lincoefs[i] * SCIPvarGetUbLocal(consdata->linvars[i]);
8017  }
8018  else
8019  {
8020  if( SCIPisInfinity(scip, -SCIPvarGetLbLocal(consdata->linvars[i]) ) )
8021  nlpiside = SCIPinfinity(scip);
8022  else
8023  nlpiside += consdata->lincoefs[i] * SCIPvarGetLbLocal(consdata->linvars[i]);
8024  }
8025 
8026  if( SCIPisInfinity(scip, nlpiside) )
8027  {
8028  SCIPdebugMsg(scip, "maximum activity is infinity: there is no interior point for fun <= rhs - maxlinactivity!\n");
8029  return SCIP_OKAY;
8030  }
8031  }
8032 
8033  if( consdata->nlinvars == 0 )
8034  nlpiside = INTERIOR_EPS;
8035 
8036  nlpiside = consdata->rhs - nlpiside;
8037  }
8038  else
8039  {
8040  /* compute minimum activity */
8041  nlpiside = 0;
8042  for( i = 0; i < consdata->nlinvars; ++i )
8043  {
8044  if( consdata->lincoefs[i] >= 0.0 )
8045  {
8046  if( SCIPisInfinity(scip, -SCIPvarGetLbLocal(consdata->linvars[i])) )
8047  nlpiside = -SCIPinfinity(scip);
8048  else
8049  nlpiside += consdata->lincoefs[i] * SCIPvarGetLbLocal(consdata->linvars[i]);
8050  }
8051  else
8052  {
8053  if( SCIPisInfinity(scip, SCIPvarGetUbLocal(consdata->linvars[i])) )
8054  nlpiside = -SCIPinfinity(scip);
8055  else
8056  nlpiside += consdata->lincoefs[i] * SCIPvarGetUbLocal(consdata->linvars[i]);
8057  }
8058 
8059  if( SCIPisInfinity(scip, -nlpiside) )
8060  {
8061  SCIPdebugMsg(scip, "minimum activity is -infinity: there is no interior point for fun >= lhs - minlinactivity!\n");
8062  return SCIP_OKAY;
8063  }
8064  }
8065 
8066  if( consdata->nlinvars == 0 )
8067  nlpiside = INTERIOR_EPS;
8068 
8069  nlpiside = consdata->lhs - nlpiside;
8070  }
8071 
8072  nquadvars = consdata->nquadvars;
8073 
8074  /* if we are looking for any interior point and the 0 is one, then use it */
8075  if( method == 'a' && ((consdata->isconvex && SCIPisGE(scip, nlpiside, 0.0))
8076  || (consdata->isconcave && SCIPisLE(scip, nlpiside, 0.0))) )
8077  {
8078  SCIP_CALL( SCIPallocClearBlockMemoryArray(scip, &(consdata->interiorpoint), nquadvars) );
8079 
8080  *success = TRUE;
8081  goto TERMINATE;
8082  }
8083 
8084  /* build nlrow */
8085  if( consdata->nlrow == NULL )
8086  {
8087  SCIP_CALL( createNlRow(scip, cons) );
8088  assert(consdata->nlrow != NULL);
8089  }
8090 
8091  nlpi = SCIPgetNlpis(scip)[0];
8092  assert(nlpi != NULL);
8093 
8094  /* initializing the subproblem */
8095  (void) SCIPsnprintf(probname, SCIP_MAXSTRLEN, "%s_subquad", SCIPgetProbName(scip));
8096  SCIP_CALL( SCIPnlpiCreateProblem(nlpi, &prob, probname) );
8097  assert(prob != NULL);
8098 
8099 #ifdef SCIP_DEBUG_INT
8101 #endif
8102  /* TODO: maybe one should set some generous iteration limit and/or a timelimit (remaining scip solve time)? */
8103 
8104  /* ask for memory to store data needed to create vars and linear coefficients */
8105  SCIP_CALL( SCIPallocBufferArray(scip, &lbs, nquadvars) );
8106  SCIP_CALL( SCIPallocBufferArray(scip, &ubs, nquadvars) );
8107  SCIP_CALL( SCIPallocBufferArray(scip, &lininds, nquadvars) );
8108  SCIP_CALL( SCIPallocBufferArray(scip, &lincoefs, nquadvars) );
8109 
8110  /* get bounds and linear coefficients */
8111  for( i = 0; i < nquadvars; i++ )
8112  {
8113  lbs[i] = SCIPvarGetLbGlobal(consdata->quadvarterms[i].var);
8114  ubs[i] = SCIPvarGetUbGlobal(consdata->quadvarterms[i].var);
8115 
8116  lincoefs[i] = consdata->quadvarterms[i].lincoef;
8117  lininds[i] = i;
8118  }
8119 
8120  /* add vars */
8121  SCIP_CALL( SCIPnlpiAddVars(nlpi, prob, nquadvars, lbs, ubs, NULL) );
8122 
8123  /* get nlrow info */
8124  nlrownquadelems = SCIPnlrowGetNQuadElems(consdata->nlrow);
8125  nlrowquadelems = SCIPnlrowGetQuadElems(consdata->nlrow);
8126 
8127 #ifndef NDEBUG
8128  {
8129  SCIP_VAR** nlrowquadvars;
8130 
8131  nlrowquadvars = SCIPnlrowGetQuadVars(consdata->nlrow);
8132  for( i = 0; i < nlrownquadelems; i++ )
8133  {
8134  assert(nlrowquadvars[nlrowquadelems[i].idx1] == consdata->quadvarterms[nlrowquadelems[i].idx1].var);
8135  assert(nlrowquadvars[nlrowquadelems[i].idx2] == consdata->quadvarterms[nlrowquadelems[i].idx2].var);
8136  }
8137  }
8138 #endif
8139 
8140  (void) SCIPsnprintf(probname, SCIP_MAXSTRLEN, "%s", SCIPconsGetName(cons));
8141 
8142  switch( method )
8143  {
8144  case 'a':
8145  /* add constraint */
8146  if( consdata->isconvex )
8147  {
8148  SCIP_CALL( SCIPnlpiAddConstraints(nlpi, prob, 1, NULL, &nlpiside, &nquadvars, &lininds, &lincoefs,
8149  &nlrownquadelems, &nlrowquadelems, NULL, NULL, NULL) );
8150  }
8151  else
8152  {
8153  SCIP_CALL( SCIPnlpiAddConstraints(nlpi, prob, 1, &nlpiside, NULL, &nquadvars, &lininds, &lincoefs,
8154  &nlrownquadelems, &nlrowquadelems, NULL, NULL, NULL) );
8155  }
8156  break;
8157 
8158  case 'm':
8159  /* add objective */
8160  if( consdata->isconvex )
8161  {
8162  SCIP_CALL( SCIPnlpiSetObjective(nlpi, prob, nquadvars, lininds, lincoefs,
8163  nlrownquadelems, nlrowquadelems, NULL, NULL, 0.0) );
8164  }
8165  else
8166  {
8167  /* NLPI assumes minimization: change signs */
8168  for( i = 0; i < nquadvars; i++ )
8169  lincoefs[i] *= -1;
8170 
8171  /* WARNING: this pointer is not ours, information should be restored! */
8172  for( i = 0; i < nlrownquadelems; i++ )
8173  nlrowquadelems->coef *= -1;
8174 
8175  SCIP_CALL( SCIPnlpiSetObjective(nlpi, prob, nquadvars, lininds, lincoefs,
8176  nlrownquadelems, nlrowquadelems, NULL, NULL, 0.0) );
8177 
8178  /* WARNING: restore information! */
8179  for( i = 0; i < nlrownquadelems; i++ )
8180  nlrowquadelems->coef *= -1;
8181  }
8182  break;
8183 
8184  default:
8185  SCIPerrorMessage("undefined method for computing interior point: %c\n", method);
8186  return SCIP_INVALIDDATA;
8187  }
8188 
8189  /* set NLP tolerances; we don't really need an optimal solution to this NLP */
8190  SCIP_CALL( SCIPnlpiSetRealPar(nlpi, prob, SCIP_NLPPAR_FEASTOL, SCIPfeastol(scip)) ); /*lint !e666*/
8191  SCIP_CALL( SCIPnlpiSetRealPar(nlpi, prob, SCIP_NLPPAR_RELOBJTOL, MAX(SCIPfeastol(scip), SCIPdualfeastol(scip))) ); /*lint !e666*/
8192 
8193  /* solve NLP problem */
8194  SCIP_CALL( SCIPnlpiSolve(nlpi, prob) );
8195 
8196  /* check termination status */
8197  if( SCIPnlpiGetTermstat(nlpi, prob) != SCIP_NLPTERMSTAT_OKAY )
8198  {
8199  SCIPdebugMsg(scip, "cons <%s>: NLP Solver termination status not okay: %d\n",
8200  SCIPconsGetName(cons), SCIPnlpiGetTermstat(nlpi, prob));
8201  *success = FALSE;
8202  goto TERMINATE;
8203  }
8204 
8205  /* check solution status */
8206  switch( SCIPnlpiGetSolstat(nlpi, prob) )
8207  {
8211  /* fallthrough */
8212  SCIPdebugMsg(scip, "cons <%s>: found an interior point. solution status: %d, termination status: %d\n",
8213  SCIPconsGetName(cons), SCIPnlpiGetSolstat(nlpi, prob), SCIPnlpiGetTermstat(nlpi, prob));
8214  break;
8215 
8219  /* fallthrough */
8220  /* TODO: we could still use the point, and let evaluateGauge decide whether the point is interior or not */
8221  SCIPdebugMsg(scip, "cons <%s>: failed to find an interior point. solution status: %d, termination status: %d\n",
8222  SCIPconsGetName(cons), SCIPnlpiGetSolstat(nlpi, prob), SCIPnlpiGetTermstat(nlpi, prob));
8223  goto TERMINATE;
8224 
8226  default:
8227  /* fallthrough */
8228  SCIPerrorMessage("cons <%s>: undefined behaviour of NLP Solver. solution status: %d, termination status: %d\n",
8229  SCIPconsGetName(cons), SCIPnlpiGetSolstat(nlpi, prob), SCIPnlpiGetTermstat(nlpi, prob));
8230  SCIPABORT();
8231  goto TERMINATE; /*lint !e527*/
8232  }
8233 
8234  /* fetch solution
8235  * note: nlpiGetSolution (at least for IPOPT) makes interiorpoint point to the internal solution stored in the
8236  * nlpi problem data structure; we need to copy it here because it will be destroyed once the problem is free'd
8237  */
8238  SCIP_CALL( SCIPnlpiGetSolution(nlpi, prob, &interiorpoint, NULL, NULL, NULL, NULL) );
8239 
8240  SCIP_CALL( SCIPallocBlockMemoryArray(scip, &(consdata->interiorpoint), nquadvars) );
8241 
8242  for( i = 0; i < nquadvars; i++ )
8243  {
8244  if( SCIPisFeasZero(scip, interiorpoint[i]) )
8245  consdata->interiorpoint[i] = 0.0;
8246  else
8247  consdata->interiorpoint[i] = interiorpoint[i];
8248  }
8249 
8250  *success = TRUE;
8251 
8252 TERMINATE:
8253 
8254 #ifdef SCIP_DEBUG_INT
8255  printf("Computation of interior point for cons <%s>:\n", SCIPconsGetName(cons));
8256  printf(" - has %d linear variables\n", consdata->nlinvars);
8257  if( consdata->isconvex )
8258  {
8259  printf(" - is convex. rhs: %g maximum activity of linear variables: %g\n", consdata->rhs, consdata->rhs - nlpiside);
8260  printf(" - searched for point whose quadratic part is <= %g\n", nlpiside);
8261  }
8262  else
8263  {
8264  printf(" - is concave. lhs: %g minimum activity of linear variables: %g\n", consdata->lhs, consdata->lhs - nlpiside);
8265  printf(" - searched for point whose quadratic part is >= %g\n", nlpiside);
8266  }
8267 
8268  if( *success )
8269  {
8270  if( prob == NULL )
8271  {
8272  printf("Computation successful, 0 is interior point.\n");
8273  for( i = 0; i < nquadvars; i++ )
8274  {
8275  assert(consdata->interiorpoint[i] == 0.0);
8276  }
8277  }
8278  else
8279  {
8280  printf("Computation successful, NLP soltat: %d, termstat: %d\nPoint found:\n",
8281  SCIPnlpiGetSolstat(nlpi, prob), SCIPnlpiGetTermstat(nlpi, prob));
8282  for( i = 0; i < nquadvars; i++ )
8283  {
8284  printf("%s = %g\n", SCIPvarGetName(consdata->quadvarterms[i].var), consdata->interiorpoint[i]);
8285  }
8286  }
8287  }
8288  else
8289  {
8290  printf("Computation failed. NLP soltat: %d, termstat: %d\n",
8291  SCIPnlpiGetSolstat(nlpi, prob), SCIPnlpiGetTermstat(nlpi, prob));
8292  printf("run with SCIP_DEBUG for more info\n");
8293  SCIP_CALL( SCIPprintCons(scip, cons, NULL) );
8294  SCIPinfoMessage(scip, NULL, ";\n");
8295  /* FIXME: instance camshape100 says that there is no interior point (interior empty)
8296  * is there something intelligent that can be said?
8297  */
8298  }
8299 #endif
8300 
8301  /* free memory */
8302  SCIPfreeBufferArrayNull(scip, &lbs);
8303  SCIPfreeBufferArrayNull(scip, &ubs);
8304  SCIPfreeBufferArrayNull(scip, &lininds);
8305  SCIPfreeBufferArrayNull(scip, &lincoefs);
8306 
8307  if( prob != NULL )
8308  {
8309  SCIP_CALL( SCIPnlpiFreeProblem(nlpi, &prob) );
8310  }
8311 
8312  return SCIP_OKAY;
8313 }
8314 
8315 /** compute gauge function of the set \f$S - s_0\f$ where \f$ S = \{ x : f(x) \le c \}\f$ and \f$ s_0 \in \mathring S\f$.
8316  *
8317  * Here, \f$ f(x) \f$ is a purely quadratic (i.e, all \f$x\f$ variables appear in a bilinear or quadratic term).
8318  * Explicitly, \f$ f(x) = \pm x^T A x \pm b^T x \f$ depending whether \f$A\f$
8319  * is positive semidefinite (+) or negative semidefinite (-).
8320  * The constant \f$c\f$ is rhs - maximum activity of the purely linear part of the constraint
8321  * if \f$A \succeq 0\f$ and minimum activity - lhs if \f$A \preceq 0\f$.
8322  * This is computed only at INITSOL.
8323  *
8324  * The method does:
8325  * 1. compute interior point
8326  * 2. compute gauge function
8327  */
8328 static
8330  SCIP* scip, /**< SCIP data structure */
8331  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
8332  SCIP_CONS* cons /**< constraint */
8333  )
8334 {
8335  SCIP_CONSHDLRDATA* conshdlrdata;
8336  SCIP_CONSDATA* consdata;
8337  SCIP_QUADVARTERM* quadvarterm;
8338  SCIP_BILINTERM* bilinterm;
8339  SCIP_Bool success;
8340  SCIP_Bool convex;
8341  int i;
8342  int j;
8343 
8344  assert(scip != NULL);
8345  assert(conshdlr != NULL);
8346  assert(cons != NULL);
8347 
8348  consdata = SCIPconsGetData(cons);
8349  assert(consdata != NULL);
8350 
8351  conshdlrdata = SCIPconshdlrGetData(conshdlr);
8352  assert(conshdlrdata != NULL);
8353  assert(conshdlrdata->gaugecuts);
8354 
8355  /* function has to be convex with finite rhs or concave with finite lhs */
8356  convex = consdata->isconvex && !SCIPisInfinity(scip, consdata->rhs);
8357  assert(convex || (consdata->isconcave && !SCIPisInfinity(scip, -consdata->lhs)));
8358 
8359  SCIPdebugMsg(scip, "cons %s: is %s\n", SCIPconsGetName(cons), convex ? "convex" : "concave");
8360 
8361  /* 1. */
8362  SCIP_CALL( computeInteriorPoint(scip, cons, conshdlrdata->interiorcomputation, &success) );
8363 
8364  /* if success, compute gaugecoefs (b_gauge) and gaugeconst (c_gauge) */
8365  if( !success )
8366  {
8367  SCIPdebugMsg(scip, "failed to compute gauge function\n");
8368  consdata->isgaugeavailable = FALSE;
8369  return SCIP_OKAY;
8370  }
8371 
8372  /* 2.
8373  * we are going to evaluate the function at interiorpoint; so, we need to compute interiorpoint^T A interiorpoint;
8374  * therefore, we need a mechanism that for a given variable, it returns its interior point value
8375  * fortunately, sepabilinvar2pos in consdata gives us all the information that we need
8376  */
8377 
8378  SCIP_CALL( SCIPallocClearBlockMemoryArray(scip, &(consdata->gaugecoefs), consdata->nquadvars) );
8379 
8380  /* compute value of quadratic part at interior point, build map and compute gaugeconst (c_gauge) */
8381  consdata->interiorpointval = 0;
8382  consdata->gaugeconst = 0;
8383  for( i = 0; i < consdata->nquadvars; i++ )
8384  {
8385  SCIP_Real val;
8386  SCIP_Real val2;
8387 
8388  val = consdata->interiorpoint[i];
8389  quadvarterm = &consdata->quadvarterms[i];
8390 
8391  consdata->interiorpointval += (quadvarterm->lincoef + quadvarterm->sqrcoef * val) * val;
8392  consdata->gaugeconst += quadvarterm->sqrcoef * val * val;
8393 
8394  for( j = 0; j < quadvarterm->nadjbilin; ++j )
8395  {
8396  int bilintermidx;
8397 
8398  bilintermidx = quadvarterm->adjbilin[j];
8399  bilinterm = &consdata->bilinterms[bilintermidx];
8400 
8401  if( bilinterm->var1 != quadvarterm->var )
8402  continue;
8403 
8404  /* the index of the variable associated with var2 in bilinterm should be given by sepabilinvar2pos */
8405  assert(consdata->sepabilinvar2pos != NULL); /* this should have been computed in INITSOL */
8406  assert(consdata->quadvarterms[consdata->sepabilinvar2pos[bilintermidx]].var == bilinterm->var2);
8407 
8408  val2 = consdata->interiorpoint[consdata->sepabilinvar2pos[bilintermidx]];
8409 
8410  consdata->interiorpointval += bilinterm->coef * val * val2;
8411  consdata->gaugeconst += bilinterm->coef * val * val2;
8412  }
8413  }
8414 
8415  /* compute gaugecoefs (b_gauge = b + 2 * A * interiorpoint) */
8416  for( i = 0; i < consdata->nquadvars; i++ )
8417  {
8418  quadvarterm = &consdata->quadvarterms[i];
8419  consdata->gaugecoefs[i] += quadvarterm->lincoef + 2.0 * quadvarterm->sqrcoef * consdata->interiorpoint[i];
8420 
8421  for( j = 0; j < quadvarterm->nadjbilin; j++ )
8422  {
8423  int varpos;
8424  int bilintermidx;
8425 
8426  bilintermidx = quadvarterm->adjbilin[j];
8427  bilinterm = &consdata->bilinterms[bilintermidx];
8428 
8429  if( bilinterm->var1 == quadvarterm->var )
8430  {
8431  varpos = consdata->sepabilinvar2pos[bilintermidx];
8432 
8433  /* the index of the variable associated with var2 in bilinterm should be given by sepabilinvar2pos */
8434  assert(consdata->quadvarterms[varpos].var == bilinterm->var2);
8435 
8436  consdata->gaugecoefs[i] += bilinterm->coef * consdata->interiorpoint[varpos];
8437  consdata->gaugecoefs[varpos] += bilinterm->coef * consdata->interiorpoint[i];
8438  }
8439  }
8440  }
8441 
8442 #ifdef SCIP_DEBUG_INT
8443  printf("quadratic part at interior point: %g\n", consdata->interiorpointval);
8444 
8445  for( j = 0; j < consdata->nquadvars; j++ )
8446  {
8447  printf("b_gauge[%s] = %g\n", SCIPvarGetName(consdata->quadvarterms[j].var), consdata->gaugecoefs[j]);
8448  }
8449  printf("c_gauge = %g\n", consdata->gaugeconst);
8450 #endif
8451 
8452  SCIPdebugMsg(scip, "gauge function computed successfully\n");
8453  consdata->isgaugeavailable = TRUE;
8454 
8455  return SCIP_OKAY;
8456 }
8457 
8458 /** evaluates gauge function of the set \f$S - s_0\f$ where \f$ S = \{ x : f(x) \le c \}\f$ and \f$ s_0 \in \mathring S\f$.
8459  *
8460  * \f$ S = \{ x : f(x) \le c \}\f$ at \f$sol - s_0\f$;
8461  * see computeGauge() for more details
8462  *
8463  * @todo Think about if user should tell that function is convex or ...
8464  */
8465 static
8467  SCIP* scip, /**< SCIP data structure */
8468  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
8469  SCIP_CONS* cons, /**< constraint */
8470  SCIP_SOL* refsol, /**< reference point where to generate cut, or NULL if sol should be used */
8471  SCIP_Real* gaugeval, /**< buffer to store the value of the gauge function */
8472  SCIP_Bool* success /**< buffer to store if evaluation was successful */
8473  )
8474 {
8475  SCIP_CONSDATA* consdata;
8476  SCIP_Real side;
8477  SCIP_Real aterm;
8478  SCIP_Real bterm;
8479  SCIP_Real cterm;
8480  SCIP_Bool convex;
8481  int i;
8482 
8483  assert(scip != NULL);
8484  assert(conshdlr != NULL);
8485  assert(cons != NULL);
8486 
8487  consdata = SCIPconsGetData(cons);
8488  assert(consdata != NULL);
8489  assert(consdata->isgaugeavailable);
8490 
8491  *success = FALSE;
8492 
8493  convex = consdata->isconvex && !SCIPisInfinity(scip, consdata->rhs);
8494 
8495  SCIPdebugMsg(scip, "cons %s: is %s\n", SCIPconsGetName(cons), convex ? "convex" : "concave");
8496 
8497  /* evaluate gauge function at x0 = (refsol - interior point)
8498  *
8499  * compute aterm = side - function(interior point)
8500  */
8501  if( convex )
8502  {
8503  side = consdata->rhs;
8504  for( i = 0; i < consdata->nlinvars; i++ )
8505  side -= SCIPgetSolVal(scip, refsol, consdata->linvars[i]) * consdata->lincoefs[i];
8506 
8507  aterm = side - consdata->interiorpointval;
8508 
8509  /* it can happen that the interior point is not really interior, since we are not so strict at the moment of
8510  * computing the interior point, which makes sense in the case that the constraint is quadratic <= linear expr,
8511  * since we compute a point in quadratic <= min linear expr and it might be that this set consists of a single
8512  * point which will not be interior. furthermore, if this set is empty, we could just take any point and it could
8513  * happen that for some value of linear expr, the point is actually interior, but for many it could not be.
8514  * also, if min linear expr = -infinity, we might have computed an interior point using some finite value.
8515  * the point will not be an interior point, if and only if aterm is negative.
8516  */
8517 #ifdef SCIP_DEBUG_GAUGE
8518  if( SCIPisLE(scip, aterm, 0.0) )
8519  {
8520  printf("For current level, there is no interior point. ");
8521  printf("rhs: %g level: %.15g interiorpointval: %.15g\n", consdata->rhs, side, consdata->interiorpointval);
8522  if( consdata->nlinvars == 1 )
8523  {
8524  SCIP_VAR* var;
8525 
8526  var = consdata->linvars[0];
8527  printf("var <%s> = %g in [%.15g, %.15g] is linpart\n", SCIPvarGetName(var),
8528  SCIPgetSolVal(scip, refsol, var), SCIPvarGetLbLocal(var), SCIPvarGetUbLocal(var));
8529  }
8530  }
8531  else
8532  {
8533  printf("For current level, there is interior point. ");
8534  printf("rhs: %g level: %.15g interiorpointval: %.15g\n", consdata->rhs, side, consdata->interiorpointval);
8535  }
8536 #endif
8537  if( !SCIPisPositive(scip, aterm) )
8538  {
8539  *gaugeval = -1.0;
8540  return SCIP_OKAY;
8541  }
8542  }
8543  else
8544  {
8545  side = consdata->lhs;
8546  for( i = 0; i < consdata->nlinvars; i++ )
8547  side -= SCIPgetSolVal(scip, refsol, consdata->linvars[i]) * consdata->lincoefs[i];
8548 
8549  aterm = side - consdata->interiorpointval;
8550 
8551 #ifdef SCIP_DEBUG_GAUGE
8552  if( SCIPisGE(scip, aterm, 0.0) )
8553  {
8554  printf("For current level, there is no interior point. ");
8555  printf("lhs: %g level: %.15g interiorpointval: %.15g\n", consdata->lhs, side, consdata->interiorpointval);
8556  if( consdata->nlinvars == 1 )
8557  {
8558  SCIP_VAR* var;
8559 
8560  var = consdata->linvars[0];
8561  printf("var <%s> = %g in [%.15g, %.15g] is linpart\n", SCIPvarGetName(var),
8562  SCIPgetSolVal(scip, refsol, var), SCIPvarGetLbLocal(var), SCIPvarGetUbLocal(var));
8563  }
8564  }
8565  else
8566  {
8567  printf("For current level, there is interior point. ");
8568  printf("lhs: %g level: %.15g interiorpointval: %.15g\n", consdata->lhs, side, consdata->interiorpointval);
8569  }
8570 #endif
8571  if( !SCIPisNegative(scip, aterm) )
8572  {
8573  *gaugeval = -1.0;
8574  return SCIP_OKAY;
8575  }
8576  }
8577 
8578  /* compute bterm = b_gauge^T * refsol - f(interiorpoint) - c_gauge
8579  * compute cterm = f(refsol) - b_gauge^T * refsol + c_gauge */
8580  bterm = -consdata->interiorpointval - consdata->gaugeconst;
8581  cterm = consdata->gaugeconst;
8582  for( i = 0; i < consdata->nquadvars; i++ )
8583  {
8584  SCIP_Real val;
8585 
8586  val = SCIPgetSolVal(scip, refsol, consdata->quadvarterms[i].var);
8587  bterm += consdata->gaugecoefs[i] * val;
8588  cterm -= consdata->gaugecoefs[i] * val;
8589  cterm += (consdata->quadvarterms[i].lincoef + consdata->quadvarterms[i].sqrcoef * val) * val;
8590  }
8591 
8592  for( i = 0; i < consdata->nbilinterms; i++ )
8593  {
8594  SCIP_VAR* var1;
8595  SCIP_VAR* var2;
8596 
8597  var1 = consdata->bilinterms[i].var1;
8598  var2 = consdata->bilinterms[i].var2;
8599  cterm += consdata->bilinterms[i].coef * SCIPgetSolVal(scip, refsol, var1) * SCIPgetSolVal(scip, refsol, var2);
8600  }
8601 
8602  /* now compute gauge */
8603  if( convex && cterm < 0.0 )
8604  {
8605  assert(SCIPisZero(scip, cterm));
8606  cterm = 0.0;
8607  }
8608  else if( !convex && cterm > 0.0 )
8609  {
8610  assert(SCIPisZero(scip, cterm));
8611  cterm = 0.0;
8612  }
8613  assert(bterm*bterm + 4*aterm*cterm >= 0);
8614 
8615  if( convex )
8616  {
8617  *gaugeval = bterm + sqrt(bterm*bterm + 4 * aterm * cterm);
8618  *gaugeval = *gaugeval / (2 * aterm);
8619  }
8620  else
8621  {
8622  *gaugeval = bterm - sqrt(bterm*bterm + 4 * aterm * cterm);
8623  *gaugeval = *gaugeval / (2 * aterm);
8624  }
8625  assert(!SCIPisNegative(scip, *gaugeval));
8626  *success = TRUE;
8627 
8628 #ifdef SCIP_DEBUG_GAUGE
8629  printf("Gauge's aterm = %g, bterm = %g, cterm = %g\n", aterm, bterm, cterm);
8630 #endif
8631  return SCIP_OKAY;
8632 }
8633 
8634 /** compute projection of refsol onto feasible region of cons; stores the projection in ref
8635  *
8636  * This method solves
8637  * \f[
8638  * \min \{ ||x - \bar x||^2 : x^T A x + 2 b^T x \le c \}
8639  * \f]
8640  * where \f$ \bar x \f$ is refsol.
8641  * Note that \f$ \bar x \f$ is not feasible, so the optimal solution actually satisfies
8642  * \f[
8643  * \min \{ ||x - \bar x||^2 : x^T A x + 2 b^T x = c \}
8644  * \f]
8645  * Using the eigendecomposition \f$ A = P D P^T \f$, the change of variables \f$ y = P^T x
8646  * \f$ and the optimality conditions, this reduces to finding \f$ \rho \f$ such that
8647  * \f[
8648  * y(\rho) = (I + \rho D)^{-1} (\bar y - \rho \bar b)
8649  * \f]
8650  * makes the constraint active. In the previous formula, \f$ \bar y = P^T \bar x\f$ and \f$ \bar b = P^T b \f$. If \f$
8651  * D \neq 0 \f$, the function
8652  * \f[
8653  * \varphi(\rho) := y(\rho)^T D y(\rho) + 2 \bar b^T y(\rho) - c
8654  * \f]
8655  * is strictly convex. So this method actually computes the unique 0 of this function using Newton's method.
8656  */
8657 static
8659  SCIP* scip, /**< SCIP data structure */
8660  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
8661  SCIP_CONS* cons, /**< constraint */
8662  SCIP_SOL* refsol, /**< the given point to project, or NULL if LP solution should be used */
8663  SCIP_Real* ref /**< array to store reference point */
8664  )
8665 {
8666  SCIP_CONSDATA* consdata;
8667  SCIP_Real* pt; /* stores P^T */
8668  SCIP_Real* bp;
8669  SCIP_Real* D;
8670  SCIP_Real* y0_;
8671  SCIP_Real* yrho;
8672  SCIP_Real* yrhoprime;
8673  SCIP_Real c;
8674  SCIP_Real c1;
8675  SCIP_Real c2;
8676  SCIP_Real rho;
8677  SCIP_Real phirho;
8678  SCIP_Real phirhoprime;
8679  SCIP_Bool isconcave;
8680  int iter;
8681  int i;
8682  int j;
8683  int n;
8684 
8685  assert(scip != NULL);
8686  assert(conshdlr != NULL);
8687  assert(cons != NULL);
8688 
8689  consdata = SCIPconsGetData(cons);
8690  assert(consdata != NULL);
8691  assert(consdata->isedavailable);
8692 
8693  SCIPdebugMessage("computing projection\n");
8694 
8695  /* get the data we need */
8696  pt = consdata->eigenvectors;
8697  D = consdata->eigenvalues;
8698  n = consdata->nquadvars;
8699  bp = consdata->bp;
8700  c = consdata->rhs;
8701  c1 = 0;
8702  c2 = 0;
8703  for( i = 0; i < consdata->nlinvars; i++ )
8704  {
8705  c1 += consdata->lincoefs[i] * SCIPgetSolVal(scip, refsol, consdata->linvars[i]);
8706  c2 -= consdata->lincoefs[i] * consdata->lincoefs[i];
8707  }
8708  c2 /= 2.0;
8709 
8710  /* determine if convex or concave */
8711  isconcave = consdata->isconcave;
8712  assert((isconcave && !SCIPisInfinity(scip, -consdata->lhs)) || !SCIPisInfinity(scip, consdata->rhs));
8713 
8714  SCIP_CALL( SCIPallocClearBufferArray(scip, &y0_, n) );
8715  SCIP_CALL( SCIPallocBufferArray(scip, &yrho, n) );
8716  SCIP_CALL( SCIPallocBufferArray(scip, &yrhoprime, n) );
8717 
8718  /* change data if function is concave */
8719  if( isconcave )
8720  {
8721  c = -consdata->lhs;
8722  c1 = - c1;
8723  for( i = 0; i < n; i++ )
8724  {
8725  D[i] = -D[i];
8726  bp[i] = -bp[i];
8727  }
8728  }
8729 
8730  /* change coordinates: compute y(0) = x_0' * P */
8731  for( i = 0; i < n; i++ )
8732  for( j = 0; j < n; j++ )
8733  y0_[i] += SCIPgetSolVal(scip, refsol, consdata->quadvarterms[j].var) * pt[i*n + j];
8734 
8735 #ifdef DEBUG_PROJ
8736  /* debug output */
8737  printf("\nP^T:\n");
8738  for( i = 0; i < n; i++ )
8739  {
8740  for( j = 0; j < n; j++ )
8741  printf("%g ", pt[i*n + j]);
8742  printf("\n");
8743  }
8744  printf("x_0: ");
8745  for( i = 0; i < n; i++ )
8746  printf("%g ", SCIPgetSolVal(scip, refsol, consdata->quadvarterms[i].var));
8747  printf("\n");
8748  printf("P^T x_0: ");
8749  for( i = 0; i < n; i++ )
8750  printf("%g ", y0_[i]);
8751  printf("\n");
8752  printf("P^T b: ");
8753  for( i = 0; i < n; i++ )
8754  printf("%g ", bp[i]);
8755  printf("\n");
8756  printf("<d,linvars> = %g\n", c1);
8757  printf("-norm(d)^2/2 = %g\n", c2);
8758 #endif
8759 
8760  /* perform newton's method: rho^+ = rho - phi(rho)/phi'(rho) */
8761  rho = 0.0;
8762  phirho = c;
8763  phirhoprime = 1.0;
8764  for( iter = 0; iter < 9; iter++ )
8765  {
8766  assert(phirhoprime != 0.0);
8767  rho = rho - (phirho - c)/ phirhoprime;
8768 
8769  /* compute phi(rho) and phi'(rho):
8770  * note that formulas were deduced for constraints of the form x' A x + 2 b x, so we use b/2 in the formulas:
8771  * c1 = <lin_coefs, sol_lin_vars>
8772  * c2 = - norm(lin_coefs)^2/2
8773  * y(rho) = (I + rho * D)^-1 * (y(0) - rho * bp/2)
8774  * y'(rho) = -(I + rho * D)^-2 * (D y(0) + bp/2)
8775  * phi(rho) = <y(rho), D * y(rho) + pb> + c1 + c2*rho
8776  * phi'(rho) = <y'(rho), 2 * D * y(rho) + pb> + c2
8777  */
8778  phirho = 0.0;
8779  phirhoprime = 0.0;
8780  for( i = 0; i < n; i++ )
8781  {
8782  assert(1.0 + rho * D[i] != 0.0);
8783  yrho[i] = (y0_[i] - rho * bp[i]/2.0) / (1.0 + rho * D[i]);
8784  yrhoprime[i] = -(D[i] * y0_[i] + bp[i]/2.0) / ( (1.0 + rho * D[i])*(1.0 + rho * D[i]) );
8785  phirho += yrho[i] * (yrho[i] * D[i] + bp[i]);
8786  phirhoprime += yrhoprime[i] * (2 * D[i] * yrho[i] + bp[i]);
8787  }
8788  phirho += c2 * rho + c1;
8789  phirhoprime += c2;
8790 #ifdef DEBUG_PROJ
8791  printf("iteration %d: rho = %g, phirho = %g, phirho' = %g\n", iter, rho, phirho, phirhoprime);
8792 #endif
8793  }
8794 
8795  /* come back to the original coordinates: new ref point is P*yrho */
8796  for( i = 0; i < n; i++ )
8797  {
8798  ref[i] = 0.0;
8799 
8800  for( j = 0; j < n; j++ )
8801  ref[i] += pt[j*n + i] * yrho[j];
8802  }
8803 
8804  /* change data back if function is concave */
8805  if( isconcave )
8806  {
8807  for( i = 0; i < n; i++ )
8808  {
8809  D[i] = -D[i];
8810  bp[i] = -bp[i];
8811  }
8812  }
8813 
8814 #ifdef SCIP_DISABLED_CODE
8815  /* project onto bounds; this is important for some cut generation methods such as generateCutLTI */
8816  for( j = 0; j < consdata->nquadvars; ++j )
8817  {
8818  SCIP_Real lb;
8819  SCIP_Real ub;
8820  SCIP_VAR* var;
8821 
8822  var = consdata->quadvarterms[j].var;
8823  lb = SCIPvarGetLbLocal(var);
8824  ub = SCIPvarGetUbLocal(var);
8825  /* do not like variables at infinity */
8826  assert(!SCIPisInfinity(scip, lb));
8827  assert(!SCIPisInfinity(scip, -ub));
8828 
8829  ref[j] = MIN(ub, MAX(lb, ref[j])); /* project value into bounds */
8830  }
8831 #endif
8832 
8833 #ifdef DEBUG_PROJ
8834  printf("modified reference point by a projection:\n");
8835  for( j = 0; j < consdata->nquadvars; ++j )
8836  {
8837  printf("%s = %g\n", SCIPvarGetName(consdata->quadvarterms[j].var), ref[j]);
8838  }
8839 #endif
8840 
8841  SCIPfreeBufferArray(scip, &y0_);
8842  SCIPfreeBufferArray(scip, &yrho);
8843  SCIPfreeBufferArray(scip, &yrhoprime);
8844 
8845  return SCIP_OKAY;
8846 }
8847 
8848 /** compute reference point suggested by gauge function */
8849 static
8851  SCIP* scip, /**< SCIP data structure */
8852  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
8853  SCIP_CONS* cons, /**< constraint */
8854  SCIP_SOL* refsol, /**< reference point where to compute gauge, or NULL if LP solution should be used */
8855  SCIP_Real* ref, /**< array to store reference point */
8856  SCIP_Bool* success /**< buffer to store whether we succeeded computing reference point */
8857  )
8858 {
8859  SCIP_CONSDATA* consdata;
8860  SCIP_Real gaugeval;
8861  SCIP_Real intpoint;
8862  SCIP_Real lb;
8863  SCIP_Real ub;
8864  SCIP_VAR* var;
8865  int j;
8866 
8867  assert(scip != NULL);
8868  assert(conshdlr != NULL);
8869  assert(cons != NULL);
8870 
8871  consdata = SCIPconsGetData(cons);
8872  assert(consdata != NULL);
8873  assert(consdata->isgaugeavailable);
8874 
8875  SCIPdebugMsg(scip, "evaluating gauge\n");
8876  SCIP_CALL( evaluateGauge(scip, conshdlr, cons, refsol, &gaugeval, success) );
8877 
8878  if( !(*success) )
8879  {
8880 #ifdef SCIP_DEBUG_GAUGE
8881  printf("Couldn't evaluate gauge!\n");
8882 #endif
8883  return SCIP_OKAY;
8884  }
8885 
8886 #ifdef SCIP_DEBUG_GAUGE
8887  {
8888  SCIP_Real level;
8889 
8890  level = consdata->rhs;
8891  for( j = 0; j < consdata->nlinvars; j++ )
8892  level -= SCIPgetSolVal(scip, refsol, consdata->linvars[j]) * consdata->lincoefs[j];
8893 
8894  printf("Summary:\n");
8895  printf("For cons <%s>: gauge at level %g evaluated at (refsol - intpoint) is %.10f\n",
8896  SCIPconsGetName(cons), level, gaugeval);
8897  printf("refsol - intpoint:\n");
8898 
8899  for( j = 0; j < consdata->nquadvars; ++j )
8900  {
8901  SCIP_VAR* vvar;
8902  vvar = consdata->quadvarterms[j].var;
8903  printf("%s: % 20.15g - %g = %g\n", SCIPvarGetName(vvar), SCIPgetSolVal(scip, refsol, vvar),
8904  consdata->interiorpoint[j], SCIPgetSolVal(scip, refsol, vvar) - consdata->interiorpoint[j]);
8905  }
8906  if( SCIPisFeasLE(scip, gaugeval, 1.0) )
8907  printf("refsol is in the closure of the region (gaugeval <= 1), don't modify reference point\n");
8908  }
8909 #endif
8910 
8911  /* scale gauge value so that final point is close to the boundary, but not on the boundary (weakens the cut) */
8912  gaugeval *= GAUGESCALE;
8913 
8914  /* if the point is not sufficiently violated, we don't modify it */
8915  if( SCIPisFeasLE(scip, gaugeval, 1.0) )
8916  {
8917  *success = FALSE;
8918  return SCIP_OKAY;
8919  }
8920 
8921  /* set reference to (refsol - interior point)/gaugeval + interior point and project onto bounds this is important for
8922  * some cut generation methods such as generateCutLTI
8923  * @todo remove the projection onto the bounds; generateCutLTI shouldn't be called for convex constraints
8924  */
8925  for( j = 0; j < consdata->nquadvars; ++j )
8926  {
8927  var = consdata->quadvarterms[j].var;
8928  lb = SCIPvarGetLbLocal(var);
8929  ub = SCIPvarGetUbLocal(var);
8930  /* do not like variables at infinity */
8931  assert(!SCIPisInfinity(scip, lb));
8932  assert(!SCIPisInfinity(scip, -ub));
8933 
8934  intpoint = consdata->interiorpoint[j];
8935  ref[j] = (SCIPgetSolVal(scip, refsol, var) - intpoint) / gaugeval + intpoint;
8936  ref[j] = MIN(ub, MAX(lb, ref[j])); /* project value into bounds */
8937  }
8938 
8939 #ifdef SCIP_DEBUG_GAUGE
8940  printf("successful application of guage: %g\n", gaugeval);
8941  printf("modified reference point:\n");
8942  for( j = 0; j < consdata->nquadvars; ++j )
8943  {
8944  printf("%s = % 20.15g\n", SCIPvarGetName(consdata->quadvarterms[j].var), ref[j]);
8945  }
8946 #endif
8947 
8948  return SCIP_OKAY;
8949 }
8950 
8951 /** generates a cut based on linearization (if convex) or McCormick (if nonconvex) in a solution
8952  * @note mode indicates whether we should modify the point we want to cutoff (sol) via gauge or projection,
8953  * or if just normal linearization should be use, or the default way (whatever is specified via settings)
8954  */
8955 static
8957  SCIP* scip, /**< SCIP data structure */
8958  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
8959  SCIP_CONS* cons, /**< constraint */
8960  SCIP_SOL* sol, /**< solution where to generate cut, or NULL if LP solution should be used */
8961  SCIP_SOL* refsol, /**< reference point where to generate cut, or NULL if sol should be used */
8962  SCIP_SIDETYPE violside, /**< for which side a cut should be generated */
8963  SCIP_ROW** row, /**< storage for cut */
8964  SCIP_Real* efficacy, /**< buffer to store efficacy of row in reference solution, or NULL if not of interest */
8965  SCIP_Bool checkcurvmultivar, /**< are we allowed to check the curvature of a multivariate quadratic function, if not done yet */
8966  SCIP_Real minefficacy, /**< minimal required efficacy */
8967  char mode /**< mode of execution 'g'auge, 'p'rojection, 'l'inearization gradient, 'd'efault */
8968  )
8969 {
8970  SCIP_CONSHDLRDATA* conshdlrdata;
8971  SCIP_CONSDATA* consdata;
8972  SCIP_VAR* var;
8973  SCIP_Real lb;
8974  SCIP_Real ub;
8975  SCIP_Real* ref;
8976  SCIP_Bool success;
8977  int j;
8978 
8979  assert(scip != NULL);
8980  assert(conshdlr != NULL);
8981  assert(cons != NULL);
8982 
8983  consdata = SCIPconsGetData(cons);
8984  assert(consdata != NULL);
8985 
8986  conshdlrdata = SCIPconshdlrGetData(conshdlr);
8987  assert(conshdlrdata != NULL);
8988 
8989  if( refsol == NULL )
8990  refsol = sol;
8991 
8992  /* get reference point */
8993  SCIP_CALL( SCIPallocBufferArray(scip, &ref, consdata->nquadvars) );
8994  success = FALSE;
8995 
8996  if( mode == 'd')
8997  {
8998  if( (consdata->isconvex && violside == SCIP_SIDETYPE_RIGHT) ||
8999  (consdata->isconcave && violside == SCIP_SIDETYPE_LEFT) )
9000  {
9001  if( conshdlrdata->gaugecuts && consdata->isgaugeavailable )
9002  {
9003  SCIP_CALL( computeReferencePointGauge(scip, conshdlr, cons, refsol, ref, &success) );
9004  }
9005  else if( conshdlrdata->projectedcuts && consdata->isedavailable )
9006  {
9007  SCIPdebugMessage("use the projection of refsol onto the region defined by the constraint as reference point\n");
9008  SCIP_CALL( computeReferencePointProjection(scip, conshdlr, cons, refsol, ref) );
9009  success = TRUE;
9010  }
9011  }
9012 
9013  if( success )
9014  {
9015  SCIP_CALL( generateCut(scip, conshdlr, cons, ref, sol, violside, row, efficacy, checkcurvmultivar, minefficacy) );
9016 
9017  /* if cut fails, try again without modifying reference point */
9018  if( *row == NULL || (efficacy != NULL && !SCIPisGT(scip, *efficacy, minefficacy)) || !SCIPisCutApplicable(scip, *row) ) /*lint !e644 */
9019  {
9020  SCIPdebugMsg(scip, "%s cut fail, try without modifying\n", conshdlrdata->gaugecuts ? "gauge" : "projected");
9021  success = FALSE;
9022  }
9023  }
9024 
9025  /* note that this is not the same as calling this method with mode 'l', 'l' assume convex/concave function */
9026  if( !success )
9027  {
9028  for( j = 0; j < consdata->nquadvars; ++j )
9029  {
9030  var = consdata->quadvarterms[j].var;
9031  lb = SCIPvarGetLbLocal(var);
9032  ub = SCIPvarGetUbLocal(var);
9033  /* do not like variables at infinity */
9034  assert(!SCIPisInfinity(scip, lb));
9035  assert(!SCIPisInfinity(scip, -ub));
9036 
9037  ref[j] = SCIPgetSolVal(scip, refsol, var);
9038  ref[j] = MIN(ub, MAX(lb, ref[j])); /* project value into bounds */
9039  }
9040 
9041  SCIP_CALL( generateCut(scip, conshdlr, cons, ref, sol, violside, row, efficacy, checkcurvmultivar, minefficacy) );
9042  }
9043  }
9044  /* gauge cut */
9045  if( mode == 'g' )
9046  {
9047  assert((consdata->isconvex && violside == SCIP_SIDETYPE_RIGHT) || (consdata->isconcave && violside == SCIP_SIDETYPE_LEFT));
9048  if( conshdlrdata->gaugecuts && consdata->isgaugeavailable )
9049  {
9050  SCIP_CALL( computeReferencePointGauge(scip, conshdlr, cons, refsol, ref, &success) );
9051  }
9052  if( success )
9053  {
9054  SCIP_CALL( generateCut(scip, conshdlr, cons, ref, sol, violside, row, efficacy, checkcurvmultivar, minefficacy) );
9055  }
9056  }
9057  /* projection cut */
9058  if( mode == 'p' )
9059  {
9060  assert((consdata->isconvex && violside == SCIP_SIDETYPE_RIGHT) || (consdata->isconcave && violside == SCIP_SIDETYPE_LEFT));
9061  if( conshdlrdata->projectedcuts && consdata->isedavailable )
9062  {
9063  SCIP_CALL( computeReferencePointProjection(scip, conshdlr, cons, refsol, ref) );
9064  SCIP_CALL( generateCut(scip, conshdlr, cons, ref, sol, violside, row, efficacy, checkcurvmultivar, minefficacy) );
9065  }
9066  }
9067  /* gradient linearization cut at refsol */
9068  if( mode == 'l' )
9069  {
9070  assert((consdata->isconvex && violside == SCIP_SIDETYPE_RIGHT) || (consdata->isconcave && violside == SCIP_SIDETYPE_LEFT));
9071  for( j = 0; j < consdata->nquadvars; ++j )
9072  {
9073  var = consdata->quadvarterms[j].var;
9074  lb = SCIPvarGetLbLocal(var);
9075  ub = SCIPvarGetUbLocal(var);
9076  /* do not like variables at infinity */
9077  assert(!SCIPisInfinity(scip, lb));
9078  assert(!SCIPisInfinity(scip, -ub));
9079 
9080  ref[j] = SCIPgetSolVal(scip, refsol, var);
9081  ref[j] = MIN(ub, MAX(lb, ref[j])); /* project value into bounds */
9082  }
9083  SCIP_CALL( generateCut(scip, conshdlr, cons, ref, sol, violside, row, efficacy, checkcurvmultivar, minefficacy) );
9084  }
9085 
9086  SCIPfreeBufferArray(scip, &ref);
9087 
9088  return SCIP_OKAY;
9089 }
9090 
9091 /** tries to find a cut that intersects with an unbounded ray of the LP
9092  *
9093  * For convex functions, we do this by linearizing in the feasible solution of the LPI.
9094  * For nonconvex functions, we just call generateCutSol with the unbounded solution as reference point.
9095  */
9096 static
9098  SCIP* scip, /**< SCIP data structure */
9099  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
9100  SCIP_CONS* cons, /**< constraint */
9101  SCIP_SIDETYPE violside, /**< for which side a cut should be generated */
9102  SCIP_ROW** row, /**< storage for cut */
9103  SCIP_Real* rowrayprod, /**< buffer to store product of ray with row coefficients, or NULL if not of interest */
9104  SCIP_Bool checkcurvmultivar /**< are we allowed to check the curvature of a multivariate quadratic function, if not done yet */
9105  )
9106 {
9107  SCIP_CONSDATA* consdata;
9108  SCIP_BILINTERM* bilinterm;
9109  SCIP_VAR* var;
9110  SCIP_Real* ref;
9111  SCIP_Real matrixrayprod;
9112  SCIP_Real linrayprod;
9113  SCIP_Real quadrayprod;
9114  SCIP_Real rayval;
9115  int i;
9116  int j;
9117 
9118  assert(scip != NULL);
9119  assert(conshdlr != NULL);
9120  assert(cons != NULL);
9121  assert(row != NULL);
9123 
9124  consdata = SCIPconsGetData(cons);
9125  assert(consdata != NULL);
9126 
9127  *row = NULL;
9128 
9129  if( !SCIPhasPrimalRay(scip) )
9130  {
9131  SCIPdebugMsg(scip, "do not have primal ray, thus cannot resolve unboundedness\n");
9132  return SCIP_OKAY;
9133  }
9134 
9135  SCIP_CALL( checkCurvature(scip, cons, checkcurvmultivar) );
9136  if( (!consdata->isconvex && violside == SCIP_SIDETYPE_RIGHT) ||
9137  (!consdata->isconcave && violside == SCIP_SIDETYPE_LEFT) )
9138  {
9139  /* if not convex, just call generateCut and hope it's getting something useful */
9140  SCIP_CALL( generateCutSol(scip, conshdlr, cons, NULL, NULL, violside, row, NULL, FALSE, -SCIPinfinity(scip), 'd') );
9141 
9142  /* compute product of cut coefficients with ray, if required */
9143  if( *row != NULL && rowrayprod != NULL )
9144  {
9145  *rowrayprod = 0.0;
9146  for( i = 0; i < SCIProwGetNNonz(*row); ++i )
9147  {
9148  assert(SCIProwGetCols(*row)[i] != NULL);
9149  var = SCIPcolGetVar(SCIProwGetCols(*row)[i]);
9150  assert(var != NULL);
9151 
9152  *rowrayprod += SCIProwGetVals(*row)[i] * SCIPgetPrimalRayVal(scip, var);
9153  }
9154  }
9155 
9156  return SCIP_OKAY;
9157  }
9158 
9159  /* we seek for a linearization of the quadratic function such that it intersects with the unbounded ray
9160  * that is, we need a reference point ref such that for the gradient g of xAx+bx in ref, we have
9161  * <g, ray> > 0.0 if rhs is finite and <g, ray> < 0.0 if lhs is finite
9162  * Since g = 2*A*ref + b, we have <g, ray> = <2*A*ref + b, ray> = <ref, 2*A*ray> + <b,ray>
9163  * initially, for finite rhs, we set ref_i = 1.0 if (A*ray)_i > 0.0 and ref_i = -1.0 if (A*ray)_i < 0.0 (for finite lhs analog)
9164  * <ref, 2*A*ray> + <b,ray> is sufficiently larger 0.0, we call generateCut for this point, otherwise, we scale up ref
9165  */
9166 
9167  quadrayprod = 0.0; /* <ref, 2*A*ray> */
9168  linrayprod = 0.0; /* <b, ray> */
9169  SCIP_CALL( SCIPallocBufferArray(scip, &ref, consdata->nquadvars) );
9170  for( i = 0; i < consdata->nquadvars; ++i )
9171  {
9172  var = consdata->quadvarterms[i].var;
9173  rayval = SCIPgetPrimalRayVal(scip, var);
9174 
9175  /* compute i-th entry of (2*A*ray) */
9176  matrixrayprod = 2.0 * consdata->quadvarterms[i].sqrcoef * rayval;
9177  for( j = 0; j < consdata->quadvarterms[i].nadjbilin; ++j )
9178  {
9179  bilinterm = &consdata->bilinterms[consdata->quadvarterms[i].adjbilin[j]];
9180  matrixrayprod += bilinterm->coef * SCIPgetPrimalRayVal(scip, bilinterm->var1 == var ? bilinterm->var2 : bilinterm->var1);
9181  }
9182 
9183  if( SCIPisPositive(scip, matrixrayprod) )
9184  ref[i] = (violside == SCIP_SIDETYPE_RIGHT ? 1.0 : -1.0);
9185  else if( SCIPisNegative(scip, matrixrayprod) )
9186  ref[i] = (violside == SCIP_SIDETYPE_RIGHT ? -1.0 : 1.0);
9187  else
9188  ref[i] = 0.0;
9189 
9190  quadrayprod += matrixrayprod * ref[i];
9191  linrayprod += consdata->quadvarterms[i].lincoef * rayval;
9192  }
9193  assert((violside == SCIP_SIDETYPE_RIGHT && quadrayprod >= 0.0) || (violside == SCIP_SIDETYPE_LEFT && quadrayprod <= 0.0));
9194 
9195  if( SCIPisZero(scip, quadrayprod) )
9196  {
9197  SCIPdebugMsg(scip, "ray is zero along cons <%s>\n", SCIPconsGetName(cons));
9198  SCIPfreeBufferArray(scip, &ref);
9199  return SCIP_OKAY;
9200  }
9201 
9202  /* add linear part to linrayprod */
9203  for( i = 0; i < consdata->nlinvars; ++i )
9204  linrayprod += consdata->lincoefs[i] * SCIPgetPrimalRayVal(scip, consdata->linvars[i]);
9205 
9206  SCIPdebugMsg(scip, "initially have <b,ray> = %g and <ref, 2*A*ref> = %g\n", linrayprod, quadrayprod);
9207 
9208  /* we scale the refpoint up, such that <ref, 2*A*ray> >= -2*<b, ray> (rhs finite) or <ref, 2*A*ray> <= -2*<b, ray> (lhs finite), if <b,ray> is not zero
9209  * if <b,ray> is zero, then we scale refpoint up if |<ref, 2*A*ray>| < 1.0
9210  */
9211  if( (!SCIPisZero(scip, linrayprod) && violside == SCIP_SIDETYPE_RIGHT && quadrayprod < -2*linrayprod) ||
9212  ( !SCIPisZero(scip, linrayprod) && violside == SCIP_SIDETYPE_LEFT && quadrayprod > -2*linrayprod) ||
9213  (SCIPisZero(scip, linrayprod) && REALABS(quadrayprod) < 1.0) )
9214  {
9215  SCIP_Real scale;
9216 
9217  if( !SCIPisZero(scip, linrayprod) )
9218  scale = 2*REALABS(linrayprod/quadrayprod); /*lint !e795 */
9219  else
9220  scale = 1.0/REALABS(quadrayprod);
9221 
9222  SCIPdebugMsg(scip, "scale refpoint by %g\n", scale);
9223  for( i = 0; i < consdata->nquadvars; ++i )
9224  ref[i] *= scale;
9225  quadrayprod *= scale;
9226  }
9227 
9228  if( rowrayprod != NULL )
9229  *rowrayprod = quadrayprod + linrayprod;
9230 
9231  SCIPdebugMsg(scip, "calling generateCut, expecting ray product %g\n", quadrayprod + linrayprod);
9232  SCIP_CALL( generateCut(scip, conshdlr, cons, ref, NULL, violside, row, NULL, FALSE, -SCIPinfinity(scip)) );
9233 
9234  SCIPfreeBufferArray(scip, &ref);
9235 
9236  return SCIP_OKAY;
9237 }
9238 
9239 /** processes a cut for constraint cons, i.e., checks numerics and possibly adds cut to sepastore */
9240 static
9242  SCIP* scip, /**< SCIP data structure */
9243  SCIP_ROW** row, /**< cut to process */
9244  SCIP_CONSHDLR* conshdlr, /**< quadratic constraints handler */
9245  SCIP_CONS* cons, /**< constraint */
9246  SCIP_Real efficacy, /**< efficacy of row in reference solution */
9247  SCIP_Real minefficacy, /**< minimal efficacy */
9248  SCIP_Bool inenforcement, /**< whether we are in constraint enforcement */
9249  SCIP_Real* bestefficacy, /**< buffer to store best efficacy of a cut that was added to the LP, if found; or NULL if not of interest */
9250  SCIP_RESULT* result /**< result of separation */
9251  )
9252 {
9253  SCIP_CONSDATA* consdata;
9254  SCIP_CONSHDLRDATA* conshdlrdata;
9255 
9256  assert(scip != NULL);
9257  assert(row != NULL);
9258  assert(conshdlr != NULL);
9259  assert(result != NULL);
9260  assert(cons != NULL);
9261 
9262  /* no cut to process */
9263  if( *row == NULL )
9264  return SCIP_OKAY;
9265 
9266  conshdlrdata = SCIPconshdlrGetData(conshdlr);
9267  assert(conshdlrdata != NULL);
9268 
9269  consdata = SCIPconsGetData(cons);
9270  assert(consdata != NULL);
9271 
9272  if( SCIPisGT(scip, efficacy, minefficacy) && SCIPisCutApplicable(scip, *row) ) /*lint !e644 */
9273  {
9274  SCIP_Bool infeasible;
9275 
9276  /* cut cuts off solution */
9277  SCIP_CALL( SCIPaddRow(scip, *row, FALSE /* forcecut */, &infeasible) );
9278  if( infeasible )
9279  {
9280  SCIPdebugMessage("cut for constraint <%s> is infeasible -> cutoff.\n", SCIPconsGetName(cons));
9281  *result = SCIP_CUTOFF;
9282  }
9283  else
9284  {
9285  SCIPdebugMessage("add cut with efficacy %g for constraint <%s> violated by %g\n", efficacy,
9286  SCIPconsGetName(cons), consdata->lhsviol+consdata->rhsviol);
9287  *result = SCIP_SEPARATED;
9288  }
9289  SCIP_CALL( SCIPresetConsAge(scip, cons) );
9290 
9291  /* mark row as not removable from LP for current node, if in enforcement */
9292  if( inenforcement && !conshdlrdata->enfocutsremovable )
9293  SCIPmarkRowNotRemovableLocal(scip, *row);
9294  }
9295  if( bestefficacy != NULL && efficacy > *bestefficacy )
9296  *bestefficacy = efficacy;
9297 
9298  SCIP_CALL( SCIPreleaseRow (scip, row) );
9299  return SCIP_OKAY;
9300 }
9301 
9302 /** tries to separate solution or LP solution by a linear cut
9303  *
9304  * assumes that constraint violations have been computed
9305  */
9306 static
9308  SCIP* scip, /**< SCIP data structure */
9309  SCIP_CONSHDLR* conshdlr, /**< quadratic constraints handler */
9310  SCIP_CONS** conss, /**< constraints */
9311  int nconss, /**< number of constraints */
9312  int nusefulconss, /**< number of constraints that seem to be useful */
9313  SCIP_SOL* sol, /**< solution to separate, or NULL if LP solution should be used */
9314  SCIP_Real minefficacy, /**< minimal efficacy of a cut if it should be added to the LP */
9315  SCIP_Bool inenforcement, /**< whether we are in constraint enforcement */
9316  SCIP_RESULT* result, /**< result of separation */
9317  SCIP_Real* bestefficacy /**< buffer to store best efficacy of a cut that was added to the LP, if found; or NULL if not of interest */
9318  )
9319 {
9320  SCIP_CONSHDLRDATA* conshdlrdata;
9321  SCIP_CONSDATA* consdata;
9322  SCIP_Real efficacy;
9323  SCIP_SIDETYPE violside;
9324  int c;
9325  SCIP_ROW* row;
9326 
9327  assert(scip != NULL);
9328  assert(conshdlr != NULL);
9329  assert(conss != NULL || nconss == 0);
9330  assert(nusefulconss <= nconss);
9331  assert(result != NULL);
9332 
9333  *result = SCIP_FEASIBLE;
9334 
9335  conshdlrdata = SCIPconshdlrGetData(conshdlr);
9336  assert(conshdlrdata != NULL);
9337 
9338  if( bestefficacy != NULL )
9339  *bestefficacy = 0.0;
9340 
9341  row = NULL;
9342  /* loop over both sides of each constraint */
9343  for( c = 0, violside = SCIP_SIDETYPE_LEFT; c < nconss; c = (violside == SCIP_SIDETYPE_LEFT ? c : c+1), violside = (violside == SCIP_SIDETYPE_LEFT ? SCIP_SIDETYPE_RIGHT : SCIP_SIDETYPE_LEFT) )
9344  {
9345  assert(conss != NULL);
9346  consdata = SCIPconsGetData(conss[c]);
9347  assert(consdata != NULL);
9348 
9349  /* if side not violated, then go on */
9350  if( !SCIPisGT(scip, violside == SCIP_SIDETYPE_LEFT ? consdata->lhsviol : consdata->rhsviol, SCIPfeastol(scip)) )
9351  continue;
9352 
9353  /* we are not feasible anymore */
9354  if( *result == SCIP_FEASIBLE )
9355  *result = SCIP_DIDNOTFIND;
9356 
9357  /* generate cut */
9358  if( sol == NULL && SCIPgetLPSolstat(scip) == SCIP_LPSOLSTAT_UNBOUNDEDRAY )
9359  {
9360  /* if the LP is unbounded, then we need a cut that cuts into the direction of a hopefully existing primal ray
9361  * that is, assume a ray r is given such that p + t*r is feasible for the LP for all t >= t_0 and some p
9362  * given a cut lhs <= <c,x> <= rhs, we check whether it imposes an upper bound on t and thus bounds the ray
9363  * this is given if rhs < infinity and <c,r> > 0, since we then enforce <c,p+t*r> = <c,p> + t<c,r> <= rhs, i.e., t <= (rhs - <c,p>)/<c,r>
9364  * similar, lhs > -infinity and <c,r> < 0 is good
9365  */
9366  SCIP_Real rayprod;
9367 
9368  rayprod = 0.0; /* for compiler */
9369  SCIP_CALL( generateCutUnboundedLP(scip, conshdlr, conss[c], violside, &row, &rayprod, conshdlrdata->checkcurvature) );
9370 
9371  if( row != NULL )
9372  {
9373  if( !SCIPisInfinity(scip, SCIProwGetRhs(row)) && SCIPisPositive(scip, rayprod) )
9374  efficacy = rayprod;
9375  else if( !SCIPisInfinity(scip, -SCIProwGetLhs(row)) && SCIPisNegative(scip, rayprod) )
9376  efficacy = -rayprod;
9377  else
9378  efficacy = 0.0;
9379 
9380  SCIP_CALL( processCut(scip, &row, conshdlr, conss[c], efficacy, minefficacy, inenforcement, bestefficacy, result) );
9381  }
9382  continue;
9383  }
9384  else
9385  {
9386  SCIP_CALL( generateCutSol(scip, conshdlr, conss[c], sol, NULL, violside, &row, &efficacy,
9387  conshdlrdata->checkcurvature, minefficacy, 'd') );
9388 
9389  SCIP_CALL( processCut(scip, &row, conshdlr, conss[c], efficacy, minefficacy, inenforcement, bestefficacy, result) );
9390  }
9391 
9392  if( *result == SCIP_CUTOFF )
9393  break;
9394 
9395  /* enforce only useful constraints
9396  * others are only checked and enforced if we are still feasible or have not found a separating cut yet
9397  */
9398  if( c >= nusefulconss && *result == SCIP_SEPARATED )
9399  break;
9400  }
9401 
9402  return SCIP_OKAY;
9403 }
9404 
9405 /** adds linearizations cuts for convex constraints w.r.t. a given reference point to cutpool and sepastore
9406  *
9407  * - If separatedlpsol is not NULL, then a cut that separates the LP solution is added to the sepastore and is forced to enter the LP.
9408  * - If separatedlpsol is not NULL, but cut does not separate the LP solution, then it is added to the cutpool only.
9409  * - If separatedlpsol is NULL, then cut is added to cutpool only.
9410  */
9411 static
9413  SCIP* scip, /**< SCIP data structure */
9414  SCIP_CONSHDLR* conshdlr, /**< quadratic constraints handler */
9415  SCIP_CONS** conss, /**< constraints */
9416  int nconss, /**< number of constraints */
9417  SCIP_SOL* ref, /**< reference point where to linearize, or NULL for LP solution */
9418  SCIP_Bool* separatedlpsol, /**< buffer to store whether a cut that separates the current LP solution was found and added to LP,
9419  * or NULL if adding to cutpool only */
9420  SCIP_Real minefficacy /**< minimal efficacy of a cut when checking for separation of LP solution */
9421  )
9422 {
9423  SCIP_CONSHDLRDATA* conshdlrdata;
9424  SCIP_CONSDATA* consdata;
9425  SCIP_Bool addedtolp;
9426  SCIP_ROW* row;
9427  int c;
9428 
9429  assert(scip != NULL);
9430  assert(conshdlr != NULL);
9431  assert(conss != NULL || nconss == 0);
9432 
9433  conshdlrdata = SCIPconshdlrGetData(conshdlr);
9434  assert(conshdlrdata != NULL);
9435 
9436  if( separatedlpsol != NULL )
9437  *separatedlpsol = FALSE;
9438 
9439  for( c = 0; c < nconss; ++c )
9440  {
9441  assert(conss[c] != NULL); /*lint !e613 */
9442 
9443  if( SCIPconsIsLocal(conss[c]) || !SCIPconsIsEnabled(conss[c]) ) /*lint !e613 */
9444  continue;
9445 
9446  SCIP_CALL( checkCurvature(scip, conss[c], conshdlrdata->checkcurvature) ); /*lint !e613 */
9447 
9448  consdata = SCIPconsGetData(conss[c]); /*lint !e613 */
9449  assert(consdata != NULL);
9450 
9451  if( consdata->isconvex && !SCIPisInfinity(scip, consdata->rhs) )
9452  {
9453  SCIP_CALL( generateCutSol(scip, conshdlr, conss[c], NULL, ref, SCIP_SIDETYPE_RIGHT, &row, NULL,
9454  conshdlrdata->checkcurvature, -SCIPinfinity(scip), 'l') ); /*lint !e613 */
9455  }
9456  else if( consdata->isconcave && !SCIPisInfinity(scip, -consdata->lhs) )
9457  {
9458  SCIP_CALL( generateCutSol(scip, conshdlr, conss[c], NULL, ref, SCIP_SIDETYPE_LEFT, &row, NULL,
9459  conshdlrdata->checkcurvature, -SCIPinfinity(scip), 'l') ); /*lint !e613 */
9460  }
9461  else
9462  continue;
9463 
9464  if( row == NULL )
9465  continue;
9466 
9467  addedtolp = FALSE;
9468 
9469  /* if caller wants, then check if cut separates LP solution and add to sepastore if so */
9470  if( separatedlpsol != NULL )
9471  {
9472  SCIP_Real efficacy;
9473 
9474  efficacy = -SCIPgetRowLPFeasibility(scip, row);
9475  if( efficacy >= minefficacy )
9476  {
9477  SCIP_Bool infeasible;
9478 
9479  *separatedlpsol = TRUE;
9480  addedtolp = TRUE;
9481  SCIP_CALL( SCIPaddRow(scip, row, TRUE, &infeasible) );
9482  assert( ! infeasible );
9483  SCIPdebugMsg(scip, "added linearization cut <%s> to LP, efficacy = %g\n", SCIProwGetName(row), efficacy);
9484  }
9485  }
9486 
9487  if( !SCIProwIsLocal(row) && !addedtolp )
9488  {
9489  SCIP_CALL( SCIPaddPoolCut(scip, row) );
9490  SCIPdebugMsg(scip, "added linearization cut <%s> to cutpool\n", SCIProwGetName(row));
9491  }
9492 
9493  SCIP_CALL( SCIPreleaseRow(scip, &row) );
9494  }
9495 
9496  return SCIP_OKAY;
9497 }
9498 
9499 /** processes the event that a new primal solution has been found */
9500 static
9501 SCIP_DECL_EVENTEXEC(processNewSolutionEvent)
9503  SCIP_CONSHDLRDATA* conshdlrdata;
9504  SCIP_CONSHDLR* conshdlr;
9505  SCIP_CONS** conss;
9506  int nconss;
9507  SCIP_SOL* sol;
9508 
9509  assert(scip != NULL);
9510  assert(event != NULL);
9511  assert(eventdata != NULL);
9512  assert(eventhdlr != NULL);
9513 
9514  assert((SCIPeventGetType(event) & SCIP_EVENTTYPE_SOLFOUND) != 0);
9515 
9516  conshdlr = (SCIP_CONSHDLR*)eventdata;
9517 
9518  nconss = SCIPconshdlrGetNConss(conshdlr);
9519 
9520  if( nconss == 0 )
9521  return SCIP_OKAY;
9522 
9523  sol = SCIPeventGetSol(event);
9524  assert(sol != NULL);
9525 
9526  conshdlrdata = SCIPconshdlrGetData(conshdlr);
9527  assert(conshdlrdata != NULL);
9528 
9529  /* we are only interested in solution coming from some heuristic other than trysol, but not from the tree
9530  * the reason for ignoring trysol solutions is that they may come from an NLP solve in sepalp, where we already added linearizations,
9531  * or are from the tree, but postprocessed via proposeFeasibleSolution
9532  */
9533  if( SCIPsolGetHeur(sol) == NULL || SCIPsolGetHeur(sol) == conshdlrdata->trysolheur )
9534  return SCIP_OKAY;
9535 
9536  conss = SCIPconshdlrGetConss(conshdlr);
9537  assert(conss != NULL);
9538 
9539  SCIPdebugMsg(scip, "caught new sol event %" SCIP_EVENTTYPE_FORMAT " from heur <%s>; have %d conss\n", SCIPeventGetType(event), SCIPheurGetName(SCIPsolGetHeur(sol)), nconss);
9540 
9541  SCIP_CALL( addLinearizationCuts(scip, conshdlr, conss, nconss, sol, NULL, 0.0) );
9542 
9543  return SCIP_OKAY;
9544 }
9545 
9546 /** registers branching candidates according to convexification gap rule
9547  *
9548  * That is, computes for every nonconvex term the gap between the terms value in the LP solution and the value of the underestimator
9549  * as it would be (and maybe has been) constructed by the separation routines of this constraint handler. Then it registers all
9550  * variables occurring in each term with the computed gap. If variables appear in more than one term, they are registered several times.
9551  */
9552 static
9554  SCIP* scip, /**< SCIP data structure */
9555  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
9556  SCIP_CONS** conss, /**< constraints to check */
9557  int nconss, /**< number of constraints to check */
9558  SCIP_SOL* sol, /**< solution to enforce (NULL for the LP solution) */
9559  int* nnotify /**< counter for number of notifications performed */
9560  )
9561 {
9562  SCIP_CONSHDLRDATA* conshdlrdata;
9563  SCIP_CONSDATA* consdata;
9564  int c;
9565  int j;
9566  SCIP_Bool xbinary;
9567  SCIP_Bool ybinary;
9568  SCIP_Bool xunbounded;
9569  SCIP_Bool yunbounded;
9570  SCIP_VAR* x;
9571  SCIP_VAR* y;
9572  SCIP_Real xlb;
9573  SCIP_Real xub;
9574  SCIP_Real xval;
9575  SCIP_Real ylb;
9576  SCIP_Real yub;
9577  SCIP_Real yval;
9578  SCIP_Real gap;
9579  SCIP_Real coef_;
9580 
9581  assert(scip != NULL);
9582  assert(conshdlr != NULL);
9583  assert(conss != NULL || nconss == 0);
9584 
9585  *nnotify = 0;
9586  yval = SCIP_INVALID;
9587  xval = SCIP_INVALID;
9588 
9589  conshdlrdata = SCIPconshdlrGetData(conshdlr);
9590  assert(conshdlr != NULL);
9591 
9592  for( c = 0; c < nconss; ++c )
9593  {
9594  assert(conss != NULL);
9595  consdata = SCIPconsGetData(conss[c]);
9596  assert(consdata != NULL);
9597 
9598  if( !consdata->nquadvars )
9599  continue;
9600 
9601  if( (!SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) || consdata->isconcave) &&
9602  ( !SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) || consdata->isconvex ) )
9603  continue;
9604  SCIPdebugMsg(scip, "cons <%s> violation: %g %g convex: %u %u\n", SCIPconsGetName(conss[c]), consdata->lhsviol, consdata->rhsviol, consdata->isconvex, consdata->isconcave);
9605 
9606  /* square terms */
9607  for( j = 0; j < consdata->nquadvars; ++j )
9608  {
9609  x = consdata->quadvarterms[j].var;
9610  if( (SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) && consdata->quadvarterms[j].sqrcoef < 0) ||
9611  ( SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) && consdata->quadvarterms[j].sqrcoef > 0) )
9612  {
9613  xlb = SCIPvarGetLbLocal(x);
9614  xub = SCIPvarGetUbLocal(x);
9615  if( SCIPisRelEQ(scip, xlb, xub) )
9616  {
9617  SCIPdebugMsg(scip, "ignore fixed variable <%s>[%g, %g], diff %g\n", SCIPvarGetName(x), xlb, xub, xub-xlb);
9618  continue;
9619  }
9620 
9621  xval = SCIPgetSolVal(scip, sol, x);
9622 
9623  /* if variable is at bounds, then no need to branch, since secant is exact there */
9624  if( SCIPisLE(scip, xval, xlb) || SCIPisGE(scip, xval, xub) )
9625  continue;
9626 
9627  if( SCIPisInfinity(scip, -xlb) || SCIPisInfinity(scip, xub) )
9628  gap = SCIPinfinity(scip);
9629  else
9630  gap = (xval-xlb)*(xub-xval)/(1+2*ABS(xval));
9631  assert(!SCIPisFeasNegative(scip, gap));
9632  SCIP_CALL( SCIPaddExternBranchCand(scip, x, MAX(gap, 0.0), SCIP_INVALID) );
9633  ++*nnotify;
9634  }
9635  }
9636 
9637  /* bilinear terms */
9638  for( j = 0; j < consdata->nbilinterms; ++j )
9639  {
9640  /* if any of the variables if fixed, then it actually behaves like a linear term, so we don't need to branch on it */
9641  x = consdata->bilinterms[j].var1;
9642  xlb = SCIPvarGetLbLocal(x);
9643  xub = SCIPvarGetUbLocal(x);
9644  if( SCIPisRelEQ(scip, xlb, xub) )
9645  continue;
9646 
9647  y = consdata->bilinterms[j].var2;
9648  ylb = SCIPvarGetLbLocal(y);
9649  yub = SCIPvarGetUbLocal(y);
9650  if( SCIPisRelEQ(scip, ylb, yub) )
9651  continue;
9652 
9653  xunbounded = SCIPisInfinity(scip, -xlb) || SCIPisInfinity(scip, xub);
9654  yunbounded = SCIPisInfinity(scip, -ylb) || SCIPisInfinity(scip, yub);
9655 
9656  /* compute gap, if both variable are bounded */
9657  gap = SCIPinfinity(scip);
9658  if( !xunbounded && !yunbounded )
9659  {
9660  xval = SCIPgetSolVal(scip, sol, x);
9661  yval = SCIPgetSolVal(scip, sol, y);
9662 
9663  /* if both variables are at one of its bounds, then no need to branch, since McCormick is exact there */
9664  if( (SCIPisLE(scip, xval, xlb) || SCIPisGE(scip, xval, xub)) &&
9665  ( SCIPisLE(scip, yval, ylb) || SCIPisGE(scip, yval, yub)) )
9666  continue;
9667 
9668  xval = MAX(xlb, MIN(xval, xub));
9669  yval = MAX(ylb, MIN(yval, yub));
9670 
9671  coef_ = SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) ? -consdata->bilinterms[j].coef : consdata->bilinterms[j].coef;
9672  if( coef_ > 0.0 )
9673  {
9674  if( (xub-xlb)*yval + (yub-ylb)*xval <= xub*yub - xlb*ylb )
9675  gap = (xval*yval - xlb*yval - ylb*xval + xlb*ylb) / (1+sqrt(xval*xval + yval*yval));
9676  else
9677  gap = (xval*yval - xval*yub - yval*xub + xub*yub) / (1+sqrt(xval*xval + yval*yval));
9678  }
9679  else
9680  { /* coef_ < 0 */
9681  if( (xub-xlb)*yval - (yub-ylb)*xval <= xub*ylb - xlb*yub )
9682  gap = -(xval*yval - xval*ylb - yval*xub + xub*ylb) / (1+sqrt(xval*xval + yval*yval));
9683  else
9684  gap = -(xval*yval - xval*yub - yval*xlb + xlb*yub) / (1+sqrt(xval*xval + yval*yval));
9685  }
9686 
9687  assert(!SCIPisNegative(scip, gap / MAX3(MAX(REALABS(xlb), REALABS(xub)), MAX(REALABS(ylb), REALABS(yub)), 1.0))); /*lint !e666*/
9688  if( gap < 0.0 )
9689  gap = 0.0;
9690 
9691  /* use tighter relaxation when using linear inequalities to adjust the branching scores for bilinear terms */
9692  if( consdata->bilintermsidx != NULL && conshdlrdata->usebilinineqbranch )
9693  {
9694  BILINESTIMATOR* bilinestimator;
9695  int bilinidx;
9696 
9697  assert(conshdlrdata->bilinestimators != NULL);
9698 
9699  bilinidx = consdata->bilintermsidx[j];
9700  assert(bilinidx >= 0 && bilinidx < conshdlrdata->nbilinterms);
9701 
9702  bilinestimator = &conshdlrdata->bilinestimators[bilinidx];
9703  assert(bilinestimator != NULL);
9704  assert(bilinestimator->x == x);
9705  assert(bilinestimator->y == y);
9706 
9707  if( SCIPisGT(scip, bilinestimator->lastimprfac, 0.0) )
9708  gap *= MAX(0.0, 1.0 - bilinestimator->lastimprfac);
9709  }
9710  }
9711 
9712  /* if one of the variables is binary or integral with domain width 1, then branching on this makes the term linear, so prefer this */
9713  xbinary = SCIPvarIsBinary(x) || (SCIPvarIsIntegral(x) && xub - xlb < 1.5);
9714  ybinary = SCIPvarIsBinary(y) || (SCIPvarIsIntegral(y) && yub - ylb < 1.5);
9715  if( xbinary )
9716  {
9718  ++*nnotify;
9719  }
9720  if( ybinary )
9721  {
9723  ++*nnotify;
9724  }
9725  if( xbinary || ybinary )
9726  continue;
9727 
9728  /* if one of the variables is unbounded, then branch on it first */
9729  if( xunbounded )
9730  {
9732  ++*nnotify;
9733  }
9734  if( yunbounded )
9735  {
9737  ++*nnotify;
9738  }
9739  if( xunbounded || yunbounded )
9740  continue;
9741 
9742  /* if both variables are integral, prefer the one with the smaller domain, so variable gets fixed soon
9743  * does not seem to work well on tln instances, so disable for now and may look at it later again
9744  */
9745 #ifdef BRANCHTOLINEARITY
9746  if( SCIPvarIsIntegral(x) && SCIPvarIsIntegral(y) )
9747  {
9748  if( SCIPisLT(scip, xub-xlb, yub-ylb) )
9749  {
9751  ++*nnotify;
9752  continue;
9753  }
9754  if( SCIPisGT(scip, xub-xlb, yub-ylb) )
9755  {
9757  ++*nnotify;
9758  continue;
9759  }
9760  }
9761 #endif
9762 
9763  /* in the regular case, suggest those variables which are not at its bounds for branching
9764  * this is, because after branching both variables will be one the bounds, and McCormick will be exact then */
9765  if( !SCIPisLE(scip, xval, xlb) && !SCIPisGE(scip, xval, xub) )
9766  {
9768  ++*nnotify;
9769  }
9770  if( !SCIPisLE(scip, yval, ylb) && !SCIPisGE(scip, yval, yub) )
9771  {
9773  ++*nnotify;
9774  }
9775  }
9776  }
9777 
9778  SCIPdebugMsg(scip, "registered %d branching candidates\n", *nnotify);
9779 
9780  return SCIP_OKAY;
9781 }
9782 
9783 /** registers branching candidates according to constraint violation rule
9784  *
9785  * That is, registers all variables appearing in nonconvex terms^1 with a score that is the violation of the constraint.
9786  * This is the same rule as is applied in cons_nonlinear and other nonlinear constraint handlers.
9787  *
9788  * 1) We mean all quadratic variables that appear either in a nonconvex square term or in a bilinear term, if the constraint
9789  * itself is nonconvex. (and this under the assumption that the rhs is violated; for violated lhs, swap terms)
9790  */
9791 static
9793  SCIP* scip, /**< SCIP data structure */
9794  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
9795  SCIP_CONS** conss, /**< constraints to check */
9796  int nconss, /**< number of constraints to check */
9797  SCIP_SOL* sol, /**< solution to enforce (NULL for the LP solution) */
9798  int* nnotify /**< counter for number of notifications performed */
9799  )
9800 {
9801  SCIP_CONSDATA* consdata;
9802  SCIP_QUADVARTERM* quadvarterm;
9803  int c;
9804  int j;
9805  SCIP_VAR* x;
9806  SCIP_Real xlb;
9807  SCIP_Real xub;
9808  SCIP_Real xval;
9809 
9810  assert(scip != NULL);
9811  assert(conshdlr != NULL);
9812  assert(conss != NULL || nconss == 0);
9813 
9814  *nnotify = 0;
9815 
9816  for( c = 0; c < nconss; ++c )
9817  {
9818  assert(conss != NULL);
9819  consdata = SCIPconsGetData(conss[c]);
9820  assert(consdata != NULL);
9821 
9822  if( !consdata->nquadvars )
9823  continue;
9824 
9825  if( (!SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) || consdata->isconcave) &&
9826  ( !SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) || consdata->isconvex ) )
9827  continue;
9828  SCIPdebugMsg(scip, "cons %s violation: %g %g convex: %u %u\n", SCIPconsGetName(conss[c]), consdata->lhsviol, consdata->rhsviol, consdata->isconvex, consdata->isconcave);
9829 
9830  for( j = 0; j < consdata->nquadvars; ++j )
9831  {
9832  quadvarterm = &consdata->quadvarterms[j];
9833  if( (SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) && quadvarterm->sqrcoef < 0) ||
9834  (SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) && quadvarterm->sqrcoef > 0) ||
9835  quadvarterm->nadjbilin > 0 )
9836  {
9837  x = quadvarterm->var;
9838  xlb = SCIPvarGetLbLocal(x);
9839  xub = SCIPvarGetUbLocal(x);
9840 
9841  if( quadvarterm->nadjbilin == 0 )
9842  {
9843  xval = SCIPgetSolVal(scip, sol, x);
9844 
9845  /* if variable is at bounds and only in a nonconvex square term, then no need to branch, since secant is exact there */
9846  if( SCIPisLE(scip, xval, xlb) || SCIPisGE(scip, xval, xub) )
9847  continue;
9848  }
9849 
9850  if( SCIPisRelEQ(scip, xlb, xub) )
9851  {
9852  SCIPdebugMsg(scip, "ignore fixed variable <%s>[%g, %g], diff %g\n", SCIPvarGetName(x), xlb, xub, xub-xlb);
9853  continue;
9854  }
9855 
9856  SCIP_CALL( SCIPaddExternBranchCand(scip, x, MAX(consdata->lhsviol, consdata->rhsviol), SCIP_INVALID) );
9857  ++*nnotify;
9858  }
9859  }
9860  }
9861 
9862  SCIPdebugMsg(scip, "registered %d branching candidates\n", *nnotify);
9863 
9864  return SCIP_OKAY;
9865 }
9866 
9867 /** registers branching candidates according to centrality rule
9868  *
9869  * That is, registers all variables appearing in nonconvex terms^1 with a score that is given by the distance of the
9870  * variable value from its bounds. This rule should not make sense, as the distance to the bounds is also (often) considered
9871  * by the branching rule later on.
9872  *
9873  * 1) We mean all quadratic variables that appear either in a nonconvex square term or in a bilinear term, if the constraint
9874  * itself is nonconvex. (and this under the assumption that the rhs is violated; for violated lhs, swap terms)
9875  */
9876 static
9878  SCIP* scip, /**< SCIP data structure */
9879  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
9880  SCIP_CONS** conss, /**< constraints to check */
9881  int nconss, /**< number of constraints to check */
9882  SCIP_SOL* sol, /**< solution to enforce (NULL for the LP solution) */
9883  int* nnotify /**< counter for number of notifications performed */
9884  )
9885 {
9886  SCIP_CONSDATA* consdata;
9887  SCIP_QUADVARTERM* quadvarterm;
9888  int c;
9889  int j;
9890  SCIP_VAR* x;
9891  SCIP_Real xlb;
9892  SCIP_Real xub;
9893  SCIP_Real xval;
9894  SCIP_Real score;
9895 
9896  assert(scip != NULL);
9897  assert(conshdlr != NULL);
9898  assert(conss != NULL || nconss == 0);
9899 
9900  *nnotify = 0;
9901 
9902  for( c = 0; c < nconss; ++c )
9903  {
9904  assert(conss != NULL);
9905  consdata = SCIPconsGetData(conss[c]);
9906  assert(consdata != NULL);
9907 
9908  if( !consdata->nquadvars )
9909  continue;
9910 
9911  if( (!SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) || consdata->isconcave) &&
9912  ( !SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) || consdata->isconvex ) )
9913  continue;
9914  SCIPdebugMsg(scip, "cons %s violation: %g %g convex: %u %u\n", SCIPconsGetName(conss[c]), consdata->lhsviol, consdata->rhsviol, consdata->isconvex, consdata->isconcave);
9915 
9916  for( j = 0; j < consdata->nquadvars; ++j )
9917  {
9918  quadvarterm = &consdata->quadvarterms[j];
9919  if( (SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) && quadvarterm->sqrcoef < 0) ||
9920  (SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) && quadvarterm->sqrcoef > 0) ||
9921  quadvarterm->nadjbilin > 0 )
9922  {
9923  x = quadvarterm->var;
9924  xlb = SCIPvarGetLbLocal(x);
9925  xub = SCIPvarGetUbLocal(x);
9926 
9927  if( SCIPisRelEQ(scip, xlb, xub) )
9928  {
9929  SCIPdebugMsg(scip, "ignore fixed variable <%s>[%g, %g], diff %g\n", SCIPvarGetName(x), xlb, xub, xub-xlb);
9930  continue;
9931  }
9932 
9933  xval = SCIPgetSolVal(scip, sol, x);
9934  xval = MAX(xlb, MIN(xub, xval));
9935 
9936  /* compute relative difference of xval to each of its bounds
9937  * and scale such that if xval were in the middle, we get a score of 1
9938  * and if xval is on one its bounds, the score is 0
9939  */
9940  if( SCIPisInfinity(scip, -xlb) || SCIPisInfinity(scip, xub) )
9941  {
9942  if( (!SCIPisInfinity(scip, -xlb) && SCIPisEQ(scip, xval, xlb)) || (!SCIPisInfinity(scip, xub) && SCIPisEQ(scip, xval, xub)) )
9943  score = 0.0;
9944  else
9945  score = 1.0;
9946  }
9947  else
9948  {
9949  score = 4.0 * (xval - xlb) * (xub - xval) / ((xub - xlb) * (xub - xlb));
9950  }
9951 
9952  SCIP_CALL( SCIPaddExternBranchCand(scip, x, score, SCIP_INVALID) );
9953  ++*nnotify;
9954  }
9955  }
9956  }
9957 
9958  SCIPdebugMsg(scip, "registered %d branching candidates\n", *nnotify);
9959 
9960  return SCIP_OKAY;
9961 }
9962 
9963 /** registers branching candidates */
9964 static
9966  SCIP* scip, /**< SCIP data structure */
9967  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
9968  SCIP_CONS** conss, /**< constraints to check */
9969  int nconss, /**< number of constraints to check */
9970  SCIP_SOL* sol, /**< solution to enforce (NULL for the LP solution) */
9971  int* nnotify /**< counter for number of notifications performed */
9972  )
9973 {
9974  SCIP_CONSHDLRDATA* conshdlrdata;
9975 
9976  conshdlrdata = SCIPconshdlrGetData(conshdlr);
9977  assert(conshdlrdata != NULL);
9978 
9979  switch( conshdlrdata->branchscoring )
9980  {
9981  case 'g' :
9982  SCIP_CALL( registerBranchingCandidatesGap(scip, conshdlr, conss, nconss, sol, nnotify) );
9983  break;
9984 
9985  case 'v' :
9986  SCIP_CALL( registerBranchingCandidatesViolation(scip, conshdlr, conss, nconss, sol, nnotify) );
9987  break;
9988 
9989  case 'c' :
9990  SCIP_CALL( registerBranchingCandidatesCentrality(scip, conshdlr, conss, nconss, sol, nnotify) );
9991  break;
9992 
9993  default :
9994  SCIPerrorMessage("invalid branchscoring selection");
9995  SCIPABORT();
9996  return SCIP_ERROR; /*lint !e527*/
9997  }
9998 
9999  return SCIP_OKAY;
10000 }
10001 
10002 
10003 /** registers a quadratic variable from a violated constraint as branching candidate that has a large absolute value in the (LP) relaxation */
10004 static
10006  SCIP* scip, /**< SCIP data structure */
10007  SCIP_CONS** conss, /**< constraints */
10008  int nconss, /**< number of constraints */
10009  SCIP_SOL* sol, /**< solution to enforce (NULL for the LP solution) */
10010  SCIP_VAR** brvar /**< buffer to store branching variable */
10011  )
10012 {
10013  SCIP_CONSDATA* consdata;
10014  SCIP_Real val;
10015  SCIP_Real brvarval;
10016  int i;
10017  int c;
10018 
10019  assert(scip != NULL);
10020  assert(conss != NULL || nconss == 0);
10021 
10022  *brvar = NULL;
10023  brvarval = -1.0;
10024 
10025  for( c = 0; c < nconss; ++c )
10026  {
10027  assert(conss != NULL);
10028  consdata = SCIPconsGetData(conss[c]);
10029  assert(consdata != NULL);
10030 
10031  if( !SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) && !SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) )
10032  continue;
10033 
10034  for( i = 0; i < consdata->nquadvars; ++i )
10035  {
10036  /* do not propose fixed variables */
10037  if( SCIPisRelEQ(scip, SCIPvarGetLbLocal(consdata->quadvarterms[i].var), SCIPvarGetUbLocal(consdata->quadvarterms[i].var)) )
10038  continue;
10039  val = SCIPgetSolVal(scip, sol, consdata->quadvarterms[i].var);
10040  if( ABS(val) > brvarval )
10041  {
10042  brvarval = ABS(val);
10043  *brvar = consdata->quadvarterms[i].var;
10044  }
10045  }
10046  }
10047 
10048  if( *brvar != NULL )
10049  {
10050  SCIP_CALL( SCIPaddExternBranchCand(scip, *brvar, brvarval, SCIP_INVALID) );
10051  }
10052 
10053  return SCIP_OKAY;
10054 }
10055 
10056 /** replaces violated quadratic constraints where all quadratic variables are fixed by linear constraints */
10057 static
10059  SCIP* scip, /**< SCIP data structure */
10060  SCIP_CONS** conss, /**< constraints */
10061  int nconss, /**< number of constraints */
10062  SCIP_Bool* addedcons, /**< buffer to store whether a linear constraint was added */
10063  SCIP_Bool* reduceddom, /**< whether a domain has been reduced */
10064  SCIP_Bool* infeasible /**< whether we detected infeasibility */
10065  )
10066 {
10067  SCIP_CONS* cons;
10068  SCIP_CONSDATA* consdata;
10069  SCIP_RESULT checkresult;
10070  SCIP_VAR* var;
10071  SCIP_Bool tightened;
10072  SCIP_Real constant;
10073  SCIP_Real val1;
10074  SCIP_Real val2;
10075  int i;
10076  int c;
10077 
10078  assert(scip != NULL);
10079  assert(conss != NULL || nconss == 0);
10080  assert(addedcons != NULL);
10081  assert(reduceddom != NULL);
10082  assert(infeasible != NULL);
10083 
10084  *addedcons = FALSE;
10085  *reduceddom = FALSE;
10086  *infeasible = FALSE;
10087 
10088  for( c = 0; c < nconss; ++c )
10089  {
10090  assert(conss != NULL);
10091  consdata = SCIPconsGetData(conss[c]);
10092  assert(consdata != NULL);
10093 
10094  if( !SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) && !SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) )
10095  continue;
10096 
10097  constant = 0.0;
10098 
10099  for( i = 0; i < consdata->nquadvars; ++i )
10100  {
10101  var = consdata->quadvarterms[i].var;
10102 
10103  /* variables should be fixed if constraint is violated */
10104  assert(SCIPisRelEQ(scip, SCIPvarGetLbLocal(var), SCIPvarGetUbLocal(var)));
10105 
10106  val1 = (SCIPvarGetUbLocal(var) + SCIPvarGetLbLocal(var)) / 2.0;
10107  constant += (consdata->quadvarterms[i].lincoef + consdata->quadvarterms[i].sqrcoef * val1) * val1;
10108 
10109  SCIPdebugMessage("<%s>: [%.15g, %.15g]\n", SCIPvarGetName(var), SCIPvarGetLbLocal(var), SCIPvarGetUbLocal(var));
10110 
10111  /* if variable is not fixed w.r.t. absolute eps yet, then try to fix it
10112  * (SCIPfixVar() doesn't allow for small tightenings, so tighten lower and upper bound separately)
10113  */
10114  if( !SCIPisEQ(scip, SCIPvarGetLbLocal(var), SCIPvarGetUbLocal(var)) )
10115  {
10116  SCIP_CALL( SCIPtightenVarLb(scip, var, val1, TRUE, infeasible, &tightened) );
10117  if( *infeasible )
10118  {
10119  SCIPdebugMsg(scip, "Fixing almost fixed variable <%s> lead to infeasibility.\n", SCIPvarGetName(var));
10120  return SCIP_OKAY;
10121  }
10122  if( tightened )
10123  {
10124  SCIPdebugMsg(scip, "Tightened lower bound of almost fixed variable <%s>.\n", SCIPvarGetName(var));
10125  *reduceddom = TRUE;
10126  }
10127 
10128  SCIP_CALL( SCIPtightenVarUb(scip, var, val1, TRUE, infeasible, &tightened) );
10129  if( *infeasible )
10130  {
10131  SCIPdebugMsg(scip, "Fixing almost fixed variable <%s> lead to infeasibility.\n", SCIPvarGetName(var));
10132  return SCIP_OKAY;
10133  }
10134  if( tightened )
10135  {
10136  SCIPdebugMsg(scip, "Tightened upper bound of almost fixed variable <%s>.\n", SCIPvarGetName(var));
10137  *reduceddom = TRUE;
10138  }
10139  }
10140  }
10141 
10142  /* if some quadratic variable was fixed now, then restart node (next enfo round) */
10143  if( *reduceddom )
10144  return SCIP_OKAY;
10145 
10146  for( i = 0; i < consdata->nbilinterms; ++i )
10147  {
10148  val1 = (SCIPvarGetUbLocal(consdata->bilinterms[i].var1) + SCIPvarGetLbLocal(consdata->bilinterms[i].var1)) / 2.0;
10149  val2 = (SCIPvarGetUbLocal(consdata->bilinterms[i].var2) + SCIPvarGetLbLocal(consdata->bilinterms[i].var2)) / 2.0;
10150  constant += consdata->bilinterms[i].coef * val1 * val2;
10151  }
10152 
10153  /* check if we have a bound change */
10154  if ( consdata->nlinvars == 1 )
10155  {
10156  SCIP_Real coef;
10157  SCIP_Real lhs;
10158  SCIP_Real rhs;
10159 
10160  coef = *consdata->lincoefs;
10161  var = *consdata->linvars;
10162 
10163  assert( ! SCIPisZero(scip, coef) );
10164 
10165  /* compute lhs/rhs, divide already by |coef| */
10166  if ( SCIPisInfinity(scip, -consdata->lhs) )
10167  lhs = -SCIPinfinity(scip);
10168  else
10169  lhs = (consdata->lhs - constant) / REALABS(coef);
10170 
10171  if ( SCIPisInfinity(scip, consdata->rhs) )
10172  rhs = SCIPinfinity(scip);
10173  else
10174  rhs = (consdata->rhs - constant) / REALABS(coef);
10175 
10176  SCIPdebugMsg(scip, "Linear constraint with one variable: %.15g <= %g <%s> <= %.15g\n", lhs, coef > 0.0 ? 1.0 : -1.0, SCIPvarGetName(var), rhs);
10177 
10178  SCIPdebugMessage("<%s>: [%.15g, %.15g]\n", SCIPvarGetName(var), SCIPvarGetLbLocal(var), SCIPvarGetUbLocal(var));
10179 
10180  if ( coef < 0.0 )
10181  {
10182  /* swap lhs and rhs, with negated sign */
10183  SCIP_Real h;
10184  h = rhs;
10185  rhs = -lhs;
10186  lhs = -h;
10187  }
10188  SCIPdebugMsg(scip, "Linear constraint is a bound: %.15g <= <%s> <= %.15g\n", lhs, SCIPvarGetName(var), rhs);
10189 
10190  if( SCIPisInfinity(scip, -rhs) || SCIPisInfinity(scip, lhs) )
10191  {
10192  SCIPdebugMsg(scip, "node will marked as infeasible since lb/ub of %s is +/-infinity\n",
10193  SCIPvarGetName(var));
10194 
10195  *infeasible = TRUE;
10196  return SCIP_OKAY;
10197  }
10198 
10199  if ( ! SCIPisInfinity(scip, -lhs) )
10200  {
10201  SCIP_CALL( SCIPtightenVarLb(scip, var, lhs, TRUE, infeasible, &tightened) );
10202  if ( *infeasible )
10203  {
10204  SCIPdebugMsg(scip, "Lower bound leads to infeasibility.\n");
10205  return SCIP_OKAY;
10206  }
10207  if ( tightened )
10208  {
10209  SCIPdebugMsg(scip, "Lower bound changed.\n");
10210  *reduceddom = TRUE;
10211  return SCIP_OKAY;
10212  }
10213  }
10214 
10215  if ( ! SCIPisInfinity(scip, rhs) )
10216  {
10217  SCIP_CALL( SCIPtightenVarUb(scip, var, rhs, TRUE, infeasible, &tightened) );
10218  if ( *infeasible )
10219  {
10220  SCIPdebugMsg(scip, "Upper bound leads to infeasibility.\n");
10221  return SCIP_OKAY;
10222  }
10223  if ( tightened )
10224  {
10225  SCIPdebugMsg(scip, "Upper bound changed.\n");
10226  *reduceddom = TRUE;
10227  return SCIP_OKAY;
10228  }
10229  }
10230  }
10231  else
10232  {
10233  SCIP_CALL( SCIPcreateConsLinear(scip, &cons, SCIPconsGetName(conss[c]),
10234  consdata->nlinvars, consdata->linvars, consdata->lincoefs,
10235  (SCIPisInfinity(scip, -consdata->lhs) ? -SCIPinfinity(scip) : (consdata->lhs - constant)),
10236  (SCIPisInfinity(scip, consdata->rhs) ? SCIPinfinity(scip) : (consdata->rhs - constant)),
10237  SCIPconsIsInitial(conss[c]), SCIPconsIsSeparated(conss[c]), SCIPconsIsEnforced(conss[c]),
10238  SCIPconsIsChecked(conss[c]), SCIPconsIsPropagated(conss[c]), TRUE,
10239  SCIPconsIsModifiable(conss[c]), SCIPconsIsDynamic(conss[c]), SCIPconsIsRemovable(conss[c]),
10240  SCIPconsIsStickingAtNode(conss[c])) );
10241 
10242  SCIPdebugMsg(scip, "replace quadratic constraint <%s> by linear constraint after all quadratic vars have been fixed\n", SCIPconsGetName(conss[c]) );
10243  SCIPdebugPrintCons(scip, cons, NULL);
10244 
10245  SCIP_CALL( SCIPcheckCons(scip, cons, NULL, FALSE, FALSE, FALSE, &checkresult) );
10246 
10247  if( checkresult != SCIP_INFEASIBLE && SCIPgetLPSolstat(scip) == SCIP_LPSOLSTAT_OPTIMAL )
10248  {
10249  SCIPdebugMsg(scip, "linear constraint is feasible and LP optimal, thus do not add\n");
10250  }
10251  else
10252  {
10253  SCIP_CALL( SCIPaddConsLocal(scip, cons, NULL) );
10254  *addedcons = TRUE;
10255  }
10256  SCIP_CALL( SCIPreleaseCons(scip, &cons) );
10257  }
10258  SCIP_CALL( SCIPdelConsLocal(scip, conss[c]) );
10259  }
10260 
10261  return SCIP_OKAY;
10262 }
10263 
10264 /** tightens a lower bound on a variable and checks the result */
10265 static
10267  SCIP* scip, /**< SCIP data structure */
10268  SCIP_CONS* cons, /**< constraint where we currently propagate */
10269  SCIP_Real intervalinfty, /**< infinity value used in interval operations */
10270  SCIP_VAR* var, /**< variable which domain we might reduce */
10271  SCIP_Real bnd, /**< new lower bound for variable */
10272  SCIP_RESULT* result, /**< result to update if there was a tightening or cutoff */
10273  int* nchgbds /**< counter to increase if a bound was tightened */
10274  )
10275 {
10276  SCIP_Bool infeas;
10277  SCIP_Bool tightened;
10278 
10279  assert(scip != NULL);
10280  assert(cons != NULL);
10281  assert(intervalinfty > 0.0);
10282  assert(bnd > -intervalinfty);
10283  assert(var != NULL);
10284  assert(result != NULL);
10285  assert(*result == SCIP_DIDNOTFIND || *result == SCIP_REDUCEDDOM);
10286  assert(nchgbds != NULL);
10287 
10288  /* new bound is no improvement */
10289  if( SCIPisHugeValue(scip, -bnd) || SCIPisLE(scip, bnd, SCIPvarGetLbLocal(var)) )
10290  return SCIP_OKAY;
10291 
10292  if( SCIPisInfinity(scip, bnd) )
10293  { /* domain will be outside [-infty, +infty] -> declare node infeasible */
10294  *result = SCIP_CUTOFF;
10295  SCIP_CALL( SCIPresetConsAge(scip, cons) );
10296  return SCIP_OKAY;
10297  }
10298 
10299  /* new lower bound is very low (between -intervalinfty and -SCIPinfinity()) */
10300  if( SCIPisInfinity(scip, -bnd) )
10301  return SCIP_OKAY;
10302 
10303  bnd = SCIPadjustedVarLb(scip, var, bnd);
10304  SCIP_CALL( SCIPtightenVarLb(scip, var, bnd, FALSE, &infeas, &tightened) );
10305  if( infeas )
10306  {
10307  SCIPdebugMsg(scip, "%s found constraint <%s> infeasible due to tightened lower bound %g for variable <%s>\n",
10308  SCIPinProbing(scip) ? "in probing" : "", SCIPconsGetName(cons), bnd, SCIPvarGetName(var));
10309  *result = SCIP_CUTOFF;
10310  SCIP_CALL( SCIPresetConsAge(scip, cons) );
10311  return SCIP_OKAY;
10312  }
10313  if( tightened )
10314  {
10315  SCIPdebugMsg(scip, "%s tightened lower bound of variable <%s> in constraint <%s> to %g\n",
10316  SCIPinProbing(scip) ? "in probing" : "", SCIPvarGetName(var), SCIPconsGetName(cons), bnd);
10317  ++*nchgbds;
10318  *result = SCIP_REDUCEDDOM;
10319  SCIP_CALL( SCIPresetConsAge(scip, cons) );
10320  }
10321 
10322  return SCIP_OKAY;
10323 }
10324 
10325 /** tightens an upper bound on a variable and checks the result */
10326 static
10328  SCIP* scip, /**< SCIP data structure */
10329  SCIP_CONS* cons, /**< constraint where we currently propagate */
10330  SCIP_Real intervalinfty, /**< infinity value used in interval operations */
10331  SCIP_VAR* var, /**< variable which domain we might reduce */
10332  SCIP_Real bnd, /**< new upper bound for variable */
10333  SCIP_RESULT* result, /**< result to update if there was a tightening or cutoff */
10334  int* nchgbds /**< counter to increase if a bound was tightened */
10335  )
10336 {
10337  SCIP_Bool infeas;
10338  SCIP_Bool tightened;
10339 
10340  assert(scip != NULL);
10341  assert(cons != NULL);
10342  assert(intervalinfty > 0.0);
10343  assert(bnd < intervalinfty);
10344  assert(var != NULL);
10345  assert(result != NULL);
10346  assert(*result == SCIP_DIDNOTFIND || *result == SCIP_REDUCEDDOM);
10347  assert(nchgbds != NULL);
10348 
10349  /* new bound is no improvement */
10350  if( SCIPisHugeValue(scip, bnd) || SCIPisGE(scip, bnd, SCIPvarGetUbLocal(var)) )
10351  return SCIP_OKAY;
10352 
10353  if( SCIPisInfinity(scip, -bnd) )
10354  { /* domain will be outside [-infty, +infty] -> declare node infeasible */
10355  *result = SCIP_CUTOFF;
10356  SCIP_CALL( SCIPresetConsAge(scip, cons) );
10357  return SCIP_OKAY;
10358  }
10359 
10360  /* new upper bound is very high (between SCIPinfinity() and intervalinfty) */
10361  if( SCIPisInfinity(scip, bnd) )
10362  return SCIP_OKAY;
10363 
10364  bnd = SCIPadjustedVarUb(scip, var, bnd);
10365  SCIP_CALL( SCIPtightenVarUb(scip, var, bnd, FALSE, &infeas, &tightened) );
10366  if( infeas )
10367  {
10368  SCIPdebugMsg(scip, "%s found constraint <%s> infeasible due to tightened upper bound %g for variable <%s>\n",
10369  SCIPinProbing(scip) ? "in probing" : "", SCIPconsGetName(cons), bnd, SCIPvarGetName(var));
10370  *result = SCIP_CUTOFF;
10371  SCIP_CALL( SCIPresetConsAge(scip, cons) );
10372  return SCIP_OKAY;
10373  }
10374  if( tightened )
10375  {
10376  SCIPdebugMsg(scip, "%s tightened upper bound of variable <%s> in constraint <%s> to %g\n",
10377  SCIPinProbing(scip) ? "in probing" : "", SCIPvarGetName(var), SCIPconsGetName(cons), bnd);
10378  ++*nchgbds;
10379  *result = SCIP_REDUCEDDOM;
10380  SCIP_CALL( SCIPresetConsAge(scip, cons) );
10381  }
10382 
10383  return SCIP_OKAY;
10384 }
10385 
10386 /** solves a quadratic equation \f$ a x^2 + b x \in rhs \f$ (with b an interval) and reduces bounds on x or deduces infeasibility if possible */
10387 static
10389  SCIP* scip, /**< SCIP data structure */
10390  SCIP_CONS* cons, /**< constraint where we currently propagate */
10391  SCIP_Real intervalinfty, /**< infinity value used in interval operations */
10392  SCIP_VAR* var, /**< variable which bounds with might tighten */
10393  SCIP_Real a, /**< coefficient in square term */
10394  SCIP_INTERVAL b, /**< coefficient in linear term */
10395  SCIP_INTERVAL rhs, /**< right hand side of quadratic equation */
10396  SCIP_RESULT* result, /**< result of propagation */
10397  int* nchgbds /**< buffer where to add number of tightened bounds */
10398  )
10399 {
10400  SCIP_INTERVAL newrange;
10401 
10402  assert(scip != NULL);
10403  assert(cons != NULL);
10404  assert(var != NULL);
10405  assert(result != NULL);
10406  assert(nchgbds != NULL);
10407 
10408  /* compute solution of a*x^2 + b*x \in rhs */
10409  if( a == 0.0 && SCIPintervalGetInf(b) == 0.0 && SCIPintervalGetSup(b) == 0.0 )
10410  {
10411  /* relatively easy case: 0.0 \in rhs, thus check if infeasible or just redundant */
10412  if( SCIPintervalGetInf(rhs) > 0.0 || SCIPintervalGetSup(rhs) < 0.0 )
10413  {
10414  SCIPdebugMsg(scip, "found <%s> infeasible due to domain propagation for quadratic variable <%s>\n", SCIPconsGetName(cons), SCIPvarGetName(var));
10415  SCIP_CALL( SCIPresetConsAge(scip, cons) );
10416  *result = SCIP_CUTOFF;
10417  }
10418  return SCIP_OKAY;
10419  }
10420  else
10421  {
10422  SCIP_INTERVAL a_;
10423  SCIP_INTERVAL xbnds;
10424 
10425  SCIPintervalSet(&a_, a);
10426  SCIPintervalSetBounds(&xbnds, -infty2infty(SCIPinfinity(scip), intervalinfty, -SCIPvarGetLbLocal(var)), infty2infty(SCIPinfinity(scip), intervalinfty, SCIPvarGetUbLocal(var))); /*lint !e666*/
10427  SCIPintervalSolveUnivariateQuadExpression(intervalinfty, &newrange, a_, b, rhs, xbnds);
10428  }
10429 
10430  /* SCIPdebugMsg(scip, "%g x^2 + [%g, %g] x in [%g, %g] and x in [%g,%g] -> [%g, %g]\n", a, b.inf, b.sup, rhs.inf, rhs.sup, SCIPvarGetLbLocal(var), SCIPvarGetUbLocal(var), newrange.inf, newrange.sup); */
10431 
10432  if( SCIPisInfinity(scip, SCIPintervalGetInf(newrange)) || SCIPisInfinity(scip, -SCIPintervalGetSup(newrange)) )
10433  {
10434  /* domain outside [-infty, +infty] -> declare node infeasible */
10435  SCIPdebugMsg(scip, "found <%s> infeasible because propagated domain of quadratic variable <%s> is outside of (-infty, +infty)\n",
10436  SCIPconsGetName(cons), SCIPvarGetName(var));
10437  *result = SCIP_CUTOFF;
10438  SCIP_CALL( SCIPresetConsAge(scip, cons) );
10439  return SCIP_OKAY;
10440  }
10441 
10442  if( SCIPintervalIsEmpty(intervalinfty, newrange) )
10443  {
10444  SCIPdebugMsg(scip, "found <%s> infeasible due to domain propagation for quadratic variable <%s>\n", SCIPconsGetName(cons), SCIPvarGetName(var));
10445  *result = SCIP_CUTOFF;
10446  return SCIP_OKAY;
10447  }
10448 
10449  if( !SCIPisInfinity(scip, -SCIPintervalGetInf(newrange)) )
10450  {
10451  SCIP_CALL( propagateBoundsTightenVarLb(scip, cons, intervalinfty, var, SCIPintervalGetInf(newrange), result, nchgbds) );
10452  if( *result == SCIP_CUTOFF )
10453  return SCIP_OKAY;
10454  }
10455 
10456  if( !SCIPisInfinity(scip, SCIPintervalGetSup(newrange)) )
10457  {
10458  SCIP_CALL( propagateBoundsTightenVarUb(scip, cons, intervalinfty, var, SCIPintervalGetSup(newrange), result, nchgbds) );
10459  if( *result == SCIP_CUTOFF )
10460  return SCIP_OKAY;
10461  }
10462 
10463  return SCIP_OKAY;
10464 }
10465 
10466 /* The new version below computes potentially tighter bounds, but also always adds a small safety area since it is not implemented roundingsafe.
10467  * This may be a reason why it gives worse results on one of two instances.
10468  * Further, I have only very few instances where one can expect a difference.
10469  */
10470 #ifndef PROPBILINNEW
10471 /** tries to deduce domain reductions for x in xsqrcoef x^2 + xlincoef x + ysqrcoef y^2 + ylincoef y + bilincoef x y \\in rhs
10472  *
10473  * @note Domain reductions for y are not deduced.
10474  */
10475 static
10477  SCIP* scip, /**< SCIP data structure */
10478  SCIP_CONS* cons, /**< the constraint, where the bilinear term belongs to */
10479  SCIP_Real intervalinfty, /**< infinity value used in interval operations */
10480  SCIP_VAR* x, /**< first variable */
10481  SCIP_Real xsqrcoef, /**< square coefficient of x */
10482  SCIP_Real xlincoef, /**< linear coefficient of x */
10483  SCIP_VAR* y, /**< second variable */
10484  SCIP_Real ysqrcoef, /**< square coefficient of y */
10485  SCIP_Real ylincoef, /**< linear coefficient of y */
10486  SCIP_Real bilincoef, /**< bilinear coefficient of x*y */
10487  SCIP_INTERVAL rhs, /**< right hand side of quadratic equation */
10488  SCIP_RESULT* result, /**< pointer to store result of domain propagation */
10489  int* nchgbds /**< counter to increment if domain reductions are found */
10490  )
10491 {
10492  SCIP_INTERVAL myrhs;
10493  SCIP_INTERVAL varbnds;
10494  SCIP_INTERVAL lincoef;
10495 
10496  assert(scip != NULL);
10497  assert(cons != NULL);
10498  assert(x != NULL);
10499  assert(y != NULL);
10500  assert(x != y);
10501  assert(result != NULL);
10502  assert(*result == SCIP_DIDNOTFIND || *result == SCIP_REDUCEDDOM);
10503  assert(nchgbds != NULL);
10504  assert(bilincoef != 0.0);
10505 
10506  if( SCIPintervalIsEntire(intervalinfty, rhs) )
10507  return SCIP_OKAY;
10508 
10509  /* try to find domain reductions for x */
10511 
10512  /* put ysqrcoef*y^2 + ylincoef * y into rhs */
10513  if( SCIPintervalGetSup(rhs) >= intervalinfty )
10514  {
10515  /* if rhs is unbounded by above, it is sufficient to get an upper bound on ysqrcoef*y^2 + ylincoef * y */
10516  SCIP_ROUNDMODE roundmode;
10517  SCIP_Real tmp;
10518 
10519  SCIPintervalSet(&lincoef, ylincoef);
10520  tmp = SCIPintervalQuadUpperBound(intervalinfty, ysqrcoef, lincoef, varbnds);
10521  roundmode = SCIPintervalGetRoundingMode();
10523  SCIPintervalSetBounds(&myrhs, SCIPintervalGetInf(rhs) - tmp, intervalinfty);
10524  SCIPintervalSetRoundingMode(roundmode);
10525  }
10526  else if( SCIPintervalGetInf(rhs) <= -intervalinfty )
10527  {
10528  /* if rhs is unbounded by below, it is sufficient to get a lower bound on ysqrcoef*y^2 + ylincoef * y */
10529  SCIP_ROUNDMODE roundmode;
10530  SCIP_Real tmp;
10531 
10532  SCIPintervalSet(&lincoef, -ylincoef);
10533  tmp = -SCIPintervalQuadUpperBound(intervalinfty, -ysqrcoef, lincoef, varbnds);
10534  roundmode = SCIPintervalGetRoundingMode();
10536  SCIPintervalSetBounds(&myrhs, -intervalinfty, SCIPintervalGetSup(rhs) - tmp);
10537  SCIPintervalSetRoundingMode(roundmode);
10538  }
10539  else
10540  {
10541  /* if rhs is bounded, we need both bounds on ysqrcoef*y^2 + ylincoef * y */
10542  SCIP_INTERVAL tmp;
10543 
10544  SCIPintervalSet(&lincoef, ylincoef);
10545  SCIPintervalQuad(intervalinfty, &tmp, ysqrcoef, lincoef, varbnds);
10546  SCIPintervalSub(intervalinfty, &myrhs, rhs, tmp);
10547  }
10548 
10549  /* create equation xsqrcoef * x^2 + (xlincoef + bilincoef * [ylb, yub]) * x \in myrhs */
10550  SCIPintervalMulScalar(intervalinfty, &lincoef, varbnds, bilincoef);
10551  SCIPintervalAddScalar(intervalinfty, &lincoef, lincoef, xlincoef);
10552 
10553  /* propagate bounds on x */
10554  SCIP_CALL( propagateBoundsQuadVar(scip, cons, intervalinfty, x, xsqrcoef, lincoef, myrhs, result, nchgbds) );
10555 
10556  return SCIP_OKAY;
10557 }
10558 #else
10559 /** tries to deduce domain reductions for x in xsqrcoef x^2 + xlincoef x + ysqrcoef y^2 + ylincoef y + bilincoef x y \\in rhs
10560  *
10561  * @note Domain reductions for y are not deduced.
10562  */
10563 static
10565  SCIP* scip, /**< SCIP data structure */
10566  SCIP_CONS* cons, /**< the constraint, where the bilinear term belongs to */
10567  SCIP_Real intervalinfty, /**< infinity value used in interval operations */
10568  SCIP_VAR* x, /**< first variable */
10569  SCIP_Real xsqrcoef, /**< square coefficient of x */
10570  SCIP_Real xlincoef, /**< linear coefficient of x */
10571  SCIP_VAR* y, /**< second variable */
10572  SCIP_Real ysqrcoef, /**< square coefficient of y */
10573  SCIP_Real ylincoef, /**< linear coefficient of y */
10574  SCIP_Real bilincoef, /**< bilinear coefficient of x*y */
10575  SCIP_INTERVAL rhs, /**< right hand side of quadratic equation */
10576  SCIP_RESULT* result, /**< pointer to store result of domain propagation */
10577  int* nchgbds /**< counter to increment if domain reductions are found */
10578  )
10579 {
10580  SCIP_INTERVAL xbnds;
10581  SCIP_INTERVAL ybnds;
10582 
10583  assert(scip != NULL);
10584  assert(cons != NULL);
10585  assert(x != NULL);
10586  assert(y != NULL);
10587  assert(x != y);
10588  assert(result != NULL);
10589  assert(*result == SCIP_DIDNOTFIND || *result == SCIP_REDUCEDDOM);
10590  assert(nchgbds != NULL);
10591  assert(bilincoef != 0.0);
10592 
10593  if( SCIPintervalIsEntire(intervalinfty, rhs) )
10594  return SCIP_OKAY;
10595 
10596  SCIPintervalSetBounds(&xbnds,
10597  -infty2infty(SCIPinfinity(scip), intervalinfty, -MIN(SCIPvarGetLbLocal(x), SCIPvarGetUbLocal(x))), /*lint !e666*/
10598  +infty2infty(SCIPinfinity(scip), intervalinfty, MAX(SCIPvarGetLbLocal(x), SCIPvarGetUbLocal(x)))); /*lint !e666*/
10599  SCIPintervalSetBounds(&ybnds,
10600  -infty2infty(SCIPinfinity(scip), intervalinfty, -MIN(SCIPvarGetLbLocal(y), SCIPvarGetUbLocal(y))), /*lint !e666*/
10601  +infty2infty(SCIPinfinity(scip), intervalinfty, MAX(SCIPvarGetLbLocal(y), SCIPvarGetUbLocal(y)))); /*lint !e666*/
10602 
10603  /* try to find domain reductions for x */
10604  SCIPintervalSolveBivariateQuadExpressionAllScalar(intervalinfty, &xbnds, xsqrcoef, ysqrcoef, bilincoef, xlincoef, ylincoef, rhs, xbnds, ybnds);
10605 
10606  if( SCIPintervalIsEmpty(intervalinfty, xbnds) )
10607  {
10608  SCIPdebugMsg(scip, "found <%s> infeasible due to domain propagation for quadratic variable <%s>\n", SCIPconsGetName(cons), SCIPvarGetName(x));
10609  *result = SCIP_CUTOFF;
10610  return SCIP_OKAY;
10611  }
10612 
10613  if( !SCIPisInfinity(scip, -SCIPintervalGetInf(xbnds)) )
10614  {
10615  SCIP_CALL( propagateBoundsTightenVarLb(scip, cons, intervalinfty, x, SCIPintervalGetInf(xbnds), result, nchgbds) );
10616  if( *result == SCIP_CUTOFF )
10617  return SCIP_OKAY;
10618  }
10619 
10620  if( !SCIPisInfinity(scip, SCIPintervalGetSup(xbnds)) )
10621  {
10622  SCIP_CALL( propagateBoundsTightenVarUb(scip, cons, intervalinfty, x, SCIPintervalGetSup(xbnds), result, nchgbds) );
10623  if( *result == SCIP_CUTOFF )
10624  return SCIP_OKAY;
10625  }
10626 
10627  return SCIP_OKAY;
10628 }
10629 #endif
10630 
10631 /** computes the minimal and maximal activity for the quadratic part in a constraint data
10632  *
10633  * Only sums up terms that contribute finite values.
10634  * Gives the number of terms that contribute infinite values.
10635  * Only computes those activities where the corresponding side of the constraint is finite.
10636  */
10637 static
10639  SCIP* scip, /**< SCIP data structure */
10640  SCIP_CONSDATA* consdata, /**< constraint data */
10641  SCIP_Real intervalinfty, /**< infinity value used in interval operations */
10642  SCIP_Real* minquadactivity, /**< minimal activity of quadratic variable terms where only terms with finite minimal activity contribute */
10643  SCIP_Real* maxquadactivity, /**< maximal activity of quadratic variable terms where only terms with finite maximal activity contribute */
10644  int* minactivityinf, /**< number of quadratic variables that contribute -infinity to minimal activity */
10645  int* maxactivityinf, /**< number of quadratic variables that contribute +infinity to maximal activity */
10646  SCIP_INTERVAL* quadactcontr /**< contribution of each quadratic variables to quadactivity */
10647  )
10648 { /*lint --e{666}*/
10649  SCIP_ROUNDMODE prevroundmode;
10650  int i;
10651  int j;
10652  int k;
10653  SCIP_INTERVAL tmp;
10654  SCIP_Real bnd;
10655  SCIP_INTERVAL xrng;
10656  SCIP_INTERVAL lincoef;
10657 
10658  assert(scip != NULL);
10659  assert(consdata != NULL);
10660  assert(minquadactivity != NULL);
10661  assert(maxquadactivity != NULL);
10662  assert(minactivityinf != NULL);
10663  assert(maxactivityinf != NULL);
10664  assert(quadactcontr != NULL);
10665 
10666  /* if lhs is -infinite, then we do not compute a maximal activity, so we set it to infinity
10667  * if rhs is infinite, then we do not compute a minimal activity, so we set it to -infinity
10668  */
10669  *minquadactivity = SCIPisInfinity(scip, consdata->rhs) ? -intervalinfty : 0.0;
10670  *maxquadactivity = SCIPisInfinity(scip, -consdata->lhs) ? intervalinfty : 0.0;
10671 
10672  *minactivityinf = 0;
10673  *maxactivityinf = 0;
10674 
10675  if( consdata->nquadvars == 0 )
10676  {
10677  SCIPintervalSet(&consdata->quadactivitybounds, 0.0);
10678  return;
10679  }
10680 
10681  for( i = 0; i < consdata->nquadvars; ++i )
10682  {
10683  /* there should be no quadratic variables fixed at -/+ infinity due to our locks */
10684  assert(!SCIPisInfinity(scip, SCIPvarGetLbLocal(consdata->quadvarterms[i].var)));
10685  assert(!SCIPisInfinity(scip, -SCIPvarGetUbLocal(consdata->quadvarterms[i].var)));
10686 
10687  SCIPintervalSetBounds(&quadactcontr[i], -intervalinfty, intervalinfty);
10688 
10689  SCIPintervalSetBounds(&xrng,
10690  -infty2infty(SCIPinfinity(scip), intervalinfty, -MIN(SCIPvarGetLbLocal(consdata->quadvarterms[i].var), SCIPvarGetUbLocal(consdata->quadvarterms[i].var))),
10691  +infty2infty(SCIPinfinity(scip), intervalinfty, MAX(SCIPvarGetLbLocal(consdata->quadvarterms[i].var), SCIPvarGetUbLocal(consdata->quadvarterms[i].var))));
10692 
10693  SCIPintervalSet(&lincoef, consdata->quadvarterms[i].lincoef);
10694  for( j = 0; j < consdata->quadvarterms[i].nadjbilin; ++j )
10695  {
10696  k = consdata->quadvarterms[i].adjbilin[j];
10697  if( consdata->bilinterms[k].var1 != consdata->quadvarterms[i].var )
10698  continue; /* handle this term later */
10699 
10700  SCIPintervalSetBounds(&tmp,
10701  -infty2infty(SCIPinfinity(scip), intervalinfty, -MIN(SCIPvarGetLbLocal(consdata->bilinterms[k].var2), SCIPvarGetUbLocal(consdata->bilinterms[k].var2))),
10702  +infty2infty(SCIPinfinity(scip), intervalinfty, MAX(SCIPvarGetLbLocal(consdata->bilinterms[k].var2), SCIPvarGetUbLocal(consdata->bilinterms[k].var2))));
10703  SCIPintervalMulScalar(intervalinfty, &tmp, tmp, consdata->bilinterms[k].coef);
10704  SCIPintervalAdd(intervalinfty, &lincoef, lincoef, tmp);
10705  }
10706 
10707  if( !SCIPisInfinity(scip, -consdata->lhs) )
10708  {
10709  /* compute maximal activity only if there is a finite left hand side */
10710  bnd = SCIPintervalQuadUpperBound(intervalinfty, consdata->quadvarterms[i].sqrcoef, lincoef, xrng);
10711  if( bnd >= intervalinfty )
10712  {
10713  ++*maxactivityinf;
10714  }
10715  else if( SCIPisInfinity(scip, -bnd) )
10716  {
10717  /* if maximal activity is below value for -infinity, let's take -1e10 as upper bound on maximal activity
10718  * @todo Something better?
10719  */
10720  bnd = -sqrt(SCIPinfinity(scip));
10721  *maxquadactivity += bnd;
10722  quadactcontr[i].sup = bnd;
10723  }
10724  else
10725  {
10726  prevroundmode = SCIPintervalGetRoundingMode();
10728  *maxquadactivity += bnd;
10729  SCIPintervalSetRoundingMode(prevroundmode);
10730  quadactcontr[i].sup = bnd;
10731  }
10732  }
10733 
10734  if( !SCIPisInfinity(scip, consdata->rhs) )
10735  {
10736  /* compute minimal activity only if there is a finite right hand side */
10737  SCIPintervalSetBounds(&lincoef, -SCIPintervalGetSup(lincoef), -SCIPintervalGetInf(lincoef));
10738  bnd = -SCIPintervalQuadUpperBound(intervalinfty, -consdata->quadvarterms[i].sqrcoef, lincoef, xrng);
10739 
10740  if( bnd <= -intervalinfty )
10741  {
10742  ++*minactivityinf;
10743  }
10744  else if( SCIPisInfinity(scip, bnd) )
10745  {
10746  /* if minimal activity is above value for infinity, let's take 1e10 as lower bound on minimal activity
10747  * @todo Something better?
10748  */
10749  bnd = sqrt(SCIPinfinity(scip));
10750  *minquadactivity += bnd;
10751  quadactcontr[i].inf = bnd;
10752  }
10753  else
10754  {
10755  prevroundmode = SCIPintervalGetRoundingMode();
10757  *minquadactivity += bnd;
10758  SCIPintervalSetRoundingMode(prevroundmode);
10759  quadactcontr[i].inf = bnd;
10760  }
10761  }
10762  }
10763 
10764  SCIPintervalSetBounds(&consdata->quadactivitybounds,
10765  (*minactivityinf > 0 ? -intervalinfty : *minquadactivity),
10766  (*maxactivityinf > 0 ? intervalinfty : *maxquadactivity));
10767  assert(!SCIPintervalIsEmpty(intervalinfty, consdata->quadactivitybounds));
10768 }
10769 
10770 /** propagates bounds on a quadratic constraint */
10771 static
10773  SCIP* scip, /**< SCIP data structure */
10774  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
10775  SCIP_CONS* cons, /**< constraint to process */
10776  SCIP_RESULT* result, /**< pointer to store the result of the propagation call */
10777  int* nchgbds, /**< buffer where to add the the number of changed bounds */
10778  SCIP_Bool* redundant /**< buffer where to store whether constraint has been found to be redundant */
10779  )
10780 { /*lint --e{666}*/
10781  SCIP_CONSDATA* consdata;
10782  SCIP_INTERVAL consbounds; /* lower and upper bounds of constraint */
10783  SCIP_INTERVAL consactivity; /* activity of linear plus quadratic part */
10784  SCIP_Real intervalinfty; /* infinity used for interval computation */
10785  SCIP_Real minquadactivity; /* lower bound on finite activities of quadratic part */
10786  SCIP_Real maxquadactivity; /* upper bound on finite activities of quadratic part */
10787  int quadminactinf; /* number of quadratic variables that contribute -infinity to minimal activity of quadratic term */
10788  int quadmaxactinf; /* number of quadratic variables that contribute +infinity to maximal activity of quadratic term */
10789  SCIP_INTERVAL* quadactcontr; /* contribution of each quadratic variable term to quadactivity */
10790 
10791  SCIP_VAR* var;
10792  SCIP_INTERVAL rhs; /* right hand side of quadratic equation */
10793  SCIP_INTERVAL tmp;
10794  SCIP_ROUNDMODE roundmode;
10795  SCIP_Real bnd;
10796  int i;
10797 
10798  assert(scip != NULL);
10799  assert(conshdlr != NULL);
10800  assert(cons != NULL);
10801  assert(result != NULL);
10802  assert(nchgbds != NULL);
10803  assert(redundant != NULL);
10804 
10805  consdata = SCIPconsGetData(cons);
10806  assert(consdata != NULL);
10807 
10808  *result = SCIP_DIDNOTRUN;
10809  *redundant = FALSE;
10810 
10811  *result = SCIP_DIDNOTFIND;
10812 
10813  intervalinfty = 1000 * SCIPinfinity(scip) * SCIPinfinity(scip);
10814 
10815  quadactcontr = NULL;
10816  quadminactinf = -1;
10817  quadmaxactinf = -1;
10818 
10819  SCIPdebugMsg(scip, "start domain propagation for constraint <%s>\n", SCIPconsGetName(cons));
10820 
10821  /* make sure we have activity of linear term and that they are consistent */
10822  consdataUpdateLinearActivity(scip, consdata, intervalinfty);
10823  assert(consdata->minlinactivity != SCIP_INVALID); /*lint !e777 */
10824  assert(consdata->maxlinactivity != SCIP_INVALID); /*lint !e777 */
10825  assert(consdata->minlinactivityinf >= 0);
10826  assert(consdata->maxlinactivityinf >= 0);
10827 
10828  /* sort quadratic variable terms, in case we need to search for terms occuring in bilinear terms later
10829  * we sort here already, since we rely on a constant variable order during this method
10830  */
10831  if( consdata->nbilinterms > 0 )
10832  {
10833  SCIP_CALL( consdataSortQuadVarTerms(scip, consdata) );
10834  }
10835 
10836  /* compute activity of quad term part, if not up to date
10837  * in that case, we also collect the contribution of each quad var term for later */
10838  if( SCIPintervalIsEmpty(intervalinfty, consdata->quadactivitybounds) )
10839  {
10840  SCIP_CALL( SCIPallocBufferArray(scip, &quadactcontr, consdata->nquadvars) );
10841  propagateBoundsGetQuadActivity(scip, consdata, intervalinfty, &minquadactivity, &maxquadactivity, &quadminactinf, &quadmaxactinf, quadactcontr);
10842  assert(!SCIPintervalIsEmpty(intervalinfty, consdata->quadactivitybounds));
10843  }
10844 
10845  SCIPdebugMsg(scip, "linear activity: [%g, %g] quadratic activity: [%g, %g]\n",
10846  (consdata->minlinactivityinf > 0 ? -intervalinfty : consdata->minlinactivity),
10847  (consdata->maxlinactivityinf > 0 ? intervalinfty : consdata->maxlinactivity),
10848  consdata->quadactivitybounds.inf, consdata->quadactivitybounds.sup);
10849 
10850  /* extend constraint bounds by epsilon to avoid some numerical difficulties */
10851  SCIPintervalSetBounds(&consbounds,
10852  -infty2infty(SCIPinfinity(scip), intervalinfty, -consdata->lhs+SCIPepsilon(scip)),
10853  +infty2infty(SCIPinfinity(scip), intervalinfty, consdata->rhs+SCIPepsilon(scip)));
10854 
10855  /* check redundancy and infeasibility */
10856  SCIPintervalSetBounds(&consactivity, consdata->minlinactivityinf > 0 ? -intervalinfty : consdata->minlinactivity,
10857  consdata->maxlinactivityinf > 0 ? intervalinfty : consdata->maxlinactivity);
10858  SCIPintervalAdd(intervalinfty, &consactivity, consactivity, consdata->quadactivitybounds);
10859  if( SCIPintervalIsSubsetEQ(intervalinfty, consactivity, consbounds) )
10860  {
10861  SCIPdebugMsg(scip, "found constraint <%s> to be redundant: sides: [%g, %g], activity: [%g, %g]\n",
10862  SCIPconsGetName(cons), consdata->lhs, consdata->rhs, SCIPintervalGetInf(consactivity), SCIPintervalGetSup(consactivity));
10863  *redundant = TRUE;
10864  goto CLEANUP;
10865  }
10866 
10867  /* was SCIPintervalAreDisjoint(consbounds, consactivity), but that would allow violations up to eps only
10868  * we need to decide feasibility w.r.t. feastol (but still want to propagate w.r.t. eps)
10869  */
10870  if( (!SCIPisInfinity(scip, -consdata->lhs) && SCIPisGT(scip, consdata->lhs-SCIPfeastol(scip), SCIPintervalGetSup(consactivity))) ||
10871  (!SCIPisInfinity(scip, consdata->rhs) && SCIPisLT(scip, consdata->rhs+SCIPfeastol(scip), SCIPintervalGetInf(consactivity))) )
10872  {
10873  SCIPdebugMsg(scip, "found constraint <%s> to be infeasible; sides: [%g, %g], activity: [%g, %g], infeas: %g\n",
10874  SCIPconsGetName(cons), consdata->lhs, consdata->rhs, SCIPintervalGetInf(consactivity), SCIPintervalGetSup(consactivity),
10875  MAX(consdata->lhs - SCIPintervalGetSup(consactivity), SCIPintervalGetInf(consactivity) - consdata->rhs));
10876  *result = SCIP_CUTOFF;
10877  goto CLEANUP;
10878  }
10879 
10880  /* propagate linear part \in rhs = consbounds - quadactivity (use the one from consdata, since that includes infinities) */
10881  SCIPintervalSub(intervalinfty, &rhs, consbounds, consdata->quadactivitybounds);
10882  if( !SCIPintervalIsEntire(intervalinfty, rhs) )
10883  {
10884  SCIP_Real coef;
10885 
10886  for( i = 0; i < consdata->nlinvars; ++i )
10887  {
10888  coef = consdata->lincoefs[i];
10889  var = consdata->linvars[i];
10890 
10891  /* skip fixed variables
10892  * @todo is that a good or a bad idea?
10893  * we can't expect much more tightening, but may detect infeasiblity, but shouldn't the check on the constraints activity detect that?
10894  */
10895  if( SCIPisEQ(scip, SCIPvarGetLbLocal(var), SCIPvarGetUbLocal(var)) )
10896  continue;
10897 
10898  /* due to large variable bounds and large coefficients, it might happen that the activity of the linear part
10899  * exceeds +/-SCIPinfinity() after updating the activities in consdataUpdateLinearActivity{Lb,Ub}Change; in
10900  * order to detect this case we need to check whether the value of consdata->{min,max}linactivity is infinite
10901  * (see #1433)
10902  */
10903  if( coef > 0.0 )
10904  {
10905  if( SCIPintervalGetSup(rhs) < intervalinfty )
10906  {
10907  assert(consdata->minlinactivity != SCIP_INVALID); /*lint !e777 */
10908  /* try to tighten the upper bound on var x */
10909  if( consdata->minlinactivityinf == 0 && !SCIPisInfinity(scip, -consdata->minlinactivity) )
10910  {
10911  assert(!SCIPisInfinity(scip, -SCIPvarGetLbLocal(var)));
10912  /* tighten upper bound on x to (rhs.sup - (minlinactivity - coef * xlb)) / coef */
10913  roundmode = SCIPintervalGetRoundingMode();
10915  bnd = SCIPintervalGetSup(rhs);
10916  bnd -= consdata->minlinactivity;
10917  bnd += coef * SCIPvarGetLbLocal(var);
10918  bnd /= coef;
10919  SCIPintervalSetRoundingMode(roundmode);
10920  SCIP_CALL( propagateBoundsTightenVarUb(scip, cons, intervalinfty, var, bnd, result, nchgbds) );
10921  if( *result == SCIP_CUTOFF )
10922  break;
10923  }
10924  else if( consdata->minlinactivityinf == 1 && SCIPisInfinity(scip, -SCIPvarGetLbLocal(var)) )
10925  {
10926  /* x was the variable that made the minimal linear activity equal -infinity, so
10927  * we tighten upper bound on x to just (rhs.sup - minlinactivity) / coef */
10928  roundmode = SCIPintervalGetRoundingMode();
10930  bnd = SCIPintervalGetSup(rhs);
10931  bnd -= consdata->minlinactivity;
10932  bnd /= coef;
10933  SCIPintervalSetRoundingMode(roundmode);
10934  SCIP_CALL( propagateBoundsTightenVarUb(scip, cons, intervalinfty, var, bnd, result, nchgbds) );
10935  if( *result == SCIP_CUTOFF )
10936  break;
10937  }
10938  /* otherwise the minimal activity is -infinity and x is not solely responsible for this */
10939  }
10940 
10941  if( SCIPintervalGetInf(rhs) > -intervalinfty )
10942  {
10943  assert(consdata->maxlinactivity != SCIP_INVALID); /*lint !e777 */
10944  /* try to tighten the lower bound on var x */
10945  if( consdata->maxlinactivityinf == 0 && !SCIPisInfinity(scip, consdata->maxlinactivity) )
10946  {
10947  assert(!SCIPisInfinity(scip, SCIPvarGetUbLocal(var)));
10948  /* tighten lower bound on x to (rhs.inf - (maxlinactivity - coef * xub)) / coef */
10949  roundmode = SCIPintervalGetRoundingMode();
10951  bnd = SCIPintervalGetInf(rhs);
10952  bnd -= consdata->maxlinactivity;
10953  bnd += coef * SCIPvarGetUbLocal(var);
10954  bnd /= coef;
10955  SCIPintervalSetRoundingMode(roundmode);
10956  SCIP_CALL( propagateBoundsTightenVarLb(scip, cons, intervalinfty, var, bnd, result, nchgbds) );
10957  if( *result == SCIP_CUTOFF )
10958  break;
10959  }
10960  else if( consdata->maxlinactivityinf == 1 && SCIPisInfinity(scip, SCIPvarGetUbLocal(var)) )
10961  {
10962  /* x was the variable that made the maximal linear activity equal infinity, so
10963  * we tighten upper bound on x to just (rhs.inf - maxlinactivity) / coef */
10964  roundmode = SCIPintervalGetRoundingMode();
10966  bnd = SCIPintervalGetInf(rhs);
10967  bnd -= consdata->maxlinactivity;
10968  bnd /= coef;
10969  SCIPintervalSetRoundingMode(roundmode);
10970  SCIP_CALL( propagateBoundsTightenVarLb(scip, cons, intervalinfty, var, bnd, result, nchgbds) );
10971  if( *result == SCIP_CUTOFF )
10972  break;
10973  }
10974  /* otherwise the maximal activity is +infinity and x is not solely responsible for this */
10975  }
10976  }
10977  else
10978  {
10979  assert(coef < 0.0 );
10980  if( SCIPintervalGetInf(rhs) > -intervalinfty )
10981  {
10982  assert(consdata->maxlinactivity != SCIP_INVALID); /*lint !e777 */
10983  /* try to tighten the upper bound on var x */
10984  if( consdata->maxlinactivityinf == 0 && !SCIPisInfinity(scip, consdata->maxlinactivity) )
10985  {
10986  assert(!SCIPisInfinity(scip, SCIPvarGetLbLocal(var)));
10987  /* compute upper bound on x to (maxlinactivity - coef * xlb) - rhs.inf / (-coef) */
10988  roundmode = SCIPintervalGetRoundingMode();
10990  bnd = consdata->maxlinactivity;
10991  bnd += (-coef) * SCIPvarGetLbLocal(var);
10992  bnd -= SCIPintervalGetInf(rhs);
10993  bnd /= (-coef);
10994  SCIPintervalSetRoundingMode(roundmode);
10995  SCIP_CALL( propagateBoundsTightenVarUb(scip, cons, intervalinfty, var, bnd, result, nchgbds) );
10996  if( *result == SCIP_CUTOFF )
10997  break;
10998  }
10999  else if( consdata->maxlinactivityinf == 1 && SCIPisInfinity(scip, -SCIPvarGetLbLocal(var)) )
11000  {
11001  /* x was the variable that made the maximal linear activity equal infinity, so
11002  * we tighten upper bound on x to just (maxlinactivity - rhs.inf) / (-coef) */
11003  roundmode = SCIPintervalGetRoundingMode();
11005  bnd = consdata->maxlinactivity;
11006  bnd -= SCIPintervalGetInf(rhs);
11007  bnd /= (-coef);
11008  SCIPintervalSetRoundingMode(roundmode);
11009  SCIP_CALL( propagateBoundsTightenVarUb(scip, cons, intervalinfty, var, bnd, result, nchgbds) );
11010  if( *result == SCIP_CUTOFF )
11011  break;
11012  }
11013  /* otherwise the maximal activity is infinity and x is not solely responsible for this */
11014  }
11015 
11016  if( SCIPintervalGetSup(rhs) < intervalinfty )
11017  {
11018  assert(consdata->minlinactivity != SCIP_INVALID); /*lint !e777 */
11019  /* try to tighten the lower bound on var x */
11020  if( consdata->minlinactivityinf == 0 && !SCIPisInfinity(scip, -consdata->minlinactivity) )
11021  {
11022  assert(!SCIPisInfinity(scip, SCIPvarGetUbLocal(var)));
11023  /* compute lower bound on x to (minlinactivity - coef * xub) - rhs.sup / (-coef) */
11024  roundmode = SCIPintervalGetRoundingMode();
11026  bnd = consdata->minlinactivity;
11027  bnd += (-coef) * SCIPvarGetUbLocal(var);
11028  bnd -= SCIPintervalGetSup(rhs);
11029  bnd /= (-coef);
11030  SCIPintervalSetRoundingMode(roundmode);
11031  SCIP_CALL( propagateBoundsTightenVarLb(scip, cons, intervalinfty, var, bnd, result, nchgbds) );
11032  if( *result == SCIP_CUTOFF )
11033  break;
11034  }
11035  else if( consdata->minlinactivityinf == 1 && SCIPisInfinity(scip, SCIPvarGetUbLocal(var)) )
11036  {
11037  /* x was the variable that made the maximal linear activity equal -infinity, so
11038  * we tighten lower bound on x to just (minlinactivity - rhs.sup) / (-coef) */
11039  roundmode = SCIPintervalGetRoundingMode();
11041  bnd = consdata->minlinactivity;
11042  bnd -= SCIPintervalGetSup(rhs);
11043  bnd /= (-coef);
11044  SCIPintervalSetRoundingMode(roundmode);
11045  SCIP_CALL( propagateBoundsTightenVarLb(scip, cons, intervalinfty, var, bnd, result, nchgbds) );
11046  if( *result == SCIP_CUTOFF )
11047  break;
11048  }
11049  /* otherwise the minimal activity is -infinity and x is not solely responsible for this */
11050  }
11051  }
11052  }
11053  if( *result == SCIP_CUTOFF )
11054  goto CLEANUP;
11055  }
11056 
11057  /* propagate quadratic part \in rhs = consbounds - linactivity */
11058  assert(consdata->minlinactivity != SCIP_INVALID); /*lint !e777 */
11059  assert(consdata->maxlinactivity != SCIP_INVALID); /*lint !e777 */
11060  consdataUpdateLinearActivity(scip, consdata, intervalinfty); /* make sure, activities of linear part did not become invalid by above bound changes, if any */
11061  assert(consdata->minlinactivityinf > 0 || consdata->maxlinactivityinf > 0 || consdata->minlinactivity <= consdata->maxlinactivity);
11062  SCIPintervalSetBounds(&tmp,
11063  (consdata->minlinactivityinf > 0 ? -intervalinfty : consdata->minlinactivity),
11064  (consdata->maxlinactivityinf > 0 ? intervalinfty : consdata->maxlinactivity));
11065  SCIPintervalSub(intervalinfty, &rhs, consbounds, tmp);
11066  if( !SCIPintervalIsEntire(intervalinfty, rhs) )
11067  {
11068  if( consdata->nquadvars == 1 )
11069  {
11070  /* quadratic part is just a*x^2+b*x -> a common case that we treat directly */
11071  SCIP_INTERVAL lincoef; /* linear coefficient of quadratic equation */
11072 
11073  assert(consdata->nbilinterms == 0);
11074 
11075  var = consdata->quadvarterms[0].var;
11076  SCIPintervalSet(&lincoef, consdata->quadvarterms[0].lincoef);
11077 
11078  /* propagate a*x^2 + b*x \in rhs */
11079  SCIP_CALL( propagateBoundsQuadVar(scip, cons, intervalinfty, var, consdata->quadvarterms[0].sqrcoef, lincoef, rhs, result, nchgbds) );
11080  }
11081  else if( consdata->nbilinterms == 1 && consdata->nquadvars == 2 )
11082  {
11083  /* quadratic part is just ax*x^2+bx*x + ay*y^2+by*y + c*xy -> a common case that we treat directly */
11084  assert(consdata->bilinterms[0].var1 == consdata->quadvarterms[0].var || consdata->bilinterms[0].var1 == consdata->quadvarterms[1].var);
11085  assert(consdata->bilinterms[0].var2 == consdata->quadvarterms[0].var || consdata->bilinterms[0].var2 == consdata->quadvarterms[1].var);
11086 
11087  /* find domain reductions for x from a_x x^2 + b_x x + a_y y^2 + b_y y + c x y \in rhs */
11088  SCIP_CALL( propagateBoundsBilinearTerm(scip, cons, intervalinfty,
11089  consdata->quadvarterms[0].var, consdata->quadvarterms[0].sqrcoef, consdata->quadvarterms[0].lincoef,
11090  consdata->quadvarterms[1].var, consdata->quadvarterms[1].sqrcoef, consdata->quadvarterms[1].lincoef,
11091  consdata->bilinterms[0].coef,
11092  rhs, result, nchgbds) );
11093  if( *result != SCIP_CUTOFF )
11094  {
11095  /* find domain reductions for y from a_x x^2 + b_x x + a_y y^2 + b_y y + c x y \in rhs */
11096  SCIP_CALL( propagateBoundsBilinearTerm(scip, cons, intervalinfty,
11097  consdata->quadvarterms[1].var, consdata->quadvarterms[1].sqrcoef, consdata->quadvarterms[1].lincoef,
11098  consdata->quadvarterms[0].var, consdata->quadvarterms[0].sqrcoef, consdata->quadvarterms[0].lincoef,
11099  consdata->bilinterms[0].coef,
11100  rhs, result, nchgbds) );
11101  }
11102  }
11103  else
11104  {
11105  /* general case */
11106 
11107  /* compute "advanced" information on quad var term activities, if not up-to-date */
11108  if( quadminactinf == -1 )
11109  {
11110  assert(quadactcontr == NULL);
11111  SCIP_CALL( SCIPallocBufferArray(scip, &quadactcontr, consdata->nquadvars) );
11112  propagateBoundsGetQuadActivity(scip, consdata, intervalinfty, &minquadactivity, &maxquadactivity, &quadminactinf, &quadmaxactinf, quadactcontr);
11113  }
11114  assert(quadactcontr != NULL);
11115  assert(quadminactinf >= 0);
11116  assert(quadmaxactinf >= 0);
11117 
11118  /* if the quad activities are not hopelessly unbounded on useful sides, try to deduce domain reductions on quad vars */
11119  if( (SCIPintervalGetSup(rhs) < intervalinfty && quadminactinf <= 1) ||
11120  ( SCIPintervalGetInf(rhs) > -intervalinfty && quadmaxactinf <= 1) )
11121  {
11122  SCIP_INTERVAL lincoef;
11123  SCIP_INTERVAL rhs2;
11124  int j;
11125  int k;
11126 
11127  for( i = 0; i < consdata->nquadvars; ++i )
11128  {
11129  var = consdata->quadvarterms[i].var;
11130 
11131  /* skip fixed variables
11132  * @todo is that a good or a bad idea?
11133  * we can't expect much more tightening, but may detect infeasiblity, but shouldn't the check on the constraints activity detect that?
11134  */
11135  if( SCIPisEQ(scip, SCIPvarGetLbLocal(var), SCIPvarGetUbLocal(var)) )
11136  continue;
11137 
11138  /* compute rhs2 such that we can propagate quadvarterm(x_i) \in rhs2 */
11139 
11140  /* setup rhs2.sup = rhs.sup - (quadactivity.inf - quadactcontr[i].inf), if everything were finite
11141  * if only quadactcontr[i].inf is infinite (i.e., the other i are all finite), we just get rhs2.sup = rhs.sup
11142  * otherwise we get rhs2.sup = infinity */
11143  if( SCIPintervalGetSup(rhs) < intervalinfty )
11144  {
11145  if( quadminactinf == 0 || (quadminactinf == 1 && SCIPintervalGetInf(quadactcontr[i]) <= -intervalinfty) )
11146  {
11147  roundmode = SCIPintervalGetRoundingMode();
11149  rhs2.sup = rhs.sup - minquadactivity; /*lint !e644*/
11150  /* if the residual quad min activity w.r.t. quad var term i is finite and nonzero, so add it to right hand side */
11151  if( quadminactinf == 0 && SCIPintervalGetInf(quadactcontr[i]) != 0.0 )
11152  rhs2.sup += SCIPintervalGetInf(quadactcontr[i]);
11153  SCIPintervalSetRoundingMode(roundmode);
11154  }
11155  else
11156  {
11157  /* there are either >= 2 quad var terms contributing -infinity, or there is one which is not i */
11158  rhs2.sup = intervalinfty;
11159  }
11160  }
11161  else
11162  {
11163  rhs2.sup = intervalinfty;
11164  }
11165 
11166  /* setup rhs2.inf = rhs.inf - (quadactivity.sup - quadactcontr[i].sup), see also above */
11167  if( SCIPintervalGetInf(rhs) > -intervalinfty )
11168  {
11169  if( quadmaxactinf == 0 || (quadmaxactinf == 1 && SCIPintervalGetSup(quadactcontr[i]) >= intervalinfty) )
11170  {
11171  roundmode = SCIPintervalGetRoundingMode();
11173  rhs2.inf = rhs.inf - maxquadactivity; /*lint !e644*/
11174  /* if the residual quad max activity w.r.t. quad var term i is finite and nonzero, so add it to right hand side */
11175  if( quadmaxactinf == 0 && SCIPintervalGetSup(quadactcontr[i]) != 0.0 )
11176  rhs2.inf += SCIPintervalGetSup(quadactcontr[i]);
11177  SCIPintervalSetRoundingMode(roundmode);
11178  }
11179  else
11180  {
11181  /* there are either >= 2 quad var terms contributing infinity, or there is one which is not i */
11182  rhs2.inf = -intervalinfty;
11183  }
11184  }
11185  else
11186  {
11187  rhs2.inf = -intervalinfty;
11188  }
11189  assert(!SCIPintervalIsEmpty(intervalinfty, rhs2));
11190 
11191  /* if rhs2 is entire, then there is nothing we could propagate */
11192  if( SCIPintervalIsEntire(intervalinfty, rhs2) )
11193  continue;
11194 
11195  /* assemble linear coefficient for quad equation a*x^2 + b*x \in rhs2 */
11196  SCIPintervalSet(&lincoef, consdata->quadvarterms[i].lincoef);
11197  for( j = 0; j < consdata->quadvarterms[i].nadjbilin; ++j )
11198  {
11199  k = consdata->quadvarterms[i].adjbilin[j];
11200 #if 1
11201  if( consdata->bilinterms[k].var1 == var )
11202  {
11203  /* bilinear term k contributes to the activity of quad var term i, so just add bounds to linear coef */
11204  SCIPintervalSetBounds(&tmp,
11205  -infty2infty(SCIPinfinity(scip), intervalinfty, -MIN(SCIPvarGetLbLocal(consdata->bilinterms[k].var2), SCIPvarGetUbLocal(consdata->bilinterms[k].var2))),
11206  +infty2infty(SCIPinfinity(scip), intervalinfty, MAX(SCIPvarGetLbLocal(consdata->bilinterms[k].var2), SCIPvarGetUbLocal(consdata->bilinterms[k].var2))));
11207  SCIPintervalMulScalar(intervalinfty, &tmp, tmp, consdata->bilinterms[k].coef);
11208  SCIPintervalAdd(intervalinfty, &lincoef, lincoef, tmp);
11209  }
11210  else
11211  {
11212  /* bilinear term k does not contribute to the activity of quad var term i
11213  * so bounds on term k are contained in rhs2
11214  * if they are finite, we try to remove them from rhs2 and update lincoef instead
11215  * if the bounds on bilinear term k as added to rhs2 are old due to recent bound tightening, we may not do best possible, but still correct
11216  * HOWEVER: when computing rhs2, we may not just have added the bounds for the bilinear term, but for the associated quadratic term
11217  * for this complete term, we used SCIPintervalQuad to compute the bounds
11218  * since we do not want to repeat a call to SCIPintervalQuad for that quadratic term with bilinear term k removed,
11219  * we only remove the bounds for the bilinear term k from rhs2 if the associated quadratic term consists only of this bilinear term,
11220  * i.e., the quadratic term corresponding to var1 should be only var1*var2, but have no square or linear coefs or other bilinear terms
11221  * (for efficiency reasons, we check here only if there are any other bilinear terms than var1*var2 associated with var1, even if they are not associated with the quad var term for var1)
11222  */
11223  SCIP_INTERVAL me;
11224  SCIP_INTERVAL bilinbounds;
11225  int otherpos;
11226 
11227  assert(consdata->bilinterms[k].var2 == var);
11228 
11229  assert(consdata->quadvarssorted);
11230  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, consdata->bilinterms[k].var1, &otherpos) );
11231  assert(otherpos >= 0);
11232  assert(consdata->quadvarterms[otherpos].var == consdata->bilinterms[k].var1);
11233 
11234  if( (consdata->quadvarterms[otherpos].sqrcoef != 0.0) || consdata->quadvarterms[otherpos].lincoef != 0.0 ||
11235  consdata->quadvarterms[otherpos].nadjbilin > 1 )
11236  continue;
11237 
11238  /* set tmp to bounds of other variable and multiply with bilin coef */
11239  SCIPintervalSetBounds(&tmp,
11240  -infty2infty(SCIPinfinity(scip), intervalinfty, -MIN(SCIPvarGetLbLocal(consdata->bilinterms[k].var1), SCIPvarGetUbLocal(consdata->bilinterms[k].var1))),
11241  +infty2infty(SCIPinfinity(scip), intervalinfty, MAX(SCIPvarGetLbLocal(consdata->bilinterms[k].var1), SCIPvarGetUbLocal(consdata->bilinterms[k].var1))));
11242  SCIPintervalMulScalar(intervalinfty, &tmp, tmp, consdata->bilinterms[k].coef);
11243 
11244  /* set me to bounds of i'th variable */
11246  -infty2infty(SCIPinfinity(scip), intervalinfty, -MIN(SCIPvarGetLbLocal(consdata->bilinterms[k].var2), SCIPvarGetUbLocal(consdata->bilinterms[k].var2))),
11247  +infty2infty(SCIPinfinity(scip), intervalinfty, MAX(SCIPvarGetLbLocal(consdata->bilinterms[k].var2), SCIPvarGetUbLocal(consdata->bilinterms[k].var2))));
11248 
11249  /* remove me*tmp from rhs2 */
11250 
11251  roundmode = SCIPintervalGetRoundingMode();
11252 
11253  if( rhs2.inf > -intervalinfty )
11254  {
11255  /* need upward rounding for SCIPintervalMulSup */
11257  SCIPintervalMulSup(intervalinfty, &bilinbounds, me, tmp);
11258  /* rhs2.inf += bilinbounds.sup, but we are in upward rounding */
11259  if( bilinbounds.sup < intervalinfty )
11260  rhs2.inf = SCIPintervalNegateReal(SCIPintervalNegateReal(rhs2.inf) - bilinbounds.sup);
11261  }
11262 
11263  if( rhs2.sup < intervalinfty )
11264  {
11265  /* need downward rounding for SCIPintervalMulInf */
11267  SCIPintervalMulInf(intervalinfty, &bilinbounds, me, tmp);
11268  /* rhs2.sup += bilinbounds.inf, but we are in downward rounding */
11269  if( bilinbounds.inf > -intervalinfty )
11270  rhs2.sup = SCIPintervalNegateReal(SCIPintervalNegateReal(rhs2.sup) - bilinbounds.inf);
11271  }
11272 
11273  SCIPintervalSetRoundingMode(roundmode);
11274 
11275  /* in theory, rhs2 should not be empty here
11276  * what we tried to do here is to remove the contribution of the k'th bilinear term (=bilinbounds) to [minquadactivity,maxquadactivity] from rhs2
11277  * however, quadactivity is computed differently (as x*(a1*y1+...+an*yn)) than bilinbounds (a*ak*yk) and since interval arithmetics do overestimation,
11278  * it can happen that bilinbounds is actually slightly larger than quadactivity, which results in rhs2 being (slightly) empty
11279  * a proper fix could be to compute the quadactivity also as x*a1*y1+...+x*an*yn in propagateBoundsGetQuadAcitivity if sqrcoef=0, but due to taking
11280  * also infinite bounds into account, this complicates the code even further
11281  * instead, I'll just work around this by turning an empty rhs2 into a small non-empty one
11282  */
11283  if( SCIPintervalIsEmpty(intervalinfty, rhs2) )
11284  {
11285  assert(SCIPrelDiff(rhs2.inf, rhs2.sup) < 1e-6);
11286  SCIPswapReals(&rhs2.inf, &rhs2.sup);
11287  }
11288 
11289  /* add tmp to lincoef */
11290  SCIPintervalAdd(intervalinfty, &lincoef, lincoef, tmp);
11291  }
11292 #else
11293  if( consdata->bilinterms[k].var1 != var )
11294  continue; /* this term does not contribute to the activity of quad var term i */
11295 
11296  SCIPintervalSetBounds(&tmp,
11297  -infty2infty(SCIPinfinity(scip), intervalinfty, -MIN(SCIPvarGetLbLocal(consdata->bilinterms[k].var2), SCIPvarGetUbLocal(consdata->bilinterms[k].var2))),
11298  +infty2infty(SCIPinfinity(scip), intervalinfty, MAX(SCIPvarGetLbLocal(consdata->bilinterms[k].var2), SCIPvarGetUbLocal(consdata->bilinterms[k].var2))));
11299  SCIPintervalMulScalar(intervalinfty, &tmp, tmp, consdata->bilinterms[k].coef);
11300  SCIPintervalAdd(intervalinfty, &lincoef, lincoef, tmp);
11301 #endif
11302  }
11303 
11304  /* deduce domain reductions for x_i */
11305  SCIP_CALL( propagateBoundsQuadVar(scip, cons, intervalinfty, var, consdata->quadvarterms[i].sqrcoef, lincoef, rhs2, result, nchgbds) );
11306  if( *result == SCIP_CUTOFF )
11307  goto CLEANUP;
11308  }
11309  }
11310  }
11311  }
11312 
11313  CLEANUP:
11314  SCIPfreeBufferArrayNull(scip, &quadactcontr);
11315 
11316  return SCIP_OKAY;
11317 }
11318 
11319 /** calls domain propagation for a set of constraints */
11320 static
11322  SCIP* scip, /**< SCIP data structure */
11323  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
11324  SCIP_CONS** conss, /**< constraints to process */
11325  int nconss, /**< number of constraints */
11326  SCIP_RESULT* result, /**< pointer to store the result of the propagation calls */
11327  int* nchgbds /**< buffer where to add the the number of changed bounds */
11328  )
11329 {
11330  SCIP_CONSHDLRDATA* conshdlrdata;
11331  SCIP_RESULT propresult;
11332  SCIP_Bool redundant;
11333  int c;
11334  int roundnr;
11335  SCIP_Bool success;
11336  int maxproprounds;
11337 
11338  assert(scip != NULL);
11339  assert(conshdlr != NULL);
11340  assert(conss != NULL || nconss == 0);
11341  assert(result != NULL);
11342  assert(nchgbds != NULL);
11343 
11345 
11346  conshdlrdata = SCIPconshdlrGetData(conshdlr);
11347  assert(conshdlrdata != NULL);
11348 
11349  *result = SCIP_DIDNOTFIND;
11350  roundnr = 0;
11351  if( SCIPgetStage(scip) == SCIP_STAGE_PRESOLVING )
11352  maxproprounds = conshdlrdata->maxproproundspresolve;
11353  else
11354  maxproprounds = conshdlrdata->maxproprounds;
11355 
11356  do
11357  {
11358  success = FALSE;
11359  ++roundnr;
11360 
11361  SCIPdebugMsg(scip, "starting domain propagation round %d of %d for %d constraints\n", roundnr, maxproprounds, nconss);
11362 
11363  for( c = 0; c < nconss && *result != SCIP_CUTOFF; ++c )
11364  {
11365  assert(conss != NULL);
11366  if( !SCIPconsIsEnabled(conss[c]) )
11367  continue;
11368 
11369  if( SCIPconsIsMarkedPropagate(conss[c]) )
11370  {
11371  /* unmark constraint for propagation */
11372  SCIP_CALL( SCIPunmarkConsPropagate(scip, conss[c]) );
11373 
11374  SCIP_CALL( propagateBoundsCons(scip, conshdlr, conss[c], &propresult, nchgbds, &redundant) );
11375  if( propresult != SCIP_DIDNOTFIND && propresult != SCIP_DIDNOTRUN )
11376  {
11377  *result = propresult;
11378  success = TRUE;
11379  }
11380  if( redundant )
11381  {
11382  SCIPdebugMsg(scip, "deleting constraint <%s> locally\n", SCIPconsGetName(conss[c]));
11383  SCIP_CALL( SCIPdelConsLocal(scip, conss[c]) );
11384  }
11385  }
11386  }
11387  }
11388  while( success && *result != SCIP_CUTOFF && roundnr < maxproprounds );
11389 
11390  return SCIP_OKAY;
11391 }
11392 
11393 /** checks for a linear variable that can be increase or decreased without harming feasibility */
11394 static
11396  SCIP* scip, /**< SCIP data structure */
11397  SCIP_CONSDATA* consdata /**< constraint data */
11398  )
11399 {
11400  int i;
11401  int downlock;
11402  int uplock;
11403 
11404  consdata->linvar_maydecrease = -1;
11405  consdata->linvar_mayincrease = -1;
11406 
11407  /* check for a linear variable that can be increase or decreased without harming feasibility */
11408  for( i = 0; i < consdata->nlinvars; ++i )
11409  {
11410  /* compute locks of i'th linear variable */
11411  assert(consdata->lincoefs[i] != 0.0);
11412  if( consdata->lincoefs[i] > 0.0 )
11413  {
11414  downlock = !SCIPisInfinity(scip, -consdata->lhs) ? 1 : 0; /* lhs <= x -> downlock on x */
11415  uplock = !SCIPisInfinity(scip, consdata->rhs) ? 1 : 0; /* x <= rhs -> uplock on x */
11416  }
11417  else
11418  {
11419  downlock = !SCIPisInfinity(scip, consdata->rhs) ? 1 : 0; /* -x <= rhs -> downlock on x */
11420  uplock = !SCIPisInfinity(scip, -consdata->lhs) ? 1 : 0; /* lhs <= -x -> uplock on x */
11421  }
11422 
11423  if( SCIPvarGetNLocksDownType(consdata->linvars[i], SCIP_LOCKTYPE_MODEL) - downlock == 0 )
11424  {
11425  /* for a*x + q(y) \in [lhs, rhs], we can decrease x without harming other constraints */
11426  /* if we have already one candidate, then take the one where the loss in the objective function is less */
11427  if( (consdata->linvar_maydecrease < 0) ||
11428  (SCIPvarGetObj(consdata->linvars[consdata->linvar_maydecrease]) / consdata->lincoefs[consdata->linvar_maydecrease] > SCIPvarGetObj(consdata->linvars[i]) / consdata->lincoefs[i]) )
11429  consdata->linvar_maydecrease = i;
11430  }
11431 
11432  if( SCIPvarGetNLocksUpType(consdata->linvars[i], SCIP_LOCKTYPE_MODEL) - uplock == 0 )
11433  {
11434  /* for a*x + q(y) \in [lhs, rhs], we can increase x without harm */
11435  /* if we have already one candidate, then take the one where the loss in the objective function is less */
11436  if( (consdata->linvar_mayincrease < 0) ||
11437  (SCIPvarGetObj(consdata->linvars[consdata->linvar_mayincrease]) / consdata->lincoefs[consdata->linvar_mayincrease] > SCIPvarGetObj(consdata->linvars[i]) / consdata->lincoefs[i]) )
11438  consdata->linvar_mayincrease = i;
11439  }
11440  }
11441 
11442 #ifdef SCIP_DEBUG
11443  if( consdata->linvar_mayincrease >= 0 )
11444  {
11445  SCIPdebugMsg(scip, "may increase <%s> to become feasible\n", SCIPvarGetName(consdata->linvars[consdata->linvar_mayincrease]));
11446  }
11447  if( consdata->linvar_maydecrease >= 0 )
11448  {
11449  SCIPdebugMsg(scip, "may decrease <%s> to become feasible\n", SCIPvarGetName(consdata->linvars[consdata->linvar_maydecrease]));
11450  }
11451 #endif
11452 }
11453 
11454 /** Given a solution where every quadratic constraint is either feasible or can be made feasible by
11455  * moving a linear variable, construct the corresponding feasible solution and pass it to the trysol heuristic.
11456  *
11457  * The method assumes that this is always possible and that not all constraints are feasible already.
11458  */
11459 static
11461  SCIP* scip, /**< SCIP data structure */
11462  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
11463  SCIP_CONS** conss, /**< constraints to process */
11464  int nconss, /**< number of constraints */
11465  SCIP_SOL* sol, /**< solution to process */
11466  SCIP_Bool* success /**< buffer to store whether we succeeded to construct a solution that satisfies all provided constraints */
11467  )
11468 {
11469  SCIP_CONSHDLRDATA* conshdlrdata;
11470  SCIP_CONSDATA* consdata;
11471  SCIP_SOL* newsol;
11472  SCIP_VAR* var;
11473  int c;
11474  SCIP_Real viol;
11475  SCIP_Real delta;
11476  SCIP_Real gap;
11477  SCIP_Bool solviolbounds;
11478  SCIP_Bool solchanged;
11479 
11480  assert(scip != NULL);
11481  assert(conshdlr != NULL);
11482  assert(conss != NULL || nconss == 0);
11483  assert(success != NULL);
11484 
11485  *success = FALSE;
11486 
11487  /* don't propose new solutions if not in presolve or solving */
11489  return SCIP_OKAY;
11490 
11491  conshdlrdata = SCIPconshdlrGetData(conshdlr);
11492  assert(conshdlrdata != NULL);
11493 
11494  if( sol != NULL )
11495  {
11496  SCIP_CALL( SCIPcreateSolCopy(scip, &newsol, sol) );
11497  }
11498  else
11499  {
11500  SCIP_CALL( SCIPcreateLPSol(scip, &newsol, NULL) );
11501  }
11502  SCIP_CALL( SCIPunlinkSol(scip, newsol) );
11503  solchanged = FALSE;
11504 
11505  SCIPdebugMsg(scip, "attempt to make solution from <%s> feasible by shifting linear variable\n",
11506  sol != NULL ? (SCIPsolGetHeur(sol) != NULL ? SCIPheurGetName(SCIPsolGetHeur(sol)) : "tree") : "LP");
11507 
11508  for( c = 0; c < nconss; ++c )
11509  {
11510  consdata = SCIPconsGetData(conss[c]); /*lint !e613*/
11511  assert(consdata != NULL);
11512 
11513  /* recompute violation of constraint in case newsol is not identical to sol anymore */
11514  if( solchanged )
11515  {
11516  SCIP_CALL( computeViolation(scip, conss[c], newsol, &solviolbounds) ); /*lint !e613*/
11517  assert(!solviolbounds);
11518  }
11519 
11520  if( SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) )
11521  viol = consdata->lhs - consdata->activity;
11522  else if( SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) )
11523  viol = consdata->rhs - consdata->activity;
11524  else
11525  continue; /* constraint is satisfied */
11526 
11527  assert(viol != 0.0);
11528  if( consdata->linvar_mayincrease >= 0 &&
11529  ((viol > 0.0 && consdata->lincoefs[consdata->linvar_mayincrease] > 0.0) || (viol < 0.0 && consdata->lincoefs[consdata->linvar_mayincrease] < 0.0)) )
11530  {
11531  /* have variable where increasing makes the constraint less violated */
11532  var = consdata->linvars[consdata->linvar_mayincrease];
11533  /* compute how much we would like to increase var */
11534  delta = viol / consdata->lincoefs[consdata->linvar_mayincrease];
11535  assert(delta > 0.0);
11536  /* if var has an upper bound, may need to reduce delta */
11537  if( !SCIPisInfinity(scip, SCIPvarGetUbGlobal(var)) )
11538  {
11539  gap = SCIPvarGetUbGlobal(var) - SCIPgetSolVal(scip, newsol, var);
11540  delta = MIN(MAX(0.0, gap), delta);
11541  }
11542  if( SCIPisPositive(scip, delta) )
11543  {
11544  /* if variable is integral, round delta up so that it will still have an integer value */
11545  if( SCIPvarIsIntegral(var) )
11546  delta = SCIPceil(scip, delta);
11547 
11548  SCIP_CALL( SCIPincSolVal(scip, newsol, var, delta) );
11549  /*lint --e{613} */
11550  SCIPdebugMsg(scip, "increase <%s> by %g to %g to remedy lhs-violation %g of cons <%s>\n", SCIPvarGetName(var), delta, SCIPgetSolVal(scip, newsol, var), viol, SCIPconsGetName(conss[c]));
11551 
11552  solchanged = TRUE;
11553 
11554  /* adjust constraint violation, if satisfied go on to next constraint */
11555  viol -= consdata->lincoefs[consdata->linvar_mayincrease] * delta;
11556  if( SCIPisZero(scip, viol) )
11557  continue;
11558  }
11559  }
11560 
11561  assert(viol != 0.0);
11562  if( consdata->linvar_maydecrease >= 0 &&
11563  ((viol > 0.0 && consdata->lincoefs[consdata->linvar_maydecrease] < 0.0) || (viol < 0.0 && consdata->lincoefs[consdata->linvar_maydecrease] > 0.0)) )
11564  {
11565  /* have variable where decreasing makes constraint less violated */
11566  var = consdata->linvars[consdata->linvar_maydecrease];
11567  /* compute how much we would like to decrease var */
11568  delta = viol / consdata->lincoefs[consdata->linvar_maydecrease];
11569  assert(delta < 0.0);
11570  /* if var has a lower bound, may need to reduce delta */
11571  if( !SCIPisInfinity(scip, -SCIPvarGetLbGlobal(var)) )
11572  {
11573  gap = SCIPgetSolVal(scip, newsol, var) - SCIPvarGetLbGlobal(var);
11574  delta = MAX(MIN(0.0, gap), delta);
11575  }
11576  if( SCIPisNegative(scip, delta) )
11577  {
11578  /* if variable is integral, round delta down so that it will still have an integer value */
11579  if( SCIPvarIsIntegral(var) )
11580  delta = SCIPfloor(scip, delta);
11581  SCIP_CALL( SCIPincSolVal(scip, newsol, var, delta) );
11582  /*lint --e{613} */
11583  SCIPdebugMsg(scip, "increase <%s> by %g to %g to remedy rhs-violation %g of cons <%s>\n", SCIPvarGetName(var), delta, SCIPgetSolVal(scip, newsol, var), viol, SCIPconsGetName(conss[c]));
11584 
11585  solchanged = TRUE;
11586 
11587  /* adjust constraint violation, if satisfied go on to next constraint */
11588  viol -= consdata->lincoefs[consdata->linvar_maydecrease] * delta;
11589  if( SCIPisZero(scip, viol) )
11590  continue;
11591  }
11592  }
11593 
11594  /* still here... so probably we could not make constraint feasible due to variable bounds, thus give up */
11595  break;
11596  }
11597 
11598  /* if we have a solution that should satisfy all quadratic constraints and has a better objective than the current upper bound,
11599  * then pass it to the trysol heuristic
11600  */
11601  if( c == nconss && (SCIPisInfinity(scip, SCIPgetUpperbound(scip)) || SCIPisSumLT(scip, SCIPgetSolTransObj(scip, newsol), SCIPgetUpperbound(scip))) )
11602  {
11603  SCIPdebugMsg(scip, "pass solution with objective val %g to trysol heuristic\n", SCIPgetSolTransObj(scip, newsol));
11604  assert(solchanged);
11605 
11606  assert(conshdlrdata->trysolheur != NULL);
11607  SCIP_CALL( SCIPheurPassSolTrySol(scip, conshdlrdata->trysolheur, newsol) );
11608 
11609  *success = TRUE;
11610  }
11611 
11612  SCIP_CALL( SCIPfreeSol(scip, &newsol) );
11613 
11614  return SCIP_OKAY;
11615 }
11616 
11617 /** helper function to enforce constraints */
11618 static
11620  SCIP* scip, /**< SCIP data structure */
11621  SCIP_CONSHDLR* conshdlr, /**< constraint handler */
11622  SCIP_CONS** conss, /**< constraints to process */
11623  int nconss, /**< number of constraints */
11624  int nusefulconss, /**< number of useful (non-obsolete) constraints to process */
11625  SCIP_SOL* sol, /**< solution to enforce (NULL for the LP solution) */
11626  SCIP_Bool solinfeasible, /**< was the solution already declared infeasible by a constraint handler? */
11627  SCIP_RESULT* result /**< pointer to store the result of the enforcing call */
11628  )
11629 {
11630  SCIP_CONSHDLRDATA* conshdlrdata;
11631  SCIP_CONSDATA* consdata;
11632  SCIP_CONS* maxviolcon;
11633  SCIP_Real maxviol;
11634  SCIP_RESULT propresult;
11635  SCIP_RESULT separateresult;
11636  int nchgbds;
11637  int nnotify;
11638  SCIP_Real sepaefficacy;
11639  SCIP_Bool solviolbounds;
11640 
11641  assert(scip != NULL);
11642  assert(conshdlr != NULL);
11643  assert(conss != NULL || nconss == 0);
11644  assert(nconss >= 0);
11645  assert(nusefulconss >= 0);
11646  assert(result != NULL);
11647 
11648  conshdlrdata = SCIPconshdlrGetData(conshdlr);
11649  assert(conshdlrdata != NULL);
11650 
11651  SCIP_CALL( computeViolations(scip, conss, nconss, sol, &solviolbounds, &maxviolcon) );
11652 
11653  if( maxviolcon == NULL )
11654  {
11655  *result = SCIP_FEASIBLE;
11656  return SCIP_OKAY;
11657  }
11658 
11659  *result = SCIP_INFEASIBLE;
11660 
11661  if( solviolbounds )
11662  {
11663  /* if LP solution violates variable bounds, then this should be because a row was added that
11664  * introduced this variable newly to the LP, in which case it gets value 0.0; the row should
11665  * have been added to resolve an infeasibility, so solinfeasible should be TRUE
11666  * see also issue #627
11667  */
11668  assert(solinfeasible);
11669  /* however, if solinfeasible is actually not TRUE, then better cut off the node to avoid that SCIP
11670  * stops because infeasible cannot be resolved */
11671  /*lint --e{774} */
11672  if( !solinfeasible )
11673  *result = SCIP_CUTOFF;
11674  return SCIP_OKAY;
11675  }
11676 
11677  consdata = SCIPconsGetData(maxviolcon);
11678  assert(consdata != NULL);
11679  maxviol = consdata->lhsviol + consdata->rhsviol;
11680  assert(SCIPisGT(scip, maxviol, SCIPfeastol(scip)));
11681 
11682  SCIPdebugMsg(scip, "enforcement with max violation %g in cons <%s> for %s solution\n", maxviol, SCIPconsGetName(maxviolcon),
11683  sol == NULL ? "LP" : "relaxation");
11684 
11685  /* if we are above the 100'th enforcement round for this node, something is strange
11686  * (maybe the LP / relaxator does not think that the cuts we add are violated, or we do ECP on a high-dimensional convex function)
11687  * in this case, check if some limit is hit or SCIP should stop for some other reason and terminate enforcement by creating a dummy node
11688  * (in optimized more, returning SCIP_INFEASIBLE in *result would be sufficient, but in debug mode this would give an assert in scip.c)
11689  * the reason to wait for 100 rounds is to avoid calls to SCIPisStopped in normal runs, which may be expensive
11690  * we only increment nenforounds until 101 to avoid an overflow
11691  */
11692  if( conshdlrdata->lastenfonode == SCIPgetCurrentNode(scip) )
11693  {
11694  if( conshdlrdata->nenforounds > 100 )
11695  {
11696  if( SCIPisStopped(scip) )
11697  {
11698  SCIP_NODE* child;
11699 
11700  SCIP_CALL( SCIPcreateChild(scip, &child, 1.0, SCIPnodeGetEstimate(SCIPgetCurrentNode(scip))) );
11701  *result = SCIP_BRANCHED;
11702 
11703  return SCIP_OKAY;
11704  }
11705  }
11706 
11707  ++conshdlrdata->nenforounds;
11708 
11709  /* cut off the current subtree, if a limit on the enforcement rounds should be applied. At this point, feasible
11710  * solutions might get cut off; the enfolplimit parameter should therefore only be set if SCIP is used as a
11711  * heuristic solver and when the returned result (infeasible, optimal, the gap) can be ignored
11712  */
11713  if( conshdlrdata->enfolplimit != -1 && conshdlrdata->nenforounds > conshdlrdata->enfolplimit )
11714  {
11716  "cut off subtree because enforcement limit was reached; this might lead to incorrect results\n");
11717  *result = SCIP_CUTOFF;
11718  return SCIP_OKAY;
11719  }
11720  }
11721  else
11722  {
11723  conshdlrdata->lastenfonode = SCIPgetCurrentNode(scip);
11724  conshdlrdata->nenforounds = 0;
11725  }
11726 
11727  /* run domain propagation */
11728  nchgbds = 0;
11729  SCIP_CALL( propagateBounds(scip, conshdlr, conss, nconss, &propresult, &nchgbds) );
11730  if( propresult == SCIP_CUTOFF || propresult == SCIP_REDUCEDDOM )
11731  {
11732  SCIPdebugMsg(scip, "propagation succeeded (%s)\n", propresult == SCIP_CUTOFF ? "cutoff" : "reduceddom");
11733  *result = propresult;
11734  return SCIP_OKAY;
11735  }
11736 
11737  /* we would like a cut that is efficient enough that it is not redundant in the LP (>lpfeastol)
11738  * however, we also don't want very weak cuts, so try to reach at least feastol (=lpfeastol by default, though)
11739  */
11740  SCIP_CALL( separatePoint(scip, conshdlr, conss, nconss, nusefulconss, sol, SCIPfeastol(scip), TRUE, &separateresult, &sepaefficacy) );
11741  if( separateresult == SCIP_CUTOFF )
11742  {
11743  SCIPdebugMsg(scip, "separation found cutoff\n");
11744  *result = SCIP_CUTOFF;
11745  return SCIP_OKAY;
11746  }
11747  if( separateresult == SCIP_SEPARATED )
11748  {
11749  SCIPdebugMsg(scip, "separation succeeded (bestefficacy = %g, minefficacy = %g)\n", sepaefficacy, SCIPfeastol(scip));
11750  *result = SCIP_SEPARATED;
11751  return SCIP_OKAY;
11752  }
11753 
11754  /* we are not feasible, the whole node is not infeasible, and we cannot find a good cut
11755  * -> collect variables for branching
11756  */
11757 
11758  SCIPdebugMsg(scip, "separation failed (bestefficacy = %g < %g = minefficacy ); max viol: %g\n", sepaefficacy, SCIPfeastol(scip), maxviol);
11759 
11760  /* find branching candidates */
11761  SCIP_CALL( registerBranchingCandidates(scip, conshdlr, conss, nconss, sol, &nnotify) );
11762 
11763  if( nnotify == 0 && !solinfeasible && SCIPfeastol(scip) > SCIPlpfeastol(scip) )
11764  {
11765  /* fallback 1: we also have no branching candidates, so try to find a weak cut */
11766  SCIP_CALL( separatePoint(scip, conshdlr, conss, nconss, nusefulconss, sol, SCIPlpfeastol(scip), TRUE, &separateresult, &sepaefficacy) );
11767  if( separateresult == SCIP_CUTOFF )
11768  {
11769  SCIPdebugMsg(scip, "separation found cutoff\n");
11770  *result = SCIP_CUTOFF;
11771  return SCIP_OKAY;
11772  }
11773  if( separateresult == SCIP_SEPARATED )
11774  {
11775  SCIPdebugMsg(scip, "separation fallback succeeded, efficacy = %g\n", sepaefficacy);
11776  *result = SCIP_SEPARATED;
11777  return SCIP_OKAY;
11778  }
11779  }
11780 
11781  if( nnotify == 0 && !solinfeasible )
11782  {
11783  /* fallback 2: separation probably failed because of numerical difficulties with a convex constraint;
11784  * if noone declared solution infeasible yet and we had not even found a weak cut, try to resolve by branching
11785  */
11786  SCIP_VAR* brvar = NULL;
11787  SCIP_CALL( registerLargeRelaxValueVariableForBranching(scip, conss, nconss, sol, &brvar) );
11788  if( brvar == NULL )
11789  {
11790  /* fallback 3: all quadratic variables seem to be fixed -> replace by linear constraint */
11791  SCIP_Bool addedcons;
11792  SCIP_Bool reduceddom;
11793  SCIP_Bool infeasible;
11794 
11795  SCIP_CALL( replaceByLinearConstraints(scip, conss, nconss, &addedcons, &reduceddom, &infeasible) );
11796  /* if the linear constraints are actually feasible, then adding them and returning SCIP_CONSADDED confuses SCIP
11797  * when it enforces the new constraints again and nothing resolves the infeasibility that we declare here
11798  * thus, we only add them if considered violated, and otherwise claim the solution is feasible (but print a
11799  * warning) */
11800  if ( infeasible )
11801  *result = SCIP_CUTOFF;
11802  else if ( addedcons )
11803  *result = SCIP_CONSADDED;
11804  else if ( reduceddom )
11805  *result = SCIP_REDUCEDDOM;
11806  else
11807  {
11808  *result = SCIP_FEASIBLE;
11809  SCIPwarningMessage(scip, "could not enforce feasibility by separating or branching; declaring solution with viol %g as feasible\n", maxviol);
11810  assert(!SCIPisInfinity(scip, maxviol));
11811  }
11812  return SCIP_OKAY;
11813  }
11814  else
11815  {
11816  SCIPdebugMsg(scip, "Could not find any usual branching variable candidate. Proposed variable <%s> with LP value %g for branching.\n",
11817  SCIPvarGetName(brvar), SCIPgetSolVal(scip, sol, brvar));
11818  nnotify = 1;
11819  }
11820  }
11821 
11822  assert(*result == SCIP_INFEASIBLE && (solinfeasible || nnotify > 0));
11823  return SCIP_OKAY;
11824 }
11825 
11826 /** tries to upgrade a nonlinear constraint into a quadratic constraint */
11827 static
11828 SCIP_DECL_NONLINCONSUPGD(nonlinconsUpgdQuadratic)
11830  SCIP_EXPRGRAPH* exprgraph;
11831  SCIP_EXPRGRAPHNODE* node;
11832  int i;
11833 
11834  assert(nupgdconss != NULL);
11835  assert(upgdconss != NULL);
11836 
11837  *nupgdconss = 0;
11838 
11839  node = SCIPgetExprgraphNodeNonlinear(scip, cons);
11840 
11841  /* no interest in linear constraints */
11842  if( node == NULL )
11843  return SCIP_OKAY;
11844 
11845  /* if a quadratic expression has been simplified, then all children of the node should be variables */
11847  return SCIP_OKAY;
11848 
11849  switch( SCIPexprgraphGetNodeOperator(node) )
11850  {
11851  case SCIP_EXPR_VARIDX:
11852  case SCIP_EXPR_CONST:
11853  case SCIP_EXPR_PLUS:
11854  case SCIP_EXPR_MINUS:
11855  case SCIP_EXPR_SUM:
11856  case SCIP_EXPR_LINEAR:
11857  /* these should not appear as exprgraphnodes after constraint presolving */
11858  return SCIP_OKAY;
11859 
11860  case SCIP_EXPR_DIV:
11861  case SCIP_EXPR_SQRT:
11862  case SCIP_EXPR_REALPOWER:
11863  case SCIP_EXPR_INTPOWER:
11864  case SCIP_EXPR_SIGNPOWER:
11865  case SCIP_EXPR_EXP:
11866  case SCIP_EXPR_LOG:
11867  case SCIP_EXPR_SIN:
11868  case SCIP_EXPR_COS:
11869  case SCIP_EXPR_TAN:
11870  /* case SCIP_EXPR_ERF: */
11871  /* case SCIP_EXPR_ERFI: */
11872  case SCIP_EXPR_MIN:
11873  case SCIP_EXPR_MAX:
11874  case SCIP_EXPR_ABS:
11875  case SCIP_EXPR_SIGN:
11876  case SCIP_EXPR_PRODUCT:
11877  case SCIP_EXPR_POLYNOMIAL:
11878  case SCIP_EXPR_USER:
11879  /* these do not look like an quadratic expression (assuming the expression graph simplifier did run) */
11880  return SCIP_OKAY;
11881 
11882  case SCIP_EXPR_MUL:
11883  case SCIP_EXPR_SQUARE:
11884  case SCIP_EXPR_QUADRATIC:
11885  /* these mean that we have something quadratic */
11886  break;
11887 
11888  case SCIP_EXPR_PARAM:
11889  case SCIP_EXPR_LAST:
11890  default:
11891  SCIPwarningMessage(scip, "unexpected expression operator %d in nonlinear constraint <%s>\n", SCIPexprgraphGetNodeOperator(node), SCIPconsGetName(cons));
11892  return SCIP_OKAY;
11893  }
11894 
11895  /* setup a quadratic constraint */
11896 
11897  if( upgdconsssize < 1 )
11898  {
11899  /* request larger upgdconss array */
11900  *nupgdconss = -1;
11901  return SCIP_OKAY;
11902  }
11903 
11904  *nupgdconss = 1;
11905  SCIP_CALL( SCIPcreateConsQuadratic(scip, &upgdconss[0], SCIPconsGetName(cons),
11907  0, NULL, 0, NULL,
11908  SCIPgetLhsNonlinear(scip, cons), SCIPgetRhsNonlinear(scip, cons),
11912  assert(!SCIPconsIsStickingAtNode(cons));
11913 
11914  exprgraph = SCIPgetExprgraphNonlinear(scip, SCIPconsGetHdlr(cons));
11915 
11916  /* add variables from expression tree as "quadratic" variables to quadratic constraint */
11917  for( i = 0; i < SCIPexprgraphGetNodeNChildren(node); ++i )
11918  {
11919  assert(SCIPexprgraphGetNodeChildren(node)[i] != NULL);
11920  SCIP_CALL( SCIPaddQuadVarQuadratic(scip, upgdconss[0], (SCIP_VAR*)SCIPexprgraphGetNodeVar(exprgraph, SCIPexprgraphGetNodeChildren(node)[i]), 0.0, 0.0) );
11921  }
11922 
11923  switch( SCIPexprgraphGetNodeOperator(node) )
11924  {
11925  case SCIP_EXPR_MUL:
11926  /* expression is product of two variables, so add bilinear term to constraint */
11927  assert(SCIPexprgraphGetNodeNChildren(node) == 2);
11928 
11929  SCIP_CALL( SCIPaddBilinTermQuadratic(scip, upgdconss[0],
11932  1.0) );
11933 
11934  break;
11935 
11936  case SCIP_EXPR_SQUARE:
11937  /* expression is square of a variable, so change square coefficient of quadratic variable */
11938  assert(SCIPexprgraphGetNodeNChildren(node) == 1);
11939 
11940  SCIP_CALL( SCIPaddSquareCoefQuadratic(scip, upgdconss[0],
11942  1.0) );
11943 
11944  break;
11945 
11946  case SCIP_EXPR_QUADRATIC:
11947  {
11948  /* expression is quadratic */
11949  SCIP_QUADELEM* quadelems;
11950  int nquadelems;
11951  SCIP_Real* lincoefs;
11952 
11954  nquadelems = SCIPexprgraphGetNodeQuadraticNQuadElements(node);
11956 
11958 
11959  if( lincoefs != NULL )
11960  for( i = 0; i < SCIPexprgraphGetNodeNChildren(node); ++i )
11961  if( lincoefs[i] != 0.0 )
11962  {
11963  /* linear term */
11964  SCIP_CALL( SCIPaddQuadVarLinearCoefQuadratic(scip, upgdconss[0],
11966  lincoefs[i]) );
11967  }
11968 
11969  for( i = 0; i < nquadelems; ++i )
11970  {
11971  assert(quadelems[i].idx1 < SCIPexprgraphGetNodeNChildren(node));
11972  assert(quadelems[i].idx2 < SCIPexprgraphGetNodeNChildren(node));
11973 
11974  if( quadelems[i].idx1 == quadelems[i].idx2 )
11975  {
11976  /* square term */
11977  SCIP_CALL( SCIPaddSquareCoefQuadratic(scip, upgdconss[0],
11978  (SCIP_VAR*)SCIPexprgraphGetNodeVar(exprgraph, SCIPexprgraphGetNodeChildren(node)[quadelems[i].idx1]),
11979  quadelems[i].coef) );
11980  }
11981  else
11982  {
11983  /* bilinear term */
11984  SCIP_CALL( SCIPaddBilinTermQuadratic(scip, upgdconss[0],
11985  (SCIP_VAR*)SCIPexprgraphGetNodeVar(exprgraph, SCIPexprgraphGetNodeChildren(node)[quadelems[i].idx1]),
11986  (SCIP_VAR*)SCIPexprgraphGetNodeVar(exprgraph, SCIPexprgraphGetNodeChildren(node)[quadelems[i].idx2]),
11987  quadelems[i].coef) );
11988  }
11989  }
11990 
11991  break;
11992  }
11993 
11994  default:
11995  SCIPerrorMessage("you should not be here\n");
11996  return SCIP_ERROR;
11997  } /*lint !e788 */
11998 
11999  return SCIP_OKAY;
12000 }
12001 
12002 /*
12003  * Callback methods of constraint handler
12004  */
12005 
12006 /** copy method for constraint handler plugins (called when SCIP copies plugins) */
12007 static
12008 SCIP_DECL_CONSHDLRCOPY(conshdlrCopyQuadratic)
12009 { /*lint --e{715}*/
12010  assert(scip != NULL);
12011  assert(conshdlr != NULL);
12012  assert(strcmp(SCIPconshdlrGetName(conshdlr), CONSHDLR_NAME) == 0);
12013 
12014  /* call inclusion method of constraint handler */
12016 
12017  *valid = TRUE;
12018 
12019  return SCIP_OKAY;
12020 }
12021 
12022 /** destructor of constraint handler to free constraint handler data (called when SCIP is exiting) */
12023 static
12024 SCIP_DECL_CONSFREE(consFreeQuadratic)
12026  SCIP_CONSHDLRDATA* conshdlrdata;
12027  int i;
12028 
12029  assert(scip != NULL);
12030  assert(conshdlr != NULL);
12031 
12032  conshdlrdata = SCIPconshdlrGetData(conshdlr);
12033  assert(conshdlrdata != NULL);
12034 
12035  for( i = 0; i < conshdlrdata->nquadconsupgrades; ++i )
12036  {
12037  assert(conshdlrdata->quadconsupgrades[i] != NULL);
12038  SCIPfreeBlockMemory(scip, &conshdlrdata->quadconsupgrades[i]); /*lint !e866*/
12039  }
12040  SCIPfreeBlockMemoryArrayNull(scip, &conshdlrdata->quadconsupgrades, conshdlrdata->quadconsupgradessize);
12041  SCIPfreeBlockMemory(scip, &conshdlrdata);
12042 
12043  return SCIP_OKAY;
12044 }
12045 
12046 /** initialization method of constraint handler (called after problem was transformed) */
12047 static
12048 SCIP_DECL_CONSINIT(consInitQuadratic)
12049 { /*lint --e{715} */
12050  SCIP_CONSHDLRDATA* conshdlrdata;
12051 
12052  assert(scip != NULL);
12053  assert(conshdlr != NULL);
12054 
12055  conshdlrdata = SCIPconshdlrGetData(conshdlr);
12056  assert(conshdlrdata != NULL);
12057 
12058  conshdlrdata->subnlpheur = SCIPfindHeur(scip, "subnlp");
12059  conshdlrdata->trysolheur = SCIPfindHeur(scip, "trysol");
12060 
12061  return SCIP_OKAY;
12062 }
12063 
12064 
12065 /** deinitialization method of constraint handler (called before transformed problem is freed) */
12066 static
12067 SCIP_DECL_CONSEXIT(consExitQuadratic)
12068 { /*lint --e{715} */
12069  SCIP_CONSHDLRDATA* conshdlrdata;
12070 
12071  assert(scip != NULL);
12072  assert(conshdlr != NULL);
12073 
12074  conshdlrdata = SCIPconshdlrGetData(conshdlr);
12075  assert(conshdlrdata != NULL);
12076 
12077  conshdlrdata->subnlpheur = NULL;
12078  conshdlrdata->trysolheur = NULL;
12079 
12080  return SCIP_OKAY;
12081 }
12082 
12083 /** presolving initialization method of constraint handler (called when presolving is about to begin) */
12084 #if 0
12085 static
12086 SCIP_DECL_CONSINITPRE(consInitpreQuadratic)
12087 { /*lint --e{715}*/
12088  SCIP_CONSHDLRDATA* conshdlrdata;
12089  SCIP_CONSDATA* consdata;
12090  int c;
12091 
12092  assert(scip != NULL);
12093  assert(conshdlr != NULL);
12094  assert(conss != NULL || nconss == 0);
12095 
12096  conshdlrdata = SCIPconshdlrGetData(conshdlr);
12097  assert(conshdlrdata != NULL);
12098 
12099  return SCIP_OKAY;
12100 }
12101 #endif
12102 
12103 /** presolving deinitialization method of constraint handler (called after presolving has been finished) */
12104 static
12105 SCIP_DECL_CONSEXITPRE(consExitpreQuadratic)
12106 { /*lint --e{715}*/
12107  SCIP_CONSDATA* consdata;
12108  int c;
12109 #ifndef NDEBUG
12110  int i;
12111 #endif
12112 
12113  assert(scip != NULL);
12114  assert(conshdlr != NULL);
12115  assert(conss != NULL || nconss == 0);
12116 
12117  for( c = 0; c < nconss; ++c )
12118  {
12119  assert(conss != NULL);
12120  consdata = SCIPconsGetData(conss[c]);
12121  assert(consdata != NULL);
12122 
12123  if( !consdata->isremovedfixings )
12124  {
12125  SCIP_CALL( removeFixedVariables(scip, conss[c]) );
12126  }
12127 
12128  /* make sure we do not have duplicate bilinear terms, quad var terms, or linear vars */
12129  SCIP_CALL( mergeAndCleanBilinearTerms(scip, conss[c]) );
12130  SCIP_CALL( mergeAndCleanQuadVarTerms(scip, conss[c]) );
12131  SCIP_CALL( mergeAndCleanLinearVars(scip, conss[c]) );
12132 
12133  assert(consdata->isremovedfixings);
12134  assert(consdata->linvarsmerged);
12135  assert(consdata->quadvarsmerged);
12136  assert(consdata->bilinmerged);
12137 
12138 #ifndef NDEBUG
12139  for( i = 0; i < consdata->nlinvars; ++i )
12140  assert(SCIPvarIsActive(consdata->linvars[i]));
12141 
12142  for( i = 0; i < consdata->nquadvars; ++i )
12143  assert(SCIPvarIsActive(consdata->quadvarterms[i].var));
12144 #endif
12145 
12146  /* tell SCIP that we have something nonlinear */
12147  if( SCIPconsIsAdded(conss[c]) && consdata->nquadvars > 0 )
12148  SCIPenableNLP(scip);
12149  }
12150 
12151  return SCIP_OKAY;
12152 }
12153 
12154 /** solving process initialization method of constraint handler (called when branch and bound process is about to begin)
12155  *
12156  * @note Also called from consEnableQuadratic during solving stage.
12157  */
12158 static
12159 SCIP_DECL_CONSINITSOL(consInitsolQuadratic)
12161  SCIP_CONSHDLRDATA* conshdlrdata;
12162  SCIP_CONSDATA* consdata;
12163  int c;
12164  int i;
12165 
12166  assert(scip != NULL);
12167  assert(conshdlr != NULL);
12168  assert(conss != NULL || nconss == 0);
12169 
12170  conshdlrdata = SCIPconshdlrGetData(conshdlr);
12171  assert(conshdlrdata != NULL);
12172 
12173  for( c = 0; c < nconss; ++c )
12174  {
12175  assert(conss != NULL);
12176  consdata = SCIPconsGetData(conss[c]);
12177  assert(consdata != NULL);
12178 
12179  /* check for a linear variable that can be increase or decreased without harming feasibility */
12180  consdataFindUnlockedLinearVar(scip, consdata);
12181 
12182  /* setup lincoefsmin, lincoefsmax */
12183  consdata->lincoefsmin = SCIPinfinity(scip);
12184  consdata->lincoefsmax = 0.0;
12185  for( i = 0; i < consdata->nlinvars; ++i )
12186  {
12187  consdata->lincoefsmin = MIN(consdata->lincoefsmin, REALABS(consdata->lincoefs[i])); /*lint !e666 */
12188  consdata->lincoefsmax = MAX(consdata->lincoefsmax, REALABS(consdata->lincoefs[i])); /*lint !e666 */
12189  }
12190 
12191  /* add nlrow representation to NLP, if NLP had been constructed */
12192  if( SCIPisNLPConstructed(scip) && SCIPconsIsEnabled(conss[c]) )
12193  {
12194  if( consdata->nlrow == NULL )
12195  {
12196  /* compute curvature for the quadratic constraint if not done yet */
12197  SCIP_CALL( checkCurvature(scip, conss[c], conshdlrdata->checkcurvature) );
12198 
12199  SCIP_CALL( createNlRow(scip, conss[c]) );
12200  assert(consdata->nlrow != NULL);
12201  }
12202  SCIP_CALL( SCIPaddNlRow(scip, consdata->nlrow) );
12203  }
12204 
12205  /* setup sepaquadvars and sepabilinvar2pos */
12206  assert(consdata->sepaquadvars == NULL);
12207  assert(consdata->sepabilinvar2pos == NULL);
12208  if( consdata->nquadvars > 0 )
12209  {
12210  SCIP_CALL( SCIPallocBlockMemoryArray(scip, &consdata->sepaquadvars, consdata->nquadvars) );
12211  SCIP_CALL( SCIPallocBlockMemoryArray(scip, &consdata->sepabilinvar2pos, consdata->nbilinterms) );
12212 
12213  /* make sure, quadratic variable terms are sorted */
12214  SCIP_CALL( consdataSortQuadVarTerms(scip, consdata) );
12215 
12216  for( i = 0; i < consdata->nquadvars; ++i )
12217  consdata->sepaquadvars[i] = consdata->quadvarterms[i].var;
12218 
12219  for( i = 0; i < consdata->nbilinterms; ++i )
12220  {
12221  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, consdata->bilinterms[i].var2, &consdata->sepabilinvar2pos[i]) );
12222  }
12223  }
12224 
12225  if( conshdlrdata->checkfactorable )
12226  {
12227  /* check if constraint function is factorable, i.e., can be written as product of two linear functions */
12228  SCIP_CALL( checkFactorable(scip, conss[c]) );
12229  }
12230 
12231  /* compute gauge function using interior points per constraint, only when there are quadratic variables */
12232  if( conshdlrdata->gaugecuts && SCIPgetSubscipDepth(scip) == 0 && consdata->nquadvars > 0 )
12233  {
12234  SCIP_CALL( checkCurvature(scip, conss[c], conshdlrdata->checkcurvature) ); /*lint !e613 */
12235  if( (consdata->isconvex && !SCIPisInfinity(scip, consdata->rhs)) ||
12236  (consdata->isconcave && !SCIPisInfinity(scip, -consdata->lhs)) )
12237  {
12238  SCIP_CALL( computeGauge(scip, conshdlr, conss[c]) );
12239  }
12240  }
12241 
12242  /* compute eigendecomposition for convex quadratics */
12243  if( conshdlrdata->projectedcuts && SCIPgetSubscipDepth(scip) == 0 && consdata->nquadvars > 0 )
12244  {
12245  SCIP_CALL( checkCurvature(scip, conss[c], conshdlrdata->checkcurvature) ); /*lint !e613 */
12246  if( (consdata->isconvex && !SCIPisInfinity(scip, consdata->rhs)) ||
12247  (consdata->isconcave && !SCIPisInfinity(scip, -consdata->lhs)) )
12248  {
12249  SCIP_CALL( computeED(scip, conshdlr, conss[c]) );
12250  }
12251  }
12252 
12253  /* mark constraint for propagation */
12254  SCIP_CALL( SCIPmarkConsPropagate(scip, conss[c]) );
12255  consdata->ispropagated = FALSE;
12256  }
12257 
12258  if( SCIPgetStage(scip) != SCIP_STAGE_INITSOLVE )
12259  {
12260  /* if called from consEnableQuadratic, then don't do below */
12261  return SCIP_OKAY;
12262  }
12263 
12264  conshdlrdata->newsoleventfilterpos = -1;
12265  if( nconss != 0 && conshdlrdata->linearizeheursol )
12266  {
12267  SCIP_EVENTHDLR* eventhdlr;
12268 
12269  eventhdlr = SCIPfindEventhdlr(scip, CONSHDLR_NAME"_newsolution");
12270  assert(eventhdlr != NULL);
12271 
12272  /* @todo Should we catch every new solution or only new *best* solutions */
12273  SCIP_CALL( SCIPcatchEvent(scip, SCIP_EVENTTYPE_SOLFOUND, eventhdlr, (SCIP_EVENTDATA*)conshdlr, &conshdlrdata->newsoleventfilterpos) );
12274  }
12275 
12276  if( nconss != 0 && !SCIPisIpoptAvailableIpopt() && !SCIPisInRestart(scip) )
12277  {
12278  SCIPverbMessage(scip, SCIP_VERBLEVEL_HIGH, NULL, "Quadratic constraint handler does not have LAPACK for eigenvalue computation. Will assume that matrices (with size > 2x2) are indefinite.\n");
12279  }
12280 
12281  /* reset flags and counters */
12282  conshdlrdata->sepanlp = FALSE;
12283  conshdlrdata->lastenfonode = NULL;
12284  conshdlrdata->nenforounds = 0;
12285 
12286  return SCIP_OKAY;
12287 }
12288 
12289 /** solving process deinitialization method of constraint handler (called before branch and bound process data is freed)
12290  *
12291  * @note Also called from consDisableQuadratic during solving stage.
12292  */
12293 static
12294 SCIP_DECL_CONSEXITSOL(consExitsolQuadratic)
12295 { /*lint --e{715}*/
12296  SCIP_CONSHDLRDATA* conshdlrdata;
12297  SCIP_CONSDATA* consdata;
12298  int c;
12299 
12300  assert(scip != NULL);
12301  assert(conshdlr != NULL);
12302  assert(conss != NULL || nconss == 0);
12303 
12304  conshdlrdata = SCIPconshdlrGetData(conshdlr);
12305  assert(conshdlrdata != NULL);
12306 
12307  for( c = 0; c < nconss; ++c )
12308  {
12309  consdata = SCIPconsGetData(conss[c]); /*lint !e613*/
12310  assert(consdata != NULL);
12311 
12312  /* free nonlinear row representation */
12313  if( consdata->nlrow != NULL )
12314  {
12315  SCIP_CALL( SCIPreleaseNlRow(scip, &consdata->nlrow) );
12316  }
12317 
12318  assert(!SCIPconsIsEnabled(conss[c]) || consdata->sepaquadvars != NULL || consdata->nquadvars == 0); /*lint !e613 */
12319  assert(!SCIPconsIsEnabled(conss[c]) || consdata->sepabilinvar2pos != NULL || consdata->nquadvars == 0); /*lint !e613 */
12320  SCIPfreeBlockMemoryArrayNull(scip, &consdata->sepaquadvars, consdata->nquadvars);
12321  SCIPfreeBlockMemoryArrayNull(scip, &consdata->sepabilinvar2pos, consdata->nbilinterms);
12322 
12323  SCIPfreeBlockMemoryArrayNull(scip, &consdata->factorleft, consdata->nquadvars + 1);
12324  SCIPfreeBlockMemoryArrayNull(scip, &consdata->factorright, consdata->nquadvars + 1);
12325 
12326  SCIPfreeBlockMemoryArrayNull(scip, &consdata->interiorpoint, consdata->nquadvars);
12327  SCIPfreeBlockMemoryArrayNull(scip, &consdata->gaugecoefs, consdata->nquadvars);
12328  SCIPfreeBlockMemoryArrayNull(scip, &consdata->eigenvalues, consdata->nquadvars);
12329  SCIPfreeBlockMemoryArrayNull(scip, &consdata->eigenvectors, (int)(consdata->nquadvars*consdata->nquadvars));
12330  SCIPfreeBlockMemoryArrayNull(scip, &consdata->bp, consdata->nquadvars);
12331  }
12332 
12333  if( SCIPgetStage(scip) != SCIP_STAGE_EXITSOLVE )
12334  {
12335  /* if called from consDisableQuadratic, then don't do below */
12336  return SCIP_OKAY;
12337  }
12338 
12339  if( conshdlrdata->newsoleventfilterpos >= 0 )
12340  {
12341  SCIP_EVENTHDLR* eventhdlr;
12342 
12343  eventhdlr = SCIPfindEventhdlr(scip, CONSHDLR_NAME"_newsolution");
12344  assert(eventhdlr != NULL);
12345 
12346  SCIP_CALL( SCIPdropEvent(scip, SCIP_EVENTTYPE_SOLFOUND, eventhdlr, (SCIP_EVENTDATA*)conshdlr, conshdlrdata->newsoleventfilterpos) );
12347  conshdlrdata->newsoleventfilterpos = -1;
12348  }
12349 
12350  /* free all stored bilinear terms in the constraint handler and constraint data; note that we might not want to
12351  * recollect all bilinear terms and therefore keep them even if consDisableQuadratic is called
12352  */
12353  SCIP_CALL( freeAllBilinearTerms(scip, conshdlrdata, conss, nconss) );
12354 
12355  return SCIP_OKAY;
12356 }
12357 
12358 /** frees specific constraint data */
12359 static
12360 SCIP_DECL_CONSDELETE(consDeleteQuadratic)
12362  assert(scip != NULL);
12363  assert(conshdlr != NULL);
12364  assert(cons != NULL);
12365  assert(consdata != NULL);
12366  assert(SCIPconsGetData(cons) == *consdata);
12367 
12368  SCIP_CALL( consdataFree(scip, consdata) );
12369 
12370  assert(*consdata == NULL);
12371 
12372  return SCIP_OKAY;
12373 }
12374 
12375 /** transforms constraint data into data belonging to the transformed problem */
12376 static
12377 SCIP_DECL_CONSTRANS(consTransQuadratic)
12378 {
12379  SCIP_CONSDATA* sourcedata;
12380  SCIP_CONSDATA* targetdata;
12381  int i;
12382 
12383  sourcedata = SCIPconsGetData(sourcecons);
12384  assert(sourcedata != NULL);
12385 
12386  SCIP_CALL( consdataCreate(scip, &targetdata,
12387  sourcedata->lhs, sourcedata->rhs,
12388  sourcedata->nlinvars, sourcedata->linvars, sourcedata->lincoefs,
12389  sourcedata->nquadvars, sourcedata->quadvarterms,
12390  sourcedata->nbilinterms, sourcedata->bilinterms,
12391  FALSE) );
12392 
12393  for( i = 0; i < targetdata->nlinvars; ++i )
12394  {
12395  SCIP_CALL( SCIPgetTransformedVar(scip, targetdata->linvars[i], &targetdata->linvars[i]) );
12396  SCIP_CALL( SCIPcaptureVar(scip, targetdata->linvars[i]) );
12397  }
12398 
12399  for( i = 0; i < targetdata->nquadvars; ++i )
12400  {
12401  SCIP_CALL( SCIPgetTransformedVar(scip, targetdata->quadvarterms[i].var, &targetdata->quadvarterms[i].var) );
12402  SCIP_CALL( SCIPcaptureVar(scip, targetdata->quadvarterms[i].var) );
12403  }
12404 
12405  for( i = 0; i < targetdata->nbilinterms; ++i )
12406  {
12407  SCIP_CALL( SCIPgetTransformedVar(scip, targetdata->bilinterms[i].var1, &targetdata->bilinterms[i].var1) );
12408  SCIP_CALL( SCIPgetTransformedVar(scip, targetdata->bilinterms[i].var2, &targetdata->bilinterms[i].var2) );
12409 
12410  if( SCIPvarCompare(targetdata->bilinterms[i].var1, targetdata->bilinterms[i].var2) > 0 )
12411  {
12412  SCIP_VAR* tmp;
12413  tmp = targetdata->bilinterms[i].var2;
12414  targetdata->bilinterms[i].var2 = targetdata->bilinterms[i].var1;
12415  targetdata->bilinterms[i].var1 = tmp;
12416  }
12417  }
12418 
12419  /* create target constraint */
12420  SCIP_CALL( SCIPcreateCons(scip, targetcons, SCIPconsGetName(sourcecons), conshdlr, targetdata,
12421  SCIPconsIsInitial(sourcecons), SCIPconsIsSeparated(sourcecons), SCIPconsIsEnforced(sourcecons),
12422  SCIPconsIsChecked(sourcecons), SCIPconsIsPropagated(sourcecons), SCIPconsIsLocal(sourcecons),
12423  SCIPconsIsModifiable(sourcecons), SCIPconsIsDynamic(sourcecons), SCIPconsIsRemovable(sourcecons),
12424  SCIPconsIsStickingAtNode(sourcecons)) );
12425 
12426  SCIPdebugMsg(scip, "created transformed quadratic constraint ");
12427  SCIPdebugPrintCons(scip, *targetcons, NULL);
12428 
12429  return SCIP_OKAY;
12430 }
12431 
12432 /** LP initialization method of constraint handler (called before the initial LP relaxation at a node is solved) */
12433 static
12434 SCIP_DECL_CONSINITLP(consInitlpQuadratic)
12436  SCIP_CONSHDLRDATA* conshdlrdata;
12437  SCIP_CONSDATA* consdata;
12438  SCIP_VAR* var;
12439  SCIP_ROW* row;
12440  SCIP_Real* x;
12441  int c;
12442  int i;
12443 
12444  assert(scip != NULL);
12445  assert(conshdlr != NULL);
12446  assert(conss != NULL || nconss == 0);
12447 
12448  conshdlrdata = SCIPconshdlrGetData(conshdlr);
12449  assert(conshdlrdata != NULL);
12450 
12451  *infeasible = FALSE;
12452 
12453  for( c = 0; c < nconss && !(*infeasible); ++c )
12454  {
12455  assert(conss[c] != NULL); /*lint !e613 */
12456 
12457  if( !SCIPconsIsEnabled(conss[c]) ) /*lint !e613 */
12458  continue;
12459 
12460  SCIP_CALL( checkCurvature(scip, conss[c], conshdlrdata->checkcurvature) ); /*lint !e613 */
12461 
12462  consdata = SCIPconsGetData(conss[c]); /*lint !e613 */
12463  assert(consdata != NULL);
12464 
12465  row = NULL;
12466 
12467  if( consdata->nquadvars == 0 )
12468  {
12469  /* if we are actually linear, add the constraint as row to the LP */
12470  SCIP_CALL( SCIPcreateEmptyRowCons(scip, &row, SCIPconsGetHdlr(conss[c]), SCIPconsGetName(conss[c]), consdata->lhs, consdata->rhs,
12471  SCIPconsIsLocal(conss[c]), FALSE , TRUE) ); /*lint !e613 */
12472  SCIP_CALL( SCIPaddVarsToRow(scip, row, consdata->nlinvars, consdata->linvars, consdata->lincoefs) );
12473  SCIP_CALL( SCIPaddRow(scip, row, FALSE, infeasible) );
12474  SCIP_CALL( SCIPreleaseRow (scip, &row) );
12475  continue;
12476  }
12477 
12478  /* alloc memory for reference point */
12479  SCIP_CALL( SCIPallocBufferArray(scip, &x, consdata->nquadvars) );
12480 
12481  /* for convex parts, add linearizations in 5 points */
12482  if( (consdata->isconvex && !SCIPisInfinity(scip, consdata->rhs)) ||
12483  (consdata->isconcave && !SCIPisInfinity(scip, -consdata->lhs)) )
12484  {
12485  SCIP_Real lb;
12486  SCIP_Real ub;
12487  SCIP_Real lambda;
12488  int k;
12489 
12490  for( k = 0; k < 5; ++k )
12491  {
12492  lambda = 0.1 * (k+1); /* lambda = 0.1, 0.2, 0.3, 0.4, 0.5 */
12493  for( i = 0; i < consdata->nquadvars; ++i )
12494  {
12495  var = consdata->quadvarterms[i].var;
12496  lb = SCIPvarGetLbGlobal(var);
12497  ub = SCIPvarGetUbGlobal(var);
12498 
12499  if( ub > -INITLPMAXVARVAL )
12500  lb = MAX(lb, -INITLPMAXVARVAL);
12501  if( lb < INITLPMAXVARVAL )
12502  ub = MIN(ub, INITLPMAXVARVAL);
12503 
12504  /* make bounds finite */
12505  if( SCIPisInfinity(scip, -lb) )
12506  lb = MIN(-10.0, ub - 0.1*REALABS(ub)); /*lint !e666 */
12507  if( SCIPisInfinity(scip, ub) )
12508  ub = MAX( 10.0, lb + 0.1*REALABS(lb)); /*lint !e666 */
12509 
12511  x[i] = lambda * ub + (1.0 - lambda) * lb;
12512  else
12513  x[i] = lambda * lb + (1.0 - lambda) * ub;
12514  }
12515 
12516  SCIP_CALL( generateCut(scip, conshdlr, conss[c], x, NULL, consdata->isconvex ? SCIP_SIDETYPE_RIGHT : SCIP_SIDETYPE_LEFT, &row, NULL,
12517  FALSE, -SCIPinfinity(scip)) ); /*lint !e613 */
12518  if( row != NULL )
12519  {
12520  SCIPdebugMsg(scip, "initlp adds row <%s> for lambda = %g of conss <%s>\n", SCIProwGetName(row), lambda, SCIPconsGetName(conss[c])); /*lint !e613 */
12521  SCIPdebug( SCIP_CALL( SCIPprintRow(scip, row, NULL) ) );
12522 
12523  SCIP_CALL( SCIPaddRow(scip, row, FALSE, infeasible) );
12524  SCIP_CALL( SCIPreleaseRow (scip, &row) );
12525  }
12526  }
12527  }
12528 
12529  /* for concave parts, add underestimator w.r.t. at most 2 reference points */
12530  if( !(*infeasible) && ((! consdata->isconvex && !SCIPisInfinity(scip, consdata->rhs))
12531  || (! consdata->isconcave && !SCIPisInfinity(scip, -consdata->lhs))) )
12532  {
12533  SCIP_Bool unbounded;
12534  SCIP_Bool possquare;
12535  SCIP_Bool negsquare;
12536  SCIP_Real lb;
12537  SCIP_Real ub;
12538  SCIP_Real lambda;
12539  int k;
12540 
12541  unbounded = FALSE; /* whether there are unbounded variables */
12542  possquare = FALSE; /* whether there is a positive square term */
12543  negsquare = FALSE; /* whether there is a negative square term */
12544  for( k = 0; k < 2; ++k )
12545  {
12546  /* Set reference point to 0 projected on bounds for unbounded variables or in between lower and upper bound
12547  * for bounded variables in the first round, we set it closer to the best bound for one part of the
12548  * variables, in the second closer to the best bound for the other part of the variables.
12549  * Additionally, we use slightly different weights for each variable.
12550  * The reason for the latter is, that for a bilinear term with bounded variables, there are always two linear underestimators
12551  * if the same weight is used for both variables of a product, then rounding and luck decides which underestimator is chosen
12552  * of course, the possible number of cuts is something in the order of 2^nquadvars, and we choose two of them here.
12553  */
12554  for( i = 0; i < consdata->nquadvars; ++i )
12555  {
12556  var = consdata->quadvarterms[i].var;
12557  lb = SCIPvarGetLbGlobal(var);
12558  ub = SCIPvarGetUbGlobal(var);
12559 
12560  if( SCIPisInfinity(scip, -lb) )
12561  {
12562  if( SCIPisInfinity(scip, ub) )
12563  x[i] = 0.0;
12564  else
12565  x[i] = MIN(0.0, ub);
12566  unbounded = TRUE;
12567  }
12568  else
12569  {
12570  if( SCIPisInfinity(scip, ub) )
12571  {
12572  x[i] = MAX(0.0, lb);
12573  unbounded = TRUE;
12574  }
12575  else
12576  {
12577  lambda = 0.4 + 0.2 * ((i+k)%2) + 0.01 * i / (double)consdata->nquadvars;
12578  x[i] = lambda * SCIPvarGetBestBoundLocal(var) + (1.0-lambda) * SCIPvarGetWorstBoundLocal(var);
12579  }
12580  }
12581 
12582  possquare |= consdata->quadvarterms[i].sqrcoef > 0.0; /*lint !e514 */
12583  negsquare |= consdata->quadvarterms[i].sqrcoef < 0.0; /*lint !e514 */
12584  }
12585 
12586  if( !consdata->isconvex && !SCIPisInfinity(scip, consdata->rhs) )
12587  {
12588  SCIP_CALL( generateCut(scip, conshdlr, conss[c], x, NULL, SCIP_SIDETYPE_RIGHT, &row, NULL,
12589  conshdlrdata->checkcurvature, -SCIPinfinity(scip)) ); /*lint !e613 */
12590  if( row != NULL )
12591  {
12592  SCIPdebugMsg(scip, "initlp adds row <%s> for rhs of conss <%s>, round %d\n", SCIProwGetName(row), SCIPconsGetName(conss[c]), k); /*lint !e613 */
12593  SCIPdebug( SCIP_CALL( SCIPprintRow(scip, row, NULL) ) );
12594 
12595  SCIP_CALL( SCIPaddRow(scip, row, FALSE, infeasible) );
12596  SCIP_CALL( SCIPreleaseRow (scip, &row) );
12597  }
12598  }
12599  if( !(*infeasible) && !consdata->isconcave && !SCIPisInfinity(scip, -consdata->lhs) )
12600  {
12601  SCIP_CALL( generateCut(scip, conshdlr, conss[c], x, NULL, SCIP_SIDETYPE_LEFT, &row, NULL,
12602  conshdlrdata->checkcurvature, -SCIPinfinity(scip)) ); /*lint !e613 */
12603  if( row != NULL )
12604  {
12605  SCIPdebugMsg(scip, "initlp adds row <%s> for lhs of conss <%s>, round %d\n", SCIProwGetName(row), SCIPconsGetName(conss[c]), k); /*lint !e613 */
12606  SCIPdebug( SCIP_CALL( SCIPprintRow(scip, row, NULL) ) );
12607 
12608  SCIP_CALL( SCIPaddRow(scip, row, FALSE, infeasible) );
12609  SCIP_CALL( SCIPreleaseRow (scip, &row) );
12610  }
12611  }
12612 
12613  /* if there are unbounded variables, then there is typically only at most one possible underestimator, so don't try another round
12614  * similar, if there are no bilinear terms and no linearizations of square terms, then the reference point does not matter, so don't do another round */
12615  if( unbounded ||
12616  (consdata->nbilinterms == 0 && (!possquare || SCIPisInfinity(scip, consdata->rhs))) ||
12617  (consdata->nbilinterms == 0 && (!negsquare || SCIPisInfinity(scip, -consdata->lhs))) )
12618  break;
12619  }
12620  }
12621 
12622  SCIPfreeBufferArray(scip, &x);
12623  }
12624 
12625  /* store all bilinear terms into constraint handler data; this code is not in initsolve because the sub-NLP
12626  * heuristic triggers this callback and should not collect all bilinear terms
12627  */
12628  SCIP_CALL( storeAllBilinearTerms(scip, conshdlrdata, conss, nconss) );
12629 
12630  return SCIP_OKAY;
12631 }
12632 
12633 /** separation method of constraint handler for LP solutions */
12634 static
12635 SCIP_DECL_CONSSEPALP(consSepalpQuadratic)
12636 {
12637  SCIP_CONSHDLRDATA* conshdlrdata;
12638  SCIP_Bool solviolbounds;
12639  SCIP_CONS* maxviolcon;
12640 
12641  assert(scip != NULL);
12642  assert(conshdlr != NULL);
12643  assert(conss != NULL || nconss == 0);
12644  assert(result != NULL);
12645 
12646  *result = SCIP_DIDNOTFIND;
12647 
12648  conshdlrdata = SCIPconshdlrGetData(conshdlr);
12649  assert(conshdlrdata != NULL);
12650 
12651  SCIP_CALL( computeViolations(scip, conss, nconss, NULL, &solviolbounds, &maxviolcon) );
12652 
12653  /* don't try to separate solutions that violate variable bounds */
12654  if( solviolbounds )
12655  return SCIP_OKAY;
12656 
12657  /* if nothing violated, then nothing to separate */
12658  if( maxviolcon == NULL )
12659  return SCIP_OKAY;
12660 
12661  /* at root, check if we want to solve the NLP relaxation and use its solutions as reference point
12662  * if there is something convex, then linearizing in the solution of the NLP relaxation can be very useful
12663  */
12664  if( SCIPgetDepth(scip) == 0 && !conshdlrdata->sepanlp &&
12665  (SCIPgetNContVars(scip) >= conshdlrdata->sepanlpmincont * SCIPgetNVars(scip) ||
12666  (SCIPgetLPSolstat(scip) == SCIP_LPSOLSTAT_UNBOUNDEDRAY && conshdlrdata->sepanlpmincont <= 1.0)) &&
12667  SCIPisNLPConstructed(scip) && SCIPgetNNlpis(scip) > 0 )
12668  {
12669  SCIP_CONSDATA* consdata;
12670  SCIP_NLPSOLSTAT solstat;
12671  SCIP_Bool solvednlp;
12672  int c;
12673 
12674  solstat = SCIPgetNLPSolstat(scip);
12675  solvednlp = FALSE;
12676  if( solstat == SCIP_NLPSOLSTAT_UNKNOWN )
12677  {
12678  /* NLP is not solved yet, so we might want to do this
12679  * but first check whether there is a violated constraint side which corresponds to a convex function
12680  */
12681  for( c = 0; c < nconss; ++c )
12682  {
12683  assert(conss[c] != NULL); /*lint !e613 */
12684 
12685  consdata = SCIPconsGetData(conss[c]); /*lint !e613 */
12686  assert(consdata != NULL);
12687 
12688  /* skip feasible constraints */
12689  if( !SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) && !SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) )
12690  continue;
12691 
12692  /* make sure curvature has been checked */
12693  SCIP_CALL( checkCurvature(scip, conss[c], conshdlrdata->checkcurvature) ); /*lint !e613 */
12694 
12695  if( (SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) && consdata->isconvex) ||
12696  ( SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) && consdata->isconcave) )
12697  break;
12698  }
12699 
12700  if( c < nconss )
12701  {
12702  /* try to solve NLP and update solstat */
12703 
12704  /* ensure linear conss are in NLP */
12705  if( conshdlrdata->subnlpheur != NULL )
12706  {
12707  SCIP_CALL( SCIPaddLinearConsToNlpHeurSubNlp(scip, conshdlrdata->subnlpheur, TRUE, TRUE) );
12708  }
12709 
12710  /* set LP solution as starting values, if available */
12712  {
12714  }
12715 
12716  /* SCIP_CALL( SCIPsetNLPIntPar(scip, SCIP_NLPPAR_VERBLEVEL, 1) ); */
12717  SCIP_CALL( SCIPsolveNLP(scip) );
12718 
12719  solstat = SCIPgetNLPSolstat(scip);
12720  SCIPdebugMsg(scip, "solved NLP relax, solution status: %d\n", solstat);
12721 
12722  solvednlp = TRUE;
12723  }
12724  }
12725 
12726  conshdlrdata->sepanlp = TRUE;
12727 
12728  if( solstat == SCIP_NLPSOLSTAT_GLOBINFEASIBLE )
12729  {
12730  SCIPdebugMsg(scip, "NLP relaxation is globally infeasible, thus can cutoff node\n");
12731  *result = SCIP_CUTOFF;
12732  return SCIP_OKAY;
12733  }
12734 
12735  if( solstat <= SCIP_NLPSOLSTAT_FEASIBLE )
12736  {
12737  /* if we have feasible NLP solution, generate linearization cuts there */
12738  SCIP_Bool lpsolseparated;
12739  SCIP_SOL* nlpsol;
12740 
12741  SCIP_CALL( SCIPcreateNLPSol(scip, &nlpsol, NULL) );
12742  assert(nlpsol != NULL);
12743 
12744  /* if we solved the NLP and solution is integral, then pass it to trysol heuristic */
12745  if( solvednlp && conshdlrdata->trysolheur != NULL )
12746  {
12747  int nfracvars;
12748 
12749  nfracvars = 0;
12750  if( SCIPgetNBinVars(scip) > 0 || SCIPgetNIntVars(scip) > 0 )
12751  {
12752  SCIP_CALL( SCIPgetNLPFracVars(scip, NULL, NULL, NULL, &nfracvars, NULL) );
12753  }
12754 
12755  if( nfracvars == 0 )
12756  {
12757  SCIPdebugMsg(scip, "pass solution with obj. value %g to trysol\n", SCIPgetSolOrigObj(scip, nlpsol));
12758  SCIP_CALL( SCIPheurPassSolTrySol(scip, conshdlrdata->trysolheur, nlpsol) );
12759  }
12760  }
12761 
12762  SCIP_CALL( addLinearizationCuts(scip, conshdlr, conss, nconss, nlpsol, &lpsolseparated, SCIPgetSepaMinEfficacy(scip)) );
12763 
12764  SCIP_CALL( SCIPfreeSol(scip, &nlpsol) );
12765 
12766  /* if a cut that separated the LP solution was added, then return, otherwise continue with usual separation in LP solution */
12767  if( lpsolseparated )
12768  {
12769  SCIPdebugMsg(scip, "linearization cuts separate LP solution\n");
12770  *result = SCIP_SEPARATED;
12771 
12772  return SCIP_OKAY;
12773  }
12774  }
12775  }
12776  /* if we do not want to try solving the NLP, or have no NLP, or have no NLP solver, or solving the NLP failed,
12777  * or separating with NLP solution as reference point failed, then try (again) with LP solution as reference point
12778  */
12779 
12780  SCIP_CALL( separatePoint(scip, conshdlr, conss, nconss, nusefulconss, NULL, SCIPgetSepaMinEfficacy(scip), FALSE, result, NULL) );
12781 
12782  return SCIP_OKAY;
12783 }
12784 
12785 /** separation method of constraint handler for arbitrary primal solutions */
12786 static
12787 SCIP_DECL_CONSSEPASOL(consSepasolQuadratic)
12789  SCIP_Bool solviolbounds;
12790  SCIP_CONS* maxviolcon;
12791 
12792  assert(scip != NULL);
12793  assert(conshdlr != NULL);
12794  assert(conss != NULL || nconss == 0);
12795  assert(sol != NULL);
12796  assert(result != NULL);
12797 
12798  *result = SCIP_DIDNOTFIND;
12799 
12800  SCIP_CALL( computeViolations(scip, conss, nconss, sol, &solviolbounds, &maxviolcon) );
12801 
12802  /* don't separate solution that are outside variable bounds */
12803  if( solviolbounds )
12804  return SCIP_OKAY;
12805 
12806  /* if nothing violated, then nothing to separate */
12807  if( maxviolcon == NULL )
12808  return SCIP_OKAY;
12809 
12810  SCIP_CALL( separatePoint(scip, conshdlr, conss, nconss, nusefulconss, sol, SCIPgetSepaMinEfficacy(scip), FALSE, result, NULL) );
12811 
12812  return SCIP_OKAY;
12813 }
12814 
12815 /** constraint enforcing method of constraint handler for LP solutions */
12816 static
12817 SCIP_DECL_CONSENFOLP(consEnfolpQuadratic)
12818 { /*lint --e{715}*/
12819  SCIP_CALL( enforceConstraint(scip, conshdlr, conss, nconss, nusefulconss, NULL, solinfeasible, result) );
12820 
12821  return SCIP_OKAY;
12822 }
12823 
12824 /** constraint enforcing method of constraint handler for relaxation solutions */
12825 static
12826 SCIP_DECL_CONSENFORELAX(consEnforelaxQuadratic)
12827 { /*lint --e{715}*/
12828  SCIP_CALL( enforceConstraint(scip, conshdlr, conss, nconss, nusefulconss, sol, solinfeasible, result) );
12829 
12830  return SCIP_OKAY;
12831 }
12832 
12833 /** constraint enforcing method of constraint handler for pseudo solutions */
12834 static
12835 SCIP_DECL_CONSENFOPS(consEnfopsQuadratic)
12836 { /*lint --e{715}*/
12837  SCIP_Bool solviolbounds;
12838  SCIP_CONS* maxviolcon;
12839  SCIP_CONSDATA* consdata;
12840  SCIP_RESULT propresult;
12841  SCIP_VAR* var;
12842  int c;
12843  int i;
12844  int nchgbds;
12845  int nnotify;
12846 
12847  assert(scip != NULL);
12848  assert(conss != NULL || nconss == 0);
12849 
12850  SCIP_CALL( computeViolations(scip, conss, nconss, NULL, &solviolbounds, &maxviolcon) );
12851 
12852  /* pseudo solutions should be within bounds by definition */
12853  assert(!solviolbounds);
12854 
12855  if( maxviolcon == NULL )
12856  {
12857  *result = SCIP_FEASIBLE;
12858  return SCIP_OKAY;
12859  }
12860 
12861  *result = SCIP_INFEASIBLE;
12862 
12863  SCIPdebugMsg(scip, "enfops with max violation in cons <%s>\n", SCIPconsGetName(maxviolcon));
12864 
12865  /* run domain propagation */
12866  nchgbds = 0;
12867  SCIP_CALL( propagateBounds(scip, conshdlr, conss, nconss, &propresult, &nchgbds) );
12868  if( propresult == SCIP_CUTOFF || propresult == SCIP_REDUCEDDOM )
12869  {
12870  *result = propresult;
12871  return SCIP_OKAY;
12872  }
12873 
12874  /* we are not feasible and we cannot proof that the whole node is infeasible
12875  * -> collect all variables in violated constraints for branching
12876  */
12877  nnotify = 0;
12878  for( c = 0; c < nconss; ++c )
12879  {
12880  assert(conss != NULL);
12881  consdata = SCIPconsGetData(conss[c]);
12882  assert(consdata != NULL);
12883 
12884  if( !SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) && !SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) )
12885  continue;
12886 
12887  for( i = 0; i < consdata->nlinvars; ++i )
12888  {
12889  var = consdata->linvars[i];
12890  if( !SCIPisRelEQ(scip, SCIPvarGetLbLocal(var), SCIPvarGetUbLocal(var)) )
12891  {
12892  SCIP_CALL( SCIPaddExternBranchCand(scip, var, MAX(consdata->lhsviol, consdata->rhsviol), SCIP_INVALID) );
12893  ++nnotify;
12894  }
12895  }
12896 
12897  for( i = 0; i < consdata->nquadvars; ++i )
12898  {
12899  var = consdata->quadvarterms[i].var;
12900  if( !SCIPisRelEQ(scip, SCIPvarGetLbLocal(var), SCIPvarGetUbLocal(var)) )
12901  {
12902  SCIP_CALL( SCIPaddExternBranchCand(scip, var, MAX(consdata->lhsviol, consdata->rhsviol), SCIP_INVALID) );
12903  ++nnotify;
12904  }
12905  }
12906  }
12907 
12908  if( nnotify == 0 )
12909  {
12910  SCIP_Bool addedcons;
12911  SCIP_Bool reduceddom;
12912  SCIP_Bool infeasible;
12913 
12914  /* if no branching candidate found, then all variables are almost fixed
12915  * calling replaceByLinearConstraints() should lead to fix all almost-fixed quadratic variables, and possibly replace some quad. conss by linear ones
12916  */
12917  SCIP_CALL( replaceByLinearConstraints(scip, conss, nconss, &addedcons, &reduceddom, &infeasible) );
12918  if( addedcons )
12919  {
12920  *result = SCIP_CONSADDED;
12921  return SCIP_OKAY;
12922  }
12923  if( reduceddom )
12924  {
12925  *result = SCIP_REDUCEDDOM;
12926  return SCIP_OKAY;
12927  }
12928  if( infeasible )
12929  {
12930  *result = SCIP_CUTOFF;
12931  return SCIP_OKAY;
12932  }
12933 
12934  SCIPdebugMsg(scip, "All variables in violated constraints fixed (up to epsilon). Cannot find branching candidate. Forcing solution of LP.\n");
12935  *result = SCIP_SOLVELP;
12936  }
12937 
12938  assert(*result == SCIP_SOLVELP || (*result == SCIP_INFEASIBLE && nnotify > 0));
12939  return SCIP_OKAY;
12940 }
12941 
12942 /** domain propagation method of constraint handler */
12943 static
12944 SCIP_DECL_CONSPROP(consPropQuadratic)
12946  int nchgbds;
12947 
12948  assert(scip != NULL);
12949  assert(conshdlr != NULL);
12950  assert(conss != NULL || nconss == 0);
12951  assert(result != NULL);
12952 
12953  nchgbds = 0;
12954  SCIP_CALL( propagateBounds(scip, conshdlr, conss, nmarkedconss, result, &nchgbds) );
12955 
12956  return SCIP_OKAY;
12957 } /*lint !e715 */
12958 
12959 /** presolving method of constraint handler */
12960 static
12961 SCIP_DECL_CONSPRESOL(consPresolQuadratic)
12962 { /*lint --e{715,788}*/
12963  SCIP_CONSHDLRDATA* conshdlrdata;
12964  SCIP_CONSDATA* consdata;
12965  SCIP_RESULT solveresult;
12966  SCIP_Bool redundant;
12967  SCIP_Bool havechange;
12968  SCIP_Bool doreformulations;
12969  int c;
12970  int i;
12971 
12972  assert(scip != NULL);
12973  assert(conshdlr != NULL);
12974  assert(conss != NULL || nconss == 0);
12975  assert(result != NULL);
12976 
12977  *result = SCIP_DIDNOTFIND;
12978 
12979  /* if other presolvers did not find enough changes for another presolving round and we are in exhaustive presolving,
12980  * then try the reformulations (replacing products with binaries, disaggregation, setting default variable bounds)
12981  * otherwise, we wait with these
12982  */
12983  doreformulations = ((presoltiming & SCIP_PRESOLTIMING_EXHAUSTIVE) != 0) && SCIPisPresolveFinished(scip);
12984  SCIPdebugMsg(scip, "presolving will %swait with reformulation\n", doreformulations ? "not " : "");
12985 
12986  conshdlrdata = SCIPconshdlrGetData(conshdlr);
12987  assert(conshdlrdata != NULL);
12988 
12989  for( c = 0; c < nconss; ++c )
12990  {
12991  assert(conss != NULL);
12992  consdata = SCIPconsGetData(conss[c]);
12993  assert(consdata != NULL);
12994 
12995  SCIPdebugMsg(scip, "process constraint <%s>\n", SCIPconsGetName(conss[c]));
12996  SCIPdebugPrintCons(scip, conss[c], NULL);
12997 
12998  if( !consdata->initialmerge )
12999  {
13000  SCIP_CALL( mergeAndCleanBilinearTerms(scip, conss[c]) );
13001  SCIP_CALL( mergeAndCleanQuadVarTerms(scip, conss[c]) );
13002  SCIP_CALL( mergeAndCleanLinearVars(scip, conss[c]) );
13003  consdata->initialmerge = TRUE;
13004  }
13005 
13006  havechange = FALSE;
13007 #ifdef CHECKIMPLINBILINEAR
13008  if( consdata->isimpladded && (presoltiming & SCIP_PRESOLTIMING_FAST) != 0 )
13009  {
13010  int nbilinremoved;
13011  SCIP_CALL( presolveApplyImplications(scip, conss[c], &nbilinremoved) );
13012  if( nbilinremoved > 0 )
13013  {
13014  *nchgcoefs += nbilinremoved;
13015  havechange = TRUE;
13016  *result = SCIP_SUCCESS;
13017  }
13018  assert(!consdata->isimpladded);
13019  }
13020 #endif
13021  /* call upgrade methods if the constraint has not been presolved yet or there has been a bound tightening or possibly be a change in variable type
13022  * we want to do this before (multi)aggregated variables are replaced, since that may change structure, e.g., introduce bilinear terms
13023  */
13024  if( !consdata->ispresolved || !consdata->ispropagated || nnewchgvartypes > 0 )
13025  {
13026  SCIP_Bool upgraded;
13027 
13028  SCIP_CALL( presolveUpgrade(scip, conshdlr, conss[c], &upgraded, nupgdconss, naddconss, presoltiming) );
13029  if( upgraded )
13030  {
13031  *result = SCIP_SUCCESS;
13032  continue;
13033  }
13034  }
13035 
13036  if( !consdata->isremovedfixings )
13037  {
13038  SCIP_CALL( removeFixedVariables(scip, conss[c]) );
13039  assert(consdata->isremovedfixings);
13040  havechange = TRUE;
13041  }
13042 
13043  /* try to "solve" the constraint, e.g., reduce to a variable aggregation */
13044  SCIP_CALL( presolveSolve(scip, conss[c], &solveresult, &redundant, naggrvars) );
13045  if( solveresult == SCIP_CUTOFF )
13046  {
13047  SCIPdebugMsg(scip, "solving constraint <%s> says problem is infeasible in presolve\n", SCIPconsGetName(conss[c]));
13048  *result = SCIP_CUTOFF;
13049  return SCIP_OKAY;
13050  }
13051  if( redundant )
13052  {
13053  SCIP_CALL( SCIPdelCons(scip, conss[c]) );
13054  ++*ndelconss;
13055  *result = SCIP_SUCCESS;
13056  break;
13057  }
13058  if( solveresult == SCIP_SUCCESS )
13059  {
13060  *result = SCIP_SUCCESS;
13061  havechange = TRUE;
13062  }
13063 
13064  /* @todo divide constraint by gcd of coefficients if all are integral */
13065 
13066  if( doreformulations )
13067  {
13068  int naddconss_old;
13069 
13070  naddconss_old = *naddconss;
13071 
13072  SCIP_CALL( presolveTryAddAND(scip, conshdlr, conss[c], naddconss) );
13073  assert(*naddconss >= naddconss_old);
13074 
13075  if( *naddconss == naddconss_old )
13076  {
13077  /* user not so empathic about AND, or we don't have products of two binaries, so try this more general reformulation */
13078  SCIP_CALL( presolveTryAddLinearReform(scip, conshdlr, conss[c], naddconss) );
13079  assert(*naddconss >= naddconss_old);
13080  }
13081 
13082  if( conshdlrdata->maxdisaggrsize > 1 )
13083  {
13084  /* try disaggregation, if enabled */
13085  SCIP_CALL( presolveDisaggregate(scip, conshdlr, conss[c], naddconss) );
13086  }
13087 
13088  if( *naddconss > naddconss_old )
13089  {
13090  /* if something happened, report success and cleanup constraint */
13091  *result = SCIP_SUCCESS;
13092  havechange = TRUE;
13093  SCIP_CALL( mergeAndCleanBilinearTerms(scip, conss[c]) );
13094  SCIP_CALL( mergeAndCleanQuadVarTerms(scip, conss[c]) );
13095  SCIP_CALL( mergeAndCleanLinearVars(scip, conss[c]) );
13096  }
13097  }
13098 
13099  if( consdata->nlinvars == 0 && consdata->nquadvars == 0 )
13100  {
13101  /* all variables fixed or removed, constraint function is 0.0 now */
13102  if( (!SCIPisInfinity(scip, -consdata->lhs) && SCIPisFeasPositive(scip, consdata->lhs)) ||
13103  ( !SCIPisInfinity(scip, consdata->rhs) && SCIPisFeasNegative(scip, consdata->rhs)) )
13104  { /* left hand side positive or right hand side negative */
13105  SCIPdebugMsg(scip, "constraint <%s> is constant and infeasible\n", SCIPconsGetName(conss[c]));
13106  SCIP_CALL( SCIPdelCons(scip, conss[c]) );
13107  ++*ndelconss;
13108  *result = SCIP_CUTOFF;
13109  return SCIP_OKAY;
13110  }
13111 
13112  /* left and right hand side are consistent */
13113  SCIPdebugMsg(scip, "constraint <%s> is constant and feasible, deleting\n", SCIPconsGetName(conss[c]));
13114  SCIP_CALL( SCIPdelCons(scip, conss[c]) );
13115  ++*ndelconss;
13116  *result = SCIP_SUCCESS;
13117  continue;
13118  }
13119 
13120  if( (presoltiming & SCIP_PRESOLTIMING_FAST) != 0 && !consdata->ispropagated )
13121  {
13122  /* try domain propagation if there were bound changes or constraint has changed (in which case, processVarEvents may have set ispropagated to false) */
13123  SCIP_RESULT propresult;
13124  int roundnr;
13125 
13126  roundnr = 0;
13127  do
13128  {
13129  ++roundnr;
13130 
13131  SCIPdebugMsg(scip, "starting domain propagation round %d of %d\n", roundnr, conshdlrdata->maxproproundspresolve);
13132 
13133  if( !consdata->ispropagated )
13134  {
13135  consdata->ispropagated = TRUE;
13136 
13137  SCIP_CALL( propagateBoundsCons(scip, conshdlr, conss[c], &propresult, nchgbds, &redundant) );
13138 
13139  if( propresult == SCIP_CUTOFF )
13140  {
13141  SCIPdebugMsg(scip, "propagation on constraint <%s> says problem is infeasible in presolve\n",
13142  SCIPconsGetName(conss[c]));
13143  *result = SCIP_CUTOFF;
13144  return SCIP_OKAY;
13145  }
13146 
13147  /* delete constraint if found redundant by bound tightening */
13148  if( redundant )
13149  {
13150  SCIP_CALL( SCIPdelCons(scip, conss[c]) );
13151  ++*ndelconss;
13152  *result = SCIP_SUCCESS;
13153  break;
13154  }
13155 
13156  if( propresult == SCIP_REDUCEDDOM )
13157  {
13158  *result = SCIP_SUCCESS;
13159  havechange = TRUE;
13160  }
13161  }
13162  }
13163  while( !consdata->ispropagated && roundnr < conshdlrdata->maxproproundspresolve );
13164 
13165  if( redundant )
13166  continue;
13167  }
13168 
13169  /* check if we have a single linear continuous variable that we can make implicit integer */
13170  if( (nnewchgvartypes != 0 || havechange || !consdata->ispresolved)
13171  && (SCIPisEQ(scip, consdata->lhs, consdata->rhs) && SCIPisIntegral(scip, consdata->lhs)) )
13172  {
13173  int ncontvar;
13174  SCIP_VAR* candidate;
13175  SCIP_Bool fail;
13176 
13177  fail = FALSE;
13178  candidate = NULL;
13179  ncontvar = 0;
13180 
13181  for( i = 0; !fail && i < consdata->nlinvars; ++i )
13182  {
13183  if( !SCIPisIntegral(scip, consdata->lincoefs[i]) )
13184  {
13185  fail = TRUE;
13186  }
13187  else if( SCIPvarGetType(consdata->linvars[i]) == SCIP_VARTYPE_CONTINUOUS )
13188  {
13189  if( ncontvar > 0 ) /* now at 2nd continuous variable */
13190  fail = TRUE;
13191  else if( SCIPisEQ(scip, ABS(consdata->lincoefs[i]), 1.0) )
13192  candidate = consdata->linvars[i];
13193  ++ncontvar;
13194  }
13195  }
13196  for( i = 0; !fail && i < consdata->nquadvars; ++i )
13197  fail = SCIPvarGetType(consdata->quadvarterms[i].var) == SCIP_VARTYPE_CONTINUOUS ||
13198  !SCIPisIntegral(scip, consdata->quadvarterms[i].lincoef) ||
13199  !SCIPisIntegral(scip, consdata->quadvarterms[i].sqrcoef);
13200  for( i = 0; !fail && i < consdata->nbilinterms; ++i )
13201  fail = !SCIPisIntegral(scip, consdata->bilinterms[i].coef);
13202 
13203  if( !fail && candidate != NULL )
13204  {
13205  SCIP_Bool infeasible;
13206 
13207  SCIPdebugMsg(scip, "make variable <%s> implicit integer due to constraint <%s>\n", SCIPvarGetName(candidate), SCIPconsGetName(conss[c]));
13208 
13209  SCIP_CALL( SCIPchgVarType(scip, candidate, SCIP_VARTYPE_IMPLINT, &infeasible) );
13210  if( infeasible )
13211  {
13212  SCIPdebugMsg(scip, "infeasible upgrade of variable <%s> to integral type, domain is empty\n", SCIPvarGetName(candidate));
13213  *result = SCIP_CUTOFF;
13214 
13215  return SCIP_OKAY;
13216  }
13217 
13218  ++(*nchgvartypes);
13219  *result = SCIP_SUCCESS;
13220  havechange = TRUE;
13221  }
13222  }
13223 
13224  /* call upgrade methods again if constraint has been changed */
13225  if( havechange )
13226  {
13227  SCIP_Bool upgraded;
13228 
13229  SCIP_CALL( presolveUpgrade(scip, conshdlr, conss[c], &upgraded, nupgdconss, naddconss, presoltiming) );
13230  if( upgraded )
13231  {
13232  *result = SCIP_SUCCESS;
13233  continue;
13234  }
13235  }
13236 
13237  /* fix quadratic variables with proper square coefficients contained in a single quadratic constraint to their
13238  * upper or lower bounds
13239  */
13240  if( (presoltiming & SCIP_PRESOLTIMING_EXHAUSTIVE) != 0 && conshdlrdata->checkquadvarlocks != 'd'
13241  && SCIPisPresolveFinished(scip) )
13242  {
13243  SCIP_CONS* cons;
13244  SCIP_VAR* vars[2];
13245  SCIP_BOUNDTYPE boundtypes[2];
13246  SCIP_Real bounds[2];
13247  char name[SCIP_MAXSTRLEN];
13248 
13249  /* merge variables in order to get correct locks for quadratic variables */
13250  if( !consdata->initialmerge )
13251  {
13252  SCIP_CALL( mergeAndCleanBilinearTerms(scip, conss[c]) );
13253  SCIP_CALL( mergeAndCleanQuadVarTerms(scip, conss[c]) );
13254  SCIP_CALL( mergeAndCleanLinearVars(scip, conss[c]) );
13255  consdata->initialmerge = TRUE;
13256  }
13257 
13258  for( i = 0; i < consdata->nquadvars; ++i )
13259  {
13260  if( hasQuadvarHpProperty(scip, consdata, i) )
13261  {
13262  SCIP_VAR* var;
13263 
13264  var = consdata->quadvarterms[i].var;
13265  assert(var != NULL);
13266 
13267  /* try to change the variable type to binary */
13268  if( conshdlrdata->checkquadvarlocks == 't' && SCIPisEQ(scip, SCIPvarGetLbGlobal(var), 0.0) && SCIPisEQ(scip, SCIPvarGetUbGlobal(var), 1.0) )
13269  {
13270  SCIP_Bool infeasible;
13271 
13272  assert(SCIPvarGetType(var) != SCIP_VARTYPE_BINARY);
13273  SCIP_CALL( SCIPchgVarType(scip, var, SCIP_VARTYPE_BINARY, &infeasible) );
13274 
13275  if( infeasible )
13276  {
13277  SCIPdebugMsg(scip, "detect infeasibility after changing variable <%s> to binary type\n", SCIPvarGetName(var));
13278  *result = SCIP_CUTOFF;
13279  return SCIP_OKAY;
13280  }
13281  }
13282  /* add bound disjunction constraint if bounds of variable are finite */
13283  else if( !SCIPisInfinity(scip, -SCIPvarGetLbGlobal(var)) && !SCIPisInfinity(scip, SCIPvarGetUbGlobal(var)) )
13284  {
13285  vars[0] = var;
13286  vars[1] = var;
13287  boundtypes[0] = SCIP_BOUNDTYPE_LOWER;
13288  boundtypes[1] = SCIP_BOUNDTYPE_UPPER;
13289  bounds[0] = SCIPvarGetUbGlobal(var);
13290  bounds[1] = SCIPvarGetLbGlobal(var);
13291 
13292  SCIPdebugMsg(scip, "add bound disjunction constraint for %s\n", SCIPvarGetName(var));
13293 
13294  (void) SCIPsnprintf(name, SCIP_MAXSTRLEN, "quadvarbnddisj_%s", SCIPvarGetName(var));
13295  SCIP_CALL( SCIPcreateConsBounddisjunction(scip, &cons, name, 2, vars, boundtypes, bounds, TRUE, TRUE,
13296  TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE) );
13297 
13298  SCIP_CALL( SCIPaddCons(scip, cons) );
13299  SCIP_CALL( SCIPreleaseCons(scip, &cons) );
13300  }
13301 
13302  *result = SCIP_SUCCESS;
13303  }
13304  }
13305  }
13306 
13307  consdata->ispresolved = TRUE;
13308  }
13309 
13310  return SCIP_OKAY;
13311 }
13312 
13313 /** variable rounding lock method of constraint handler */
13314 static
13315 SCIP_DECL_CONSLOCK(consLockQuadratic)
13316 { /*lint --e{715}*/
13317  SCIP_CONSDATA* consdata;
13318  SCIP_Bool haslb;
13319  SCIP_Bool hasub;
13320  int i;
13321 
13322  assert(scip != NULL);
13323  assert(cons != NULL);
13324  assert(locktype == SCIP_LOCKTYPE_MODEL);
13325 
13326  consdata = SCIPconsGetData(cons);
13327  assert(consdata != NULL);
13328 
13329  haslb = !SCIPisInfinity(scip, -consdata->lhs);
13330  hasub = !SCIPisInfinity(scip, consdata->rhs);
13331 
13332  for( i = 0; i < consdata->nlinvars; ++i )
13333  {
13334  if( consdata->lincoefs[i] > 0 )
13335  {
13336  if( haslb )
13337  {
13338  SCIP_CALL( SCIPaddVarLocksType(scip, consdata->linvars[i], locktype, nlockspos, nlocksneg) );
13339  }
13340  if( hasub )
13341  {
13342  SCIP_CALL( SCIPaddVarLocksType(scip, consdata->linvars[i], locktype, nlocksneg, nlockspos) );
13343  }
13344  }
13345  else
13346  {
13347  if( haslb )
13348  {
13349  SCIP_CALL( SCIPaddVarLocksType(scip, consdata->linvars[i], locktype, nlocksneg, nlockspos) );
13350  }
13351  if( hasub )
13352  {
13353  SCIP_CALL( SCIPaddVarLocksType(scip, consdata->linvars[i], locktype, nlockspos, nlocksneg) );
13354  }
13355  }
13356  }
13357 
13358  for( i = 0; i < consdata->nquadvars; ++i )
13359  {
13360  /* @todo try to be more clever, but variable locks that depend on the bounds of other variables are not trival to maintain */
13361  SCIP_CALL( SCIPaddVarLocksType(scip, consdata->quadvarterms[i].var, SCIP_LOCKTYPE_MODEL, nlockspos+nlocksneg,
13362  nlockspos+nlocksneg) );
13363  }
13364 
13365  return SCIP_OKAY;
13366 }
13367 
13368 /** constraint enabling notification method of constraint handler */
13369 static
13370 SCIP_DECL_CONSENABLE(consEnableQuadratic)
13372  SCIP_CONSHDLRDATA* conshdlrdata;
13373 
13374  assert(scip != NULL);
13375  assert(conshdlr != NULL);
13376  assert(cons != NULL);
13377  assert(SCIPconsIsTransformed(cons));
13378  assert(SCIPconsIsActive(cons));
13379 
13380  conshdlrdata = SCIPconshdlrGetData(conshdlr);
13381  assert(conshdlrdata != NULL);
13382 
13383  SCIPdebugMsg(scip, "enable cons <%s>\n", SCIPconsGetName(cons));
13384 
13385  /* catch variable events */
13386  SCIP_CALL( catchVarEvents(scip, conshdlrdata->eventhdlr, cons) );
13387 
13388  if( SCIPgetStage(scip) >= SCIP_STAGE_EXITPRESOLVE )
13389  {
13390  /* merge duplicate bilinear terms, move quad terms that are linear to linear vars */
13391  SCIP_CALL( mergeAndCleanBilinearTerms(scip, cons) );
13392  SCIP_CALL( mergeAndCleanQuadVarTerms(scip, cons) );
13393  SCIP_CALL( mergeAndCleanLinearVars(scip, cons) );
13394  }
13395 
13396  /* initialize solving data */
13397  if( SCIPgetStage(scip) == SCIP_STAGE_SOLVING )
13398  {
13399  SCIP_CALL( consInitsolQuadratic(scip, conshdlr, &cons, 1) );
13400  }
13401 
13402  return SCIP_OKAY;
13403 }
13404 
13405 /** constraint disabling notification method of constraint handler */
13406 static
13407 SCIP_DECL_CONSDISABLE(consDisableQuadratic)
13408 { /*lint --e{715}*/
13409  SCIP_CONSHDLRDATA* conshdlrdata;
13410 
13411  assert(scip != NULL);
13412  assert(conshdlr != NULL);
13413  assert(cons != NULL);
13414  assert(SCIPconsIsTransformed(cons));
13415 
13416  conshdlrdata = SCIPconshdlrGetData(conshdlr);
13417  assert(conshdlrdata != NULL);
13418 
13419  SCIPdebugMsg(scip, "disable cons <%s>\n", SCIPconsGetName(cons));
13420 
13421  /* free solving data */
13422  if( SCIPgetStage(scip) == SCIP_STAGE_SOLVING )
13423  {
13424  SCIP_CALL( consExitsolQuadratic(scip, conshdlr, &cons, 1, FALSE) );
13425  }
13426 
13427  /* drop variable events */
13428  SCIP_CALL( dropVarEvents(scip, conshdlrdata->eventhdlr, cons) );
13429 
13430  return SCIP_OKAY;
13431 }
13432 
13433 /** constraint display method of constraint handler */
13434 static
13435 SCIP_DECL_CONSPRINT(consPrintQuadratic)
13436 { /*lint --e{715}*/
13437  SCIP_CONSDATA* consdata;
13438 
13439  assert(scip != NULL);
13440  assert(cons != NULL);
13441 
13442  consdata = SCIPconsGetData(cons);
13443  assert(consdata != NULL);
13444 
13445  /* print left hand side for ranged rows */
13446  if( !SCIPisInfinity(scip, -consdata->lhs)
13447  && !SCIPisInfinity(scip, consdata->rhs)
13448  && !SCIPisEQ(scip, consdata->lhs, consdata->rhs) )
13449  SCIPinfoMessage(scip, file, "%.15g <= ", consdata->lhs);
13450 
13451  /* print coefficients and variables */
13452  if( consdata->nlinvars == 0 && consdata->nquadvars == 0 )
13453  {
13454  SCIPinfoMessage(scip, file, "0 ");
13455  }
13456  else
13457  {
13458  SCIP_VAR*** monomialvars;
13459  SCIP_Real** monomialexps;
13460  SCIP_Real* monomialcoefs;
13461  int* monomialnvars;
13462  int nmonomials;
13463  int monomialssize;
13464  int j;
13465 
13466  monomialssize = consdata->nlinvars + 2 * consdata->nquadvars + consdata->nbilinterms;
13467  SCIP_CALL( SCIPallocBufferArray(scip, &monomialvars, monomialssize) );
13468  SCIP_CALL( SCIPallocBufferArray(scip, &monomialexps, monomialssize) );
13469  SCIP_CALL( SCIPallocBufferArray(scip, &monomialcoefs, monomialssize) );
13470  SCIP_CALL( SCIPallocBufferArray(scip, &monomialnvars, monomialssize) );
13471 
13472  nmonomials = 0;
13473  for( j = 0; j < consdata->nlinvars; ++j )
13474  {
13475  assert(nmonomials < monomialssize);
13476 
13477  SCIP_CALL( SCIPallocBufferArray(scip, &monomialvars[nmonomials], 1) ); /*lint !e866 */
13478 
13479  monomialvars[nmonomials][0] = consdata->linvars[j];
13480  monomialexps[nmonomials] = NULL;
13481  monomialcoefs[nmonomials] = consdata->lincoefs[j];
13482  monomialnvars[nmonomials] = 1;
13483  ++nmonomials;
13484  }
13485 
13486  for( j = 0; j < consdata->nquadvars; ++j )
13487  {
13488  if( consdata->quadvarterms[j].lincoef != 0.0 )
13489  {
13490  assert(nmonomials < monomialssize);
13491 
13492  SCIP_CALL( SCIPallocBufferArray(scip, &monomialvars[nmonomials], 1) ); /*lint !e866 */
13493 
13494  monomialvars[nmonomials][0] = consdata->quadvarterms[j].var;
13495  monomialexps[nmonomials] = NULL;
13496  monomialcoefs[nmonomials] = consdata->quadvarterms[j].lincoef;
13497  monomialnvars[nmonomials] = 1;
13498  ++nmonomials;
13499  }
13500 
13501  if( consdata->quadvarterms[j].sqrcoef != 0.0 )
13502  {
13503  assert(nmonomials < monomialssize);
13504 
13505  SCIP_CALL( SCIPallocBufferArray(scip, &monomialvars[nmonomials], 1) ); /*lint !e866 */
13506  SCIP_CALL( SCIPallocBufferArray(scip, &monomialexps[nmonomials], 1) ); /*lint !e866 */
13507 
13508  monomialvars[nmonomials][0] = consdata->quadvarterms[j].var;
13509  monomialexps[nmonomials][0] = 2.0;
13510  monomialcoefs[nmonomials] = consdata->quadvarterms[j].sqrcoef;
13511  monomialnvars[nmonomials] = 1;
13512  ++nmonomials;
13513  }
13514  }
13515 
13516  for( j = 0; j < consdata->nbilinterms; ++j )
13517  {
13518  assert(nmonomials < monomialssize);
13519 
13520  SCIP_CALL( SCIPallocBufferArray(scip, &monomialvars[nmonomials], 2) ); /*lint !e866 */
13521 
13522  monomialvars[nmonomials][0] = consdata->bilinterms[j].var1;
13523  monomialvars[nmonomials][1] = consdata->bilinterms[j].var2;
13524  monomialexps[nmonomials] = NULL;
13525  monomialcoefs[nmonomials] = consdata->bilinterms[j].coef;
13526  monomialnvars[nmonomials] = 2;
13527  ++nmonomials;
13528  }
13529 
13530  SCIP_CALL( SCIPwriteVarsPolynomial(scip, file, monomialvars, monomialexps, monomialcoefs, monomialnvars, nmonomials, TRUE) );
13531 
13532  for( j = nmonomials - 1; j >= 0 ; --j )
13533  {
13534  SCIPfreeBufferArrayNull(scip, &monomialexps[j]);
13535  SCIPfreeBufferArray(scip, &monomialvars[j]);
13536  }
13537 
13538  SCIPfreeBufferArray(scip, &monomialnvars);
13539  SCIPfreeBufferArray(scip, &monomialcoefs);
13540  SCIPfreeBufferArray(scip, &monomialexps);
13541  SCIPfreeBufferArray(scip, &monomialvars);
13542  }
13543 
13544  /* print right hand side */
13545  if( SCIPisEQ(scip, consdata->lhs, consdata->rhs) )
13546  {
13547  SCIPinfoMessage(scip, file, " == %.15g", consdata->rhs);
13548  }
13549  else if( !SCIPisInfinity(scip, consdata->rhs) )
13550  {
13551  SCIPinfoMessage(scip, file, " <= %.15g", consdata->rhs);
13552  }
13553  else if( !SCIPisInfinity(scip, -consdata->lhs) )
13554  {
13555  SCIPinfoMessage(scip, file, " >= %.15g", consdata->lhs);
13556  }
13557  else
13558  {
13559  /* should be ignored by parser */
13560  SCIPinfoMessage(scip, file, " [free]");
13561  }
13562 
13563  return SCIP_OKAY;
13564 }
13565 
13566 /** feasibility check method of constraint handler for integral solutions */
13567 static
13568 SCIP_DECL_CONSCHECK(consCheckQuadratic)
13569 { /*lint --e{715}*/
13570  SCIP_CONSHDLRDATA* conshdlrdata;
13571  SCIP_CONSDATA* consdata;
13572  SCIP_Real maxviol;
13573  int c;
13574  SCIP_Bool maypropfeasible; /* whether we may be able to propose a feasible solution */
13575  SCIP_Bool solviolbounds;
13576 
13577  assert(scip != NULL);
13578  assert(conss != NULL || nconss == 0);
13579  assert(result != NULL);
13580 
13581  conshdlrdata = SCIPconshdlrGetData(conshdlr);
13582  assert(conshdlrdata != NULL);
13583 
13584  *result = SCIP_FEASIBLE;
13585 
13586  maxviol = 0.0;
13587  maypropfeasible = conshdlrdata->linfeasshift && (conshdlrdata->trysolheur != NULL) &&
13589  for( c = 0; c < nconss; ++c )
13590  {
13591  assert(conss != NULL);
13592  SCIP_CALL( computeViolation(scip, conss[c], sol, &solviolbounds) );
13593  assert(!solviolbounds); /* see also issue #627 */
13594 
13595  consdata = SCIPconsGetData(conss[c]);
13596  assert(consdata != NULL);
13597 
13598  if( SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) || SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) )
13599  {
13600  *result = SCIP_INFEASIBLE;
13601  if( printreason )
13602  {
13603  SCIP_CALL( SCIPprintCons(scip, conss[c], NULL) );
13604  SCIPinfoMessage(scip, NULL, ";\n");
13605  if( SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) )
13606  {
13607  SCIPinfoMessage(scip, NULL, "violation: left hand side is violated by %.15g\n", consdata->lhsviol);
13608  }
13609  if( SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)) )
13610  {
13611  SCIPinfoMessage(scip, NULL, "violation: right hand side is violated by %.15g\n", consdata->rhsviol);
13612  }
13613  }
13614  if( (conshdlrdata->subnlpheur == NULL || sol == NULL) && !maypropfeasible && !completely )
13615  return SCIP_OKAY;
13616  if( consdata->lhsviol > maxviol || consdata->rhsviol > maxviol )
13617  maxviol = consdata->lhsviol + consdata->rhsviol;
13618 
13619  /* do not try to shift linear variables if activity is at infinity (leads to setting variable to infinity in solution, which is not allowed) */
13620  if( maypropfeasible && SCIPisInfinity(scip, REALABS(consdata->activity)) )
13621  maypropfeasible = FALSE;
13622 
13623  if( maypropfeasible )
13624  {
13625  /* update information on linear variables that may be in- or decreased, if initsolve has not done so yet */
13627  consdataFindUnlockedLinearVar(scip, consdata);
13628 
13629  if( SCIPisGT(scip, consdata->lhsviol, SCIPfeastol(scip)) )
13630  {
13631  /* check if there is a variable which may help to get the left hand side satisfied
13632  * if there is no such var, then we cannot get feasible */
13633  if( !(consdata->linvar_mayincrease >= 0 && consdata->lincoefs[consdata->linvar_mayincrease] > 0.0) &&
13634  ! (consdata->linvar_maydecrease >= 0 && consdata->lincoefs[consdata->linvar_maydecrease] < 0.0) )
13635  maypropfeasible = FALSE;
13636  }
13637  else
13638  {
13639  assert(SCIPisGT(scip, consdata->rhsviol, SCIPfeastol(scip)));
13640  /* check if there is a variable which may help to get the right hand side satisfied
13641  * if there is no such var, then we cannot get feasible */
13642  if( !(consdata->linvar_mayincrease >= 0 && consdata->lincoefs[consdata->linvar_mayincrease] < 0.0) &&
13643  ! (consdata->linvar_maydecrease >= 0 && consdata->lincoefs[consdata->linvar_maydecrease] > 0.0) )
13644  maypropfeasible = FALSE;
13645  }
13646  }
13647  }
13648  }
13649 
13650  if( *result == SCIP_INFEASIBLE && maypropfeasible )
13651  {
13652  SCIP_Bool success;
13653 
13654  SCIP_CALL( proposeFeasibleSolution(scip, conshdlr, conss, nconss, sol, &success) );
13655 
13656  /* do not pass solution to NLP heuristic if we made it feasible this way */
13657  if( success )
13658  return SCIP_OKAY;
13659  }
13660 
13661  if( *result == SCIP_INFEASIBLE && conshdlrdata->subnlpheur != NULL && sol != NULL && !SCIPisInfinity(scip, maxviol) )
13662  {
13663  SCIP_CALL( SCIPupdateStartpointHeurSubNlp(scip, conshdlrdata->subnlpheur, sol, maxviol) );
13664  }
13665 
13666  return SCIP_OKAY;
13667 }
13668 
13669 /** constraint copying method of constraint handler */
13670 static
13671 SCIP_DECL_CONSCOPY(consCopyQuadratic)
13673  SCIP_CONSDATA* consdata;
13674  SCIP_CONSDATA* targetconsdata;
13675  SCIP_VAR** linvars;
13676  SCIP_QUADVARTERM* quadvarterms;
13677  SCIP_BILINTERM* bilinterms;
13678  int i;
13679  int j;
13680  int k;
13681 
13682  assert(scip != NULL);
13683  assert(cons != NULL);
13684  assert(sourcescip != NULL);
13685  assert(sourceconshdlr != NULL);
13686  assert(sourcecons != NULL);
13687  assert(varmap != NULL);
13688  assert(valid != NULL);
13689 
13690  consdata = SCIPconsGetData(sourcecons);
13691  assert(consdata != NULL);
13692 
13693  linvars = NULL;
13694  quadvarterms = NULL;
13695  bilinterms = NULL;
13696 
13697  *valid = TRUE;
13698 
13699  if( consdata->nlinvars != 0 )
13700  {
13701  SCIP_CALL( SCIPallocBufferArray(sourcescip, &linvars, consdata->nlinvars) );
13702  for( i = 0; i < consdata->nlinvars; ++i )
13703  {
13704  SCIP_CALL( SCIPgetVarCopy(sourcescip, scip, consdata->linvars[i], &linvars[i], varmap, consmap, global, valid) );
13705  assert(!(*valid) || linvars[i] != NULL);
13706 
13707  /* we do not copy, if a variable is missing */
13708  if( !(*valid) )
13709  goto TERMINATE;
13710  }
13711  }
13712 
13713  if( consdata->nbilinterms != 0 )
13714  {
13715  SCIP_CALL( SCIPallocBufferArray(sourcescip, &bilinterms, consdata->nbilinterms) );
13716  }
13717 
13718  if( consdata->nquadvars != 0 )
13719  {
13720  SCIP_CALL( SCIPallocBufferArray(sourcescip, &quadvarterms, consdata->nquadvars) );
13721  for( i = 0; i < consdata->nquadvars; ++i )
13722  {
13723  SCIP_CALL( SCIPgetVarCopy(sourcescip, scip, consdata->quadvarterms[i].var, &quadvarterms[i].var, varmap, consmap, global, valid) );
13724  assert(!(*valid) || quadvarterms[i].var != NULL);
13725 
13726  /* we do not copy, if a variable is missing */
13727  if( !(*valid) )
13728  goto TERMINATE;
13729 
13730  quadvarterms[i].lincoef = consdata->quadvarterms[i].lincoef;
13731  quadvarterms[i].sqrcoef = consdata->quadvarterms[i].sqrcoef;
13732  quadvarterms[i].eventdata = NULL;
13733  quadvarterms[i].nadjbilin = consdata->quadvarterms[i].nadjbilin;
13734  quadvarterms[i].adjbilin = consdata->quadvarterms[i].adjbilin;
13735 
13736  assert(consdata->nbilinterms != 0 || consdata->quadvarterms[i].nadjbilin == 0);
13737 
13738  for( j = 0; j < consdata->quadvarterms[i].nadjbilin; ++j )
13739  {
13740  assert(bilinterms != NULL);
13741 
13742  k = consdata->quadvarterms[i].adjbilin[j];
13743  assert(consdata->bilinterms[k].var1 != NULL);
13744  assert(consdata->bilinterms[k].var2 != NULL);
13745  if( consdata->bilinterms[k].var1 == consdata->quadvarterms[i].var )
13746  {
13747  assert(consdata->bilinterms[k].var2 != consdata->quadvarterms[i].var);
13748  bilinterms[k].var1 = quadvarterms[i].var;
13749  }
13750  else
13751  {
13752  assert(consdata->bilinterms[k].var2 == consdata->quadvarterms[i].var);
13753  bilinterms[k].var2 = quadvarterms[i].var;
13754  }
13755  bilinterms[k].coef = consdata->bilinterms[k].coef;
13756  }
13757  }
13758  }
13759 
13760  assert(stickingatnode == FALSE);
13761  SCIP_CALL( SCIPcreateConsQuadratic2(scip, cons, name ? name : SCIPconsGetName(sourcecons),
13762  consdata->nlinvars, linvars, consdata->lincoefs,
13763  consdata->nquadvars, quadvarterms,
13764  consdata->nbilinterms, bilinterms,
13765  consdata->lhs, consdata->rhs,
13766  initial, separate, enforce, check, propagate, local, modifiable, dynamic, removable) );
13767 
13768  /* copy information on curvature */
13769  targetconsdata = SCIPconsGetData(*cons);
13770  targetconsdata->isconvex = consdata->isconvex;
13771  targetconsdata->isconcave = consdata->isconcave;
13772  targetconsdata->iscurvchecked = consdata->iscurvchecked;
13773 
13774  TERMINATE:
13775  SCIPfreeBufferArrayNull(sourcescip, &quadvarterms);
13776  SCIPfreeBufferArrayNull(sourcescip, &bilinterms);
13777  SCIPfreeBufferArrayNull(sourcescip, &linvars);
13778 
13779  return SCIP_OKAY;
13780 }
13781 
13782 /** constraint parsing method of constraint handler */
13783 static
13784 SCIP_DECL_CONSPARSE(consParseQuadratic)
13785 { /*lint --e{715}*/
13786  SCIP_VAR*** monomialvars;
13787  SCIP_Real** monomialexps;
13788  SCIP_Real* monomialcoefs;
13789  char* endptr;
13790  int* monomialnvars;
13791  int nmonomials;
13792 
13793  SCIP_Real lhs;
13794  SCIP_Real rhs;
13795 
13796  assert(scip != NULL);
13797  assert(success != NULL);
13798  assert(str != NULL);
13799  assert(name != NULL);
13800  assert(cons != NULL);
13801 
13802  /* set left and right hand side to their default values */
13803  lhs = -SCIPinfinity(scip);
13804  rhs = SCIPinfinity(scip);
13805 
13806  (*success) = FALSE;
13807 
13808  /* return of string empty */
13809  if( !*str )
13810  return SCIP_OKAY;
13811 
13812  /* ignore whitespace */
13813  while( isspace((unsigned char)*str) )
13814  ++str;
13815 
13816  /* check for left hand side */
13817  if( isdigit((unsigned char)str[0]) || ((str[0] == '-' || str[0] == '+') && isdigit((unsigned char)str[1])) )
13818  {
13819  /* there is a number coming, maybe it is a left-hand-side */
13820  if( !SCIPstrToRealValue(str, &lhs, &endptr) )
13821  {
13822  SCIPerrorMessage("error parsing number from <%s>\n", str);
13823  return SCIP_OKAY;
13824  }
13825 
13826  /* ignore whitespace */
13827  while( isspace((unsigned char)*endptr) )
13828  ++endptr;
13829 
13830  if( endptr[0] != '<' || endptr[1] != '=' )
13831  {
13832  /* no '<=' coming, so it was the first coefficient, but not a left-hand-side */
13833  lhs = -SCIPinfinity(scip);
13834  }
13835  else
13836  {
13837  /* it was indeed a left-hand-side, so continue parsing after it */
13838  str = endptr + 2;
13839 
13840  /* ignore whitespace */
13841  while( isspace((unsigned char)*str) )
13842  ++str;
13843  }
13844  }
13845 
13846  SCIP_CALL( SCIPparseVarsPolynomial(scip, str, &monomialvars, &monomialexps, &monomialcoefs, &monomialnvars, &nmonomials, &endptr, success) );
13847 
13848  if( *success )
13849  {
13850  /* check for right hand side */
13851  str = endptr;
13852 
13853  /* ignore whitespace */
13854  while( isspace((unsigned char)*str) )
13855  ++str;
13856 
13857  if( *str && str[0] == '<' && str[1] == '=' )
13858  {
13859  /* we seem to get a right-hand-side */
13860  str += 2;
13861 
13862  if( !SCIPstrToRealValue(str, &rhs, &endptr) )
13863  {
13864  SCIPerrorMessage("error parsing right-hand-side from %s\n", str);
13865  *success = FALSE;
13866  }
13867  }
13868  else if( *str && str[0] == '>' && str[1] == '=' )
13869  {
13870  /* we seem to get a left-hand-side */
13871  str += 2;
13872 
13873  /* we should not have a left-hand-side already */
13874  assert(SCIPisInfinity(scip, -lhs));
13875 
13876  if( !SCIPstrToRealValue(str, &lhs, &endptr) )
13877  {
13878  SCIPerrorMessage("error parsing left-hand-side from %s\n", str);
13879  *success = FALSE;
13880  }
13881  }
13882  else if( *str && str[0] == '=' && str[1] == '=' )
13883  {
13884  /* we seem to get a left- and right-hand-side */
13885  str += 2;
13886 
13887  /* we should not have a left-hand-side already */
13888  assert(SCIPisInfinity(scip, -lhs));
13889 
13890  if( !SCIPstrToRealValue(str, &lhs, &endptr) )
13891  {
13892  SCIPerrorMessage("error parsing left-hand-side from %s\n", str);
13893  *success = FALSE;
13894  }
13895  else
13896  {
13897  rhs = lhs;
13898  }
13899  }
13900  }
13901 
13902  if( *success )
13903  {
13904  int i;
13905 
13906  /* setup constraint */
13907  assert(stickingatnode == FALSE);
13908  SCIP_CALL( SCIPcreateConsQuadratic(scip, cons, name, 0, NULL, NULL,
13909  0, NULL, NULL, NULL, lhs, rhs,
13910  initial, separate, enforce, check, propagate, local, modifiable, dynamic, removable) );
13911 
13912  for( i = 0; i < nmonomials; ++i )
13913  {
13914  if( monomialnvars[i] == 0 )
13915  {
13916  /* constant monomial */
13917  SCIPaddConstantQuadratic(scip, *cons, monomialcoefs[i]);
13918  }
13919  else if( monomialnvars[i] == 1 && monomialexps[i][0] == 1.0 )
13920  {
13921  /* linear monomial */
13922  SCIP_CALL( SCIPaddLinearVarQuadratic(scip, *cons, monomialvars[i][0], monomialcoefs[i]) );
13923  }
13924  else if( monomialnvars[i] == 1 && monomialexps[i][0] == 2.0 )
13925  {
13926  /* square monomial */
13927  SCIP_CALL( SCIPaddQuadVarQuadratic(scip, *cons, monomialvars[i][0], 0.0, monomialcoefs[i]) );
13928  }
13929  else if( monomialnvars[i] == 2 && monomialexps[i][0] == 1.0 && monomialexps[i][1] == 1.0 )
13930  {
13931  /* bilinear term */
13932  SCIP_VAR* var1;
13933  SCIP_VAR* var2;
13934  int pos;
13935 
13936  var1 = monomialvars[i][0];
13937  var2 = monomialvars[i][1];
13938  if( var1 == var2 )
13939  {
13940  /* actually a square term */
13941  SCIP_CALL( SCIPaddQuadVarQuadratic(scip, *cons, var1, 0.0, monomialcoefs[i]) );
13942  }
13943  else
13944  {
13945  SCIP_CALL( SCIPfindQuadVarTermQuadratic(scip, *cons, var1, &pos) );
13946  if( pos == -1 )
13947  {
13948  SCIP_CALL( SCIPaddQuadVarQuadratic(scip, *cons, var1, 0.0, 0.0) );
13949  }
13950 
13951  SCIP_CALL( SCIPfindQuadVarTermQuadratic(scip, *cons, var2, &pos) );
13952  if( pos == -1 )
13953  {
13954  SCIP_CALL( SCIPaddQuadVarQuadratic(scip, *cons, var2, 0.0, 0.0) );
13955  }
13956  }
13957 
13958  SCIP_CALL( SCIPaddBilinTermQuadratic(scip, *cons, var1, var2, monomialcoefs[i]) );
13959  }
13960  else
13961  {
13962  SCIPerrorMessage("polynomial in quadratic constraint does not have degree at most 2\n");
13963  *success = FALSE;
13964  SCIP_CALL( SCIPreleaseCons(scip, cons) );
13965  break;
13966  }
13967  }
13968  }
13969 
13970  SCIPfreeParseVarsPolynomialData(scip, &monomialvars, &monomialexps, &monomialcoefs, &monomialnvars, nmonomials);
13971 
13972  return SCIP_OKAY;
13973 }
13974 
13975 /** constraint method of constraint handler which returns the variables (if possible) */
13976 static
13977 SCIP_DECL_CONSGETVARS(consGetVarsQuadratic)
13978 { /*lint --e{715}*/
13979  SCIP_CONSDATA* consdata;
13980 
13981  assert(cons != NULL);
13982  assert(success != NULL);
13983 
13984  consdata = SCIPconsGetData(cons);
13985  assert(consdata != NULL);
13986 
13987  if( varssize < consdata->nlinvars + consdata->nquadvars )
13988  (*success) = FALSE;
13989  else
13990  {
13991  int i;
13992 
13993  assert(vars != NULL);
13994 
13995  BMScopyMemoryArray(vars, consdata->linvars, consdata->nlinvars);
13996 
13997  for( i = 0; i < consdata->nquadvars; ++i )
13998  vars[consdata->nlinvars+i] = consdata->quadvarterms[i].var;
13999 
14000  (*success) = TRUE;
14001  }
14002 
14003  return SCIP_OKAY;
14004 }
14005 
14006 /** constraint method of constraint handler which returns the number of variables (if possible) */
14007 static
14008 SCIP_DECL_CONSGETNVARS(consGetNVarsQuadratic)
14009 { /*lint --e{715}*/
14010  SCIP_CONSDATA* consdata;
14011 
14012  assert(cons != NULL);
14013  assert(success != NULL);
14014 
14015  consdata = SCIPconsGetData(cons);
14016  assert(consdata != NULL);
14017 
14018  (*nvars) = consdata->nlinvars + consdata->nquadvars;
14019  (*success) = TRUE;
14020 
14021  return SCIP_OKAY;
14022 }
14023 
14024 
14025 /*
14026  * constraint specific interface methods
14027  */
14028 
14029 /** creates the handler for quadratic constraints and includes it in SCIP */
14031  SCIP* scip /**< SCIP data structure */
14032  )
14033 {
14034  SCIP_CONSHDLRDATA* conshdlrdata;
14035  SCIP_CONSHDLR* conshdlr;
14036 
14037  /* create quadratic constraint handler data */
14038  SCIP_CALL( SCIPallocBlockMemory(scip, &conshdlrdata) );
14039  BMSclearMemory(conshdlrdata);
14040 
14041  /* include constraint handler */
14044  consEnfolpQuadratic, consEnfopsQuadratic, consCheckQuadratic, consLockQuadratic,
14045  conshdlrdata) );
14046  assert(conshdlr != NULL);
14047 
14048  /* set non-fundamental callbacks via specific setter functions */
14049  SCIP_CALL( SCIPsetConshdlrCopy(scip, conshdlr, conshdlrCopyQuadratic, consCopyQuadratic) );
14050  SCIP_CALL( SCIPsetConshdlrDelete(scip, conshdlr, consDeleteQuadratic) );
14051  SCIP_CALL( SCIPsetConshdlrDisable(scip, conshdlr, consDisableQuadratic) );
14052  SCIP_CALL( SCIPsetConshdlrEnable(scip, conshdlr, consEnableQuadratic) );
14053  SCIP_CALL( SCIPsetConshdlrExit(scip, conshdlr, consExitQuadratic) );
14054  SCIP_CALL( SCIPsetConshdlrExitpre(scip, conshdlr, consExitpreQuadratic) );
14055  SCIP_CALL( SCIPsetConshdlrExitsol(scip, conshdlr, consExitsolQuadratic) );
14056  SCIP_CALL( SCIPsetConshdlrFree(scip, conshdlr, consFreeQuadratic) );
14057  SCIP_CALL( SCIPsetConshdlrGetVars(scip, conshdlr, consGetVarsQuadratic) );
14058  SCIP_CALL( SCIPsetConshdlrGetNVars(scip, conshdlr, consGetNVarsQuadratic) );
14059  SCIP_CALL( SCIPsetConshdlrInit(scip, conshdlr, consInitQuadratic) );
14060  SCIP_CALL( SCIPsetConshdlrInitsol(scip, conshdlr, consInitsolQuadratic) );
14061  SCIP_CALL( SCIPsetConshdlrInitlp(scip, conshdlr, consInitlpQuadratic) );
14062  SCIP_CALL( SCIPsetConshdlrParse(scip, conshdlr, consParseQuadratic) );
14063  SCIP_CALL( SCIPsetConshdlrPresol(scip, conshdlr, consPresolQuadratic, CONSHDLR_MAXPREROUNDS, CONSHDLR_PRESOLTIMING) );
14064  SCIP_CALL( SCIPsetConshdlrPrint(scip, conshdlr, consPrintQuadratic) );
14065  SCIP_CALL( SCIPsetConshdlrProp(scip, conshdlr, consPropQuadratic, CONSHDLR_PROPFREQ, CONSHDLR_DELAYPROP,
14067  SCIP_CALL( SCIPsetConshdlrSepa(scip, conshdlr, consSepalpQuadratic, consSepasolQuadratic, CONSHDLR_SEPAFREQ,
14069  SCIP_CALL( SCIPsetConshdlrTrans(scip, conshdlr, consTransQuadratic) );
14070  SCIP_CALL( SCIPsetConshdlrEnforelax(scip, conshdlr, consEnforelaxQuadratic) );
14071 
14072  /* add quadratic constraint handler parameters */
14073  SCIP_CALL( SCIPaddIntParam(scip, "constraints/" CONSHDLR_NAME "/replacebinaryprod",
14074  "max. length of linear term which when multiplied with a binary variables is replaced by an auxiliary variable and a linear reformulation (0 to turn off)",
14075  &conshdlrdata->replacebinaryprodlength, FALSE, INT_MAX, 0, INT_MAX, NULL, NULL) );
14076 
14077  SCIP_CALL( SCIPaddIntParam(scip, "constraints/" CONSHDLR_NAME "/empathy4and",
14078  "empathy level for using the AND constraint handler: 0 always avoid using AND; 1 use AND sometimes; 2 use AND as often as possible",
14079  &conshdlrdata->empathy4and, FALSE, 0, 0, 2, NULL, NULL) );
14080 
14081  SCIP_CALL( SCIPaddBoolParam(scip, "constraints/" CONSHDLR_NAME "/binreforminitial",
14082  "whether to make non-varbound linear constraints added due to replacing products with binary variables initial",
14083  &conshdlrdata->binreforminitial, TRUE, FALSE, NULL, NULL) );
14084 
14085  SCIP_CALL( SCIPaddBoolParam(scip, "constraints/" CONSHDLR_NAME "/binreformbinaryonly",
14086  "whether to consider only binary variables when replacing products with binary variables",
14087  &conshdlrdata->binreformbinaryonly, FALSE, TRUE, NULL, NULL) );
14088 
14089  SCIP_CALL( SCIPaddRealParam(scip, "constraints/" CONSHDLR_NAME "/binreformmaxcoef",
14090  "limit (as factor on 1/feastol) on coefficients and coef. range in linear constraints created when replacing products with binary variables",
14091  &conshdlrdata->binreformmaxcoef, TRUE, 1e-4, 0.0, SCIPinfinity(scip), NULL, NULL) );
14092 
14093  SCIP_CALL( SCIPaddRealParam(scip, "constraints/" CONSHDLR_NAME "/cutmaxrange",
14094  "maximal coef range of a cut (maximal coefficient divided by minimal coefficient) in order to be added to LP relaxation",
14095  &conshdlrdata->cutmaxrange, TRUE, 1e+7, 0.0, SCIPinfinity(scip), NULL, NULL) );
14096 
14097  SCIP_CALL( SCIPaddRealParam(scip, "constraints/" CONSHDLR_NAME "/mincurvcollectbilinterms",
14098  "minimal curvature of constraints to be considered when returning bilinear terms to other plugins",
14099  &conshdlrdata->mincurvcollectbilinterms, TRUE, 0.8, -SCIPinfinity(scip), SCIPinfinity(scip), NULL, NULL) );
14100 
14101  SCIP_CALL( SCIPaddBoolParam(scip, "constraints/" CONSHDLR_NAME "/linearizeheursol",
14102  "whether linearizations of convex quadratic constraints should be added to cutpool in a solution found by some heuristic",
14103  &conshdlrdata->linearizeheursol, TRUE, TRUE, NULL, NULL) );
14104 
14105  SCIP_CALL( SCIPaddBoolParam(scip, "constraints/" CONSHDLR_NAME "/checkcurvature",
14106  "whether multivariate quadratic functions should be checked for convexity/concavity",
14107  &conshdlrdata->checkcurvature, FALSE, TRUE, NULL, NULL) );
14108 
14109  SCIP_CALL( SCIPaddBoolParam(scip, "constraints/" CONSHDLR_NAME "/checkfactorable",
14110  "whether constraint functions should be checked to be factorable",
14111  &conshdlrdata->checkfactorable, TRUE, TRUE, NULL, NULL) );
14112 
14113  SCIP_CALL( SCIPaddCharParam(scip, "constraints/" CONSHDLR_NAME "/checkquadvarlocks",
14114  "whether quadratic variables contained in a single constraint should be forced to be at their lower or upper bounds ('d'isable, change 't'ype, add 'b'ound disjunction)",
14115  &conshdlrdata->checkquadvarlocks, TRUE, 't', "bdt", NULL, NULL) );
14116 
14117  SCIP_CALL( SCIPaddBoolParam(scip, "constraints/" CONSHDLR_NAME "/linfeasshift",
14118  "whether to try to make solutions in check function feasible by shifting a linear variable (esp. useful if constraint was actually objective function)",
14119  &conshdlrdata->linfeasshift, TRUE, TRUE, NULL, NULL) );
14120 
14121  SCIP_CALL( SCIPaddIntParam(scip, "constraints/" CONSHDLR_NAME "/maxdisaggrsize",
14122  "maximum number of created constraints when disaggregating a quadratic constraint (<= 1: off)",
14123  &conshdlrdata->maxdisaggrsize, FALSE, 1, 1, INT_MAX, NULL, NULL) );
14124 
14125  SCIP_CALL( SCIPaddCharParam(scip, "constraints/" CONSHDLR_NAME "/disaggrmergemethod",
14126  "strategy how to merge independent blocks to reach maxdisaggrsize limit (keep 'b'iggest blocks and merge others; keep 's'mallest blocks and merge other; merge small blocks into bigger blocks to reach 'm'ean sizes)",
14127  &conshdlrdata->disaggrmergemethod, TRUE, 'm', "bms", NULL, NULL) );
14128 
14129  SCIP_CALL( SCIPaddIntParam(scip, "constraints/" CONSHDLR_NAME "/maxproprounds",
14130  "limit on number of propagation rounds for a single constraint within one round of SCIP propagation during solve",
14131  &conshdlrdata->maxproprounds, TRUE, 1, 0, INT_MAX, NULL, NULL) );
14132 
14133  SCIP_CALL( SCIPaddIntParam(scip, "constraints/" CONSHDLR_NAME "/maxproproundspresolve",
14134  "limit on number of propagation rounds for a single constraint within one round of SCIP presolve",
14135  &conshdlrdata->maxproproundspresolve, TRUE, 10, 0, INT_MAX, NULL, NULL) );
14136 
14137  SCIP_CALL( SCIPaddIntParam(scip, "constraints/" CONSHDLR_NAME "/enfolplimit",
14138  "maximum number of enforcement rounds before declaring the LP relaxation infeasible (-1: no limit); WARNING: changing this parameter might lead to incorrect results!",
14139  &conshdlrdata->enfolplimit, TRUE, -1, -1, INT_MAX, NULL, NULL) );
14140 
14141  SCIP_CALL( SCIPaddRealParam(scip, "constraints/" CONSHDLR_NAME "/sepanlpmincont",
14142  "minimal required fraction of continuous variables in problem to use solution of NLP relaxation in root for separation",
14143  &conshdlrdata->sepanlpmincont, FALSE, 1.0, 0.0, 2.0, NULL, NULL) );
14144 
14145  SCIP_CALL( SCIPaddBoolParam(scip, "constraints/" CONSHDLR_NAME "/enfocutsremovable",
14146  "are cuts added during enforcement removable from the LP in the same node?",
14147  &conshdlrdata->enfocutsremovable, TRUE, FALSE, NULL, NULL) );
14148 
14149  SCIP_CALL( SCIPaddBoolParam(scip, "constraints/" CONSHDLR_NAME "/gaugecuts",
14150  "should convex quadratics generated strong cuts via gauge function?",
14151  &conshdlrdata->gaugecuts, FALSE, FALSE, NULL, NULL) );
14152 
14153  SCIP_CALL( SCIPaddCharParam(scip, "constraints/" CONSHDLR_NAME "/interiorcomputation",
14154  "how the interior point for gauge cuts should be computed: 'a'ny point per constraint, 'm'ost interior per constraint",
14155  &conshdlrdata->interiorcomputation, TRUE, 'a', "am", NULL, NULL) );
14156 
14157  SCIP_CALL( SCIPaddBoolParam(scip, "constraints/" CONSHDLR_NAME "/projectedcuts",
14158  "should convex quadratics generated strong cuts via projections?",
14159  &conshdlrdata->projectedcuts, FALSE, FALSE, NULL, NULL) );
14160 
14161  SCIP_CALL( SCIPaddCharParam(scip, "constraints/" CONSHDLR_NAME "/branchscoring",
14162  "which score to give branching candidates: convexification 'g'ap, constraint 'v'iolation, 'c'entrality of variable value in domain",
14163  &conshdlrdata->branchscoring, TRUE, 'g', "cgv", NULL, NULL) );
14164 
14165  SCIP_CALL( SCIPaddBoolParam(scip, "constraints/" CONSHDLR_NAME "/usebilinineqbranch",
14166  "should linear inequalities be consindered when computing the branching scores for bilinear terms?",
14167  &conshdlrdata->usebilinineqbranch, FALSE, FALSE, NULL, NULL) );
14168 
14169  SCIP_CALL( SCIPaddRealParam(scip, "constraints/" CONSHDLR_NAME "/minscorebilinterms",
14170  "minimal required score in order to use linear inequalities for tighter bilinear relaxations",
14171  &conshdlrdata->minscorebilinterms, FALSE, 0.01, 0.0, 1.0, NULL, NULL) );
14172 
14173  SCIP_CALL( SCIPaddIntParam(scip, "constraints/" CONSHDLR_NAME "/bilinineqmaxseparounds",
14174  "maximum number of separation rounds to use linear inequalities for the bilinear term relaxation in a local node",
14175  &conshdlrdata->bilinineqmaxseparounds, TRUE, 3, 0, INT_MAX, NULL, NULL) );
14176 
14177  conshdlrdata->eventhdlr = NULL;
14178  SCIP_CALL( SCIPincludeEventhdlrBasic(scip, &(conshdlrdata->eventhdlr),CONSHDLR_NAME"_boundchange", "signals a bound change to a quadratic constraint",
14179  processVarEvent, NULL) );
14180  assert(conshdlrdata->eventhdlr != NULL);
14181 
14182  SCIP_CALL( SCIPincludeEventhdlrBasic(scip, NULL, CONSHDLR_NAME"_newsolution", "handles the event that a new primal solution has been found",
14183  processNewSolutionEvent, NULL) );
14184 
14185  /* include the quadratic constraint upgrade in the nonlinear constraint handler */
14187 
14188  return SCIP_OKAY;
14189 }
14190 
14191 /** includes a quadratic constraint update method into the quadratic constraint handler */
14193  SCIP* scip, /**< SCIP data structure */
14194  SCIP_DECL_QUADCONSUPGD((*quadconsupgd)), /**< method to call for upgrading quadratic constraint */
14195  int priority, /**< priority of upgrading method */
14196  SCIP_Bool active, /**< should the upgrading method be active by default? */
14197  const char* conshdlrname /**< name of the constraint handler */
14198  )
14199 {
14200  SCIP_CONSHDLR* conshdlr;
14201  SCIP_CONSHDLRDATA* conshdlrdata;
14202  SCIP_QUADCONSUPGRADE* quadconsupgrade;
14203  char paramname[SCIP_MAXSTRLEN];
14204  char paramdesc[SCIP_MAXSTRLEN];
14205  int i;
14206 
14207  assert(quadconsupgd != NULL);
14208  assert(conshdlrname != NULL );
14209 
14210  /* find the quadratic constraint handler */
14211  conshdlr = SCIPfindConshdlr(scip, CONSHDLR_NAME);
14212  if( conshdlr == NULL )
14213  {
14214  SCIPerrorMessage("quadratic constraint handler not found\n");
14215  return SCIP_PLUGINNOTFOUND;
14216  }
14217 
14218  conshdlrdata = SCIPconshdlrGetData(conshdlr);
14219  assert(conshdlrdata != NULL);
14220 
14221  if( !conshdlrdataHasUpgrade(scip, conshdlrdata, quadconsupgd, conshdlrname) )
14222  {
14223  /* create a quadratic constraint upgrade data object */
14224  SCIP_CALL( SCIPallocBlockMemory(scip, &quadconsupgrade) );
14225  quadconsupgrade->quadconsupgd = quadconsupgd;
14226  quadconsupgrade->priority = priority;
14227  quadconsupgrade->active = active;
14228 
14229  /* insert quadratic constraint upgrade method into constraint handler data */
14230  assert(conshdlrdata->nquadconsupgrades <= conshdlrdata->quadconsupgradessize);
14231  if( conshdlrdata->nquadconsupgrades+1 > conshdlrdata->quadconsupgradessize )
14232  {
14233  int newsize;
14234 
14235  newsize = SCIPcalcMemGrowSize(scip, conshdlrdata->nquadconsupgrades+1);
14236  SCIP_CALL( SCIPreallocBlockMemoryArray(scip, &conshdlrdata->quadconsupgrades, conshdlrdata->quadconsupgradessize, newsize) );
14237  conshdlrdata->quadconsupgradessize = newsize;
14238  }
14239  assert(conshdlrdata->nquadconsupgrades+1 <= conshdlrdata->quadconsupgradessize);
14240 
14241  for( i = conshdlrdata->nquadconsupgrades; i > 0 && conshdlrdata->quadconsupgrades[i-1]->priority < quadconsupgrade->priority; --i )
14242  conshdlrdata->quadconsupgrades[i] = conshdlrdata->quadconsupgrades[i-1];
14243  assert(0 <= i && i <= conshdlrdata->nquadconsupgrades);
14244  conshdlrdata->quadconsupgrades[i] = quadconsupgrade;
14245  conshdlrdata->nquadconsupgrades++;
14246 
14247  /* adds parameter to turn on and off the upgrading step */
14248  (void) SCIPsnprintf(paramname, SCIP_MAXSTRLEN, "constraints/" CONSHDLR_NAME "/upgrade/%s", conshdlrname);
14249  (void) SCIPsnprintf(paramdesc, SCIP_MAXSTRLEN, "enable quadratic upgrading for constraint handler <%s>", conshdlrname);
14251  paramname, paramdesc,
14252  &quadconsupgrade->active, FALSE, active, NULL, NULL) );
14253  }
14254 
14255  return SCIP_OKAY;
14256 }
14257 
14258 /** Creates and captures a quadratic constraint.
14259  *
14260  * The constraint should be given in the form
14261  * \f[
14262  * \ell \leq \sum_{i=1}^n b_i x_i + \sum_{j=1}^m a_j y_j z_j \leq u,
14263  * \f]
14264  * where \f$x_i = y_j = z_k\f$ is possible.
14265  *
14266  * @note the constraint gets captured, hence at one point you have to release it using the method SCIPreleaseCons()
14267  */
14269  SCIP* scip, /**< SCIP data structure */
14270  SCIP_CONS** cons, /**< pointer to hold the created constraint */
14271  const char* name, /**< name of constraint */
14272  int nlinvars, /**< number of linear terms (n) */
14273  SCIP_VAR** linvars, /**< array with variables in linear part (x_i) */
14274  SCIP_Real* lincoefs, /**< array with coefficients of variables in linear part (b_i) */
14275  int nquadterms, /**< number of quadratic terms (m) */
14276  SCIP_VAR** quadvars1, /**< array with first variables in quadratic terms (y_j) */
14277  SCIP_VAR** quadvars2, /**< array with second variables in quadratic terms (z_j) */
14278  SCIP_Real* quadcoefs, /**< array with coefficients of quadratic terms (a_j) */
14279  SCIP_Real lhs, /**< left hand side of quadratic equation (ell) */
14280  SCIP_Real rhs, /**< right hand side of quadratic equation (u) */
14281  SCIP_Bool initial, /**< should the LP relaxation of constraint be in the initial LP?
14282  * Usually set to TRUE. Set to FALSE for 'lazy constraints'. */
14283  SCIP_Bool separate, /**< should the constraint be separated during LP processing?
14284  * Usually set to TRUE. */
14285  SCIP_Bool enforce, /**< should the constraint be enforced during node processing?
14286  * TRUE for model constraints, FALSE for additional, redundant constraints. */
14287  SCIP_Bool check, /**< should the constraint be checked for feasibility?
14288  * TRUE for model constraints, FALSE for additional, redundant constraints. */
14289  SCIP_Bool propagate, /**< should the constraint be propagated during node processing?
14290  * Usually set to TRUE. */
14291  SCIP_Bool local, /**< is constraint only valid locally?
14292  * Usually set to FALSE. Has to be set to TRUE, e.g., for branching constraints. */
14293  SCIP_Bool modifiable, /**< is constraint modifiable (subject to column generation)?
14294  * Usually set to FALSE. In column generation applications, set to TRUE if pricing
14295  * adds coefficients to this constraint. */
14296  SCIP_Bool dynamic, /**< is constraint subject to aging?
14297  * Usually set to FALSE. Set to TRUE for own cuts which
14298  * are separated as constraints. */
14299  SCIP_Bool removable /**< should the relaxation be removed from the LP due to aging or cleanup?
14300  * Usually set to FALSE. Set to TRUE for 'lazy constraints' and 'user cuts'. */
14301  )
14302 {
14303  SCIP_CONSHDLR* conshdlr;
14304  SCIP_CONSDATA* consdata;
14305  SCIP_HASHMAP* quadvaridxs;
14306  SCIP_Real sqrcoef;
14307  int i;
14308  int var1pos;
14309  int var2pos;
14310 
14311  int nbilinterms;
14312 
14313  assert(linvars != NULL || nlinvars == 0);
14314  assert(lincoefs != NULL || nlinvars == 0);
14315  assert(quadvars1 != NULL || nquadterms == 0);
14316  assert(quadvars2 != NULL || nquadterms == 0);
14317  assert(quadcoefs != NULL || nquadterms == 0);
14318 
14319  assert(modifiable == FALSE); /* we do not support column generation */
14320 
14321  /* find the quadratic constraint handler */
14322  conshdlr = SCIPfindConshdlr(scip, CONSHDLR_NAME);
14323  if( conshdlr == NULL )
14324  {
14325  SCIPerrorMessage("quadratic constraint handler not found\n");
14326  return SCIP_PLUGINNOTFOUND;
14327  }
14328 
14329  /* create constraint data and constraint */
14330  SCIP_CALL( consdataCreateEmpty(scip, &consdata) );
14331 
14332  consdata->lhs = lhs;
14333  consdata->rhs = rhs;
14334 
14335  SCIP_CALL( SCIPcreateCons(scip, cons, name, conshdlr, consdata, initial, separate, enforce, check, propagate,
14336  local, modifiable, dynamic, removable, FALSE) );
14337 
14338  /* add quadratic variables and remember their indices */
14339  SCIP_CALL( SCIPhashmapCreate(&quadvaridxs, SCIPblkmem(scip), nquadterms) );
14340  nbilinterms = 0;
14341  for( i = 0; i < nquadterms; ++i )
14342  {
14343  if( SCIPisZero(scip, quadcoefs[i]) ) /*lint !e613*/
14344  continue;
14345 
14346  /* if it is actually a square term, remember it's coefficient */
14347  /* cppcheck-suppress nullPointer */
14348  if( quadvars1[i] == quadvars2[i] ) /*lint !e613*/
14349  sqrcoef = quadcoefs[i]; /*lint !e613 */
14350  else
14351  sqrcoef = 0.0;
14352 
14353  /* add quadvars1[i], if not in there already */
14354  if( !SCIPhashmapExists(quadvaridxs, quadvars1[i]) ) /*lint !e613*/
14355  {
14356  SCIP_CALL( addQuadVarTerm(scip, *cons, quadvars1[i], 0.0, sqrcoef) ); /*lint !e613*/
14357  assert(consdata->nquadvars >= 0);
14358  assert(consdata->quadvarterms[consdata->nquadvars-1].var == quadvars1[i]); /*lint !e613*/
14359 
14360  SCIP_CALL( SCIPhashmapInsertInt(quadvaridxs, quadvars1[i], consdata->nquadvars-1) ); /*lint !e613*/
14361  }
14362  else if( !SCIPisZero(scip, sqrcoef) )
14363  {
14364  /* if it's there already, but we got a square coefficient, add it to the previous one */
14365  var1pos = SCIPhashmapGetImageInt(quadvaridxs, quadvars1[i]); /*lint !e613*/
14366  assert(consdata->quadvarterms[var1pos].var == quadvars1[i]); /*lint !e613*/
14367  consdata->quadvarterms[var1pos].sqrcoef += sqrcoef;
14368  }
14369 
14370  /* cppcheck-suppress nullPointer */
14371  if( quadvars1[i] == quadvars2[i] ) /*lint !e613*/
14372  continue;
14373 
14374  /* add quadvars2[i], if not in there already */
14375  if( !SCIPhashmapExists(quadvaridxs, quadvars2[i]) ) /*lint !e613*/
14376  {
14377  assert(sqrcoef == 0.0);
14378  SCIP_CALL( addQuadVarTerm(scip, *cons, quadvars2[i], 0.0, 0.0) ); /*lint !e613*/
14379  assert(consdata->nquadvars >= 0);
14380  assert(consdata->quadvarterms[consdata->nquadvars-1].var == quadvars2[i]); /*lint !e613*/
14381 
14382  SCIP_CALL( SCIPhashmapInsertInt(quadvaridxs, quadvars2[i], consdata->nquadvars-1) ); /*lint !e613*/
14383  }
14384 
14385  ++nbilinterms;
14386  }
14387 
14388  /* add bilinear terms, if we saw any */
14389  if( nbilinterms > 0 )
14390  {
14391  SCIP_CALL( consdataEnsureBilinSize(scip, consdata, nbilinterms) );
14392  for( i = 0; i < nquadterms; ++i )
14393  {
14394  if( SCIPisZero(scip, quadcoefs[i]) ) /*lint !e613*/
14395  continue;
14396 
14397  /* square terms have been taken care of already */
14398  if( quadvars1[i] == quadvars2[i] ) /*lint !e613 */
14399  continue;
14400 
14401  assert(SCIPhashmapExists(quadvaridxs, quadvars1[i])); /*lint !e613*/
14402  assert(SCIPhashmapExists(quadvaridxs, quadvars2[i])); /*lint !e613*/
14403 
14404  var1pos = SCIPhashmapGetImageInt(quadvaridxs, quadvars1[i]); /*lint !e613*/
14405  var2pos = SCIPhashmapGetImageInt(quadvaridxs, quadvars2[i]); /*lint !e613*/
14406 
14407  SCIP_CALL( addBilinearTerm(scip, *cons, var1pos, var2pos, quadcoefs[i]) ); /*lint !e613*/
14408  }
14409  }
14410 
14411  /* add linear variables */
14412  SCIP_CALL( consdataEnsureLinearVarsSize(scip, consdata, nlinvars) );
14413  for( i = 0; i < nlinvars; ++i )
14414  {
14415  if( SCIPisZero(scip, lincoefs[i]) ) /*lint !e613*/
14416  continue;
14417 
14418  /* if it's a linear coefficient for a quadratic variable, add it there, otherwise add as linear variable */
14419  if( SCIPhashmapExists(quadvaridxs, linvars[i]) ) /*lint !e613*/
14420  {
14421  var1pos = SCIPhashmapGetImageInt(quadvaridxs, linvars[i]); /*lint !e613*/
14422  assert(consdata->quadvarterms[var1pos].var == linvars[i]); /*lint !e613*/
14423  consdata->quadvarterms[var1pos].lincoef += lincoefs[i]; /*lint !e613*/
14424  }
14425  else
14426  {
14427  SCIP_CALL( addLinearCoef(scip, *cons, linvars[i], lincoefs[i]) ); /*lint !e613*/
14428  }
14429  }
14430 
14431  SCIPhashmapFree(&quadvaridxs);
14432 
14433  SCIPdebugMsg(scip, "created quadratic constraint ");
14434  SCIPdebugPrintCons(scip, *cons, NULL);
14435 
14436  return SCIP_OKAY;
14437 }
14438 
14439 /** creates and captures a quadratic constraint with all its
14440  * flags set to their default values.
14441  *
14442  * The constraint should be given in the form
14443  * \f[
14444  * \ell \leq \sum_{i=1}^n b_i x_i + \sum_{j=1}^m a_j y_j z_j \leq u,
14445  * \f]
14446  * where \f$x_i = y_j = z_k\f$ is possible.
14447  *
14448  * @note the constraint gets captured, hence at one point you have to release it using the method SCIPreleaseCons()
14449  */
14451  SCIP* scip, /**< SCIP data structure */
14452  SCIP_CONS** cons, /**< pointer to hold the created constraint */
14453  const char* name, /**< name of constraint */
14454  int nlinvars, /**< number of linear terms (n) */
14455  SCIP_VAR** linvars, /**< array with variables in linear part (x_i) */
14456  SCIP_Real* lincoefs, /**< array with coefficients of variables in linear part (b_i) */
14457  int nquadterms, /**< number of quadratic terms (m) */
14458  SCIP_VAR** quadvars1, /**< array with first variables in quadratic terms (y_j) */
14459  SCIP_VAR** quadvars2, /**< array with second variables in quadratic terms (z_j) */
14460  SCIP_Real* quadcoefs, /**< array with coefficients of quadratic terms (a_j) */
14461  SCIP_Real lhs, /**< left hand side of quadratic equation (ell) */
14462  SCIP_Real rhs /**< right hand side of quadratic equation (u) */
14463  )
14464 {
14465  SCIP_CALL( SCIPcreateConsQuadratic(scip, cons, name, nlinvars, linvars, lincoefs,
14466  nquadterms, quadvars1, quadvars2, quadcoefs, lhs, rhs,
14467  TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE) );
14468 
14469  return SCIP_OKAY;
14470 }
14471 
14472 /** Creates and captures a quadratic constraint.
14473  *
14474  * The constraint should be given in the form
14475  * \f[
14476  * \ell \leq \sum_{i=1}^n b_i x_i + \sum_{j=1}^m (a_j y_j^2 + b_j y_j) + \sum_{k=1}^p c_k v_k w_k \leq u.
14477  * \f]
14478  *
14479  * @note the constraint gets captured, hence at one point you have to release it using the method SCIPreleaseCons()
14480  */
14482  SCIP* scip, /**< SCIP data structure */
14483  SCIP_CONS** cons, /**< pointer to hold the created constraint */
14484  const char* name, /**< name of constraint */
14485  int nlinvars, /**< number of linear terms (n) */
14486  SCIP_VAR** linvars, /**< array with variables in linear part (x_i) */
14487  SCIP_Real* lincoefs, /**< array with coefficients of variables in linear part (b_i) */
14488  int nquadvarterms, /**< number of quadratic terms (m) */
14489  SCIP_QUADVARTERM* quadvarterms, /**< quadratic variable terms */
14490  int nbilinterms, /**< number of bilinear terms (p) */
14491  SCIP_BILINTERM* bilinterms, /**< bilinear terms */
14492  SCIP_Real lhs, /**< constraint left hand side (ell) */
14493  SCIP_Real rhs, /**< constraint right hand side (u) */
14494  SCIP_Bool initial, /**< should the LP relaxation of constraint be in the initial LP? */
14495  SCIP_Bool separate, /**< should the constraint be separated during LP processing? */
14496  SCIP_Bool enforce, /**< should the constraint be enforced during node processing? */
14497  SCIP_Bool check, /**< should the constraint be checked for feasibility? */
14498  SCIP_Bool propagate, /**< should the constraint be propagated during node processing? */
14499  SCIP_Bool local, /**< is constraint only valid locally? */
14500  SCIP_Bool modifiable, /**< is constraint modifiable (subject to column generation)? */
14501  SCIP_Bool dynamic, /**< is constraint dynamic? */
14502  SCIP_Bool removable /**< should the constraint be removed from the LP due to aging or cleanup? */
14503  )
14504 {
14505  SCIP_CONSHDLR* conshdlr;
14506  SCIP_CONSDATA* consdata;
14507 
14508  assert(modifiable == FALSE); /* we do not support column generation */
14509  assert(nlinvars == 0 || (linvars != NULL && lincoefs != NULL));
14510  assert(nquadvarterms == 0 || quadvarterms != NULL);
14511  assert(nbilinterms == 0 || bilinterms != NULL);
14512 
14513  /* find the quadratic constraint handler */
14514  conshdlr = SCIPfindConshdlr(scip, CONSHDLR_NAME);
14515  if( conshdlr == NULL )
14516  {
14517  SCIPerrorMessage("quadratic constraint handler not found\n");
14518  return SCIP_PLUGINNOTFOUND;
14519  }
14520 
14521  /* create constraint data */
14522  SCIP_CALL( consdataCreate(scip, &consdata, lhs, rhs,
14523  nlinvars, linvars, lincoefs, nquadvarterms, quadvarterms, nbilinterms, bilinterms,
14524  TRUE) );
14525 
14526  /* create constraint */
14527  SCIP_CALL( SCIPcreateCons(scip, cons, name, conshdlr, consdata, initial, separate, enforce, check, propagate,
14528  local, modifiable, dynamic, removable, FALSE) );
14529 
14530  return SCIP_OKAY;
14531 }
14532 
14533 /** creates and captures a quadratic constraint in its most basic version, i.e.,
14534  * all constraint flags are set to their default values.
14535  *
14536  * The constraint should be given in the form
14537  * \f[
14538  * \ell \leq \sum_{i=1}^n b_i x_i + \sum_{j=1}^m (a_j y_j^2 + b_j y_j) + \sum_{k=1}^p c_k v_k w_k \leq u.
14539  * \f]
14540  *
14541  * @note the constraint gets captured, hence at one point you have to release it using the method SCIPreleaseCons()
14542  */
14544  SCIP* scip, /**< SCIP data structure */
14545  SCIP_CONS** cons, /**< pointer to hold the created constraint */
14546  const char* name, /**< name of constraint */
14547  int nlinvars, /**< number of linear terms (n) */
14548  SCIP_VAR** linvars, /**< array with variables in linear part (x_i) */
14549  SCIP_Real* lincoefs, /**< array with coefficients of variables in linear part (b_i) */
14550  int nquadvarterms, /**< number of quadratic terms (m) */
14551  SCIP_QUADVARTERM* quadvarterms, /**< quadratic variable terms */
14552  int nbilinterms, /**< number of bilinear terms (p) */
14553  SCIP_BILINTERM* bilinterms, /**< bilinear terms */
14554  SCIP_Real lhs, /**< constraint left hand side (ell) */
14555  SCIP_Real rhs /**< constraint right hand side (u) */
14556  )
14557 {
14558  SCIP_CALL( SCIPcreateConsQuadratic2(scip, cons, name, nlinvars, linvars, lincoefs,
14559  nquadvarterms, quadvarterms, nbilinterms, bilinterms, lhs, rhs,
14560  TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE) );
14561 
14562  return SCIP_OKAY;
14563 }
14564 
14565 
14566 /** Adds a constant to the constraint function, that is, subtracts a constant from both sides */
14568  SCIP* scip, /**< SCIP data structure */
14569  SCIP_CONS* cons, /**< constraint */
14570  SCIP_Real constant /**< constant to subtract from both sides */
14571  )
14572 {
14573  SCIP_CONSDATA* consdata;
14574 
14575  assert(scip != NULL);
14576  assert(cons != NULL);
14577  assert(!SCIPisInfinity(scip, REALABS(constant)));
14578 
14579  /* nlrow and solving data (see initsol) may become invalid when changing constraint */
14580  if( SCIPgetStage(scip) == SCIP_STAGE_SOLVING && SCIPconsIsEnabled(cons) )
14581  {
14582  SCIPerrorMessage("Cannot modify enabled constraint in solving stage.\n");
14583  SCIPABORT();
14584  }
14585 
14586  consdata = SCIPconsGetData(cons);
14587  assert(consdata != NULL);
14588  assert(consdata->lhs <= consdata->rhs);
14589 
14590  if( !SCIPisInfinity(scip, -consdata->lhs) )
14591  consdata->lhs -= constant;
14592  if( !SCIPisInfinity(scip, consdata->rhs) )
14593  consdata->rhs -= constant;
14594 
14595  if( consdata->lhs > consdata->rhs )
14596  {
14597  assert(SCIPisEQ(scip, consdata->lhs, consdata->rhs));
14598  consdata->lhs = consdata->rhs;
14599  }
14600 }
14601 
14602 /** Adds a linear variable with coefficient to a quadratic constraint. */
14604  SCIP* scip, /**< SCIP data structure */
14605  SCIP_CONS* cons, /**< constraint */
14606  SCIP_VAR* var, /**< variable */
14607  SCIP_Real coef /**< coefficient of variable */
14608  )
14609 {
14610  assert(scip != NULL);
14611  assert(cons != NULL);
14612  assert(var != NULL);
14613  assert(!SCIPisInfinity(scip, REALABS(coef)));
14614 
14615  /* nlrow and solving data (see initsol) may become invalid when changing constraint */
14616  if( SCIPgetStage(scip) == SCIP_STAGE_SOLVING && SCIPconsIsEnabled(cons) )
14617  {
14618  SCIPerrorMessage("Cannot modify enabled constraint in solving stage.\n");
14619  return SCIP_INVALIDCALL;
14620  }
14621 
14622  SCIP_CALL( addLinearCoef(scip, cons, var, coef) );
14623 
14624  return SCIP_OKAY;
14625 }
14626 
14627 /** Adds a quadratic variable with linear and square coefficient to a quadratic constraint. */
14629  SCIP* scip, /**< SCIP data structure */
14630  SCIP_CONS* cons, /**< constraint */
14631  SCIP_VAR* var, /**< variable */
14632  SCIP_Real lincoef, /**< linear coefficient of variable */
14633  SCIP_Real sqrcoef /**< square coefficient of variable */
14634  )
14635 {
14636  assert(scip != NULL);
14637  assert(cons != NULL);
14638  assert(var != NULL);
14639  assert(!SCIPisInfinity(scip, REALABS(lincoef)));
14640  assert(!SCIPisInfinity(scip, REALABS(sqrcoef)));
14641 
14642  /* nlrow and solving data (see initsol) may become invalid when changing constraint */
14643  if( SCIPgetStage(scip) == SCIP_STAGE_SOLVING && SCIPconsIsEnabled(cons) )
14644  {
14645  SCIPerrorMessage("Cannot modify enabled constraint in solving stage.\n");
14646  return SCIP_INVALIDCALL;
14647  }
14648 
14649  SCIP_CALL( addQuadVarTerm(scip, cons, var, lincoef, sqrcoef) );
14650 
14651  return SCIP_OKAY;
14652 }
14653 
14654 /** Adds a linear coefficient for a quadratic variable.
14655  *
14656  * Variable will be added with square coefficient 0.0 if not existing yet.
14657  */
14659  SCIP* scip, /**< SCIP data structure */
14660  SCIP_CONS* cons, /**< constraint */
14661  SCIP_VAR* var, /**< variable */
14662  SCIP_Real coef /**< value to add to linear coefficient of variable */
14663  )
14664 {
14665  SCIP_CONSDATA* consdata;
14666  int pos;
14667 
14668  assert(scip != NULL);
14669  assert(cons != NULL);
14670  assert(var != NULL);
14671  assert(!SCIPisInfinity(scip, REALABS(coef)));
14672 
14673  if( SCIPisZero(scip, coef) )
14674  return SCIP_OKAY;
14675 
14676  /* nlrow and solving data (see initsol) may become invalid when changing constraint */
14677  if( SCIPgetStage(scip) == SCIP_STAGE_SOLVING && SCIPconsIsEnabled(cons) )
14678  {
14679  SCIPerrorMessage("Cannot modify enabled constraint in solving stage.\n");
14680  return SCIP_INVALIDCALL;
14681  }
14682 
14683  consdata = SCIPconsGetData(cons);
14684  assert(consdata != NULL);
14685 
14686  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, var, &pos) );
14687  if( pos < 0 )
14688  {
14689  SCIP_CALL( addQuadVarTerm(scip, cons, var, coef, 0.0) );
14690  return SCIP_OKAY;
14691  }
14692  assert(pos < consdata->nquadvars);
14693  assert(consdata->quadvarterms[pos].var == var);
14694 
14695  consdata->quadvarterms[pos].lincoef += coef;
14696 
14697  /* update flags and invalid activities */
14698  consdata->ispropagated = FALSE;
14699  consdata->ispresolved = consdata->ispresolved && !SCIPisZero(scip, consdata->quadvarterms[pos].lincoef);
14700 
14701  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
14702  consdata->activity = SCIP_INVALID;
14703 
14704  return SCIP_OKAY;
14705 }
14706 
14707 /** Adds a square coefficient for a quadratic variable.
14708  *
14709  * Variable will be added with linear coefficient 0.0 if not existing yet.
14710  */
14712  SCIP* scip, /**< SCIP data structure */
14713  SCIP_CONS* cons, /**< constraint */
14714  SCIP_VAR* var, /**< variable */
14715  SCIP_Real coef /**< value to add to square coefficient of variable */
14716  )
14717 {
14718  SCIP_CONSDATA* consdata;
14719  int pos;
14720 
14721  assert(scip != NULL);
14722  assert(cons != NULL);
14723  assert(var != NULL);
14724  assert(!SCIPisInfinity(scip, REALABS(coef)));
14725 
14726  if( SCIPisZero(scip, coef) )
14727  return SCIP_OKAY;
14728 
14729  /* nlrow and solving data (see initsol) may become invalid when changing constraint */
14730  if( SCIPgetStage(scip) == SCIP_STAGE_SOLVING && SCIPconsIsEnabled(cons) )
14731  {
14732  SCIPerrorMessage("Cannot modify enabled constraint in solving stage.\n");
14733  return SCIP_INVALIDCALL;
14734  }
14735 
14736  consdata = SCIPconsGetData(cons);
14737  assert(consdata != NULL);
14738 
14739  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, var, &pos) );
14740  if( pos < 0 )
14741  {
14742  SCIP_CALL( addQuadVarTerm(scip, cons, var, 0.0, coef) );
14743  return SCIP_OKAY;
14744  }
14745  assert(pos < consdata->nquadvars);
14746  assert(consdata->quadvarterms[pos].var == var);
14747 
14748  consdata->quadvarterms[pos].sqrcoef += coef;
14749 
14750  /* update flags and invalid activities */
14751  consdata->isconvex = FALSE;
14752  consdata->isconcave = FALSE;
14753  consdata->iscurvchecked = FALSE;
14754  consdata->ispropagated = FALSE;
14755  consdata->ispresolved = consdata->ispresolved && !SCIPisZero(scip, consdata->quadvarterms[pos].sqrcoef);
14756 
14757  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
14758  consdata->activity = SCIP_INVALID;
14759 
14760  return SCIP_OKAY;
14761 }
14762 
14763 /** Adds a bilinear term to a quadratic constraint.
14764  *
14765  * Variables will be added with linear and square coefficient 0.0 if not existing yet.
14766  * If variables are equal, only the square coefficient of the variable is updated.
14767  */
14769  SCIP* scip, /**< SCIP data structure */
14770  SCIP_CONS* cons, /**< constraint */
14771  SCIP_VAR* var1, /**< first variable */
14772  SCIP_VAR* var2, /**< second variable */
14773  SCIP_Real coef /**< coefficient of bilinear term */
14774  )
14775 {
14776  SCIP_CONSDATA* consdata;
14777  int var1pos;
14778  int var2pos;
14779 
14780  assert(scip != NULL);
14781  assert(cons != NULL);
14782  assert(var1 != NULL);
14783  assert(var2 != NULL);
14784  assert(!SCIPisInfinity(scip, REALABS(coef)));
14785 
14786  /* nlrow and solving data (see initsol) may become invalid when changing constraint */
14787  if( SCIPgetStage(scip) == SCIP_STAGE_SOLVING && SCIPconsIsEnabled(cons) )
14788  {
14789  SCIPerrorMessage("Cannot modify enabled constraint in solving stage.\n");
14790  return SCIP_INVALIDCALL;
14791  }
14792 
14793  if( var1 == var2 )
14794  {
14795  SCIP_CALL( SCIPaddSquareCoefQuadratic(scip, cons, var1, coef) );
14796  return SCIP_OKAY;
14797  }
14798 
14799  consdata = SCIPconsGetData(cons);
14800  assert(consdata != NULL);
14801 
14802  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, var1, &var1pos) );
14803  if( var1pos < 0 )
14804  {
14805  SCIP_CALL( addQuadVarTerm(scip, cons, var1, 0.0, 0.0) );
14806  var1pos = consdata->nquadvars-1;
14807  }
14808 
14809  if( !consdata->quadvarssorted )
14810  {
14811  SCIP_CALL( consdataSortQuadVarTerms(scip, consdata) );
14812  /* sorting may change the position of var1 */
14813  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, var1, &var1pos) );
14814  assert(var1pos >= 0);
14815  }
14816 
14817  assert(consdata->quadvarssorted);
14818  SCIP_CALL( consdataFindQuadVarTerm(scip, consdata, var2, &var2pos) );
14819  if( var2pos < 0 )
14820  {
14821  SCIP_CALL( addQuadVarTerm(scip, cons, var2, 0.0, 0.0) );
14822  var2pos = consdata->nquadvars-1;
14823  }
14824 
14825  assert(consdata->quadvarterms[var1pos].var == var1);
14826  assert(consdata->quadvarterms[var2pos].var == var2);
14827 
14828  SCIP_CALL( addBilinearTerm(scip, cons, var1pos, var2pos, coef) );
14829 
14830  return SCIP_OKAY;
14831 }
14832 
14833 /** Gets the quadratic constraint as a nonlinear row representation. */
14835  SCIP* scip, /**< SCIP data structure */
14836  SCIP_CONS* cons, /**< constraint */
14837  SCIP_NLROW** nlrow /**< pointer to store nonlinear row */
14838  )
14839 {
14840  SCIP_CONSDATA* consdata;
14841 
14842  assert(cons != NULL);
14843  assert(nlrow != NULL);
14844 
14845  consdata = SCIPconsGetData(cons);
14846  assert(consdata != NULL);
14847 
14848  if( consdata->nlrow == NULL )
14849  {
14850  SCIP_CALL( createNlRow(scip, cons) );
14851  }
14852  assert(consdata->nlrow != NULL);
14853  *nlrow = consdata->nlrow;
14854 
14855  return SCIP_OKAY;
14856 }
14857 
14858 /** Gets the number of variables in the linear term of a quadratic constraint. */
14860  SCIP* scip, /**< SCIP data structure */
14861  SCIP_CONS* cons /**< constraint */
14862  )
14863 {
14864  assert(cons != NULL);
14865  assert(SCIPconsGetData(cons) != NULL);
14866 
14867  return SCIPconsGetData(cons)->nlinvars;
14868 }
14869 
14870 /** Gets the variables in the linear part of a quadratic constraint.
14871  * Length is given by SCIPgetNLinearVarsQuadratic.
14872  */
14874  SCIP* scip, /**< SCIP data structure */
14875  SCIP_CONS* cons /**< constraint */
14876  )
14877 {
14878  assert(cons != NULL);
14879  assert(SCIPconsGetData(cons) != NULL);
14880 
14881  return SCIPconsGetData(cons)->linvars;
14882 }
14883 
14884 /** Gets the coefficients in the linear part of a quadratic constraint.
14885  * Length is given by SCIPgetNLinearVarsQuadratic.
14886  */
14888  SCIP* scip, /**< SCIP data structure */
14889  SCIP_CONS* cons /**< constraint */
14890  )
14891 {
14892  assert(cons != NULL);
14893  assert(SCIPconsGetData(cons) != NULL);
14894 
14895  return SCIPconsGetData(cons)->lincoefs;
14896 }
14897 
14898 /** Gets the number of quadratic variable terms of a quadratic constraint.
14899  */
14901  SCIP* scip, /**< SCIP data structure */
14902  SCIP_CONS* cons /**< constraint */
14903  )
14904 {
14905  assert(cons != NULL);
14906  assert(SCIPconsGetData(cons) != NULL);
14907 
14908  return SCIPconsGetData(cons)->nquadvars;
14909 }
14910 
14911 /** Gets the quadratic variable terms of a quadratic constraint.
14912  * Length is given by SCIPgetNQuadVarTermsQuadratic.
14913  */
14915  SCIP* scip, /**< SCIP data structure */
14916  SCIP_CONS* cons /**< constraint */
14917  )
14918 {
14919  assert(cons != NULL);
14920  assert(SCIPconsGetData(cons) != NULL);
14921 
14922  return SCIPconsGetData(cons)->quadvarterms;
14923 }
14924 
14925 /** Ensures that quadratic variable terms are sorted. */
14927  SCIP* scip, /**< SCIP data structure */
14928  SCIP_CONS* cons /**< constraint */
14929  )
14930 {
14931  assert(cons != NULL);
14932  assert(SCIPconsGetData(cons) != NULL);
14933 
14935 
14936  return SCIP_OKAY;
14937 }
14938 
14939 /** Finds the position of a quadratic variable term for a given variable.
14940  *
14941  * @note If the quadratic variable terms have not been sorted before, then a search may reorder the current order of the terms.
14942  */
14944  SCIP* scip, /**< SCIP data structure */
14945  SCIP_CONS* cons, /**< constraint */
14946  SCIP_VAR* var, /**< variable to search for */
14947  int* pos /**< buffer to store position of quadvarterm for var, or -1 if not found */
14948  )
14949 {
14950  assert(cons != NULL);
14951  assert(SCIPconsGetData(cons) != NULL);
14952  assert(var != NULL);
14953  assert(pos != NULL);
14954 
14955  SCIP_CALL( consdataFindQuadVarTerm(scip, SCIPconsGetData(cons), var, pos) );
14956 
14957  return SCIP_OKAY;
14958 }
14959 
14960 /** Gets the number of bilinear terms of a quadratic constraint. */
14962  SCIP* scip, /**< SCIP data structure */
14963  SCIP_CONS* cons /**< constraint */
14964  )
14965 {
14966  assert(cons != NULL);
14967  assert(SCIPconsGetData(cons) != NULL);
14968 
14969  return SCIPconsGetData(cons)->nbilinterms;
14970 }
14971 
14972 /** Gets the bilinear terms of a quadratic constraint.
14973  * Length is given by SCIPgetNBilinTermQuadratic.
14974  */
14976  SCIP* scip, /**< SCIP data structure */
14977  SCIP_CONS* cons /**< constraint */
14978  )
14979 {
14980  assert(cons != NULL);
14981  assert(SCIPconsGetData(cons) != NULL);
14982 
14983  return SCIPconsGetData(cons)->bilinterms;
14984 }
14985 
14986 /** Gets the left hand side of a quadratic constraint. */
14988  SCIP* scip, /**< SCIP data structure */
14989  SCIP_CONS* cons /**< constraint */
14990  )
14991 {
14992  assert(cons != NULL);
14993  assert(SCIPconsGetData(cons) != NULL);
14994 
14995  return SCIPconsGetData(cons)->lhs;
14996 }
14997 
14998 /** Gets the right hand side of a quadratic constraint. */
15000  SCIP* scip, /**< SCIP data structure */
15001  SCIP_CONS* cons /**< constraint */
15002  )
15003 {
15004  assert(cons != NULL);
15005  assert(SCIPconsGetData(cons) != NULL);
15006 
15007  return SCIPconsGetData(cons)->rhs;
15008 }
15009 
15010 /** get index of a variable in linvars that may be decreased without making any other constraint infeasible, or -1 if none */
15012  SCIP* scip, /**< SCIP data structure */
15013  SCIP_CONS* cons /**< constraint */
15014  )
15015 {
15016  SCIP_CONSDATA* consdata;
15017 
15018  assert(cons != NULL);
15019 
15020  consdata = SCIPconsGetData(cons);
15021  assert(consdata != NULL);
15022 
15023  /* check for a linear variable that can be increase or decreased without harming feasibility */
15024  consdataFindUnlockedLinearVar(scip, consdata);
15025 
15026  return consdata->linvar_maydecrease;
15027 }
15028 
15029 /** get index of a variable in linvars that may be increased without making any other constraint infeasible, or -1 if none */
15031  SCIP* scip, /**< SCIP data structure */
15032  SCIP_CONS* cons /**< constraint */
15033  )
15034 {
15035  SCIP_CONSDATA* consdata;
15036 
15037  assert(cons != NULL);
15038 
15039  consdata = SCIPconsGetData(cons);
15040  assert(consdata != NULL);
15041 
15042  /* check for a linear variable that can be increase or decreased without harming feasibility */
15043  consdataFindUnlockedLinearVar(scip, consdata);
15044 
15045  return consdata->linvar_mayincrease;
15046 }
15047 
15048 /** Check the quadratic function of a quadratic constraint for its semi-definiteness, if not done yet. */
15050  SCIP* scip, /**< SCIP data structure */
15051  SCIP_CONS* cons /**< constraint */
15052  )
15053 {
15054  assert(cons != NULL);
15055 
15056  SCIP_CALL( checkCurvature(scip, cons, TRUE) );
15057 
15058  return SCIP_OKAY;
15059 }
15060 
15061 /** Indicates whether the quadratic function of a quadratic constraint is (known to be) convex. */
15063  SCIP* scip, /**< SCIP data structure */
15064  SCIP_CONS* cons /**< constraint */
15065  )
15066 {
15067  SCIP_Bool determined;
15068 
15069  assert(cons != NULL);
15070  assert(SCIPconsGetData(cons) != NULL);
15071 
15072  checkCurvatureEasy(scip, cons, &determined, FALSE);
15073  assert(determined);
15074 
15075  return (SCIPconsGetData(cons)->isconvex);
15076 }
15077 
15078 /** Indicates whether the quadratic function of a quadratic constraint is (known to be) concave. */
15080  SCIP* scip, /**< SCIP data structure */
15081  SCIP_CONS* cons /**< constraint */
15082  )
15083 {
15084  SCIP_Bool determined;
15085 
15086  assert(cons != NULL);
15087  assert(SCIPconsGetData(cons) != NULL);
15088 
15089  checkCurvatureEasy(scip, cons, &determined, FALSE);
15090  assert(determined);
15091 
15092  return (SCIPconsGetData(cons)->isconcave);
15093 }
15094 
15095 /** Computes the violation of a constraint by a solution */
15097  SCIP* scip, /**< SCIP data structure */
15098  SCIP_CONS* cons, /**< constraint */
15099  SCIP_SOL* sol, /**< solution which violation to calculate, or NULL for LP solution */
15100  SCIP_Real* violation /**< pointer to store violation of constraint */
15101  )
15102 {
15103  SCIP_CONSDATA* consdata;
15104  SCIP_Bool solviolbounds;
15105 
15106  assert(scip != NULL);
15107  assert(cons != NULL);
15108  assert(violation != NULL);
15109 
15110  SCIP_CALL( computeViolation(scip, cons, sol, &solviolbounds) );
15111  /* we don't care here whether the solution violated variable bounds */
15112 
15113  consdata = SCIPconsGetData(cons);
15114  assert(consdata != NULL);
15115 
15116  *violation = MAX(consdata->lhsviol, consdata->rhsviol);
15117 
15118  return SCIP_OKAY;
15119 }
15120 
15121 /** Indicates whether the quadratic constraint is local w.r.t. the current local bounds.
15122  *
15123  * That is, checks whether each variable with a square term is fixed and for each bilinear term at least one variable is fixed.
15124  */
15126  SCIP* scip, /**< SCIP data structure */
15127  SCIP_CONS* cons /**< constraint */
15128  )
15129 {
15130  SCIP_CONSDATA* consdata;
15131  SCIP_VAR* var1;
15132  SCIP_VAR* var2;
15133  int i;
15134 
15135  assert(scip != NULL);
15136  assert(cons != NULL);
15137 
15138  consdata = SCIPconsGetData(cons);
15139  assert(consdata != NULL);
15140 
15141  /* check all square terms */
15142  for( i = 0; i < consdata->nquadvars; ++i )
15143  {
15144  if( consdata->quadvarterms[i].sqrcoef == 0.0 )
15145  continue;
15146 
15147  var1 = consdata->quadvarterms[i].var;
15148  assert(var1 != NULL);
15149 
15150  if( !SCIPisRelEQ(scip, SCIPvarGetLbLocal(var1), SCIPvarGetUbLocal(var1)) )
15151  return FALSE;
15152  }
15153 
15154  for( i = 0; i < consdata->nbilinterms; ++i )
15155  {
15156  var1 = consdata->bilinterms[i].var1;
15157  var2 = consdata->bilinterms[i].var2;
15158 
15159  assert(var1 != NULL);
15160  assert(var2 != NULL);
15161 
15162  if( !SCIPisRelEQ(scip, SCIPvarGetLbLocal(var1), SCIPvarGetUbLocal(var1)) &&
15163  ! SCIPisRelEQ(scip, SCIPvarGetLbLocal(var2), SCIPvarGetUbLocal(var2)) )
15164  return FALSE;
15165  }
15166 
15167  return TRUE;
15168 }
15169 
15170 /** Adds the constraint to an NLPI problem. */
15172  SCIP* scip, /**< SCIP data structure */
15173  SCIP_CONS* cons, /**< constraint */
15174  SCIP_NLPI* nlpi, /**< interface to NLP solver */
15175  SCIP_NLPIPROBLEM* nlpiprob, /**< NLPI problem where to add constraint */
15176  SCIP_HASHMAP* scipvar2nlpivar, /**< mapping from SCIP variables to variable indices in NLPI */
15177  SCIP_Bool names /**< whether to pass constraint names to NLPI */
15178  )
15179 {
15180  SCIP_CONSDATA* consdata;
15181  int nlininds;
15182  int* lininds;
15183  SCIP_Real* linvals;
15184  int nquadelems;
15185  SCIP_QUADELEM* quadelems;
15186  SCIP_VAR* othervar;
15187  const char* name;
15188  int j;
15189  int l;
15190  int lincnt;
15191  int quadcnt;
15192  int idx1;
15193  int idx2;
15194 
15195  assert(scip != NULL);
15196  assert(cons != NULL);
15197  assert(nlpi != NULL);
15198  assert(nlpiprob != NULL);
15199  assert(scipvar2nlpivar != NULL);
15200 
15201  consdata = SCIPconsGetData(cons);
15202  assert(consdata != NULL);
15203 
15204  /* count nonzeros in quadratic part */
15205  nlininds = consdata->nlinvars;
15206  nquadelems = consdata->nbilinterms;
15207  for( j = 0; j < consdata->nquadvars; ++j )
15208  {
15209  if( consdata->quadvarterms[j].sqrcoef != 0.0 )
15210  ++nquadelems;
15211  if( consdata->quadvarterms[j].lincoef != 0.0 )
15212  ++nlininds;
15213  }
15214 
15215  /* setup linear part */
15216  lininds = NULL;
15217  linvals = NULL;
15218  lincnt = 0;
15219  if( nlininds > 0 )
15220  {
15221  SCIP_CALL( SCIPallocBufferArray(scip, &lininds, nlininds) );
15222  SCIP_CALL( SCIPallocBufferArray(scip, &linvals, nlininds) );
15223 
15224  for( j = 0; j < consdata->nlinvars; ++j )
15225  {
15226  linvals[j] = consdata->lincoefs[j];
15227  assert(SCIPhashmapExists(scipvar2nlpivar, consdata->linvars[j]));
15228  lininds[j] = SCIPhashmapGetImageInt(scipvar2nlpivar, consdata->linvars[j]);
15229  }
15230 
15231  lincnt = consdata->nlinvars;
15232  }
15233 
15234  /* setup quadratic part */
15235  quadelems = NULL;
15236  if( nquadelems > 0 )
15237  {
15238  SCIP_CALL( SCIPallocBufferArray(scip, &quadelems, nquadelems) );
15239  }
15240  quadcnt = 0;
15241 
15242  for( j = 0; j < consdata->nquadvars; ++j )
15243  {
15244  assert(SCIPhashmapExists(scipvar2nlpivar, consdata->quadvarterms[j].var));
15245  idx1 = SCIPhashmapGetImageInt(scipvar2nlpivar, consdata->quadvarterms[j].var);
15246  if( consdata->quadvarterms[j].lincoef != 0.0 )
15247  {
15248  assert(lininds != NULL);
15249  assert(linvals != NULL);
15250  /* coverity[var_deref_op] */
15251  lininds[lincnt] = idx1;
15252  linvals[lincnt] = consdata->quadvarterms[j].lincoef;
15253  ++lincnt;
15254  }
15255 
15256  if( consdata->quadvarterms[j].sqrcoef != 0.0 )
15257  {
15258  assert(quadcnt < nquadelems);
15259  assert(quadelems != NULL);
15260  /* coverity[var_deref_op] */
15261  quadelems[quadcnt].idx1 = idx1;
15262  quadelems[quadcnt].idx2 = idx1;
15263  quadelems[quadcnt].coef = consdata->quadvarterms[j].sqrcoef;
15264  ++quadcnt;
15265  }
15266 
15267  for( l = 0; l < consdata->quadvarterms[j].nadjbilin; ++l )
15268  {
15269  othervar = consdata->bilinterms[consdata->quadvarterms[j].adjbilin[l]].var2;
15270  /* if othervar is on position 2, then we process this bilinear term later (or it was processed already) */
15271  if( othervar == consdata->quadvarterms[j].var )
15272  continue;
15273 
15274  assert(quadcnt < nquadelems);
15275  assert(quadelems != NULL);
15276  assert(SCIPhashmapExists(scipvar2nlpivar, othervar));
15277  idx2 = SCIPhashmapGetImageInt(scipvar2nlpivar, othervar);
15278  /* coverity[var_deref_op] */
15279  quadelems[quadcnt].idx1 = MIN(idx1, idx2);
15280  quadelems[quadcnt].idx2 = MAX(idx1, idx2);
15281  quadelems[quadcnt].coef = consdata->bilinterms[consdata->quadvarterms[j].adjbilin[l]].coef;
15282  ++quadcnt;
15283  }
15284  }
15285 
15286  assert(quadcnt == nquadelems);
15287  assert(lincnt == nlininds);
15288 
15289  name = names ? SCIPconsGetName(cons) : NULL;
15290 
15291  SCIP_CALL( SCIPnlpiAddConstraints(nlpi, nlpiprob, 1,
15292  &consdata->lhs, &consdata->rhs,
15293  &nlininds, &lininds, &linvals ,
15294  &nquadelems, &quadelems,
15295  NULL, NULL, &name) );
15296 
15297  SCIPfreeBufferArrayNull(scip, &quadelems);
15298  SCIPfreeBufferArrayNull(scip, &lininds);
15299  SCIPfreeBufferArrayNull(scip, &linvals);
15300 
15301  return SCIP_OKAY;
15302 }
15303 
15304 
15305 /** sets the left hand side of a quadratic constraint
15306  *
15307  * @note This method may only be called during problem creation stage for an original constraint.
15308  */
15310  SCIP* scip, /**< SCIP data structure */
15311  SCIP_CONS* cons, /**< constraint data */
15312  SCIP_Real lhs /**< new left hand side */
15313  )
15314 {
15315  SCIP_CONSDATA* consdata;
15316 
15317  assert(scip != NULL);
15318  assert(cons != NULL);
15319  assert(!SCIPisInfinity(scip, lhs));
15320 
15321  if( strcmp(SCIPconshdlrGetName(SCIPconsGetHdlr(cons)), CONSHDLR_NAME) != 0 )
15322  {
15323  SCIPerrorMessage("constraint is not quadratic\n");
15324  return SCIP_INVALIDDATA;
15325  }
15326 
15327  if( SCIPgetStage(scip) > SCIP_STAGE_PROBLEM || !SCIPconsIsOriginal(cons) )
15328  {
15329  SCIPerrorMessage("method may only be called during problem creation stage for original constraints\n");
15330  return SCIP_INVALIDDATA;
15331  }
15332 
15333  consdata = SCIPconsGetData(cons);
15334  assert(consdata != NULL);
15335  assert(!SCIPisInfinity(scip, consdata->lhs));
15336 
15337  /* adjust value to not be smaller than -inf */
15338  if( SCIPisInfinity(scip, -lhs) )
15339  lhs = -SCIPinfinity(scip);
15340 
15341  /* check for lhs <= rhs */
15342  if( !SCIPisLE(scip, lhs, consdata->rhs) )
15343  return SCIP_INVALIDDATA;
15344 
15345  consdata->lhs = lhs;
15346 
15347  return SCIP_OKAY;
15348 }
15349 
15350 /** sets the right hand side of a quadratic constraint
15351  *
15352  * @note This method may only be called during problem creation stage for an original constraint.
15353  */
15355  SCIP* scip, /**< SCIP data structure */
15356  SCIP_CONS* cons, /**< constraint data */
15357  SCIP_Real rhs /**< new right hand side */
15358  )
15359 {
15360  SCIP_CONSDATA* consdata;
15361 
15362  assert(scip != NULL);
15363  assert(cons != NULL);
15364  assert(!SCIPisInfinity(scip, -rhs));
15365 
15366  if( strcmp(SCIPconshdlrGetName(SCIPconsGetHdlr(cons)), CONSHDLR_NAME) != 0 )
15367  {
15368  SCIPerrorMessage("constraint is not quadratic\n");
15369  return SCIP_INVALIDDATA;
15370  }
15371 
15372  if( SCIPgetStage(scip) > SCIP_STAGE_PROBLEM || !SCIPconsIsOriginal(cons) )
15373  {
15374  SCIPerrorMessage("method may only be called during problem creation stage for original constraints\n");
15375  return SCIP_INVALIDDATA;
15376  }
15377 
15378  consdata = SCIPconsGetData(cons);
15379  assert(consdata != NULL);
15380  assert(!SCIPisInfinity(scip, -consdata->rhs));
15381 
15382  /* adjust value to not be greater than inf */
15383  if( SCIPisInfinity(scip, rhs) )
15384  rhs = SCIPinfinity(scip);
15385 
15386  /* check for lhs <= rhs */
15387  if( !SCIPisLE(scip, consdata->lhs, rhs) )
15388  return SCIP_INVALIDDATA;
15389 
15390  consdata->rhs = rhs;
15391 
15392  return SCIP_OKAY;
15393 }
15394 
15395 /** gets the feasibility of the quadratic constraint in the given solution */
15397  SCIP* scip, /**< SCIP data structure */
15398  SCIP_CONS* cons, /**< constraint data */
15399  SCIP_SOL* sol, /**< solution, or NULL to use current node's solution */
15400  SCIP_Real* feasibility /**< pointer to store the feasibility */
15401  )
15402 {
15403  SCIP_CONSDATA* consdata;
15404  SCIP_Bool solviolbounds;
15405 
15406  assert(scip != NULL);
15407  assert(cons != NULL);
15408  assert(feasibility != NULL);
15409 
15410  if( strcmp(SCIPconshdlrGetName(SCIPconsGetHdlr(cons)), CONSHDLR_NAME) != 0 )
15411  {
15412  SCIPerrorMessage("constraint is not quadratic\n");
15413  SCIPABORT();
15414  }
15415 
15416  SCIP_CALL( computeViolation(scip, cons, sol, &solviolbounds) );
15417 
15418  consdata = SCIPconsGetData(cons);
15419  assert(consdata != NULL);
15420 
15421  if( SCIPisInfinity(scip, consdata->rhs) && SCIPisInfinity(scip, -consdata->lhs) )
15422  *feasibility = SCIPinfinity(scip);
15423  else if( SCIPisInfinity(scip, -consdata->lhs) )
15424  *feasibility = (consdata->rhs - consdata->activity);
15425  else if( SCIPisInfinity(scip, consdata->rhs) )
15426  *feasibility = (consdata->activity - consdata->lhs);
15427  else
15428  {
15429  assert(!SCIPisInfinity(scip, -consdata->rhs));
15430  assert(!SCIPisInfinity(scip, consdata->lhs));
15431  *feasibility = MIN( consdata->rhs - consdata->activity, consdata->activity - consdata->lhs );
15432  }
15433 
15434  return SCIP_OKAY;
15435 }
15436 
15437 /** gets the activity of the quadratic constraint in the given solution */
15439  SCIP* scip, /**< SCIP data structure */
15440  SCIP_CONS* cons, /**< constraint data */
15441  SCIP_SOL* sol, /**< solution, or NULL to use current node's solution */
15442  SCIP_Real* activity /**< pointer to store the activity */
15443  )
15444 {
15445  SCIP_CONSDATA* consdata;
15446  SCIP_Bool solviolbounds;
15447 
15448  assert(scip != NULL);
15449  assert(cons != NULL);
15450  assert(activity != NULL);
15451 
15452  if( strcmp(SCIPconshdlrGetName(SCIPconsGetHdlr(cons)), CONSHDLR_NAME) != 0 )
15453  {
15454  SCIPerrorMessage("constraint is not quadratic\n");
15455  SCIPABORT();
15456  }
15457 
15458  SCIP_CALL( computeViolation(scip, cons, sol, &solviolbounds) );
15459 
15460  consdata = SCIPconsGetData(cons);
15461  assert(consdata != NULL);
15462 
15463  *activity = consdata->activity;
15464 
15465  return SCIP_OKAY;
15466 }
15467 
15468 /** changes the linear coefficient value for a given quadratic variable in a quadratic constraint data; if not
15469  * available, it adds it
15470  *
15471  * @note this is only allowed for original constraints and variables in problem creation stage
15472  */
15474  SCIP* scip, /**< SCIP data structure */
15475  SCIP_CONS* cons, /**< constraint data */
15476  SCIP_VAR* var, /**< quadratic variable */
15477  SCIP_Real coef /**< new coefficient */
15478  )
15479 {
15480  SCIP_CONSDATA* consdata;
15481  SCIP_Bool found;
15482  int i;
15483 
15484  assert(scip != NULL);
15485  assert(cons != NULL);
15486  assert(var != NULL);
15487 
15488  if( strcmp(SCIPconshdlrGetName(SCIPconsGetHdlr(cons)), CONSHDLR_NAME) != 0 )
15489  {
15490  SCIPerrorMessage("constraint is not quadratic\n");
15491  return SCIP_INVALIDDATA;
15492  }
15493 
15494  if( SCIPgetStage(scip) > SCIP_STAGE_PROBLEM || !SCIPconsIsOriginal(cons) || !SCIPvarIsOriginal(var) )
15495  {
15496  SCIPerrorMessage("method may only be called during problem creation stage for original constraints and variables\n");
15497  return SCIP_INVALIDDATA;
15498  }
15499 
15500  consdata = SCIPconsGetData(cons);
15501  assert(consdata != NULL);
15502 
15503  /* check all quadratic variables */
15504  found = FALSE;
15505  for( i = 0; i < consdata->nquadvars; ++i )
15506  {
15507  if( var == consdata->quadvarterms[i].var )
15508  {
15509  if( found || SCIPisZero(scip, coef) )
15510  {
15511  consdata->quadvarterms[i].lincoef = 0.0;
15512 
15513  /* remember to merge quadratic variable terms */
15514  consdata->quadvarsmerged = FALSE;
15515  }
15516  else
15517  consdata->quadvarterms[i].lincoef = coef;
15518 
15519  found = TRUE;
15520  }
15521  }
15522 
15523  /* check all linear variables */
15524  i = 0;
15525  while( i < consdata->nlinvars )
15526  {
15527  if( var == consdata->linvars[i] )
15528  {
15529  if( found || SCIPisZero(scip, coef) )
15530  {
15531  SCIP_CALL( delLinearCoefPos(scip, cons, i) );
15532 
15533  /* decrease i by one since otherwise we would skip the coefficient which has been switched to position i */
15534  i--;
15535  }
15536  else
15537  {
15538  SCIP_CALL( chgLinearCoefPos(scip, cons, i, coef) );
15539  }
15540 
15541  found = TRUE;
15542  }
15543  i++;
15544  }
15545 
15546  /* add linear term if necessary */
15547  if( !found && !SCIPisZero(scip, coef) )
15548  {
15549  SCIP_CALL( addLinearCoef(scip, cons, var, coef) );
15550  }
15551 
15552  consdata->ispropagated = FALSE;
15553  consdata->ispresolved = FALSE;
15554 
15555  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
15556  consdata->activity = SCIP_INVALID;
15557 
15558  return SCIP_OKAY;
15559 }
15560 
15561 /** changes the square coefficient value for a given quadratic variable in a quadratic constraint data; if not
15562  * available, it adds it
15563  *
15564  * @note this is only allowed for original constraints and variables in problem creation stage
15565  */
15567  SCIP* scip, /**< SCIP data structure */
15568  SCIP_CONS* cons, /**< constraint data */
15569  SCIP_VAR* var, /**< quadratic variable */
15570  SCIP_Real coef /**< new coefficient */
15571  )
15572 {
15573  SCIP_CONSDATA* consdata;
15574  SCIP_Bool found;
15575  int i;
15576 
15577  assert(scip != NULL);
15578  assert(cons != NULL);
15579  assert(var != NULL);
15580  assert(!SCIPisInfinity(scip, REALABS(coef)));
15581 
15582  if( strcmp(SCIPconshdlrGetName(SCIPconsGetHdlr(cons)), CONSHDLR_NAME) != 0 )
15583  {
15584  SCIPerrorMessage("constraint is not quadratic\n");
15585  return SCIP_INVALIDDATA;
15586  }
15587 
15588  if( SCIPgetStage(scip) > SCIP_STAGE_PROBLEM || !SCIPconsIsOriginal(cons) || !SCIPvarIsOriginal(var) )
15589  {
15590  SCIPerrorMessage("method may only be called during problem creation stage for original constraints and variables\n");
15591  return SCIP_INVALIDDATA;
15592  }
15593 
15594  consdata = SCIPconsGetData(cons);
15595  assert(consdata != NULL);
15596 
15597  /* find the quadratic variable and change its quadratic coefficient */
15598  found = FALSE;
15599  for( i = 0; i < consdata->nquadvars; ++i )
15600  {
15601  if( var == consdata->quadvarterms[i].var )
15602  {
15603  consdata->quadvarterms[i].sqrcoef = (found || SCIPisZero(scip, coef)) ? 0.0 : coef;
15604  found = TRUE;
15605  }
15606  }
15607 
15608  /* add bilinear term if necessary */
15609  if( !found && !SCIPisZero(scip, coef) )
15610  {
15611  SCIP_CALL( addQuadVarTerm(scip, cons, var, 0.0, coef) );
15612  }
15613 
15614  /* update flags and invalidate activities */
15615  consdata->isconvex = FALSE;
15616  consdata->isconcave = FALSE;
15617  consdata->iscurvchecked = FALSE;
15618  consdata->ispropagated = FALSE;
15619  consdata->ispresolved = FALSE;
15620 
15621  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
15622  consdata->activity = SCIP_INVALID;
15623 
15624  /* remember to merge quadratic variable terms */
15625  consdata->quadvarsmerged = FALSE;
15626 
15627  return SCIP_OKAY;
15628 }
15629 
15630 /** changes the bilinear coefficient value for a given quadratic variable in a quadratic constraint data; if not
15631  * available, it adds it
15632  *
15633  * @note this is only allowed for original constraints and variables in problem creation stage
15634  */
15636  SCIP* scip, /**< SCIP data structure */
15637  SCIP_CONS* cons, /**< constraint */
15638  SCIP_VAR* var1, /**< first variable */
15639  SCIP_VAR* var2, /**< second variable */
15640  SCIP_Real coef /**< coefficient of bilinear term */
15641  )
15642 {
15643  SCIP_CONSDATA* consdata;
15644  SCIP_Bool found;
15645  int i;
15646 
15647  assert(scip != NULL);
15648  assert(cons != NULL);
15649  assert(var1 != NULL);
15650  assert(var2 != NULL);
15651  assert(!SCIPisInfinity(scip, REALABS(coef)));
15652 
15653  if( strcmp(SCIPconshdlrGetName(SCIPconsGetHdlr(cons)), CONSHDLR_NAME) != 0 )
15654  {
15655  SCIPerrorMessage("constraint is not quadratic\n");
15656  return SCIP_INVALIDDATA;
15657  }
15658 
15659  if( SCIPgetStage(scip) > SCIP_STAGE_PROBLEM || !SCIPconsIsOriginal(cons) || !SCIPvarIsOriginal(var1) || !SCIPvarIsOriginal(var2) )
15660  {
15661  SCIPerrorMessage("method may only be called during problem creation stage for original constraints and variables\n");
15662  return SCIP_INVALIDDATA;
15663  }
15664 
15665  if( var1 == var2 )
15666  {
15667  SCIP_CALL( SCIPchgSquareCoefQuadratic(scip, cons, var1, coef) );
15668  return SCIP_OKAY;
15669  }
15670 
15671  consdata = SCIPconsGetData(cons);
15672  assert(consdata != NULL);
15673 
15674  /* search array of bilinear terms */
15675  found = FALSE;
15676  for( i = 0; i < consdata->nbilinterms; ++i )
15677  {
15678  if( (consdata->bilinterms[i].var1 == var1 && consdata->bilinterms[i].var2 == var2) ||
15679  (consdata->bilinterms[i].var1 == var2 && consdata->bilinterms[i].var2 == var1) )
15680  {
15681  if( found || SCIPisZero(scip, coef) )
15682  {
15683  consdata->bilinterms[i].coef = 0.0;
15684 
15685  /* remember to merge bilinear terms */
15686  consdata->bilinmerged = FALSE;
15687  }
15688  else
15689  consdata->bilinterms[i].coef = coef;
15690  found = TRUE;
15691  }
15692  }
15693 
15694  /* add bilinear term if necessary */
15695  if( !found )
15696  {
15697  SCIP_CALL( SCIPaddBilinTermQuadratic(scip, cons, var1, var2, coef) );
15698  }
15699 
15700  /* update flags and invalidate activities */
15701  consdata->isconvex = FALSE;
15702  consdata->isconcave = FALSE;
15703  consdata->iscurvchecked = FALSE;
15704  consdata->ispropagated = FALSE;
15705  consdata->ispresolved = FALSE;
15706 
15707  SCIPintervalSetEmpty(&consdata->quadactivitybounds);
15708  consdata->activity = SCIP_INVALID;
15709 
15710  return SCIP_OKAY;
15711 }
15712 
15713 /** returns the total number of bilinear terms that are contained in all quadratic constraints */
15715  SCIP* scip /**< SCIP data structure */
15716  )
15717 {
15718  SCIP_CONSHDLRDATA* conshdlrdata;
15719  SCIP_CONSHDLR* conshdlr;
15720 
15721  assert(scip != NULL);
15722 
15723  conshdlr = SCIPfindConshdlr(scip, CONSHDLR_NAME);
15724 
15725  if( conshdlr == NULL )
15726  return 0;
15727 
15728  conshdlrdata = SCIPconshdlrGetData(conshdlr);
15729  assert(conshdlrdata != NULL);
15730 
15731  return conshdlrdata->nbilinterms;
15732 }
15733 
15734 /** returns all bilinear terms that are contained in all quadratic constraints */
15736  SCIP* scip, /**< SCIP data structure */
15737  SCIP_VAR** RESTRICT x, /**< array to store first variable of each bilinear term */
15738  SCIP_VAR** RESTRICT y, /**< array to second variable of each bilinear term */
15739  int* RESTRICT nbilinterms, /**< buffer to store the total number of bilinear terms */
15740  int* RESTRICT nunderests, /**< array to store the total number of constraints that require to underestimate a bilinear term */
15741  int* RESTRICT noverests, /**< array to store the total number of constraints that require to overestimate a bilinear term */
15742  SCIP_Real* maxnonconvexity /**< largest absolute value of nonconvex eigenvalues of all quadratic constraints containing a bilinear term */
15743  )
15744 {
15745  SCIP_CONSHDLRDATA* conshdlrdata;
15746  SCIP_CONSHDLR* conshdlr;
15747  int i;
15748 
15749  assert(scip != NULL);
15750  assert(x != NULL);
15751  assert(y != NULL);
15752  assert(nbilinterms != NULL);
15753  assert(nunderests != NULL);
15754  assert(noverests!= NULL);
15755  assert(maxnonconvexity != NULL);
15756 
15757  conshdlr = SCIPfindConshdlr(scip, CONSHDLR_NAME);
15758 
15759  if( conshdlr == NULL )
15760  {
15761  *nbilinterms = 0;
15762  return SCIP_OKAY;
15763  }
15764 
15765  conshdlrdata = SCIPconshdlrGetData(conshdlr);
15766  assert(conshdlrdata != NULL);
15767 
15768  for( i = 0; i < conshdlrdata->nbilinterms; ++i )
15769  {
15770  x[i] = conshdlrdata->bilinestimators[i].x;
15771  y[i] = conshdlrdata->bilinestimators[i].y;
15772  nunderests[i] = conshdlrdata->bilinestimators[i].nunderest;
15773  noverests[i] = conshdlrdata->bilinestimators[i].noverest;
15774  maxnonconvexity[i] = conshdlrdata->bilinestimators[i].maxnonconvexity;
15775  }
15776 
15777  *nbilinterms = conshdlrdata->nbilinterms;
15778 
15779  return SCIP_OKAY;
15780 }
15781 
15782 /** helper function to compute the violation of an inequality of the form xcoef * x <= ycoef * y + constant for two
15783  * corner points of the domain [lbx,ubx]x[lby,uby]
15784  */
15785 static
15786 void getIneqViol(
15787  SCIP_VAR* x, /**< first variable */
15788  SCIP_VAR* y, /**< second variable */
15789  SCIP_Real xcoef, /**< x-coefficient */
15790  SCIP_Real ycoef, /**< y-coefficient */
15791  SCIP_Real constant, /**< constant */
15792  SCIP_Real* viol1, /**< buffer to store the violation of the first corner point */
15793  SCIP_Real* viol2 /**< buffer to store the violation of the second corner point */
15794  )
15795 {
15796  SCIP_Real norm;
15797 
15798  assert(viol1 != NULL);
15799  assert(viol2 != NULL);
15800 
15801  norm = SQRT(SQR(xcoef) + SQR(ycoef));
15802 
15803  /* inequality can be used for underestimating xy if and only if xcoef * ycoef > 0 */
15804  if( xcoef * ycoef >= 0 )
15805  {
15806  /* violation for top-left and bottom-right corner */
15807  *viol1 = MAX(0, (xcoef * SCIPvarGetLbLocal(x) - ycoef * SCIPvarGetUbLocal(y) - constant) / norm); /*lint !e666*/
15808  *viol2 = MAX(0, (xcoef * SCIPvarGetUbLocal(x) - ycoef * SCIPvarGetLbLocal(y) - constant) / norm); /*lint !e666*/
15809  }
15810  else
15811  {
15812  /* violation for top-right and bottom-left corner */
15813  *viol1 = MAX(0, (xcoef * SCIPvarGetUbLocal(x) - ycoef * SCIPvarGetUbLocal(y) - constant) / norm); /*lint !e666*/
15814  *viol2 = MAX(0, (xcoef * SCIPvarGetLbLocal(x) - ycoef * SCIPvarGetLbLocal(y) - constant) / norm); /*lint !e666*/
15815  }
15816 
15817  return;
15818 }
15819 
15820 /** adds a globally valid inequality of the form xcoef x <= ycoef y + constant for a bilinear term (x,y)
15821  *
15822  * @note the indices of bilinear terms match with the entries of bilinear terms returned by SCIPgetAllBilinearTermsQuadratic
15823  */
15825  SCIP* scip, /**< SCIP data structure */
15826  SCIP_VAR* x, /**< first variable */
15827  SCIP_VAR* y, /**< second variable */
15828  int idx, /**< index of the bilinear term */
15829  SCIP_Real xcoef, /**< x coefficient */
15830  SCIP_Real ycoef, /**< y coefficient */
15831  SCIP_Real constant, /**< constant part */
15832  SCIP_Bool* success /**< buffer to store whether inequality has been accepted */
15833  )
15834 {
15835  SCIP_CONSHDLRDATA* conshdlrdata;
15836  SCIP_CONSHDLR* conshdlr;
15837  BILINESTIMATOR* bilinest;
15838  SCIP_Real* ineqs;
15839  SCIP_Real viol1 = 0.0;
15840  SCIP_Real viol2 = 0.0;
15841  int* nineqs;
15842  int i;
15843 
15844  assert(scip != NULL);
15845  assert(x != NULL);
15846  assert(y != NULL);
15847  assert(idx >= 0);
15848  assert(xcoef != SCIP_INVALID); /*lint !e777 */
15849  assert(ycoef != SCIP_INVALID); /*lint !e777 */
15850  assert(constant != SCIP_INVALID); /*lint !e777 */
15851  assert(success != NULL);
15852 
15853  *success = FALSE;
15854 
15855  /* ignore inequalities that only yield to a (possible) bound tightening */
15856  if( SCIPisFeasZero(scip, xcoef) || SCIPisFeasZero(scip, ycoef) )
15857  return SCIP_OKAY;
15858 
15859  /* get constraint handler and its data */
15860  conshdlr = SCIPfindConshdlr(scip, CONSHDLR_NAME);
15861  if( conshdlr == NULL )
15862  return SCIP_OKAY;
15863 
15864  conshdlrdata = SCIPconshdlrGetData(conshdlr);
15865  assert(conshdlrdata != NULL);
15866  assert(idx < conshdlrdata->nbilinterms);
15867 
15868  bilinest = &conshdlrdata->bilinestimators[idx];
15869  assert(bilinest != NULL);
15870  assert(bilinest->x == x);
15871  assert(bilinest->y == y);
15872 
15873  SCIPdebugMsg(scip, "add bilinear term inequality: %g %s <= %g %s + %g\n", xcoef, SCIPvarGetName(bilinest->x),
15874  ycoef, SCIPvarGetName(bilinest->y), constant);
15875 
15876  if( xcoef * ycoef > 0.0 )
15877  {
15878  ineqs = bilinest->inequnderest;
15879  nineqs = &bilinest->ninequnderest;
15880  }
15881  else
15882  {
15883  ineqs = bilinest->ineqoverest;
15884  nineqs = &bilinest->nineqoverest;
15885  }
15886 
15887  /* compute violation of the inequality of the important corner points */
15888  getIneqViol(x, y, xcoef, ycoef, constant, &viol1, &viol2);
15889  SCIPdebugMsg(scip, "violations of inequality = (%g,%g)\n", viol1, viol2);
15890 
15891  /* inequality does not cut off one of the important corner points */
15892  if( SCIPisFeasLE(scip, MAX(viol1, viol2), 0.0) )
15893  return SCIP_OKAY;
15894 
15895  /* check whether inequality exists already */
15896  for( i = 0; i < *nineqs; ++i )
15897  {
15898  if( SCIPisFeasEQ(scip, xcoef, ineqs[3*i]) && SCIPisFeasEQ(scip, ycoef, ineqs[3*i+1])
15899  && SCIPisFeasEQ(scip, constant, ineqs[3*i+2]) )
15900  {
15901  SCIPdebugMsg(scip, "inequality already found -> skip\n");
15902  return SCIP_OKAY;
15903  }
15904  }
15905 
15906  /* add inequality if we found less than two so far; otherwise compare the violations to decide which which
15907  * inequality might be replaced
15908  */
15909  if( *nineqs < 2 )
15910  {
15911  ineqs[3*(*nineqs)] = xcoef;
15912  ineqs[3*(*nineqs) + 1] = ycoef;
15913  ineqs[3*(*nineqs) + 2] = constant;
15914  ++(*nineqs);
15915  *success = TRUE;
15916  }
15917  else
15918  {
15919  SCIP_Real viols1[2] = {0.0, 0.0};
15920  SCIP_Real viols2[2] = {0.0, 0.0};
15921  SCIP_Real bestviol;
15922  int pos = -1;
15923 
15924  assert(*nineqs == 2);
15925 
15926  /* compute resulting violations of both corner points when replacing an existing inequality
15927  *
15928  * given the violations (v1,w1), (v2,w2), (v3,w3) we select two inequalities i and j that
15929  * maximize max{vi,vj} + max{wi,wj} this measurement guarantees that select inequalities that
15930  * separate both important corner points
15931  */
15932  getIneqViol(x, y, ineqs[0], ineqs[1], ineqs[2], &viols1[0], &viols2[0]);
15933  getIneqViol(x, y, ineqs[3], ineqs[4], ineqs[5], &viols1[1], &viols2[1]);
15934  bestviol = MAX(viols1[0], viols1[1]) + MAX(viols2[0], viols2[1]);
15935 
15936  for( i = 0; i < 2; ++i )
15937  {
15938  SCIP_Real viol = MAX(viol1, viols1[i]) + MAX(viol2, viols2[i]);
15939  if( SCIPisGT(scip, viol, bestviol) )
15940  {
15941  bestviol = viol;
15942  /* remember inequality that should be replaced */
15943  pos = 1 - i;
15944  }
15945  }
15946 
15947  /* replace inequality at pos when replacing an existing inequality improved the total violation */
15948  if( pos != -1 )
15949  {
15950  assert(pos >= 0 && pos < 2);
15951  ineqs[3*pos] = xcoef;
15952  ineqs[3*pos+1] = ycoef;
15953  ineqs[3*pos+2] = constant;
15954  *success = TRUE;
15955  }
15956  }
15957  SCIPdebugMsg(scip, "accepted inequality? %u\n", *success);
15958 
15959  return SCIP_OKAY;
15960 }
15961 
15962 
15963 /** creates a SCIP_ROWPREP datastructure
15964  *
15965  * Initial cut represents 0 <= 0.
15966  */
15968  SCIP* scip, /**< SCIP data structure */
15969  SCIP_ROWPREP** rowprep, /**< buffer to store pointer to rowprep */
15970  SCIP_SIDETYPE sidetype, /**< whether cut will be or lower-equal or larger-equal type */
15971  SCIP_Bool local /**< whether cut will be valid only locally */
15972  )
15973 {
15974  assert(scip != NULL);
15975  assert(rowprep != NULL);
15976 
15977  SCIP_CALL( SCIPallocBlockMemory(scip, rowprep) );
15978  BMSclearMemory(*rowprep);
15979 
15980  (*rowprep)->sidetype = sidetype;
15981  (*rowprep)->local = local;
15982 
15983  return SCIP_OKAY;
15984 }
15985 
15986 /** frees a SCIP_ROWPREP datastructure */
15987 void SCIPfreeRowprep(
15988  SCIP* scip, /**< SCIP data structure */
15989  SCIP_ROWPREP** rowprep /**< pointer that stores pointer to rowprep */
15990  )
15991 {
15992  assert(scip != NULL);
15993  assert(rowprep != NULL);
15994  assert(*rowprep != NULL);
15995 
15996  SCIPfreeBlockMemoryArrayNull(scip, &(*rowprep)->vars, (*rowprep)->varssize);
15997  SCIPfreeBlockMemoryArrayNull(scip, &(*rowprep)->coefs, (*rowprep)->varssize);
15998  SCIPfreeBlockMemory(scip, rowprep);
15999 }
16000 
16001 /** creates a copy of a SCIP_ROWPREP datastructure */
16003  SCIP* scip, /**< SCIP data structure */
16004  SCIP_ROWPREP** target, /**< buffer to store pointer of rowprep copy */
16005  SCIP_ROWPREP* source /**< rowprep to copy */
16006  )
16007 {
16008  assert(scip != NULL);
16009  assert(target != NULL);
16010  assert(source != NULL);
16011 
16012  SCIP_CALL( SCIPduplicateBlockMemory(scip, target, source) );
16013  if( source->coefs != NULL )
16014  {
16015  SCIP_CALL( SCIPduplicateBlockMemoryArray(scip, &(*target)->coefs, source->coefs, source->varssize) );
16016  }
16017  if( source->vars != NULL )
16018  {
16019  SCIP_CALL( SCIPduplicateBlockMemoryArray(scip, &(*target)->vars, source->vars, source->varssize) );
16020  }
16021 
16022  return SCIP_OKAY;
16023 }
16024 
16025 /** ensures that rowprep has space for at least given number of additional terms
16026  *
16027  * Useful when knowing in advance how many terms will be added.
16028  */
16030  SCIP* scip, /**< SCIP data structure */
16031  SCIP_ROWPREP* rowprep, /**< rowprep */
16032  int size /**< number of additional terms for which to alloc space in rowprep */
16033  )
16034 {
16035  int oldsize;
16036 
16037  assert(scip != NULL);
16038  assert(rowprep != NULL);
16039  assert(size >= 0);
16040 
16041  if( rowprep->varssize >= rowprep->nvars + size )
16042  return SCIP_OKAY; /* already enough space left */
16043 
16044  /* realloc vars and coefs array */
16045  oldsize = rowprep->varssize;
16046  rowprep->varssize = SCIPcalcMemGrowSize(scip, rowprep->nvars + size);
16047 
16048  SCIP_CALL( SCIPreallocBlockMemoryArray(scip, &rowprep->vars, oldsize, rowprep->varssize) );
16049  SCIP_CALL( SCIPreallocBlockMemoryArray(scip, &rowprep->coefs, oldsize, rowprep->varssize) );
16050 
16051  return SCIP_OKAY;
16052 }
16053 
16054 /** prints a rowprep */
16055 void SCIPprintRowprep(
16056  SCIP* scip, /**< SCIP data structure */
16057  SCIP_ROWPREP* rowprep, /**< rowprep to be printed */
16058  FILE* file /**< file to print to, or NULL for stdout */
16059  )
16060 {
16061  int i;
16062 
16063  assert(scip != NULL);
16064  assert(rowprep != NULL);
16065 
16066  if( *rowprep->name != '\0' )
16067  {
16068  SCIPinfoMessage(scip, file, "[%s](%c) ", rowprep->name, rowprep->local ? 'l' : 'g');
16069  }
16070 
16071  for( i = 0; i < rowprep->nvars; ++i )
16072  {
16073  SCIPinfoMessage(scip, file, "%+.15g*<%s> ", rowprep->coefs[i], SCIPvarGetName(rowprep->vars[i]));
16074  }
16075 
16076  SCIPinfoMessage(scip, file, rowprep->sidetype == SCIP_SIDETYPE_LEFT ? ">= %.15g\n" : "<= %.15g\n", rowprep->side);
16077 }
16078 
16079 /** adds a term coef*var to a rowprep */
16081  SCIP* scip, /**< SCIP data structure */
16082  SCIP_ROWPREP* rowprep, /**< rowprep */
16083  SCIP_VAR* var, /**< variable to add */
16084  SCIP_Real coef /**< coefficient to add */
16085  )
16086 {
16087  assert(scip != NULL);
16088  assert(rowprep != NULL);
16089  assert(var != NULL);
16090 
16091  if( coef == 0.0 )
16092  return SCIP_OKAY;
16093 
16094  SCIP_CALL( SCIPensureRowprepSize(scip, rowprep, 1) );
16095  assert(rowprep->varssize > rowprep->nvars);
16096 
16097  rowprep->vars[rowprep->nvars] = var;
16098  rowprep->coefs[rowprep->nvars] = coef;
16099  ++rowprep->nvars;
16100 
16101  return SCIP_OKAY;
16102 }
16103 
16104 /** adds several terms coef*var to a rowprep */
16106  SCIP* scip, /**< SCIP data structure */
16107  SCIP_ROWPREP* rowprep, /**< rowprep */
16108  int nvars, /**< number of terms to add */
16109  SCIP_VAR** vars, /**< variables to add */
16110  SCIP_Real* coefs /**< coefficients to add */
16111  )
16112 {
16113  assert(scip != NULL);
16114  assert(rowprep != NULL);
16115  assert(vars != NULL || nvars == 0);
16116  assert(coefs != NULL || nvars == 0);
16117 
16118  if( nvars == 0 )
16119  return SCIP_OKAY;
16120 
16121  SCIP_CALL( SCIPensureRowprepSize(scip, rowprep, nvars) );
16122  assert(rowprep->varssize >= rowprep->nvars + nvars);
16123 
16124  /*lint --e{866} */
16125  BMScopyMemoryArray(rowprep->vars + rowprep->nvars, vars, nvars);
16126  BMScopyMemoryArray(rowprep->coefs + rowprep->nvars, coefs, nvars);
16127  rowprep->nvars += nvars;
16128 
16129  return SCIP_OKAY;
16130 }
16131 
16132 #ifdef NDEBUG
16133 #undef SCIPaddRowprepSide
16134 #undef SCIPaddRowprepConstant
16135 #endif
16136 
16137 /** adds constant value to side of rowprep */
16138 void SCIPaddRowprepSide(
16139  SCIP_ROWPREP* rowprep, /**< rowprep */
16140  SCIP_Real side /**< constant value to be added to side */
16141  )
16142 {
16143  assert(rowprep != NULL);
16144 
16145  rowprep->side += side;
16146 }
16147 
16148 /** adds constant term to rowprep
16149  *
16150  * Substracts constant from side.
16151  */
16153  SCIP_ROWPREP* rowprep, /**< rowprep */
16154  SCIP_Real constant /**< constant value to be added */
16155  )
16156 {
16157  assert(rowprep != NULL);
16158 
16159  SCIPaddRowprepSide(rowprep, -constant);
16160 }
16161 
16162 /** computes violation of cut in a given solution */
16164  SCIP* scip, /**< SCIP data structure */
16165  SCIP_ROWPREP* rowprep, /**< rowprep to be turned into a row */
16166  SCIP_SOL* sol /**< solution or NULL for LP solution */
16167  )
16168 {
16169  SCIP_Real activity;
16170  int i;
16171 
16172  activity = 0.0;
16173  for( i = 0; i < rowprep->nvars; ++i )
16174  {
16175  /* Loose variable have the best bound as LP solution value.
16176  * HOWEVER, they become column variables when they are added to a row (via SCIPaddVarsToRow below).
16177  * When this happens, their LP solution value changes to 0.0!
16178  * So when calculating the row activity for an LP solution, we treat loose variable as if they were already column variables.
16179  */
16180  if( sol != NULL || SCIPvarGetStatus(rowprep->vars[i]) != SCIP_VARSTATUS_LOOSE )
16181  activity += rowprep->coefs[i] * SCIPgetSolVal(scip, sol, rowprep->vars[i]);
16182  }
16183 
16184  if( rowprep->sidetype == SCIP_SIDETYPE_RIGHT )
16185  /* cut is activity <= side -> violation is activity - side, if positive */
16186  return MAX(activity - rowprep->side, 0.0);
16187  else
16188  /* cut is activity >= side -> violation is side - activity, if positive */
16189  return MAX(rowprep->side - activity, 0.0);
16190 }
16191 
16192 /** Merge terms that use same variable and eliminate zero coefficients.
16193  *
16194  * Terms are sorted by variable (@see SCIPvarComp) after return.
16195  */
16197  SCIP* scip, /**< SCIP data structure */
16198  SCIP_ROWPREP* rowprep /**< rowprep to be cleaned up */
16199  )
16200 {
16201  int i;
16202  int j;
16203 
16204  assert(scip != NULL);
16205  assert(rowprep != NULL);
16206 
16207  if( rowprep->nvars <= 1 )
16208  return;
16209 
16210  /* sort terms by variable index */
16211  SCIPsortPtrReal((void**)rowprep->vars, rowprep->coefs, SCIPvarComp, rowprep->nvars);
16212 
16213  /* merge terms with same variable, drop 0 coefficients */
16214  i = 0;
16215  j = 1;
16216  while( j < rowprep->nvars )
16217  {
16218  if( rowprep->vars[i] == rowprep->vars[j] )
16219  {
16220  /* merge term j into term i */
16221  rowprep->coefs[i] += rowprep->coefs[j];
16222  ++j;
16223  continue;
16224  }
16225 
16226  if( rowprep->coefs[i] == 0.0 )
16227  {
16228  /* move term j to position i */
16229  rowprep->coefs[i] = rowprep->coefs[j];
16230  rowprep->vars[i] = rowprep->vars[j];
16231  ++j;
16232  continue;
16233  }
16234 
16235  /* move term j to position i+1 and move on */
16236  if( j != i+1 )
16237  {
16238  rowprep->vars[i+1] = rowprep->vars[j];
16239  rowprep->coefs[i+1] = rowprep->coefs[j];
16240  }
16241  ++i;
16242  ++j;
16243  }
16244 
16245  /* remaining term can have coef zero -> forget about it */
16246  if( rowprep->coefs[i] == 0.0 )
16247  --i;
16248 
16249  /* i points to last term */
16250  rowprep->nvars = i+1;
16251 }
16252 
16253 /** sort cut terms by absolute value of coefficients, from largest to smallest */
16254 static
16256  SCIP* scip, /**< SCIP data structure */
16257  SCIP_ROWPREP* rowprep /**< rowprep to be sorted */
16258  )
16259 {
16260  int i;
16261 
16262  assert(scip != NULL);
16263  assert(rowprep != NULL);
16264 
16265  /* special treatment for cuts with few variables */
16266  switch( rowprep->nvars )
16267  {
16268  case 0:
16269  case 1:
16270  break;
16271 
16272  case 2:
16273  {
16274  if( REALABS(rowprep->coefs[0]) < REALABS(rowprep->coefs[1]) )
16275  {
16276  SCIP_Real tmp1;
16277  SCIP_VAR* tmp2;
16278 
16279  tmp1 = rowprep->coefs[0];
16280  rowprep->coefs[0] = rowprep->coefs[1];
16281  rowprep->coefs[1] = tmp1;
16282 
16283  tmp2 = rowprep->vars[0];
16284  rowprep->vars[0] = rowprep->vars[1];
16285  rowprep->vars[1] = tmp2;
16286  }
16287  break;
16288  }
16289 
16290  default :
16291  {
16292  SCIP_Real* abscoefs;
16293 
16294  SCIP_CALL( SCIPallocBufferArray(scip, &abscoefs, rowprep->nvars) );
16295  for( i = 0; i < rowprep->nvars; ++i )
16296  abscoefs[i] = REALABS(rowprep->coefs[i]);
16297  SCIPsortDownRealRealPtr(abscoefs, rowprep->coefs, (void**)rowprep->vars, rowprep->nvars);
16298  SCIPfreeBufferArray(scip, &abscoefs);
16299  }
16300  }
16301 
16302  /* forget about coefs that are exactly zero (unlikely to have some) */
16303  while( rowprep->nvars > 0 && rowprep->coefs[rowprep->nvars-1] == 0.0 )
16304  --rowprep->nvars;
16305 
16306  return SCIP_OKAY;
16307 }
16308 
16309 /** try to improve coef range by aggregating cut with variable bounds
16310  *
16311  * Assumes terms have been sorted by rowprepCleanupSortTerms().
16312  */
16313 static
16315  SCIP* scip, /**< SCIP data structure */
16316  SCIP_ROWPREP* rowprep, /**< rowprep to be improve */
16317  SCIP_SOL* sol, /**< solution that we try to cut off, or NULL for LP solution */
16318  SCIP_Real maxcoefrange /**< maximal allowed coefficients range */
16319  )
16320 {
16321  SCIP_VAR* var;
16322  SCIP_Real lb;
16323  SCIP_Real ub;
16324  SCIP_Real ref;
16325  SCIP_Real coef;
16326  SCIP_Real mincoef;
16327  SCIP_Real maxcoef;
16328  SCIP_Real loss[2];
16329  int maxcoefidx;
16330  int pos;
16331 
16332  maxcoefidx = 0;
16333  if( rowprep->nvars > 0 )
16334  {
16335  maxcoef = REALABS(rowprep->coefs[0]);
16336  mincoef = REALABS(rowprep->coefs[rowprep->nvars-1]);
16337  }
16338  else
16339  mincoef = maxcoef = 1.0;
16340 
16341  /* eliminate minimal or maximal coefs as long as coef range is too large
16342  * this is likely going to eliminate coefs that are within eps of 0.0
16343  * if not, then we do so after scaling (or should we enforce this here?)
16344  */
16345  while( maxcoef / mincoef > maxcoefrange )
16346  {
16347  SCIPdebugMsg(scip, "cut coefficients have very large range: mincoef = %g maxcoef = %g\n", mincoef, maxcoef);
16348 
16349  /* max/min can only be > 1 if there is more than one var
16350  * we need this below for updating the max/min coef after eliminating a term
16351  */
16352  assert(rowprep->nvars > 1);
16353 
16354  /* try to reduce coef range by aggregating with variable bounds
16355  * that is, eliminate a term like a*x from a*x + ... <= side by adding -a*x <= -a*lb(x)
16356  * with ref(x) the reference point we try to eliminate, this would weaken the cut by a*(lb(x)-ref(x))
16357  *
16358  * we consider eliminating either the term with maximal or the one with minimal coefficient,
16359  * taking the one that leads to the least weakening of the cut
16360  *
16361  * TODO (suggested by @bzfserra, see !496):
16362  * - Also one could think of not completely removing the coefficient but do an aggregation that makes the coefficient look better. For instance:
16363  * say you have $`a x + 0.1 y \leq r`$ and $`y`$ has only an upper bound, $`y \leq b`$,
16364  * then you can't really remove $`y`$. However, you could aggregate it with $`0.9 \cdot (y \leq b)`$ to get
16365  * $`a x + y \leq r + 0.9 b`$, which has better numerics (and hopefully still cuts the point... actually, if for the point you want to separate, $`y^* = b`$, then the violation is the same)
16366  */
16367 
16368  for( pos = 0; pos < 2; ++pos )
16369  {
16370  var = rowprep->vars[pos ? rowprep->nvars-1 : maxcoefidx];
16371  coef = rowprep->coefs[pos ? rowprep->nvars-1 : maxcoefidx];
16372  lb = SCIPvarGetLbLocal(var);
16373  ub = SCIPvarGetUbLocal(var);
16374  ref = SCIPgetSolVal(scip, sol, var);
16375  assert(coef != 0.0);
16376 
16377  /* make sure reference point is something reasonable within the bounds, preferable the value from the solution */
16378  if( SCIPisInfinity(scip, REALABS(ref)) )
16379  ref = 0.0;
16380  ref = MAX(lb, MIN(ub, ref));
16381 
16382  /* check whether we can eliminate coef*var from rowprep and how much we would loose w.r.t. ref(x) */
16383  if( ((coef > 0.0 && rowprep->sidetype == SCIP_SIDETYPE_RIGHT) || (coef < 0.0 && rowprep->sidetype == SCIP_SIDETYPE_LEFT)) )
16384  {
16385  /* we would need to aggregate with -coef*var <= -coef*lb(x) */
16386  if( SCIPisInfinity(scip, -lb) )
16387  loss[pos] = SCIP_INVALID;
16388  else
16389  loss[pos] = REALABS(coef) * (ref - lb);
16390  }
16391  else
16392  {
16393  assert((coef < 0.0 && rowprep->sidetype == SCIP_SIDETYPE_RIGHT) || (coef > 0.0 && rowprep->sidetype == SCIP_SIDETYPE_LEFT));
16394  /* we would need to aggregate with -coef*var >= -coef*ub(x) */
16395  if( SCIPisInfinity(scip, ub) )
16396  loss[pos] = SCIP_INVALID;
16397  else
16398  loss[pos] = REALABS(coef) * (ub - ref);
16399  }
16400  assert(loss[pos] >= 0.0); /* assuming SCIP_INVALID >= 0 */
16401 
16402  SCIPdebugMsg(scip, "aggregating %g*<%s> %c= ... with <%s>[%g] %c= %g looses %g\n",
16403  coef, SCIPvarGetName(var), rowprep->sidetype == SCIP_SIDETYPE_RIGHT ? '<' : '>',
16404  SCIPvarGetName(var), ref,
16405  ((coef > 0.0 && rowprep->sidetype == SCIP_SIDETYPE_RIGHT) || (coef < 0.0 && rowprep->sidetype == SCIP_SIDETYPE_LEFT)) ? '>' : '<',
16406  ((coef > 0.0 && rowprep->sidetype == SCIP_SIDETYPE_RIGHT) || (coef < 0.0 && rowprep->sidetype == SCIP_SIDETYPE_LEFT)) ? lb : ub, loss[pos]);
16407  }
16408 
16409  /*lint --e{777} */
16410  if( loss[0] == SCIP_INVALID && loss[1] == SCIP_INVALID )
16411  break; /* cannot eliminate coefficient */
16412 
16413  /* select position with smaller loss */
16414  pos = (loss[1] == SCIP_INVALID || loss[1] > loss[0]) ? 0 : 1;
16415 
16416  /* now do the actual elimination */
16417  var = rowprep->vars[pos ? rowprep->nvars-1 : maxcoefidx];
16418  coef = rowprep->coefs[pos ? rowprep->nvars-1 : maxcoefidx];
16419 
16420  /* eliminate coef*var from rowprep: increase side */
16421  if( ((coef > 0.0 && rowprep->sidetype == SCIP_SIDETYPE_RIGHT) || (coef < 0.0 && rowprep->sidetype == SCIP_SIDETYPE_LEFT)) )
16422  {
16423  /* we aggregate with -coef*var <= -coef*lb(x) */
16424  assert(!SCIPisInfinity(scip, -SCIPvarGetLbLocal(var)));
16425  SCIPaddRowprepConstant(rowprep, coef * SCIPvarGetLbLocal(var));
16426  rowprep->local |= SCIPisGT(scip, SCIPvarGetLbLocal(var), SCIPvarGetLbGlobal(var));
16427  }
16428  else
16429  {
16430  assert((coef < 0.0 && rowprep->sidetype == SCIP_SIDETYPE_RIGHT) || (coef > 0.0 && rowprep->sidetype == SCIP_SIDETYPE_LEFT));
16431  /* we aggregate with -coef*var >= -coef*ub(x) */
16432  assert(!SCIPisInfinity(scip, SCIPvarGetUbLocal(var)));
16433  SCIPaddRowprepConstant(rowprep, coef * SCIPvarGetUbLocal(var));
16434  rowprep->local |= SCIPisLT(scip, SCIPvarGetUbLocal(var), SCIPvarGetUbGlobal(var));
16435  }
16436 
16437  /* eliminate coef*var from rowprep: remove coef */
16438  if( pos == 0 )
16439  {
16440  /* set first term to zero */
16441  rowprep->coefs[maxcoefidx] = 0.0;
16442 
16443  /* update index */
16444  ++maxcoefidx;
16445 
16446  /* update maxcoef */
16447  maxcoef = REALABS(rowprep->coefs[maxcoefidx]);
16448  }
16449  else
16450  {
16451  /* forget last term */
16452  --rowprep->nvars;
16453 
16454  /* update mincoef */
16455  mincoef = REALABS(rowprep->coefs[rowprep->nvars-1]);
16456  }
16457  }
16458 
16459  /* if maximal coefs were removed, then there are now 0's in the beginning of the coefs array
16460  * -> move all remaining coefs and vars up front
16461  */
16462  if( maxcoefidx > 0 )
16463  {
16464  int i;
16465  for( i = maxcoefidx; i < rowprep->nvars; ++i )
16466  {
16467  rowprep->vars[i-maxcoefidx] = rowprep->vars[i];
16468  rowprep->coefs[i-maxcoefidx] = rowprep->coefs[i];
16469  }
16470  rowprep->nvars -= maxcoefidx;
16471  }
16472 }
16473 
16474 
16475 /** scales up rowprep if it seems useful */
16476 static
16478  SCIP* scip, /**< SCIP data structure */
16479  SCIP_ROWPREP* rowprep, /**< rowprep to be improve */
16480  SCIP_Real* viol, /**< violation of cut in sol (input and output) */
16481  SCIP_Real minviol /**< minimal violation we try to achieve */
16482  )
16483 {
16484  SCIP_Real scalefactor;
16485  SCIP_Real mincoef;
16486  SCIP_Real maxcoef;
16487 
16488  assert(scip != NULL);
16489  assert(rowprep != NULL);
16490  assert(viol != NULL);
16491 
16492  /* if violation is very small than better don't scale up */
16493  if( *viol < ROWPREP_SCALEUP_VIOLNONZERO )
16494  return;
16495 
16496  /* if violation is already above minviol, then nothing to do */
16497  if( *viol >= minviol )
16498  return;
16499 
16500  /* if violation is sufficiently positive (>10*eps), but has not reached minviol,
16501  * then consider scaling up to reach approx MINVIOLFACTOR*minviol
16502  */
16503  scalefactor = ROWPREP_SCALEUP_MINVIOLFACTOR * minviol / *viol;
16504 
16505  /* scale by approx. scalefactor, if minimal coef is not so large yet and maximal coef and rhs don't get huge by doing so (or have been so before) */
16506  mincoef = rowprep->nvars > 0 ? REALABS(rowprep->coefs[rowprep->nvars-1]) : 1.0;
16507  maxcoef = rowprep->nvars > 0 ? REALABS(rowprep->coefs[0]) : 1.0;
16508  if( mincoef < ROWPREP_SCALEUP_MAXMINCOEF && scalefactor * maxcoef < ROWPREP_SCALEUP_MAXMAXCOEF && scalefactor * REALABS(rowprep->side) < ROWPREP_SCALEUP_MAXSIDE )
16509  {
16510  int scaleexp;
16511 
16512  /* SCIPinfoMessage(scip, NULL, "scale up by ~%g, viol=%g: ", scalefactor, myviol);
16513  SCIPprintRowprep(scip, rowprep, NULL); */
16514 
16515  /* SCIPscaleRowprep returns the actually applied scale factor */
16516  scaleexp = SCIPscaleRowprep(rowprep, scalefactor);
16517  *viol = ldexp(*viol, scaleexp);
16518 
16519  /* SCIPinfoMessage(scip, NULL, "scaled up by %g, viol=%g: ", ldexp(1.0, scaleexp), myviol);
16520  SCIPprintRowprep(scip, rowprep, NULL); */
16521  }
16522 }
16523 
16524 /** scales down rowprep if it improves coefs and keeps rowprep violated */
16525 static
16527  SCIP* scip, /**< SCIP data structure */
16528  SCIP_ROWPREP* rowprep, /**< rowprep to be improve */
16529  SCIP_Real* viol, /**< violation of cut in sol (input and output) */
16530  SCIP_Real minviol /**< minimal violation we try to keep */
16531  )
16532 {
16533  SCIP_Real scalefactor;
16534 
16535  /* if maxcoef < ROWPREP_SCALEDOWN_MINMAXCOEF (or no terms), then don't consider scaling down */
16536  if( rowprep->nvars == 0 || REALABS(rowprep->coefs[0]) < ROWPREP_SCALEDOWN_MINMAXCOEF )
16537  return;
16538 
16539  /* consider scaling down so that maxcoef ~ 10 */
16540  scalefactor = 10.0 / REALABS(rowprep->coefs[0]);
16541 
16542  /* if minimal violation would be lost by scaling down, then increase scalefactor such that minviol is still reached */
16543  if( *viol > minviol && scalefactor * *viol < minviol )
16544  {
16545  assert(minviol > 0.0); /* since viol >= 0, the if-condition should ensure that minviol > 0 */
16546  assert(*viol > 0.0); /* since minviol > 0, the if-condition ensures viol > 0 */
16547  scalefactor = ROWPREP_SCALEUP_MINVIOLFACTOR * minviol / *viol;
16548  }
16549 
16550  /* scale by approx. scalefactor if scaling down and minimal coef does not get too small
16551  * myviol < minviol (-> scalefactor > 1) or mincoef < feastol before scaling is possible, in which case we also don't scale down
16552  */
16553  if( scalefactor < 1.0 && scalefactor * REALABS(rowprep->coefs[rowprep->nvars-1]) > ROWPREP_SCALEDOWN_MINCOEF )
16554  {
16555  int scaleexp;
16556 
16557  /* SCIPinfoMessage(scip, NULL, "scale down by ~%g, viol=%g: ", scalefactor, myviol);
16558  SCIPprintRowprep(scip, rowprep, NULL); */
16559 
16560  scaleexp = SCIPscaleRowprep(rowprep, scalefactor);
16561  *viol = ldexp(*viol, scaleexp);
16562 
16563  /* SCIPinfoMessage(scip, NULL, "scaled down by %g, viol=%g: ", ldexp(1.0, scaleexp), myviol);
16564  SCIPprintRowprep(scip, rowprep, NULL); */
16565  }
16566 }
16567 
16568 /** rounds almost integral coefs to integrals, thereby trying to relax the cut */
16569 static
16571  SCIP* scip, /**< SCIP data structure */
16572  SCIP_ROWPREP* rowprep, /**< rowprep to be improve */
16573  SCIP_Real* viol /**< violation of cut in sol (input), set to SCIP_INVALID if some coef changed */
16574  )
16575 {
16576  SCIP_Real coef;
16577  SCIP_Real roundcoef;
16578  int i;
16579 
16580  assert(scip != NULL);
16581  assert(rowprep != NULL);
16582  assert(viol != NULL);
16583 
16584  /* Coefficients smaller than epsilon are rounded to 0.0 when added to row and
16585  * coefficients very close to integral values are rounded to integers when added to LP.
16586  * Both cases can be problematic if variable value is very large (bad numerics).
16587  * Thus, we anticipate by rounding coef here, but also modify constant so that cut is still valid (if possible),
16588  * i.e., bound coef[i]*x by round(coef[i])*x + (coef[i]-round(coef[i])) * bound(x).
16589  * Or in other words, we aggregate with the variable bound.
16590  *
16591  * If the required bound of x is not finite, then only round coef (introduces an error).
16592  * @TODO If only the opposite bound is available, then one could move the coefficient
16593  * away from the closest integer so that the SCIP_ROW won't try to round it.
16594  */
16595  for( i = 0; i < rowprep->nvars; ++i )
16596  {
16597  coef = rowprep->coefs[i];
16598  roundcoef = SCIPround(scip, coef);
16599  if( coef != roundcoef && SCIPisEQ(scip, coef, roundcoef) ) /*lint !e777*/
16600  {
16601  SCIP_Real xbnd;
16602  SCIP_VAR* var;
16603 
16604  var = rowprep->vars[i];
16605  if( rowprep->sidetype == SCIP_SIDETYPE_RIGHT )
16606  if( rowprep->local )
16607  xbnd = coef > roundcoef ? SCIPvarGetLbLocal(var) : SCIPvarGetUbLocal(var);
16608  else
16609  xbnd = coef > roundcoef ? SCIPvarGetLbGlobal(var) : SCIPvarGetUbGlobal(var);
16610  else
16611  if( rowprep->local )
16612  xbnd = coef > roundcoef ? SCIPvarGetUbLocal(var) : SCIPvarGetLbLocal(var);
16613  else
16614  xbnd = coef > roundcoef ? SCIPvarGetUbGlobal(var) : SCIPvarGetLbGlobal(var);
16615 
16616  if( !SCIPisInfinity(scip, REALABS(xbnd)) )
16617  {
16618  /* if there is a bound, then relax row side so rounding coef will not introduce an error */
16619  SCIPdebugMsg(scip, "var <%s> [%g,%g] has almost integral coef %.15g, round coefficient to %g and add constant %g\n",
16620  SCIPvarGetName(var), SCIPvarGetLbGlobal(var), SCIPvarGetUbGlobal(var), coef, roundcoef, (coef-roundcoef) * xbnd);
16621  SCIPaddRowprepConstant(rowprep, (coef-roundcoef) * xbnd);
16622  }
16623  else
16624  {
16625  /* if there is no bound, then we make the coef integral, too, even though this will introduce an error
16626  * however, SCIP_ROW would do this anyway, but doing this here might eliminate some epsilon coefs (so they don't determine mincoef below)
16627  * and helps to get a more accurate row violation value
16628  */
16629  SCIPdebugMsg(scip, "var <%s> [%g,%g] has almost integral coef %.15g, round coefficient to %g without relaxing side (!)\n",
16630  SCIPvarGetName(var), SCIPvarGetLbGlobal(var), SCIPvarGetUbGlobal(var), coef, roundcoef);
16631  }
16632  rowprep->coefs[i] = roundcoef;
16633  *viol = SCIP_INVALID;
16634  }
16635  }
16636 
16637  /* forget about coefs that became exactly zero by the above step */
16638  while( rowprep->nvars > 0 && rowprep->coefs[rowprep->nvars-1] == 0.0 )
16639  --rowprep->nvars;
16640 }
16641 
16642 /** relaxes almost zero side */
16643 static
16644 void rowprepCleanupSide(
16645  SCIP* scip, /**< SCIP data structure */
16646  SCIP_ROWPREP* rowprep, /**< rowprep to be improve */
16647  SCIP_Real* viol /**< violation of cut in sol (input), set to SCIP_INVALID if some coef changed */
16648  )
16649 {
16650  /* SCIP_ROW handling will replace a side close to 0 by 0.0, even if that makes the row more restrictive
16651  * we thus relax the side here so that it will either be 0 now or will not be rounded to 0 later
16652  */
16653  if( !SCIPisZero(scip, rowprep->side) )
16654  return;
16655 
16656  if( rowprep->side > 0.0 && rowprep->sidetype == SCIP_SIDETYPE_RIGHT )
16657  rowprep->side = 1.1*SCIPepsilon(scip);
16658  else if( rowprep->side < 0.0 && rowprep->sidetype == SCIP_SIDETYPE_LEFT )
16659  rowprep->side = -1.1*SCIPepsilon(scip);
16660  else
16661  rowprep->side = 0.0;
16662 
16663  *viol = SCIP_INVALID;
16664 }
16665 
16666 /* Cleans up and attempts to improve rowprep
16667  *
16668  * Drops small or large coefficients if coefrange is too large, if this can be done by relaxing the cut.
16669  * Scales coefficients and side up to reach minimal violation, if possible.
16670  * Scaling is omitted if violation is very small (ROWPREP_SCALEUP_VIOLNONZERO) or
16671  * maximal coefficient would become huge (ROWPREP_SCALEUP_MAXMAXCOEF).
16672  * Scales coefficients and side down if they are large and if the minimal violation is still reached.
16673  * Rounds coefficients close to integral values to integrals, if this can be done by relaxing the cut.
16674  * Rounds side within epsilon of 0 to 0.0 or +/-1.1*epsilon, whichever relaxes the cut least.
16675  *
16676  * After return, the terms in the rowprep will be sorted by absolute value of coefficient, in decreasing order.
16677  */
16679  SCIP* scip, /**< SCIP data structure */
16680  SCIP_ROWPREP* rowprep, /**< rowprep to be cleaned */
16681  SCIP_SOL* sol, /**< solution that we try to cut off, or NULL for LP solution */
16682  SCIP_Real maxcoefrange, /**< maximal allowed coefficients range */
16683  SCIP_Real minviol, /**< minimal absolute violation the row should achieve (w.r.t. sol) */
16684  SCIP_Real* coefrange, /**< buffer to store coefrange of cleaned up cut, or NULL if not of interest */
16685  SCIP_Real* viol /**< buffer to store absolute violation of cleaned up cut in sol, or NULL if not of interest */
16686  )
16687 {
16688  SCIP_Real myviol;
16689 #ifdef SCIP_DEBUG
16690  SCIP_Real mincoef = 1.0;
16691  SCIP_Real maxcoef = 1.0;
16692 #endif
16693 
16694  assert(maxcoefrange > 1.0); /* not much interesting otherwise */
16695 
16696  /* sort term by absolute value of coef. */
16697  SCIP_CALL( rowprepCleanupSortTerms(scip, rowprep) );
16698 
16699 #ifdef SCIP_DEBUG
16700  if( rowprep->nvars > 0 )
16701  {
16702  maxcoef = REALABS(rowprep->coefs[0]);
16703  mincoef = REALABS(rowprep->coefs[rowprep->nvars-1]);
16704  }
16705 
16706  SCIPinfoMessage(scip, NULL, "starting cleanup, coefrange %g: ", maxcoef/mincoef);
16707  SCIPprintRowprep(scip, rowprep, NULL);
16708 #endif
16709 
16710  /* improve coefficient range by aggregating out variables */
16711  rowprepCleanupImproveCoefrange(scip, rowprep, sol, maxcoefrange);
16712 
16713  /* get current violation in sol */
16714  myviol = SCIPgetRowprepViolation(scip, rowprep, sol);
16715  assert(myviol >= 0.0);
16716 
16717 #ifdef SCIP_DEBUG
16718  if( rowprep->nvars > 0 )
16719  {
16720  maxcoef = REALABS(rowprep->coefs[0]);
16721  mincoef = REALABS(rowprep->coefs[rowprep->nvars-1]);
16722  }
16723 
16724  SCIPinfoMessage(scip, NULL, "improved coefrange to %g, viol %g: ", maxcoef / mincoef, myviol);
16725  SCIPprintRowprep(scip, rowprep, NULL);
16726 #endif
16727 
16728  /* if there is interest in achieving some minimal violation, then possibly scale up to increase violation, updates myviol */
16729  if( minviol > 0.0 )
16730  {
16731  /* first, try to achieve scip's minefficacy (typically 1e-4) */
16732  if( SCIPgetSepaMinEfficacy(scip) > minviol )
16733  rowprepCleanupScaleup(scip, rowprep, &myviol, SCIPgetSepaMinEfficacy(scip));
16734  /* in case scip minefficacy could not be reached or was smaller than minviol, try with the given minviol */
16735  rowprepCleanupScaleup(scip, rowprep, &myviol, minviol);
16736  }
16737 
16738  /* scale down to improve numerics, updates myviol */
16739  rowprepCleanupScaledown(scip, rowprep, &myviol, MAX(SCIPgetSepaMinEfficacy(scip), minviol)); /*lint !e666*/
16740 
16741 #ifdef SCIP_DEBUG
16742  SCIPinfoMessage(scip, NULL, "applied scaling, viol %g: ", myviol);
16743  SCIPprintRowprep(scip, rowprep, NULL);
16744 #endif
16745 
16746  /* turn almost-integral coefs to integral values, may set myviol to SCIP_INVALID */
16747  rowprepCleanupIntegralCoefs(scip, rowprep, &myviol);
16748 
16749  /* relax almost-zero side, may set myviol to SCIP_INVALID */
16750  rowprepCleanupSide(scip, rowprep, &myviol);
16751 
16752 #ifdef SCIP_DEBUG
16753  SCIPinfoMessage(scip, NULL, "adjusted almost-integral coefs and sides, viol %g: ", myviol);
16754  SCIPprintRowprep(scip, rowprep, NULL);
16755 #endif
16756 
16757  /* compute final coefrange, if requested by caller */
16758  if( coefrange != NULL )
16759  {
16760  if( rowprep->nvars > 0 )
16761  *coefrange = REALABS(rowprep->coefs[0]) / REALABS(rowprep->coefs[rowprep->nvars-1]);
16762  else
16763  *coefrange = 1.0;
16764  }
16765 
16766  /* If we updated myviol correctly, then it should coincide with freshly computed violation.
16767  * I leave this assert off for now, since getting the tolerance in the EQ correctly is not trivial. We recompute viol below anyway.
16768  */
16769  /* assert(myviol == SCIP_INVALID || SCIPisEQ(scip, myviol, SCIPgetRowprepViolation(scip, rowprep, sol))); */
16770 
16771  /* compute final violation, if requested by caller */
16772  if( viol != NULL ) /*lint --e{777} */
16773  *viol = myviol == SCIP_INVALID ? SCIPgetRowprepViolation(scip, rowprep, sol) : myviol;
16774 
16775  return SCIP_OKAY;
16776 }
16777 
16778 /** scales a rowprep
16779  *
16780  * @return Exponent of actually applied scaling factor, if written as 2^x.
16781  */
16782 int SCIPscaleRowprep(
16783  SCIP_ROWPREP* rowprep, /**< rowprep to be scaled */
16784  SCIP_Real factor /**< suggested scale factor */
16785  )
16786 {
16787  double v;
16788  int expon;
16789  int i;
16790 
16791  assert(rowprep != NULL);
16792  assert(factor > 0.0);
16793 
16794  /* write factor as v*2^expon with v in [0.5,1) */
16795  v = frexp(factor, &expon);
16796  /* adjust to v'*2^expon with v' in (0.5,1] by v'=v if v > 0.5, v'=1 if v=0.5 */
16797  if( v == 0.5 )
16798  --expon;
16799 
16800  /* multiply each coefficient by 2^expon */
16801  for( i = 0; i < rowprep->nvars; ++i )
16802  rowprep->coefs[i] = ldexp(rowprep->coefs[i], expon);
16803 
16804  /* multiply side by 2^expon */
16805  rowprep->side = ldexp(rowprep->side, expon);
16806 
16807  return expon;
16808 }
16809 
16810 /** generates a SCIP_ROW from a rowprep */
16812  SCIP* scip, /**< SCIP data structure */
16813  SCIP_ROW** row, /**< buffer to store pointer to new row */
16814  SCIP_ROWPREP* rowprep, /**< rowprep to be turned into a row */
16815  SCIP_CONSHDLR* conshdlr /**< constraint handler */
16816  )
16817 {
16818  assert(scip != NULL);
16819  assert(row != NULL);
16820  assert(rowprep != NULL);
16821 
16822  SCIP_CALL( SCIPcreateEmptyRowCons(scip, row, conshdlr, rowprep->name,
16823  rowprep->sidetype == SCIP_SIDETYPE_LEFT ? rowprep->side : -SCIPinfinity(scip),
16824  rowprep->sidetype == SCIP_SIDETYPE_RIGHT ? rowprep->side : SCIPinfinity(scip),
16825  rowprep->local && (SCIPgetDepth(scip) > 0), FALSE, TRUE) );
16826 
16827  SCIP_CALL( SCIPaddVarsToRow(scip, *row, rowprep->nvars, rowprep->vars, rowprep->coefs) );
16828 
16829  return SCIP_OKAY;
16830 }
16831 
16832 /** generates a SCIP_ROW from a rowprep */
16834  SCIP* scip, /**< SCIP data structure */
16835  SCIP_ROW** row, /**< buffer to store pointer to new row */
16836  SCIP_ROWPREP* rowprep, /**< rowprep to be turned into a row */
16837  SCIP_SEPA* sepa /**< separator */
16838  )
16839 {
16840  assert(scip != NULL);
16841  assert(row != NULL);
16842  assert(rowprep != NULL);
16843 
16844  SCIP_CALL( SCIPcreateEmptyRowSepa(scip, row, sepa, rowprep->name,
16845  rowprep->sidetype == SCIP_SIDETYPE_LEFT ? rowprep->side : -SCIPinfinity(scip),
16846  rowprep->sidetype == SCIP_SIDETYPE_RIGHT ? rowprep->side : SCIPinfinity(scip),
16847  rowprep->local && (SCIPgetDepth(scip) > 0), FALSE, TRUE) );
16848 
16849  SCIP_CALL( SCIPaddVarsToRow(scip, *row, rowprep->nvars, rowprep->vars, rowprep->coefs) );
16850 
16851  return SCIP_OKAY;
16852 }
enum SCIP_Result SCIP_RESULT
Definition: type_result.h:52
SCIP_RETCODE SCIPupdateStartpointHeurSubNlp(SCIP *scip, SCIP_HEUR *heur, SCIP_SOL *solcand, SCIP_Real violation)
Definition: heur_subnlp.c:2451
static void rowprepCleanupImproveCoefrange(SCIP *scip, SCIP_ROWPREP *rowprep, SCIP_SOL *sol, SCIP_Real maxcoefrange)
SCIP_Real SCIPgetPrimalRayVal(SCIP *scip, SCIP_VAR *var)
Definition: scip_sol.c:3516
SCIP_Bool SCIPisEQ(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
SCIP_Real SCIPround(SCIP *scip, SCIP_Real val)
#define SCIPfreeBlockMemoryArray(scip, ptr, num)
Definition: scip_mem.h:97
enum SCIP_BoundType SCIP_BOUNDTYPE
Definition: type_lp.h:50
void SCIPintervalDivScalar(SCIP_Real infinity, SCIP_INTERVAL *resultant, SCIP_INTERVAL operand1, SCIP_Real operand2)
static SCIP_Bool conshdlrdataHasUpgrade(SCIP *scip, SCIP_CONSHDLRDATA *conshdlrdata, SCIP_DECL_QUADCONSUPGD((*quadconsupgd)), const char *conshdlrname)
SCIP_Real SCIPfeastol(SCIP *scip)
SCIP_EXPORT SCIP_Real SCIPvarGetBestBoundLocal(SCIP_VAR *var)
Definition: var.c:17438
#define ROWPREP_SCALEUP_VIOLNONZERO
SCIP_Bool SCIPisRelEQ(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
#define SCIPreallocBlockMemoryArray(scip, ptr, oldnum, newnum)
Definition: scip_mem.h:86
static SCIP_RETCODE mergeAndCleanLinearVars(SCIP *scip, SCIP_CONS *cons)
SCIP_RETCODE SCIPcreateConsLinear(SCIP *scip, SCIP_CONS **cons, const char *name, int nvars, SCIP_VAR **vars, SCIP_Real *vals, SCIP_Real lhs, SCIP_Real rhs, SCIP_Bool initial, SCIP_Bool separate, SCIP_Bool enforce, SCIP_Bool check, SCIP_Bool propagate, SCIP_Bool local, SCIP_Bool modifiable, SCIP_Bool dynamic, SCIP_Bool removable, SCIP_Bool stickingatnode)
static SCIP_Bool generateCutLTIgenMulCoeff(SCIP *scip, SCIP_Real x1, SCIP_Real y1_, SCIP_Real x2, SCIP_Real y2, SCIP_Bool whichuse, SCIP_Real *cx, SCIP_Real *cy, SCIP_Real *cw)
void SCIPintervalMulSup(SCIP_Real infinity, SCIP_INTERVAL *resultant, SCIP_INTERVAL operand1, SCIP_INTERVAL operand2)
SCIP_RETCODE SCIPcreateConsAnd(SCIP *scip, SCIP_CONS **cons, const char *name, SCIP_VAR *resvar, int nvars, SCIP_VAR **vars, SCIP_Bool initial, SCIP_Bool separate, SCIP_Bool enforce, SCIP_Bool check, SCIP_Bool propagate, SCIP_Bool local, SCIP_Bool modifiable, SCIP_Bool dynamic, SCIP_Bool removable, SCIP_Bool stickingatnode)
Definition: cons_and.c:5008
int SCIPgetNContVars(SCIP *scip)
Definition: scip_prob.c:2167
static SCIP_RETCODE consdataCreate(SCIP *scip, SCIP_CONSDATA **consdata, SCIP_Real lhs, SCIP_Real rhs, int nlinvars, SCIP_VAR **linvars, SCIP_Real *lincoefs, int nquadvars, SCIP_QUADVARTERM *quadvarterms, int nbilinterms, SCIP_BILINTERM *bilinterms, SCIP_Bool capturevars)
static volatile int nterms
Definition: interrupt.c:37
SCIP_RETCODE SCIPfreeSol(SCIP *scip, SCIP_SOL **sol)
Definition: scip_sol.c:976
SCIP_Bool SCIProwIsLocal(SCIP_ROW *row)
Definition: lp.c:17075
SCIP_Real SCIPdualfeastol(SCIP *scip)
static SCIP_RETCODE propagateBoundsQuadVar(SCIP *scip, SCIP_CONS *cons, SCIP_Real intervalinfty, SCIP_VAR *var, SCIP_Real a, SCIP_INTERVAL b, SCIP_INTERVAL rhs, SCIP_RESULT *result, int *nchgbds)
SCIP_Bool SCIPisPositive(SCIP *scip, SCIP_Real val)
SCIP_EXPORT SCIP_Bool SCIPvarIsTransformed(SCIP_VAR *var)
Definition: var.c:16880
static SCIP_RETCODE freeAllBilinearTerms(SCIP *scip, SCIP_CONSHDLRDATA *conshdlrdata, SCIP_CONS **conss, int nconss)
SCIP_Real SCIPepsilon(SCIP *scip)
static SCIP_DECL_CONSENFOPS(consEnfopsQuadratic)
SCIP_RETCODE SCIPcreateChild(SCIP *scip, SCIP_NODE **node, SCIP_Real nodeselprio, SCIP_Real estimate)
Definition: scip_branch.c:959
SCIP_Bool SCIPconsIsLockedType(SCIP_CONS *cons, SCIP_LOCKTYPE locktype)
Definition: cons.c:8469
SCIP_RETCODE SCIPnlpiAddVars(SCIP_NLPI *nlpi, SCIP_NLPIPROBLEM *problem, int nvars, const SCIP_Real *lbs, const SCIP_Real *ubs, const char **varnames)
Definition: nlpi.c:250
#define NULL
Definition: def.h:253
#define ROWPREP_SCALEDOWN_MINCOEF
SCIP_Bool SCIPisStopped(SCIP *scip)
Definition: scip_general.c:686
static void consdataMoveLinearVar(SCIP_CONSDATA *consdata, int oldpos, int newpos)
SCIP_RETCODE SCIPheurPassSolTrySol(SCIP *scip, SCIP_HEUR *heur, SCIP_SOL *sol)
Definition: heur_trysol.c:242
SCIP_RETCODE SCIPcreateConsBasicQuadratic2(SCIP *scip, SCIP_CONS **cons, const char *name, int nlinvars, SCIP_VAR **linvars, SCIP_Real *lincoefs, int nquadvarterms, SCIP_QUADVARTERM *quadvarterms, int nbilinterms, SCIP_BILINTERM *bilinterms, SCIP_Real lhs, SCIP_Real rhs)
SCIP_Bool SCIPconsIsEnabled(SCIP_CONS *cons)
Definition: cons.c:8173
SCIP_RETCODE SCIPsetConshdlrTrans(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSTRANS((*constrans)))
Definition: scip_cons.c:585
SCIP_Bool SCIPintervalIsEmpty(SCIP_Real infinity, SCIP_INTERVAL operand)
SCIP_Bool SCIPisIntegral(SCIP *scip, SCIP_Real val)
#define SCIPallocBlockMemoryArray(scip, ptr, num)
Definition: scip_mem.h:80
static SCIP_RETCODE consdataSortBilinTerms(SCIP *scip, SCIP_CONSDATA *consdata)
primal heuristic that tries a given solution
SCIP_Bool SCIPhaveVarsCommonClique(SCIP *scip, SCIP_VAR *var1, SCIP_Bool value1, SCIP_VAR *var2, SCIP_Bool value2, SCIP_Bool regardimplics)
Definition: scip_var.c:7569
SCIP_RETCODE SCIPaddExternBranchCand(SCIP *scip, SCIP_VAR *var, SCIP_Real score, SCIP_Real solval)
Definition: scip_branch.c:654
SCIP_CONSHDLR * SCIPfindConshdlr(SCIP *scip, const char *name)
Definition: scip_cons.c:876
SCIP_VAR * var2
const char * SCIPheurGetName(SCIP_HEUR *heur)
Definition: heur.c:1254
static void rowprepCleanupScaleup(SCIP *scip, SCIP_ROWPREP *rowprep, SCIP_Real *viol, SCIP_Real minviol)
public methods for SCIP parameter handling
SCIP_Real SCIPgetSepaMinEfficacy(SCIP *scip)
Definition: scip_sepa.c:297
#define MAXDNOM
SCIP_RETCODE SCIPgetViolationQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_SOL *sol, SCIP_Real *violation)
#define SCIP_EVENTTYPE_VARFIXED
Definition: type_event.h:58
#define GAUGESCALE
static SCIP_RETCODE separatePoint(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS **conss, int nconss, int nusefulconss, SCIP_SOL *sol, SCIP_Real minefficacy, SCIP_Bool inenforcement, SCIP_RESULT *result, SCIP_Real *bestefficacy)
public methods for branch and bound tree
#define CONSHDLR_PRESOLTIMING
static SCIP_DECL_CONSSEPASOL(consSepasolQuadratic)
SCIP_RETCODE SCIPaddLinearCoefsToNlRow(SCIP *scip, SCIP_NLROW *nlrow, int nvars, SCIP_VAR **vars, SCIP_Real *vals)
Definition: scip_nlp.c:1390
static SCIP_RETCODE consdataEnsureQuadVarTermsSize(SCIP *scip, SCIP_CONSDATA *consdata, int num)
SCIP_RETCODE SCIPsetConshdlrExitsol(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSEXITSOL((*consexitsol)))
Definition: scip_cons.c:452
static SCIP_DECL_CONSINITSOL(consInitsolQuadratic)
SCIP_Bool SCIPisGE(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
void SCIPfreeParseVarsPolynomialData(SCIP *scip, SCIP_VAR ****monomialvars, SCIP_Real ***monomialexps, SCIP_Real **monomialcoefs, int **monomialnvars, int nmonomials)
Definition: scip_var.c:1161
Constraint handler for variable bound constraints .
SCIP_RETCODE SCIPcreateConsBasicQuadratic(SCIP *scip, SCIP_CONS **cons, const char *name, int nlinvars, SCIP_VAR **linvars, SCIP_Real *lincoefs, int nquadterms, SCIP_VAR **quadvars1, SCIP_VAR **quadvars2, SCIP_Real *quadcoefs, SCIP_Real lhs, SCIP_Real rhs)
SCIP_RETCODE SCIPtightenVarLb(SCIP *scip, SCIP_VAR *var, SCIP_Real newbound, SCIP_Bool force, SCIP_Bool *infeasible, SCIP_Bool *tightened)
Definition: scip_var.c:5121
SCIP_RETCODE SCIPcreateCons(SCIP *scip, SCIP_CONS **cons, const char *name, SCIP_CONSHDLR *conshdlr, SCIP_CONSDATA *consdata, SCIP_Bool initial, SCIP_Bool separate, SCIP_Bool enforce, SCIP_Bool check, SCIP_Bool propagate, SCIP_Bool local, SCIP_Bool modifiable, SCIP_Bool dynamic, SCIP_Bool removable, SCIP_Bool stickingatnode)
Definition: scip_cons.c:933
SCIP_Bool SCIPconsIsLocal(SCIP_CONS *cons)
Definition: cons.c:8315
SCIP_BILINTERM * SCIPgetBilinTermsQuadratic(SCIP *scip, SCIP_CONS *cons)
static SCIP_RETCODE propagateBoundsBilinearTerm(SCIP *scip, SCIP_CONS *cons, SCIP_Real intervalinfty, SCIP_VAR *x, SCIP_Real xsqrcoef, SCIP_Real xlincoef, SCIP_VAR *y, SCIP_Real ysqrcoef, SCIP_Real ylincoef, SCIP_Real bilincoef, SCIP_INTERVAL rhs, SCIP_RESULT *result, int *nchgbds)
SCIP_EXPORT int SCIPvarGetNLocksUpType(SCIP_VAR *var, SCIP_LOCKTYPE locktype)
Definition: var.c:3241
public methods for memory management
SCIP_RETCODE SCIPsetConshdlrEnforelax(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSENFORELAX((*consenforelax)))
Definition: scip_cons.c:307
#define ROWPREP_SCALEDOWN_MINMAXCOEF
SCIP_NLPI ** SCIPgetNlpis(SCIP *scip)
Definition: scip_nlp.c:118
int SCIPexprgraphGetNodeNChildren(SCIP_EXPRGRAPHNODE *node)
Definition: expr.c:12974
#define SCIPallocClearBufferArray(scip, ptr, num)
Definition: scip_mem.h:113
SCIP_Real SCIPintervalNegateReal(SCIP_Real x)
SCIP_Bool SCIPconsIsChecked(SCIP_CONS *cons)
Definition: cons.c:8275
SCIP_EXPORT SCIP_Bool SCIPsortedvecFindPtr(void **ptrarray, SCIP_DECL_SORTPTRCOMP((*ptrcomp)), void *val, int len, int *pos)
SCIP_RETCODE SCIPmarkConsPropagate(SCIP *scip, SCIP_CONS *cons)
Definition: scip_cons.c:1950
SCIP_RETCODE SCIPincludeConshdlrBasic(SCIP *scip, SCIP_CONSHDLR **conshdlrptr, const char *name, const char *desc, int enfopriority, int chckpriority, int eagerfreq, SCIP_Bool needscons, SCIP_DECL_CONSENFOLP((*consenfolp)), SCIP_DECL_CONSENFOPS((*consenfops)), SCIP_DECL_CONSCHECK((*conscheck)), SCIP_DECL_CONSLOCK((*conslock)), SCIP_CONSHDLRDATA *conshdlrdata)
Definition: scip_cons.c:165
SCIP_RETCODE SCIPaddVarLocksType(SCIP *scip, SCIP_VAR *var, SCIP_LOCKTYPE locktype, int nlocksdown, int nlocksup)
Definition: scip_var.c:4200
static SCIP_DECL_SORTINDCOMP(quadVarTermComp)
#define SCIP_MAXSTRLEN
Definition: def.h:274
static SCIP_RETCODE replaceQuadVarTermPos(SCIP *scip, SCIP_CONS *cons, int pos, SCIP_VAR *var, SCIP_Real coef, SCIP_Real offset)
#define SCIP_DECL_CONSINITPRE(x)
Definition: type_cons.h:141
#define CONSHDLR_DELAYPROP
SCIP_VAR * var1
SCIP_EVENTHDLR * SCIPfindEventhdlr(SCIP *scip, const char *name)
Definition: scip_event.c:224
SCIP_RETCODE SCIPcreateNlRow(SCIP *scip, SCIP_NLROW **nlrow, const char *name, SCIP_Real constant, int nlinvars, SCIP_VAR **linvars, SCIP_Real *lincoefs, int nquadvars, SCIP_VAR **quadvars, int nquadelems, SCIP_QUADELEM *quadelems, SCIP_EXPRTREE *expression, SCIP_Real lhs, SCIP_Real rhs, SCIP_EXPRCURV curvature)
Definition: scip_nlp.c:1167
SCIP_RETCODE SCIPaddRowprepTerms(SCIP *scip, SCIP_ROWPREP *rowprep, int nvars, SCIP_VAR **vars, SCIP_Real *coefs)
void SCIPwarningMessage(SCIP *scip, const char *formatstr,...)
Definition: scip_message.c:122
#define SCIPallocClearBlockMemoryArray(scip, ptr, num)
Definition: scip_mem.h:84
static SCIP_RETCODE getImpliedBounds(SCIP *scip, SCIP_VAR *x, SCIP_Bool xval, SCIP_VAR *y, SCIP_INTERVAL *resultant)
SCIP_Bool SCIPisRelGT(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
SCIP_RETCODE SCIPsetConshdlrGetVars(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSGETVARS((*consgetvars)))
Definition: scip_cons.c:815
SCIP_RETCODE SCIPaddSquareCoefQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var, SCIP_Real coef)
SCIP_EXPORT void SCIPsortDownIntInt(int *intarray1, int *intarray2, int len)
SCIP_RETCODE SCIPcleanupRowprep(SCIP *scip, SCIP_ROWPREP *rowprep, SCIP_SOL *sol, SCIP_Real maxcoefrange, SCIP_Real minviol, SCIP_Real *coefrange, SCIP_Real *viol)
#define CONSHDLR_PROPFREQ
SCIP_Real inequnderest[6]
#define SQR(x)
Definition: def.h:205
#define INTERIOR_EPS
int SCIProwGetNNonz(SCIP_ROW *row)
Definition: lp.c:16887
SCIP_RETCODE SCIPcaptureVar(SCIP *scip, SCIP_VAR *var)
Definition: scip_var.c:1217
static SCIP_DECL_CONSSEPALP(consSepalpQuadratic)
SCIP_Real SCIPgetSolVal(SCIP *scip, SCIP_SOL *sol, SCIP_VAR *var)
Definition: scip_sol.c:1352
internal methods for NLPI solver interfaces
SCIP_RETCODE SCIPaddRowprepTerm(SCIP *scip, SCIP_ROWPREP *rowprep, SCIP_VAR *var, SCIP_Real coef)
SCIP_RETCODE SCIPtightenVarUb(SCIP *scip, SCIP_VAR *var, SCIP_Real newbound, SCIP_Bool force, SCIP_Bool *infeasible, SCIP_Bool *tightened)
Definition: scip_var.c:5237
SCIP_RETCODE SCIPcheckCurvatureQuadratic(SCIP *scip, SCIP_CONS *cons)
public solving methods
static SCIP_RETCODE lockLinearVariable(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var, SCIP_Real coef)
SCIP_RETCODE SCIPprintRow(SCIP *scip, SCIP_ROW *row, FILE *file)
Definition: scip_lp.c:2031
SCIP_Bool local
static SCIP_RETCODE catchVarEvents(SCIP *scip, SCIP_EVENTHDLR *eventhdlr, SCIP_CONS *cons)
SCIP_Longint SCIPcalcGreComDiv(SCIP_Longint val1, SCIP_Longint val2)
Definition: misc.c:8690
SCIP_RETCODE SCIPsetConshdlrPrint(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSPRINT((*consprint)))
Definition: scip_cons.c:769
static void consdataUpdateLinearActivityUbChange(SCIP *scip, SCIP_CONSDATA *consdata, SCIP_Real coef, SCIP_Real oldbnd, SCIP_Real newbnd)
SCIP_Bool SCIPconsIsAdded(SCIP_CONS *cons)
Definition: cons.c:8505
static SCIP_RETCODE dropLinearVarEvents(SCIP *scip, SCIP_EVENTHDLR *eventhdlr, SCIP_CONS *cons, int linvarpos)
int SCIPconshdlrGetNConss(SCIP_CONSHDLR *conshdlr)
Definition: cons.c:4593
static SCIP_RETCODE addQuadVarTerm(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var, SCIP_Real lincoef, SCIP_Real sqrcoef)
#define RESTRICT
Definition: def.h:265
SCIP_RETCODE SCIPnlpiCreateProblem(SCIP_NLPI *nlpi, SCIP_NLPIPROBLEM **problem, const char *name)
Definition: nlpi.c:211
SCIP_RETCODE SCIPhashmapInsertInt(SCIP_HASHMAP *hashmap, void *origin, int image)
Definition: misc.c:3009
static SCIP_DECL_CONSENABLE(consEnableQuadratic)
static SCIP_RETCODE generateCut(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons, SCIP_Real *ref, SCIP_SOL *sol, SCIP_SIDETYPE violside, SCIP_ROW **row, SCIP_Real *efficacy, SCIP_Bool checkcurvmultivar, SCIP_Real minefficacy)
static void consdataUpdateLinearActivityLbChange(SCIP *scip, SCIP_CONSDATA *consdata, SCIP_Real coef, SCIP_Real oldbnd, SCIP_Real newbnd)
SCIP_NODE * SCIPgetCurrentNode(SCIP *scip)
Definition: scip_tree.c:80
SCIP_EXPORT SCIP_Bool SCIPvarIsBinary(SCIP_VAR *var)
Definition: var.c:16918
static SCIP_DECL_NONLINCONSUPGD(nonlinconsUpgdQuadratic)
SCIP_EXPORT SCIP_VAR ** SCIPvarGetImplVars(SCIP_VAR *var, SCIP_Bool varfixing)
Definition: var.c:17647
int SCIPgetNVars(SCIP *scip)
Definition: scip_prob.c:1987
SCIP_Bool SCIPconsIsActive(SCIP_CONS *cons)
Definition: cons.c:8137
#define CONSHDLR_MAXPREROUNDS
void SCIPintervalSetRoundingMode(SCIP_ROUNDMODE roundmode)
SCIP_SIDETYPE sidetype
static SCIP_DECL_CONSEXITPRE(consExitpreQuadratic)
void SCIPaddConstantQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_Real constant)
void SCIPverbMessage(SCIP *scip, SCIP_VERBLEVEL msgverblevel, FILE *file, const char *formatstr,...)
Definition: scip_message.c:215
SCIP_RETCODE SCIPchgBilinCoefQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var1, SCIP_VAR *var2, SCIP_Real coef)
#define FALSE
Definition: def.h:73
#define INITLPMAXVARVAL
static SCIP_RETCODE evaluateGauge(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons, SCIP_SOL *refsol, SCIP_Real *gaugeval, SCIP_Bool *success)
static SCIP_RETCODE storeAllBilinearTerms(SCIP *scip, SCIP_CONSHDLRDATA *conshdlrdata, SCIP_CONS **conss, int nconss)
SCIP_Real SCIPgetLhsQuadratic(SCIP *scip, SCIP_CONS *cons)
SCIP_Bool SCIPisRelGE(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
static SCIP_RETCODE presolveSolve(SCIP *scip, SCIP_CONS *cons, SCIP_RESULT *result, SCIP_Bool *redundant, int *naggrvars)
SCIP_EXPORT SCIP_Real SCIPvarGetObj(SCIP_VAR *var)
Definition: var.c:17200
SCIP_QUADVARTERM * SCIPgetQuadVarTermsQuadratic(SCIP *scip, SCIP_CONS *cons)
SCIP_Bool SCIPisIpoptAvailableIpopt(void)
SCIP_EXPORT SCIP_HEUR * SCIPsolGetHeur(SCIP_SOL *sol)
Definition: sol.c:2553
void * SCIPhashmapEntryGetImage(SCIP_HASHMAPENTRY *entry)
Definition: misc.c:3387
#define CONSHDLR_SEPAPRIORITY
SCIP_EXPORT SCIP_VARTYPE SCIPvarGetType(SCIP_VAR *var)
Definition: var.c:16903
SCIP_Bool SCIPisFeasNegative(SCIP *scip, SCIP_Real val)
#define TRUE
Definition: def.h:72
#define SCIPdebug(x)
Definition: pub_message.h:74
enum SCIP_Retcode SCIP_RETCODE
Definition: type_retcode.h:53
static SCIP_RETCODE generateCutConvex(SCIP *scip, SCIP_CONS *cons, SCIP_SIDETYPE violside, SCIP_Real *ref, SCIP_ROWPREP *rowprep, SCIP_Bool *success)
SCIP_Bool SCIPisRelLE(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
#define SCIP_PRESOLTIMING_EXHAUSTIVE
Definition: type_timing.h:45
SCIP_RETCODE SCIPdelConsLocal(SCIP *scip, SCIP_CONS *cons)
Definition: scip_prob.c:3470
SCIP_Bool SCIPconsIsInitial(SCIP_CONS *cons)
Definition: cons.c:8245
SCIP_Real SCIPgetRhsNonlinear(SCIP *scip, SCIP_CONS *cons)
static void consdataFindUnlockedLinearVar(SCIP *scip, SCIP_CONSDATA *consdata)
static void checkCurvatureEasy(SCIP *scip, SCIP_CONS *cons, SCIP_Bool *determined, SCIP_Bool checkmultivariate)
SCIP_RETCODE SCIPsetConshdlrDelete(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSDELETE((*consdelete)))
Definition: scip_cons.c:562
void SCIPintervalSetBounds(SCIP_INTERVAL *resultant, SCIP_Real inf, SCIP_Real sup)
SCIP_Bool SCIPisFeasLE(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
SCIP_EXPORT SCIP_Bool SCIPvarIsActive(SCIP_VAR *var)
Definition: var.c:17025
public methods for problem variables
static GRAPHNODE ** active
SCIP_Real SCIPadjustedVarUb(SCIP *scip, SCIP_VAR *var, SCIP_Real ub)
Definition: scip_var.c:4583
void SCIPswapReals(SCIP_Real *value1, SCIP_Real *value2)
Definition: misc.c:9878
SCIP_RETCODE SCIPaddBoolParam(SCIP *scip, const char *name, const char *desc, SCIP_Bool *valueptr, SCIP_Bool isadvanced, SCIP_Bool defaultvalue, SCIP_DECL_PARAMCHGD((*paramchgd)), SCIP_PARAMDATA *paramdata)
Definition: scip_param.c:47
static SCIP_RETCODE removeBilinearTermsPos(SCIP *scip, SCIP_CONS *cons, int nterms, int *termposs)
SCIP_Real SCIPceil(SCIP *scip, SCIP_Real val)
#define SCIPfreeBlockMemory(scip, ptr)
Definition: scip_mem.h:95
SCIP_EXPORT SCIP_Real * SCIPvarGetImplBounds(SCIP_VAR *var, SCIP_Bool varfixing)
Definition: var.c:17676
SCIP_EXPORT void SCIPsortPtrReal(void **ptrarray, SCIP_Real *realarray, SCIP_DECL_SORTPTRCOMP((*ptrcomp)), int len)
#define SCIPdebugMessage
Definition: pub_message.h:77
void SCIPcomputeBilinEnvelope1(SCIP *scip, SCIP_Real bilincoef, SCIP_Real lbx, SCIP_Real ubx, SCIP_Real refpointx, SCIP_Real lby, SCIP_Real uby, SCIP_Real refpointy, SCIP_Bool overestimate, SCIP_Real xcoef, SCIP_Real ycoef, SCIP_Real constant, SCIP_Real *RESTRICT lincoefx, SCIP_Real *RESTRICT lincoefy, SCIP_Real *RESTRICT linconstant, SCIP_Bool *RESTRICT success)
static SCIP_RETCODE presolveTryAddAND(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons, int *naddconss)
SCIP_EXPORT SCIP_VARSTATUS SCIPvarGetStatus(SCIP_VAR *var)
Definition: var.c:16857
SCIP_RETCODE SCIPaddToNlpiProblemQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_NLPI *nlpi, SCIP_NLPIPROBLEM *nlpiprob, SCIP_HASHMAP *scipvar2nlpivar, SCIP_Bool names)
Constraint handler for AND constraints, .
static SCIP_RETCODE mergeAndCleanBilinearTerms(SCIP *scip, SCIP_CONS *cons)
SCIP_Real SCIPgetUpperbound(SCIP *scip)
SCIP_RETCODE SCIPchgSquareCoefQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var, SCIP_Real coef)
SCIP_RETCODE SCIPsetConshdlrPresol(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSPRESOL((*conspresol)), int maxprerounds, SCIP_PRESOLTIMING presoltiming)
Definition: scip_cons.c:524
SCIP_RETCODE SCIPnlpiSetRealPar(SCIP_NLPI *nlpi, SCIP_NLPIPROBLEM *problem, SCIP_NLPPARAM type, SCIP_Real dval)
Definition: nlpi.c:671
static SCIP_RETCODE chgLinearCoefPos(SCIP *scip, SCIP_CONS *cons, int pos, SCIP_Real newcoef)
static SCIP_RETCODE propagateBoundsCons(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons, SCIP_RESULT *result, int *nchgbds, SCIP_Bool *redundant)
static SCIP_DECL_CONSENFOLP(consEnfolpQuadratic)
void SCIPaddSquareLinearization(SCIP *scip, SCIP_Real sqrcoef, SCIP_Real refpoint, SCIP_Bool isint, SCIP_Real *lincoef, SCIP_Real *linconstant, SCIP_Bool *success)
#define SCIPfreeBufferArray(scip, ptr)
Definition: scip_mem.h:123
SCIP_RETCODE SCIPsetConshdlrInit(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSINIT((*consinit)))
Definition: scip_cons.c:380
SCIP_RETCODE SCIPsetConshdlrGetNVars(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSGETNVARS((*consgetnvars)))
Definition: scip_cons.c:838
#define SCIPallocBlockMemory(scip, ptr)
Definition: scip_mem.h:78
#define SCIPdebugPrintCons(x, y, z)
Definition: pub_message.h:83
public methods for SCIP variables
static SCIP_RETCODE dropQuadVarEvents(SCIP *scip, SCIP_EVENTHDLR *eventhdlr, SCIP_CONS *cons, int quadvarpos)
SCIP_RETCODE SCIPsetConshdlrExitpre(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSEXITPRE((*consexitpre)))
Definition: scip_cons.c:500
SCIP_RETCODE SCIPunlinkSol(SCIP *scip, SCIP_SOL *sol)
Definition: scip_sol.c:1181
#define SCIP_EVENTTYPE_BOUNDCHANGED
Definition: type_event.h:108
SCIP_RETCODE SCIPfindQuadVarTermQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var, int *pos)
static SCIP_RETCODE registerBranchingCandidatesViolation(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS **conss, int nconss, SCIP_SOL *sol, int *nnotify)
#define SCIPdebugMsgPrint
Definition: scip_message.h:70
#define ROWPREP_SCALEUP_MAXMAXCOEF
#define SCIPdebugMsg
Definition: scip_message.h:69
SCIP_RETCODE SCIPchgLinearCoefQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var, SCIP_Real coef)
SCIP_RETCODE SCIPcreateNLPSol(SCIP *scip, SCIP_SOL **sol, SCIP_HEUR *heur)
Definition: scip_sol.c:389
static void consdataUpdateLinearActivity(SCIP *scip, SCIP_CONSDATA *consdata, SCIP_Real intervalinfty)
public methods for separator plugins
SCIP_RETCODE SCIPgetActivityQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_SOL *sol, SCIP_Real *activity)
SCIP_VAR ** x
Definition: circlepacking.c:54
SCIP_RETCODE SCIPlockVarCons(SCIP *scip, SCIP_VAR *var, SCIP_CONS *cons, SCIP_Bool lockdown, SCIP_Bool lockup)
Definition: scip_var.c:4291
SCIP_LPSOLSTAT SCIPgetLPSolstat(SCIP *scip)
Definition: scip_lp.c:158
SCIP_EXPORT void SCIPsortInt(int *intarray, int len)
int SCIPgetNQuadVarTermsQuadratic(SCIP *scip, SCIP_CONS *cons)
static SCIP_RETCODE lockQuadraticVariable(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var)
#define SCIP_PRESOLTIMING_FAST
Definition: type_timing.h:43
SCIP_RETCODE SCIPsetConshdlrFree(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSFREE((*consfree)))
Definition: scip_cons.c:356
SCIP_Bool SCIPisInfinity(SCIP *scip, SCIP_Real val)
SCIP_RETCODE SCIPgetNLPFracVars(SCIP *scip, SCIP_VAR ***fracvars, SCIP_Real **fracvarssol, SCIP_Real **fracvarsfrac, int *nfracvars, int *npriofracvars)
Definition: scip_nlp.c:712
int SCIPgetNIntVars(SCIP *scip)
Definition: scip_prob.c:2077
SCIP_RETCODE SCIPsortQuadVarTermsQuadratic(SCIP *scip, SCIP_CONS *cons)
SCIP_RETCODE SCIPsolveNLP(SCIP *scip)
Definition: scip_nlp.c:569
public methods for numerical tolerances
SCIP_RETCODE SCIPnlpiSetObjective(SCIP_NLPI *nlpi, SCIP_NLPIPROBLEM *problem, int nlins, const int *lininds, const SCIP_Real *linvals, int nquadelems, const SCIP_QUADELEM *quadelems, const int *exprvaridxs, const SCIP_EXPRTREE *exprtree, const SCIP_Real constant)
Definition: nlpi.c:300
SCIP_RETCODE SCIPaddQuadVarQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var, SCIP_Real lincoef, SCIP_Real sqrcoef)
static SCIP_RETCODE unlockQuadraticVariable(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var)
SCIP_HEUR * SCIPfindHeur(SCIP *scip, const char *name)
Definition: scip_heur.c:248
SCIP_EXPORT SCIP_Real * SCIPvarGetMultaggrScalars(SCIP_VAR *var)
Definition: var.c:17144
void SCIPupdateSolConsViolation(SCIP *scip, SCIP_SOL *sol, SCIP_Real absviol, SCIP_Real relviol)
Definition: scip_sol.c:264
SCIP_Longint SCIPgetNLPs(SCIP *scip)
SCIP_RETCODE SCIPcreateConsVarbound(SCIP *scip, SCIP_CONS **cons, const char *name, SCIP_VAR *var, SCIP_VAR *vbdvar, SCIP_Real vbdcoef, SCIP_Real lhs, SCIP_Real rhs, SCIP_Bool initial, SCIP_Bool separate, SCIP_Bool enforce, SCIP_Bool check, SCIP_Bool propagate, SCIP_Bool local, SCIP_Bool modifiable, SCIP_Bool dynamic, SCIP_Bool removable, SCIP_Bool stickingatnode)
public methods for expressions, expression trees, expression graphs, and related stuff ...
#define SCIP_EVENTTYPE_LBCHANGED
Definition: type_event.h:104
SCIP_RETCODE SCIPdelCons(SCIP *scip, SCIP_CONS *cons)
Definition: scip_prob.c:2838
SCIP_RETCODE SCIPchgLhsQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_Real lhs)
public methods for querying solving statistics
SCIP_Bool SCIPconsIsLocked(SCIP_CONS *cons)
Definition: cons.c:8415
static SCIP_RETCODE generateCutNonConvex(SCIP *scip, SCIP_CONSHDLRDATA *conshdlrdata, SCIP_CONS *cons, SCIP_SIDETYPE violside, SCIP_Real *ref, SCIP_ROWPREP *rowprep, SCIP_Bool *success)
SCIP_Bool SCIPisLE(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
static SCIP_RETCODE registerBranchingCandidatesGap(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS **conss, int nconss, SCIP_SOL *sol, int *nnotify)
int SCIPhashmapGetImageInt(SCIP_HASHMAP *hashmap, void *origin)
Definition: misc.c:3098
public methods for the branch-and-bound tree
SCIP_RETCODE SCIPgetVarCopy(SCIP *sourcescip, SCIP *targetscip, SCIP_VAR *sourcevar, SCIP_VAR **targetvar, SCIP_HASHMAP *varmap, SCIP_HASHMAP *consmap, SCIP_Bool global, SCIP_Bool *success)
Definition: scip_copy.c:672
SCIP_RETCODE SCIPaddQuadVarLinearCoefQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var, SCIP_Real coef)
SCIP_EXPROP SCIPexprgraphGetNodeOperator(SCIP_EXPRGRAPHNODE *node)
Definition: expr.c:13034
static SCIP_RETCODE consdataSortQuadVarTerms(SCIP *scip, SCIP_CONSDATA *consdata)
SCIP_EXPORT SCIP_Bool SCIPvarIsInitial(SCIP_VAR *var)
Definition: var.c:16939
#define CONSHDLR_EAGERFREQ
SCIP_Bool SCIPhashmapExists(SCIP_HASHMAP *hashmap, void *origin)
Definition: misc.c:3240
SCIP_RETCODE SCIPcreateSolCopy(SCIP *scip, SCIP_SOL **sol, SCIP_SOL *sourcesol)
Definition: scip_sol.c:609
SCIP_RETCODE SCIPreleaseNlRow(SCIP *scip, SCIP_NLROW **nlrow)
Definition: scip_nlp.c:1275
#define SCIPduplicateBlockMemoryArray(scip, ptr, source, num)
Definition: scip_mem.h:92
SCIP_Real coef
Definition: type_expr.h:104
void SCIPaddBilinLinearization(SCIP *scip, SCIP_Real bilincoef, SCIP_Real refpointx, SCIP_Real refpointy, SCIP_Real *lincoefx, SCIP_Real *lincoefy, SCIP_Real *linconstant, SCIP_Bool *success)
SCIP_RETCODE SCIPnlpiAddConstraints(SCIP_NLPI *nlpi, SCIP_NLPIPROBLEM *problem, int nconss, const SCIP_Real *lhss, const SCIP_Real *rhss, const int *nlininds, int *const *lininds, SCIP_Real *const *linvals, const int *nquadelems, SCIP_QUADELEM *const *quadelems, int *const *exprvaridxs, SCIP_EXPRTREE *const *exprtrees, const char **names)
Definition: nlpi.c:268
public methods for managing constraints
#define SCIP_EVENTTYPE_SOLFOUND
Definition: type_event.h:127
void SCIPfreeRowprep(SCIP *scip, SCIP_ROWPREP **rowprep)
SCIP_Real inf
Definition: intervalarith.h:39
SCIP_RETCODE SCIPcheckCons(SCIP *scip, SCIP_CONS *cons, SCIP_SOL *sol, SCIP_Bool checkintegrality, SCIP_Bool checklprows, SCIP_Bool printreason, SCIP_RESULT *result)
Definition: scip_cons.c:2071
SCIP_HASHMAPENTRY * SCIPhashmapGetEntry(SCIP_HASHMAP *hashmap, int entryidx)
Definition: misc.c:3366
SCIP_Real SCIPrelDiff(SCIP_Real val1, SCIP_Real val2)
Definition: misc.c:10571
static SCIP_RETCODE checkCurvature(SCIP *scip, SCIP_CONS *cons, SCIP_Bool checkmultivariate)
static SCIP_RETCODE presolveTryAddLinearReform(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons, int *naddconss)
static SCIP_RETCODE generateCutFactorableDo(SCIP *scip, SCIP_CONS *cons, SCIP_Real *ref, SCIP_Real multleft, SCIP_Real *coefleft, SCIP_Real multright, SCIP_Real *coefright, SCIP_Real rightminactivity, SCIP_Real rightmaxactivity, SCIP_Real rhs, SCIP_ROWPREP *rowprep, SCIP_Bool *success)
SCIP_RETCODE SCIPsetConshdlrExit(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSEXIT((*consexit)))
Definition: scip_cons.c:404
SCIP_EXPORT const char * SCIPvarGetName(SCIP_VAR *var)
Definition: var.c:16738
static SCIP_DECL_CONSEXIT(consExitQuadratic)
SCIP_RETCODE SCIPincludeConshdlrQuadratic(SCIP *scip)
struct SCIP_QuadVarEventData SCIP_QUADVAREVENTDATA
SCIP_Bool SCIPintervalIsEntire(SCIP_Real infinity, SCIP_INTERVAL operand)
static void getIneqViol(SCIP_VAR *x, SCIP_VAR *y, SCIP_Real xcoef, SCIP_Real ycoef, SCIP_Real constant, SCIP_Real *viol1, SCIP_Real *viol2)
SCIP_RETCODE LapackDsyev(SCIP_Bool computeeigenvectors, int N, SCIP_Real *a, SCIP_Real *w)
SCIP_RETCODE SCIPensureRowprepSize(SCIP *scip, SCIP_ROWPREP *rowprep, int size)
static void propagateBoundsGetQuadActivity(SCIP *scip, SCIP_CONSDATA *consdata, SCIP_Real intervalinfty, SCIP_Real *minquadactivity, SCIP_Real *maxquadactivity, int *minactivityinf, int *maxactivityinf, SCIP_INTERVAL *quadactcontr)
SCIP_EXPORT SCIP_Bool SCIPvarIsIntegral(SCIP_VAR *var)
Definition: var.c:16929
SCIP_COL ** SCIProwGetCols(SCIP_ROW *row)
Definition: lp.c:16912
static SCIP_RETCODE addLinearizationCuts(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS **conss, int nconss, SCIP_SOL *ref, SCIP_Bool *separatedlpsol, SCIP_Real minefficacy)
#define SCIPerrorMessage
Definition: pub_message.h:45
SCIP_Bool SCIPstrToRealValue(const char *str, SCIP_Real *value, char **endptr)
Definition: misc.c:10364
interval arithmetics for provable bounds
SCIP_Bool SCIPisConvexQuadratic(SCIP *scip, SCIP_CONS *cons)
static SCIP_RETCODE removeFixedVariables(SCIP *scip, SCIP_CONS *cons)
void SCIPintervalSetEmpty(SCIP_INTERVAL *resultant)
SCIP_Real SCIPgetRowprepViolation(SCIP *scip, SCIP_ROWPREP *rowprep, SCIP_SOL *sol)
SCIP_RETCODE SCIPnlpiGetSolution(SCIP_NLPI *nlpi, SCIP_NLPIPROBLEM *problem, SCIP_Real **primalvalues, SCIP_Real **consdualvalues, SCIP_Real **varlbdualvalues, SCIP_Real **varubdualvalues, SCIP_Real *objval)
Definition: nlpi.c:537
SCIP_RETCODE SCIPincSolVal(SCIP *scip, SCIP_SOL *sol, SCIP_VAR *var, SCIP_Real incval)
Definition: scip_sol.c:1309
SCIP_EXPORT int SCIPvarGetNImpls(SCIP_VAR *var, SCIP_Bool varfixing)
Definition: var.c:17630
SCIP_VAR ** vars
enum SCIP_NlpSolStat SCIP_NLPSOLSTAT
Definition: type_nlpi.h:69
SCIP_RETCODE SCIPreleaseRow(SCIP *scip, SCIP_ROW **row)
Definition: scip_lp.c:1406
public methods for event handler plugins and event handlers
SCIP_Real SCIPintervalGetInf(SCIP_INTERVAL interval)
SCIP_Bool SCIPisFeasEQ(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
SCIP_RETCODE SCIPcatchEvent(SCIP *scip, SCIP_EVENTTYPE eventtype, SCIP_EVENTHDLR *eventhdlr, SCIP_EVENTDATA *eventdata, int *filterpos)
Definition: scip_event.c:276
public methods for nonlinear functions
SCIP_Bool SCIPisInRestart(SCIP *scip)
Definition: scip_solve.c:3531
#define COPYSIGN
Definition: def.h:244
void SCIPcomputeBilinEnvelope2(SCIP *scip, SCIP_Real bilincoef, SCIP_Real lbx, SCIP_Real ubx, SCIP_Real refpointx, SCIP_Real lby, SCIP_Real uby, SCIP_Real refpointy, SCIP_Bool overestimate, SCIP_Real xcoef1, SCIP_Real ycoef1, SCIP_Real constant1, SCIP_Real xcoef2, SCIP_Real ycoef2, SCIP_Real constant2, SCIP_Real *RESTRICT lincoefx, SCIP_Real *RESTRICT lincoefy, SCIP_Real *RESTRICT linconstant, SCIP_Bool *RESTRICT success)
SCIP_Bool SCIPisPresolveFinished(SCIP *scip)
Definition: scip_general.c:595
static SCIP_RETCODE computeViolation(SCIP *scip, SCIP_CONS *cons, SCIP_SOL *sol, SCIP_Bool *solviolbounds)
SCIP_RETCODE SCIPsetConshdlrInitsol(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSINITSOL((*consinitsol)))
Definition: scip_cons.c:428
static SCIP_DECL_CONSDELETE(consDeleteQuadratic)
SCIP_RETCODE SCIPsetConshdlrDisable(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSDISABLE((*consdisable)))
Definition: scip_cons.c:723
static SCIP_DECL_CONSPARSE(consParseQuadratic)
static SCIP_RETCODE presolveUpgrade(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons, SCIP_Bool *upgraded, int *nupgdconss, int *naddconss, SCIP_PRESOLTIMING presoltiming)
static SCIP_RETCODE presolveDisaggregateMarkComponent(SCIP *scip, SCIP_CONSDATA *consdata, int quadvaridx, SCIP_HASHMAP *var2component, int componentnr, int *componentsize)
static SCIP_RETCODE catchQuadVarEvents(SCIP *scip, SCIP_EVENTHDLR *eventhdlr, SCIP_CONS *cons, int quadvarpos)
SCIPInterval sqrt(const SCIPInterval &x)
SCIP_RETCODE SCIPgetTransformedVar(SCIP *scip, SCIP_VAR *var, SCIP_VAR **transvar)
Definition: scip_var.c:1442
#define SCIPfreeBufferArrayNull(scip, ptr)
Definition: scip_mem.h:124
int SCIPhashmapGetNEntries(SCIP_HASHMAP *hashmap)
Definition: misc.c:3358
BMS_BLKMEM * SCIPblkmem(SCIP *scip)
Definition: scip_mem.c:47
static SCIP_DECL_CONSCHECK(consCheckQuadratic)
SCIP_Real * SCIProwGetVals(SCIP_ROW *row)
Definition: lp.c:16922
#define MAX3(x, y, z)
Definition: def.h:227
#define SCIP_EVENTTYPE_IMPLADDED
Definition: type_event.h:71
static SCIP_DECL_CONSPRESOL(consPresolQuadratic)
void SCIPaddRowprepSide(SCIP_ROWPREP *rowprep, SCIP_Real side)
SCIP_Bool SCIPisZero(SCIP *scip, SCIP_Real val)
struct SCIP_EventData SCIP_EVENTDATA
Definition: type_event.h:155
SCIP_NLPSOLSTAT SCIPnlpiGetSolstat(SCIP_NLPI *nlpi, SCIP_NLPIPROBLEM *problem)
Definition: nlpi.c:511
SCIP_Bool SCIPinProbing(SCIP *scip)
Definition: scip_probing.c:87
int SCIPnlrowGetNQuadElems(SCIP_NLROW *nlrow)
Definition: nlp.c:3323
static SCIP_DECL_CONSTRANS(consTransQuadratic)
constraint handler for quadratic constraints
SCIP_RETCODE SCIPcreateRowprep(SCIP *scip, SCIP_ROWPREP **rowprep, SCIP_SIDETYPE sidetype, SCIP_Bool local)
#define CONSHDLR_CHECKPRIORITY
static SCIP_RETCODE registerBranchingCandidates(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS **conss, int nconss, SCIP_SOL *sol, int *nnotify)
#define REALABS(x)
Definition: def.h:188
public methods for problem copies
SCIP_Bool SCIPisRelLT(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
public methods for primal CIP solutions
SCIP_CONSDATA * SCIPconsGetData(SCIP_CONS *cons)
Definition: cons.c:8106
#define SCIP_CALL(x)
Definition: def.h:365
SCIP_RETCODE SCIPaddBilinTermQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var1, SCIP_VAR *var2, SCIP_Real coef)
unsigned int SCIP_PRESOLTIMING
Definition: type_timing.h:52
#define CONSHDLR_ENFOPRIORITY
SCIP_EVENTTYPE SCIPeventGetType(SCIP_EVENT *event)
Definition: event.c:995
SCIP_VAR * h
Definition: circlepacking.c:59
SCIP_Real SCIPeventGetNewbound(SCIP_EVENT *event)
Definition: event.c:1198
SCIP_Real sup
Definition: intervalarith.h:40
SCIP_RETCODE SCIPcreateConsQuadratic2(SCIP *scip, SCIP_CONS **cons, const char *name, int nlinvars, SCIP_VAR **linvars, SCIP_Real *lincoefs, int nquadvarterms, SCIP_QUADVARTERM *quadvarterms, int nbilinterms, SCIP_BILINTERM *bilinterms, SCIP_Real lhs, SCIP_Real rhs, SCIP_Bool initial, SCIP_Bool separate, SCIP_Bool enforce, SCIP_Bool check, SCIP_Bool propagate, SCIP_Bool local, SCIP_Bool modifiable, SCIP_Bool dynamic, SCIP_Bool removable)
SCIP_RETCODE SCIPchgRhsQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_Real rhs)
SCIP_RETCODE SCIPincludeQuadconsUpgrade(SCIP *scip, SCIP_DECL_QUADCONSUPGD((*quadconsupgd)), int priority, SCIP_Bool active, const char *conshdlrname)
void SCIPintervalSet(SCIP_INTERVAL *resultant, SCIP_Real value)
SCIP_QUADELEM * SCIPnlrowGetQuadElems(SCIP_NLROW *nlrow)
Definition: nlp.c:3333
int SCIPgetLinvarMayIncreaseQuadratic(SCIP *scip, SCIP_CONS *cons)
SCIP_VAR ** SCIPgetLinearVarsQuadratic(SCIP *scip, SCIP_CONS *cons)
static void rowprepCleanupScaledown(SCIP *scip, SCIP_ROWPREP *rowprep, SCIP_Real *viol, SCIP_Real minviol)
#define SCIPdebugGetSolVal(scip, var, val)
Definition: debug.h:257
static SCIP_RETCODE rowprepCleanupSortTerms(SCIP *scip, SCIP_ROWPREP *rowprep)
struct SCIP_ConsData SCIP_CONSDATA
Definition: type_cons.h:51
#define SCIP_EVENTTYPE_BOUNDTIGHTENED
Definition: type_event.h:106
public methods for primal heuristic plugins and divesets
#define SCIP_EVENTTYPE_UBCHANGED
Definition: type_event.h:105
public methods for constraint handler plugins and constraints
public methods for NLP management
static SCIP_RETCODE consdataEnsureAdjBilinSize(SCIP *scip, SCIP_QUADVARTERM *quadvarterm, int num)
SCIP_RETCODE SCIPresetConsAge(SCIP *scip, SCIP_CONS *cons)
Definition: scip_cons.c:1748
static SCIP_RETCODE proposeFeasibleSolution(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS **conss, int nconss, SCIP_SOL *sol, SCIP_Bool *success)
SCIP_Bool SCIPconsIsRemovable(SCIP_CONS *cons)
Definition: cons.c:8345
SCIP_Real SCIPexprgraphGetNodeQuadraticConstant(SCIP_EXPRGRAPHNODE *node)
Definition: expr.c:13137
SCIP_Bool SCIPisFeasZero(SCIP *scip, SCIP_Real val)
int SCIPgetNLinearVarsNonlinear(SCIP *scip, SCIP_CONS *cons)
Ipopt NLP interface.
static SCIP_RETCODE computeInteriorPoint(SCIP *scip, SCIP_CONS *cons, char method, SCIP_Bool *success)
static SCIP_RETCODE propagateBoundsTightenVarUb(SCIP *scip, SCIP_CONS *cons, SCIP_Real intervalinfty, SCIP_VAR *var, SCIP_Real bnd, SCIP_RESULT *result, int *nchgbds)
#define SCIPallocBufferArray(scip, ptr, num)
Definition: scip_mem.h:111
int SCIPcalcMemGrowSize(SCIP *scip, int num)
Definition: scip_mem.c:129
SCIP_Real SCIPinfinity(SCIP *scip)
SCIP_RETCODE SCIPsetConshdlrSepa(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSSEPALP((*conssepalp)), SCIP_DECL_CONSSEPASOL((*conssepasol)), int sepafreq, int sepapriority, SCIP_Bool delaysepa)
Definition: scip_cons.c:219
public data structures and miscellaneous methods
#define CONSHDLR_NEEDSCONS
SCIP_Real SCIPeventGetOldbound(SCIP_EVENT *event)
Definition: event.c:1174
static unsigned int nextPowerOf2(unsigned int v)
SCIP_RETCODE SCIPunlockVarCons(SCIP *scip, SCIP_VAR *var, SCIP_CONS *cons, SCIP_Bool lockdown, SCIP_Bool lockup)
Definition: scip_var.c:4376
static SCIP_DECL_CONSINITLP(consInitlpQuadratic)
SCIP_Real side
int SCIPgetDepth(SCIP *scip)
Definition: scip_tree.c:637
#define SCIP_Bool
Definition: def.h:70
static SCIP_DECL_CONSFREE(consFreeQuadratic)
SCIP_RETCODE SCIPgetFeasibilityQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_SOL *sol, SCIP_Real *feasibility)
static SCIP_RETCODE presolveDisaggregate(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons, int *naddconss)
SCIP_RETCODE SCIPdropVarEvent(SCIP *scip, SCIP_VAR *var, SCIP_EVENTTYPE eventtype, SCIP_EVENTHDLR *eventhdlr, SCIP_EVENTDATA *eventdata, int filterpos)
Definition: scip_event.c:390
SCIP_Bool SCIPexprgraphAreAllNodeChildrenVars(SCIP_EXPRGRAPHNODE *node)
Definition: expr.c:14638
static void rowprepCleanupIntegralCoefs(SCIP *scip, SCIP_ROWPREP *rowprep, SCIP_Real *viol)
void SCIPintervalSolveUnivariateQuadExpression(SCIP_Real infinity, SCIP_INTERVAL *resultant, SCIP_INTERVAL sqrcoeff, SCIP_INTERVAL lincoeff, SCIP_INTERVAL rhs, SCIP_INTERVAL xbnds)
#define CONSHDLR_DELAYSEPA
static SCIP_DECL_CONSHDLRCOPY(conshdlrCopyQuadratic)
SCIP_EXPORT SCIP_Real SCIPvarGetMultaggrConstant(SCIP_VAR *var)
Definition: var.c:17156
static SCIP_RETCODE registerBranchingCandidatesCentrality(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS **conss, int nconss, SCIP_SOL *sol, int *nnotify)
SCIP_Bool SCIPisSumLT(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
const char * SCIPgetProbName(SCIP *scip)
Definition: scip_prob.c:1066
SCIP_RETCODE SCIPhashmapCreate(SCIP_HASHMAP **hashmap, BMS_BLKMEM *blkmem, int mapsize)
Definition: misc.c:2891
SCIP_EXPORT void SCIPsortIntInt(int *intarray1, int *intarray2, int len)
static SCIP_RETCODE computeGauge(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons)
static SCIP_RETCODE generateCutFactorable(SCIP *scip, SCIP_CONS *cons, SCIP_SIDETYPE violside, SCIP_Real *ref, SCIP_ROWPREP *rowprep, SCIP_Bool *success)
SCIP_RETCODE SCIPsetConshdlrCopy(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSHDLRCOPY((*conshdlrcopy)), SCIP_DECL_CONSCOPY((*conscopy)))
Definition: scip_cons.c:331
SCIP_Bool SCIPisNLPConstructed(SCIP *scip)
Definition: scip_nlp.c:209
int SCIPgetNNlpis(SCIP *scip)
Definition: scip_nlp.c:131
SCIP_EXPORT SCIP_Real SCIPvarGetUbGlobal(SCIP_VAR *var)
Definition: var.c:17362
#define NONLINCONSUPGD_PRIORITY
SCIP_RETCODE SCIPprintCons(SCIP *scip, SCIP_CONS *cons, FILE *file)
Definition: scip_cons.c:2472
constraint handler for nonlinear constraints
SCIP_EXPORT SCIP_BOUNDTYPE SCIPvarGetBestBoundType(SCIP_VAR *var)
Definition: var.c:17464
SCIP_NLPSOLSTAT SCIPgetNLPSolstat(SCIP *scip)
Definition: scip_nlp.c:592
void SCIPintervalSolveBivariateQuadExpressionAllScalar(SCIP_Real infinity, SCIP_INTERVAL *resultant, SCIP_Real ax, SCIP_Real ay, SCIP_Real axy, SCIP_Real bx, SCIP_Real by, SCIP_INTERVAL rhs, SCIP_INTERVAL xbnds, SCIP_INTERVAL ybnds)
void SCIPmergeRowprepTerms(SCIP *scip, SCIP_ROWPREP *rowprep)
SCIP_RETCODE SCIPnlpiSetIntPar(SCIP_NLPI *nlpi, SCIP_NLPIPROBLEM *problem, SCIP_NLPPARAM type, int ival)
Definition: nlpi.c:636
SCIP_EXPORT SCIP_Real SCIPvarGetWorstBoundLocal(SCIP_VAR *var)
Definition: var.c:17451
SCIP_CONSHDLRDATA * SCIPconshdlrGetData(SCIP_CONSHDLR *conshdlr)
Definition: cons.c:4211
SCIP_RETCODE SCIPcreateLPSol(SCIP *scip, SCIP_SOL **sol, SCIP_HEUR *heur)
Definition: scip_sol.c:361
SCIP_Bool SCIPisCutApplicable(SCIP *scip, SCIP_ROW *cut)
Definition: scip_cut.c:177
static SCIP_RETCODE sortAllBilinTerms(SCIP *scip, SCIP_BILINTERM *bilinterms, int nbilinterms, SCIP_CONS **bilinconss, int *bilinposs)
static SCIP_DECL_CONSEXITSOL(consExitsolQuadratic)
static SCIP_RETCODE replaceByLinearConstraints(SCIP *scip, SCIP_CONS **conss, int nconss, SCIP_Bool *addedcons, SCIP_Bool *reduceddom, SCIP_Bool *infeasible)
SCIP_RETCODE SCIPcreateVar(SCIP *scip, SCIP_VAR **var, const char *name, SCIP_Real lb, SCIP_Real ub, SCIP_Real obj, SCIP_VARTYPE vartype, SCIP_Bool initial, SCIP_Bool removable, SCIP_DECL_VARDELORIG((*vardelorig)), SCIP_DECL_VARTRANS((*vartrans)), SCIP_DECL_VARDELTRANS((*vardeltrans)), SCIP_DECL_VARCOPY((*varcopy)), SCIP_VARDATA *vardata)
Definition: scip_var.c:104
SCIP_EXPORT SCIP_Bool SCIPvarIsOriginal(SCIP_VAR *var)
Definition: var.c:16867
SCIP_Real SCIProwGetLhs(SCIP_ROW *row)
Definition: lp.c:16966
#define MIN(x, y)
Definition: def.h:223
methods for debugging
SCIP_RETCODE SCIPcreateEmptyRowCons(SCIP *scip, SCIP_ROW **row, SCIP_CONSHDLR *conshdlr, const char *name, SCIP_Real lhs, SCIP_Real rhs, SCIP_Bool local, SCIP_Bool modifiable, SCIP_Bool removable)
Definition: scip_lp.c:1268
public methods for LP management
static SCIP_RETCODE generateCutLTI(SCIP *scip, SCIP_CONS *cons, SCIP_SIDETYPE violside, SCIP_Real *ref, SCIP_SOL *sol, SCIP_ROWPREP *rowprep, SCIP_Bool *success)
static void consdataSortLinearVars(SCIP_CONSDATA *consdata)
void SCIPsort(int *perm, SCIP_DECL_SORTINDCOMP((*indcomp)), void *dataptr, int len)
Definition: misc.c:5317
SCIP_Bool SCIPisNegative(SCIP *scip, SCIP_Real val)
SCIP_Bool SCIPconsIsTransformed(SCIP_CONS *cons)
Definition: cons.c:8385
public methods for cuts and aggregation rows
void SCIPintervalAdd(SCIP_Real infinity, SCIP_INTERVAL *resultant, SCIP_INTERVAL operand1, SCIP_INTERVAL operand2)
SCIP_RETCODE SCIPnlpiSolve(SCIP_NLPI *nlpi, SCIP_NLPIPROBLEM *problem)
Definition: nlpi.c:497
SCIP_Real SCIPgetLhsNonlinear(SCIP *scip, SCIP_CONS *cons)
SCIP_EXPORT SCIP_Real SCIPnodeGetEstimate(SCIP_NODE *node)
Definition: tree.c:7377
SCIP_Real SCIPintervalGetSup(SCIP_INTERVAL interval)
#define BMScopyMemoryArray(ptr, source, num)
Definition: memory.h:124
SCIP_Bool SCIPconsIsSeparated(SCIP_CONS *cons)
Definition: cons.c:8255
#define ROWPREP_SCALEUP_MAXSIDE
static SCIP_Real getInteriority(SCIP *scip, SCIP_Real lbx, SCIP_Real ubx, SCIP_Real refx, SCIP_Real lby, SCIP_Real uby, SCIP_Real refy)
#define infty2infty(infty1, infty2, val)
int SCIPgetNSepaRounds(SCIP *scip)
static SCIP_RETCODE consdataFree(SCIP *scip, SCIP_CONSDATA **consdata)
Constraint handler for linear constraints in their most general form, .
static SCIP_RETCODE createNlRow(SCIP *scip, SCIP_CONS *cons)
SCIP_Real * SCIPgetLinearCoefsNonlinear(SCIP *scip, SCIP_CONS *cons)
SCIP_RETCODE SCIPaddVar(SCIP *scip, SCIP_VAR *var)
Definition: scip_prob.c:1667
SCIP_Bool SCIPisFeasGE(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
#define CONSHDLR_NAME
#define BMSclearMemory(ptr)
Definition: memory.h:119
#define SCIP_EVENTTYPE_GBDCHANGED
Definition: type_event.h:103
static SCIP_Bool consdataCheckBilinTermsSort(SCIP_CONSDATA *consdata)
SCIP_RETCODE SCIPgetRowprepRowCons(SCIP *scip, SCIP_ROW **row, SCIP_ROWPREP *rowprep, SCIP_CONSHDLR *conshdlr)
SCIP_Bool SCIPconsIsDynamic(SCIP_CONS *cons)
Definition: cons.c:8335
char name[SCIP_MAXSTRLEN]
SCIP_EXPORT SCIP_Real SCIPvarGetLbLocal(SCIP_VAR *var)
Definition: var.c:17408
SCIP_RETCODE SCIPincludeEventhdlrBasic(SCIP *scip, SCIP_EVENTHDLR **eventhdlrptr, const char *name, const char *desc, SCIP_DECL_EVENTEXEC((*eventexec)), SCIP_EVENTHDLRDATA *eventhdlrdata)
Definition: scip_event.c:94
SCIP_RETCODE SCIPaddRealParam(SCIP *scip, const char *name, const char *desc, SCIP_Real *valueptr, SCIP_Bool isadvanced, SCIP_Real defaultvalue, SCIP_Real minvalue, SCIP_Real maxvalue, SCIP_DECL_PARAMCHGD((*paramchgd)), SCIP_PARAMDATA *paramdata)
Definition: scip_param.c:129
SCIP_RETCODE SCIPunmarkConsPropagate(SCIP *scip, SCIP_CONS *cons)
Definition: scip_cons.c:1978
void * SCIPexprgraphGetNodeVar(SCIP_EXPRGRAPH *exprgraph, SCIP_EXPRGRAPHNODE *node)
Definition: expr.c:13066
SCIP_VAR * SCIPcolGetVar(SCIP_COL *col)
Definition: lp.c:16736
static void generateCutLTIcomputeCoefs(SCIP *scip, SCIP_Real xl, SCIP_Real xu, SCIP_Real x0, SCIP_Real yl, SCIP_Real yu, SCIP_Real y0_, SCIP_Real wl, SCIP_Real wu, SCIP_Real w0, SCIP_Real *cx, SCIP_Real *cy, SCIP_Real *cw, SCIP_Real *c0, SCIP_Bool *success)
static SCIP_DECL_CONSENFORELAX(consEnforelaxQuadratic)
static SCIP_Bool generateCutLTIfindIntersection(SCIP *scip, SCIP_Real x0, SCIP_Real y0_, SCIP_Real x1, SCIP_Real y1_, SCIP_Real wl, SCIP_Real wu, SCIP_Real *xl, SCIP_Real *yl, SCIP_Real *xu, SCIP_Real *yu)
public methods for the LP relaxation, rows and columns
SCIP_Real * SCIPexprgraphGetNodeQuadraticLinearCoefs(SCIP_EXPRGRAPHNODE *node)
Definition: expr.c:13149
#define ROWPREP_SCALEUP_MINVIOLFACTOR
SCIP_Bool SCIPisConcaveQuadratic(SCIP *scip, SCIP_CONS *cons)
SCIP_RETCODE SCIPaddLinearConsToNlpHeurSubNlp(SCIP *scip, SCIP_HEUR *heur, SCIP_Bool addcombconss, SCIP_Bool addcontconss)
Definition: heur_subnlp.c:2417
SCIP_EXPORT int SCIPvarGetNLocksDownType(SCIP_VAR *var, SCIP_LOCKTYPE locktype)
Definition: var.c:3184
SCIP_RETCODE SCIPparseVarsPolynomial(SCIP *scip, const char *str, SCIP_VAR ****monomialvars, SCIP_Real ***monomialexps, SCIP_Real **monomialcoefs, int **monomialnvars, int *nmonomials, char **endptr, SCIP_Bool *success)
Definition: scip_var.c:809
public methods for nonlinear relaxations
SCIP_EXPORT void SCIPsortDownRealRealPtr(SCIP_Real *realarray1, SCIP_Real *realarray2, void **ptrarray, int len)
SCIP_Bool SCIPinDive(SCIP *scip)
Definition: scip_lp.c:2594
SCIP_RETCODE SCIPaddLinearVarQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var, SCIP_Real coef)
SCIP_Real SCIPfloor(SCIP *scip, SCIP_Real val)
static SCIP_RETCODE registerLargeRelaxValueVariableForBranching(SCIP *scip, SCIP_CONS **conss, int nconss, SCIP_SOL *sol, SCIP_VAR **brvar)
SCIP_EXPORT SCIP_Real SCIPvarGetUbLocal(SCIP_VAR *var)
Definition: var.c:17418
methods for sorting joint arrays of various types
SCIP_QUADVAREVENTDATA * eventdata
#define SQRT(x)
Definition: def.h:206
enum SCIP_ExprCurv SCIP_EXPRCURV
Definition: type_expr.h:95
int SCIPgetNAllBilinearTermsQuadratic(SCIP *scip)
public methods for branching rule plugins and branching
SCIP_VAR ** b
Definition: circlepacking.c:56
SCIP_RETCODE SCIPaddRow(SCIP *scip, SCIP_ROW *row, SCIP_Bool forcecut, SCIP_Bool *infeasible)
Definition: scip_cut.c:220
public methods for managing events
static SCIP_RETCODE addBilinearTerm(SCIP *scip, SCIP_CONS *cons, int var1pos, int var2pos, SCIP_Real coef)
general public methods
#define MAX(x, y)
Definition: def.h:222
static void consdataMoveQuadVarTerm(SCIP_CONSDATA *consdata, int oldpos, int newpos)
SCIP_RETCODE SCIPcopyRowprep(SCIP *scip, SCIP_ROWPREP **target, SCIP_ROWPREP *source)
static SCIP_RETCODE consdataCreateEmpty(SCIP *scip, SCIP_CONSDATA **consdata)
static SCIP_DECL_CONSGETNVARS(consGetNVarsQuadratic)
SCIP_RETCODE SCIPincludeNonlinconsUpgrade(SCIP *scip, SCIP_DECL_NONLINCONSUPGD((*nonlinconsupgd)), SCIP_DECL_EXPRGRAPHNODEREFORM((*nodereform)), int priority, SCIP_Bool active, const char *conshdlrname)
public methods for solutions
#define CONSHDLR_DESC
SCIP_Bool SCIPconsIsEnforced(SCIP_CONS *cons)
Definition: cons.c:8265
SCIP_Real SCIPintervalQuadUpperBound(SCIP_Real infinity, SCIP_Real a, SCIP_INTERVAL b_, SCIP_INTERVAL x)
SCIP_Bool SCIPisHugeValue(SCIP *scip, SCIP_Real val)
static SCIP_RETCODE dropVarEvents(SCIP *scip, SCIP_EVENTHDLR *eventhdlr, SCIP_CONS *cons)
SCIP_RETCODE SCIPdropEvent(SCIP *scip, SCIP_EVENTTYPE eventtype, SCIP_EVENTHDLR *eventhdlr, SCIP_EVENTDATA *eventdata, int filterpos)
Definition: scip_event.c:310
static SCIP_DECL_CONSGETVARS(consGetVarsQuadratic)
#define SCIP_EVENTTYPE_FORMAT
Definition: type_event.h:135
SCIP_Bool SCIPisLinearLocalQuadratic(SCIP *scip, SCIP_CONS *cons)
int SCIPgetNLinearVarsQuadratic(SCIP *scip, SCIP_CONS *cons)
SCIP_RETCODE SCIPgetAllBilinearTermsQuadratic(SCIP *scip, SCIP_VAR **RESTRICT x, SCIP_VAR **RESTRICT y, int *RESTRICT nbilinterms, int *RESTRICT nunderests, int *RESTRICT noverests, SCIP_Real *maxnonconvexity)
SCIP_EXPORT SCIP_Real SCIPvarGetLbGlobal(SCIP_VAR *var)
Definition: var.c:17352
public methods for the probing mode
SCIP_EXPRGRAPH * SCIPgetExprgraphNonlinear(SCIP *scip, SCIP_CONSHDLR *conshdlr)
static void rowprepCleanupSide(SCIP *scip, SCIP_ROWPREP *rowprep, SCIP_Real *viol)
static SCIP_DECL_CONSCOPY(consCopyQuadratic)
static SCIP_DECL_CONSINIT(consInitQuadratic)
void SCIPenableNLP(SCIP *scip)
Definition: scip_nlp.c:194
static SCIP_RETCODE unlockLinearVariable(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var, SCIP_Real coef)
SCIP_EXPORT int SCIPvarGetMultaggrNVars(SCIP_VAR *var)
Definition: var.c:17120
void SCIPintervalSetRoundingModeUpwards(void)
SCIP_RETCODE SCIPnlpiFreeProblem(SCIP_NLPI *nlpi, SCIP_NLPIPROBLEM **problem)
Definition: nlpi.c:224
type definitions for expressions and expression trees
static SCIP_RETCODE computeReferencePointProjection(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons, SCIP_SOL *refsol, SCIP_Real *ref)
SCIP_CONS ** SCIPconshdlrGetConss(SCIP_CONSHDLR *conshdlr)
Definition: cons.c:4563
int SCIPgetNBilinTermsQuadratic(SCIP *scip, SCIP_CONS *cons)
public methods for message output
NLP local search primal heuristic using sub-SCIPs.
static SCIP_RETCODE generateCutSol(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons, SCIP_SOL *sol, SCIP_SOL *refsol, SCIP_SIDETYPE violside, SCIP_ROW **row, SCIP_Real *efficacy, SCIP_Bool checkcurvmultivar, SCIP_Real minefficacy, char mode)
SCIP_Real SCIPgetSolTransObj(SCIP *scip, SCIP_SOL *sol)
Definition: scip_sol.c:1482
SCIP_VAR * a
Definition: circlepacking.c:57
int SCIPscaleRowprep(SCIP_ROWPREP *rowprep, SCIP_Real factor)
int SCIPsnprintf(char *t, int len, const char *s,...)
Definition: misc.c:10263
SCIP_RETCODE SCIPaddIntParam(SCIP *scip, const char *name, const char *desc, int *valueptr, SCIP_Bool isadvanced, int defaultvalue, int minvalue, int maxvalue, SCIP_DECL_PARAMCHGD((*paramchgd)), SCIP_PARAMDATA *paramdata)
Definition: scip_param.c:73
void SCIPhashmapFree(SCIP_HASHMAP **hashmap)
Definition: misc.c:2925
const char * SCIPconsGetName(SCIP_CONS *cons)
Definition: cons.c:8076
SCIP_RETCODE SCIPaddBilinearIneqQuadratic(SCIP *scip, SCIP_VAR *x, SCIP_VAR *y, int idx, SCIP_Real xcoef, SCIP_Real ycoef, SCIP_Real constant, SCIP_Bool *success)
SCIP_RETCODE SCIPreleaseVar(SCIP *scip, SCIP_VAR **var)
Definition: scip_var.c:1251
SCIP_Real SCIPselectSimpleValue(SCIP_Real lb, SCIP_Real ub, SCIP_Longint maxdnom)
Definition: misc.c:9378
#define SCIP_Real
Definition: def.h:164
void SCIPintervalMulScalar(SCIP_Real infinity, SCIP_INTERVAL *resultant, SCIP_INTERVAL operand1, SCIP_Real operand2)
SCIP_VAR ** y
Definition: circlepacking.c:55
SCIP_CONSHDLR * SCIPconsGetHdlr(SCIP_CONS *cons)
Definition: cons.c:8096
static SCIP_RETCODE computeReferencePointGauge(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons, SCIP_SOL *refsol, SCIP_Real *ref, SCIP_Bool *success)
const char * SCIProwGetName(SCIP_ROW *row)
Definition: lp.c:17025
SCIP_Real SCIPgetRhsQuadratic(SCIP *scip, SCIP_CONS *cons)
SCIP_Bool SCIPisLT(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
public methods for message handling
SCIP_Bool SCIPisGT(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
static SCIP_RETCODE checkFactorable(SCIP *scip, SCIP_CONS *cons)
SCIP_EXPRGRAPHNODE ** SCIPexprgraphGetNodeChildren(SCIP_EXPRGRAPHNODE *node)
Definition: expr.c:12984
#define SCIP_INVALID
Definition: def.h:184
SCIP_Real SCIPgetRowLPFeasibility(SCIP *scip, SCIP_ROW *row)
Definition: scip_lp.c:1848
SCIP_EXPRGRAPHNODE * SCIPgetExprgraphNodeNonlinear(SCIP *scip, SCIP_CONS *cons)
SCIP_RETCODE SCIPaddNlRow(SCIP *scip, SCIP_NLROW *nlrow)
Definition: scip_nlp.c:460
SCIP_RETCODE SCIPwriteVarsPolynomial(SCIP *scip, FILE *file, SCIP_VAR ***monomialvars, SCIP_Real **monomialexps, SCIP_Real *monomialcoefs, int *monomialnvars, int nmonomials, SCIP_Bool type)
Definition: scip_var.c:394
SCIP_Bool SCIPhasPrimalRay(SCIP *scip)
Definition: scip_sol.c:3498
static SCIP_RETCODE propagateBoundsTightenVarLb(SCIP *scip, SCIP_CONS *cons, SCIP_Real intervalinfty, SCIP_VAR *var, SCIP_Real bnd, SCIP_RESULT *result, int *nchgbds)
SCIP_EXPORT SCIP_BOUNDTYPE * SCIPvarGetImplTypes(SCIP_VAR *var, SCIP_Bool varfixing)
Definition: var.c:17662
SCIP_VAR ** SCIPnlrowGetQuadVars(SCIP_NLROW *nlrow)
Definition: nlp.c:3286
static SCIP_RETCODE delLinearCoefPos(SCIP *scip, SCIP_CONS *cons, int pos)
#define SCIP_Longint
Definition: def.h:149
static SCIP_RETCODE consdataEnsureBilinSize(SCIP *scip, SCIP_CONSDATA *consdata, int num)
SCIP_Bool SCIPconsIsStickingAtNode(SCIP_CONS *cons)
Definition: cons.c:8355
const char * SCIPconshdlrGetName(SCIP_CONSHDLR *conshdlr)
Definition: cons.c:4191
SCIP_NLPTERMSTAT SCIPnlpiGetTermstat(SCIP_NLPI *nlpi, SCIP_NLPIPROBLEM *problem)
Definition: nlpi.c:523
#define SCIPdebugAddSolVal(scip, var, val)
Definition: debug.h:256
int SCIPgetNBinVars(SCIP *scip)
Definition: scip_prob.c:2032
SCIP_RETCODE SCIPgetProbvarSum(SCIP *scip, SCIP_VAR **var, SCIP_Real *scalar, SCIP_Real *constant)
Definition: scip_var.c:1796
static SCIP_DECL_CONSLOCK(consLockQuadratic)
SCIP_Real SCIPlpfeastol(SCIP *scip)
SCIP_RETCODE SCIPcatchVarEvent(SCIP *scip, SCIP_VAR *var, SCIP_EVENTTYPE eventtype, SCIP_EVENTHDLR *eventhdlr, SCIP_EVENTDATA *eventdata, int *filterpos)
Definition: scip_event.c:344
SCIP_RETCODE SCIPcreateConsBounddisjunction(SCIP *scip, SCIP_CONS **cons, const char *name, int nvars, SCIP_VAR **vars, SCIP_BOUNDTYPE *boundtypes, SCIP_Real *bounds, SCIP_Bool initial, SCIP_Bool separate, SCIP_Bool enforce, SCIP_Bool check, SCIP_Bool propagate, SCIP_Bool local, SCIP_Bool modifiable, SCIP_Bool dynamic, SCIP_Bool removable, SCIP_Bool stickingatnode)
int SCIP_ROUNDMODE
Definition: intervalarith.h:46
void SCIPintervalMulInf(SCIP_Real infinity, SCIP_INTERVAL *resultant, SCIP_INTERVAL operand1, SCIP_INTERVAL operand2)
void SCIPintervalSub(SCIP_Real infinity, SCIP_INTERVAL *resultant, SCIP_INTERVAL operand1, SCIP_INTERVAL operand2)
SCIP_VAR * SCIPeventGetVar(SCIP_EVENT *event)
Definition: event.c:1018
SCIP_Real ineqoverest[6]
SCIP_Bool SCIPconsIsOriginal(SCIP_CONS *cons)
Definition: cons.c:8375
SCIP_RETCODE SCIPaddCons(SCIP *scip, SCIP_CONS *cons)
Definition: scip_prob.c:2765
SCIP_RETCODE SCIPaddPoolCut(SCIP *scip, SCIP_ROW *row)
Definition: scip_cut.c:331
SCIP_Real * SCIPgetCoefsLinearVarsQuadratic(SCIP *scip, SCIP_CONS *cons)
struct SCIP_ConshdlrData SCIP_CONSHDLRDATA
Definition: type_cons.h:50
static SCIP_DECL_EVENTEXEC(processVarEvent)
#define SCIPfreeBlockMemoryArrayNull(scip, ptr, num)
Definition: scip_mem.h:98
SCIP_EXPORT void SCIPsortPtrPtrReal(void **ptrarray1, void **ptrarray2, SCIP_Real *realarray, SCIP_DECL_SORTPTRCOMP((*ptrcomp)), int len)
static SCIP_RETCODE addLinearCoef(SCIP *scip, SCIP_CONS *cons, SCIP_VAR *var, SCIP_Real coef)
static SCIP_RETCODE presolveDisaggregateMergeComponents(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_HASHMAP *var2component, int nvars, int *ncomponents, int *componentssize)
#define CONSHDLR_PROP_TIMING
SCIP_Real SCIProwGetRhs(SCIP_ROW *row)
Definition: lp.c:16976
#define SCIP_DECL_QUADCONSUPGD(x)
static SCIP_DECL_CONSPROP(consPropQuadratic)
SCIP_Real * coefs
SCIP_RETCODE SCIPcreateConsQuadratic(SCIP *scip, SCIP_CONS **cons, const char *name, int nlinvars, SCIP_VAR **linvars, SCIP_Real *lincoefs, int nquadterms, SCIP_VAR **quadvars1, SCIP_VAR **quadvars2, SCIP_Real *quadcoefs, SCIP_Real lhs, SCIP_Real rhs, SCIP_Bool initial, SCIP_Bool separate, SCIP_Bool enforce, SCIP_Bool check, SCIP_Bool propagate, SCIP_Bool local, SCIP_Bool modifiable, SCIP_Bool dynamic, SCIP_Bool removable)
static SCIP_RETCODE delQuadVarTermPos(SCIP *scip, SCIP_CONS *cons, int pos)
SCIP_RETCODE SCIPaddConsLocal(SCIP *scip, SCIP_CONS *cons, SCIP_NODE *validnode)
Definition: scip_prob.c:3389
static SCIP_DECL_CONSPRINT(consPrintQuadratic)
#define BMSclearMemoryArray(ptr, num)
Definition: memory.h:120
SCIP_Bool SCIPconsIsMarkedPropagate(SCIP_CONS *cons)
Definition: cons.c:8285
public methods for primal heuristics
#define ROWPREP_SCALEUP_MAXMINCOEF
SCIP_RETCODE SCIPaddVarsToRow(SCIP *scip, SCIP_ROW *row, int nvars, SCIP_VAR **vars, SCIP_Real *vals)
Definition: scip_lp.c:1565
#define CONSHDLR_SEPAFREQ
static SCIP_RETCODE computeED(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons)
void SCIPinfoMessage(SCIP *scip, FILE *file, const char *formatstr,...)
Definition: scip_message.c:198
static SCIP_RETCODE propagateBounds(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS **conss, int nconss, SCIP_RESULT *result, int *nchgbds)
int SCIPexprgraphGetNodeQuadraticNQuadElements(SCIP_EXPRGRAPHNODE *node)
Definition: expr.c:13173
SCIP_RETCODE SCIPreleaseCons(SCIP *scip, SCIP_CONS **cons)
Definition: scip_cons.c:1109
SCIP_RETCODE SCIPaggregateVars(SCIP *scip, SCIP_VAR *varx, SCIP_VAR *vary, SCIP_Real scalarx, SCIP_Real scalary, SCIP_Real rhs, SCIP_Bool *infeasible, SCIP_Bool *redundant, SCIP_Bool *aggregated)
Definition: scip_var.c:8305
SCIP_RETCODE SCIPchgVarType(SCIP *scip, SCIP_VAR *var, SCIP_VARTYPE vartype, SCIP_Bool *infeasible)
Definition: scip_var.c:8084
SCIP_STAGE SCIPgetStage(SCIP *scip)
Definition: scip_general.c:355
void SCIPprintRowprep(SCIP *scip, SCIP_ROWPREP *rowprep, FILE *file)
constraint handler for bound disjunction constraints
void SCIPintervalAddScalar(SCIP_Real infinity, SCIP_INTERVAL *resultant, SCIP_INTERVAL operand1, SCIP_Real operand2)
SCIP_RETCODE SCIPsetConshdlrParse(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSPARSE((*consparse)))
Definition: scip_cons.c:792
void SCIPaddBilinMcCormick(SCIP *scip, SCIP_Real bilincoef, SCIP_Real lbx, SCIP_Real ubx, SCIP_Real refpointx, SCIP_Real lby, SCIP_Real uby, SCIP_Real refpointy, SCIP_Bool overestimate, SCIP_Real *lincoefx, SCIP_Real *lincoefy, SCIP_Real *linconstant, SCIP_Bool *success)
SCIP_RETCODE SCIPsetConshdlrProp(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSPROP((*consprop)), int propfreq, SCIP_Bool delayprop, SCIP_PROPTIMING proptiming)
Definition: scip_cons.c:265
SCIP_EXPORT SCIP_Bool SCIPvarIsRemovable(SCIP_VAR *var)
Definition: var.c:16949
#define SCIPABORT()
Definition: def.h:337
static void updateBilinearRelaxation(SCIP *scip, SCIP_VAR *RESTRICT x, SCIP_VAR *RESTRICT y, SCIP_Real bilincoef, SCIP_SIDETYPE violside, SCIP_Real refx, SCIP_Real refy, SCIP_Real *RESTRICT ineqs, int nineqs, SCIP_Real mccormickval, SCIP_Real *RESTRICT bestcoefx, SCIP_Real *RESTRICT bestcoefy, SCIP_Real *RESTRICT bestconst, SCIP_Real *RESTRICT bestval, SCIP_Bool *success)
public methods for global and local (sub)problems
void SCIPmarkRowNotRemovableLocal(SCIP *scip, SCIP_ROW *row)
Definition: scip_lp.c:1706
SCIP_Real SCIPadjustedVarLb(SCIP *scip, SCIP_VAR *var, SCIP_Real lb)
Definition: scip_var.c:4551
int SCIPgetLinvarMayDecreaseQuadratic(SCIP *scip, SCIP_CONS *cons)
static SCIP_RETCODE consdataFindQuadVarTerm(SCIP *scip, SCIP_CONSDATA *consdata, SCIP_VAR *var, int *pos)
SCIP_ROUNDMODE SCIPintervalGetRoundingMode(void)
SCIP_RETCODE SCIPsetConshdlrEnable(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSENABLE((*consenable)))
Definition: scip_cons.c:700
SCIP_RETCODE SCIPgetRowprepRowSepa(SCIP *scip, SCIP_ROW **row, SCIP_ROWPREP *rowprep, SCIP_SEPA *sepa)
static SCIP_RETCODE mergeAndCleanQuadVarTerms(SCIP *scip, SCIP_CONS *cons)
SCIP_VAR ** SCIPgetLinearVarsNonlinear(SCIP *scip, SCIP_CONS *cons)
SCIP_RETCODE SCIPaddCharParam(SCIP *scip, const char *name, const char *desc, char *valueptr, SCIP_Bool isadvanced, char defaultvalue, const char *allowedvalues, SCIP_DECL_PARAMCHGD((*paramchgd)), SCIP_PARAMDATA *paramdata)
Definition: scip_param.c:157
SCIP_Bool SCIPconsIsPropagated(SCIP_CONS *cons)
Definition: cons.c:8295
int SCIPgetSubscipDepth(SCIP *scip)
Definition: scip_copy.c:2289
void SCIPhashmapEntrySetImage(SCIP_HASHMAPENTRY *entry, void *image)
Definition: misc.c:3417
void SCIPaddSquareSecant(SCIP *scip, SCIP_Real sqrcoef, SCIP_Real lb, SCIP_Real ub, SCIP_Real refpoint, SCIP_Real *lincoef, SCIP_Real *linconstant, SCIP_Bool *success)
#define SCIPduplicateBlockMemory(scip, ptr, source)
Definition: scip_mem.h:90
static SCIP_RETCODE consdataEnsureLinearVarsSize(SCIP *scip, SCIP_CONSDATA *consdata, int num)
static SCIP_RETCODE enforceConstraint(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS **conss, int nconss, int nusefulconss, SCIP_SOL *sol, SCIP_Bool solinfeasible, SCIP_RESULT *result)
void SCIPintervalSetRoundingModeDownwards(void)
static SCIP_RETCODE computeViolations(SCIP *scip, SCIP_CONS **conss, int nconss, SCIP_SOL *sol, SCIP_Bool *solviolbounds, SCIP_CONS **maxviolcon)
SCIP_RETCODE SCIPsetNLPInitialGuessSol(SCIP *scip, SCIP_SOL *sol)
Definition: scip_nlp.c:537
#define ABS(x)
Definition: def.h:218
SCIP_EXPORT SCIP_VAR ** SCIPvarGetMultaggrVars(SCIP_VAR *var)
Definition: var.c:17132
SCIP_SOL * SCIPeventGetSol(SCIP_EVENT *event)
Definition: event.c:1259
static SCIP_DECL_CONSDISABLE(consDisableQuadratic)
SCIP_RETCODE SCIPsetConshdlrInitlp(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_DECL_CONSINITLP((*consinitlp)))
Definition: scip_cons.c:608
static SCIP_Bool hasQuadvarHpProperty(SCIP *scip, SCIP_CONSDATA *consdata, int idx)
SCIP_Bool SCIPintervalIsSubsetEQ(SCIP_Real infinity, SCIP_INTERVAL operand1, SCIP_INTERVAL operand2)
static SCIP_RETCODE processCut(SCIP *scip, SCIP_ROW **row, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons, SCIP_Real efficacy, SCIP_Real minefficacy, SCIP_Bool inenforcement, SCIP_Real *bestefficacy, SCIP_RESULT *result)
static SCIP_RETCODE catchLinearVarEvents(SCIP *scip, SCIP_EVENTHDLR *eventhdlr, SCIP_CONS *cons, int linvarpos)
SCIP_RETCODE SCIPcreateEmptyRowSepa(SCIP *scip, SCIP_ROW **row, SCIP_SEPA *sepa, const char *name, SCIP_Real lhs, SCIP_Real rhs, SCIP_Bool local, SCIP_Bool modifiable, SCIP_Bool removable)
Definition: scip_lp.c:1297
SCIP_Bool SCIPconsIsModifiable(SCIP_CONS *cons)
Definition: cons.c:8325
SCIP_Bool SCIPisFeasPositive(SCIP *scip, SCIP_Real val)
SCIP_EXPORT int SCIPvarCompare(SCIP_VAR *var1, SCIP_VAR *var2)
Definition: var.c:11436
SCIP_RETCODE SCIPgetNlRowQuadratic(SCIP *scip, SCIP_CONS *cons, SCIP_NLROW **nlrow)
#define SCIPreallocBufferArray(scip, ptr, num)
Definition: scip_mem.h:115
uint64_t SCIP_EVENTTYPE
Definition: type_event.h:134
void SCIPaddRowprepConstant(SCIP_ROWPREP *rowprep, SCIP_Real constant)
static SCIP_RETCODE generateCutUnboundedLP(SCIP *scip, SCIP_CONSHDLR *conshdlr, SCIP_CONS *cons, SCIP_SIDETYPE violside, SCIP_ROW **row, SCIP_Real *rowrayprod, SCIP_Bool checkcurvmultivar)
SCIP_Real SCIPgetSolOrigObj(SCIP *scip, SCIP_SOL *sol)
Definition: scip_sol.c:1435
void SCIPintervalQuad(SCIP_Real infinity, SCIP_INTERVAL *resultant, SCIP_Real sqrcoeff, SCIP_INTERVAL lincoeff, SCIP_INTERVAL xrng)
memory allocation routines
enum SCIP_SideType SCIP_SIDETYPE
Definition: type_lp.h:58
SCIP_QUADELEM * SCIPexprgraphGetNodeQuadraticQuadElements(SCIP_EXPRGRAPHNODE *node)
Definition: expr.c:13161