Scippy

SCIP

Solving Constraint Integer Programs

sepa_cmir.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-2017 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 email to scip@zib.de. */
13 /* */
14 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
15 
16 /**@file sepa_cmir.c
17  * @brief complemented mixed integer rounding cuts separator (Marchand's version)
18  * @author Kati Wolter
19  * @author Tobias Achterberg
20  */
21 
22 /*---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----0----+----1----+----2*/
23 
24 #include <assert.h>
25 #include <string.h>
26 
27 #include "scip/sepa_cmir.h"
28 #include "scip/pub_misc.h"
29 
30 
31 #define SEPA_NAME "cmir"
32 #define SEPA_DESC "complemented mixed integer rounding cuts separator (Marchand's version)"
33 #define SEPA_PRIORITY -3000
34 #define SEPA_FREQ 0
35 #define SEPA_MAXBOUNDDIST 0.0
36 #define SEPA_USESSUBSCIP FALSE /**< does the separator use a secondary SCIP instance? */
37 #define SEPA_DELAY FALSE /**< should separation method be delayed, if other separators found cuts? */
38 
39 #define DEFAULT_MAXROUNDS 3 /**< maximal number of cmir separation rounds per node (-1: unlimited) */
40 #define DEFAULT_MAXROUNDSROOT 10 /**< maximal number of cmir separation rounds in the root node (-1: unlimited) */
41 #define DEFAULT_MAXTRIES 100 /**< maximal number of rows to start aggregation with per separation round
42  * (-1: unlimited) */
43 #define DEFAULT_MAXTRIESROOT -1 /**< maximal number of rows to start aggregation with per round in the root node
44  * (-1: unlimited) */
45 #define DEFAULT_MAXFAILS 20 /**< maximal number of consecutive unsuccessful aggregation tries (-1: unlimited) */
46 #define DEFAULT_MAXFAILSROOT 100 /**< maximal number of consecutive unsuccessful aggregation tries in the root node
47  * (-1: unlimited) */
48 #define DEFAULT_MAXAGGRS 3 /**< maximal number of aggregations for each row per separation round */
49 #define DEFAULT_MAXAGGRSROOT 6 /**< maximal number of aggregations for each row per round in the root node */
50 #define DEFAULT_MAXSEPACUTS 100 /**< maximal number of cmir cuts separated per separation round */
51 #define DEFAULT_MAXSEPACUTSROOT 500 /**< maximal number of cmir cuts separated per separation round in root node */
52 #define DEFAULT_MAXSLACK 0.0 /**< maximal slack of rows to be used in aggregation */
53 #define DEFAULT_MAXSLACKROOT 0.1 /**< maximal slack of rows to be used in aggregation in the root node */
54 #define DEFAULT_DENSITYSCORE 1e-04 /**< weight of row density in the aggregation scoring of the rows */
55 #define DEFAULT_SLACKSCORE 1e-03 /**< weight of slack in the aggregation scoring of the rows */
56 #define DEFAULT_MAXAGGDENSITY 0.20 /**< maximal density of aggregated row */
57 #define DEFAULT_MAXROWDENSITY 0.05 /**< maximal density of row to be used in aggregation */
58 #define DEFAULT_DENSITYOFFSET 100 /**< additional number of variables allowed in row on top of density */
59 #define DEFAULT_MAXROWFAC 1e+4 /**< maximal row aggregation factor */
60 #define DEFAULT_MAXTESTDELTA -1 /**< maximal number of different deltas to try (-1: unlimited) */
61 #define DEFAULT_MAXCONTS 10 /**< maximal number of active continuous variables in aggregated row */
62 #define DEFAULT_MAXCONTSROOT 10 /**< maximal number of active continuous variables in aggregated row in the root */
63 #define DEFAULT_AGGRTOL 0.1 /**< aggregation heuristic: tolerance for bound distances used to select real
64  * variable in current aggregated constraint to be eliminated */
65 #define DEFAULT_TRYNEGSCALING TRUE /**< should negative values also be tested in scaling? */
66 #define DEFAULT_FIXINTEGRALRHS TRUE /**< should an additional variable be complemented if f0 = 0? */
67 #define DEFAULT_DYNAMICCUTS TRUE /**< should generated cuts be removed from the LP if they are no longer tight? */
68 
69 #define BOUNDSWITCH 0.5
70 #define USEVBDS TRUE
71 #define ALLOWLOCAL TRUE
72 #define MINFRAC 0.05
73 #define MAXFRAC 0.999
74 #define MAKECONTINTEGRAL FALSE
75 #define IMPLINTSARECONT
76 
77 #define MAXAGGRLEN(nvars) (0.1*(nvars)+1000) /**< maximal length of base inequality */
78 
79 
80 /*
81  * Data structures
82  */
83 
84 /** separator data */
85 struct SCIP_SepaData
86 {
87  SCIP_Real maxslack; /**< maximal slack of rows to be used in aggregation */
88  SCIP_Real maxslackroot; /**< maximal slack of rows to be used in aggregation in the root node */
89  SCIP_Real densityscore; /**< weight of row density in the aggregation scoring of the rows */
90  SCIP_Real slackscore; /**< weight of slack in the aggregation scoring of the rows */
91  SCIP_Real maxaggdensity; /**< maximal density of aggregated row */
92  SCIP_Real maxrowdensity; /**< maximal density of row to be used in aggregation */
93  SCIP_Real maxrowfac; /**< maximal row aggregation factor */
94  SCIP_Real aggrtol; /**< tolerance for bound distance used in aggregation heuristic */
95  int maxrounds; /**< maximal number of cmir separation rounds per node (-1: unlimited) */
96  int maxroundsroot; /**< maximal number of cmir separation rounds in the root node (-1: unlimited) */
97  int maxtries; /**< maximal number of rows to start aggregation with per separation round
98  * (-1: unlimited) */
99  int maxtriesroot; /**< maximal number of rows to start aggregation with per round in the root node
100  * (-1: unlimited) */
101  int maxfails; /**< maximal number of consecutive unsuccessful aggregation tries
102  * (-1: unlimited) */
103  int maxfailsroot; /**< maximal number of consecutive unsuccessful aggregation tries in the root
104  * node (-1: unlimited) */
105  int maxaggrs; /**< maximal number of aggregations for each row per separation round */
106  int maxaggrsroot; /**< maximal number of aggregations for each row per round in the root node */
107  int maxsepacuts; /**< maximal number of cmir cuts separated per separation round */
108  int maxsepacutsroot; /**< maximal number of cmir cuts separated per separation round in root node */
109  int densityoffset; /**< additional number of variables allowed in row on top of density */
110  int maxtestdelta; /**< maximal number of different deltas to try (-1: unlimited) */
111  int maxconts; /**< maximal number of active continuous variables in aggregated row */
112  int maxcontsroot; /**< maximal number of active continuous variables in aggregated row in the root */
113  SCIP_Bool trynegscaling; /**< should negative values also be tested in scaling? */
114  SCIP_Bool fixintegralrhs; /**< should an additional variable be complemented if f0 = 0? */
115  SCIP_Bool dynamiccuts; /**< should generated cuts be removed from the LP if they are no longer tight? */
116 };
117 
118 
119 /*
120  * Local methods
121  */
122 
123 /** stores nonzero elements of dense coefficient vector as sparse vector, and calculates activity and norm */
124 static
126  SCIP* scip, /**< SCIP data structure */
127  int nvars, /**< number of problem variables */
128  SCIP_VAR** vars, /**< problem variables */
129  SCIP_Real* cutcoefs, /**< dense coefficient vector */
130  SCIP_Real* varsolvals, /**< dense variable LP solution vector */
131  SCIP_VAR** cutvars, /**< array to store variables of sparse cut vector */
132  SCIP_Real* cutvals, /**< array to store coefficients of sparse cut vector */
133  int* cutlen, /**< pointer to store number of nonzero entries in cut */
134  SCIP_Real* cutact /**< pointer to store activity of cut */
135  )
136 {
137  SCIP_Real act;
138  int len;
139  int v;
140 
141  assert(nvars == 0 || cutcoefs != NULL);
142  assert(nvars == 0 || varsolvals != NULL);
143  assert(cutvars != NULL);
144  assert(cutvals != NULL);
145  assert(cutlen != NULL);
146  assert(cutact != NULL);
147 
148  len = 0;
149  act = 0.0;
150  for( v = 0; v < nvars; ++v )
151  {
152  SCIP_Real val;
153 
154  val = cutcoefs[v];
155  if( !SCIPisZero(scip, val) )
156  {
157  act += val * varsolvals[v];
158  cutvars[len] = vars[v];
159  cutvals[len] = val;
160  len++;
161  }
162  }
163 
164  *cutlen = len;
165  *cutact = act;
166 
167  return SCIP_OKAY;
168 }
169 
170 /** adds given cut to LP if violated */
171 static
173  SCIP* scip, /**< SCIP data structure */
174  SCIP_SEPA* sepa, /**< separator */
175  SCIP_SOL* sol, /**< the solution that should be separated, or NULL for LP solution */
176  SCIP_Real* varsolvals, /**< solution values of active variables */
177  SCIP_Real* cutcoefs, /**< coefficients of active variables in cut */
178  SCIP_Real cutrhs, /**< right hand side of cut */
179  SCIP_Bool cutislocal, /**< is the cut only locally valid? */
180  SCIP_Bool cutremovable, /**< should the cut be removed from the LP due to aging or cleanup? */
181  int cutrank, /**< rank of the cut */
182  const char* cutclassname, /**< name of cut class to use for row names */
183  SCIP_Bool* cutoff, /**< whether a cutoff has been detected */
184  int* ncuts /**< pointer to count the number of added cuts */
185  )
186 {
187  SCIP_VAR** vars;
188  SCIP_VAR** cutvars;
189  SCIP_Real* cutvals;
190  SCIP_Real cutact;
191  int nvars;
192  int cutlen;
193 
194  assert(scip != NULL);
195  assert(varsolvals != NULL);
196  assert(cutcoefs != NULL);
197  assert(cutoff != NULL);
198  assert(ncuts != NULL);
199 
200  *cutoff = FALSE;
201 
202  /* get active problem variables */
203  SCIP_CALL( SCIPgetVarsData(scip, &vars, &nvars, NULL, NULL, NULL, NULL) );
204  assert(nvars == 0 || vars != NULL);
205 
206  /* get temporary memory for storing the cut as sparse row */
207  SCIP_CALL( SCIPallocBufferArray(scip, &cutvars, nvars) );
208  SCIP_CALL( SCIPallocBufferArray(scip, &cutvals, nvars) );
209 
210  /* store the cut as sparse row, calculate activity and norm of cut */
211  SCIP_CALL( storeCutInArrays(scip, nvars, vars, cutcoefs, varsolvals,
212  cutvars, cutvals, &cutlen, &cutact) );
213 
214  if( cutlen > 0 )
215  {
216  SCIP_Real cutnorm;
217 
218  cutnorm = SCIPgetVectorEfficacyNorm(scip, cutvals, cutlen);
219  if( SCIPisPositive(scip, cutnorm) && SCIPisEfficacious(scip, (cutact - cutrhs)/cutnorm) )
220  {
221  SCIP_ROW* cut;
222  char cutname[SCIP_MAXSTRLEN];
223  SCIP_Bool success;
224 
225  /* create the cut */
226  (void) SCIPsnprintf(cutname, SCIP_MAXSTRLEN, "%s%d_%d", cutclassname, SCIPgetNLPs(scip), *ncuts);
227  SCIP_CALL( SCIPcreateEmptyRowSepa(scip, &cut, sepa, cutname, -SCIPinfinity(scip), cutrhs,
228  cutislocal, FALSE, cutremovable) );
229  SCIP_CALL( SCIPaddVarsToRow(scip, cut, cutlen, cutvars, cutvals) );
230 
231  /* set cut rank */
232  SCIProwChgRank(cut, cutrank);
233 
234  SCIPdebugMsg(scip, " -> found potential %s cut <%s>: activity=%f, rhs=%f, norm=%f, eff=%f\n",
235  cutclassname, cutname, cutact, cutrhs, cutnorm, SCIPgetCutEfficacy(scip, sol, cut));
236  SCIPdebug( SCIP_CALL( SCIPprintRow(scip, cut, NULL) ) );
237 
238  /* try to scale the cut to integral values, but only if the scaling is small; otherwise keep the fractional cut */
239  SCIP_CALL( SCIPmakeRowIntegral(scip, cut, -SCIPepsilon(scip), SCIPsumepsilon(scip),
240  (SCIP_Longint) 30, 100.0, MAKECONTINTEGRAL, &success) );
241  if( success && !SCIPisCutEfficacious(scip, sol, cut) )
242  {
243  SCIPdebugMsg(scip, " -> %s cut <%s> no longer efficacious: act=%f, rhs=%f, norm=%f, eff=%f\n",
244  cutclassname, cutname, cutact, cutrhs, cutnorm, SCIPgetCutEfficacy(scip, sol, cut));
245  SCIPdebug( SCIP_CALL( SCIPprintRow(scip, cut, NULL) ) );
246  success = FALSE;
247  }
248  else
249  success = TRUE; /* also use cut if scaling failed */
250 
251  /* if scaling was successful, add the cut */
252  if( success ) /*lint !e774*/ /* Boolean within 'if' always evaluates to True */
253  {
254  SCIPdebugMsg(scip, " -> found %s cut <%s>: act=%f, rhs=%f, norm=%f, eff=%f, rank=%d, min=%f, max=%f (range=%g)\n",
255  cutclassname, cutname, cutact, cutrhs, cutnorm, SCIPgetCutEfficacy(scip, sol, cut), SCIProwGetRank(cut),
256  SCIPgetRowMinCoef(scip, cut), SCIPgetRowMaxCoef(scip, cut),
257  SCIPgetRowMaxCoef(scip, cut)/SCIPgetRowMinCoef(scip, cut));
258  SCIPdebug( SCIP_CALL( SCIPprintRow(scip, cut, NULL) ) );
259  SCIP_CALL( SCIPaddCut(scip, sol, cut, FALSE, cutoff) );
260  if( !(*cutoff) && !cutislocal )
261  {
262  SCIP_CALL( SCIPaddPoolCut(scip, cut) );
263  }
264  (*ncuts)++;
265  }
266 
267  /* release the row */
268  SCIP_CALL( SCIPreleaseRow(scip, &cut) );
269  }
270  }
271 
272  /* free temporary memory */
273  SCIPfreeBufferArray(scip, &cutvals);
274  SCIPfreeBufferArray(scip, &cutvars);
275 
276  return SCIP_OKAY;
277 }
278 
279 /** adds delta to active continuous variables counter */
280 static
281 void updateNActiveConts(
282  SCIP* scip, /**< SCIP data structure */
283  SCIP_Real* varsolvals, /**< LP solution value of all variables in LP */
284  SCIP_Real* bestcontlbs, /**< best lower (variable or standard) bounds of continuous variables */
285  SCIP_Real* bestcontubs, /**< best upper (variable or standard) bounds of continuous variables */
286  int nintvars, /**< number of integer variables */
287  SCIP_VAR* var, /**< continuous variable */
288  int delta, /**< delta value of counters */
289  int* nactiveconts /**< pointer to count number of active continuous variables */
290  )
291 {
292  assert(nactiveconts != NULL);
293 
294  if( !SCIPvarIsIntegral(var) )
295  {
296  SCIP_Real primsol;
297  SCIP_Real lb;
298  SCIP_Real ub;
299  int probindex;
300 
301  probindex = SCIPvarGetProbindex(var);
302  assert(probindex >= nintvars);
303 
304  primsol = varsolvals[probindex];
305  lb = bestcontlbs[probindex - nintvars];
306  ub = bestcontubs[probindex - nintvars];
307 
308  if( !SCIPisInfinity(scip, -lb) && SCIPisLT(scip, lb, primsol) && !SCIPisInfinity(scip, ub) && SCIPisLT(scip, primsol, ub) )
309  (*nactiveconts) += delta;
310  }
311 }
312 
313 /** decreases the score of a row in order to not aggregate it again too soon */
314 static
315 void decreaseRowScore(
316  SCIP* scip, /**< SCIP data structure */
317  SCIP_Real* rowlhsscores, /**< aggregation scores for left hand sides of row */
318  SCIP_Real* rowrhsscores, /**< aggregation scores for right hand sides of row */
319  int rowidx /**< index of row to decrease score for */
320  )
321 {
322  assert(rowlhsscores != NULL);
323  assert(rowrhsscores != NULL);
324  assert(rowlhsscores[rowidx] >= 0.0);
325  assert(rowrhsscores[rowidx] >= 0.0);
326 
327  rowlhsscores[rowidx] *= 0.9;
328  rowrhsscores[rowidx] *= 0.9;
329 }
330 
331 /** calculates the c-MIR cut for the given rowweights and delta value, and updates testeddeltas, bestdelta, and
332  * bestefficacy
333  */
334 static
336  SCIP* scip, /**< SCIP data structure */
337  SCIP_SOL* sol, /**< the solution that should be separated, or NULL for LP solution */
338  int nvars, /**< number of problem variables */
339  SCIP_Real* rowweights, /**< weight of rows in aggregated row */
340  SCIP_Real maxweight, /**< largest magnitude of weights; set to -1 if sparsity information is unknown */
341  int* weightinds, /**< sparsity pattern of weights; size nrowinds; NULL if sparsity info is unknown */
342  int nweightinds, /**< number of nonzeros in weights; -1 if rowinds is NULL */
343  int rowlensum, /**< total number of non-zeros in used rows (row associated with nonzero weight coefficient); -1 if unknown */
344  SCIP_Real* cutcoefs, /**< array to store the cut coefficients */
345  SCIP_Real* mksetcoefs, /**< array to store mixed knapsack set coefficients: size nvars; or NULL */
346  SCIP_Bool* mksetcoefsvalid, /**< pointer to store whether mixed knapsack set coefficients are valid; or NULL */
347  SCIP_Real* testeddeltas, /**< array with already tested deltas */
348  int* ntesteddeltas, /**< pointer to the number of elements in testeddeltas */
349  SCIP_Real delta, /**< delta value to scale mixed knapsack equation with */
350  SCIP_Real boundswitch, /**< fraction of domain up to which lower bound is used in transformation */
351  SCIP_Bool usevbds, /**< should variable bounds be used in bound transformation? */
352  SCIP_Bool allowlocal, /**< should local information allowed to be used, resulting in a local cut? */
353  SCIP_Bool fixintegralrhs, /**< should complementation tried to be adjusted such that rhs gets fractional? */
354  int maxmksetcoefs, /**< maximal number of nonzeros allowed in aggregated base inequality */
355  SCIP_Real maxweightrange, /**< maximal valid range max(|weights|)/min(|weights|) of row weights */
356  SCIP_Real minfrac, /**< minimal fractionality of rhs to produce MIR cut for */
357  SCIP_Real maxfrac, /**< maximal fractionality of rhs to produce MIR cut for */
358  SCIP_Real* bestdelta, /**< pointer to the currently best delta value */
359  SCIP_Real* bestefficacy /**< pointer to the currently best efficacy */
360  )
361 {
362  SCIP_Bool tested;
363  int i;
364 
365  assert(testeddeltas != NULL);
366  assert(ntesteddeltas != NULL);
367  assert(bestdelta != NULL);
368  assert(bestefficacy != NULL);
369 
370  /* do not use too small deltas */
371  if( SCIPisFeasZero(scip, delta) )
372  return SCIP_OKAY;
373 
374  /* check, if delta with mult was already tested */
375  tested = FALSE;
376  for( i = 0; i < *ntesteddeltas && !tested; i++ )
377  tested = SCIPisEQ(scip, testeddeltas[i], delta);
378  if( !tested )
379  {
380  SCIP_Real cutact;
381  SCIP_Real cutrhs;
382  SCIP_Bool success;
383  SCIP_Bool cutislocal;
384 
385  testeddeltas[*ntesteddeltas] = delta;
386  (*ntesteddeltas)++;
387 
388  /* create a MIR cut out of the weighted LP rows */
389  SCIP_CALL( SCIPcalcMIR(scip, sol, boundswitch, usevbds, allowlocal, fixintegralrhs, NULL, NULL, maxmksetcoefs,
390  maxweightrange, minfrac, maxfrac, rowweights, maxweight, weightinds, nweightinds, rowlensum, NULL, delta,
391  mksetcoefs, mksetcoefsvalid, cutcoefs, &cutrhs, &cutact, &success, &cutislocal, NULL) );
392  assert(allowlocal || !cutislocal);
393  SCIPdebugMsg(scip, "delta = %g -> success: %u, cutact: %g, cutrhs: %g, vio: %g\n",
394  delta, success, success ? cutact : 0.0, success ? cutrhs : 0.0, success ? cutact - cutrhs : 0.0);
395 
396  /* check if delta generates cut which is more violated */
397  if( success && SCIPisFeasGT(scip, cutact, cutrhs) )
398  {
399  SCIP_Real norm;
400 
401  norm = SCIPgetVectorEfficacyNorm(scip, cutcoefs, nvars);
402  if( norm > 0.0 )
403  {
404  SCIP_Real efficacy;
405 
406  efficacy = (cutact - cutrhs)/norm;
407  SCIPdebugMsg(scip, "act = %g rhs = %g eff = %g, old besteff = %g, old bestdelta=%g\n", cutact, cutrhs, efficacy, *bestefficacy, *bestdelta);
408  if( efficacy > *bestefficacy )
409  {
410  *bestdelta = delta;
411  *bestefficacy = efficacy;
412  }
413  }
414  }
415  }
416 
417  return SCIP_OKAY;
418 }
419 
420 /** Performs the cut generation heuristic of the c-MIR separation algorithm, i.e., tries to generate a c-MIR cut which is
421  * valid for the mixed knapsack set corresponding to the current aggregated constraint. Cuts will only be added here if
422  * no pointer to store best scaling factor delta is given.
423  */
425  SCIP* scip, /**< SCIP data structure */
426  SCIP_SEPA* sepa, /**< separator */
427  SCIP_SOL* sol, /**< the solution that should be separated, or NULL for LP solution */
428  SCIP_Real* varsolvals, /**< LP solution value of all variables in LP */
429  int maxtestdelta, /**< maximal number of different deltas to try (-1: unlimited) */
430  SCIP_Real* rowweights, /**< weight of rows in aggregated row */
431  SCIP_Real maxweight, /**< largest magnitude of weights; set to -1.0 if sparsity information is
432  * unknown */
433  int* weightinds, /**< sparsity pattern of weights; size nrowinds; NULL if sparsity info is
434  * unknown */
435  int nweightinds, /**< number of nonzeros in weights; -1 if rowinds is NULL */
436  int rowlensum, /**< total number of non-zeros in used rows (row associated with nonzero weight coefficient); -1 if unknown */
437  SCIP_Real boundswitch, /**< fraction of domain up to which lower bound is used in transformation */
438  SCIP_Bool usevbds, /**< should variable bounds be used in bound transformation? */
439  SCIP_Bool allowlocal, /**< should local information allowed to be used, resulting in a local cut? */
440  SCIP_Bool fixintegralrhs, /**< should complementation tried to be adjusted such that rhs gets fractional? */
441  int maxmksetcoefs, /**< maximal number of nonzeros allowed in aggregated base inequality */
442  SCIP_Real maxweightrange, /**< maximal valid range max(|weights|)/min(|weights|) of row weights */
443  SCIP_Real minfrac, /**< minimal fractionality of rhs to produce MIR cut for */
444  SCIP_Real maxfrac, /**< maximal fractionality of rhs to produce MIR cut for */
445  SCIP_Bool trynegscaling, /**< should negative values also be tested in scaling? */
446  SCIP_Bool cutremovable, /**< should the cut be removed from the LP due to aging or cleanup? */
447  const char* cutclassname, /**< name of cut class to use for row names */
448  SCIP_Bool* cutoff, /**< whether a cutoff has been detected */
449  int* ncuts, /**< pointer to count the number of generated cuts */
450  SCIP_Real* delta, /**< pointer to store best delta found; NULL, if cut should be added here */
451  SCIP_Bool* deltavalid /**< pointer to store whether best delta value is valid or NULL */
452  )
453 { /*lint --e{715}*/
454  SCIP_VAR** vars;
455  SCIP_Real* cutcoefs;
456  SCIP_Real* mksetcoefs;
457  SCIP_Real* testeddeltas;
458  SCIP_Real bestdelta;
459  SCIP_Real bestefficacy;
460  SCIP_Real maxabsmksetcoef;
461  SCIP_Bool mksetcoefsvalid;
462  int nvars;
463  int ncontvars;
464  int nintvars;
465  int ntesteddeltas;
466  int vi;
467 
468  assert( cutoff != NULL );
469  *cutoff = FALSE;
470 
471  if( maxtestdelta == -1 )
472  maxtestdelta = INT_MAX;
473 
474  if( delta != NULL )
475  *deltavalid = FALSE;
476 
477  /* get active problem variables */
478  vars = SCIPgetVars(scip);
479  nvars = SCIPgetNVars(scip);
480  ncontvars = SCIPgetNContVars(scip);
481  nintvars = nvars-ncontvars;
482  if( nvars == 0 )
483  return SCIP_OKAY;
484  assert(vars != NULL);
485 
486  /* get temporary memory */
487  SCIP_CALL( SCIPallocBufferArray(scip, &mksetcoefs, nvars) );
488  SCIP_CALL( SCIPallocBufferArray(scip, &cutcoefs, nvars) );
489  SCIP_CALL( SCIPallocBufferArray(scip, &testeddeltas, 3 + 2*(nintvars+2)) );
490 
491  /* As in Marchand's version. Use the absolute value of the coefficients of the integer variables (lying
492  * strictly between its bounds) in the constructed mixed knapsack set, i.e.,
493  * N* = { |alpha'_j| : j in N, alpha'_j != 0 and l_j < x*_j < u_j }
494  */
495 
496  /* search delta for generating a cut with maximum efficacy:
497  * delta = coefficient of integer variable in constructed mixed knapsack set which lies between its bounds
498  */
499  ntesteddeltas = 0;
500  bestdelta = 0.0;
501  bestefficacy = 0.0;
502  maxabsmksetcoef = 0.0;
503  mksetcoefsvalid = FALSE;
504 
505  /* try delta = 1 and get the coefficients of all variables in the constructed mixed knapsack set;
506  * if the aggregated row contains too many nonzero elements the generation of the c-MIR cut is aborted,
507  * in this case, mksetcoefs is not valid and we can abort the separation heuristic (as the number of nonzeros
508  * keeps the same for different values of delta)
509  */
510  SCIP_CALL( tryDelta(scip, sol, nvars, rowweights, maxweight, weightinds, nweightinds, rowlensum, cutcoefs, mksetcoefs,
511  &mksetcoefsvalid, testeddeltas, &ntesteddeltas, 1.0, boundswitch, usevbds, allowlocal, fixintegralrhs,
512  maxmksetcoefs, maxweightrange, minfrac, maxfrac, &bestdelta, &bestefficacy) );
513  if( mksetcoefsvalid && trynegscaling )
514  {
515  SCIP_CALL( tryDelta(scip, sol, nvars, rowweights, maxweight, weightinds, nweightinds, rowlensum, cutcoefs, NULL,
516  NULL, testeddeltas, &ntesteddeltas, -1.0, boundswitch, usevbds, allowlocal, fixintegralrhs, maxmksetcoefs,
517  maxweightrange, minfrac, maxfrac, &bestdelta, &bestefficacy) );
518  }
519 
520  /* find mult in { +1, -1 } and delta in the corresponding set N* leading to the most violated c-MIR cut */
521  for( vi = 0; mksetcoefsvalid && vi < nintvars; vi++ )
522  {
523  SCIP_VAR* var;
524  SCIP_Real primsol;
525  SCIP_Real lb;
526  SCIP_Real ub;
527  SCIP_Real absmksetcoef;
528 
529  var = vars[vi];
530  assert(vi == SCIPvarGetProbindex(var));
531  assert(SCIPvarGetType(var) != SCIP_VARTYPE_CONTINUOUS);
532  assert(SCIPvarIsActive(var));
533  assert(SCIPvarIsIntegral(var));
534 
535  /* update maximum coefficient of integer variables in constructed mixed knapsack set for
536  * mult = +1 and delta = 1 and
537  * mult = -1 and delta = 1
538  */
539  absmksetcoef = REALABS(mksetcoefs[vi]);
540  maxabsmksetcoef = MAX(maxabsmksetcoef, absmksetcoef);
541 
542  if( ntesteddeltas >= maxtestdelta )
543  continue; /* remaining loop is only for maxabsmksetcoef calculation */
544 
545  /* ignore variables with current solution value on its bounds */
546  primsol = varsolvals[vi];
547  lb = SCIPvarGetLbLocal(var);
548  ub = SCIPvarGetUbLocal(var);
549  if( SCIPisEQ(scip, primsol, lb) || SCIPisEQ(scip, primsol, ub) )
550  continue;
551 
552  /* try to divide aggregated row by absmksetcoef */
553  if( !SCIPisFeasZero(scip, absmksetcoef) )
554  {
555  SCIP_CALL( tryDelta(scip, sol, nvars, rowweights, maxweight, weightinds, nweightinds, rowlensum, cutcoefs, NULL,
556  NULL, testeddeltas, &ntesteddeltas, 1.0/absmksetcoef, boundswitch, usevbds, allowlocal, fixintegralrhs,
557  maxmksetcoefs, maxweightrange, minfrac, maxfrac, &bestdelta, &bestefficacy) );
558  if( trynegscaling )
559  {
560  SCIP_CALL( tryDelta(scip, sol, nvars, rowweights, maxweight, weightinds, nweightinds, rowlensum, cutcoefs,
561  NULL, NULL, testeddeltas, &ntesteddeltas, -1.0/absmksetcoef, boundswitch, usevbds, allowlocal,
562  fixintegralrhs, maxmksetcoefs, maxweightrange, minfrac, maxfrac, &bestdelta, &bestefficacy) );
563  }
564  }
565  }
566 
567  /* additionally try delta = maxabscoef+1 */
568  if( mksetcoefsvalid && !SCIPisFeasZero(scip, maxabsmksetcoef) )
569  {
570  SCIP_CALL( tryDelta(scip, sol, nvars, rowweights, maxweight, weightinds, nweightinds, rowlensum, cutcoefs, NULL,
571  NULL, testeddeltas, &ntesteddeltas, 1.0/(maxabsmksetcoef+1.0), boundswitch, usevbds, allowlocal,
572  fixintegralrhs, maxmksetcoefs, maxweightrange, minfrac, maxfrac, &bestdelta, &bestefficacy) );
573  if( trynegscaling )
574  {
575  SCIP_CALL( tryDelta(scip, sol, nvars, rowweights, maxweight, weightinds, nweightinds, rowlensum, cutcoefs, NULL,
576  NULL, testeddeltas, &ntesteddeltas, -1.0/(maxabsmksetcoef+1.0), boundswitch, usevbds, allowlocal,
577  fixintegralrhs, maxmksetcoefs, maxweightrange, minfrac, maxfrac, &bestdelta, &bestefficacy) );
578  }
579  }
580 
581  /* delta found */
582  if( mksetcoefsvalid && SCIPisEfficacious(scip, bestefficacy) )
583  {
584  SCIP_Real currentdelta;
585  SCIP_Real cutrhs;
586  SCIP_Real cutact;
587  SCIP_Bool success;
588  SCIP_Bool cutislocal;
589  int cutrank;
590  int i;
591 
592  assert(!SCIPisFeasZero(scip, bestdelta));
593 
594  /* Try to improve efficacy by multiplying delta with 2, 4 and 8 */
595  for( i = 0, currentdelta = 2.0 * bestdelta; i < 3; i++, currentdelta *= 2.0 )
596  {
597  SCIP_CALL( tryDelta(scip, sol, nvars, rowweights, maxweight, weightinds, nweightinds, rowlensum, cutcoefs,
598  NULL, NULL, testeddeltas, &ntesteddeltas, currentdelta, boundswitch, usevbds, allowlocal, fixintegralrhs,
599  maxmksetcoefs, maxweightrange, minfrac, maxfrac, &bestdelta, &bestefficacy) );
600  }
601 
602  /* if no pointer to store delta is given, add cut here (zerohalf cuts will be stored in a separate cut pool first) */
603  if( delta == NULL )
604  {
605  /* generate cut with bestdelta and best boundswitch value */
606  SCIP_CALL( SCIPcalcMIR(scip, sol, boundswitch, usevbds, allowlocal, fixintegralrhs, NULL, NULL,
607  maxmksetcoefs, maxweightrange, minfrac, maxfrac, rowweights, maxweight, weightinds, nweightinds, rowlensum,
608  NULL, bestdelta, NULL, NULL, cutcoefs, &cutrhs, &cutact, &success, &cutislocal, &cutrank) );
609  assert(allowlocal || !cutislocal);
610  assert(success);
611 
612  /* add the cut to the separation storage */
613  SCIP_CALL( addCut(scip, sepa, sol, varsolvals, cutcoefs, cutrhs, cutislocal, cutremovable, cutrank, cutclassname, cutoff, ncuts) );
614  }
615  else
616  {
617  *delta = bestdelta;
618  *deltavalid = TRUE;
619  }
620  }
621 
622  /* free datastructures */
623  SCIPfreeBufferArray(scip, &testeddeltas);
624  SCIPfreeBufferArray(scip, &cutcoefs);
625  SCIPfreeBufferArray(scip, &mksetcoefs);
626 
627  return SCIP_OKAY;
628 }
629 
630 /** returns whether the variable should be tried to be aggregated out */
631 static
633  SCIP_VAR* var /**< problem variable */
634  )
635 {
636  SCIP_VARTYPE vartype;
637 
638  vartype = SCIPvarGetType(var);
639 
640 #ifdef IMPLINTSARECONT
641  return (vartype == SCIP_VARTYPE_CONTINUOUS || vartype == SCIP_VARTYPE_IMPLINT);
642 #else
643  return (vartype == SCIP_VARTYPE_CONTINUOUS);
644 #endif
645 }
646 
647 /** returns the minimal distance of the solution of a continuous variable to its bounds */
648 static
650  SCIP* scip, /**< SCIP data structure */
651  int nintvars, /**< number of integer variables in the problem */
652  SCIP_Real* varsolvals, /**< LP solution value of all variables in LP */
653  SCIP_Real* bestcontlbs, /**< best lower (variable or standard) bounds of continuous variables */
654  SCIP_Real* bestcontubs, /**< best upper (variable or standard) bounds of continuous variables */
655  SCIP_VAR* var /**< continuous variable to get bound distance for */
656  )
657 {
658  SCIP_Real primsol;
659  SCIP_Real lb;
660  SCIP_Real ub;
661  SCIP_Real distlower;
662  SCIP_Real distupper;
663  SCIP_Real bounddist;
664 
665  assert(varIsContinuous(var));
666  assert(SCIPvarGetProbindex(var) >= nintvars);
667 
668  primsol = varsolvals[SCIPvarGetProbindex(var)];
669  lb = bestcontlbs[SCIPvarGetProbindex(var) - nintvars];
670  ub = bestcontubs[SCIPvarGetProbindex(var) - nintvars];
671  assert(SCIPisGE(scip, lb, SCIPvarGetLbGlobal(var)));
672  assert(SCIPisLE(scip, ub, SCIPvarGetUbGlobal(var)));
673  distlower = primsol - lb;
674  distupper = ub - primsol;
675  bounddist = MIN(distlower, distupper);
676 
677 #ifdef IMPLINTSARECONT
678  /* prefer continuous variables over implicit integers to be aggregated out */
680  bounddist /= 10.0;
681 #endif
682 
683  return bounddist;
684 }
685 
686 /** aggregates different single mixed integer constraints by taking linear combinations of the rows of the LP */
687 static
689  SCIP* scip, /**< SCIP data structure */
690  SCIP_SEPA* sepa, /**< separator */
691  SCIP_SEPADATA* sepadata, /**< separator data */
692  SCIP_SOL* sol, /**< the solution that should be separated, or NULL for LP solution */
693  SCIP_Real* varsolvals, /**< LP solution value of all variables in LP */
694  SCIP_Real* bestcontlbs, /**< best lower (variable or standard) bounds of continuous variables */
695  SCIP_Real* bestcontubs, /**< best upper (variable or standard) bounds of continuous variables */
696  SCIP_Real* contvarscorebounds, /**< bounds on the maximal rowlhsscores and rowrhsscores the variable is contained in */
697  SCIP_Real* rowlhsscores, /**< aggregation scores for left hand sides of row */
698  SCIP_Real* rowrhsscores, /**< aggregation scores for right hand sides of row */
699  int startrow, /**< index of row to start aggregation */
700  int maxaggrs, /**< maximal number of aggregations */
701  SCIP_Real maxslack, /**< maximal slack of rows to be used in aggregation */
702  int maxconts, /**< maximal number of active continuous variables in aggregated row */
703  SCIP_Bool* wastried, /**< pointer to store whether the given startrow was actually tried */
704  SCIP_Bool* cutoff, /**< whether a cutoff has been detected */
705  int* ncuts /**< pointer to count the number of generated cuts */
706  )
707 {
708  SCIP_COL** startnonzcols;
709  SCIP_COL** cols;
710  SCIP_VAR** vars;
711  SCIP_ROW** rows;
712  SCIP_COL* bestcol;
713  SCIP_Real* startnonzcoefs;
714  SCIP_Real* aggrcoefs;
715  SCIP_Real* rowweights;
716  int* weightinds;
717  int* aggrcontnonzposs;
718  SCIP_Real* aggrcontnonzbounddists;
719  SCIP_Real maxweight;
720  SCIP_Real minweight;
721  SCIP_Real startrowact;
722  SCIP_Bool hasfractional;
723  int naggrintnonzs;
724  int naggrcontnonzs;
725  int maxaggrnonzs;
726  int nstartnonzcols;
727  int naggrs;
728  int nactiveconts;
729  int nvars;
730  int nintvars;
731  int ncontvars;
732  int ncols;
733  int nrows;
734  int indpos;
735  int c;
736  int r;
737  int nweightinds;
738  int rowlensum;
739 
740  assert(scip != NULL);
741  assert(sepadata != NULL);
742  assert(varsolvals != NULL);
743  assert(rowlhsscores != NULL);
744  assert(rowrhsscores != NULL);
745  assert(wastried != NULL);
746  assert(cutoff != NULL);
747  assert(ncuts != NULL);
748 
749  *cutoff = FALSE;
750  *wastried = FALSE;
751 
752  SCIP_CALL( SCIPgetVarsData(scip, &vars, &nvars, NULL, NULL, NULL, &ncontvars) );
753 #ifdef IMPLINTSARECONT
754  ncontvars += SCIPgetNImplVars(scip); /* also aggregate out implicit integers */
755 #endif
756  nintvars = nvars - ncontvars;
757  assert((nvars == 0 && nintvars == 0 && ncontvars == 0) || vars != NULL);
758  SCIP_CALL( SCIPgetLPColsData(scip, &cols, &ncols) );
759  assert(ncols == 0 || cols != NULL);
760  SCIP_CALL( SCIPgetLPRowsData(scip, &rows, &nrows) );
761  assert(nrows == 0 || rows != NULL);
762  assert(0 <= startrow && startrow < nrows);
763 
764  SCIPdebugMsg(scip, "start c-MIR aggregation with row <%s> (%d/%d)\n", SCIProwGetName(rows[startrow]), startrow, nrows);
765 
766  /* calculate maximal number of non-zeros in aggregated row */
767  maxaggrnonzs = (int)(sepadata->maxaggdensity * ncols) + sepadata->densityoffset;
768 
769  /* get temporary memory */
770  SCIP_CALL( SCIPallocBufferArray(scip, &aggrcoefs, ncols) );
771  BMSclearMemoryArray(aggrcoefs, ncols);
772  SCIP_CALL( SCIPallocBufferArray(scip, &aggrcontnonzposs, ncols) );
773  SCIP_CALL( SCIPallocBufferArray(scip, &aggrcontnonzbounddists, ncols) );
774  SCIP_CALL( SCIPallocBufferArray(scip, &rowweights, nrows) );
775  /* initialize weights of rows in aggregation */
776  BMSclearMemoryArray(rowweights, nrows);
777  SCIP_CALL( SCIPallocBufferArray(scip, &weightinds, nrows) );
778  BMSclearMemoryArray(weightinds, nrows);
779 
780  startrowact = SCIPgetRowSolActivity(scip, rows[startrow], sol);
781  if( startrowact <= 0.5 * SCIProwGetLhs(rows[startrow]) + 0.5 * SCIProwGetRhs(rows[startrow]) )
782  rowweights[startrow] = -1.0;
783  else
784  rowweights[startrow] = 1.0;
785 
786  /* build weights sparse representation */
787  nweightinds = 0;
788  rowlensum = 0;
789  weightinds[nweightinds] = startrow;
790  nweightinds++;
791  rowlensum += SCIProwGetNNonz(rows[startrow]);
792 
793  maxweight = 1.0;
794  minweight = 1.0;
795 
796  /* get nonzero columns and coefficients of startrow */
797  startnonzcols = SCIProwGetCols(rows[startrow]);
798  nstartnonzcols = SCIProwGetNLPNonz(rows[startrow]);
799  startnonzcoefs = SCIProwGetVals(rows[startrow]);
800 
801  /* for all columns of startrow store coefficient as coefficient in aggregated row */
802  naggrintnonzs = 0;
803  naggrcontnonzs = 0;
804  nactiveconts = 0;
805  hasfractional = FALSE;
806  for( c = 0; c < nstartnonzcols; c++ )
807  {
808  SCIP_VAR* var;
809  int pos;
810 
811  var = SCIPcolGetVar(startnonzcols[c]);
812  pos = SCIPcolGetLPPos(startnonzcols[c]);
813  assert(pos >= 0);
814  assert(!SCIPisZero(scip, startnonzcoefs[c]));
815  aggrcoefs[pos] = rowweights[startrow] * startnonzcoefs[c];
816  if( varIsContinuous(var) )
817  {
818  SCIP_Real bounddist;
819 
820  updateNActiveConts(scip, varsolvals, bestcontlbs, bestcontubs, nintvars, var, +1, &nactiveconts);
821 
822  /* store continuous variable in array sorted by distance to closest bound */
823  bounddist = getBounddist(scip, nintvars, varsolvals, bestcontlbs, bestcontubs, var);
824  SCIPsortedvecInsertDownRealInt(aggrcontnonzbounddists, aggrcontnonzposs, bounddist, pos, &naggrcontnonzs, NULL);
825  }
826  else
827  naggrintnonzs++;
828 
829  if( !hasfractional && SCIPvarIsIntegral(var) )
830  {
831  SCIP_Real primsol;
832 
833  primsol = varsolvals[SCIPvarGetProbindex(var)];
834  hasfractional = !SCIPisFeasIntegral(scip, primsol);
835  }
836  }
837  assert(naggrintnonzs + naggrcontnonzs == nstartnonzcols);
838 
839  /* don't try aggregation if there is no integer variable with fractional value */
840  if( !hasfractional )
841  {
842  SCIPdebugMsg(scip, " -> row has no fractional integer variables: ignore\n");
843  maxaggrs = -1;
844  }
845 
846  /* decrease score of startrow in order to not aggregate it again too soon */
847  decreaseRowScore(scip, rowlhsscores, rowrhsscores, startrow);
848 
849  /* try to generate cut from the current aggregated row
850  * add cut if found, otherwise add another row to aggregated row
851  * in order to get rid of a continuous variable
852  */
853  naggrs = 0;
854  while( nactiveconts <= maxconts && naggrs <= maxaggrs && naggrcontnonzs + naggrintnonzs <= maxaggrnonzs )
855  {
856  SCIP_ROW* bestrow;
857  SCIP_COL** bestrownonzcols; /* columns with nonzero coefficients in best row to add */
858  SCIP_Real* bestrownonzcoefs; /* nonzero coefficients of columns in best row to add */
859  int nbestrownonzcols; /* number of columns with nonzero coefficients in best row to add */
860  SCIP_Real bestbounddist;
861  SCIP_Real bestscore;
862  int bestrowpos;
863  SCIP_Real aggrfac;
864  SCIP_Real absaggrfac;
865  int nzi;
866  int oldncuts;
867  int ncanceledcontnonzs;
868 
869  *wastried = TRUE;
870 
871 #ifdef SCIP_DEBUG
872  SCIPdebugMsg(scip, "aggregation of startrow %d and %d additional rows with %d integer and %d continuous variables (%d active):\n",
873  startrow, naggrs, naggrintnonzs, naggrcontnonzs, nactiveconts);
874  for( c = 0; c < ncols; ++c )
875  {
876  if( aggrcoefs[c] != 0.0 )
877  SCIPdebugMsgPrint(scip, " %+g<%s>(%g)", aggrcoefs[c], SCIPvarGetName(SCIPcolGetVar(cols[c])),
878  varsolvals[SCIPvarGetProbindex(SCIPcolGetVar(cols[c]))]);
879  }
880  SCIPdebugMsgPrint(scip, "\n");
881 #endif
882 
883  /* Step 1:
884  * try to generate a MIR cut out of the current aggregation
885  */
886  oldncuts = *ncuts;
887  SCIP_CALL( SCIPcutGenerationHeuristicCmir(scip, sepa, sol, varsolvals, sepadata->maxtestdelta, rowweights, maxweight,
888  weightinds, nweightinds, rowlensum, BOUNDSWITCH, USEVBDS, ALLOWLOCAL, sepadata->fixintegralrhs,
889  (int) MAXAGGRLEN(nvars), sepadata->maxrowfac, MINFRAC, MAXFRAC, sepadata->trynegscaling,
890  sepadata->dynamiccuts, "cmir", cutoff, ncuts, NULL, NULL) );
891 
892  if ( *cutoff )
893  break;
894 
895  /* if the cut was successfully added, abort the aggregation of further rows */
896  if( *ncuts > oldncuts )
897  {
898  SCIPdebugMsg(scip, " -> abort aggregation: cut found\n");
899  break;
900  }
901 
902  /* Step 2:
903  * aggregate an additional row in order to remove a continuous variable
904  */
905 
906  /* abort, if we reached the maximal number of aggregations */
907  if( naggrs == maxaggrs )
908  {
909  SCIPdebugMsg(scip, " -> abort aggregation: %s\n", nactiveconts == 0 ? "no more active continuous variables"
910  : "maximal number of aggregations reached");
911  break;
912  }
913 
914  SCIPdebugMsg(scip, " -> search column to eliminate\n");
915 
916  /* search for "best" continuous variable in aggregated row:
917  * - solution value is strictly between lower and upper bound
918  * - it exists a not yet aggregated row with nonzero coefficient in this column
919  * out of these variables:
920  * - prefer variables with larger distance of current solution value to its bounds
921  * - of those with large bound distance, prefer variables that can be eliminated with a row of high score
922  */
923  bestcol = NULL;
924  bestbounddist = -1.0;
925  bestscore = 0.0;
926  bestrow = NULL;
927  aggrfac = 0.0;
928  for( nzi = 0; nzi < naggrcontnonzs; ++nzi )
929  {
930  SCIP_COL* col;
931  SCIP_VAR* var;
932  SCIP_Real bounddist;
933 
934  c = aggrcontnonzposs[nzi];
935  assert(0 <= c && c < ncols);
936  assert(!SCIPisZero(scip, aggrcoefs[c]));
937 
938  col = cols[c];
939  var = SCIPcolGetVar(col);
940  assert(varIsContinuous(var));
941  assert(SCIPvarGetProbindex(var) >= nintvars);
942 
943  bounddist = aggrcontnonzbounddists[nzi];
944  assert(SCIPisEQ(scip, bounddist, getBounddist(scip, nintvars, varsolvals, bestcontlbs, bestcontubs, var)));
945  assert(bounddist <= bestbounddist || bestbounddist == -1.0);
946 
947  /* check, if variable is candidate to be the new best variable */
948  if( bounddist >= bestbounddist - sepadata->aggrtol )
949  {
950  SCIP_ROW** nonzrows;
951  SCIP_Real* nonzcoefs;
952  SCIP_Real maxrowscore;
953  int nnonzrows;
954  int probindex;
955 
956  probindex = SCIPvarGetProbindex(var);
957  assert(probindex >= nintvars);
958 
959  SCIPdebugMsg(scip, " -> col <%s>[%g,%g]: sol=%g, dist=%g\n", SCIPvarGetName(var), bestcontlbs[probindex - nintvars],
960  bestcontubs[probindex - nintvars], varsolvals[probindex], bounddist);
961 
962  /* if we know that we will not find a better row, just skip the column */
963  if( contvarscorebounds[probindex - nintvars] <= bestscore )
964  continue;
965 
966  /* look for "best" row to add (minimal slack), but don't add rows again,
967  * that are already involved in aggregation
968  */
969  nnonzrows = SCIPcolGetNLPNonz(col);
970  nonzrows = SCIPcolGetRows(col);
971  nonzcoefs = SCIPcolGetVals(col);
972  maxrowscore = 0.0;
973 
974  for( r = 0; r < nnonzrows; r++ )
975  {
976  SCIP_Real score;
977  SCIP_Real rowscore;
978  SCIP_Real factor;
979  SCIP_Real absfactor;
980  SCIP_Real activity;
981  SCIP_Real lhs;
982  SCIP_Real rhs;
983  SCIP_Real rowlhsscore;
984  SCIP_Real rowrhsscore;
985  int lppos;
986 
987  lppos = SCIProwGetLPPos(nonzrows[r]);
988  assert(0 <= lppos && lppos < nrows);
989 
990  SCIPdebugMsg(scip, " -> r=%d row <%s>: weight=%g, pos=%d, alpha_j=%g, a^r_j=%g, factor=%g, %g <= %g <= %g\n",
991  r, SCIProwGetName(nonzrows[r]), rowweights[lppos], lppos, aggrcoefs[c], nonzcoefs[r],
992  - aggrcoefs[c] / nonzcoefs[r], SCIProwGetLhs(nonzrows[r]),
993  SCIPgetRowSolActivity(scip, nonzrows[r], sol), SCIProwGetRhs(nonzrows[r]));
994 
995  /* update maxrowscore */
996  rowlhsscore = rowlhsscores[lppos];
997  rowrhsscore = rowrhsscores[lppos];
998  rowscore = MAX(rowlhsscore, rowrhsscore);
999  maxrowscore = MAX(maxrowscore, rowscore);
1000 
1001  /* if even the better rowscore does not improve the bestscore, ignore the row */
1002  if( rowscore <= bestscore )
1003  continue;
1004 
1005  /* take only unmodifiable LP rows, that are not yet aggregated */
1006  if( rowweights[lppos] != 0.0 || SCIProwIsModifiable(nonzrows[r]) )
1007  continue;
1008 
1009  /* don't aggregate rows that would lead to a too extreme aggregation factor */
1010  factor = - aggrcoefs[c] / nonzcoefs[r];
1011  absfactor = REALABS(factor);
1012  if( !SCIPisPositive(scip, absfactor)
1013  || absfactor > sepadata->maxrowfac * minweight
1014  || maxweight > sepadata->maxrowfac * absfactor )
1015  continue;
1016 
1017  /* for selected real variable y_k, select constraint r with best score SCORE_r with r in P\Q,
1018  * where P\Q is the set of constraints not yet involved in the aggregation set
1019  */
1020  assert(!SCIPisInfinity(scip, -SCIProwGetLhs(nonzrows[r])) || rowlhsscores[lppos] == 0.0);
1021  assert(!SCIPisInfinity(scip, SCIProwGetRhs(nonzrows[r])) || rowrhsscores[lppos] == 0.0);
1022  score = (factor < 0.0 ? rowlhsscore : rowrhsscore);
1023  if( score <= bestscore )
1024  continue;
1025 
1026  /* check, if the row's slack multiplied with the aggregation factor is too large */
1027  activity = SCIPgetRowSolActivity(scip, nonzrows[r], sol);
1028  lhs = SCIProwGetLhs(nonzrows[r]);
1029  rhs = SCIProwGetRhs(nonzrows[r]);
1030  if( (factor < 0.0 && SCIPisGT(scip, factor * (lhs - activity), maxslack))
1031  || (factor > 0.0 && SCIPisGT(scip, factor * (rhs - activity), maxslack)) )
1032  continue;
1033 
1034  /* the row passed all tests: it is the best candidate up to now */
1035  bestbounddist = bounddist;
1036  bestscore = score;
1037  bestcol = col;
1038  bestrow = nonzrows[r];
1039  aggrfac = factor;
1040  SCIPdebugMsg(scip, " -> col <%s>: %g * row <%s>, bounddist=%g, score=%g\n",
1041  SCIPvarGetName(SCIPcolGetVar(bestcol)), aggrfac, SCIProwGetName(bestrow), bestbounddist, score);
1042  }
1043 
1044  /* update score bound of column */
1045  assert(maxrowscore <= contvarscorebounds[probindex - nintvars]);
1046  contvarscorebounds[probindex - nintvars] = maxrowscore;
1047  }
1048  else
1049  {
1050  /* since the nonzero continuous variables are sorted by bound distance, we can abort now */
1051  break;
1052  }
1053  }
1054  assert((bestcol == NULL) == (bestrow == NULL));
1055 
1056 #ifndef NDEBUG
1057  /* check that the remaining variables really can be ignored */
1058  for( ; nzi < naggrcontnonzs; ++nzi )
1059  {
1060  SCIP_COL* col;
1061  SCIP_VAR* var;
1062  SCIP_Real bounddist;
1063 
1064  c = aggrcontnonzposs[nzi];
1065  assert(0 <= c && c < ncols);
1066  assert(!SCIPisZero(scip, aggrcoefs[c]));
1067 
1068  col = cols[c];
1069  var = SCIPcolGetVar(col);
1070  assert(varIsContinuous(var));
1071 
1072  bounddist = aggrcontnonzbounddists[nzi];
1073 
1074  SCIPdebugMsg(scip, " -> ignoring col <%s>[%g,%g]: sol=%g, dist=%g\n",
1075  SCIPvarGetName(var), bestcontlbs[SCIPvarGetProbindex(var) - nintvars],
1076  bestcontubs[SCIPvarGetProbindex(var) - nintvars], varsolvals[SCIPvarGetProbindex(var)], bounddist);
1077 
1078  assert(SCIPisEQ(scip, bounddist, getBounddist(scip, nintvars, varsolvals, bestcontlbs, bestcontubs, var)));
1079  assert(bounddist < bestbounddist - sepadata->aggrtol);
1080  }
1081 #endif
1082 
1083  /* abort, if no row can be added to remove an additional active continuous variable */
1084  if( bestcol == NULL )
1085  {
1086  SCIPdebugMsg(scip, " -> abort aggregation: no removable column found\n");
1087  break;
1088  }
1089 
1090  /* Step 3: add row to aggregation */
1091  bestrowpos = SCIProwGetLPPos(bestrow);
1092  SCIPdebugMsg(scip, " -> adding %+g<%s> to eliminate variable <%s> (aggregation %d)\n",
1093  aggrfac, SCIProwGetName(bestrow), SCIPvarGetName(SCIPcolGetVar(bestcol)), naggrs+1);
1094  assert(rowweights[bestrowpos] == 0.0);
1095  assert(!SCIPisZero(scip, aggrfac));
1096 
1097  /* change row's aggregation weight */
1098  rowweights[bestrowpos] = aggrfac;
1099 
1100  /* build weights sparse representation */
1101  SCIPsortedvecInsertInt(weightinds, bestrowpos, &nweightinds, &indpos);
1102  rowlensum += SCIProwGetNNonz(rows[bestrowpos]);
1103 
1104  absaggrfac = REALABS(aggrfac);
1105  maxweight = MAX(maxweight, absaggrfac);
1106  minweight = MIN(minweight, absaggrfac);
1107 
1108  /* decrease score of aggregation row in order to not aggregate it again too soon */
1109  decreaseRowScore(scip, rowlhsscores, rowrhsscores, bestrowpos);
1110 
1111  /* change coefficients of aggregation and update the number of continuous variables */
1112  bestrownonzcols = SCIProwGetCols(bestrow);
1113  bestrownonzcoefs = SCIProwGetVals(bestrow);
1114  nbestrownonzcols = SCIProwGetNLPNonz(bestrow);
1115  ncanceledcontnonzs = 0;
1116  for( c = 0; c < nbestrownonzcols; c++ )
1117  {
1118  SCIP_VAR* var;
1119  int pos;
1120  SCIP_Bool iscont;
1121  SCIP_Bool waszero;
1122  SCIP_Bool iszero;
1123 
1124  var = SCIPcolGetVar(bestrownonzcols[c]);
1125  pos = SCIPcolGetLPPos(bestrownonzcols[c]);
1126  assert(pos >= 0);
1127  assert(!SCIPisZero(scip, bestrownonzcoefs[c]));
1128 
1129  iscont = varIsContinuous(var);
1130  waszero = (aggrcoefs[pos] == 0.0);
1131  aggrcoefs[pos] += bestrownonzcoefs[c] * aggrfac;
1132  iszero = SCIPisZero(scip, aggrcoefs[pos]);
1133 
1134  if( iszero )
1135  {
1136  aggrcoefs[pos] = 0.0;
1137  if( !waszero )
1138  {
1139  /* coefficient switched from non-zero to zero */
1140  if( iscont )
1141  {
1142  ncanceledcontnonzs++;
1143  /* naggrcontnonzs will be decreased later in a cleanup step */
1144  updateNActiveConts(scip, varsolvals, bestcontlbs, bestcontubs, nintvars, var, -1, &nactiveconts);
1145  }
1146  else
1147  naggrintnonzs--;
1148  }
1149  }
1150  else if( waszero )
1151  {
1152  /* coefficient switched from zero to non-zero */
1153  if( iscont )
1154  {
1155  SCIP_Real bounddist;
1156 
1157  assert(naggrcontnonzs < ncols);
1158 
1159  /* store continuous variable in array sorted by distance to closest bound */
1160  bounddist = getBounddist(scip, nintvars, varsolvals, bestcontlbs, bestcontubs, var);
1161  SCIPsortedvecInsertDownRealInt(aggrcontnonzbounddists, aggrcontnonzposs, bounddist, pos, &naggrcontnonzs, NULL);
1162 
1163  updateNActiveConts(scip, varsolvals, bestcontlbs, bestcontubs, nintvars, var, +1, &nactiveconts);
1164  }
1165  else
1166  naggrintnonzs++;
1167  }
1168  }
1169 
1170  /* remove canceled elements from aggtcontnonzs vector */
1171  if( ncanceledcontnonzs > 0 )
1172  {
1173  int newnaggrintnonzs;
1174 
1175  newnaggrintnonzs = 0;
1176  for( nzi = 0; nzi < naggrcontnonzs; ++nzi )
1177  {
1178  int pos;
1179 
1180  pos = aggrcontnonzposs[nzi];
1181  assert(0 <= pos && pos < ncols);
1182  if( aggrcoefs[pos] != 0.0 )
1183  {
1184  assert(newnaggrintnonzs <= nzi);
1185  aggrcontnonzposs[newnaggrintnonzs] = pos;
1186  aggrcontnonzbounddists[newnaggrintnonzs] = aggrcontnonzbounddists[nzi];
1187  newnaggrintnonzs++;
1188  }
1189  }
1190  assert(ncanceledcontnonzs == naggrcontnonzs - newnaggrintnonzs);
1191  naggrcontnonzs = newnaggrintnonzs;
1192  }
1193 
1194  naggrs++;
1195 
1196  SCIPdebugMsg(scip, " -> %d continuous variables left (%d/%d active), %d/%d nonzeros, %d/%d aggregations\n",
1197  naggrcontnonzs, nactiveconts, maxconts, naggrcontnonzs + naggrintnonzs, maxaggrnonzs, naggrs, maxaggrs);
1198  }
1199 #ifdef SCIP_DEBUG
1200  if( nactiveconts > maxconts )
1201  {
1202  SCIPdebugMsg(scip, " -> abort aggregation: %d/%d active continuous variables\n", nactiveconts, maxconts);
1203  }
1204  if( naggrcontnonzs + naggrintnonzs > maxaggrnonzs )
1205  {
1206  SCIPdebugMsg(scip, " -> abort aggregation: %d/%d nonzeros\n", naggrcontnonzs + naggrintnonzs, maxaggrnonzs);
1207  }
1208 #endif
1209 
1210  /* free datastructures */
1211  SCIPfreeBufferArray(scip, &weightinds);
1212  SCIPfreeBufferArray(scip, &rowweights);
1213  SCIPfreeBufferArray(scip, &aggrcontnonzbounddists);
1214  SCIPfreeBufferArray(scip, &aggrcontnonzposs);
1215  SCIPfreeBufferArray(scip, &aggrcoefs);
1216 
1217  return SCIP_OKAY;
1218 }
1219 
1220 /** searches and adds c-MIR cuts that separate the given primal solution */
1221 static
1223  SCIP* scip, /**< SCIP data structure */
1224  SCIP_SEPA* sepa, /**< the c-MIR separator */
1225  SCIP_SOL* sol, /**< the solution that should be separated, or NULL for LP solution */
1226  SCIP_RESULT* result /**< pointer to store the result */
1227  )
1228 {
1229  SCIP_SEPADATA* sepadata;
1230  SCIP_VAR** vars;
1231  SCIP_Real* varsolvals;
1232  SCIP_Real* bestcontlbs;
1233  SCIP_Real* bestcontubs;
1234  SCIP_Real* contvarscorebounds;
1235  SCIP_ROW** rows;
1236  SCIP_Real* rowlhsscores;
1237  SCIP_Real* rowrhsscores;
1238  SCIP_Real* rowscores;
1239  int* roworder;
1240  SCIP_Real maxslack;
1241  SCIP_Real objnorm;
1242  SCIP_Bool cutoff = FALSE;
1243  int nvars;
1244  int nintvars;
1245  int ncontvars;
1246  int nrows;
1247  int nnonzrows;
1248  int zerorows;
1249  int ntries;
1250  int nfails;
1251  int depth;
1252  int ncalls;
1253  int maxtries;
1254  int maxfails;
1255  int maxaggrs;
1256  int maxsepacuts;
1257  int maxconts;
1258  int ncuts;
1259  int r;
1260  int v;
1261 
1262  assert(result != NULL);
1263  assert(*result == SCIP_DIDNOTRUN);
1264 
1265  sepadata = SCIPsepaGetData(sepa);
1266  assert(sepadata != NULL);
1267 
1268  depth = SCIPgetDepth(scip);
1269  ncalls = SCIPsepaGetNCallsAtNode(sepa);
1270 
1271  /* only call the cmir cut separator a given number of times at each node */
1272  if( (depth == 0 && sepadata->maxroundsroot >= 0 && ncalls >= sepadata->maxroundsroot)
1273  || (depth > 0 && sepadata->maxrounds >= 0 && ncalls >= sepadata->maxrounds) )
1274  return SCIP_OKAY;
1275 
1276  /* get all rows and number of columns */
1277  SCIP_CALL( SCIPgetLPRowsData(scip, &rows, &nrows) );
1278  assert(nrows == 0 || rows != NULL);
1279 
1280  /* nothing to do, if LP is empty */
1281  if( nrows == 0 )
1282  return SCIP_OKAY;
1283 
1284  /* check whether SCIP was stopped in the meantime */
1285  if( SCIPisStopped(scip) )
1286  return SCIP_OKAY;
1287 
1288  /* get active problem variables */
1289  vars = SCIPgetVars(scip);
1290  nvars = SCIPgetNVars(scip);
1291  ncontvars = SCIPgetNContVars(scip);
1292 #ifdef IMPLINTSARECONT
1293  ncontvars += SCIPgetNImplVars(scip); /* also aggregate out implicit integers */
1294 #endif
1295  nintvars = nvars-ncontvars;
1296  assert(nvars == 0 || vars != NULL);
1297 
1298  /* nothing to do, if problem has no variables */
1299  if( nvars == 0 )
1300  return SCIP_OKAY;
1301 
1302  SCIPdebugMsg(scip, "separating c-MIR cuts\n");
1303 
1304  *result = SCIP_DIDNOTFIND;
1305 
1306  /* get data structure */
1307  SCIP_CALL( SCIPallocBufferArray(scip, &rowlhsscores, nrows) );
1308  SCIP_CALL( SCIPallocBufferArray(scip, &rowrhsscores, nrows) );
1309  SCIP_CALL( SCIPallocBufferArray(scip, &rowscores, nrows) );
1310  SCIP_CALL( SCIPallocBufferArray(scip, &roworder, nrows) );
1311  SCIP_CALL( SCIPallocBufferArray(scip, &varsolvals, nvars) );
1312  SCIP_CALL( SCIPallocBufferArray(scip, &bestcontlbs, ncontvars) );
1313  SCIP_CALL( SCIPallocBufferArray(scip, &bestcontubs, ncontvars) );
1314  SCIP_CALL( SCIPallocBufferArray(scip, &contvarscorebounds, ncontvars) );
1315 
1316  /* get the solution values for all active variables */
1317  SCIP_CALL( SCIPgetSolVals(scip, sol, nvars, vars, varsolvals) );
1318 
1319  /* calculate the tightest bounds w.r.t. current solution for the continuous variables */
1320  for( v = nintvars; v < nvars; ++v )
1321  {
1322  SCIP_Real bestlb;
1323  SCIP_Real bestub;
1324  SCIP_Real bestvlb;
1325  SCIP_Real bestvub;
1326  int bestvlbidx;
1327  int bestvubidx;
1328 
1329 #if ALLOWLOCAL == 1
1330  bestlb = SCIPvarGetLbLocal(vars[v]);
1331  bestub = SCIPvarGetUbLocal(vars[v]);
1332 #else
1333  bestlb = SCIPvarGetLbGlobal(vars[v]);
1334  bestub = SCIPvarGetUbGlobal(vars[v]);
1335 #endif
1336  SCIP_CALL( SCIPgetVarClosestVlb(scip, vars[v], sol, &bestvlb, &bestvlbidx) );
1337  SCIP_CALL( SCIPgetVarClosestVub(scip, vars[v], sol, &bestvub, &bestvubidx) );
1338  if( bestvlbidx >= 0 )
1339  bestlb = MAX(bestlb, bestvlb);
1340  if( bestvubidx >= 0 )
1341  bestub = MIN(bestub, bestvub);
1342 
1343  bestcontlbs[v-nintvars] = bestlb;
1344  bestcontubs[v-nintvars] = bestub;
1345 
1346  /* initialize row score bounds for continuous variables */
1347  contvarscorebounds[v-nintvars] = SCIP_REAL_MAX;
1348  }
1349 
1350  /* get the maximal number of cuts allowed in a separation round */
1351  if( depth == 0 )
1352  {
1353  maxtries = sepadata->maxtriesroot;
1354  maxfails = sepadata->maxfailsroot;
1355  maxaggrs = sepadata->maxaggrsroot;
1356  maxsepacuts = sepadata->maxsepacutsroot;
1357  maxslack = sepadata->maxslackroot;
1358  maxconts = sepadata->maxcontsroot;
1359  }
1360  else
1361  {
1362  maxtries = sepadata->maxtries;
1363  maxfails = sepadata->maxfails;
1364  maxaggrs = sepadata->maxaggrs;
1365  maxsepacuts = sepadata->maxsepacuts;
1366  maxslack = sepadata->maxslack;
1367  maxconts = sepadata->maxconts;
1368  }
1369 
1370  /* calculate aggregation scores for both sides of all rows, and sort rows by nonincreasing maximal score */
1371  objnorm = SCIPgetObjNorm(scip);
1372  objnorm = MAX(objnorm, 1.0);
1373 
1374  /* count the number of non-zero rows and zero rows.
1375  * these values are used for the sorting of the rowscores.
1376  * only the non-zero rows need to be sorted. */
1377  nnonzrows = 0;
1378  zerorows = 0;
1379  for( r = 0; r < nrows; r++ )
1380  {
1381  int nnonz;
1382  int i;
1383 
1384  assert(SCIProwGetLPPos(rows[r]) == r);
1385 
1386  nnonz = SCIProwGetNLPNonz(rows[r]);
1387  if( nnonz == 0 )
1388  {
1389  /* ignore empty rows */
1390  rowlhsscores[r] = 0.0;
1391  rowrhsscores[r] = 0.0;
1392 
1393  /* adding the row number to the back of the roworder
1394  * for the zero rows */
1395  zerorows++;
1396  rowscores[r] = 0.0;
1397  roworder[nrows - zerorows] = r;
1398  }
1399  else
1400  {
1401  SCIP_Real activity;
1402  SCIP_Real lhs;
1403  SCIP_Real rhs;
1404  SCIP_Real dualsol;
1405  SCIP_Real dualscore;
1406  SCIP_Real rowdensity;
1407  SCIP_Real rownorm;
1408  SCIP_Real slack;
1409 
1410  dualsol = (sol == NULL ? SCIProwGetDualsol(rows[r]) : 1.0);
1411  activity = SCIPgetRowSolActivity(scip, rows[r], sol);
1412  lhs = SCIProwGetLhs(rows[r]);
1413  rhs = SCIProwGetRhs(rows[r]);
1414  rownorm = SCIProwGetNorm(rows[r]);
1415  rownorm = MAX(rownorm, 0.1);
1416  rowdensity = (SCIP_Real)(nnonz - sepadata->densityoffset)/(SCIP_Real)nvars;
1417  assert(SCIPisPositive(scip, rownorm));
1418 
1419  slack = (activity - lhs)/rownorm;
1420  dualscore = MAX(dualsol/objnorm, 0.0001);
1421  if( !SCIPisInfinity(scip, -lhs) && SCIPisLE(scip, slack, maxslack)
1422  && (ALLOWLOCAL || !SCIProwIsLocal(rows[r])) /*lint !e506 !e774*/
1423  && rowdensity <= sepadata->maxrowdensity
1424  && rowdensity <= sepadata->maxaggdensity ) /*lint !e774*/
1425  {
1426  rowlhsscores[r] = dualscore + sepadata->densityscore * (1.0-rowdensity)
1427  + sepadata->slackscore * MAX(1.0 - slack, 0.0);
1428  assert(rowlhsscores[r] > 0.0);
1429  }
1430  else
1431  rowlhsscores[r] = 0.0;
1432 
1433  slack = (rhs - activity)/rownorm;
1434  dualscore = MAX(-dualsol/objnorm, 0.0001);
1435  if( !SCIPisInfinity(scip, rhs) && SCIPisLE(scip, slack, maxslack)
1436  && (ALLOWLOCAL || !SCIProwIsLocal(rows[r])) /*lint !e506 !e774*/
1437  && rowdensity <= sepadata->maxrowdensity
1438  && rowdensity <= sepadata->maxaggdensity ) /*lint !e774*/
1439  {
1440  rowrhsscores[r] = dualscore + sepadata->densityscore * (1.0-rowdensity)
1441  + sepadata->slackscore * MAX(1.0 - slack, 0.0);
1442  assert(rowrhsscores[r] > 0.0);
1443  }
1444  else
1445  rowrhsscores[r] = 0.0;
1446 
1447  rowscores[r] = MAX(rowlhsscores[r], rowrhsscores[r]);
1448  if( rowscores[r] == 0.0 )
1449  {
1450  /* adding the row number to the back of the roworder
1451  * for the zero rows */
1452  zerorows++;
1453  roworder[nrows - zerorows] = r;
1454  }
1455  else
1456  {
1457  /* adding and sorting the row number to the next index
1458  * in roworder <= nnonzrows */
1459  for( i = nnonzrows; i > 0 && rowscores[r] > rowscores[roworder[i - 1]]; --i )
1460  roworder[i] = roworder[i - 1];
1461  roworder[i] = r;
1462 
1463  nnonzrows++;
1464  }
1465  }
1466 
1467  SCIPdebugMsg(scip, " -> row %d <%s>: lhsscore=%g rhsscore=%g maxscore=%g\n", r, SCIProwGetName(rows[r]), rowlhsscores[r], rowrhsscores[r], rowscores[r]);
1468  }
1469  assert(nrows == nnonzrows + zerorows);
1470 
1471  /* start aggregation heuristic for each row in the LP */
1472  ncuts = 0;
1473  if( maxtries < 0 )
1474  maxtries = INT_MAX;
1475  if( maxfails < 0 )
1476  maxfails = INT_MAX;
1477  else if( depth == 0 && 2*SCIPgetNSepaRounds(scip) < maxfails )
1478  maxfails += maxfails - 2*SCIPgetNSepaRounds(scip); /* allow up to double as many fails in early separounds of root node */
1479  ntries = 0;
1480  nfails = 0;
1481  for( r = 0; r < nrows && ntries < maxtries && ncuts < maxsepacuts && rowscores[roworder[r]] > 0.0
1482  && !SCIPisStopped(scip); r++ )
1483  {
1484  SCIP_Bool wastried;
1485  int oldncuts;
1486 
1487  oldncuts = ncuts;
1488  SCIP_CALL( aggregation(scip, sepa, sepadata, sol, varsolvals, bestcontlbs, bestcontubs, contvarscorebounds,
1489  rowlhsscores, rowrhsscores, roworder[r], maxaggrs, maxslack, maxconts, &wastried, &cutoff, &ncuts) );
1490  if ( cutoff )
1491  break;
1492 
1493  if( !wastried )
1494  continue;
1495  ntries++;
1496 
1497  if( ncuts == oldncuts )
1498  {
1499  nfails++;
1500  if( nfails >= maxfails )
1501  break;
1502  }
1503  else
1504  nfails = 0;
1505  }
1506 
1507  /* free data structure */
1508  SCIPfreeBufferArray(scip, &contvarscorebounds);
1509  SCIPfreeBufferArray(scip, &bestcontubs);
1510  SCIPfreeBufferArray(scip, &bestcontlbs);
1511  SCIPfreeBufferArray(scip, &varsolvals);
1512  SCIPfreeBufferArray(scip, &roworder);
1513  SCIPfreeBufferArray(scip, &rowscores);
1514  SCIPfreeBufferArray(scip, &rowrhsscores);
1515  SCIPfreeBufferArray(scip, &rowlhsscores);
1516 
1517  if ( cutoff )
1518  *result = SCIP_CUTOFF;
1519  else if ( ncuts > 0 )
1520  *result = SCIP_SEPARATED;
1521 
1522  return SCIP_OKAY;
1523 }
1524 
1525 
1526 /*
1527  * Callback methods of separator
1528  */
1529 
1530 /** copy method for separator plugins (called when SCIP copies plugins) */
1531 static
1532 SCIP_DECL_SEPACOPY(sepaCopyCmir)
1533 { /*lint --e{715}*/
1534  assert(scip != NULL);
1535  assert(sepa != NULL);
1536  assert(strcmp(SCIPsepaGetName(sepa), SEPA_NAME) == 0);
1537 
1538  /* call inclusion method of constraint handler */
1539  SCIP_CALL( SCIPincludeSepaCmir(scip) );
1540 
1541  return SCIP_OKAY;
1542 }
1543 
1544 /** destructor of separator to free user data (called when SCIP is exiting) */
1545 static
1546 SCIP_DECL_SEPAFREE(sepaFreeCmir)
1547 { /*lint --e{715}*/
1548  SCIP_SEPADATA* sepadata;
1549 
1550  /* free separator data */
1551  sepadata = SCIPsepaGetData(sepa);
1552  assert(sepadata != NULL);
1553 
1554  SCIPfreeBlockMemory(scip, &sepadata);
1555 
1556  SCIPsepaSetData(sepa, NULL);
1557 
1558  return SCIP_OKAY;
1559 }
1560 
1561 
1562 /** LP solution separation method of separator */
1563 static
1564 SCIP_DECL_SEPAEXECLP(sepaExeclpCmir)
1565 { /*lint --e{715}*/
1566 
1567  *result = SCIP_DIDNOTRUN;
1569  /* only call separator, if we are not close to terminating */
1570  if( SCIPisStopped(scip) )
1571  return SCIP_OKAY;
1572 
1573  /* only call separator, if an optimal LP solution is at hand */
1575  return SCIP_OKAY;
1576 
1577  /* only call separator, if there are fractional variables */
1578  if( SCIPgetNLPBranchCands(scip) == 0 )
1579  return SCIP_OKAY;
1580 
1581  SCIP_CALL( separateCuts(scip, sepa, NULL, result) );
1582 
1583  return SCIP_OKAY;
1584 }
1585 
1586 
1587 /** arbitrary primal solution separation method of separator */
1588 static
1589 SCIP_DECL_SEPAEXECSOL(sepaExecsolCmir)
1590 { /*lint --e{715}*/
1591 
1592  *result = SCIP_DIDNOTRUN;
1594  SCIP_CALL( separateCuts(scip, sepa, sol, result) );
1595 
1596  return SCIP_OKAY;
1597 }
1598 
1599 
1600 /*
1601  * separator specific interface methods
1602  */
1603 
1604 /** creates the cmir separator and includes it in SCIP */
1606  SCIP* scip /**< SCIP data structure */
1607  )
1608 {
1609  SCIP_SEPADATA* sepadata;
1610  SCIP_SEPA* sepa;
1611 
1612  /* create cmir separator data */
1613  SCIP_CALL( SCIPallocBlockMemory(scip, &sepadata) );
1614 
1615  /* include separator */
1618  sepaExeclpCmir, sepaExecsolCmir,
1619  sepadata) );
1620 
1621  assert(sepa != NULL);
1622 
1623  /* set non-NULL pointers to callback methods */
1624  SCIP_CALL( SCIPsetSepaCopy(scip, sepa, sepaCopyCmir) );
1625  SCIP_CALL( SCIPsetSepaFree(scip, sepa, sepaFreeCmir) );
1626 
1627  /* add cmir separator parameters */
1628  SCIP_CALL( SCIPaddIntParam(scip,
1629  "separating/cmir/maxrounds",
1630  "maximal number of cmir separation rounds per node (-1: unlimited)",
1631  &sepadata->maxrounds, FALSE, DEFAULT_MAXROUNDS, -1, INT_MAX, NULL, NULL) );
1632  SCIP_CALL( SCIPaddIntParam(scip,
1633  "separating/cmir/maxroundsroot",
1634  "maximal number of cmir separation rounds in the root node (-1: unlimited)",
1635  &sepadata->maxroundsroot, FALSE, DEFAULT_MAXROUNDSROOT, -1, INT_MAX, NULL, NULL) );
1636  SCIP_CALL( SCIPaddIntParam(scip,
1637  "separating/cmir/maxtries",
1638  "maximal number of rows to start aggregation with per separation round (-1: unlimited)",
1639  &sepadata->maxtries, TRUE, DEFAULT_MAXTRIES, -1, INT_MAX, NULL, NULL) );
1640  SCIP_CALL( SCIPaddIntParam(scip,
1641  "separating/cmir/maxtriesroot",
1642  "maximal number of rows to start aggregation with per separation round in the root node (-1: unlimited)",
1643  &sepadata->maxtriesroot, TRUE, DEFAULT_MAXTRIESROOT, -1, INT_MAX, NULL, NULL) );
1644  SCIP_CALL( SCIPaddIntParam(scip,
1645  "separating/cmir/maxfails",
1646  "maximal number of consecutive unsuccessful aggregation tries (-1: unlimited)",
1647  &sepadata->maxfails, TRUE, DEFAULT_MAXFAILS, -1, INT_MAX, NULL, NULL) );
1648  SCIP_CALL( SCIPaddIntParam(scip,
1649  "separating/cmir/maxfailsroot",
1650  "maximal number of consecutive unsuccessful aggregation tries in the root node (-1: unlimited)",
1651  &sepadata->maxfailsroot, TRUE, DEFAULT_MAXFAILSROOT, -1, INT_MAX, NULL, NULL) );
1652  SCIP_CALL( SCIPaddIntParam(scip,
1653  "separating/cmir/maxaggrs",
1654  "maximal number of aggregations for each row per separation round",
1655  &sepadata->maxaggrs, TRUE, DEFAULT_MAXAGGRS, 0, INT_MAX, NULL, NULL) );
1656  SCIP_CALL( SCIPaddIntParam(scip,
1657  "separating/cmir/maxaggrsroot",
1658  "maximal number of aggregations for each row per separation round in the root node",
1659  &sepadata->maxaggrsroot, TRUE, DEFAULT_MAXAGGRSROOT, 0, INT_MAX, NULL, NULL) );
1660  SCIP_CALL( SCIPaddIntParam(scip,
1661  "separating/cmir/maxsepacuts",
1662  "maximal number of cmir cuts separated per separation round",
1663  &sepadata->maxsepacuts, FALSE, DEFAULT_MAXSEPACUTS, 0, INT_MAX, NULL, NULL) );
1664  SCIP_CALL( SCIPaddIntParam(scip,
1665  "separating/cmir/maxsepacutsroot",
1666  "maximal number of cmir cuts separated per separation round in the root node",
1667  &sepadata->maxsepacutsroot, FALSE, DEFAULT_MAXSEPACUTSROOT, 0, INT_MAX, NULL, NULL) );
1669  "separating/cmir/maxslack",
1670  "maximal slack of rows to be used in aggregation",
1671  &sepadata->maxslack, TRUE, DEFAULT_MAXSLACK, 0.0, SCIP_REAL_MAX, NULL, NULL) );
1673  "separating/cmir/maxslackroot",
1674  "maximal slack of rows to be used in aggregation in the root node",
1675  &sepadata->maxslackroot, TRUE, DEFAULT_MAXSLACKROOT, 0.0, SCIP_REAL_MAX, NULL, NULL) );
1677  "separating/cmir/densityscore",
1678  "weight of row density in the aggregation scoring of the rows",
1679  &sepadata->densityscore, TRUE, DEFAULT_DENSITYSCORE, 0.0, SCIP_REAL_MAX, NULL, NULL) );
1681  "separating/cmir/slackscore",
1682  "weight of slack in the aggregation scoring of the rows",
1683  &sepadata->slackscore, TRUE, DEFAULT_SLACKSCORE, 0.0, SCIP_REAL_MAX, NULL, NULL) );
1685  "separating/cmir/maxaggdensity",
1686  "maximal density of aggregated row",
1687  &sepadata->maxaggdensity, TRUE, DEFAULT_MAXAGGDENSITY, 0.0, 1.0, NULL, NULL) );
1689  "separating/cmir/maxrowdensity",
1690  "maximal density of row to be used in aggregation",
1691  &sepadata->maxrowdensity, TRUE, DEFAULT_MAXROWDENSITY, 0.0, 1.0, NULL, NULL) );
1692  SCIP_CALL( SCIPaddIntParam(scip,
1693  "separating/cmir/densityoffset",
1694  "additional number of variables allowed in row on top of density",
1695  &sepadata->densityoffset, TRUE, DEFAULT_DENSITYOFFSET, 0, INT_MAX, NULL, NULL) );
1697  "separating/cmir/maxrowfac",
1698  "maximal row aggregation factor",
1699  &sepadata->maxrowfac, TRUE, DEFAULT_MAXROWFAC, 0.0, SCIP_REAL_MAX, NULL, NULL) );
1700  SCIP_CALL( SCIPaddIntParam(scip,
1701  "separating/cmir/maxtestdelta",
1702  "maximal number of different deltas to try (-1: unlimited)",
1703  &sepadata->maxtestdelta, TRUE, DEFAULT_MAXTESTDELTA, -1, INT_MAX, NULL, NULL) );
1704  SCIP_CALL( SCIPaddIntParam(scip,
1705  "separating/cmir/maxconts",
1706  "maximal number of active continuous variables in aggregated row",
1707  &sepadata->maxconts, TRUE, DEFAULT_MAXCONTS, 0, INT_MAX, NULL, NULL) );
1708  SCIP_CALL( SCIPaddIntParam(scip,
1709  "separating/cmir/maxcontsroot",
1710  "maximal number of active continuous variables in aggregated row in the root node",
1711  &sepadata->maxcontsroot, TRUE, DEFAULT_MAXCONTSROOT, 0, INT_MAX, NULL, NULL) );
1713  "separating/cmir/aggrtol",
1714  "tolerance for bound distances used to select continuous variable in current aggregated constraint to be eliminated",
1715  &sepadata->aggrtol, TRUE, DEFAULT_AGGRTOL, 0.0, SCIP_REAL_MAX, NULL, NULL) );
1717  "separating/cmir/trynegscaling",
1718  "should negative values also be tested in scaling?",
1719  &sepadata->trynegscaling, TRUE, DEFAULT_TRYNEGSCALING, NULL, NULL) );
1721  "separating/cmir/fixintegralrhs",
1722  "should an additional variable be complemented if f0 = 0?",
1723  &sepadata->fixintegralrhs, TRUE, DEFAULT_FIXINTEGRALRHS, NULL, NULL) );
1725  "separating/cmir/dynamiccuts",
1726  "should generated cuts be removed from the LP if they are no longer tight?",
1727  &sepadata->dynamiccuts, FALSE, DEFAULT_DYNAMICCUTS, NULL, NULL) );
1728 
1729  return SCIP_OKAY;
1730 }
enum SCIP_Result SCIP_RESULT
Definition: type_result.h:52
SCIP_RETCODE SCIPincludeSepaCmir(SCIP *scip)
Definition: sepa_cmir.c:1609
SCIP_Bool SCIPisFeasZero(SCIP *scip, SCIP_Real val)
Definition: scip.c:46151
static SCIP_DECL_SEPAEXECSOL(sepaExecsolCmir)
Definition: sepa_cmir.c:1593
void SCIPsortedvecInsertDownRealInt(SCIP_Real *realarray, int *intarray, SCIP_Real keyval, int field1val, int *len, int *pos)
static void decreaseRowScore(SCIP *scip, SCIP_Real *rowlhsscores, SCIP_Real *rowrhsscores, int rowidx)
Definition: sepa_cmir.c:319
#define USEVBDS
Definition: sepa_cmir.c:74
static void updateNActiveConts(SCIP *scip, SCIP_Real *varsolvals, SCIP_Real *bestcontlbs, SCIP_Real *bestcontubs, int nintvars, SCIP_VAR *var, int delta, int *nactiveconts)
Definition: sepa_cmir.c:285
SCIP_Real SCIPvarGetLbGlobal(SCIP_VAR *var)
Definition: var.c:17166
#define SCIP_MAXSTRLEN
Definition: def.h:215
SCIP_Real * SCIPcolGetVals(SCIP_COL *col)
Definition: lp.c:16190
int SCIProwGetNNonz(SCIP_ROW *row)
Definition: lp.c:16232
SCIP_Bool SCIPisPositive(SCIP *scip, SCIP_Real val)
Definition: scip.c:45876
SCIP_Real SCIPvarGetLbLocal(SCIP_VAR *var)
Definition: var.c:17222
SCIP_Bool SCIPisGE(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
Definition: scip.c:45803
const char * SCIProwGetName(SCIP_ROW *row)
Definition: lp.c:16370
static SCIP_DECL_SEPACOPY(sepaCopyCmir)
Definition: sepa_cmir.c:1536
#define DEFAULT_MAXCONTS
Definition: sepa_cmir.c:64
int SCIProwGetNLPNonz(SCIP_ROW *row)
Definition: lp.c:16246
SCIP_RETCODE SCIPgetVarsData(SCIP *scip, SCIP_VAR ***vars, int *nvars, int *nbinvars, int *nintvars, int *nimplvars, int *ncontvars)
Definition: scip.c:11505
SCIP_Real SCIProwGetLhs(SCIP_ROW *row)
Definition: lp.c:16311
#define FALSE
Definition: def.h:64
#define DEFAULT_TRYNEGSCALING
Definition: sepa_cmir.c:69
SCIP_Real SCIPinfinity(SCIP *scip)
Definition: scip.c:45816
int SCIPsnprintf(char *t, int len, const char *s,...)
Definition: misc.c:9340
#define TRUE
Definition: def.h:63
#define SCIPdebug(x)
Definition: pub_message.h:74
const char * SCIPsepaGetName(SCIP_SEPA *sepa)
Definition: sepa.c:632
enum SCIP_Retcode SCIP_RETCODE
Definition: type_retcode.h:53
#define DEFAULT_SLACKSCORE
Definition: sepa_cmir.c:58
int SCIPvarGetProbindex(SCIP_VAR *var)
Definition: var.c:16859
#define SEPA_USESSUBSCIP
Definition: sepa_cmir.c:36
SCIP_Real SCIPgetVectorEfficacyNorm(SCIP *scip, SCIP_Real *vals, int nvals)
Definition: scip.c:33793
#define DEFAULT_MAXFAILS
Definition: sepa_cmir.c:47
SCIP_RETCODE SCIPcalcMIR(SCIP *scip, SCIP_SOL *sol, SCIP_Real boundswitch, SCIP_Bool usevbds, SCIP_Bool allowlocal, SCIP_Bool fixintegralrhs, int *boundsfortrans, SCIP_BOUNDTYPE *boundtypesfortrans, int maxmksetcoefs, SCIP_Real maxweightrange, SCIP_Real minfrac, SCIP_Real maxfrac, SCIP_Real *weights, SCIP_Real maxweight, int *weightinds, int nweightinds, int rowlensum, int *sidetypes, SCIP_Real scale, SCIP_Real *mksetcoefs, SCIP_Bool *mksetcoefsvalid, SCIP_Real *mircoef, SCIP_Real *mirrhs, SCIP_Real *cutactivity, SCIP_Bool *success, SCIP_Bool *cutislocal, int *cutrank)
Definition: scip.c:29473
#define SCIPfreeBlockMemory(scip, ptr)
Definition: scip.h:21907
static SCIP_RETCODE tryDelta(SCIP *scip, SCIP_SOL *sol, int nvars, SCIP_Real *rowweights, SCIP_Real maxweight, int *weightinds, int nweightinds, int rowlensum, SCIP_Real *cutcoefs, SCIP_Real *mksetcoefs, SCIP_Bool *mksetcoefsvalid, SCIP_Real *testeddeltas, int *ntesteddeltas, SCIP_Real delta, SCIP_Real boundswitch, SCIP_Bool usevbds, SCIP_Bool allowlocal, SCIP_Bool fixintegralrhs, int maxmksetcoefs, SCIP_Real maxweightrange, SCIP_Real minfrac, SCIP_Real maxfrac, SCIP_Real *bestdelta, SCIP_Real *bestefficacy)
Definition: sepa_cmir.c:339
static SCIP_Real getBounddist(SCIP *scip, int nintvars, SCIP_Real *varsolvals, SCIP_Real *bestcontlbs, SCIP_Real *bestcontubs, SCIP_VAR *var)
Definition: sepa_cmir.c:653
#define DEFAULT_MAXAGGDENSITY
Definition: sepa_cmir.c:59
#define MINFRAC
Definition: sepa_cmir.c:76
SCIP_Bool SCIPisEQ(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
Definition: scip.c:45751
#define DEFAULT_MAXAGGRS
Definition: sepa_cmir.c:51
#define SCIPfreeBufferArray(scip, ptr)
Definition: scip.h:21937
#define SCIPallocBlockMemory(scip, ptr)
Definition: scip.h:21890
int SCIPgetNLPBranchCands(SCIP *scip)
Definition: scip.c:36161
SCIP_RETCODE SCIPgetLPColsData(SCIP *scip, SCIP_COL ***cols, int *ncols)
Definition: scip.c:29087
SCIP_RETCODE SCIPsetSepaCopy(SCIP *scip, SCIP_SEPA *sepa, SCIP_DECL_SEPACOPY((*sepacopy)))
Definition: scip.c:7367
SCIP_Real SCIProwGetDualsol(SCIP_ROW *row)
Definition: lp.c:16331
#define SCIPdebugMsgPrint
Definition: scip.h:452
#define SCIPdebugMsg
Definition: scip.h:451
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.c:4202
int SCIPgetNContVars(SCIP *scip)
Definition: scip.c:11811
SCIP_Real SCIPgetObjNorm(SCIP *scip)
Definition: scip.c:11284
SCIP_Real SCIPepsilon(SCIP *scip)
Definition: scip.c:45246
SCIP_RETCODE SCIPgetVarClosestVlb(SCIP *scip, SCIP_VAR *var, SCIP_SOL *sol, SCIP_Real *closestvlb, int *closestvlbidx)
Definition: scip.c:23516
SCIP_Real SCIPgetRowMaxCoef(SCIP *scip, SCIP_ROW *row)
Definition: scip.c:30491
#define DEFAULT_FIXINTEGRALRHS
Definition: sepa_cmir.c:70
SCIP_SEPADATA * SCIPsepaGetData(SCIP_SEPA *sepa)
Definition: sepa.c:543
#define ALLOWLOCAL
Definition: sepa_cmir.c:75
#define DEFAULT_MAXROUNDSROOT
Definition: sepa_cmir.c:40
SCIP_Real SCIPvarGetUbGlobal(SCIP_VAR *var)
Definition: var.c:17176
SCIP_Bool SCIPisCutEfficacious(SCIP *scip, SCIP_SOL *sol, SCIP_ROW *cut)
Definition: scip.c:33761
#define MAXAGGRLEN(nvars)
Definition: sepa_cmir.c:81
SCIP_Real SCIPgetRowMinCoef(SCIP *scip, SCIP_ROW *row)
Definition: scip.c:30473
static SCIP_DECL_SEPAEXECLP(sepaExeclpCmir)
Definition: sepa_cmir.c:1568
SCIP_Bool SCIPisLT(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
Definition: scip.c:45764
SCIP_ROW ** SCIPcolGetRows(SCIP_COL *col)
Definition: lp.c:16180
SCIP_RETCODE SCIPgetSolVals(SCIP *scip, SCIP_SOL *sol, int nvars, SCIP_VAR **vars, SCIP_Real *vals)
Definition: scip.c:38044
#define DEFAULT_MAXSEPACUTS
Definition: sepa_cmir.c:53
SCIP_Bool SCIProwIsLocal(SCIP_ROW *row)
Definition: lp.c:16420
static SCIP_Bool varIsContinuous(SCIP_VAR *var)
Definition: sepa_cmir.c:636
int SCIPsepaGetNCallsAtNode(SCIP_SEPA *sepa)
Definition: sepa.c:759
SCIP_Bool SCIPisEfficacious(SCIP *scip, SCIP_Real efficacy)
Definition: scip.c:33779
const char * SCIPvarGetName(SCIP_VAR *var)
Definition: var.c:16552
void SCIPsepaSetData(SCIP_SEPA *sepa, SCIP_SEPADATA *sepadata)
Definition: sepa.c:553
#define MAXFRAC
Definition: sepa_cmir.c:77
#define NULL
Definition: lpi_spx1.cpp:137
#define REALABS(x)
Definition: def.h:159
complemented mixed integer rounding cuts separator (Marchand&#39;s version)
#define DEFAULT_DENSITYSCORE
Definition: sepa_cmir.c:57
#define SCIP_CALL(x)
Definition: def.h:306
#define DEFAULT_AGGRTOL
Definition: sepa_cmir.c:66
SCIP_Bool SCIPisFeasGT(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
Definition: scip.c:46125
SCIP_RETCODE SCIPgetVarClosestVub(SCIP *scip, SCIP_VAR *var, SCIP_SOL *sol, SCIP_Real *closestvub, int *closestvubidx)
Definition: scip.c:23539
#define DEFAULT_MAXSEPACUTSROOT
Definition: sepa_cmir.c:54
SCIP_Real SCIProwGetRhs(SCIP_ROW *row)
Definition: lp.c:16321
SCIP_RETCODE SCIPaddCut(SCIP *scip, SCIP_SOL *sol, SCIP_ROW *cut, SCIP_Bool forcecut, SCIP_Bool *infeasible)
Definition: scip.c:33869
SCIP_Bool SCIProwIsModifiable(SCIP_ROW *row)
Definition: lp.c:16430
SCIP_COL ** SCIProwGetCols(SCIP_ROW *row)
Definition: lp.c:16257
SCIP_RETCODE SCIPincludeSepaBasic(SCIP *scip, SCIP_SEPA **sepa, const char *name, const char *desc, int priority, int freq, SCIP_Real maxbounddist, SCIP_Bool usessubscip, SCIP_Bool delay, SCIP_DECL_SEPAEXECLP((*sepaexeclp)), SCIP_DECL_SEPAEXECSOL((*sepaexecsol)), SCIP_SEPADATA *sepadata)
Definition: scip.c:7325
#define SEPA_NAME
Definition: sepa_cmir.c:31
#define SCIPallocBufferArray(scip, ptr, num)
Definition: scip.h:21925
SCIP_Real * SCIProwGetVals(SCIP_ROW *row)
Definition: lp.c:16267
public data structures and miscellaneous methods
#define DEFAULT_MAXCONTSROOT
Definition: sepa_cmir.c:65
#define SCIP_Bool
Definition: def.h:61
SCIP_LPSOLSTAT SCIPgetLPSolstat(SCIP *scip)
Definition: scip.c:28854
int SCIPgetNImplVars(SCIP *scip)
Definition: scip.c:11766
#define DEFAULT_MAXTRIES
Definition: sepa_cmir.c:41
#define DEFAULT_DYNAMICCUTS
Definition: sepa_cmir.c:71
int SCIPgetDepth(SCIP *scip)
Definition: scip.c:42094
SCIP_RETCODE SCIPcutGenerationHeuristicCmir(SCIP *scip, SCIP_SEPA *sepa, SCIP_SOL *sol, SCIP_Real *varsolvals, int maxtestdelta, SCIP_Real *rowweights, SCIP_Real maxweight, int *weightinds, int nweightinds, int rowlensum, SCIP_Real boundswitch, SCIP_Bool usevbds, SCIP_Bool allowlocal, SCIP_Bool fixintegralrhs, int maxmksetcoefs, SCIP_Real maxweightrange, SCIP_Real minfrac, SCIP_Real maxfrac, SCIP_Bool trynegscaling, SCIP_Bool cutremovable, const char *cutclassname, SCIP_Bool *cutoff, int *ncuts, SCIP_Real *delta, SCIP_Bool *deltavalid)
Definition: sepa_cmir.c:428
static SCIP_RETCODE addCut(SCIP *scip, SCIP_SEPA *sepa, SCIP_SOL *sol, SCIP_Real *varsolvals, SCIP_Real *cutcoefs, SCIP_Real cutrhs, SCIP_Bool cutislocal, SCIP_Bool cutremovable, int cutrank, const char *cutclassname, SCIP_Bool *cutoff, int *ncuts)
Definition: sepa_cmir.c:176
#define MAX(x, y)
Definition: tclique_def.h:75
SCIP_RETCODE SCIPaddPoolCut(SCIP *scip, SCIP_ROW *row)
Definition: scip.c:33964
static SCIP_RETCODE aggregation(SCIP *scip, SCIP_SEPA *sepa, SCIP_SEPADATA *sepadata, SCIP_SOL *sol, SCIP_Real *varsolvals, SCIP_Real *bestcontlbs, SCIP_Real *bestcontubs, SCIP_Real *contvarscorebounds, SCIP_Real *rowlhsscores, SCIP_Real *rowrhsscores, int startrow, int maxaggrs, SCIP_Real maxslack, int maxconts, SCIP_Bool *wastried, SCIP_Bool *cutoff, int *ncuts)
Definition: sepa_cmir.c:692
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.c:30051
SCIP_Real SCIPgetCutEfficacy(SCIP *scip, SCIP_SOL *sol, SCIP_ROW *cut)
Definition: scip.c:33738
#define DEFAULT_MAXSLACK
Definition: sepa_cmir.c:55
SCIP_Bool SCIPisInfinity(SCIP *scip, SCIP_Real val)
Definition: scip.c:45827
SCIP_Real SCIPgetRowSolActivity(SCIP *scip, SCIP_ROW *row, SCIP_SOL *sol)
Definition: scip.c:30713
int SCIProwGetRank(SCIP_ROW *row)
Definition: lp.c:16400
#define DEFAULT_MAXROUNDS
Definition: sepa_cmir.c:39
int SCIPgetNVars(SCIP *scip)
Definition: scip.c:11631
#define SCIP_REAL_MAX
Definition: def.h:136
SCIP_RETCODE SCIPreleaseRow(SCIP *scip, SCIP_ROW **row)
Definition: scip.c:30160
SCIP_RETCODE SCIPsetSepaFree(SCIP *scip, SCIP_SEPA *sepa, SCIP_DECL_SEPAFREE((*sepafree)))
Definition: scip.c:7383
SCIP_Bool SCIPisGT(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
Definition: scip.c:45790
#define DEFAULT_MAXROWFAC
Definition: sepa_cmir.c:62
SCIP_VAR * SCIPcolGetVar(SCIP_COL *col)
Definition: lp.c:16081
#define DEFAULT_DENSITYOFFSET
Definition: sepa_cmir.c:61
void SCIProwChgRank(SCIP_ROW *row, int rank)
Definition: lp.c:16533
#define DEFAULT_MAXTRIESROOT
Definition: sepa_cmir.c:44
SCIP_VAR ** SCIPgetVars(SCIP *scip)
Definition: scip.c:11586
int SCIProwGetLPPos(SCIP_ROW *row)
Definition: lp.c:16500
#define SCIP_Real
Definition: def.h:135
SCIP_RETCODE SCIPaddVarsToRow(SCIP *scip, SCIP_ROW *row, int nvars, SCIP_VAR **vars, SCIP_Real *vals)
Definition: scip.c:30314
SCIP_Bool SCIPisStopped(SCIP *scip)
Definition: scip.c:1138
#define MIN(x, y)
Definition: memory.c:75
static SCIP_RETCODE storeCutInArrays(SCIP *scip, int nvars, SCIP_VAR **vars, SCIP_Real *cutcoefs, SCIP_Real *varsolvals, SCIP_VAR **cutvars, SCIP_Real *cutvals, int *cutlen, SCIP_Real *cutact)
Definition: sepa_cmir.c:129
#define DEFAULT_MAXAGGRSROOT
Definition: sepa_cmir.c:52
#define BOUNDSWITCH
Definition: sepa_cmir.c:73
SCIP_RETCODE SCIPprintRow(SCIP *scip, SCIP_ROW *row, FILE *file)
Definition: scip.c:30762
#define SCIP_Longint
Definition: def.h:120
#define DEFAULT_MAXTESTDELTA
Definition: sepa_cmir.c:63
SCIP_VARTYPE SCIPvarGetType(SCIP_VAR *var)
Definition: var.c:16717
static SCIP_DECL_SEPAFREE(sepaFreeCmir)
Definition: sepa_cmir.c:1550
#define SEPA_PRIORITY
Definition: sepa_cmir.c:33
SCIP_Bool SCIPisZero(SCIP *scip, SCIP_Real val)
Definition: scip.c:45864
SCIP_Bool SCIPisLE(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
Definition: scip.c:45777
enum SCIP_Vartype SCIP_VARTYPE
Definition: type_var.h:60
SCIP_Real SCIPvarGetUbLocal(SCIP_VAR *var)
Definition: var.c:17232
#define SEPA_FREQ
Definition: sepa_cmir.c:34
SCIP_Bool SCIPisFeasIntegral(SCIP *scip, SCIP_Real val)
Definition: scip.c:46187
#define MAKECONTINTEGRAL
Definition: sepa_cmir.c:78
SCIP_Real SCIPsumepsilon(SCIP *scip)
Definition: scip.c:45260
#define BMSclearMemoryArray(ptr, num)
Definition: memory.h:85
SCIP_RETCODE SCIPgetLPRowsData(SCIP *scip, SCIP_ROW ***rows, int *nrows)
Definition: scip.c:29165
static SCIP_RETCODE separateCuts(SCIP *scip, SCIP_SEPA *sepa, SCIP_SOL *sol, SCIP_RESULT *result)
Definition: sepa_cmir.c:1226
#define DEFAULT_MAXROWDENSITY
Definition: sepa_cmir.c:60
#define DEFAULT_MAXSLACKROOT
Definition: sepa_cmir.c:56
SCIP_Longint SCIPgetNLPs(SCIP *scip)
Definition: scip.c:41363
int SCIPcolGetNLPNonz(SCIP_COL *col)
Definition: lp.c:16169
int SCIPcolGetLPPos(SCIP_COL *col)
Definition: lp.c:16122
SCIP_Bool SCIPvarIsIntegral(SCIP_VAR *var)
Definition: var.c:16743
#define SEPA_DESC
Definition: sepa_cmir.c:32
SCIP_RETCODE SCIPmakeRowIntegral(SCIP *scip, SCIP_ROW *row, SCIP_Real mindelta, SCIP_Real maxdelta, SCIP_Longint maxdnom, SCIP_Real maxscale, SCIP_Bool usecontvars, SCIP_Bool *success)
Definition: scip.c:30431
SCIP_Real SCIProwGetNorm(SCIP_ROW *row)
Definition: lp.c:16287
void SCIPsortedvecInsertInt(int *intarray, int keyval, int *len, int *pos)
#define SEPA_MAXBOUNDDIST
Definition: sepa_cmir.c:35
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.c:4258
#define DEFAULT_MAXFAILSROOT
Definition: sepa_cmir.c:48
struct SCIP_SepaData SCIP_SEPADATA
Definition: type_sepa.h:38
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.c:4176
int SCIPgetNSepaRounds(SCIP *scip)
Definition: scip.c:41933
SCIP_Bool SCIPvarIsActive(SCIP_VAR *var)
Definition: var.c:16839
#define SEPA_DELAY
Definition: sepa_cmir.c:37