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;

```