Resources

Progressive Party Problem (clpe14)

/***************************************************************/
/*                                                             */
/*          S A S   S A M P L E   L I B R A R Y                */
/*                                                             */
/*    NAME: clpe14                                             */
/*   TITLE: Progressive Party Problem (clpe14)                 */
/* PRODUCT: OR                                                 */
/*  SYSTEM: ALL                                                */
/*    KEYS: OR                                                 */
/*   PROCS: CLP                                                */
/*    DATA:                                                    */
/*                                                             */
/* SUPPORT:                             UPDATE:                */
/*     REF:                                                    */
/*    MISC: Example 14 from the CLP Procedure chapter of the   */
/*          Constraint Programming book.                       */
/*                                                             */
/***************************************************************/


data capacities;
   input boatnum capacity crewsize;
   datalines;
 1   6  2
 2   8  2
 3  12  2
 4  12  2
 5  12  4
 6  12  4
 7  12  4
 8  10  1
 9  10  2
10  10  2
11  10  2
12  10  3
13   8  4
14   8  2
15   8  3
16  12  6
17   8  2
18   8  2
19   8  4
20   8  2
21   8  4
22   8  5
23   7  4
24   7  4
25   7  2
26   7  2
27   7  4
28   7  5
29   6  2
30   6  4
31   6  2
32   6  2
33   6  2
34   6  2
35   6  2
36   6  2
37   6  4
38   6  5
39   9  7
40   0  2
41   0  3
42   0  4
;


data hostability;
   set capacities;
   spareCapacity = capacity - crewsize;
run;

data hosts guests;
   set hostability;
   if (boatnum <= 12 or boatnum eq 14) then do;
      output hosts;
   end;
   else do;
      output guests;
   end;
run;

/* sort so guest boats with larger crews appear first */
proc sort data=guests;
   by descending crewsize;
run;

data capacities;
   format boatnum capacity 2.;
   set hosts guests;
   seqno = _n_;
run;


%let rounds=2;
%let numhosts=13;

%macro ppp;
   proc sql noprint;
      select count(*) into :numboats from capacities;
      select max(capacity) into :maxcap from capacities;
      %do i = 0 %to &maxcap;
         select count(*) into :numclass_&i from capacities where capacity = &i;
      %end;
      select crewsize, spareCapacity into
         :crewsize_1-:crewsize_%scan(&numboats,1),
         :cap_1-:cap_%scan(&numboats,1) from capacities order by seqno;
   quit;

   proc clp out=out varselect=FIFO;
      /* assume first &numhosts boats are hosts */
      /* process each round in turn */
      %do t = 1 %to &rounds;
         %do i = &numhosts+1 %to &numboats;
            /* boat i assigned host value for round t */
            var x_&i._&t = [1,&numhosts];
         %end;
         %do h = 1 %to &numhosts;
            var L_&h._&t = [0,&&cap_&h]; /* load of host boat */
         %end;
      %end;

      %do i = &numhosts+1 %to &numboats;
         /* assign different host each round */
         alldiff (x_&i._1-x_&i._&rounds);
      %end;

      %do t = 1 %to &rounds;
         %do i = &numhosts+1 %to &numboats-1;
            /* boat i assigned host value for round t */
            %do j = &i+1 %to &numboats;
               var m_&i._&j._&t = [0,1];
               reify m_&i._&j._&t : (x_&i._&t = x_&j._&t);
            %end;
         %end;
      %end;

      %do i = &numhosts+1 %to &numboats-1;
         %do j = &i+1 %to &numboats;
            lincon 1 >= 0
            %do t = 1 %to &rounds;
               + m_&i._&j._&t
            %end;
            ;
         %end;
      %end;

      /* honor capacities */
      %do t = 1 %to &rounds;
         PACK((
         %do i = &numhosts+1 %to &numboats;
            x_&i._&t
         %end;
         ) (
         %do i = &numhosts+1 %to &numboats;
            &&crewsize_&i
         %end;
         ) (
         %do h = 1 %to &numhosts;
            L_&h._&t
         %end;
         ));
      %end;

      /* break symmetries */
      %do t = 1 %to &rounds-1;
         lincon x_%scan(&numboats,1)_&t < x_%scan(&numboats,1)_%eval(&t+1);
      %end;

   run;
%mend ppp;

%ppp;


%macro procrslts;
   proc transpose data=out out=xpose;
   run;

   proc sql;
      create table result as
         select * from xpose where col1=0;
      create table assign as
         select * from xpose where _name_ like 'x%';
      create table hosts as
         select * from xpose where _name_ like 'h%'
            and scan(_name_,4,'_') is null and col1=0;
      create table meetups as
         select * from xpose where _name_ like 'm%' and col1=0
            order by scan(_name_,2,'_'), scan(_name_,4,'_'), scan(_name_,3,'_');
      create table results2 (round num, host num, boatnum num);
      %do t = 1 %to &rounds.;
         %do h = 1 %to &numhosts.;
         insert into results2 values(&t., &h., &h.);
            insert into results2
               select &t., &h., input(scan(_name_,2,'_'),2.)
               from assign where col1 = &h. and scan(_name_,3,'_') = "&t.";
         %end;
      %end;
     create table results3 as
      select a.round, c.boatnum as host, b.boatnum, b.crewsize, c.capacity
         from results2 a inner join capacities b on a.boatnum=b.seqno
         inner join capacities c on a.host=c.seqno;
   quit;
%mend procrslts;

%procrslts;

%let numcols = 6;


data results4;
   set results3 end=lastobs;
   drop colnum first i host capacity boatnum crewsize savper;
   array cs[&numcols.];
   array bt[&numcols.];
   retain cs bt;
   retain colnum;
   retain first 1;
   retain host 0;
   dummy = LAG1(host);
   if LAG1(host) ne host or first then do;
      hostboat = LAG1(host);
      cap = LAG1(capacity);
      savper = round;
      round = LAG1(round);
      if first ne 1 then do;
         output;
      end;
      round = savper;
      first = 0;
      colnum=1;
      do i = 1 to &numcols.;
         cs[i] = .;
         bt[i] = .;
      end;
   end;
   else do;
      colnum = colnum+1;
   end;
   bt[colnum] = boatnum;
   cs[colnum] = crewsize;
   if first ne 1 and lastobs then do;
     hostboat=host;
     cap = capacity;
     output;
   end;
run;

proc sort data=results3;
   by round host;
run;

data results5;
   set results3;
   retain finish segmt_no 0;
   if LAG1(host) ne host then do;
      start = 0;
      finish = capacity;
      segmt_no = 1;
      output;
      finish = 0;
   end;
   start = finish;
   finish = start + crewsize;
   segmt_no = segmt_no + 1;
   output;
run;

data results6;
   array cs[&numcols.];
   array bt[&numcols.];
   set results4;
   keep round start finish segmt_no hostboat boatnum;
   do i = 1 to &numcols;
      hostboat = bt[i];
      boatnum = .;
      start = 0;
      finish = cap;
      segmt_no = 1;
      start = 0;
      if not missing(hostboat) then do;
         output;
      end;
   end;
   do i = 1 to &numcols;
      finish = 0;
      hostboat = bt[i];
      start = 0;
      segmt_no = 2;
      do j = 1 to &numcols;
         finish = finish + cs[j];
         boatnum = bt[j];
         if not missing(hostboat) and not missing(boatnum) then do;
            output;
            segmt_no = segmt_no + 1;
         end;
         start = finish;
      end;
   end;
run;

proc sort data=results6;
   by hostboat round segmt_no;
run;

data results7;
   set results6
      (where=(hostboat=36 or hostboat=38 or hostboat=40 or hostboat=42));
run;

proc sort data=results7;
   by hostboat round segmt_no;
run;

data labels;
   input _y _xvar $ _hlabel _xoffset _yoffset segmt_no _lvar $;
   datalines;
.  start 0.9   0.2   0.9   1  boatnum
.  start 0.9   0.2   0.9   2  boatnum
.  start 0.9   0.2   0.9   3  boatnum
.  start 0.9   0.2   0.9   4  boatnum
.  start 0.9   0.2   0.9   5  boatnum
.  start 0.9   0.2   0.9   6  boatnum
;


%let numcols=6;
goptions vpos=40 htext=1.1;
pattern1 v=e c=red;
pattern2 v=e c=black r=&numcols.;
title1 j=c h=3pct 'Schedule for Round #BYVAL(round)';
options nobyline; /* suppress byline */

proc gantt data=results5 labdata=labels;
   by round;
   label round='Round';
   label host='Host';
   chart / activity = host s_start=start s_finish=finish pattern=segmt_no
                      labvar=segmt_no nolegend nojobnum;
   id host;
run;



title1 j=c h=7pct 'Schedule for Boat #BYVAL(hostboat)';
options nobyline; /* suppress byline */
goptions vsize=3.25in hsize=6.4in;
goptions vpos=20 htext=1.2;

proc format;
    value boatfmt
      . = "  "
    ;
run;

proc gantt data=results7 labdata=labels;
   by hostboat;
   format boatnum boatfmt.;
   label hostboat='Boat';
   label round='Round';
   chart / activity = hostboat s_start=start s_finish=finish pattern=segmt_no
                      labvar=segmt_no nolegend nojobnum;
   id round;
run;