Work-Shift Scheduling: Finding Optimal Assignment

/*********************************************************************/
/*                                                                   */
/*          S A S   S A M P L E   L I B R A R Y                      */
/*                                                                   */
/*    NAME: clpe03                                                   */
/*   TITLE: Work-Shift Scheduling: Finding Optimal Assignment        */
/*                                                          (clpe03) */
/* PRODUCT: OR                                                       */
/*  SYSTEM: ALL                                                      */
/*    KEYS: OR                                                       */
/*   PROCS: CLP, GANTT                                               */
/*    DATA:                                                          */
/*                                                                   */
/* SUPPORT:                             UPDATE:                      */
/*     REF:                                                          */
/*    MISC: Example 3 from the CLP Procedure chapter of the          */
/*          Constraint Programming book.                             */
/*                                                                   */
/*********************************************************************/


proc clp out=clpout;
   /*  Six workers (Alan, Bob, John, Mike, Scott and Ted)
       are to be assigned to 3 working shifts.            */
   var (W1-W6) = [1,3];

   /* The first shift needs at least 1 and at most 4 people;
      the second shift needs at least 2 and at most 3 people;
      and the third shift needs exactly 2 people. */
   gcc (W1-W6) = ( ( 1, 1, 4) ( 2, 2, 3) ( 3, 2, 2) );

   /* Alan doesn't work on the first shift. */
   lincon W1 <> 1;

   /* Bob works only on the third shift. */
   lincon W2 = 3;
run;


/* print solution */
proc print;
   title 'Solution to Work-Shift Scheduling Problem';
run;


/* Produce Gantt Chart */
proc transpose data=clpout out=tmp1;
run;

data tmp2 (drop=_NAME_);
   format Name $8.;
   set tmp1;
   reName col1=e_start;
   e_finish=col1+1;
   duration=1;
   if _Name_='W1' then Name='Alan';
   else if _Name_='W2' then Name='Bob';
   else if _Name_='W3' then Name='John';
   else if _Name_='W4' then Name='Mike';
   else if _Name_='W5' then Name='Scott';
   else if _Name_='W6' then Name='Ted';
   else delete;
run;

proc format;
   value shift
      1 = '   Shift 1'
      2 = '   Shift 2'
      3 = '   Shift 3'
      4 = ' '
      ;
run;


goptions htext=1.5;
pattern1 c=ltgray;
title j=c h=6pct 'Example 3: Feasible Work-Shift Assignment';

proc gantt data=tmp2;
   format e_start shift.;
   chart /
      pcompress
      skip=2
      dur=duration scale=16
      chartwidth=84
      ref=2 3 lref=20
      useformat
      nolegend;
   id Name;
run;


%macro callclp(obj);
   %put The objective value is: &obj..;
   proc clp out=clpout;
      /* Six workers (Alan, Bob, John, Mike, Scott and Ted)
         are to be assigned to 3 working shifts.  */
      var (W1-W6) = [1,3];
      var (C1-C6) = [1,100];

      /* The first shift needs at least 1 and at most 4 people;
         the second shift needs at least 2 and at most 3 people;
         and the third shift needs exactly 2 people. */
      gcc (W1-W6) = ( ( 1, 1, 4) ( 2, 2, 3) ( 3, 2, 2) );

      /* Alan doesn't work on the first shift. */
      lincon W1 <> 1;

      /* Bob works only on the third shift. */
      lincon W2 = 3;


      /* Specify the costs of assigning the workers to the shifts.
         Use 100 (a large number) to indicate an assignment
         that is not possible.*/
      element (W1, (100,  12, 10), C1);
      element (W2, (100, 100,  6), C2);
      element (W3, ( 16,   8, 12), C3);
      element (W4, ( 10,   6,  8), C4);
      element (W5, (  6,   6,  8), C5);
      element (W6, ( 12,   4,  4), C6);

      /* The total cost should be no more than the given objective value. */
      lincon C1 + C2 + C3 + C4 + C5 + C6 <= &obj;
   run;

   /* when a solution is found,                      */
   /* &_ORCLP_ contains the string SOLUTIONS_FOUND=1   */
   %if %index(&_ORCLP_,  SOLUTIONS_FOUND=1) %then %let clpreturn=SUCCESSFUL;
%mend;

/* Bisection search method to determine the optimal objective value  */
%macro mincost(lb, ub);
   %do %while (&lb<&ub-1);
      %put Currently lb=&lb, ub=&ub..;
      %let newobj=%eval((&lb+&ub)/2);
      %let clpreturn=NOTFOUND;
      %callclp(&newobj);
      %if &clpreturn=SUCCESSFUL %then %let ub=&newobj;
      %else %let lb=&newobj;
   %end;

   %callclp(&ub);

   %put Minimum possible objective value within given range is &ub.;
   %put Any value less than &ub makes the problem infeasible. ;

   proc print;
   run;
%mend;

/* Find the minimum objective value between 1 and 100. */
%mincost(lb=1, ub=100);


proc transpose data=clpout out=tmp1;
run;

data tmp2 (drop=_NAME_);
   format Name $8.;
   set tmp1;
   reName col1=e_start;
   e_finish=col1+1;
   duration=1;
   if _Name_='W1' then Name='Alan';
   else if _Name_='W2' then Name='Bob';
   else if _Name_='W3' then Name='John';
   else if _Name_='W4' then Name='Mike';
   else if _Name_='W5' then Name='Scott';
   else if _Name_='W6' then Name='Ted';
   else delete;
run;

data tmp4;
   set tmp1;
   if _n_<=6 then delete;
run;

proc format;
   value shift
      1 = '   Shift 1'
      2 = '   Shift 2'
      3 = '   Shift 3'
      4 = ' '
      5 = ' ';
run;

data tmp5(drop=_Name_);
   format e_start shift.;
   format cost1 $8.;
   set tmp2;
   set tmp4;
   rename col1=cost;
   cost1="$"||strip(col1);
run;

data labels;
   _y = -1; _xvar="e_start"; _xoffset=0.25; _yoffset=-.15;
   _clabel='blue'; _hlabel=1.0; _lvar="cost1";
run;

proc sort data=tmp5 out=tmp6;
   by e_start;
run;

data tmp6;
   retain total 0;
   set tmp6;
   total=total+cost;
run;

data tmp7(keep=x y drop=max_y cscale);
   set tmp6 end=last;
   y=lag(total);
   if ( dif(e_start) ) then do;
      x=e_start;
      output;
   end;
   if (last ) then do;
      y=total;
      x=e_start+1;
      output;
      max_y = y + 5;
             cscale = 6 /max_y;
      stry=y;
      call symput('max_x', put(x+0.15,best.));
      call symput('mincost', strip(put(stry,best.)));
      call symput('max_y', strip(put(max_y,best.)));
      call symput('cscale', put(cscale,best.));
    end;
run;

%put &max_y;
%put &cscale;
%put &mincost;

%annomac;
data anno; /* define cost curve. */
   %dclanno;
   %system(2,2,4);
   *length lab $16;
   set tmp7;
   when='a';
   if _n_ = 1 then do;
      do i = 0 to &max_y by 5;
         lab=put( i, dollar7.);
         %label(&max_x + 0.8, (&max_y -i) * &cscale,lab,black,0,0,1.0, ,4);
         output;
         %label(&max_x + 0.9, (&max_y -i) * &cscale,'-',black,0,0,1.0, ,4);
      end;
      %move(1, &max_y * &cscale); /* initial point to start the cost curve.*/
   end;
   else do;
      %draw( x, (&max_y - y) * &cscale, blue,2,2);
   end;
run;


goptions htext=1.5;
pattern1 c=ltgray;
title1 j=c h=6pct 'Example 3: Optimal Work-Shift Assignment';
title2 j=c h=5pct "Minimum Cost Schedule: $&mincost";

proc gantt data=tmp5 labdata=labels annotate=anno;
   chart /
      pcompress
      skip=2
      chartwidth=84
      labsplit='/' scale=16
      mindate=1 maxdate=5
      ref=2 3 4
      useformat nolegend
      ;
   id Name;
run;