Scippy

SCIP

Solving Constraint Integer Programs

heur_shiftandpropagate.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 heur_shiftandpropagate.c
17  * @brief shiftandpropagate primal heuristic
18  * @author Timo Berthold
19  * @author Gregor Hendel
20  */
21 
22 /*---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----0----+----1----+----2*/
23 
24 #include "blockmemshell/memory.h"
26 #include "scip/pub_event.h"
27 #include "scip/pub_heur.h"
28 #include "scip/pub_lp.h"
29 #include "scip/pub_message.h"
30 #include "scip/pub_misc.h"
31 #include "scip/pub_misc_sort.h"
32 #include "scip/pub_sol.h"
33 #include "scip/pub_var.h"
34 #include "scip/scip_event.h"
35 #include "scip/scip_general.h"
36 #include "scip/scip_heur.h"
37 #include "scip/scip_lp.h"
38 #include "scip/scip_mem.h"
39 #include "scip/scip_message.h"
40 #include "scip/scip_numerics.h"
41 #include "scip/scip_param.h"
42 #include "scip/scip_prob.h"
43 #include "scip/scip_probing.h"
44 #include "scip/scip_randnumgen.h"
45 #include "scip/scip_sol.h"
46 #include "scip/scip_solvingstats.h"
47 #include "scip/scip_tree.h"
48 #include "scip/scip_var.h"
49 #include <string.h>
50 
51 #define HEUR_NAME "shiftandpropagate"
52 #define HEUR_DESC "Pre-root heuristic to expand an auxiliary branch-and-bound tree and apply propagation techniques"
53 #define HEUR_DISPCHAR 'T'
54 #define HEUR_PRIORITY 1000
55 #define HEUR_FREQ 0
56 #define HEUR_FREQOFS 0
57 #define HEUR_MAXDEPTH -1
58 #define HEUR_TIMING SCIP_HEURTIMING_BEFORENODE
59 #define HEUR_USESSUBSCIP FALSE /**< does the heuristic use a secondary SCIP instance? */
60 
61 #define DEFAULT_WEIGHT_INEQUALITY 1 /**< the heuristic row weight for inequalities */
62 #define DEFAULT_WEIGHT_EQUALITY 3 /**< the heuristic row weight for equations */
63 #define DEFAULT_RELAX TRUE /**< Should continuous variables be relaxed from the problem? */
64 #define DEFAULT_PROBING TRUE /**< Is propagation of solution values enabled? */
65 #define DEFAULT_ONLYWITHOUTSOL TRUE /**< Should heuristic only be executed if no primal solution was found, yet? */
66 #define DEFAULT_NPROPROUNDS 10 /**< The default number of propagation rounds for each propagation used */
67 #define DEFAULT_PROPBREAKER 65000 /**< fixed maximum number of propagations */
68 #define DEFAULT_CUTOFFBREAKER 15 /**< fixed maximum number of allowed cutoffs before the heuristic stops */
69 #define DEFAULT_RANDSEED 29 /**< the default random seed for random number generation */
70 #define DEFAULT_SORTKEY 'v' /**< the default key for variable sorting */
71 #define DEFAULT_SORTVARS TRUE /**< should variables be processed in sorted order? */
72 #define DEFAULT_COLLECTSTATS TRUE /**< should variable statistics be collected during probing? */
73 #define DEFAULT_STOPAFTERFEASIBLE TRUE /**< Should the heuristic stop calculating optimal shift values when no more rows are violated? */
74 #define DEFAULT_PREFERBINARIES TRUE /**< Should binary variables be shifted first? */
75 #define DEFAULT_SELECTBEST FALSE /**< should the heuristic choose the best candidate in every round? (set to FALSE for static order)? */
76 #define DEFAULT_MAXCUTOFFQUOT 0.0 /**< maximum percentage of allowed cutoffs before stopping the heuristic */
77 #define SORTKEYS "nrtuv"/**< options sorting key: (n)orms down, norms (u)p, (v)iolated rows decreasing,
78  * viola(t)ed rows increasing, or (r)andom */
79 #define DEFAULT_NOZEROFIXING FALSE /**< should variables with a zero shifting value be delayed instead of being fixed? */
80 #define DEFAULT_FIXBINLOCKS TRUE /**< should binary variables with no locks in one direction be fixed to that direction? */
81 #define DEFAULT_BINLOCKSFIRST FALSE /**< should binary variables with no locks be preferred in the ordering? */
82 #define DEFAULT_NORMALIZE TRUE /**< should coefficients and left/right hand sides be normalized by max row coeff? */
83 #define DEFAULT_UPDATEWEIGHTS FALSE /**< should row weight be increased every time the row is violated? */
84 #define DEFAULT_IMPLISCONTINUOUS TRUE /**< should implicit integer variables be treated as continuous variables? */
85 
86 #define EVENTHDLR_NAME "eventhdlrshiftandpropagate"
87 #define EVENTHDLR_DESC "event handler to catch bound changes"
88 #define EVENTTYPE_SHIFTANDPROPAGATE (SCIP_EVENTTYPE_BOUNDCHANGED | SCIP_EVENTTYPE_GBDCHANGED)
89 
90 
91 /*
92  * Data structures
93  */
94 
95 /** primal heuristic data */
96 struct SCIP_HeurData
97 {
98  SCIP_COL** lpcols; /**< stores lp columns with discrete variables before cont. variables */
99  SCIP_RANDNUMGEN* randnumgen; /**< random number generation */
100  int* rowweights; /**< row weight storage */
101  SCIP_Bool relax; /**< should continuous variables be relaxed from the problem */
102  SCIP_Bool probing; /**< should probing be executed? */
103  SCIP_Bool onlywithoutsol; /**< Should heuristic only be executed if no primal solution was found, yet? */
104  int nlpcols; /**< the number of lp columns */
105  int nproprounds; /**< The default number of propagation rounds for each propagation used */
106  int cutoffbreaker; /**< the number of cutoffs before heuristic execution is stopped, or -1 for no
107  * limit */
108  SCIP_EVENTHDLR* eventhdlr; /**< event handler to register and process variable bound changes */
109 
110  SCIP_Real maxcutoffquot; /**< maximum percentage of allowed cutoffs before stopping the heuristic */
111  char sortkey; /**< the key by which variables are sorted */
112  SCIP_Bool sortvars; /**< should variables be processed in sorted order? */
113  SCIP_Bool collectstats; /**< should variable statistics be collected during probing? */
114  SCIP_Bool stopafterfeasible; /**< Should the heuristic stop calculating optimal shift values when no
115  * more rows are violated? */
116  SCIP_Bool preferbinaries; /**< Should binary variables be shifted first? */
117  SCIP_Bool nozerofixing; /**< should variables with a zero shifting value be delayed instead of being fixed? */
118  SCIP_Bool fixbinlocks; /**< should binary variables with no locks in one direction be fixed to that direction? */
119  SCIP_Bool binlocksfirst; /**< should binary variables with no locks be preferred in the ordering? */
120  SCIP_Bool normalize; /**< should coefficients and left/right hand sides be normalized by max row coeff? */
121  SCIP_Bool updateweights; /**< should row weight be increased every time the row is violated? */
122  SCIP_Bool impliscontinuous; /**< should implicit integer variables be treated as continuous variables? */
123  SCIP_Bool selectbest; /**< should the heuristic choose the best candidate in every round? (set to FALSE for static order)? */
125  SCIP_LPSOLSTAT lpsolstat; /**< the probing status after probing */
126  SCIP_Longint ntotaldomredsfound; /**< the total number of domain reductions during heuristic */
127  SCIP_Longint nlpiters; /**< number of LP iterations which the heuristic needed */
128  int nremainingviols; /**< the number of remaining violations */
129  int nprobings; /**< how many probings has the heuristic executed? */
130  int ncutoffs; /**< has the probing node been cutoff? */
131  )
132 };
133 
134 /** status of a variable in heuristic transformation */
135 enum TransformStatus
136 {
137  TRANSFORMSTATUS_NONE = 0, /**< variable has not been transformed yet */
138  TRANSFORMSTATUS_LB = 1, /**< variable has been shifted by using lower bound (x-lb) */
139  TRANSFORMSTATUS_NEG = 2, /**< variable has been negated by using upper bound (ub-x) */
140  TRANSFORMSTATUS_FREE = 3 /**< variable does not have to be shifted */
141 };
142 typedef enum TransformStatus TRANSFORMSTATUS;
144 /** information about the matrix after its heuristic transformation */
145 struct ConstraintMatrix
146 {
147  SCIP_Real* rowmatvals; /**< matrix coefficients row by row */
148  int* rowmatind; /**< the indices of the corresponding variables */
149  int* rowmatbegin; /**< the starting indices of each row */
150  SCIP_Real* colmatvals; /**< matrix coefficients column by column */
151  int* colmatind; /**< the indices of the corresponding rows for each coefficient */
152  int* colmatbegin; /**< the starting indices of each column */
153  int* violrows; /**< the number of violated rows for every variable */
154  TRANSFORMSTATUS* transformstatus; /**< information about transform status of every discrete variable */
155  SCIP_Real* lhs; /**< left hand side vector after normalization */
156  SCIP_Real* rhs; /**< right hand side vector after normalization */
157  SCIP_Real* colnorms; /**< vector norms of all discrete problem variables after normalization */
158  SCIP_Real* upperbounds; /**< the upper bounds of every non-continuous variable after transformation*/
159  SCIP_Real* transformshiftvals; /**< values by which original discrete variable bounds were shifted */
160  int nnonzs; /**< number of nonzero column entries */
161  int nrows; /**< number of rows of matrix */
162  int ncols; /**< the number of columns in matrix (including continuous vars) */
163  int ndiscvars; /**< number of discrete problem variables */
164  SCIP_Bool normalized; /**< indicates if the matrix data has already been normalized */
165 };
166 typedef struct ConstraintMatrix CONSTRAINTMATRIX;
168 struct SCIP_EventhdlrData
169 {
170  CONSTRAINTMATRIX* matrix; /**< the constraint matrix of the heuristic */
171  SCIP_HEURDATA* heurdata; /**< heuristic data */
172  int* violatedrows; /**< all currently violated LP rows */
173  int* violatedrowpos; /**< position in violatedrows array for every row */
174  int* nviolatedrows; /**< pointer to the total number of currently violated rows */
175 };
176 
177 struct SCIP_EventData
178 {
179  int colpos; /**< column position of the event-related variable */
180 };
181 /*
182  * Local methods
183  */
184 
185 /** returns whether a given variable is counted as discrete, depending on the parameter impliscontinuous */
186 static
188  SCIP_VAR* var, /**< variable to check for discreteness */
189  SCIP_Bool impliscontinuous /**< should implicit integer variables be counted as continuous? */
190  )
191 {
192  return SCIPvarIsIntegral(var) && (SCIPvarGetType(var) != SCIP_VARTYPE_IMPLINT || !impliscontinuous);
193 }
194 
195 /** returns whether a given column is counted as discrete, depending on the parameter impliscontinuous */
196 static
198  SCIP_COL* col, /**< column to check for discreteness */
199  SCIP_Bool impliscontinuous /**< should implicit integer variables be counted as continuous? */
200  )
201 {
202  return SCIPcolIsIntegral(col) && (!impliscontinuous || SCIPvarGetType(SCIPcolGetVar(col)) != SCIP_VARTYPE_IMPLINT);
203 }
204 
205 /** returns nonzero values and corresponding columns of given row */
206 static
207 void getRowData(
208  CONSTRAINTMATRIX* matrix, /**< constraint matrix object */
209  int rowindex, /**< index of the desired row */
210  SCIP_Real** valpointer, /**< pointer to store the nonzero coefficients of the row */
211  SCIP_Real* lhs, /**< lhs of the row */
212  SCIP_Real* rhs, /**< rhs of the row */
213  int** indexpointer, /**< pointer to store column indices which belong to the nonzeros */
214  int* nrowvals /**< pointer to store number of nonzeros in the desired row (or NULL) */
215  )
216 {
217  int arrayposition;
218 
219  assert(matrix != NULL);
220  assert(0 <= rowindex && rowindex < matrix->nrows);
221 
222  arrayposition = matrix->rowmatbegin[rowindex];
223 
224  if ( nrowvals != NULL )
225  {
226  if( rowindex == matrix->nrows - 1 )
227  *nrowvals = matrix->nnonzs - arrayposition;
228  else
229  *nrowvals = matrix->rowmatbegin[rowindex + 1] - arrayposition; /*lint !e679*/
230  }
231 
232  if( valpointer != NULL )
233  *valpointer = &(matrix->rowmatvals[arrayposition]);
234  if( indexpointer != NULL )
235  *indexpointer = &(matrix->rowmatind[arrayposition]);
236 
237  if( lhs != NULL )
238  *lhs = matrix->lhs[rowindex];
239 
240  if( rhs != NULL )
241  *rhs = matrix->rhs[rowindex];
242 }
243 
244 /** returns nonzero values and corresponding rows of given column */
245 static
246 void getColumnData(
247  CONSTRAINTMATRIX* matrix, /**< constraint matrix object */
248  int colindex, /**< the index of the desired column */
249  SCIP_Real** valpointer, /**< pointer to store the nonzero coefficients of the column */
250  int** indexpointer, /**< pointer to store row indices which belong to the nonzeros */
251  int* ncolvals /**< pointer to store number of nonzeros in the desired column */
252  )
253 {
254  int arrayposition;
255 
256  assert(matrix != NULL);
257  assert(0 <= colindex && colindex < matrix->ncols);
258 
259  arrayposition = matrix->colmatbegin[colindex];
260 
261  if( ncolvals != NULL )
262  {
263  if( colindex == matrix->ncols - 1 )
264  *ncolvals = matrix->nnonzs - arrayposition;
265  else
266  *ncolvals = matrix->colmatbegin[colindex + 1] - arrayposition; /*lint !e679*/
267  }
268  if( valpointer != NULL )
269  *valpointer = &(matrix->colmatvals[arrayposition]);
270 
271  if( indexpointer != NULL )
272  *indexpointer = &(matrix->colmatind[arrayposition]);
273 }
274 
275 /** relaxes a continuous variable from all its rows, which has influence
276  * on both the left and right hand side of the constraint.
277  */
278 static
279 void relaxVar(
280  SCIP* scip, /**< current scip instance */
281  SCIP_VAR* var, /**< variable which is relaxed from the problem */
282  CONSTRAINTMATRIX* matrix, /**< constraint matrix object */
283  SCIP_Bool normalize /**< should coefficients and be normalized by rows maximum norms? */
284  )
285 {
286  SCIP_ROW** colrows;
287  SCIP_COL* varcol;
288  SCIP_Real* colvals;
289  SCIP_Real ub;
290  SCIP_Real lb;
291  int ncolvals;
292  int r;
293 
294  assert(var != NULL);
295  assert(SCIPvarGetStatus(var) == SCIP_VARSTATUS_COLUMN);
296 
297  varcol = SCIPvarGetCol(var);
298  assert(varcol != NULL);
299 
300  /* get nonzero values and corresponding rows of variable */
301  colvals = SCIPcolGetVals(varcol);
302  ncolvals = SCIPcolGetNLPNonz(varcol);
303  colrows = SCIPcolGetRows(varcol);
304 
305  ub = SCIPvarGetUbGlobal(var);
306  lb = SCIPvarGetLbGlobal(var);
307 
308  assert(colvals != NULL || ncolvals == 0);
309 
310  SCIPdebugMsg(scip, "Relaxing variable <%s> with lb <%g> and ub <%g>\n",
311  SCIPvarGetName(var), lb, ub);
312 
313  assert(matrix->normalized);
314  /* relax variable from all its constraints */
315  for( r = 0; r < ncolvals; ++r )
316  {
317  SCIP_ROW* colrow;
318  SCIP_Real lhs;
319  SCIP_Real rhs;
320  SCIP_Real lhsvarbound;
321  SCIP_Real rhsvarbound;
322  SCIP_Real rowabs;
323  SCIP_Real colval;
324  int rowindex;
325 
326  colrow = colrows[r];
327  rowindex = SCIProwGetLPPos(colrow);
328 
329  if( rowindex == -1 )
330  break;
331 
332  rowabs = SCIPgetRowMaxCoef(scip, colrow);
333  assert(colvals != NULL); /* to please flexelint */
334  colval = colvals[r];
335  if( normalize && SCIPisFeasGT(scip, rowabs, 0.0) )
336  colval /= rowabs;
337 
338  assert(0 <= rowindex && rowindex < matrix->nrows);
339  getRowData(matrix, rowindex, NULL, &lhs, &rhs, NULL, NULL);
340  /* variables bound influence the lhs and rhs of current row depending on the sign
341  * of the variables coefficient.
342  */
343  if( SCIPisFeasPositive(scip, colval) )
344  {
345  lhsvarbound = ub;
346  rhsvarbound = lb;
347  }
348  else if( SCIPisFeasNegative(scip, colval) )
349  {
350  lhsvarbound = lb;
351  rhsvarbound = ub;
352  }
353  else
354  continue;
355 
356  /* relax variable from the current row */
357  if( !SCIPisInfinity(scip, -matrix->lhs[rowindex]) && !SCIPisInfinity(scip, ABS(lhsvarbound)) )
358  matrix->lhs[rowindex] -= colval * lhsvarbound;
359  else
360  matrix->lhs[rowindex] = -SCIPinfinity(scip);
361 
362  if( !SCIPisInfinity(scip, matrix->rhs[rowindex]) && !SCIPisInfinity(scip, ABS(rhsvarbound)) )
363  matrix->rhs[rowindex] -= colval * rhsvarbound;
364  else
365  matrix->rhs[rowindex] = SCIPinfinity(scip);
366 
367  SCIPdebugMsg(scip, "Row <%s> changed:Coefficient <%g>, LHS <%g> --> <%g>, RHS <%g> --> <%g>\n",
368  SCIProwGetName(colrow), colval, lhs, matrix->lhs[rowindex], rhs, matrix->rhs[rowindex]);
369  }
370 }
371 
372 /** transforms bounds of a given variable s.t. its lower bound equals zero afterwards.
373  * If the variable already has lower bound zero, the variable is not transformed,
374  * if not, the variable's bounds are changed w.r.t. the smaller absolute value of its
375  * bounds in order to avoid numerical inaccuracies. If both lower and upper bound
376  * of the variable differ from infinity, there are two cases. If |lb| <= |ub|,
377  * the bounds are shifted by -lb, else a new variable ub - x replaces x.
378  * The transformation is memorized by the transform status of the variable s.t.
379  * retransformation is possible.
380  */
381 static
382 void transformVariable(
383  SCIP* scip, /**< current scip instance */
384  CONSTRAINTMATRIX* matrix, /**< constraint matrix object */
385  SCIP_HEURDATA* heurdata, /**< heuristic data */
386  int colpos /**< position of variable column in matrix */
387  )
388 {
389  SCIP_COL* col;
390  SCIP_VAR* var;
391  SCIP_Real lb;
392  SCIP_Real ub;
393 
394  SCIP_Bool negatecoeffs; /* do the row coefficients need to be negated? */
395  SCIP_Real deltashift; /* difference from previous transformation */
396 
397  assert(matrix != NULL);
398  assert(0 <= colpos && colpos < heurdata->nlpcols);
399  col = heurdata->lpcols[colpos];
400  assert(col != NULL);
401  assert(SCIPcolIsInLP(col));
402 
403  var = SCIPcolGetVar(col);
404  assert(var != NULL);
405  assert(SCIPvarIsIntegral(var));
406  lb = SCIPvarGetLbLocal(var);
407  ub = SCIPvarGetUbLocal(var);
408 
409  negatecoeffs = FALSE;
410  /* if both lower and upper bound are -infinity and infinity, resp., this is reflected by a free transform status.
411  * If the lower bound is already zero, this is reflected by identity transform status. In both cases, none of the
412  * corresponding rows needs to be modified.
413  */
414  if( SCIPisInfinity(scip, -lb) && SCIPisInfinity(scip, ub) )
415  {
416  if( matrix->transformstatus[colpos] == TRANSFORMSTATUS_NEG )
417  negatecoeffs = TRUE;
418 
419  deltashift = matrix->transformshiftvals[colpos];
420  matrix->transformshiftvals[colpos] = 0.0;
421  matrix->transformstatus[colpos] = TRANSFORMSTATUS_FREE;
422  }
423  else if( SCIPisLE(scip, REALABS(lb), REALABS(ub)) )
424  {
425  assert(!SCIPisInfinity(scip, REALABS(lb)));
426 
427  matrix->transformstatus[colpos] = TRANSFORMSTATUS_LB;
428  deltashift = lb;
429  matrix->transformshiftvals[colpos] = lb;
430  }
431  else
432  {
433  assert(!SCIPisInfinity(scip, ub));
434  if( matrix->transformstatus[colpos] != TRANSFORMSTATUS_NEG )
435  negatecoeffs = TRUE;
436  matrix->transformstatus[colpos] = TRANSFORMSTATUS_NEG;
437  deltashift = ub;
438  matrix->transformshiftvals[colpos] = ub;
439  }
440 
441  /* determine the upper bound for this variable in heuristic transformation (lower bound is implicit; always 0) */
442  if( !SCIPisInfinity(scip, ub) && !SCIPisInfinity(scip, lb) )
443  matrix->upperbounds[colpos] = MIN(ub - lb, SCIPinfinity(scip)); /*lint !e666*/
444  else
445  matrix->upperbounds[colpos] = SCIPinfinity(scip);
446 
447  /* a real transformation is necessary. The variable x is either shifted by -lb or
448  * replaced by ub - x, depending on the smaller absolute of lb and ub.
449  */
450  if( !SCIPisFeasZero(scip, deltashift) || negatecoeffs )
451  {
452  SCIP_Real* vals;
453  int* rows;
454  int nrows;
455  int i;
456 
457  assert(!SCIPisInfinity(scip, deltashift));
458 
459  /* get nonzero values and corresponding rows of column */
460  getColumnData(matrix, colpos, &vals, &rows, &nrows);
461  assert(nrows == 0 ||(vals != NULL && rows != NULL));
462 
463  /* go through rows and modify its lhs, rhs and the variable coefficient, if necessary */
464  for( i = 0; i < nrows; ++i )
465  {
466  int rowpos = rows[i];
467  assert(rowpos >= 0);
468  assert(rowpos < matrix->nrows);
469 
470  if( !SCIPisInfinity(scip, -(matrix->lhs[rowpos])) )
471  matrix->lhs[rowpos] -= (vals[i]) * deltashift;
472 
473  if( !SCIPisInfinity(scip, matrix->rhs[rowpos]) )
474  matrix->rhs[rowpos] -= (vals[i]) * deltashift;
475 
476  if( negatecoeffs )
477  (vals[i]) = -(vals[i]);
478 
479  assert(SCIPisFeasLE(scip, matrix->lhs[rowpos], matrix->rhs[rowpos]));
480  }
481  }
482  SCIPdebugMsg(scip, "Variable <%s> at colpos %d transformed. Status %d LB <%g> --> <%g>, UB <%g> --> <%g>\n",
483  SCIPvarGetName(var), colpos, matrix->transformstatus[colpos], lb, 0.0, ub, matrix->upperbounds[colpos]);
484 }
485 
486 /** initializes copy of the original coefficient matrix and applies heuristic specific adjustments: normalizing row
487  * vectors, transforming variable domains such that lower bound is zero, and relaxing continuous variables.
488  */
489 static
491  SCIP* scip, /**< current scip instance */
492  CONSTRAINTMATRIX* matrix, /**< constraint matrix object to be initialized */
493  SCIP_HEURDATA* heurdata, /**< heuristic data */
494  int* colposs, /**< position of columns according to variable type sorting */
495  SCIP_Bool normalize, /**< should coefficients and be normalized by rows maximum norms? */
496  int* nmaxrows, /**< maximum number of rows a variable appears in */
497  SCIP_Bool relax, /**< should continuous variables be relaxed from the problem? */
498  SCIP_Bool* initialized, /**< was the initialization successful? */
499  SCIP_Bool* infeasible /**< is the problem infeasible? */
500  )
501 {
502  SCIP_ROW** lprows;
503  SCIP_COL** lpcols;
504  SCIP_Bool impliscontinuous;
505  int i;
506  int j;
507  int currentpointer;
508 
509  int nrows;
510  int ncols;
511 
512  assert(scip != NULL);
513  assert(matrix != NULL);
514  assert(initialized!= NULL);
515  assert(infeasible != NULL);
516  assert(nmaxrows != NULL);
517 
518  SCIPdebugMsg(scip, "entering Matrix Initialization method of SHIFTANDPROPAGATE heuristic!\n");
519 
520  /* get LP row data; column data is already initialized in heurdata */
521  SCIP_CALL( SCIPgetLPRowsData(scip, &lprows, &nrows) );
522  lpcols = heurdata->lpcols;
523  ncols = heurdata->nlpcols;
524 
525  matrix->nrows = nrows;
526  matrix->nnonzs = 0;
527  matrix->normalized = FALSE;
528  matrix->ndiscvars = 0;
529  *nmaxrows = 0;
530  impliscontinuous = heurdata->impliscontinuous;
531 
532  /* count the number of nonzeros of the LP constraint matrix */
533  for( j = 0; j < ncols; ++j )
534  {
535  assert(lpcols[j] != NULL);
536  assert(SCIPcolGetLPPos(lpcols[j]) >= 0);
537 
538  if( colIsDiscrete(lpcols[j], impliscontinuous) )
539  {
540  matrix->nnonzs += SCIPcolGetNLPNonz(lpcols[j]);
541  ++matrix->ndiscvars;
542  }
543  }
544 
545  matrix->ncols = matrix->ndiscvars;
546 
547  if( matrix->nnonzs == 0 )
548  {
549  SCIPdebugMsg(scip, "No matrix entries - Terminating initialization of matrix.\n");
550 
551  *initialized = FALSE;
552 
553  return SCIP_OKAY;
554  }
555 
556  /* allocate memory for the members of heuristic matrix */
557  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->rowmatvals, matrix->nnonzs) );
558  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->rowmatind, matrix->nnonzs) );
559  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->colmatvals, matrix->nnonzs) );
560  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->colmatind, matrix->nnonzs) );
561  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->rowmatbegin, matrix->nrows) );
562  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->colmatbegin, matrix->ncols) );
563  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->lhs, matrix->nrows) );
564  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->rhs, matrix->nrows) );
565  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->colnorms, matrix->ncols) );
566  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->violrows, matrix->ncols) );
567  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->transformstatus, matrix->ndiscvars) );
568  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->upperbounds, matrix->ndiscvars) );
569  SCIP_CALL( SCIPallocBufferArray(scip, &matrix->transformshiftvals, matrix->ndiscvars) );
570 
571  /* set transform status of variables */
572  for( j = 0; j < matrix->ndiscvars; ++j )
573  matrix->transformstatus[j] = TRANSFORMSTATUS_NONE;
574 
575  currentpointer = 0;
576  *infeasible = FALSE;
577 
578  /* initialize the rows vector of the heuristic matrix together with its corresponding
579  * lhs, rhs.
580  */
581  for( i = 0; i < nrows; ++i )
582  {
583  SCIP_COL** cols;
584  SCIP_ROW* row;
585  SCIP_Real* rowvals;
586  SCIP_Real constant;
587  SCIP_Real maxval;
588  int nrowlpnonz;
589 
590  /* get LP row information */
591  row = lprows[i];
592  rowvals = SCIProwGetVals(row);
593  nrowlpnonz = SCIProwGetNLPNonz(row);
594  maxval = SCIPgetRowMaxCoef(scip, row);
595  cols = SCIProwGetCols(row);
596  constant = SCIProwGetConstant(row);
597 
598  SCIPdebugMsg(scip, " %s : lhs=%g, rhs=%g, maxval=%g \n", SCIProwGetName(row), matrix->lhs[i], matrix->rhs[i], maxval);
599  SCIPdebug( SCIP_CALL( SCIPprintRow(scip, row, NULL) ) );
600  assert(!SCIPisInfinity(scip, constant));
601 
602  matrix->rowmatbegin[i] = currentpointer;
603 
604  /* modify the lhs and rhs w.r.t to the rows constant and normalize by 1-norm, i.e divide the lhs and rhs by the
605  * maximum absolute value of the row
606  */
607  if( !SCIPisInfinity(scip, -SCIProwGetLhs(row)) )
608  matrix->lhs[i] = SCIProwGetLhs(row) - constant;
609  else
610  matrix->lhs[i] = -SCIPinfinity(scip);
611 
612  if( !SCIPisInfinity(scip, SCIProwGetRhs(row)) )
613  matrix->rhs[i] = SCIProwGetRhs(row) - constant;
614  else
615  matrix->rhs[i] = SCIPinfinity(scip);
616 
617  /* make sure that maxval is larger than zero before normalization.
618  * Maxval may be zero if the constraint contains no variables but is modifiable, hence not redundant
619  */
620  if( normalize && !SCIPisFeasZero(scip, maxval) )
621  {
622  if( !SCIPisInfinity(scip, -matrix->lhs[i]) )
623  matrix->lhs[i] /= maxval;
624  if( !SCIPisInfinity(scip, matrix->rhs[i]) )
625  matrix->rhs[i] /= maxval;
626  }
627 
628  /* in case of empty rows with a 0 < lhs <= 0.0 or 0.0 <= rhs < 0 we deduce the infeasibility of the problem */
629  if( nrowlpnonz == 0 && (SCIPisFeasPositive(scip, matrix->lhs[i]) || SCIPisFeasNegative(scip, matrix->rhs[i])) )
630  {
631  *infeasible = TRUE;
632  SCIPdebugMsg(scip, " Matrix initialization stopped because of row infeasibility! \n");
633  break;
634  }
635 
636  /* row coefficients are normalized and copied to heuristic matrix */
637  for( j = 0; j < nrowlpnonz; ++j )
638  {
639  if( !colIsDiscrete(cols[j], impliscontinuous) )
640  continue;
641  assert(SCIPcolGetLPPos(cols[j]) >= 0);
642  assert(currentpointer < matrix->nnonzs);
643 
644  matrix->rowmatvals[currentpointer] = rowvals[j];
645  if( normalize && SCIPisFeasGT(scip, maxval, 0.0) )
646  matrix->rowmatvals[currentpointer] /= maxval;
647 
648  matrix->rowmatind[currentpointer] = colposs[SCIPcolGetLPPos(cols[j])];
649 
650  ++currentpointer;
651  }
652  }
653 
654  matrix->normalized = TRUE;
655 
656  if( *infeasible )
657  return SCIP_OKAY;
658 
659  assert(currentpointer == matrix->nnonzs);
660 
661  currentpointer = 0;
662 
663  /* copy the nonzero coefficient data column by column to heuristic matrix */
664  for( j = 0; j < matrix->ncols; ++j )
665  {
666  SCIP_COL* currentcol;
667  SCIP_ROW** rows;
668  SCIP_Real* colvals;
669  int ncolnonz;
670 
671  assert(SCIPcolGetLPPos(lpcols[j]) >= 0);
672 
673  currentcol = lpcols[j];
674  assert(colIsDiscrete(currentcol, impliscontinuous));
675 
676  colvals = SCIPcolGetVals(currentcol);
677  rows = SCIPcolGetRows(currentcol);
678  ncolnonz = SCIPcolGetNLPNonz(currentcol);
679  matrix->colnorms[j] = ncolnonz;
680 
681  *nmaxrows = MAX(*nmaxrows, ncolnonz);
682 
683  /* loop over all rows with nonzero coefficients in the column, transform them and add them to the heuristic matrix */
684  matrix->colmatbegin[j] = currentpointer;
685 
686  for( i = 0; i < ncolnonz; ++i )
687  {
688  SCIP_Real maxval;
689 
690  assert(rows[i] != NULL);
691  assert(0 <= SCIProwGetLPPos(rows[i]));
692  assert(SCIProwGetLPPos(rows[i]) < nrows);
693  assert(currentpointer < matrix->nnonzs);
694 
695  /* rows are normalized by maximum norm */
696  maxval = SCIPgetRowMaxCoef(scip, rows[i]);
697 
698  assert(maxval > 0);
699 
700  matrix->colmatvals[currentpointer] = colvals[i];
701  if( normalize && SCIPisFeasGT(scip, maxval, 0.0) )
702  matrix->colmatvals[currentpointer] /= maxval;
703 
704  matrix->colmatind[currentpointer] = SCIProwGetLPPos(rows[i]);
705 
706  /* update the column norm */
707  matrix->colnorms[j] += ABS(matrix->colmatvals[currentpointer]);
708  ++currentpointer;
709  }
710  }
711  assert(currentpointer == matrix->nnonzs);
712 
713  /* each variable is either transformed, if it supposed to be integral, or relaxed */
714  for( j = 0; j < (relax ? ncols : matrix->ndiscvars); ++j )
715  {
716  SCIP_COL* col;
717 
718  col = lpcols[j];
719  if( colIsDiscrete(col, impliscontinuous) )
720  {
721  matrix->transformshiftvals[j] = 0.0;
722  transformVariable(scip, matrix, heurdata, j);
723  }
724  else
725  {
726  SCIP_VAR* var;
727  var = SCIPcolGetVar(col);
728  assert(!varIsDiscrete(var, impliscontinuous));
729  relaxVar(scip, var, matrix, normalize);
730  }
731  }
732  *initialized = TRUE;
733 
734  SCIPdebugMsg(scip, "Matrix initialized for %d discrete variables with %d cols, %d rows and %d nonzero entries\n",
735  matrix->ndiscvars, matrix->ncols, matrix->nrows, matrix->nnonzs);
736  return SCIP_OKAY;
737 }
738 
739 /** frees all members of the heuristic matrix */
740 static
741 void freeMatrix(
742  SCIP* scip, /**< current SCIP instance */
743  CONSTRAINTMATRIX** matrix /**< constraint matrix object */
744  )
745 {
746  assert(scip != NULL);
747  assert(matrix != NULL);
748 
749  /* all fields are only allocated, if problem is not empty */
750  if( (*matrix)->nnonzs > 0 )
751  {
752  assert((*matrix) != NULL);
753  assert((*matrix)->rowmatbegin != NULL);
754  assert((*matrix)->rowmatvals != NULL);
755  assert((*matrix)->rowmatind != NULL);
756  assert((*matrix)->colmatbegin != NULL);
757  assert((*matrix)->colmatvals!= NULL);
758  assert((*matrix)->colmatind != NULL);
759  assert((*matrix)->lhs != NULL);
760  assert((*matrix)->rhs != NULL);
761  assert((*matrix)->transformstatus != NULL);
762  assert((*matrix)->transformshiftvals != NULL);
763 
764  /* free all fields */
765  SCIPfreeBufferArray(scip, &((*matrix)->transformshiftvals));
766  SCIPfreeBufferArray(scip, &((*matrix)->upperbounds));
767  SCIPfreeBufferArray(scip, &((*matrix)->transformstatus));
768  SCIPfreeBufferArray(scip, &((*matrix)->violrows));
769  SCIPfreeBufferArray(scip, &((*matrix)->colnorms));
770  SCIPfreeBufferArray(scip, &((*matrix)->rhs));
771  SCIPfreeBufferArray(scip, &((*matrix)->lhs));
772  SCIPfreeBufferArray(scip, &((*matrix)->colmatbegin));
773  SCIPfreeBufferArray(scip, &((*matrix)->rowmatbegin));
774  SCIPfreeBufferArray(scip, &((*matrix)->colmatind));
775  SCIPfreeBufferArray(scip, &((*matrix)->colmatvals));
776  SCIPfreeBufferArray(scip, &((*matrix)->rowmatind));
777  SCIPfreeBufferArray(scip, &((*matrix)->rowmatvals));
778 
779 
780  (*matrix)->nrows = 0;
781  (*matrix)->ncols = 0;
782  }
783 
784  /* free matrix */
785  SCIPfreeBuffer(scip, matrix);
786 }
787 
788 /** updates the information about a row whenever violation status changes */
789 static
790 void checkRowViolation(
791  SCIP* scip, /**< current SCIP instance */
792  CONSTRAINTMATRIX* matrix, /**< constraint matrix object */
793  int rowindex, /**< index of the row */
794  int* violatedrows, /**< contains all violated rows */
795  int* violatedrowpos, /**< positions of rows in the violatedrows array */
796  int* nviolatedrows, /**< pointer to update total number of violated rows */
797  int* rowweights, /**< row weight storage */
798  SCIP_Bool updateweights /**< should row weight be increased every time the row is violated? */
799  )
800 {
801  int* cols;
802  int ncols;
803  int c;
804  int violadd;
805  assert(matrix != NULL);
806  assert(violatedrows != NULL);
807  assert(violatedrowpos != NULL);
808  assert(nviolatedrows != NULL);
809 
810  getRowData(matrix, rowindex, NULL, NULL, NULL, &cols, &ncols);
811  violadd = 0;
812 
813  /* row is now violated. Enqueue it in the set of violated rows. */
814  if( violatedrowpos[rowindex] == -1 && (SCIPisFeasGT(scip, matrix->lhs[rowindex], 0.0) || SCIPisFeasLT(scip, matrix->rhs[rowindex], 0.0)) )
815  {
816  assert(*nviolatedrows < matrix->nrows);
817 
818  violatedrows[*nviolatedrows] = rowindex;
819  violatedrowpos[rowindex] = *nviolatedrows;
820  ++(*nviolatedrows);
821  if( updateweights )
822  ++rowweights[rowindex];
823 
824  violadd = 1;
825  }
826  /* row is now feasible. Remove it from the set of violated rows. */
827  else if( violatedrowpos[rowindex] >= 0 && SCIPisFeasLE(scip, matrix->lhs[rowindex], 0.0) && SCIPisFeasGE(scip, matrix->rhs[rowindex], 0.0) )
828  {
829  /* swap the row with last violated row */
830  if( violatedrowpos[rowindex] != *nviolatedrows - 1 )
831  {
832  assert(*nviolatedrows - 1 >= 0);
833  violatedrows[violatedrowpos[rowindex]] = violatedrows[*nviolatedrows - 1];
834  violatedrowpos[violatedrows[*nviolatedrows - 1]] = violatedrowpos[rowindex];
835  }
836 
837  /* unlink the row from its position in the array and decrease number of violated rows */
838  violatedrowpos[rowindex] = -1;
839  --(*nviolatedrows);
840  violadd = -1;
841  }
842 
843  /* increase or decrease the column violation counter */
844  for( c = 0; c < ncols; ++c )
845  {
846  matrix->violrows[cols[c]] += violadd;
847  assert(matrix->violrows[cols[c]] >= 0);
848  }
849 }
850 
851 /** collects the necessary information about row violations for the zero-solution. That is,
852  * all solution values in heuristic transformation are zero.
853  */
854 static
855 void checkViolations(
856  SCIP* scip, /**< current scip instance */
857  CONSTRAINTMATRIX* matrix, /**< constraint matrix object */
858  int colidx, /**< column index for specific column, or -1 for all rows */
859  int* violatedrows, /**< violated rows */
860  int* violatedrowpos, /**< row positions of violated rows */
861  int* nviolatedrows, /**< pointer to store the number of violated rows */
862  int* rowweights, /**< weight array for every row */
863  SCIP_Bool updateweights /**< should row weight be increased every time the row is violated? */
864  )
865 {
866  int nrows;
867  int* rowindices;
868  int i;
869 
870  assert(matrix != NULL);
871  assert(violatedrows != NULL);
872  assert(violatedrowpos != NULL);
873  assert(nviolatedrows != NULL);
874  assert(-1 <= colidx && colidx < matrix->ncols);
875 
876  /* check if we requested an update for a single variable, or if we want to (re)-initialize the whole violation info */
877  if( colidx >= 0 )
878  getColumnData(matrix, colidx, NULL, &rowindices, &nrows);
879  else
880  {
881  nrows = matrix->nrows;
882  rowindices = NULL;
883  *nviolatedrows = 0;
884 
885  /* reinitialize the violated rows */
886  for( i = 0; i < nrows; ++i )
887  violatedrowpos[i] = -1;
888 
889  /* clear the violated row counters for all variables */
890  BMSclearMemoryArray(matrix->violrows, matrix->ndiscvars);
891  }
892 
893  assert(colidx < 0 || *nviolatedrows >= 0);
894  SCIPdebugMsg(scip, "Entering violation check for %d rows! \n", nrows);
895  /* loop over rows and check if it is violated */
896  for( i = 0; i < nrows; ++i )
897  {
898  int rowpos;
899  if( colidx >= 0 )
900  {
901  assert(rowindices != NULL);
902  rowpos = rowindices[i];
903  }
904  else
905  rowpos = i;
906  /* check, if zero solution violates this row */
907  checkRowViolation(scip, matrix, rowpos, violatedrows, violatedrowpos, nviolatedrows, rowweights, updateweights);
908 
909  assert((violatedrowpos[rowpos] == -1 && SCIPisFeasGE(scip, matrix->rhs[rowpos], 0.0) && SCIPisFeasLE(scip, matrix->lhs[rowpos], 0.0))
910  || (violatedrowpos[rowpos] >= 0 &&(SCIPisFeasLT(scip, matrix->rhs[rowpos], 0.0) || SCIPisFeasGT(scip, matrix->lhs[rowpos], 0.0))));
911  }
912 }
913 
914 /** retransforms solution values of variables according to their transformation status */
915 static
917  SCIP* scip, /**< current scip instance */
918  CONSTRAINTMATRIX* matrix, /**< constraint matrix object */
919  SCIP_VAR* var, /**< variable whose solution value has to be retransformed */
920  int varindex, /**< permutation of variable indices according to sorting */
921  SCIP_Real solvalue /**< solution value of the variable */
922  )
923 {
924  TRANSFORMSTATUS status;
925 
926  assert(matrix != NULL);
927  assert(var != NULL);
928 
929  status = matrix->transformstatus[varindex];
930  assert(status != TRANSFORMSTATUS_NONE);
931 
932  /* check if original variable has different bounds and transform solution value correspondingly */
933  if( status == TRANSFORMSTATUS_LB )
934  {
935  assert(!SCIPisInfinity(scip, -SCIPvarGetLbLocal(var)));
936 
937  return solvalue + matrix->transformshiftvals[varindex];
938  }
939  else if( status == TRANSFORMSTATUS_NEG )
940  {
941  assert(!SCIPisInfinity(scip, SCIPvarGetUbLocal(var)));
942  return matrix->transformshiftvals[varindex] - solvalue;
943  }
944  return solvalue;
945 }
946 
947 /** determines the best shifting value of a variable
948  * @todo if there is already an incumbent solution, try considering the objective cutoff as additional constraint */
949 static
951  SCIP* scip, /**< current scip instance */
952  CONSTRAINTMATRIX* matrix, /**< constraint matrix object */
953  int varindex, /**< index of variable which should be shifted */
954  int direction, /**< the direction for this variable */
955  int* rowweights, /**< weighting of rows for best shift calculation */
956  SCIP_Real* steps, /**< buffer array to store the individual steps for individual rows */
957  int* violationchange, /**< buffer array to store the individual change of feasibility of row */
958  SCIP_Real* beststep, /**< pointer to store optimal shifting step */
959  int* rowviolations /**< pointer to store new weighted sum of row violations, i.e, v - f */
960  )
961 {
962  SCIP_Real* vals;
963  int* rows;
964 
965  SCIP_Real slacksurplus;
966  SCIP_Real upperbound;
967 
968  int nrows;
969  int sum;
970  int i;
971 
972  SCIP_Bool allzero;
973 
974  assert(beststep != NULL);
975  assert(rowviolations != NULL);
976  assert(rowweights != NULL);
977  assert(steps != NULL);
978  assert(violationchange != NULL);
979  assert(direction == 1 || direction == -1);
980 
981  upperbound = matrix->upperbounds[varindex];
982 
983  /* get nonzero values and corresponding rows of variable */
984  getColumnData(matrix, varindex, &vals, &rows, &nrows);
985 
986  /* loop over rows and calculate, which is the minimum shift to make this row feasible
987  * or the minimum shift to violate this row
988  */
989  allzero = TRUE;
990  slacksurplus = 0.0;
991  for( i = 0; i < nrows; ++i )
992  {
993  SCIP_Real lhs;
994  SCIP_Real rhs;
995  SCIP_Real val;
996  int rowpos;
997  SCIP_Bool rowisviolated;
998  int rowweight;
999 
1000  /* get the row data */
1001  rowpos = rows[i];
1002  assert(rowpos >= 0);
1003  lhs = matrix->lhs[rowpos];
1004  rhs = matrix->rhs[rowpos];
1005  rowweight = rowweights[rowpos];
1006  val = direction * vals[i];
1007 
1008  /* determine if current row is violated or not */
1009  rowisviolated =(SCIPisFeasLT(scip, rhs, 0.0) || SCIPisFeasLT(scip, -lhs, 0.0));
1010 
1011  /* for a feasible row, determine the minimum integer value within the bounds of the variable by which it has to be
1012  * shifted to make row infeasible.
1013  */
1014  if( !rowisviolated )
1015  {
1016  SCIP_Real maxfeasshift;
1017 
1018  maxfeasshift = SCIPinfinity(scip);
1019 
1020  /* feasibility can only be violated if the variable has a lock in the corresponding direction,
1021  * i.e. a positive coefficient for a "<="-constraint, a negative coefficient for a ">="-constraint.
1022  */
1023  if( SCIPisFeasGT(scip, val, 0.0) && !SCIPisInfinity(scip, rhs) )
1024  maxfeasshift = SCIPfeasFloor(scip, rhs/val);
1025  else if( SCIPisFeasLT(scip, val, 0.0) && !SCIPisInfinity(scip, -lhs) )
1026  maxfeasshift = SCIPfeasFloor(scip, lhs/val);
1027 
1028  /* if the variable has no lock in the current row, it can still help to increase the slack of this row;
1029  * we measure slack increase for shifting by one
1030  */
1031  if( SCIPisFeasGT(scip, val, 0.0) && SCIPisInfinity(scip, rhs) )
1032  slacksurplus += val;
1033  if( SCIPisFeasLT(scip, val, 0.0) && SCIPisInfinity(scip, -lhs) )
1034  slacksurplus -= val;
1035 
1036  /* check if the least violating shift lies within variable bounds and set corresponding array values */
1037  if( !SCIPisInfinity(scip, maxfeasshift) && SCIPisFeasLE(scip, maxfeasshift + 1.0, upperbound) )
1038  {
1039  steps[i] = maxfeasshift + 1.0;
1040  violationchange[i] = rowweight;
1041  allzero = FALSE;
1042  }
1043  else
1044  {
1045  steps[i] = upperbound;
1046  violationchange[i] = 0;
1047  }
1048  }
1049  /* for a violated row, determine the minimum integral value within the bounds of the variable by which it has to be
1050  * shifted to make row feasible.
1051  */
1052  else
1053  {
1054  SCIP_Real minfeasshift;
1055 
1056  minfeasshift = SCIPinfinity(scip);
1057 
1058  /* if coefficient has the right sign to make row feasible, determine the minimum integer to shift variable
1059  * to obtain feasibility
1060  */
1061  if( SCIPisFeasLT(scip, -lhs, 0.0) && SCIPisFeasGT(scip, val, 0.0) )
1062  minfeasshift = SCIPfeasCeil(scip, lhs/val);
1063  else if( SCIPisFeasLT(scip, rhs,0.0) && SCIPisFeasLT(scip, val, 0.0) )
1064  minfeasshift = SCIPfeasCeil(scip, rhs/val);
1065 
1066  /* check if the minimum feasibility recovery shift lies within variable bounds and set corresponding array
1067  * values
1068  */
1069  if( !SCIPisInfinity(scip, minfeasshift) && SCIPisFeasLE(scip, minfeasshift, upperbound) )
1070  {
1071  steps[i] = minfeasshift;
1072  violationchange[i] = -rowweight;
1073  allzero = FALSE;
1074  }
1075  else
1076  {
1077  steps[i] = upperbound;
1078  violationchange[i] = 0;
1079  }
1080  }
1081  }
1082 
1083  /* in case that the variable cannot affect the feasibility of any row, in particular it cannot violate
1084  * a single row, but we can add slack to already feasible rows, we will do this
1085  */
1086  if( allzero )
1087  {
1088  if( ! SCIPisInfinity(scip, upperbound) && SCIPisGT(scip, slacksurplus, 0.0) )
1089  *beststep = direction * upperbound;
1090  else
1091  *beststep = 0.0;
1092 
1093  return SCIP_OKAY;
1094  }
1095 
1096  /* sorts rows by increasing value of steps */
1097  SCIPsortRealInt(steps, violationchange, nrows);
1098 
1099  *beststep = 0.0;
1100  *rowviolations = 0;
1101  sum = 0;
1102 
1103  /* best shifting step is calculated by summing up the violation changes for each relevant step and
1104  * taking the one which leads to the minimum sum. This sum measures the balance of feasibility recovering and
1105  * violating changes which will be obtained by shifting the variable by this step
1106  * note, the sums for smaller steps have to be taken into account for all bigger steps, i.e., the sums can be
1107  * computed iteratively
1108  */
1109  for( i = 0; i < nrows && !SCIPisInfinity(scip, steps[i]); ++i )
1110  {
1111  sum += violationchange[i];
1112 
1113  /* if we reached the last entry for the current step value, we have finished computing its sum and
1114  * update the step defining the minimum sum
1115  */
1116  if( (i == nrows-1 || steps[i+1] > steps[i]) && sum < *rowviolations ) /*lint !e679*/
1117  {
1118  *rowviolations = sum;
1119  *beststep = direction * steps[i];
1120  }
1121  }
1122  assert(*rowviolations <= 0);
1123  assert(!SCIPisInfinity(scip, *beststep));
1124 
1125  return SCIP_OKAY;
1126 }
1127 
1128 /** updates transformation of a given variable by taking into account current local bounds. if the bounds have changed
1129  * since last update, updating the heuristic specific upper bound of the variable, its current transformed solution value
1130  * and all affected rows is necessary.
1131  */
1132 static
1134  SCIP* scip, /**< current scip */
1135  CONSTRAINTMATRIX* matrix, /**< constraint matrix object */
1136  SCIP_HEURDATA* heurdata, /**< heuristic data */
1137  int varindex, /**< index of variable in matrix */
1138  SCIP_Real lb, /**< local lower bound of the variable */
1139  SCIP_Real ub, /**< local upper bound of the variable */
1140  int* violatedrows, /**< violated rows */
1141  int* violatedrowpos, /**< violated row positions */
1142  int* nviolatedrows /**< pointer to store number of violated rows */
1143  )
1144 {
1145  TRANSFORMSTATUS status;
1146  SCIP_Real deltashift;
1147  SCIP_Bool checkviolations;
1148 
1149  assert(scip != NULL);
1150  assert(matrix != NULL);
1151  assert(0 <= varindex && varindex < matrix->ndiscvars);
1152 
1153  /* deltashift is the difference between the old and new transformation value. */
1154  deltashift = 0.0;
1155  status = matrix->transformstatus[varindex];
1156 
1157  SCIPdebugMsg(scip, " Variable <%d> [%g,%g], status %d(%g), ub %g \n", varindex, lb, ub, status,
1158  matrix->transformshiftvals[varindex], matrix->upperbounds[varindex]);
1159 
1160  checkviolations = FALSE;
1161  /* depending on the variable status, deltashift is calculated differently. */
1162  switch( status )
1163  {
1164  case TRANSFORMSTATUS_LB:
1165  if( SCIPisInfinity(scip, -lb) )
1166  {
1167  transformVariable(scip, matrix, heurdata, varindex);
1168  checkviolations = TRUE;
1169  }
1170  else
1171  {
1172  deltashift = lb - (matrix->transformshiftvals[varindex]);
1173  matrix->transformshiftvals[varindex] = lb;
1174  if( !SCIPisInfinity(scip, ub) )
1175  matrix->upperbounds[varindex] = ub - lb;
1176  else
1177  matrix->upperbounds[varindex] = SCIPinfinity(scip);
1178  }
1179  break;
1180  case TRANSFORMSTATUS_NEG:
1181  if( SCIPisInfinity(scip, ub) )
1182  {
1183  transformVariable(scip, matrix, heurdata, varindex);
1184  checkviolations = TRUE;
1185  }
1186  else
1187  {
1188  deltashift = (matrix->transformshiftvals[varindex]) - ub;
1189  matrix->transformshiftvals[varindex] = ub;
1190 
1191  if( !SCIPisInfinity(scip, -lb) )
1192  matrix->upperbounds[varindex] = MIN(ub - lb, SCIPinfinity(scip)); /*lint !e666*/
1193  else
1194  matrix->upperbounds[varindex] = SCIPinfinity(scip);
1195  }
1196  break;
1197  case TRANSFORMSTATUS_FREE:
1198  /* in case of a free transform status, if one of the bounds has become finite, we want
1199  * to transform this variable to a variable with a lowerbound or a negated transform status */
1200  if( !SCIPisInfinity(scip, -lb) || !SCIPisInfinity(scip, ub) )
1201  {
1202  transformVariable(scip, matrix, heurdata, varindex);
1203 
1204  /* violations have to be rechecked for rows in which variable appears */
1205  checkviolations = TRUE;
1206 
1207  assert(matrix->transformstatus[varindex] == TRANSFORMSTATUS_LB || TRANSFORMSTATUS_NEG);
1208  assert(SCIPisLE(scip, ABS(lb), ABS(ub)) || matrix->transformstatus[varindex] == TRANSFORMSTATUS_NEG);
1209  }
1210  break;
1211 
1212  case TRANSFORMSTATUS_NONE:
1213  default:
1214  SCIPerrorMessage("Error: Invalid variable status <%d> in shift and propagagate heuristic, aborting!\n");
1215  SCIPABORT();
1216  return SCIP_INVALIDDATA; /*lint !e527*/
1217  }
1218  /* if the bound, by which the variable was shifted, has changed, deltashift is different from zero, which requires
1219  * an update of all affected rows
1220  */
1221  if( !SCIPisFeasZero(scip, deltashift) )
1222  {
1223  int i;
1224  int* rows;
1225  SCIP_Real* vals;
1226  int nrows;
1227 
1228  /* get nonzero values and corresponding rows of variable */
1229  getColumnData(matrix, varindex, &vals, &rows, &nrows);
1230 
1231  /* go through rows, update the rows w.r.t. the influence of the changed transformation of the variable */
1232  for( i = 0; i < nrows; ++i )
1233  {
1234  SCIPdebugMsg(scip, " update slacks of row<%d>: coefficient <%g>, %g <= 0 <= %g \n",
1235  rows[i], vals[i], matrix->lhs[rows[i]], matrix->rhs[rows[i]]);
1236 
1237  if( !SCIPisInfinity(scip, -(matrix->lhs[rows[i]])) )
1238  matrix->lhs[rows[i]] -= (vals[i]) * deltashift;
1239 
1240  if( !SCIPisInfinity(scip, matrix->rhs[rows[i]]) )
1241  matrix->rhs[rows[i]] -= (vals[i]) * deltashift;
1242  }
1243  checkviolations = TRUE;
1244  }
1245 
1246  /* check and update information about violated rows, if necessary */
1247  if( checkviolations )
1248  checkViolations(scip, matrix, varindex, violatedrows, violatedrowpos, nviolatedrows, heurdata->rowweights, heurdata->updateweights);
1249 
1250  SCIPdebugMsg(scip, " Variable <%d> [%g,%g], status %d(%g), ub %g \n", varindex, lb, ub, status,
1251  matrix->transformshiftvals[varindex], matrix->upperbounds[varindex]);
1252 
1253  return SCIP_OKAY;
1254 }
1255 
1256 /** comparison method for columns; binary < integer < implicit < continuous variables */
1257 static
1258 SCIP_DECL_SORTPTRCOMP(heurSortColsShiftandpropagate)
1260  SCIP_COL* col1;
1261  SCIP_COL* col2;
1262  SCIP_VAR* var1;
1263  SCIP_VAR* var2;
1264  SCIP_VARTYPE vartype1;
1265  SCIP_VARTYPE vartype2;
1266  int key1;
1267  int key2;
1268 
1269  col1 = (SCIP_COL*)elem1;
1270  col2 = (SCIP_COL*)elem2;
1271  var1 = SCIPcolGetVar(col1);
1272  var2 = SCIPcolGetVar(col2);
1273  assert(var1 != NULL && var2 != NULL);
1274 
1275  vartype1 = SCIPvarGetType(var1);
1276  vartype2 = SCIPvarGetType(var2);
1277 
1278  switch (vartype1)
1279  {
1280  case SCIP_VARTYPE_BINARY:
1281  key1 = 1;
1282  break;
1283  case SCIP_VARTYPE_INTEGER:
1284  key1 = 2;
1285  break;
1286  case SCIP_VARTYPE_IMPLINT:
1287  key1 = 3;
1288  break;
1290  key1 = 4;
1291  break;
1292  default:
1293  key1 = -1;
1294  SCIPerrorMessage("unknown variable type\n");
1295  SCIPABORT();
1296  break;
1297  }
1298  switch (vartype2)
1299  {
1300  case SCIP_VARTYPE_BINARY:
1301  key2 = 1;
1302  break;
1303  case SCIP_VARTYPE_INTEGER:
1304  key2 = 2;
1305  break;
1306  case SCIP_VARTYPE_IMPLINT:
1307  key2 = 3;
1308  break;
1310  key2 = 4;
1311  break;
1312  default:
1313  key2 = -1;
1314  SCIPerrorMessage("unknown variable type\n");
1315  SCIPABORT();
1316  break;
1317  }
1318  return key1 - key2;
1319 }
1320 
1321 /*
1322  * Callback methods of primal heuristic
1323  */
1324 
1325 /** deinitialization method of primal heuristic(called before transformed problem is freed) */
1326 static
1327 SCIP_DECL_HEUREXIT(heurExitShiftandpropagate)
1328 { /*lint --e{715}*/
1329  SCIP_HEURDATA* heurdata;
1330 
1331  heurdata = SCIPheurGetData(heur);
1332  assert(heurdata != NULL);
1333 
1334  /* free random number generator */
1335  SCIPfreeRandom(scip, &heurdata->randnumgen);
1336 
1337  /* if statistic mode is enabled, statistics are printed to console */
1338  SCIPstatistic(
1340  " DETAILS : %d violations left, %d probing status\n",
1341  heurdata->nremainingviols,
1342  heurdata->lpsolstat
1343  );
1345  " SHIFTANDPROPAGATE PROBING : %d probings, %" SCIP_LONGINT_FORMAT " domain reductions, ncutoffs: %d , LP iterations: %" SCIP_LONGINT_FORMAT " \n ",
1346  heurdata->nprobings,
1347  heurdata->ntotaldomredsfound,
1348  heurdata->ncutoffs,
1349  heurdata->nlpiters);
1350  );
1351 
1352  return SCIP_OKAY;
1353 }
1354 
1355 /** initialization method of primal heuristic(called after problem was transformed). We only need this method for
1356  * statistic mode of heuristic.
1357  */
1358 static
1359 SCIP_DECL_HEURINIT(heurInitShiftandpropagate)
1360 { /*lint --e{715}*/
1361  SCIP_HEURDATA* heurdata;
1362 
1363  heurdata = SCIPheurGetData(heur);
1364 
1365  assert(heurdata != NULL);
1366 
1367  /* create random number generator */
1368  SCIP_CALL( SCIPcreateRandom(scip, &heurdata->randnumgen,
1369  DEFAULT_RANDSEED, TRUE) );
1370 
1371  SCIPstatistic(
1372  heurdata->lpsolstat = SCIP_LPSOLSTAT_NOTSOLVED;
1373  heurdata->nremainingviols = 0;
1374  heurdata->nprobings = 0;
1375  heurdata->ntotaldomredsfound = 0;
1376  heurdata->ncutoffs = 0;
1377  heurdata->nlpiters = 0;
1378  )
1379  return SCIP_OKAY;
1380 }
1381 
1382 /** destructor of primal heuristic to free user data(called when SCIP is exiting) */
1383 static
1384 SCIP_DECL_HEURFREE(heurFreeShiftandpropagate)
1385 { /*lint --e{715}*/
1386  SCIP_HEURDATA* heurdata;
1387  SCIP_EVENTHDLR* eventhdlr;
1388  SCIP_EVENTHDLRDATA* eventhdlrdata;
1389 
1390  heurdata = SCIPheurGetData(heur);
1391  assert(heurdata != NULL);
1392  eventhdlr = heurdata->eventhdlr;
1393  assert(eventhdlr != NULL);
1394  eventhdlrdata = SCIPeventhdlrGetData(eventhdlr);
1395 
1396  SCIPfreeBlockMemoryNull(scip, &eventhdlrdata);
1397 
1398  /* free heuristic data */
1399  SCIPfreeBlockMemory(scip, &heurdata);
1400 
1401  SCIPheurSetData(heur, NULL);
1402 
1403  return SCIP_OKAY;
1404 }
1405 
1406 
1407 /** copy method for primal heuristic plugins(called when SCIP copies plugins) */
1408 static
1409 SCIP_DECL_HEURCOPY(heurCopyShiftandpropagate)
1410 { /*lint --e{715}*/
1411  assert(scip != NULL);
1412  assert(heur != NULL);
1413  assert(strcmp(SCIPheurGetName(heur), HEUR_NAME) == 0);
1414 
1415  /* call inclusion method of primal heuristic */
1417 
1418  return SCIP_OKAY;
1419 }
1420 
1421 /** execution method of primal heuristic */
1422 static
1423 SCIP_DECL_HEUREXEC(heurExecShiftandpropagate)
1424 { /*lint --e{715}*/
1425  SCIP_HEURDATA* heurdata; /* heuristic data */
1426  SCIP_EVENTHDLR* eventhdlr; /* shiftandpropagate event handler */
1427  SCIP_EVENTHDLRDATA* eventhdlrdata; /* event handler data */
1428  SCIP_EVENTDATA** eventdatas; /* event data for every variable */
1429 
1430  CONSTRAINTMATRIX* matrix; /* constraint matrix object */
1431  SCIP_COL** lpcols; /* lp columns */
1432  SCIP_SOL* sol; /* solution pointer */
1433  SCIP_Real* colnorms; /* contains Euclidean norms of column vectors */
1434 
1435  SCIP_Real* steps; /* buffer arrays for best shift selection in main loop */
1436  int* violationchange;
1437 
1438  int* violatedrows; /* the violated rows */
1439  int* violatedrowpos; /* the array position of a violated row, or -1 */
1440  int* permutation; /* reflects the position of the variables after sorting */
1441  int* violatedvarrows; /* number of violated rows for each variable */
1442  int* colposs; /* position of columns according to variable type sorting */
1443  int nlpcols; /* number of lp columns */
1444  int nviolatedrows; /* number of violated rows */
1445  int ndiscvars; /* number of non-continuous variables of the problem */
1446  int lastindexofsusp; /* last variable which has been swapped due to a cutoff */
1447  int nbinvars; /* number of binary variables */
1448  int nintvars; /* number of integer variables */
1449  int i;
1450  int r;
1451  int v;
1452  int c;
1453  int ncutoffs; /* counts the number of cutoffs for this execution */
1454  int nprobings; /* counts the number of probings */
1455  int nlprows; /* the number LP rows */
1456  int nmaxrows; /* maximum number of LP rows of a variable */
1457 
1458  SCIP_Bool initialized; /* has the matrix been initialized? */
1459  SCIP_Bool cutoff; /* has current probing node been cutoff? */
1460  SCIP_Bool probing; /* should probing be applied or not? */
1461  SCIP_Bool infeasible; /* FALSE as long as currently infeasible rows have variables left */
1462  SCIP_Bool impliscontinuous;
1463 
1464  heurdata = SCIPheurGetData(heur);
1465  assert(heurdata != NULL);
1466 
1467  eventhdlr = heurdata->eventhdlr;
1468  assert(eventhdlr != NULL);
1469 
1470  eventhdlrdata = SCIPeventhdlrGetData(eventhdlr);
1471  assert(eventhdlrdata != NULL);
1472 
1473  *result = SCIP_DIDNOTRUN;
1474  SCIPdebugMsg(scip, "entering execution method of shift and propagate heuristic\n");
1475 
1476  /* heuristic is obsolete if there are only continuous variables */
1477  if( SCIPgetNVars(scip) - SCIPgetNContVars(scip) == 0 )
1478  return SCIP_OKAY;
1479 
1480  /* stop execution method if there is already a primarily feasible solution at hand */
1481  if( SCIPgetBestSol(scip) != NULL && heurdata->onlywithoutsol )
1482  return SCIP_OKAY;
1483 
1484  /* stop if there is no LP available */
1485  if ( ! SCIPhasCurrentNodeLP(scip) )
1486  return SCIP_OKAY;
1487 
1488  if( !SCIPisLPConstructed(scip) )
1489  {
1490  /* @note this call can have the side effect that variables are created */
1491  SCIP_CALL( SCIPconstructLP(scip, &cutoff) );
1492 
1493  /* manually cut off the node if the LP construction detected infeasibility (heuristics cannot return such a result) */
1494  if( cutoff )
1495  {
1497  return SCIP_OKAY;
1498  }
1499 
1500  SCIP_CALL( SCIPflushLP(scip) );
1501  }
1502 
1503  SCIPstatistic( heurdata->nlpiters = SCIPgetNLPIterations(scip) );
1504 
1505  nlprows = SCIPgetNLPRows(scip);
1506 
1507  SCIP_CALL( SCIPgetLPColsData(scip, &lpcols, &nlpcols) );
1508  assert(nlpcols == 0 || lpcols != NULL);
1509 
1510  /* we need an LP */
1511  if( nlprows == 0 || nlpcols == 0 )
1512  return SCIP_OKAY;
1513 
1514  *result = SCIP_DIDNOTFIND;
1515  initialized = FALSE;
1516 
1517  /* allocate lp column array */
1518  SCIP_CALL( SCIPallocBufferArray(scip, &heurdata->lpcols, nlpcols) );
1519  heurdata->nlpcols = nlpcols;
1520 
1521  impliscontinuous = heurdata->impliscontinuous;
1522 
1523 #ifndef NDEBUG
1524  BMSclearMemoryArray(heurdata->lpcols, nlpcols);
1525 #endif
1526 
1527  /* copy and sort the columns by their variable types (binary before integer before implicit integer before continuous) */
1528  BMScopyMemoryArray(heurdata->lpcols, lpcols, nlpcols);
1529 
1530  SCIPsortPtr((void**)heurdata->lpcols, heurSortColsShiftandpropagate, nlpcols);
1531 
1532  SCIP_CALL( SCIPallocBufferArray(scip, &colposs, nlpcols) );
1533 
1534  /* we have to collect the number of different variable types before we start probing since during probing variable
1535  * can be created (e.g., cons_xor.c)
1536  */
1537  ndiscvars = 0;
1538  nbinvars = 0;
1539  nintvars = 0;
1540  for( c = 0; c < nlpcols; ++c )
1541  {
1542  SCIP_COL* col;
1543  SCIP_VAR* colvar;
1544 
1545  col = heurdata->lpcols[c];
1546  assert(col != NULL);
1547  colvar = SCIPcolGetVar(col);
1548  assert(colvar != NULL);
1549 
1550  if( varIsDiscrete(colvar, impliscontinuous) )
1551  ++ndiscvars;
1552  if( SCIPvarGetType(colvar) == SCIP_VARTYPE_BINARY )
1553  ++nbinvars;
1554  else if( SCIPvarGetType(colvar) == SCIP_VARTYPE_INTEGER )
1555  ++nintvars;
1556 
1557  /* save the position of this column in the array such that it can be accessed as the "true" column position */
1558  assert(SCIPcolGetLPPos(col) >= 0);
1559  colposs[SCIPcolGetLPPos(col)] = c;
1560  }
1561  assert(nbinvars + nintvars <= ndiscvars);
1562 
1563  /* start probing mode */
1564  SCIP_CALL( SCIPstartProbing(scip) );
1565 
1566  /* enables collection of variable statistics during probing */
1567  if( heurdata->collectstats )
1568  SCIPenableVarHistory(scip);
1569  else
1570  SCIPdisableVarHistory(scip);
1571 
1572  /* this should always be fulfilled becase we perform shift and propagate only at the root node */
1573  assert(SCIP_MAXTREEDEPTH > SCIPgetDepth(scip));
1574 
1575  /* @todo check if this node is necessary (I don't think so) */
1576  SCIP_CALL( SCIPnewProbingNode(scip) );
1577  ncutoffs = 0;
1578  nprobings = 0;
1579  nmaxrows = 0;
1580  infeasible = FALSE;
1581 
1582  /* initialize heuristic matrix and working solution */
1583  SCIP_CALL( SCIPallocBuffer(scip, &matrix) );
1584  SCIP_CALL( initMatrix(scip, matrix, heurdata, colposs, heurdata->normalize, &nmaxrows, heurdata->relax, &initialized, &infeasible) );
1585 
1586  /* could not initialize matrix */
1587  if( !initialized || infeasible )
1588  {
1589  SCIPdebugMsg(scip, " MATRIX not initialized -> Execution of heuristic stopped! \n");
1590  goto TERMINATE;
1591  }
1592 
1593  /* the number of discrete LP column variables can be less than the actual number of variables, if, e.g., there
1594  * are nonlinearities in the problem. The heuristic execution can be terminated in that case.
1595  */
1596  if( matrix->ndiscvars < ndiscvars )
1597  {
1598  SCIPdebugMsg(scip, "Not all discrete variables are in the current LP. Shiftandpropagate execution terminated.\n");
1599  goto TERMINATE;
1600  }
1601 
1602  assert(nmaxrows > 0);
1603 
1604  eventhdlrdata->matrix = matrix;
1605  eventhdlrdata->heurdata = heurdata;
1606 
1607  SCIP_CALL( SCIPcreateSol(scip, &sol, heur) );
1608  SCIPsolSetHeur(sol, heur);
1609 
1610  /* allocate arrays for execution method */
1611  SCIP_CALL( SCIPallocBufferArray(scip, &permutation, ndiscvars) );
1612  SCIP_CALL( SCIPallocBufferArray(scip, &heurdata->rowweights, matrix->nrows) );
1613 
1614  /* allocate necessary memory for best shift search */
1615  SCIP_CALL( SCIPallocBufferArray(scip, &steps, nmaxrows) );
1616  SCIP_CALL( SCIPallocBufferArray(scip, &violationchange, nmaxrows) );
1617 
1618  /* allocate arrays to store information about infeasible rows */
1619  SCIP_CALL( SCIPallocBufferArray(scip, &violatedrows, matrix->nrows) );
1620  SCIP_CALL( SCIPallocBufferArray(scip, &violatedrowpos, matrix->nrows) );
1621 
1622  eventhdlrdata->violatedrows = violatedrows;
1623  eventhdlrdata->violatedrowpos = violatedrowpos;
1624  eventhdlrdata->nviolatedrows = &nviolatedrows;
1625 
1626  /* initialize arrays. Before sorting, permutation is the identity permutation */
1627  for( i = 0; i < ndiscvars; ++i )
1628  permutation[i] = i;
1629 
1630  /* initialize row weights */
1631  for( r = 0; r < matrix->nrows; ++r )
1632  {
1633  if( !SCIPisInfinity(scip, -(matrix->lhs[r])) && !SCIPisInfinity(scip, matrix->rhs[r]) )
1634  heurdata->rowweights[r] = DEFAULT_WEIGHT_EQUALITY;
1635  else
1636  heurdata->rowweights[r] = DEFAULT_WEIGHT_INEQUALITY;
1637  }
1638  colnorms = matrix->colnorms;
1639 
1640  assert(nbinvars >= 0);
1641  assert(nintvars >= 0);
1642 
1643  /* check rows for infeasibility */
1644  checkViolations(scip, matrix, -1, violatedrows, violatedrowpos, &nviolatedrows, heurdata->rowweights, heurdata->updateweights);
1645 
1646  /* allocate memory for violatedvarrows array only if variable ordering relies on it */
1647  if( heurdata->sortvars && (heurdata->sortkey == 't' || heurdata->sortkey == 'v') )
1648  {
1649  SCIP_CALL( SCIPallocBufferArray(scip, &violatedvarrows, ndiscvars) );
1650  BMScopyMemoryArray(violatedvarrows, matrix->violrows, ndiscvars);
1651  }
1652  else
1653  violatedvarrows = NULL;
1654 
1655  /* sort variables w.r.t. the sorting key parameter. Sorting is indirect, all matrix column data
1656  * stays in place, but permutation array gives access to the sorted order of variables
1657  */
1658  if( heurdata->sortvars )
1659  {
1660  switch (heurdata->sortkey)
1661  {
1662  case 'n':
1663  /* variable ordering w.r.t. column norms nonincreasing */
1664  if( heurdata->preferbinaries )
1665  {
1666  if( nbinvars > 0 )
1667  SCIPsortDownRealInt(colnorms, permutation, nbinvars);
1668  if( nbinvars < ndiscvars )
1669  SCIPsortDownRealInt(&colnorms[nbinvars], &permutation[nbinvars], ndiscvars - nbinvars);
1670  }
1671  else
1672  {
1673  SCIPsortDownRealInt(colnorms, permutation, ndiscvars);
1674  }
1675  SCIPdebugMsg(scip, "Variables sorted down w.r.t their normalized columns!\n");
1676  break;
1677  case 'u':
1678  /* variable ordering w.r.t. column norms nondecreasing */
1679  if( heurdata->preferbinaries )
1680  {
1681  if( nbinvars > 0 )
1682  SCIPsortRealInt(colnorms, permutation, nbinvars);
1683  if( nbinvars < ndiscvars )
1684  SCIPsortRealInt(&colnorms[nbinvars], &permutation[nbinvars], ndiscvars - nbinvars);
1685  }
1686  else
1687  {
1688  SCIPsortRealInt(colnorms, permutation, ndiscvars);
1689  }
1690  SCIPdebugMsg(scip, "Variables sorted w.r.t their normalized columns!\n");
1691  break;
1692  case 'v':
1693  /* variable ordering w.r.t. nonincreasing number of violated rows */
1694  assert(violatedvarrows != NULL);
1695  if( heurdata->preferbinaries )
1696  {
1697  if( nbinvars > 0 )
1698  SCIPsortDownIntInt(violatedvarrows, permutation, nbinvars);
1699  if( nbinvars < ndiscvars )
1700  SCIPsortDownIntInt(&violatedvarrows[nbinvars], &permutation[nbinvars], ndiscvars - nbinvars);
1701  }
1702  else
1703  {
1704  SCIPsortDownIntInt(violatedvarrows, permutation, ndiscvars);
1705  }
1706 
1707  SCIPdebugMsg(scip, "Variables sorted down w.r.t their number of currently infeasible rows!\n");
1708  break;
1709  case 't':
1710  /* variable ordering w.r.t. nondecreasing number of violated rows */
1711  assert(violatedvarrows != NULL);
1712  if( heurdata->preferbinaries )
1713  {
1714  if( nbinvars > 0 )
1715  SCIPsortIntInt(violatedvarrows, permutation, nbinvars);
1716  if( nbinvars < ndiscvars )
1717  SCIPsortIntInt(&violatedvarrows[nbinvars], &permutation[nbinvars], ndiscvars - nbinvars);
1718  }
1719  else
1720  {
1721  SCIPsortIntInt(violatedvarrows, permutation, ndiscvars);
1722  }
1723 
1724  SCIPdebugMsg(scip, "Variables sorted (upwards) w.r.t their number of currently infeasible rows!\n");
1725  break;
1726  case 'r':
1727  /* random sorting */
1728  if( heurdata->preferbinaries )
1729  {
1730  if( nbinvars > 0 )
1731  SCIPrandomPermuteIntArray(heurdata->randnumgen, permutation, 0, nbinvars - 1);
1732  if( nbinvars < ndiscvars )
1733  SCIPrandomPermuteIntArray(heurdata->randnumgen, &permutation[nbinvars], nbinvars - 1,
1734  ndiscvars - nbinvars - 1);
1735  }
1736  else
1737  {
1738  SCIPrandomPermuteIntArray(heurdata->randnumgen, permutation, 0, ndiscvars - 1);
1739  }
1740  SCIPdebugMsg(scip, "Variables permuted randomly!\n");
1741  break;
1742  default:
1743  SCIPdebugMsg(scip, "No variable permutation applied\n");
1744  break;
1745  }
1746  }
1747 
1748  /* should binary variables without locks be treated first? */
1749  if( heurdata->binlocksfirst )
1750  {
1751  SCIP_VAR* var;
1752  int nbinwithoutlocks = 0;
1753 
1754  /* count number of binaries without locks */
1755  if( heurdata->preferbinaries )
1756  {
1757  for( c = 0; c < nbinvars; ++c )
1758  {
1759  var = SCIPcolGetVar(heurdata->lpcols[permutation[c]]);
1762  ++nbinwithoutlocks;
1763  }
1764  }
1765  else
1766  {
1767  for( c = 0; c < ndiscvars; ++c )
1768  {
1769  var = SCIPcolGetVar(heurdata->lpcols[permutation[c]]);
1770  if( SCIPvarIsBinary(var) )
1771  {
1774  ++nbinwithoutlocks;
1775  }
1776  }
1777  }
1778 
1779  if( nbinwithoutlocks > 0 )
1780  {
1781  SCIP_VAR* binvar;
1782  int b = 1;
1783  int tmp;
1784  c = 0;
1785 
1786  /* if c reaches nbinwithoutlocks, then all binary variables without locks were sorted to the beginning of the array */
1787  while( c < nbinwithoutlocks && b < ndiscvars )
1788  {
1789  assert(c < b);
1790  assert(c < ndiscvars);
1791  assert(b < ndiscvars);
1792  var = SCIPcolGetVar(heurdata->lpcols[permutation[c]]);
1793  binvar = SCIPcolGetVar(heurdata->lpcols[permutation[b]]);
1794 
1795  /* search for next variable which is not a binary variable without locks */
1798  {
1799  ++c;
1800  if( c >= nbinwithoutlocks )
1801  break;
1802  var = SCIPcolGetVar(heurdata->lpcols[permutation[c]]);
1803  }
1804  if( c >= nbinwithoutlocks )
1805  break;
1806 
1807  /* search for next binary variable without locks (with position > c) */
1808  if( b <= c )
1809  {
1810  b = c + 1;
1811  binvar = SCIPcolGetVar(heurdata->lpcols[permutation[b]]);
1812  }
1813  while( !SCIPvarIsBinary(binvar) || (SCIPvarGetNLocksUpType(binvar, SCIP_LOCKTYPE_MODEL) > 0
1815  {
1816  ++b;
1817  assert(b < ndiscvars);
1818  binvar = SCIPcolGetVar(heurdata->lpcols[permutation[b]]);
1819  }
1820 
1821  /* swap the two variables */
1822  tmp = permutation[b];
1823  permutation[b] = permutation[c];
1824  permutation[c] = tmp;
1825 
1826  /* increase counters */
1827  ++c;
1828  ++b;
1829  }
1830  }
1831 
1832 #ifndef NDEBUG
1833  for( c = 0; c < ndiscvars; ++c )
1834  {
1835  assert((c < nbinwithoutlocks) == (SCIPvarIsBinary(SCIPcolGetVar(heurdata->lpcols[permutation[c]]))
1836  && (SCIPvarGetNLocksUpType(SCIPcolGetVar(heurdata->lpcols[permutation[c]]), SCIP_LOCKTYPE_MODEL) == 0
1837  || SCIPvarGetNLocksDownType(SCIPcolGetVar(heurdata->lpcols[permutation[c]]), SCIP_LOCKTYPE_MODEL) == 0)));
1838  }
1839 #endif
1840  }
1841 
1842  SCIP_CALL( SCIPallocBufferArray(scip, &eventdatas, matrix->ndiscvars) );
1843  BMSclearMemoryArray(eventdatas, matrix->ndiscvars);
1844 
1845  /* initialize variable events to catch bound changes during propagation */
1846  for( c = 0; c < matrix->ndiscvars; ++c )
1847  {
1848  SCIP_VAR* var;
1849 
1850  var = SCIPcolGetVar(heurdata->lpcols[c]);
1851  assert(var != NULL);
1852  assert(SCIPvarIsIntegral(var));
1853  assert(eventdatas[c] == NULL);
1854 
1855  SCIP_CALL( SCIPallocBuffer(scip, &(eventdatas[c])) ); /*lint !e866*/
1856 
1857  eventdatas[c]->colpos = c;
1858 
1859  SCIP_CALL( SCIPcatchVarEvent(scip, var, EVENTTYPE_SHIFTANDPROPAGATE, eventhdlr, eventdatas[c], NULL) );
1860  }
1861 
1862  cutoff = FALSE;
1863 
1864  lastindexofsusp = -1;
1865  probing = heurdata->probing;
1866  infeasible = FALSE;
1867 
1868  SCIPdebugMsg(scip, "SHIFT_AND_PROPAGATE heuristic starts main loop with %d violations and %d remaining variables!\n",
1869  nviolatedrows, ndiscvars);
1870 
1871  assert(matrix->ndiscvars == ndiscvars);
1872 
1873  /* loop over variables, shift them according to shifting criteria and try to reduce the global infeasibility */
1874  for( c = 0; c < ndiscvars; ++c )
1875  {
1876  SCIP_VAR* var;
1877  SCIP_Longint ndomredsfound;
1878  SCIP_Real optimalshiftvalue;
1879  SCIP_Real origsolval;
1880  SCIP_Real lb;
1881  SCIP_Real ub;
1882  int nviolations;
1883  int permutedvarindex;
1884  int j;
1885  SCIP_Bool marksuspicious;
1886 
1887  if( heurdata->selectbest )
1888  { /* search for best candidate */
1889  j = c + 1;
1890  while( j < ndiscvars )
1891  {
1892  /* run through remaining variables and search for best candidate */
1893  if( matrix->violrows[permutation[c]] < matrix->violrows[permutation[j]] )
1894  {
1895  int tmp;
1896  tmp = permutation[c];
1897  permutation[c] = permutation[j];
1898  permutation[j] = tmp;
1899  }
1900  ++j;
1901  }
1902  }
1903  permutedvarindex = permutation[c];
1904  optimalshiftvalue = 0.0;
1905  nviolations = 0;
1906  var = SCIPcolGetVar(heurdata->lpcols[permutedvarindex]);
1907  lb = SCIPvarGetLbLocal(var);
1908  ub = SCIPvarGetUbLocal(var);
1909  assert(SCIPcolGetLPPos(SCIPvarGetCol(var)) >= 0);
1910  assert(SCIPvarIsIntegral(var));
1911 
1912  /* check whether we hit some limit, e.g. the time limit, in between
1913  * since the check itself consumes some time, we only do it every tenth iteration
1914  */
1915  if( c % 10 == 0 && SCIPisStopped(scip) )
1916  goto TERMINATE2;
1917 
1918  /* if propagation is enabled, check if propagation has changed the variables bounds
1919  * and update the transformed upper bound correspondingly
1920  * @todo this should not be necessary
1921  */
1922  if( heurdata->probing )
1923  SCIP_CALL( updateTransformation(scip, matrix, heurdata, permutedvarindex,lb, ub, violatedrows, violatedrowpos,
1924  &nviolatedrows) );
1925 
1926  SCIPdebugMsg(scip, "Variable %s with local bounds [%g,%g], status <%d>, matrix bound <%g>\n",
1927  SCIPvarGetName(var), lb, ub, matrix->transformstatus[permutedvarindex], matrix->upperbounds[permutedvarindex]);
1928 
1929  /* ignore variable if propagation fixed it (lb and ub will be zero) */
1930  if( SCIPisFeasZero(scip, matrix->upperbounds[permutedvarindex]) )
1931  {
1932  assert(!SCIPisInfinity(scip, ub));
1933  assert(SCIPisFeasEQ(scip, lb, ub));
1934 
1935  SCIP_CALL( SCIPsetSolVal(scip, sol, var, ub) );
1936 
1937  continue;
1938  }
1939 
1940  marksuspicious = FALSE;
1941 
1942  /* check whether the variable is binary and has no locks in one direction, so that we want to fix it to the
1943  * respective bound (only enabled by parameter)
1944  */
1945  if( heurdata->fixbinlocks && SCIPvarIsBinary(var)
1948  {
1950  origsolval = SCIPvarGetUbLocal(var);
1951  else
1952  {
1953  assert(SCIPvarGetNLocksDownType(var, SCIP_LOCKTYPE_MODEL) == 0);
1954  origsolval = SCIPvarGetLbLocal(var);
1955  }
1956  }
1957  else
1958  {
1959  /* only apply the computationally expensive best shift selection, if there is a violated row left */
1960  if( !heurdata->stopafterfeasible || nviolatedrows > 0 )
1961  {
1962  /* compute optimal shift value for variable */
1963  SCIP_CALL( getOptimalShiftingValue(scip, matrix, permutedvarindex, 1, heurdata->rowweights, steps, violationchange,
1964  &optimalshiftvalue, &nviolations) );
1965  assert(SCIPisFeasGE(scip, optimalshiftvalue, 0.0));
1966 
1967  /* Variables with FREE transform have to be dealt with twice */
1968  if( matrix->transformstatus[permutedvarindex] == TRANSFORMSTATUS_FREE )
1969  {
1970  SCIP_Real downshiftvalue;
1971  int ndownviolations;
1972 
1973  downshiftvalue = 0.0;
1974  ndownviolations = 0;
1975  SCIP_CALL( getOptimalShiftingValue(scip, matrix, permutedvarindex, -1, heurdata->rowweights, steps, violationchange,
1976  &downshiftvalue, &ndownviolations) );
1977 
1978  assert(SCIPisLE(scip, downshiftvalue, 0.0));
1979 
1980  /* compare to positive direction and select the direction which makes more rows feasible */
1981  if( ndownviolations < nviolations )
1982  {
1983  optimalshiftvalue = downshiftvalue;
1984  }
1985  }
1986  }
1987  else
1988  optimalshiftvalue = 0.0;
1989 
1990  /* if zero optimal shift values are forbidden by the user parameter, delay the variable by marking it suspicious */
1991  if( heurdata->nozerofixing && nviolations > 0 && SCIPisFeasZero(scip, optimalshiftvalue) )
1992  marksuspicious = TRUE;
1993 
1994  /* retransform the solution value from the heuristic transformation space */
1995  assert(varIsDiscrete(var, impliscontinuous));
1996  origsolval = retransformVariable(scip, matrix, var, permutedvarindex, optimalshiftvalue);
1997  }
1998  assert(SCIPisFeasGE(scip, origsolval, lb) && SCIPisFeasLE(scip, origsolval, ub));
1999 
2000  /* check if propagation should still be performed
2001  * @todo do we need the hard coded value? we could use SCIP_MAXTREEDEPTH
2002  */
2003  if( nprobings > DEFAULT_PROPBREAKER )
2004  probing = FALSE;
2005 
2006  /* if propagation is enabled, fix the variable to the new solution value and propagate the fixation
2007  * (to fix other variables and to find out early whether solution is already infeasible)
2008  */
2009  if( !marksuspicious && probing )
2010  {
2011  /* this assert should be always fulfilled because we run this heuristic at the root node only and do not
2012  * perform probing if nprobings is less than DEFAULT_PROPBREAKER (currently: 65000)
2013  */
2014  assert(SCIP_MAXTREEDEPTH > SCIPgetDepth(scip));
2015 
2016  SCIP_CALL( SCIPnewProbingNode(scip) );
2017  SCIP_CALL( SCIPfixVarProbing(scip, var, origsolval) );
2018  ndomredsfound = 0;
2019 
2020  SCIPdebugMsg(scip, " Shift %g(%g originally) is optimal, propagate solution\n", optimalshiftvalue, origsolval);
2021  SCIP_CALL( SCIPpropagateProbing(scip, heurdata->nproprounds, &cutoff, &ndomredsfound) );
2022 
2023  ++nprobings;
2024  SCIPstatistic( heurdata->ntotaldomredsfound += ndomredsfound );
2025  SCIPdebugMsg(scip, "Propagation finished! <%" SCIP_LONGINT_FORMAT "> domain reductions %s, <%d> probing depth\n", ndomredsfound, cutoff ? "CUTOFF" : "",
2026  SCIPgetProbingDepth(scip));
2027  }
2028  assert(!cutoff || probing);
2029 
2030  /* propagation led to an empty domain, hence we backtrack and postpone the variable */
2031  if( cutoff )
2032  {
2033  assert(probing);
2034 
2035  ++ncutoffs;
2036 
2037  /* only continue heuristic if number of cutoffs occured so far is reasonably small */
2038  if( heurdata->cutoffbreaker >= 0 && ncutoffs >= ((heurdata->maxcutoffquot * SCIPgetProbingDepth(scip)) + heurdata->cutoffbreaker) )
2039  break;
2040 
2041  cutoff = FALSE;
2042 
2043  /* backtrack to the parent of the current node */
2044  assert(SCIPgetProbingDepth(scip) >= 1);
2046 
2047  /* this assert should be always fulfilled because we run this heuristic at the root node only and do not
2048  * perform probing if nprobings is less than DEFAULT_PROPBREAKER (currently: 65000)
2049  */
2050  assert(SCIP_MAXTREEDEPTH > SCIPgetDepth(scip));
2051 
2052  /* if the variable upper and lower bound are equal to the solution value to which we tried to fix the variable,
2053  * we are trapped at an infeasible node and break; this can only happen due to an intermediate global bound change of the variable,
2054  * I guess
2055  */
2056  if( SCIPisFeasEQ(scip, SCIPvarGetUbLocal(var), origsolval) && SCIPisFeasEQ(scip, SCIPvarGetLbLocal(var), origsolval) )
2057  {
2058  cutoff = TRUE;
2059  break;
2060  }
2061  else if( SCIPisFeasEQ(scip, SCIPvarGetLbLocal(var), origsolval) )
2062  {
2063  /* if the variable were to be set to one of its bounds, repropagate by tightening this bound by 1.0
2064  * into the direction of the other bound, if possible */
2065  assert(SCIPisFeasGE(scip, SCIPvarGetUbLocal(var), origsolval + 1.0));
2066 
2067  ndomredsfound = 0;
2068  SCIP_CALL( SCIPnewProbingNode(scip) );
2069  SCIP_CALL( SCIPchgVarLbProbing(scip, var, origsolval + 1.0) );
2070  SCIP_CALL( SCIPpropagateProbing(scip, heurdata->nproprounds, &cutoff, &ndomredsfound) );
2071 
2072  SCIPstatistic( heurdata->ntotaldomredsfound += ndomredsfound );
2073  }
2074  else if( SCIPisFeasEQ(scip, SCIPvarGetUbLocal(var), origsolval) )
2075  {
2076  /* if the variable were to be set to one of its bounds, repropagate by tightening this bound by 1.0
2077  * into the direction of the other bound, if possible */
2078  assert(SCIPisFeasLE(scip, SCIPvarGetLbLocal(var), origsolval - 1.0));
2079 
2080  ndomredsfound = 0;
2081 
2082  SCIP_CALL( SCIPnewProbingNode(scip) );
2083  SCIP_CALL( SCIPchgVarUbProbing(scip, var, origsolval - 1.0) );
2084  SCIP_CALL( SCIPpropagateProbing(scip, heurdata->nproprounds, &cutoff, &ndomredsfound) );
2085 
2086  SCIPstatistic( heurdata->ntotaldomredsfound += ndomredsfound );
2087  }
2088 
2089  /* if the tightened bound again leads to a cutoff, both subproblems are proven infeasible and the heuristic
2090  * can be stopped */
2091  if( cutoff )
2092  {
2093  break;
2094  }
2095  else
2096  {
2097  /* since repropagation was successful, we indicate that this variable led to a cutoff in one direction */
2098  marksuspicious = TRUE;
2099  }
2100  }
2101 
2102  if( marksuspicious )
2103  {
2104  /* mark the variable as suspicious */
2105  assert(permutedvarindex == permutation[c]);
2106 
2107  ++lastindexofsusp;
2108  assert(lastindexofsusp >= 0 && lastindexofsusp <= c);
2109 
2110  permutation[c] = permutation[lastindexofsusp];
2111  permutation[lastindexofsusp] = permutedvarindex;
2112 
2113  SCIPdebugMsg(scip, " Suspicious variable! Postponed from pos <%d> to position <%d>\n", c, lastindexofsusp);
2114  }
2115  else
2116  {
2117  SCIPdebugMsg(scip, "Variable <%d><%s> successfully shifted by value <%g>!\n", permutedvarindex,
2118  SCIPvarGetName(var), optimalshiftvalue);
2119 
2120  /* update solution */
2121  SCIP_CALL( SCIPsetSolVal(scip, sol, var, origsolval) );
2122 
2123  /* only to ensure that some assertions can be made later on */
2124  if( !probing )
2125  {
2126  SCIP_CALL( SCIPfixVarProbing(scip, var, origsolval) );
2127  }
2128  }
2129  }
2130  SCIPdebugMsg(scip, "Heuristic finished with %d remaining violations and %d remaining variables!\n",
2131  nviolatedrows, lastindexofsusp + 1);
2132 
2133  /* if constructed solution might be feasible, go through the queue of suspicious variables and set the solution
2134  * values
2135  */
2136  if( nviolatedrows == 0 && !cutoff )
2137  {
2138  SCIP_Bool stored;
2139  SCIP_Bool trysol;
2140 
2141  for( v = 0; v <= lastindexofsusp; ++v )
2142  {
2143  SCIP_VAR* var;
2144  SCIP_Real origsolval;
2145  int permutedvarindex;
2146 
2147  /* get the column position of the variable */
2148  permutedvarindex = permutation[v];
2149  var = SCIPcolGetVar(heurdata->lpcols[permutedvarindex]);
2150  assert(varIsDiscrete(var, impliscontinuous));
2151 
2152  /* update the transformation of the variable, since the bound might have changed after the last update. */
2153  if( heurdata->probing )
2154  SCIP_CALL( updateTransformation(scip, matrix, heurdata, permutedvarindex, SCIPvarGetLbLocal(var),
2155  SCIPvarGetUbLocal(var), violatedrows, violatedrowpos, &nviolatedrows) );
2156 
2157  /* retransform the solution value from the heuristic transformed space, set the solution value accordingly */
2158  assert(varIsDiscrete(var, impliscontinuous));
2159  origsolval = retransformVariable(scip, matrix, var, permutedvarindex, 0.0);
2160  assert(SCIPisFeasGE(scip, origsolval, SCIPvarGetLbLocal(var))
2161  && SCIPisFeasLE(scip, origsolval, SCIPvarGetUbLocal(var)));
2162  SCIP_CALL( SCIPsetSolVal(scip, sol, var, origsolval) );
2163  SCIP_CALL( SCIPfixVarProbing(scip, var, origsolval) ); /* only to ensure that some assertions can be made later */
2164 
2165  SCIPdebugMsg(scip, " Remaining variable <%s> set to <%g>; %d Violations\n", SCIPvarGetName(var), origsolval,
2166  nviolatedrows);
2167  }
2168 
2169  /* Fixing of remaining variables led to infeasibility */
2170  if( nviolatedrows > 0 )
2171  goto TERMINATE2;
2172 
2173  trysol = TRUE;
2174 
2175  /* if the constructed solution might still be extendable to a feasible solution, try this by
2176  * solving the remaining LP
2177  */
2178  if( nlpcols != matrix->ndiscvars )
2179  {
2180  /* case that remaining LP has to be solved */
2181  SCIP_Bool lperror;
2182 
2183 #ifndef NDEBUG
2184  {
2185  SCIP_VAR** vars;
2186 
2187  vars = SCIPgetVars(scip);
2188  assert(vars != NULL);
2189  /* ensure that all discrete variables in the remaining LP are fixed */
2190  for( v = 0; v < ndiscvars; ++v )
2191  {
2192  if( SCIPvarIsInLP(vars[v]) )
2193  assert(SCIPisFeasEQ(scip, SCIPvarGetLbLocal(vars[v]), SCIPvarGetUbLocal(vars[v])));
2194  }
2195  }
2196 #endif
2197 
2198  SCIPdebugMsg(scip, " -> old LP iterations: %" SCIP_LONGINT_FORMAT "\n", SCIPgetNLPIterations(scip));
2199 
2200 #ifdef SCIP_DEBUG
2201  SCIP_CALL( SCIPwriteLP(scip, "shiftandpropagatelp.mps") );
2202 #endif
2203  /* solve LP;
2204  * errors in the LP solver should not kill the overall solving process, if the LP is just needed for a heuristic.
2205  * hence in optimized mode, the return code is caught and a warning is printed, only in debug mode, SCIP will stop.
2206  */
2207 #ifdef NDEBUG
2208  {
2209  SCIP_RETCODE retstat;
2210  retstat = SCIPsolveProbingLP(scip, -1, &lperror, NULL);
2211  if( retstat != SCIP_OKAY )
2212  {
2213  SCIPwarningMessage(scip, "Error while solving LP in SHIFTANDPROPAGATE heuristic; LP solve terminated with code <%d>\n",
2214  retstat);
2215  }
2216  }
2217 #else
2218  SCIP_CALL( SCIPsolveProbingLP(scip, -1, &lperror, NULL) );
2219 #endif
2220 
2221  SCIPdebugMsg(scip, " -> new LP iterations: %" SCIP_LONGINT_FORMAT "\n", SCIPgetNLPIterations(scip));
2222  SCIPdebugMsg(scip, " -> error=%u, status=%d\n", lperror, SCIPgetLPSolstat(scip));
2223 
2224  /* check if this is a feasible solution */
2225  if( !lperror && SCIPgetLPSolstat(scip) == SCIP_LPSOLSTAT_OPTIMAL )
2226  {
2227  /* copy the current LP solution to the working solution */
2228  SCIP_CALL( SCIPlinkLPSol(scip, sol) );
2229  }
2230  else
2231  trysol = FALSE;
2232 
2233  SCIPstatistic( heurdata->lpsolstat = SCIPgetLPSolstat(scip) );
2234  }
2235 
2236  /* check solution for feasibility, and add it to solution store if possible.
2237  * None of integrality, feasibility of LP rows, variable bounds have to be checked, because they
2238  * are guaranteed by the heuristic at this stage.
2239  */
2240  if( trysol )
2241  {
2242  SCIP_Bool printreason;
2243  SCIP_Bool completely;
2244 #ifdef SCIP_DEBUG
2245  printreason = TRUE;
2246 #else
2247  printreason = FALSE;
2248 #endif
2249 #ifndef NDEBUG
2250  completely = TRUE; /*lint !e838*/
2251 #else
2252  completely = FALSE;
2253 #endif
2254 
2255  /* we once also checked the variable bounds which should not be necessary */
2256  SCIP_CALL( SCIPtrySol(scip, sol, printreason, completely, FALSE, FALSE, FALSE, &stored) );
2257 
2258  if( stored )
2259  {
2260  SCIPdebugMsg(scip, "found feasible shifted solution:\n");
2261  SCIPdebug( SCIP_CALL( SCIPprintSol(scip, sol, NULL, FALSE) ) );
2262  *result = SCIP_FOUNDSOL;
2263 
2264  SCIPstatisticMessage(" Shiftandpropagate solution value: %16.9g \n", SCIPgetSolOrigObj(scip, sol));
2265  }
2266  }
2267  }
2268  else
2269  {
2270  SCIPdebugMsg(scip, "Solution constructed by heuristic is already known to be infeasible\n");
2271  }
2272 
2273  SCIPstatistic( heurdata->nremainingviols = nviolatedrows; );
2274 
2275  TERMINATE2:
2276  /* free allocated memory in reverse order of allocation */
2277  for( c = matrix->ndiscvars - 1; c >= 0; --c )
2278  {
2279  SCIP_VAR* var;
2280 
2281  var = SCIPcolGetVar(heurdata->lpcols[c]);
2282  assert(var != NULL);
2283  assert(eventdatas[c] != NULL);
2284 
2285  SCIP_CALL( SCIPdropVarEvent(scip, var, EVENTTYPE_SHIFTANDPROPAGATE, eventhdlr, eventdatas[c], -1) );
2286  SCIPfreeBuffer(scip, &(eventdatas[c]));
2287  }
2288  SCIPfreeBufferArray(scip, &eventdatas);
2289 
2290  if( violatedvarrows != NULL )
2291  {
2292  assert(heurdata->sortkey == 'v' || heurdata->sortkey == 't');
2293  SCIPfreeBufferArray(scip, &violatedvarrows);
2294  }
2295  /* free all allocated memory */
2296  SCIPfreeBufferArray(scip, &violatedrowpos);
2297  SCIPfreeBufferArray(scip, &violatedrows);
2298  SCIPfreeBufferArray(scip, &violationchange);
2299  SCIPfreeBufferArray(scip, &steps);
2300  SCIPfreeBufferArray(scip, &heurdata->rowweights);
2301  SCIPfreeBufferArray(scip, &permutation);
2302  SCIP_CALL( SCIPfreeSol(scip, &sol) );
2303 
2304  eventhdlrdata->nviolatedrows = NULL;
2305  eventhdlrdata->violatedrowpos = NULL;
2306  eventhdlrdata->violatedrows = NULL;
2307 
2308  TERMINATE:
2309  /* terminate probing mode and free the remaining memory */
2310  SCIPstatistic(
2311  heurdata->ncutoffs += ncutoffs;
2312  heurdata->nprobings += nprobings;
2313  heurdata->nlpiters = SCIPgetNLPIterations(scip) - heurdata->nlpiters;
2314  );
2315 
2316  SCIP_CALL( SCIPendProbing(scip) );
2317  freeMatrix(scip, &matrix);
2318  SCIPfreeBufferArray(scip, &colposs);
2319  SCIPfreeBufferArray(scip, &heurdata->lpcols);
2320  eventhdlrdata->matrix = NULL;
2321 
2322  return SCIP_OKAY;
2323 }
2324 
2325 /** event handler execution method for the heuristic which catches all
2326  * events in which a lower or upper bound were tightened */
2327 static
2328 SCIP_DECL_EVENTEXEC(eventExecShiftandpropagate)
2329 { /*lint --e{715}*/
2330  SCIP_EVENTHDLRDATA* eventhdlrdata;
2331  SCIP_VAR* var;
2332  SCIP_COL* col;
2333  SCIP_Real lb;
2334  SCIP_Real ub;
2335  int colpos;
2336  CONSTRAINTMATRIX* matrix;
2337  SCIP_HEURDATA* heurdata;
2338 
2339  assert(scip != NULL);
2340  assert(eventhdlr != NULL);
2341  assert(strcmp(EVENTHDLR_NAME, SCIPeventhdlrGetName(eventhdlr)) == 0);
2342 
2343  eventhdlrdata = SCIPeventhdlrGetData(eventhdlr);
2344  assert(eventhdlrdata != NULL);
2345 
2346  matrix = eventhdlrdata->matrix;
2347 
2348  heurdata = eventhdlrdata->heurdata;
2349  assert(heurdata != NULL && heurdata->lpcols != NULL);
2350 
2351  colpos = eventdata->colpos;
2352 
2353  assert(0 <= colpos && colpos < matrix->ndiscvars);
2354 
2355  col = heurdata->lpcols[colpos];
2356  var = SCIPcolGetVar(col);
2357 
2358  lb = SCIPvarGetLbLocal(var);
2359  ub = SCIPvarGetUbLocal(var);
2360 
2361  SCIP_CALL( updateTransformation(scip, matrix, eventhdlrdata->heurdata, colpos, lb, ub, eventhdlrdata->violatedrows,
2362  eventhdlrdata->violatedrowpos, eventhdlrdata->nviolatedrows) );
2363 
2364  return SCIP_OKAY;
2365 }
2366 
2367 /*
2368  * primal heuristic specific interface methods
2369  */
2370 
2371 /** creates the shiftandpropagate primal heuristic and includes it in SCIP */
2373  SCIP* scip /**< SCIP data structure */
2374  )
2375 {
2376  SCIP_HEURDATA* heurdata;
2377  SCIP_HEUR* heur;
2378  SCIP_EVENTHDLRDATA* eventhandlerdata;
2379  SCIP_EVENTHDLR* eventhdlr;
2380 
2381  SCIP_CALL( SCIPallocBlockMemory(scip, &eventhandlerdata) );
2382  eventhandlerdata->matrix = NULL;
2383 
2384  eventhdlr = NULL;
2386  eventExecShiftandpropagate, eventhandlerdata) );
2387  assert(eventhdlr != NULL);
2388 
2389  /* create Shiftandpropagate primal heuristic data */
2390  SCIP_CALL( SCIPallocBlockMemory(scip, &heurdata) );
2391  heurdata->rowweights = NULL;
2392  heurdata->nlpcols = 0;
2393  heurdata->eventhdlr = eventhdlr;
2394 
2395  /* include primal heuristic */
2396  SCIP_CALL( SCIPincludeHeurBasic(scip, &heur,
2398  HEUR_MAXDEPTH, HEUR_TIMING, HEUR_USESSUBSCIP, heurExecShiftandpropagate, heurdata) );
2399 
2400  assert(heur != NULL);
2401 
2402  /* set non-NULL pointers to callback methods */
2403  SCIP_CALL( SCIPsetHeurCopy(scip, heur, heurCopyShiftandpropagate) );
2404  SCIP_CALL( SCIPsetHeurFree(scip, heur, heurFreeShiftandpropagate) );
2405  SCIP_CALL( SCIPsetHeurInit(scip, heur, heurInitShiftandpropagate) );
2406  SCIP_CALL( SCIPsetHeurExit(scip, heur, heurExitShiftandpropagate) );
2407 
2408  /* add shiftandpropagate primal heuristic parameters */
2409  SCIP_CALL( SCIPaddIntParam(scip, "heuristics/" HEUR_NAME "/nproprounds",
2410  "The number of propagation rounds used for each propagation",
2411  &heurdata->nproprounds, TRUE, DEFAULT_NPROPROUNDS, -1, 1000, NULL, NULL) );
2412  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/relax", "Should continuous variables be relaxed?",
2413  &heurdata->relax, TRUE, DEFAULT_RELAX, NULL, NULL) );
2414  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/probing", "Should domains be reduced by probing?",
2415  &heurdata->probing, TRUE, DEFAULT_PROBING, NULL, NULL) );
2416  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/onlywithoutsol",
2417  "Should heuristic only be executed if no primal solution was found, yet?",
2418  &heurdata->onlywithoutsol, TRUE, DEFAULT_ONLYWITHOUTSOL, NULL, NULL) );
2419  SCIP_CALL( SCIPaddIntParam(scip, "heuristics/" HEUR_NAME "/cutoffbreaker", "The number of cutoffs before heuristic stops",
2420  &heurdata->cutoffbreaker, TRUE, DEFAULT_CUTOFFBREAKER, -1, 1000000, NULL, NULL) );
2421  SCIP_CALL( SCIPaddCharParam(scip, "heuristics/" HEUR_NAME "/sortkey",
2422  "the key for variable sorting: (n)orms down, norms (u)p, (v)iolations down, viola(t)ions up, or (r)andom",
2423  &heurdata->sortkey, TRUE, DEFAULT_SORTKEY, SORTKEYS, NULL, NULL) );
2424  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/sortvars", "Should variables be sorted for the heuristic?",
2425  &heurdata->sortvars, TRUE, DEFAULT_SORTVARS, NULL, NULL));
2426  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/" HEUR_NAME "/collectstats", "should variable statistics be collected during probing?",
2427  &heurdata->collectstats, TRUE, DEFAULT_COLLECTSTATS, NULL, NULL) );
2428  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/stopafterfeasible",
2429  "Should the heuristic stop calculating optimal shift values when no more rows are violated?",
2430  &heurdata->stopafterfeasible, TRUE, DEFAULT_STOPAFTERFEASIBLE, NULL, NULL) );
2431  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/preferbinaries",
2432  "Should binary variables be shifted first?",
2433  &heurdata->preferbinaries, TRUE, DEFAULT_PREFERBINARIES, NULL, NULL) );
2434  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/nozerofixing",
2435  "should variables with a zero shifting value be delayed instead of being fixed?",
2436  &heurdata->nozerofixing, TRUE, DEFAULT_NOZEROFIXING, NULL, NULL) );
2437  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/fixbinlocks",
2438  "should binary variables with no locks in one direction be fixed to that direction?",
2439  &heurdata->fixbinlocks, TRUE, DEFAULT_FIXBINLOCKS, NULL, NULL) );
2440  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/binlocksfirst",
2441  "should binary variables with no locks be preferred in the ordering?",
2442  &heurdata->binlocksfirst, TRUE, DEFAULT_BINLOCKSFIRST, NULL, NULL) );
2443  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/normalize",
2444  "should coefficients and left/right hand sides be normalized by max row coeff?",
2445  &heurdata->normalize, TRUE, DEFAULT_NORMALIZE, NULL, NULL) );
2446  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/updateweights",
2447  "should row weight be increased every time the row is violated?",
2448  &heurdata->updateweights, TRUE, DEFAULT_UPDATEWEIGHTS, NULL, NULL) );
2449  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/impliscontinuous",
2450  "should implicit integer variables be treated as continuous variables?",
2451  &heurdata->impliscontinuous, TRUE, DEFAULT_IMPLISCONTINUOUS, NULL, NULL) );
2452  SCIP_CALL( SCIPaddBoolParam(scip, "heuristics/shiftandpropagate/selectbest",
2453  "should the heuristic choose the best candidate in every round? (set to FALSE for static order)?",
2454  &heurdata->selectbest, TRUE, DEFAULT_SELECTBEST, NULL, NULL) );
2455  SCIP_CALL( SCIPaddRealParam(scip, "heuristics/" HEUR_NAME "/maxcutoffquot",
2456  "maximum percentage of allowed cutoffs before stopping the heuristic",
2457  &heurdata->maxcutoffquot, TRUE, DEFAULT_MAXCUTOFFQUOT, 0.0, 2.0, NULL, NULL) );
2458 
2459  return SCIP_OKAY;
2460 }
SCIP_RETCODE SCIPgetLPColsData(SCIP *scip, SCIP_COL ***cols, int *ncols)
Definition: scip_lp.c:427
int SCIPgetNContVars(SCIP *scip)
Definition: scip_prob.c:2167
SCIP_RETCODE SCIPfreeSol(SCIP *scip, SCIP_SOL **sol)
Definition: scip_sol.c:976
#define NULL
Definition: def.h:253
SCIP_Bool SCIPisStopped(SCIP *scip)
Definition: scip_general.c:686
const char * SCIPheurGetName(SCIP_HEUR *heur)
Definition: heur.c:1254
SCIP_RETCODE SCIPsetSolVal(SCIP *scip, SCIP_SOL *sol, SCIP_VAR *var, SCIP_Real val)
Definition: scip_sol.c:1212
public methods for SCIP parameter handling
int SCIProwGetNLPNonz(SCIP_ROW *row)
Definition: lp.c:16901
void SCIPfreeRandom(SCIP *scip, SCIP_RANDNUMGEN **randnumgen)
#define DEFAULT_FIXBINLOCKS
preroot heuristic that alternatingly fixes variables and propagates domains
SCIP_RETCODE SCIPfixVarProbing(SCIP *scip, SCIP_VAR *var, SCIP_Real fixedval)
Definition: scip_probing.c:408
int SCIPgetNLPRows(SCIP *scip)
Definition: scip_lp.c:561
static void relaxVar(SCIP *scip, SCIP_VAR *var, CONSTRAINTMATRIX *matrix, SCIP_Bool normalize)
SCIP_RETCODE SCIPnewProbingNode(SCIP *scip)
Definition: scip_probing.c:155
SCIP_EXPORT SCIP_Bool SCIPvarIsInLP(SCIP_VAR *var)
Definition: var.c:17077
#define HEUR_USESSUBSCIP
SCIP_EXPORT int SCIPvarGetNLocksUpType(SCIP_VAR *var, SCIP_LOCKTYPE locktype)
Definition: var.c:3241
public methods for memory management
SCIP_HEURDATA * SCIPheurGetData(SCIP_HEUR *heur)
Definition: heur.c:1165
#define DEFAULT_SORTKEY
#define HEUR_DESC
static SCIP_DECL_HEUREXEC(heurExecShiftandpropagate)
SCIP_Real * SCIPcolGetVals(SCIP_COL *col)
Definition: lp.c:16845
void SCIPwarningMessage(SCIP *scip, const char *formatstr,...)
Definition: scip_message.c:122
SCIP_EXPORT void SCIPsortDownIntInt(int *intarray1, int *intarray2, int len)
SCIP_Bool SCIPcolIsIntegral(SCIP_COL *col)
Definition: lp.c:16756
#define HEUR_NAME
SCIP_RETCODE SCIPprintRow(SCIP *scip, SCIP_ROW *row, FILE *file)
Definition: scip_lp.c:2031
struct SCIP_EventhdlrData SCIP_EVENTHDLRDATA
Definition: type_event.h:138
SCIP_Real SCIProwGetConstant(SCIP_ROW *row)
Definition: lp.c:16932
SCIP_NODE * SCIPgetCurrentNode(SCIP *scip)
Definition: scip_tree.c:80
SCIP_EXPORT SCIP_Bool SCIPvarIsBinary(SCIP_VAR *var)
Definition: var.c:16918
const char * SCIPeventhdlrGetName(SCIP_EVENTHDLR *eventhdlr)
Definition: event.c:314
int SCIPgetNVars(SCIP *scip)
Definition: scip_prob.c:1987
#define FALSE
Definition: def.h:73
#define DEFAULT_CUTOFFBREAKER
SCIP_ROW ** SCIPcolGetRows(SCIP_COL *col)
Definition: lp.c:16835
static SCIP_DECL_EVENTEXEC(eventExecShiftandpropagate)
#define DEFAULT_RELAX
static void freeMatrix(SCIP *scip, CONSTRAINTMATRIX **matrix)
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
SCIP_RETCODE SCIPlinkLPSol(SCIP *scip, SCIP_SOL *sol)
Definition: scip_sol.c:1017
#define SCIPstatisticMessage
Definition: pub_message.h:104
#define HEUR_DISPCHAR
SCIP_Bool SCIPisLPConstructed(SCIP *scip)
Definition: scip_lp.c:91
#define DEFAULT_SORTVARS
SCIP_RETCODE SCIPcutoffNode(SCIP *scip, SCIP_NODE *node)
Definition: scip_tree.c:423
#define DEFAULT_UPDATEWEIGHTS
SCIP_Bool SCIPisFeasLE(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
#define DEFAULT_BINLOCKSFIRST
struct SCIP_HeurData SCIP_HEURDATA
Definition: type_heur.h:51
public methods for problem variables
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
#define SCIPfreeBlockMemory(scip, ptr)
Definition: scip_mem.h:95
SCIP_EXPORT SCIP_VARSTATUS SCIPvarGetStatus(SCIP_VAR *var)
Definition: var.c:16857
int SCIProwGetLPPos(SCIP_ROW *row)
Definition: lp.c:17155
#define DEFAULT_WEIGHT_INEQUALITY
#define SCIPfreeBufferArray(scip, ptr)
Definition: scip_mem.h:123
enum SCIP_LPSolStat SCIP_LPSOLSTAT
Definition: type_lp.h:42
#define SCIPallocBlockMemory(scip, ptr)
Definition: scip_mem.h:78
public methods for SCIP variables
SCIP_RETCODE SCIPsetHeurInit(SCIP *scip, SCIP_HEUR *heur, SCIP_DECL_HEURINIT((*heurinit)))
Definition: scip_heur.c:184
#define DEFAULT_RANDSEED
SCIP_RETCODE SCIPtrySol(SCIP *scip, SCIP_SOL *sol, SCIP_Bool printreason, SCIP_Bool completely, SCIP_Bool checkbounds, SCIP_Bool checkintegrality, SCIP_Bool checklprows, SCIP_Bool *stored)
Definition: scip_sol.c:3124
#define HEUR_TIMING
#define SCIPdebugMsg
Definition: scip_message.h:69
SCIP_LPSOLSTAT SCIPgetLPSolstat(SCIP *scip)
Definition: scip_lp.c:158
#define DEFAULT_ONLYWITHOUTSOL
SCIP_Bool SCIPhasCurrentNodeLP(SCIP *scip)
Definition: scip_lp.c:73
SCIP_Bool SCIPisInfinity(SCIP *scip, SCIP_Real val)
#define HEUR_PRIORITY
public methods for numerical tolerances
SCIP_RETCODE SCIPcreateRandom(SCIP *scip, SCIP_RANDNUMGEN **randnumgen, unsigned int initialseed, SCIP_Bool useglobalseed)
SCIP_RETCODE SCIPcreateSol(SCIP *scip, SCIP_SOL **sol, SCIP_HEUR *heur)
Definition: scip_sol.c:319
public methods for querying solving statistics
SCIP_Bool SCIPisLE(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
SCIP_RETCODE SCIPincludeHeurBasic(SCIP *scip, SCIP_HEUR **heur, const char *name, const char *desc, char dispchar, int priority, int freq, int freqofs, int maxdepth, SCIP_HEURTIMING timingmask, SCIP_Bool usessubscip, SCIP_DECL_HEUREXEC((*heurexec)), SCIP_HEURDATA *heurdata)
Definition: scip_heur.c:107
public methods for the branch-and-bound tree
SCIP_EVENTHDLRDATA * SCIPeventhdlrGetData(SCIP_EVENTHDLR *eventhdlr)
Definition: event.c:324
static SCIP_DECL_HEUREXIT(heurExitShiftandpropagate)
#define DEFAULT_NORMALIZE
SCIP_RETCODE SCIPincludeHeurShiftandpropagate(SCIP *scip)
SCIP_EXPORT const char * SCIPvarGetName(SCIP_VAR *var)
Definition: var.c:16738
SCIP_EXPORT void SCIPsortDownRealInt(SCIP_Real *realarray, int *intarray, int len)
SCIP_EXPORT void SCIPsolSetHeur(SCIP_SOL *sol, SCIP_HEUR *heur)
Definition: sol.c:2594
static SCIP_Bool varIsDiscrete(SCIP_VAR *var, SCIP_Bool impliscontinuous)
SCIP_EXPORT SCIP_Bool SCIPvarIsIntegral(SCIP_VAR *var)
Definition: var.c:16929
SCIP_COL ** SCIProwGetCols(SCIP_ROW *row)
Definition: lp.c:16912
#define DEFAULT_STOPAFTERFEASIBLE
#define SCIPerrorMessage
Definition: pub_message.h:45
#define DEFAULT_SELECTBEST
void SCIPenableVarHistory(SCIP *scip)
Definition: scip_var.c:8568
static void transformVariable(SCIP *scip, CONSTRAINTMATRIX *matrix, SCIP_HEURDATA *heurdata, int colpos)
SCIP_RETCODE SCIPgetLPRowsData(SCIP *scip, SCIP_ROW ***rows, int *nrows)
Definition: scip_lp.c:505
static SCIP_Bool colIsDiscrete(SCIP_COL *col, SCIP_Bool impliscontinuous)
public methods for event handler plugins and event handlers
SCIP_Bool SCIPisFeasEQ(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
SCIP_VAR ** SCIPgetVars(SCIP *scip)
Definition: scip_prob.c:1942
#define SCIPallocBuffer(scip, ptr)
Definition: scip_mem.h:109
#define EVENTTYPE_SHIFTANDPROPAGATE
SCIP_Real * SCIProwGetVals(SCIP_ROW *row)
Definition: lp.c:16922
static SCIP_RETCODE initMatrix(SCIP *scip, CONSTRAINTMATRIX *matrix, SCIP_HEURDATA *heurdata, int *colposs, SCIP_Bool normalize, int *nmaxrows, SCIP_Bool relax, SCIP_Bool *initialized, SCIP_Bool *infeasible)
int SCIPgetProbingDepth(SCIP *scip)
Definition: scip_probing.c:188
#define SORTKEYS
int SCIPcolGetNLPNonz(SCIP_COL *col)
Definition: lp.c:16824
struct SCIP_EventData SCIP_EVENTDATA
Definition: type_event.h:155
#define DEFAULT_PREFERBINARIES
void SCIPheurSetData(SCIP_HEUR *heur, SCIP_HEURDATA *heurdata)
Definition: heur.c:1175
SCIP_RETCODE SCIPendProbing(SCIP *scip)
Definition: scip_probing.c:250
#define REALABS(x)
Definition: def.h:188
public methods for primal CIP solutions
#define SCIP_CALL(x)
Definition: def.h:365
#define DEFAULT_NOZEROFIXING
#define SCIPfreeBlockMemoryNull(scip, ptr)
Definition: scip_mem.h:96
static SCIP_DECL_HEURINIT(heurInitShiftandpropagate)
SCIP_RETCODE SCIPbacktrackProbing(SCIP *scip, int probingdepth)
Definition: scip_probing.c:215
SCIP_Real SCIPfeasFloor(SCIP *scip, SCIP_Real val)
SCIP_EXPORT void SCIPsortPtr(void **ptrarray, SCIP_DECL_SORTPTRCOMP((*ptrcomp)), int len)
public methods for primal heuristic plugins and divesets
#define EVENTHDLR_NAME
SCIP_Bool SCIPisFeasZero(SCIP *scip, SCIP_Real val)
SCIP_EXPORT SCIP_COL * SCIPvarGetCol(SCIP_VAR *var)
Definition: var.c:17066
#define SCIPallocBufferArray(scip, ptr, num)
Definition: scip_mem.h:111
SCIP_Real SCIPinfinity(SCIP *scip)
public data structures and miscellaneous methods
int SCIPgetDepth(SCIP *scip)
Definition: scip_tree.c:637
SCIP_EXPORT void SCIPsortRealInt(SCIP_Real *realarray, int *intarray, int len)
#define SCIP_Bool
Definition: def.h:70
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_RETCODE SCIPconstructLP(SCIP *scip, SCIP_Bool *cutoff)
Definition: scip_lp.c:114
#define HEUR_MAXDEPTH
#define HEUR_FREQOFS
SCIP_EXPORT void SCIPsortIntInt(int *intarray1, int *intarray2, int len)
SCIP_RETCODE SCIPsetHeurExit(SCIP *scip, SCIP_HEUR *heur, SCIP_DECL_HEUREXIT((*heurexit)))
Definition: scip_heur.c:200
SCIP_EXPORT SCIP_Real SCIPvarGetUbGlobal(SCIP_VAR *var)
Definition: var.c:17362
#define DEFAULT_NPROPROUNDS
SCIP_RETCODE SCIPpropagateProbing(SCIP *scip, int maxproprounds, SCIP_Bool *cutoff, SCIP_Longint *ndomredsfound)
Definition: scip_probing.c:565
SCIP_Real SCIProwGetLhs(SCIP_ROW *row)
Definition: lp.c:16966
#define MIN(x, y)
Definition: def.h:223
enum TransformStatus TRANSFORMSTATUS
public methods for LP management
#define DEFAULT_MAXCUTOFFQUOT
void SCIPrandomPermuteIntArray(SCIP_RANDNUMGEN *randnumgen, int *array, int begin, int end)
Definition: misc.c:9659
#define DEFAULT_IMPLISCONTINUOUS
SCIP_RETCODE SCIPflushLP(SCIP *scip)
Definition: scip_lp.c:138
#define BMScopyMemoryArray(ptr, source, num)
Definition: memory.h:124
#define DEFAULT_WEIGHT_EQUALITY
SCIP_Bool SCIPisFeasGE(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
#define HEUR_FREQ
static void getColumnData(CONSTRAINTMATRIX *matrix, int colindex, SCIP_Real **valpointer, int **indexpointer, int *ncolvals)
SCIP_EXPORT SCIP_Real SCIPvarGetLbLocal(SCIP_VAR *var)
Definition: var.c:17408
#define SCIP_MAXTREEDEPTH
Definition: def.h:301
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_VAR * SCIPcolGetVar(SCIP_COL *col)
Definition: lp.c:16736
static void checkRowViolation(SCIP *scip, CONSTRAINTMATRIX *matrix, int rowindex, int *violatedrows, int *violatedrowpos, int *nviolatedrows, int *rowweights, SCIP_Bool updateweights)
public methods for the LP relaxation, rows and columns
SCIP_EXPORT int SCIPvarGetNLocksDownType(SCIP_VAR *var, SCIP_LOCKTYPE locktype)
Definition: var.c:3184
static void checkViolations(SCIP *scip, CONSTRAINTMATRIX *matrix, int colidx, int *violatedrows, int *violatedrowpos, int *nviolatedrows, int *rowweights, SCIP_Bool updateweights)
SCIP_Real * r
Definition: circlepacking.c:50
SCIP_EXPORT SCIP_Real SCIPvarGetUbLocal(SCIP_VAR *var)
Definition: var.c:17418
methods for sorting joint arrays of various types
#define SCIP_LONGINT_FORMAT
Definition: def.h:156
SCIP_VAR ** b
Definition: circlepacking.c:56
public methods for managing events
general public methods
#define SCIPfreeBuffer(scip, ptr)
Definition: scip_mem.h:121
#define MAX(x, y)
Definition: def.h:222
static SCIP_DECL_HEURCOPY(heurCopyShiftandpropagate)
static SCIP_Real retransformVariable(SCIP *scip, CONSTRAINTMATRIX *matrix, SCIP_VAR *var, int varindex, SCIP_Real solvalue)
SCIP_Bool SCIPisFeasGT(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
static SCIP_RETCODE updateTransformation(SCIP *scip, CONSTRAINTMATRIX *matrix, SCIP_HEURDATA *heurdata, int varindex, SCIP_Real lb, SCIP_Real ub, int *violatedrows, int *violatedrowpos, int *nviolatedrows)
SCIP_Longint SCIPgetNLPIterations(SCIP *scip)
public methods for solutions
public methods for random numbers
SCIP_RETCODE SCIPwriteLP(SCIP *scip, const char *filename)
Definition: scip_lp.c:812
SCIP_EXPORT SCIP_Real SCIPvarGetLbGlobal(SCIP_VAR *var)
Definition: var.c:17352
public methods for the probing mode
SCIP_RETCODE SCIPsetHeurCopy(SCIP *scip, SCIP_HEUR *heur, SCIP_DECL_HEURCOPY((*heurcopy)))
Definition: scip_heur.c:152
SCIP_Bool SCIPisFeasLT(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
SCIP_Bool SCIPcolIsInLP(SCIP_COL *col)
Definition: lp.c:16799
SCIP_RETCODE SCIPstartProbing(SCIP *scip)
Definition: scip_probing.c:109
static void getRowData(CONSTRAINTMATRIX *matrix, int rowindex, SCIP_Real **valpointer, SCIP_Real *lhs, SCIP_Real *rhs, int **indexpointer, int *nrowvals)
public methods for message output
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
SCIP_RETCODE SCIPchgVarLbProbing(SCIP *scip, SCIP_VAR *var, SCIP_Real newbound)
Definition: scip_probing.c:291
SCIP_RETCODE SCIPprintSol(SCIP *scip, SCIP_SOL *sol, FILE *file, SCIP_Bool printzeros)
Definition: scip_sol.c:1766
#define SCIPstatistic(x)
Definition: pub_message.h:101
#define SCIP_Real
Definition: def.h:164
SCIP_RETCODE SCIPchgVarUbProbing(SCIP *scip, SCIP_VAR *var, SCIP_Real newbound)
Definition: scip_probing.c:335
const char * SCIProwGetName(SCIP_ROW *row)
Definition: lp.c:17025
static SCIP_DECL_SORTPTRCOMP(heurSortColsShiftandpropagate)
public methods for message handling
SCIP_Bool SCIPisGT(SCIP *scip, SCIP_Real val1, SCIP_Real val2)
#define SCIP_Longint
Definition: def.h:149
#define EVENTHDLR_DESC
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 SCIPsetHeurFree(SCIP *scip, SCIP_HEUR *heur, SCIP_DECL_HEURFREE((*heurfree)))
Definition: scip_heur.c:168
#define DEFAULT_PROBING
#define DEFAULT_PROPBREAKER
enum SCIP_Vartype SCIP_VARTYPE
Definition: type_var.h:60
#define DEFAULT_COLLECTSTATS
SCIP_Real SCIPfeasCeil(SCIP *scip, SCIP_Real val)
SCIP_Real SCIProwGetRhs(SCIP_ROW *row)
Definition: lp.c:16976
SCIP_Real SCIPgetRowMaxCoef(SCIP *scip, SCIP_ROW *row)
Definition: scip_lp.c:1760
#define BMSclearMemoryArray(ptr, num)
Definition: memory.h:120
public methods for primal heuristics
void SCIPdisableVarHistory(SCIP *scip)
Definition: scip_var.c:8587
#define SCIPABORT()
Definition: def.h:337
public methods for global and local (sub)problems
static SCIP_DECL_HEURFREE(heurFreeShiftandpropagate)
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_SOL * SCIPgetBestSol(SCIP *scip)
Definition: scip_sol.c:2304
#define ABS(x)
Definition: def.h:218
SCIP_RETCODE SCIPsolveProbingLP(SCIP *scip, int itlim, SCIP_Bool *lperror, SCIP_Bool *cutoff)
Definition: scip_probing.c:801
static SCIP_RETCODE getOptimalShiftingValue(SCIP *scip, CONSTRAINTMATRIX *matrix, int varindex, int direction, int *rowweights, SCIP_Real *steps, int *violationchange, SCIP_Real *beststep, int *rowviolations)
int SCIPcolGetLPPos(SCIP_COL *col)
Definition: lp.c:16777
SCIP_Bool SCIPisFeasPositive(SCIP *scip, SCIP_Real val)
SCIP_Real SCIPgetSolOrigObj(SCIP *scip, SCIP_SOL *sol)
Definition: scip_sol.c:1435
memory allocation routines